Ignore:
Timestamp:
Sep 22, 2019, 9:31:49 PM (5 years ago)
Author:
chronos
Message:
  • Modified: All parts of virtual machine have own form in Forms subdirectory.
  • Modified: Main form moved to Forms subdirectory.
  • Modified: TCpu class moved to UCpu unit.
  • Added: Assembler and dissasembler forms.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/virtcpu varint/UMachine.pas

    r196 r197  
    66
    77uses
    8   Classes, SysUtils, UVarInt;
     8  Classes, SysUtils, UVarInt, UCpu, syncobjs;
    99
    1010type
    11 
    12   T = TVarInt;
    13 
    14   TOpcode = (opNop, opLoad, opLoadConst, opNeg,
    15     opJump, opJumpRel,
    16     opInc, opDec,
    17     opLoadMem, opStoreMem,
    18     opAdd, opSub,
    19     opInput, opOutput,
    20     opCall, opCallRel, opRet,
    21     opExchg,
    22     opAnd, opOr, opXor,
    23     opShl, opShr,
    24     opRor, opRol,
    25     opPush, opPop,
    26     opJumpRelCond,
    27     opLdir, opLddr,
    28     opJumpCond, opTestEqual, opTestNotEqual, opTestLess,
    29     opTestLessEqual, opTestGreater, opTestGreaterEqual,
    30     opMul, opDiv, opHalt
    31   );
    32 
    33   TOpcodeHandler = procedure of object;
    34   TInputEvent = function (Port: T): T of object;
    35   TOutputEvent = procedure (Port, Value: T) of object;
    36 
    37   { TCPU }
    38 
    39   TCPU = class(TComponent)
    40   private
    41     FOnInput: TInputEvent;
    42     FOnOutput: TOutputEvent;
    43     OpcodeHandlers: array[TOpcode] of TOpcodeHandler;
    44     function ReadNext: T; inline;
    45     procedure OpcodeNop;
    46     procedure OpcodeHalt;
    47     procedure OpcodeLoad;
    48     procedure OpcodeLoadConst;
    49     procedure OpcodeJump;
    50     procedure OpcodeJumpRel;
    51     procedure OpcodeNeg;
    52     procedure OpcodeInc;
    53     procedure OpcodeDec;
    54     procedure OpcodeLoadMem;
    55     procedure OpcodeStoreMem;
    56     procedure OpcodeExchange;
    57     procedure OpcodeTestEqual;
    58     procedure OpcodeTestNotEqual;
    59     procedure OpcodeTestGreatEqual;
    60     procedure OpcodeTestGreat;
    61     procedure OpcodeTestLessEqual;
    62     procedure OpcodeTestLess;
    63     procedure OpcodeJumpCond;
    64     procedure OpcodeJumpRelCond;
    65     procedure OpcodeShl;
    66     procedure OpcodeShr;
    67     procedure OpcodeRor;
    68     procedure OpcodeRol;
    69     procedure OpcodeAnd;
    70     procedure OpcodeOr;
    71     procedure OpcodeXor;
    72     procedure OpcodePush;
    73     procedure OpcodePop;
    74     procedure OpcodeCall;
    75     procedure OpcodeReturn;
    76     procedure OpcodeCallRel;
    77     procedure OpcodeOutput;
    78     procedure OpcodeInput;
    79     procedure OpcodeAdd;
    80     procedure OpcodeSub;
    81     procedure OpcodeMul;
    82     procedure OpcodeDiv;
    83     procedure OpcodeLdir;
    84     procedure OpcodeLddr;
    85   public
    86     Memory: Pointer;
    87     Registers: array of T;
    88     IP: T;
    89     SP: T;
    90     Condition: Boolean;
    91     Terminated: Boolean;
    92     Ticks: Integer;
    93     procedure Start;
    94     procedure Stop;
    95     procedure Step; inline;
    96     constructor Create(AOwner: TComponent); override;
    97   published
    98     property OnInput: TInputEvent read FOnInput write FOnInput;
    99     property OnOutput: TOutputEvent read FOnOutput write FOnOutput;
     11  TScreen = class
     12    Size: TPoint;
     13    MemoryBase: Integer;
     14    MemorySize: Integer;
     15    ChangedAreaFrom: Integer;
     16    ChangedAreaTo: Integer;
    10017  end;
    10118
    … …  
    10623    FMemorySize: Integer;
    10724    procedure SetMemorySize(AValue: Integer);
     25    function CpuInput(Port: T): T;
     26    procedure CpuOutput(Port: T; Value: T);
    10827  public
    10928    Cpu: TCpu;
    11029    Memory: Pointer;
     30    Screen: TScreen;
     31    InputBuffer: string;
     32    OutputBuffer: string;
     33    LockInput: TCriticalSection;
     34    LockOutput: TCriticalSection;
    11135    property MemorySize: Integer read FMemorySize write SetMemorySize;
    11236    constructor Create(AOwner: TComponent); override;
    … …  
    12549  Memory := ReAllocMem(Memory, FMemorySize);
    12650  Cpu.Memory := Memory;
     51  Cpu.OnOutput := CpuOutput;
     52  Cpu.OnInput := CpuInput;
     53end;
     54
     55function TMachine.CpuInput(Port: T): T;
     56begin
     57  Result := 0;
     58  case Integer(Port) of
     59    0: begin
     60      LockInput.Acquire;
     61      while (Length(InputBuffer) = 0) and not Cpu.Terminated do begin
     62        LockInput.Release;
     63        Sleep(100);
     64        LockInput.Acquire;
     65      end;
     66      if Length(InputBuffer) > 0 then begin
     67        Result := Ord(InputBuffer[1]);
     68        Delete(InputBuffer, 1, 1);
     69      end else Result := 0;
     70      LockInput.Release;
     71    end;
     72    1: Result := Screen.Size.X;
     73    2: Result := Screen.Size.Y;
     74    3: Result := Screen.MemoryBase;
     75  end;
     76end;
     77
     78procedure TMachine.CpuOutput(Port: T; Value: T);
     79begin
     80  case Integer(Port) of
     81    0: begin
     82      LockOutput.Acquire;
     83      OutputBuffer := OutputBuffer + Char(Value);
     84      LockOutput.Release;
     85    end;
     86    1: Screen.Size.X := Value;
     87    2: Screen.Size.Y := Value;
     88    3: Screen.MemoryBase := Value;
     89    4: Screen.ChangedAreaFrom := Value;
     90    5: Screen.ChangedAreaTo := Value;
     91  end;
    12792end;
    12893
    … …  
    13095begin
    13196  inherited;
     97  LockInput := TCriticalSection.Create;
     98  LockOutput := TCriticalSection.Create;
    13299  Cpu := TCpu.Create(nil);
    133100  MemorySize := 1000;
     101  Screen := TScreen.Create;
     102  Screen.Size := Point(320, 240);
     103  Screen.MemoryBase := $200;
    134104end;
    135105
    … …  
    137107begin
    138108  MemorySize := 0;
     109  FreeAndNil(Screen);
    139110  FreeAndNil(Cpu);
    140111  inherited Destroy;
    141112end;
    142113
    143 { TCPU }
    144 
    145 function TCPU.ReadNext: T;
    146 begin
    147   IP := IP + Result.ReadFromAddr(Pointer(NativeUInt(Memory) + IP));
    148 end;
    149 
    150 procedure TCPU.OpcodeHalt;
    151 begin
    152   Terminated := True;
    153 end;
    154 
    155 procedure TCPU.OpcodeNop;
    156 begin
    157   // Do nothing
    158 end;
    159 
    160 procedure TCPU.OpcodeLoad;
    161 var
    162   P1: T;
    163   P2: T;
    164 begin
    165   P1 := ReadNext;
    166   P2 := ReadNext;
    167   Registers[P1] := Registers[P2];
    168 end;
    169 
    170 procedure TCPU.OpcodeLoadConst;
    171 var
    172   P1: T;
    173   P2: T;
    174 begin
    175   P1 := ReadNext;
    176   P2 := ReadNext;
    177   Registers[P1] := P2;
    178 end;
    179 
    180 procedure TCPU.OpcodeLoadMem;
    181 var
    182   P1: T;
    183   P2: T;
    184 begin
    185   P1 := ReadNext;
    186   P2 := ReadNext;
    187   Registers[P1].ReadFromAddr(Pointer(NativeUInt(Memory) + Integer(Registers[P2])));
    188 end;
    189 
    190 procedure TCPU.OpcodeStoreMem;
    191 var
    192   P1: T;
    193   P2: T;
    194 begin
    195   P1 := ReadNext;
    196   P2 := ReadNext;
    197   Registers[P2].WriteToAddr(Pointer(NativeUInt(Memory) + Registers[P1]));
    198 end;
    199 
    200 procedure TCPU.OpcodeNeg;
    201 var
    202   P1: T;
    203 begin
    204   P1 := ReadNext;
    205   Registers[P1] := -Registers[P1];
    206 end;
    207 
    208 procedure TCPU.OpcodeExchange;
    209 var
    210   P1, P2, Temp: T;
    211 begin
    212   P1 := ReadNext;
    213   P2 := ReadNext;
    214   Temp := Registers[P1];
    215   Registers[P1] := Registers[P2];
    216   Registers[P2] := Temp;
    217 end;
    218 
    219 procedure TCPU.OpcodeJump;
    220 begin
    221   IP := ReadNext;
    222 end;
    223 
    224 procedure TCPU.OpcodeJumpRel;
    225 begin
    226   IP := IP + ReadNext;
    227 end;
    228 
    229 procedure TCPU.OpcodeTestEqual;
    230 begin
    231   Condition := ReadNext = ReadNext;
    232 end;
    233 
    234 procedure TCPU.OpcodeTestNotEqual;
    235 begin
    236   Condition := ReadNext <> ReadNext;
    237 end;
    238 
    239 procedure TCPU.OpcodeTestGreatEqual;
    240 begin
    241   Condition := ReadNext >= ReadNext;
    242 end;
    243 
    244 procedure TCPU.OpcodeTestGreat;
    245 begin
    246   Condition := ReadNext > ReadNext;
    247 end;
    248 
    249 procedure TCPU.OpcodeTestLessEqual;
    250 begin
    251   Condition := ReadNext <= ReadNext;
    252 end;
    253 
    254 procedure TCPU.OpcodeTestLess;
    255 begin
    256   Condition := ReadNext < ReadNext;
    257 end;
    258 
    259 procedure TCPU.OpcodeJumpCond;
    260 var
    261   Addr: T;
    262 begin
    263   Addr := ReadNext;
    264   if Condition then IP := Addr;
    265 end;
    266 
    267 
    268 procedure TCPU.OpcodeJumpRelCond;
    269 var
    270   Addr: T;
    271 begin
    272   Addr := ReadNext;
    273   if Condition then IP := IP + Addr;
    274 end;
    275 
    276 procedure TCPU.OpcodeRor;
    277 var
    278   P1, P2: T;
    279 begin
    280   P1 := ReadNext;
    281   P2 := ReadNext;
    282   Registers[P1] := (Registers[P1] shr Registers[P2]) or
    283     ((Registers[P1] and ((1 shl Registers[P2]) - 1)) shl (SizeOf(T) * 8 - Registers[P2]));
    284 end;
    285 
    286 procedure TCPU.OpcodeRol;
    287 var
    288   P1, P2: T;
    289 begin
    290   P1 := ReadNext;
    291   P2 := ReadNext;
    292   Registers[P1] := (Registers[P1] shl Registers[P2]) or
    293     ((Registers[P1] shr (SizeOf(T) * 8 - Registers[P2])) and ((1 shl Registers[P2]) - 1));
    294 end;
    295 
    296 procedure TCPU.OpcodeShl;
    297 var
    298   P1, P2: T;
    299 begin
    300   P1 := ReadNext;
    301   P2 := ReadNext;
    302   Registers[P1] := Registers[P1] shl Registers[P2];
    303 end;
    304 
    305 procedure TCPU.OpcodeShr;
    306 var
    307   P1, P2: T;
    308 begin
    309   P1 := ReadNext;
    310   P2 := ReadNext;
    311   Registers[P1] := Registers[P1] shr Registers[P2];
    312 end;
    313 
    314 procedure TCPU.OpcodeAnd;
    315 var
    316   P1, P2: T;
    317 begin
    318   P1 := ReadNext;
    319   P2 := ReadNext;
    320   Registers[P1] := Registers[P1] and Registers[P2];
    321 end;
    322 
    323 procedure TCPU.OpcodeOr;
    324 var
    325   P1, P2: T;
    326 begin
    327   P1 := ReadNext;
    328   P2 := ReadNext;
    329   Registers[P1] := Registers[P1] or Registers[P2];
    330 end;
    331 
    332 procedure TCPU.OpcodeXor;
    333 var
    334   P1, P2: T;
    335 begin
    336   P1 := ReadNext;
    337   P2 := ReadNext;
    338   Registers[P1] := Registers[P1] xor Registers[P2];
    339 end;
    340 
    341 procedure TCPU.OpcodePush;
    342 var
    343   P1: T;
    344 begin
    345   P1 := ReadNext;
    346   SP := SP - Registers[P1].GetByteSize;
    347   Registers[P1].WriteToAddr(Pointer(NativeUInt(Memory) + Integer(SP)));
    348 end;
    349 
    350 procedure TCPU.OpcodePop;
    351 begin
    352   SP := SP + Registers[ReadNext].ReadFromAddr(Pointer(NativeUInt(Memory) + Integer(SP)));
    353 end;
    354 
    355 procedure TCPU.OpcodeCall;
    356 var
    357   Addr: T;
    358 begin
    359   Addr := ReadNext;
    360   SP := SP - IP.GetByteSize;
    361   IP.WriteToAddr(Pointer(NativeUInt(Memory) + SP));
    362   IP := Addr;
    363 end;
    364 
    365 procedure TCPU.OpcodeCallRel;
    366 var
    367   Addr: T;
    368 begin
    369   Addr := ReadNext;
    370   SP := SP - IP.GetByteSize;
    371   IP.WriteToAddr(Pointer(NativeUInt(Memory) + SP));
    372   IP := IP + Addr;
    373 end;
    374 
    375 procedure TCPU.OpcodeReturn;
    376 begin
    377   SP := SP + IP.ReadFromAddr(Pointer(NativeUInt(Memory) + SP));
    378 end;
    379 
    380 procedure TCPU.OpcodeOutput;
    381 var
    382   R1: T;
    383   R2: T;
    384 begin
    385   R1 := ReadNext;
    386   R2 := ReadNext;
    387   if Assigned(FOnOutput) then
    388     FOnOutput(Registers[R1], Registers[R2]);
    389 end;
    390 
    391 procedure TCPU.OpcodeInput;
    392 var
    393   R1: T;
    394   R2: T;
    395 begin
    396   R1 := ReadNext;
    397   R2 := ReadNext;
    398   if Assigned(FOnInput) then
    399     Registers[R1] := FOnInput(Registers[R2]);
    400 end;
    401 
    402 procedure TCPU.OpcodeInc;
    403 var
    404   R: T;
    405 begin
    406   R := ReadNext;
    407   Registers[R] := Registers[R] + 1;
    408 end;
    409 
    410 procedure TCPU.OpcodeDec;
    411 var
    412   R: T;
    413 begin
    414   R := ReadNext;
    415   Registers[R] := Registers[R] - 1;
    416 end;
    417 
    418 procedure TCPU.OpcodeAdd;
    419 var
    420   R1: T;
    421   R2: T;
    422 begin
    423   R1 := ReadNext;
    424   R2 := ReadNext;
    425   Registers[R1] := Registers[R1] + Registers[R2];
    426 end;
    427 
    428 procedure TCPU.OpcodeSub;
    429 var
    430   R1: T;
    431   R2: T;
    432 begin
    433   R1 := ReadNext;
    434   R2 := ReadNext;
    435   Registers[R1] := Registers[R1] - Registers[R2];
    436 end;
    437 
    438 procedure TCPU.OpcodeMul;
    439 var
    440   R1: T;
    441   R2: T;
    442 begin
    443   R1 := ReadNext;
    444   R2 := ReadNext;
    445   Registers[R1] := Registers[R1] * Registers[R2];
    446 end;
    447 
    448 procedure TCPU.OpcodeDiv;
    449 var
    450   R1: T;
    451   R2: T;
    452 begin
    453   R1 := ReadNext;
    454   R2 := ReadNext;
    455   Registers[R1] := Registers[R1] div Registers[R2];
    456 end;
    457 
    458 procedure TCPU.OpcodeLdir;
    459 var
    460   Src: T;
    461   Dst: T;
    462   Count: T;
    463   Bytes: T;
    464 begin
    465   Src := ReadNext;
    466   Dst := ReadNext;
    467   Count := ReadNext;
    468   Bytes := ReadNext;
    469   while Registers[Count] > 0 do begin
    470     Move(Pointer(NativeUInt(Memory) + Registers[Src])^,
    471       Pointer(NativeUInt(Memory) + Registers[Dst])^, Bytes);
    472     Inc(Registers[Src], Bytes);
    473     Inc(Registers[Dst], Bytes);
    474     Dec(Registers[Count]);
    475   end;
    476 end;
    477 
    478 procedure TCPU.OpcodeLddr;
    479 var
    480   Src: T;
    481   Dst: T;
    482   Count: T;
    483   Bytes: T;
    484 begin
    485   Src := ReadNext;
    486   Dst := ReadNext;
    487   Count := ReadNext;
    488   Bytes := ReadNext;
    489   while Registers[Count] > 0 do begin
    490     Move(Pointer(NativeUInt(Memory) + Registers[Src])^,
    491       Pointer(NativeUInt(Memory) + Registers[Dst])^, Bytes);
    492     Dec(Registers[Src], Bytes);
    493     Dec(Registers[Dst], Bytes);
    494     Dec(Registers[Count]);
    495   end;
    496 end;
    497 
    498 procedure TCPU.Start;
    499 begin
    500   Terminated := False;
    501   Ticks := 0;
    502   IP := 0;
    503   SP := MemSize(Memory);
    504   while not Terminated do
    505     Step;
    506 end;
    507 
    508 procedure TCPU.Stop;
    509 begin
    510   Terminated := True;
    511 end;
    512 
    513 procedure TCPU.Step;
    514 var
    515   Opcode: T;
    516 begin
    517   Opcode := ReadNext;
    518   if (Opcode >= 0) and (Opcode <= T(Integer(High(TOpcode)))) then
    519     OpcodeHandlers[TOpcode(Byte(Opcode))]
    520     else raise Exception.Create(Format('Unsupported instruction %d on address %x', [Int64(Opcode), Int64(IP)]));
    521   Inc(Ticks);
    522 end;
    523 
    524 constructor TCPU.Create(AOwner: TComponent);
    525 begin
    526   inherited;
    527   SetLength(Registers, 16);
    528   OpcodeHandlers[opNop] := OpcodeNop;
    529   OpcodeHandlers[opHalt] := OpcodeHalt;
    530   OpcodeHandlers[opLoad] := OpcodeLoad;
    531   OpcodeHandlers[opLoadConst] := OpcodeLoadConst;
    532   OpcodeHandlers[opNeg] := OpcodeNeg;
    533   OpcodeHandlers[opJump] := OpcodeJump;
    534   OpcodeHandlers[opInc] := OpcodeInc;
    535   OpcodeHandlers[opDec] := OpcodeDec;
    536   OpcodeHandlers[opJumpRel] := OpcodeJumpRel;
    537   OpcodeHandlers[opLoadMem] := OpcodeLoadMem;
    538   OpcodeHandlers[opStoreMem] := OpcodeStoreMem;
    539   OpcodeHandlers[opExchg] := OpcodeExchange;
    540   OpcodeHandlers[opAnd] := OpcodeAnd;
    541   OpcodeHandlers[opOr] := OpcodeOr;
    542   OpcodeHandlers[opXor] := OpcodeXor;
    543   OpcodeHandlers[opShl] := OpcodeShl;
    544   OpcodeHandlers[opShr] := OpcodeShr;
    545   OpcodeHandlers[opPush] := OpcodePush;
    546   OpcodeHandlers[opPop] := OpcodePop;
    547   OpcodeHandlers[opCall] := OpcodeCall;
    548   OpcodeHandlers[opCallRel] := OpcodeCallRel;
    549   OpcodeHandlers[opRet] := OpcodeReturn;
    550   OpcodeHandlers[opRor] := OpcodeRor;
    551   OpcodeHandlers[opRol] := OpcodeRol;
    552   OpcodeHandlers[opInput] := OpcodeInput;
    553   OpcodeHandlers[opOutput] := OpcodeOutput;
    554   OpcodeHandlers[opAdd] := OpcodeAdd;
    555   OpcodeHandlers[opSub] := OpcodeSub;
    556   OpcodeHandlers[opLdir] := OpcodeLdir;
    557   OpcodeHandlers[opLddr] := OpcodeLddr;
    558   OpcodeHandlers[opJumpCond] := OpcodeJumpCond;
    559   OpcodeHandlers[opJumpRelCond] := OpcodeJumpRelCond;
    560   OpcodeHandlers[opTestEqual] := OpcodeTestEqual;
    561   OpcodeHandlers[opTestNotEqual] := OpcodeTestNotEqual;
    562   OpcodeHandlers[opTestLess] := OpcodeTestLess;
    563   OpcodeHandlers[opTestLessEqual] := OpcodeTestLessEqual;
    564   OpcodeHandlers[opTestGreater] := OpcodeTestGreat;
    565   OpcodeHandlers[opTestGreaterEqual] := OpcodeTestGreatEqual;
    566   OpcodeHandlers[opMul] := OpcodeMul;
    567   OpcodeHandlers[opDiv] := OpcodeDiv;
    568 end;
    569 
    570114end.
    571115
Note: See TracChangeset for help on using the changeset viewer.