API tools faq
paste
Advertisement
WarPie90

Untitled

WarPie90
Feb 2nd, 2025
38
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 8.52 KB | None | 0 0
raw download clone embed print report
  1. unit xprInterpreter;
  2. {
  3.   Author: Jarl K. Holta  
  4.   License: GNU Lesser GPL (http://www.gnu.org/licenses/lgpl.html)
  5. }
  6. {$I header.inc}
  7. {$hints off}
  8.  
  9. interface
  10.  
  11. uses
  12.   SysUtils, xprTypes, xprBytecode, xprErrors;
  13.  
  14. type
  15.   TStack64k = array [0..$FFFF] of record
  16.     case Byte of
  17.       1: (b: Boolean;);
  18.       2: (f: Double;);
  19.       3: (i: Int64; );
  20.   end;
  21.  
  22.   TConst64k = array [0..$FFFF] of TConstant;
  23.  
  24.  
  25.   TInterpreter = record
  26.     Bytecode: TByteCode;
  27.     FProgram: Pointer;
  28.  
  29.     FStack: TStack64k;
  30.     FConst: TConst64k;
  31.  
  32.     procedure Compile(BC: TBytecode);
  33.   end;
  34.  
  35.  
  36. implementation
  37.  
  38. uses
  39.   Math;
  40.  
  41. {$DEFINE COPY_CODE_RESULT :=
  42.   if Op.Args[2].Typ in XprFloatTypes then
  43.   begin
  44.     if (Op.Args[0].Pos = EMemPos.mpUnalloc)      and (Op.Args[1].Pos = EMemPos.mpUnalloc) then
  45.       Result := GetCode(@f_stack_stack, @f_stack_const)
  46.     else if (Op.Args[0].Pos = EMemPos.mpUnalloc) and (Op.Args[1].Pos = EMemPos.mpTable) then
  47.       Result := GetCode(@f_stack_const, @f_const_stack)
  48.     else if (Op.Args[0].Pos = EMemPos.mpTable)   and (Op.Args[1].Pos = EMemPos.mpUnalloc) then
  49.       Result := GetCode(@f_const_stack, @body);
  50.   end else
  51.   begin
  52.     if (Op.Args[0].Pos = EMemPos.mpUnalloc)      and (Op.Args[1].Pos = EMemPos.mpUnalloc) then
  53.       Result := GetCode(@i_stack_stack, @i_stack_const)
  54.     else if (Op.Args[0].Pos = EMemPos.mpUnalloc) and (Op.Args[1].Pos = EMemPos.mpTable) then
  55.       Result := GetCode(@i_stack_const, @i_const_stack)
  56.     else if (Op.Args[0].Pos = EMemPos.mpTable)   and (Op.Args[1].Pos = EMemPos.mpUnalloc) then
  57.       Result := GetCode(@i_const_stack, @f_stack_stack);
  58.   end
  59. }
  60.  
  61. {$DEFINE COPY_CODE_RESULT_ASGN :=
  62.   if Op.Args[2].Typ in XprFloatTypes then
  63.   begin
  64.     if      (Op.Args[1].Pos = EMemPos.mpUnalloc) then Result := GetCode(@f_stack_stack, @f_stack_const)
  65.     else if (Op.Args[1].Pos = EMemPos.mpTable) then   Result := GetCode(@f_stack_const, @i_stack_stack)
  66.   end else
  67.   begin
  68.     if      (Op.Args[1].Pos = EMemPos.mpUnalloc) then Result := GetCode(@i_stack_stack, @i_stack_const)
  69.     else if (Op.Args[1].Pos = EMemPos.mpTable)   then Result := GetCode(@i_stack_const, @body)
  70.   end
  71. }
  72.  
  73. function GetCode(start, stop: Pointer): TBytes;
  74. var sz: SizeInt;
  75. begin
  76.   sz := PtrUInt(stop) - PtrUInt(start);
  77.   SetLength(Result, sz);
  78.   Move(start^, Result[0], sz);
  79. end;
  80.  
  81. function Get_MUL_Code(var FStack: TStack64k; var FConst: TConst64k; const Op: TInstruction): TBytes;
  82. label i_stack_stack, i_stack_const, i_const_stack, f_stack_stack, f_stack_const, f_const_stack, body;
  83. begin
  84.   goto body;
  85.   i_stack_stack: FStack[Op.Args[2].Arg].i := FStack[Op.Args[0].Arg].i * FStack[Op.Args[1].Arg].i;
  86.   i_stack_const: FStack[Op.Args[2].Arg].i := FStack[Op.Args[0].Arg].i * FConst[Op.Args[1].Arg].i;
  87.   i_const_stack: FStack[Op.Args[2].Arg].i := FConst[Op.Args[0].Arg].i * FStack[Op.Args[1].Arg].i;
  88.   f_stack_stack: FStack[Op.Args[2].Arg].f := FStack[Op.Args[0].Arg].f * FStack[Op.Args[1].Arg].f;
  89.   f_stack_const: FStack[Op.Args[2].Arg].f := FStack[Op.Args[0].Arg].f * FConst[Op.Args[1].Arg].f;
  90.   f_const_stack: FStack[Op.Args[2].Arg].f := FConst[Op.Args[0].Arg].f * FStack[Op.Args[1].Arg].f;
  91.   body:
  92.   COPY_CODE_RESULT;
  93. end;
  94.  
  95.  
  96. function Get_EQ_Code(var FStack: TStack64k; var FConst: TConst64k; const Op: TInstruction): TBytes;
  97. label i_stack_stack, i_stack_const, i_const_stack, f_stack_stack, f_stack_const, f_const_stack, body;
  98. begin
  99.   goto body;
  100.   i_stack_stack: FStack[Op.Args[2].Arg].b := FStack[Op.Args[0].Arg].i = FStack[Op.Args[1].Arg].i;
  101.   i_stack_const: FStack[Op.Args[2].Arg].b := FStack[Op.Args[0].Arg].i = FConst[Op.Args[1].Arg].i;
  102.   i_const_stack: FStack[Op.Args[2].Arg].b := FConst[Op.Args[0].Arg].i = FStack[Op.Args[1].Arg].i;
  103.   f_stack_stack: FStack[Op.Args[2].Arg].b := FStack[Op.Args[0].Arg].f = FStack[Op.Args[1].Arg].f;
  104.   f_stack_const: FStack[Op.Args[2].Arg].b := FStack[Op.Args[0].Arg].f = FConst[Op.Args[1].Arg].f;
  105.   f_const_stack: FStack[Op.Args[2].Arg].b := FConst[Op.Args[0].Arg].f = FStack[Op.Args[1].Arg].f;
  106.   body:
  107.   COPY_CODE_RESULT;
  108. end;
  109.  
  110. function Get_LTE_Code(var FStack: TStack64k; var FConst: TConst64k; const Op: TInstruction): TBytes;
  111. label i_stack_stack, i_stack_const, i_const_stack, f_stack_stack, f_stack_const, f_const_stack, body;
  112. begin
  113.   goto body;
  114.   i_stack_stack: FStack[Op.Args[2].Arg].b := FStack[Op.Args[0].Arg].i <= FStack[Op.Args[1].Arg].i;
  115.   i_stack_const: FStack[Op.Args[2].Arg].b := FStack[Op.Args[0].Arg].i <= FConst[Op.Args[1].Arg].i;
  116.   i_const_stack: FStack[Op.Args[2].Arg].b := FConst[Op.Args[0].Arg].i <= FStack[Op.Args[1].Arg].i;
  117.   f_stack_stack: FStack[Op.Args[2].Arg].b := FStack[Op.Args[0].Arg].f <= FStack[Op.Args[1].Arg].f;
  118.   f_stack_const: FStack[Op.Args[2].Arg].b := FStack[Op.Args[0].Arg].f <= FConst[Op.Args[1].Arg].f;
  119.   f_const_stack: FStack[Op.Args[2].Arg].b := FConst[Op.Args[0].Arg].f <= FStack[Op.Args[1].Arg].f;
  120.   body:
  121.   COPY_CODE_RESULT;
  122. end;
  123.  
  124.  
  125. function Get_ASGN_Code(var FStack: TStack64k; var FConst: TConst64k; const Op: TInstruction): TBytes;
  126. label i_stack_stack, i_stack_const, f_stack_stack, f_stack_const, body;
  127. begin
  128.   goto body;
  129.   i_stack_stack: FStack[Op.Args[0].Arg].i := FStack[Op.Args[1].Arg].i;
  130.   i_stack_const: FStack[Op.Args[0].Arg].i := FConst[Op.Args[1].Arg].i;
  131.   f_stack_stack: FStack[Op.Args[0].Arg].f := FStack[Op.Args[1].Arg].f;
  132.   f_stack_const: FStack[Op.Args[0].Arg].f := FConst[Op.Args[1].Arg].f;
  133.   body:
  134.   COPY_CODE_RESULT_ASGN;
  135. end;
  136.  
  137. function Get_LADD_Code(var FStack: TStack64k; var FConst: TConst64k; const Op: TInstruction): TBytes;
  138. label i_stack_stack, i_stack_const, f_stack_stack, f_stack_const, body;
  139. begin
  140.   goto body;
  141.   i_stack_stack: FStack[Op.Args[0].Arg].i += FStack[Op.Args[1].Arg].i;
  142.   i_stack_const: FStack[Op.Args[0].Arg].i += FConst[Op.Args[1].Arg].i;
  143.   f_stack_stack: FStack[Op.Args[0].Arg].f += FStack[Op.Args[1].Arg].f;
  144.   f_stack_const: FStack[Op.Args[0].Arg].f += FConst[Op.Args[1].Arg].f;
  145.   body:
  146.   COPY_CODE_RESULT_ASGN;
  147. end;
  148.  
  149. function Get_LSUB_Code(var FStack: TStack64k; var FConst: TConst64k; const Op: TInstruction): TBytes;
  150. label i_stack_stack, i_stack_const, f_stack_stack, f_stack_const, body;
  151. begin
  152.   goto body;
  153.   i_stack_stack: FStack[Op.Args[0].Arg].i -= FStack[Op.Args[1].Arg].i;
  154.   i_stack_const: FStack[Op.Args[0].Arg].i -= FConst[Op.Args[1].Arg].i;
  155.   f_stack_stack: FStack[Op.Args[0].Arg].f -= FStack[Op.Args[1].Arg].f;
  156.   f_stack_const: FStack[Op.Args[0].Arg].f -= FConst[Op.Args[1].Arg].f;
  157.   body:
  158.   COPY_CODE_RESULT_ASGN;
  159. end;
  160.  
  161.  
  162. procedure TInterpreter.Compile(BC: TByteCode): TByteCode;
  163. var
  164.   i,j: Int32;
  165.   jumps: array of record From, Goal:PtrUInt; machineGoal: PtrUInt; end;
  166.   compiled, code: TBytes;
  167.   jmp: record From, Goal:PtrUInt; machineGoal: PtrUInt; end;
  168.  
  169.   procedure AddJump(From, Goal: PtrUInt);
  170.   begin
  171.     SetLength(jumps, Length(jumps)+1);
  172.     jumps[High(jumps)].From := From;
  173.     jumps[High(jumps)].Goal := Goal;
  174.   end;
  175. var
  176.   raw: TBytes;
  177. begin
  178.   Self.Bytecode := BC;
  179.   Move(BC.Constants.Data[0], Self.FConst[0], (BC.Constants.High+1)*SizeOf(TConstant));
  180.   FillByte(Self.FStack, $FFFF*SizeOf(Int64), 0);
  181.  
  182.   for i:=0 to bc.Code.High do
  183.   begin
  184.     if bc.Code.data[i].Code = bcRELJMP then AddJump(i, i+bc.Code.data[i].Args[0].Arg);
  185.     if bc.Code.data[i].Code = bcJZ     then AddJump(i, bc.Code.data[i].Args[1].Arg);
  186.     if bc.Code.data[i].Code = bcJNZ    then AddJump(i, bc.Code.data[i].Args[1].Arg);
  187.   end;
  188.  
  189.   for i:=0 to bc.Code.High do
  190.   begin
  191.     // patch location
  192.     for j:=0 to High(jumps) do
  193.     begin
  194.       if jumps[j].Goal = i then jumps[j].machineGoal := Length(Result);
  195.       if jumps[j].From = i then jmp := jumps[i];
  196.     end;
  197.  
  198.     if bc.Code.Data[i].Code in [bcJZ, bcRELJMP, RETURN] then
  199.     begin
  200.       // compiled code is moved to special opcode
  201.       // Result.Append(Opcode(bcExecutableMem, pointer_to_exec_mem);
  202.       // where pointer_to_exec_mem is VirtualAlloc from the current compiled snippet
  203.       // reset "compiled"
  204.       // Result.Append(bc.Code.Data[i]);
  205.     end
  206.     else
  207.     begin
  208.       case bc.Code.Data[i].Code of
  209.         bcASGN: code := Get_ASGN_Code(Self.FStack, Self.FConst, bc.Code.data[i]);
  210.         bcLADD: code := Get_LADD_Code(Self.FStack, Self.FConst, bc.Code.data[i]);
  211.         bcLSUB: code := Get_LSUB_Code(Self.FStack, Self.FConst, bc.Code.data[i]);
  212.  
  213.         bcLTE:  code := Get_LTE_Code(Self.FStack, Self.FConst, bc.Code.data[i]);
  214.         bcEQ:   code := Get_EQ_Code (Self.FStack, Self.FConst, bc.Code.data[i]);
  215.         bcMUL:  code := Get_MUL_Code(Self.FStack, Self.FConst, bc.Code.data[i]);
  216.       end;
  217.       //add code to the final compiled .. compiled.Extend(code)
  218.     end;
  219.   end;
  220. end;
  221.  
  222.  
  223.  
  224. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!