Changeset 18 for trunk/UBrainFuck.pas

Timestamp:

Feb 11, 2012, 9:32:25 PM (13 years ago)

Author:

chronos

Message:

• Modified: Optimalized execution of BrainFuck commands using array of methods instead of case statement. This can scale better for future additional commands.
• Added: Interpretter form show speed in steps per second.

File:

• trunk/UBrainFuck.pas (modified) (12 diffs)

trunk/UBrainFuck.pas

@@ -39 +39 @@
   end;
 
+  TBrainFuckCommand = (cmNone, cmInc, cmDec, cmPointerInc, cmPointerDec,
+    cmOutput, cmInput, cmLoopStart, cmLoopEnd);
+
+  TCommandHandler = procedure of object;
+
   { TBrainFuckInterpretter }
 
@@ -49 +54 @@
     FThread: TBrainFuckInterpretterThread;
     FStepCount: Integer;
+    FCommandTable: array[TBrainFuckCommand] of TCommandHandler;
     function GetMemorySize: Integer;
-    function GetSource: string;
     procedure SetMemorySize(AValue: Integer);
     procedure SetSource(AValue: string);
     procedure SetState(AValue: TRunState);
-    procedure Write(Value: Byte);
-    function Read: Byte;
     procedure SetThread(State: Boolean);
     procedure PrepareJumpTable;
-    procedure RemoveBlankCharacters;
+    procedure CommandInc;
+    procedure CommandDec;
+    procedure CommandPointerInc;
+    procedure CommandPointerDec;
+    procedure CommandInput;
+    procedure CommandOutput;
+    procedure CommandLoopStart;
+    procedure CommandLoopEnd;
   public
-    FSource: array of Char;
+    FSource: array of TBrainFuckCommand;
     SourceJump: array of Integer;
     SourcePosition: Integer;
@@ -80 +90 @@
     property OnChangeState: TNotifyEvent read FOnChangeState write FOnChangeState;
     property StepCount: Integer read FStepCount;
-    property Source: string read GetSource write SetSource;
+    property Source: string write SetSource;
     property MemorySize: Integer read GetMemorySize write SetMemorySize;
     property CellSize: Integer read FCellSize write FCellSize;
@@ -113 +123 @@
 { TBrainFuckInterpretter }
 
-procedure TBrainFuckInterpretter.Write(Value: Byte);
-begin
-  if OutputPosition > Length(Output) then
-    SetLength(Output, Length(Output) + 1 + Length(Output) div 4);
-  Output[OutputPosition] := Char(Value);
-  Inc(OutputPosition);
-end;
-
 procedure TBrainFuckInterpretter.SetState(AValue: TRunState);
 begin
@@ -128 +130 @@
 end;
 
-function TBrainFuckInterpretter.GetSource: string;
-var
-  I: Integer;
-begin
-  SetLength(Result, Length(FSource));
-  //Move(Pointer(Result)^, Pointer(FSource)^, Length(Result));
-  for I := 0 to Length(FSource) - 1 do
-    Result[I + 1] := FSource[I];
-end;
-
 function TBrainFuckInterpretter.GetMemorySize: Integer;
 begin
@@ -151 +143 @@
 var
   I: Integer;
+  Pos: Integer;
 begin
   SetLength(FSource, Length(AValue));
-  //Move(Pointer(AValue)^, Pointer(FSource)^, Length(AValue));
-  for I := 0 to Length(FSource) - 1 do
-    FSource[I] := AValue[I + 1];
-end;
-
-function TBrainFuckInterpretter.Read: Byte;
-begin
-  while (InputPosition > Length(Input)) and (FState <> rsStopped) do begin
-    Sleep(1);
-  end;
-  if InputPosition <= Length(Input) then begin
-    Result := Ord(Input[InputPosition]);
-    Inc(InputPosition);
-  end else Result := 0;
+  Pos := 0;
+  for I := 1 to Length(AValue) do begin
+    case AValue[I] of
+      '+': FSource[Pos] := cmInc;
+      '-': FSource[Pos] := cmDec;
+      '>': FSource[Pos] := cmPointerInc;
+      '<': FSource[Pos] := cmPointerDec;
+      ',': FSource[Pos] := cmInput;
+      '.': FSource[Pos] := cmOutput;
+      '[': FSource[Pos] := cmLoopStart;
+      ']': FSource[Pos] := cmLoopEnd;
+      else Dec(Pos);
+    end;
+    Inc(Pos);
+  end;
+  SetLength(FSource, Pos);
 end;
 
@@ -186 +181 @@
 var
   Loop: array of Integer;
-  LoopCurrent: Integer;
   I: Integer;
 begin
@@ -196 +190 @@
   for I := 0 to Length(FSource) - 1 do begin
     case FSource[I] of
-      '[': begin
+      cmLoopStart: begin
         SetLength(Loop, Length(Loop) + 1);
         Loop[High(Loop)] := I;
       end;
-      ']': begin
+      cmLoopEnd: begin
         if SourceJump[I] > 0 then raise Exception.Create(SJumpTableColision);
         SourceJump[I] := Loop[High(Loop)];
@@ -212 +206 @@
 end;
 
-procedure TBrainFuckInterpretter.RemoveBlankCharacters;
-var
-  I: Integer;
-  LastChar: Integer;
-begin
-  LastChar := 0;
-  for I := 0 to Length(FSource) - 1 do
-    if FSource[I] in ['+','-','>','<','.',',','[',']'] then begin
-      FSource[LastChar] := FSource[I];
-      Inc(LastChar);
-    end;
-  SetLength(FSource, LastChar);
+procedure TBrainFuckInterpretter.CommandInc;
+begin
+  Memory[MemoryPosition] := ((Memory[MemoryPosition] + 1) mod CellSize);
+end;
+
+procedure TBrainFuckInterpretter.CommandDec;
+begin
+  Memory[MemoryPosition] := ((Memory[MemoryPosition] - 1) mod CellSize);
+end;
+
+procedure TBrainFuckInterpretter.CommandPointerInc;
+begin
+  if MemoryPosition < MemorySize then Inc(MemoryPosition)
+    else raise Exception.Create(SProgramUpperLimit);
+end;
+
+procedure TBrainFuckInterpretter.CommandPointerDec;
+begin
+  if MemoryPosition > 0 then Dec(MemoryPosition)
+    else raise Exception.Create(SProgramLowerLimit);
+end;
+
+procedure TBrainFuckInterpretter.CommandInput;
+begin
+  while (InputPosition > Length(Input)) and (FState <> rsStopped) do begin
+    Sleep(1);
+  end;
+  if InputPosition <= Length(Input) then begin
+    Memory[MemoryPosition] := Ord(Input[InputPosition]);
+    Inc(InputPosition);
+  end;
+end;
+
+procedure TBrainFuckInterpretter.CommandOutput;
+begin
+  if OutputPosition > Length(Output) then
+    SetLength(Output, Length(Output) + 1 + Length(Output) div 4);
+  Output[OutputPosition] := Char(Memory[MemoryPosition]);
+  Inc(OutputPosition);
+end;
+
+procedure TBrainFuckInterpretter.CommandLoopStart;
+begin
+  if Memory[MemoryPosition] = 0 then
+    SourcePosition := SourceJump[SourcePosition];
+end;
+
+procedure TBrainFuckInterpretter.CommandLoopEnd;
+begin
+  if Memory[MemoryPosition] > 0 then
+    SourcePosition := SourceJump[SourcePosition] - 1;
 end;
 
@@ -230 +263 @@
   I: Integer;
 begin
-  RemoveBlankCharacters;
   PrepareJumpTable;
   SourcePosition := 0;
@@ -244 +276 @@
 
 procedure TBrainFuckInterpretter.SingleStep;
-var
-  CodeText: string;
-  C: Integer;
-  NewPos: Integer;
-begin
-  case FSource[SourcePosition] of
-    '>': if MemoryPosition < MemorySize then Inc(MemoryPosition)
-      else raise Exception.Create(SProgramUpperLimit);
-    '<': if MemoryPosition > 0 then Dec(MemoryPosition)
-      else raise Exception.Create(SProgramLowerLimit);
-    '+': Memory[MemoryPosition] := ((Memory[MemoryPosition] + 1) mod CellSize);
-    '-': Memory[MemoryPosition] := ((Memory[MemoryPosition] - 1) mod CellSize);
-    '.': Write(Memory[MemoryPosition]);
-    ',': Memory[MemoryPosition] := Read;
-    '[': begin
-      if Memory[MemoryPosition] = 0 then begin
-        SourcePosition := SourceJump[SourcePosition];
-        (*C := 1;
-        Inc(SourcePosition);
-        while C > 0 do begin
-          case ReadCode of
-            '[': Inc(C);
-            ']': Dec(C);
-          end;
-          Inc(SourcePosition);
-        end;
-        Dec(SourcePosition);*)
-        //if NewPos <> SourcePosition then raise Exception.Create('Wrong pos: ' + IntToStr(SourcePosition) + ' ' + IntToStr(NewPos));
-      end;
-    end;
-    ']': begin
-      if Memory[MemoryPosition] > 0 then begin
-        SourcePosition := SourceJump[SourcePosition] - 1;
-        (*C := 1;
-        Dec(SourcePosition);
-        while C > 0 do begin
-          case ReadCode of
-            ']': Inc(C);
-            '[': Dec(C);
-          end;
-          Dec(SourcePosition);
-        end;
-        if NewPos <> SourcePosition then raise Exception.Create('Wrong pos: ' + IntToStr(SourcePosition) + ' ' + IntToStr(NewPos));
-        *)
-      end;
-    end;
-  end;
+begin
+  FCommandTable[FSource[SourcePosition]];
   Inc(SourcePosition);
   Inc(FStepCount);
@@ -317 +304 @@
   MemorySize := 30000;
   CellSize := 256;
+  FCommandTable[cmInc] := CommandInc;
+  FCommandTable[cmDec] := CommandDec;
+  FCommandTable[cmPointerInc] := CommandPointerInc;
+  FCommandTable[cmPointerDec] := CommandPointerDec;
+  FCommandTable[cmOutput] := CommandOutput;
+  FCommandTable[cmInput] := CommandInput;
+  FCommandTable[cmLoopStart] := CommandLoopStart;
+  FCommandTable[cmLoopEnd] := CommandLoopEnd;
 end;