Changeset 64 for trunk/UTarget.pas

Timestamp:

Dec 4, 2014, 2:59:28 PM (10 years ago)

Author:

chronos

Message:

• Modified: Now commands cmInc, cmDec, cmPointerInc, cmPointerDec and cmSet use numeric parameter to merge multiple small steps to one unary operation with numeric parameter. Optimization is done on TTarget side and not on each specific targets.
• Added: Optimization to eliminate redundant source code.
• Added: Optimization level option in Options dialog.

File:

• trunk/UTarget.pas (modified) (9 diffs)

trunk/UTarget.pas

@@ -66 +66 @@
   end;
 
-  TBrainFuckCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,
-    cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug);
+  TMachineCommand = (cmNoOperation, cmInc, cmDec, cmPointerInc, cmPointerDec,
+    cmOutput, cmInput, cmLoopStart, cmLoopEnd, cmDebug, cmSet);
+
+  TMachineOperation = record
+    Command: TMachineCommand;
+    Parameter: Integer;
+  end;
 
   TLogEvent = procedure (Lines: TStrings) of object;
@@ -80 +85 @@
     function SourceReadNext: Char;
     function CheckClear: Boolean;
-    function CheckOccurence(C: TBrainFuckCommand): Integer;
+    function CheckOccurenceSumParam(C: TMachineCommand): Integer;
+    function CheckOccurence(C: TMachineCommand): Integer;
+    procedure OptimizeAddSub;
+    procedure OptimizeMerge;
+    procedure OptimizeZeroInitMemory;
   protected
     FSourceCode: string;
-    FProgram: array of TBrainFuckCommand;
+    FProgram: array of TMachineOperation;
     FProgramIndex: Integer;
     FTargetCode: string;
@@ -101 +110 @@
     ProgramName: string;
     ImageIndex: Integer;
-    Optimization: TCompilerOptimization;
+    OptimizationLevel: TCompilerOptimization;
     CompilerPath: string;
     ExecutorPath: string;
@@ -367 +376 @@
 begin
   inherited;
-  Optimization := coNormal;
+  OptimizationLevel := coNormal;
   BreakPoints := TBreakPointList.Create;
   DebugSteps := TDebugStepList.Create;
@@ -387 +396 @@
 
 procedure TTarget.OptimizeSource;
-begin
-  // Remove redundand code
-
+var
+  OldLength: Integer;
+begin
+  OptimizeAddSub;
+  repeat
+    OldLength := Length(FProgram);
+    OptimizeMerge;
+  until Length(FProgram) = OldLength;
+  OptimizeZeroInitMemory;
 end;
 
@@ -395 +410 @@
 begin
   LoadProgram;
+  if OptimizationLevel = coNormal then OptimizeSource;
   Compiled := True;
 end;
@@ -528 +544 @@
 end;
 
-function TTarget.CheckOccurence(C: TBrainFuckCommand): Integer;
+function TTarget.CheckOccurence(C: TMachineCommand): Integer;
 begin
   Result := 1;
-  if Optimization = coNormal then
-  while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1] = C) do begin
+  while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1].Command = C) do begin
     Inc(Result);
     Inc(FProgramIndex);
   end;
+end;
+
+function TTarget.CheckOccurenceSumParam(C: TMachineCommand): Integer;
+begin
+  Result := FProgram[FProgramIndex].Parameter;
+  while ((FProgramIndex + 1) < Length(FProgram)) and (FProgram[FProgramIndex + 1].Command = C) do begin
+    Inc(Result, FProgram[FProgramIndex + 1].Parameter);
+    Inc(FProgramIndex);
+  end;
+end;
+
+procedure TTarget.OptimizeAddSub;
+var
+  NewProgram: array of TMachineOperation;
+  NewProgramIndex: Integer;
+begin
+  NewProgramIndex := 0;
+  SetLength(NewProgram, Length(FProgram));
+
+  FProgramIndex := 0;
+  while (FProgramIndex < Length(FProgram)) do begin
+    case FProgram[FProgramIndex].Command of
+      cmPointerInc: begin
+        NewProgram[NewProgramIndex].Command := cmPointerInc;
+        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmPointerInc);
+      end;
+      cmPointerDec: begin
+        NewProgram[NewProgramIndex].Command := cmPointerDec;
+        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmPointerDec);
+      end;
+      cmInc: begin
+        NewProgram[NewProgramIndex].Command := cmInc;
+        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmInc);
+      end;
+      cmDec: begin
+        NewProgram[NewProgramIndex].Command := cmDec;
+        NewProgram[NewProgramIndex].Parameter := CheckOccurenceSumParam(cmDec);
+      end;
+      else begin
+        NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
+        NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
+      end;
+    end;
+    Inc(FProgramIndex);
+    Inc(NewProgramIndex);
+  end;
+  SetLength(NewProgram, NewProgramIndex);
+
+  // Replace old program by new program
+  SetLength(FProgram, Length(NewProgram));
+  Move(NewProgram[0], FProgram[0], SizeOf(TMachineOperation) * Length(NewProgram));
+end;
+
+procedure TTarget.OptimizeMerge;
+var
+  NewProgram: array of TMachineOperation;
+  NewProgramIndex: Integer;
+  PreviousCommand: TMachineCommand;
+begin
+  // Merge together cmInc, cmDec, cmSet
+  // Merge together cmPointerInc, cmPointerDec
+  PreviousCommand := cmNoOperation;
+  NewProgramIndex := 0;
+  SetLength(NewProgram, Length(FProgram));
+
+  FProgramIndex := 0;
+  while (FProgramIndex < Length(FProgram)) do begin
+    case FProgram[FProgramIndex].Command of
+      cmPointerInc: begin
+        if PreviousCommand in [cmPointerInc, cmPointerDec] then begin
+          if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
+            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
+              FProgram[FProgramIndex].Parameter
+          else if NewProgram[NewProgramIndex - 1].Command = cmPointerDec then
+            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
+              FProgram[FProgramIndex].Parameter;
+          // If value negative then change command
+          if NewProgram[NewProgramIndex - 1].Parameter < 0 then begin
+            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
+            if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
+              NewProgram[NewProgramIndex - 1].Command := cmPointerDec
+              else NewProgram[NewProgramIndex - 1].Command := cmPointerInc;
+          end;
+          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
+          Dec(NewProgramIndex);
+        end else begin
+          NewProgram[NewProgramIndex].Command := cmPointerInc;
+          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
+        end;
+      end;
+      cmPointerDec: begin
+        if PreviousCommand in [cmPointerInc, cmPointerDec] then begin
+          if NewProgram[NewProgramIndex - 1].Command = cmPointerDec then
+            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
+              FProgram[FProgramIndex].Parameter
+          else if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
+            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
+              FProgram[FProgramIndex].Parameter;
+          // If value negative then change command
+          if NewProgram[NewProgramIndex - 1].Parameter < 0 then begin
+            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
+            if NewProgram[NewProgramIndex - 1].Command = cmPointerInc then
+              NewProgram[NewProgramIndex - 1].Command := cmPointerDec
+              else NewProgram[NewProgramIndex - 1].Command := cmPointerInc;
+          end;
+          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
+          Dec(NewProgramIndex);
+        end else begin
+          NewProgram[NewProgramIndex].Command := cmPointerDec;
+          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
+        end;
+      end;
+      cmInc: begin
+        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
+          if NewProgram[NewProgramIndex - 1].Command in [cmInc, cmSet] then
+            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
+              FProgram[FProgramIndex].Parameter
+          else if NewProgram[NewProgramIndex - 1].Command = cmDec then
+            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
+              FProgram[FProgramIndex].Parameter;
+          // If value negative then change command
+          if (NewProgram[NewProgramIndex - 1].Parameter < 0) and (NewProgram[NewProgramIndex - 1].Command <> cmSet) then begin
+            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
+            if NewProgram[NewProgramIndex - 1].Command = cmInc then
+              NewProgram[NewProgramIndex - 1].Command := cmDec
+              else NewProgram[NewProgramIndex - 1].Command := cmInc;
+          end;
+          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
+          Dec(NewProgramIndex);
+        end else begin
+          NewProgram[NewProgramIndex].Command := cmInc;
+          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
+        end;
+      end;
+      cmDec: begin
+        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
+          if NewProgram[NewProgramIndex - 1].Command = cmDec then
+            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter +
+              FProgram[FProgramIndex].Parameter
+          else if NewProgram[NewProgramIndex - 1].Command in [cmInc, cmSet] then
+            NewProgram[NewProgramIndex - 1].Parameter := NewProgram[NewProgramIndex - 1].Parameter -
+              FProgram[FProgramIndex].Parameter;
+          // If value negative then change command
+          if (NewProgram[NewProgramIndex - 1].Parameter < 0) and (NewProgram[NewProgramIndex - 1].Command <> cmSet) then begin
+            NewProgram[NewProgramIndex - 1].Parameter := -NewProgram[NewProgramIndex - 1].Parameter;
+            if NewProgram[NewProgramIndex - 1].Command = cmInc then
+              NewProgram[NewProgramIndex - 1].Command := cmDec
+              else NewProgram[NewProgramIndex - 1].Command := cmInc;
+          end;
+          if NewProgram[NewProgramIndex - 1].Parameter = 0 then Dec(NewProgramIndex);
+          Dec(NewProgramIndex);
+        end else begin
+          NewProgram[NewProgramIndex].Command := cmDec;
+          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
+        end;
+      end;
+      cmSet: begin
+        if PreviousCommand in [cmInc, cmDec, cmSet] then begin
+          // Set overrides value of previous commands
+          Dec(NewProgramIndex);
+          NewProgram[NewProgramIndex].Command := cmSet;
+          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
+        end else begin
+          NewProgram[NewProgramIndex].Command := cmSet;
+          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
+        end;
+      end;
+      cmLoopStart: begin
+        if CheckClear then begin
+          NewProgram[NewProgramIndex].Command := cmSet;
+          NewProgram[NewProgramIndex].Parameter := 0;
+          Inc(FProgramIndex, 2);
+        end else begin
+          NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
+          NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
+        end;
+      end;
+      else begin
+        NewProgram[NewProgramIndex].Command := FProgram[FProgramIndex].Command;
+        NewProgram[NewProgramIndex].Parameter := FProgram[FProgramIndex].Parameter;
+      end;
+    end;
+    PreviousCommand := FProgram[FProgramIndex].Command;
+    Inc(FProgramIndex);
+    Inc(NewProgramIndex);
+  end;
+  SetLength(NewProgram, NewProgramIndex);
+
+  // Replace old program by new program
+  SetLength(FProgram, Length(NewProgram));
+  Move(NewProgram[0], FProgram[0], SizeOf(TMachineOperation) * Length(NewProgram));
+end;
+
+procedure TTarget.OptimizeZeroInitMemory;
+begin
+  // Here optimization related to assumption that initial memory is filled with zeroes
+  // Then code for constants preparation can be translated to cmSet commands
+  // To eliminate also loops for building constants code need to be somehow interpretted partialy
 end;
 
@@ -549 +762 @@
     case FSourceCode[I] of
       '+': begin
-        FProgram[FProgramIndex] := cmInc;
+        FProgram[FProgramIndex].Command := cmInc;
+        FProgram[FProgramIndex].Parameter := 1;
         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
       end;
       '-': begin
-        FProgram[FProgramIndex] := cmDec;
+        FProgram[FProgramIndex].Command := cmDec;
+        FProgram[FProgramIndex].Parameter := 1;
         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
       end;
       '>': begin
-        FProgram[FProgramIndex] := cmPointerInc;
+        FProgram[FProgramIndex].Command := cmPointerInc;
+        FProgram[FProgramIndex].Parameter := 1;
         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
       end;
       '<': begin
-        FProgram[FProgramIndex] := cmPointerDec;
+        FProgram[FProgramIndex].Command := cmPointerDec;
+        FProgram[FProgramIndex].Parameter := 1;
         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
       end;
       ',': begin
-        FProgram[FProgramIndex] := cmInput;
+        FProgram[FProgramIndex].Command := cmInput;
+        FProgram[FProgramIndex].Parameter := 0;
         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
       end;
       '.': begin
-        FProgram[FProgramIndex] := cmOutput;
+        FProgram[FProgramIndex].Command := cmOutput;
+        FProgram[FProgramIndex].Parameter := 0;
         DebugSteps.AddStep(I - 1, FProgramIndex, soNormal);
       end;
       '[': begin
-        FProgram[FProgramIndex] := cmLoopStart;
+        FProgram[FProgramIndex].Command := cmLoopStart;
+        FProgram[FProgramIndex].Parameter := 0;
         DebugSteps.AddStep(I - 1, FProgramIndex, soStepIn);
       end;
       ']': begin
-        FProgram[FProgramIndex] := cmLoopEnd;
+        FProgram[FProgramIndex].Command := cmLoopEnd;
+        FProgram[FProgramIndex].Parameter := 0;
         DebugSteps.AddStep(I - 1, FProgramIndex, soStepOut);
       end
@@ -594 +815 @@
 function TTarget.CheckClear: Boolean;
 begin
-  Result := (FProgram[FProgramIndex] = cmLoopStart) and (Length(FProgram) >= FProgramIndex + 2) and
-    (FProgram[FProgramIndex + 1] = cmDec) and (FProgram[FProgramIndex + 2] = cmLoopEnd);
+  Result := (FProgram[FProgramIndex].Command = cmLoopStart) and (Length(FProgram) >= FProgramIndex + 2) and
+    (((FProgram[FProgramIndex + 1].Command = cmDec) and (FProgram[FProgramIndex + 1].Parameter = 1)) or
+    ((FProgram[FProgramIndex + 1].Command = cmInc) and (FProgram[FProgramIndex + 1].Parameter = -1)))
+    and (FProgram[FProgramIndex + 2].Command = cmLoopEnd);
 end;