Changeset 171 for branches/virtualcpu4


Ignore:
Timestamp:
Apr 10, 2019, 4:00:46 PM (6 years ago)
Author:
chronos
Message:
  • Added: Keyboard console.
  • Added: Show Hello World! message.
Location:
branches/virtualcpu4
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • branches/virtualcpu4/UCpu.pas

    r170 r171  
    1313    opCall, opRet, opAdd, opAddc, opSub, opSubc, opInc, opDec, opIn, opOut, opShl,
    1414    opShr, opDataPrefix8, opDataPrefix16, opDataPrefix32, opDataPrefix64,
    15     opDataSize, opAddrSize);
     15    opDataSize, opAddrSize, opTest);
    1616  TAddress = QWord;
    1717  PAddress = ^TAddress;
    … …  
    5353    procedure InstJumpNotZero;
    5454    procedure InstJumpRel;
     55    procedure InstTest;
    5556    procedure InstNeg;
    5657    procedure InstClear;
    … …  
    7778    procedure InstDataSize;
    7879    procedure InstAddrSize;
     80    procedure InitInstructions;
    7981  public
    8082    Memory: array of Byte;
    … …  
    9395    function Read32: DWord; inline;
    9496    function Read64: QWord; inline;
     97    function ReadAddress: TAddress; inline;
    9598    constructor Create;
    9699    property Ticks: Integer read FTicks;
    … …  
    167170end;
    168171
     172procedure TCpu.InstTest;
     173var
     174  Reg: Byte;
     175begin
     176  Reg := Read8;
     177  case DataSize of
     178    bw8: Z := Registers[Reg].B = 0;
     179    bw16: Z := Registers[Reg].W = 0;
     180    bw32: Z := Registers[Reg].D = 0;
     181    bw64: Z := Registers[Reg].Q = 0;
     182  end;
     183end;
     184
    169185procedure TCpu.InstNeg;
    170186var
    171   Reg: Integer;
     187  Reg: Byte;
    172188begin
    173189  Reg := Read8;
    … …  
    428444procedure TCpu.InstIn;
    429445var
    430   R: Integer;
    431   Port: Integer;
     446  R: Byte;
     447  Port: TAddress;
    432448begin
    433449  R := Read8;
    434   Port := Read8;
     450  Port := ReadAddress;
    435451  case DataSize of
    436452    bw8: begin
    … …  
    455471procedure TCpu.InstOut;
    456472var
    457   R: Integer;
     473  R: Byte;
    458474  Port: TAddress;
    459475  Value: TRegister;
    460476begin
     477  Port := ReadAddress;
    461478  R := Read8;
    462   Port := Read8;
    463479  case DataSize of
    464480    bw8: begin
    … …  
    541557end;
    542558
    543 procedure TCpu.Run;
    544 begin
    545   Terminated := False;
    546   FTicks := 0;
    547   DataSizeLast := bwNone;
    548   IP := 0;
    549   SP := Length(Memory);
    550   while not Terminated do
    551     Step;
    552 end;
    553 
    554 procedure TCpu.Step;
    555 var
    556   Opcode: Byte;
    557 begin
    558   if DataSizePrefix <> bwNone then begin
    559     DataSizeLast := DataSize;
    560     DataSize := DataSizePrefix;
    561     DataSizePrefix := bwNone;
    562   end;
    563   Opcode := Read8;
    564   if Opcode < Length(Instructions) then Instructions[TOpcode(Opcode)]
    565     else raise Exception.Create('Unsupported opcode ' + IntToStr(Opcode) + ' at address ' + IntToHex(IP, 8) + '.');
    566   if DataSizeLast <> bwNone then begin
    567     DataSize := DataSizeLast;
    568     DataSizeLast := bwNone;
    569   end;
    570   IP := IP mod Length(Memory);
    571   Inc(FTicks);
    572 end;
    573 
    574 procedure TCpu.Start;
    575 begin
    576   if not Running then begin
    577     Terminated := False;
    578     Thread := TCpuThread.Create(True);
    579     Thread.Cpu := Self;
    580     Thread.Start;
    581     FRunning := True;
    582   end;
    583 end;
    584 
    585 procedure TCpu.Stop;
    586 begin
    587   if Running then begin
    588     Terminated := True;
    589     Thread.Terminate;
    590     Thread.WaitFor;
    591     FreeAndNil(Thread);
    592     FRunning := False;
    593   end;
    594 end;
    595 
    596 function TCpu.Read8: Byte;
    597 begin
    598   Result := Memory[IP];
    599   Inc(IP);
    600 end;
    601 
    602 function TCpu.Read16: Word;
    603 begin
    604   Result := PWord(@Memory[IP])^;
    605   Inc(IP, SizeOf(Word));
    606 end;
    607 
    608 function TCpu.Read32: DWord;
    609 begin
    610   Result := PDWord(@Memory[IP])^;
    611   Inc(IP, SizeOf(DWord));
    612 end;
    613 
    614 function TCpu.Read64: QWord;
    615 begin
    616   Result := PQWord(@Memory[IP])^;
    617   Inc(IP, SizeOf(QWord));
    618 end;
    619 
    620 constructor TCpu.Create;
    621 begin
    622   DataSize := bw16;
    623   AddressSize := bw16;
    624   SetLength(Memory, 1000);
    625   SetLength(Registers, 32);
     559procedure TCpu.InitInstructions;
     560begin
    626561  Instructions[opNop] := InstNop;
    627562  Instructions[opHalt] := InstHalt;
    … …  
    629564  Instructions[opLoadConst] := InstLoadConst;
    630565  Instructions[opJump] := InstJump;
     566  Instructions[opJumpNotZero] := InstJumpNotZero;
     567  Instructions[opJumpZero] := InstJumpZero;
    631568  Instructions[opJumpRel] := InstJumpRel;
    632569  Instructions[opLoadMem] := InstLoadMem;
    … …  
    654591  Instructions[opDataPrefix32] := InstDataPrefix64;
    655592  Instructions[opAddrSize] := InstAddrSize;
     593  Instructions[opTest] := InstTest;
     594end;
     595
     596procedure TCpu.Run;
     597begin
     598  Terminated := False;
     599  FTicks := 0;
     600  DataSizeLast := bwNone;
     601  IP := 0;
     602  SP := Length(Memory);
     603  while not Terminated do
     604    Step;
     605end;
     606
     607procedure TCpu.Step;
     608var
     609  Opcode: Byte;
     610begin
     611  if DataSizePrefix <> bwNone then begin
     612    DataSizeLast := DataSize;
     613    DataSize := DataSizePrefix;
     614    DataSizePrefix := bwNone;
     615  end;
     616  Opcode := Read8;
     617  if Opcode < Length(Instructions) then begin
     618    if Assigned(Instructions[TOpcode(Opcode)]) then Instructions[TOpcode(Opcode)]
     619      else raise Exception.Create('Missing instruction handler for opcode '+ IntToStr(Opcode));
     620  end else raise Exception.Create('Unsupported opcode ' + IntToStr(Opcode) + ' at address ' + IntToHex(IP, 8) + '.');
     621  if DataSizeLast <> bwNone then begin
     622    DataSize := DataSizeLast;
     623    DataSizeLast := bwNone;
     624  end;
     625  IP := IP mod Length(Memory);
     626  Inc(FTicks);
     627end;
     628
     629procedure TCpu.Start;
     630begin
     631  if not Running then begin
     632    Terminated := False;
     633    Thread := TCpuThread.Create(True);
     634    Thread.Cpu := Self;
     635    Thread.Start;
     636    FRunning := True;
     637  end;
     638end;
     639
     640procedure TCpu.Stop;
     641begin
     642  if Running then begin
     643    Terminated := True;
     644    Thread.Terminate;
     645    Thread.WaitFor;
     646    FreeAndNil(Thread);
     647    FRunning := False;
     648  end;
     649end;
     650
     651function TCpu.Read8: Byte;
     652begin
     653  Result := Memory[IP];
     654  Inc(IP);
     655end;
     656
     657function TCpu.Read16: Word;
     658begin
     659  Result := PWord(@Memory[IP])^;
     660  Inc(IP, SizeOf(Word));
     661end;
     662
     663function TCpu.Read32: DWord;
     664begin
     665  Result := PDWord(@Memory[IP])^;
     666  Inc(IP, SizeOf(DWord));
     667end;
     668
     669function TCpu.Read64: QWord;
     670begin
     671  Result := PQWord(@Memory[IP])^;
     672  Inc(IP, SizeOf(QWord));
     673end;
     674
     675function TCpu.ReadAddress: TAddress;
     676begin
     677  case AddressSize of
     678    bw8: Result := Read8;
     679    bw16: Result := Read16;
     680    bw32: Result := Read32;
     681    bw64: Result := Read64;
     682  end;
     683end;
     684
     685constructor TCpu.Create;
     686begin
     687  DataSize := bw16;
     688  AddressSize := bw16;
     689  SetLength(Memory, 1000);
     690  SetLength(Registers, 32);
     691  InitInstructions;
    656692end;
    657693

  • branches/virtualcpu4/UFormMain.lfm

    r170 r171  
    11object FormMain: TFormMain
    2   Left = 384
    3   Height = 613
    4   Top = 219
    5   Width = 1178
     2  Left = 223
     3  Height = 790
     4  Top = 54
     5  Width = 1432
    66  Caption = 'VirtCpu4'
    7   ClientHeight = 613
    8   ClientWidth = 1178
     7  ClientHeight = 790
     8  ClientWidth = 1432
    99  DesignTimePPI = 120
    1010  OnCreate = FormCreate
    … …  
    4040  object ListViewRegisters: TListView
    4141    Left = 8
    42     Height = 592
     42    Height = 769
    4343    Top = 8
    4444    Width = 312
    … …  
    6262  object ListViewMemory: TListView
    6363    Left = 328
    64     Height = 592
     64    Height = 769
    6565    Top = 8
    6666    Width = 648
    … …  
    8282    OnData = ListViewMemoryData
    8383  end
     84  object Memo1: TMemo
     85    Left = 984
     86    Height = 619
     87    Top = 160
     88    Width = 432
     89    OnKeyPress = Memo1KeyPress
     90    ReadOnly = True
     91    TabOrder = 4
     92  end
     93  object Label2: TLabel
     94    Left = 984
     95    Height = 20
     96    Top = 136
     97    Width = 56
     98    Caption = 'Console:'
     99    ParentColor = False
     100  end
    84101  object Timer1: TTimer
    85102    Interval = 200

  • branches/virtualcpu4/UFormMain.pas

    r170 r171  
    11unit UFormMain;
    22
    3 {$mode objfpc}{$H+}
     3{$mode delphi}{$H+}
    44
    55interface
    … …  
    1717    ButtonStop: TButton;
    1818    Label1: TLabel;
     19    Label2: TLabel;
    1920    ListViewMemory: TListView;
    2021    ListViewRegisters: TListView;
     22    Memo1: TMemo;
    2123    Timer1: TTimer;
    2224    procedure ButtonStartClick(Sender: TObject);
    … …  
    2729    procedure ListViewMemoryData(Sender: TObject; Item: TListItem);
    2830    procedure ListViewRegistersData(Sender: TObject; Item: TListItem);
     31    procedure Memo1KeyPress(Sender: TObject; var Key: char);
    2932    procedure Timer1Timer(Sender: TObject);
    3033  private
     34    KeyInputBuffer: array of Char;
     35    function CpuInput(Port: TAddress): TRegister;
     36    procedure CpuOutput(Port: TAddress; Value: TRegister);
    3137    procedure ReloadMemoryDump;
    3238    procedure ReloadRegisterDump;
    … …  
    6268begin
    6369  Cpu := TCpu.Create;
     70  Cpu.OnInput := CpuInput;
     71  Cpu.OnOutput := CpuOutput;
    6472  Cpu.DataSize := bw16;
    6573  Cpu.AddressSize := bw16;
    … …  
    110118end;
    111119
     120procedure TFormMain.Memo1KeyPress(Sender: TObject; var Key: char);
     121begin
     122  SetLength(KeyInputBuffer, Length(KeyInputBuffer) + 1);
     123  KeyInputBuffer[High(KeyInputBuffer)] := Key;
     124end;
     125
    112126procedure TFormMain.Timer1Timer(Sender: TObject);
    113127begin
    … …  
    133147  R1: Byte;
    134148  R2: Byte;
     149  R3: Byte;
    135150  LabelStart: Integer;
     151  LabelText: Integer;
     152  LabelPrint: Integer;
    136153begin
    137154  R1 := 1;
    138155  R2 := 2;
     156  R3 := 3;
    139157  with InstructionWriter do begin
     158    LabelText := 200;
     159    LoadConst(R1, LabelText);
     160    LoadConst(R2, 12);
     161  LabelPrint := IP;
     162    DataPrefix8; LoadMem(R3, R1);
     163    DataPrefix8; Output(0, R3);
     164    Increment(R1);
     165    Decrement(R2);
     166    Test(R2);
     167    JumpNotZero(LabelPrint);
     168
    140169    LoadConst(R1, 100);
     170  LabelStart := IP;
     171    Increment(R1);
    141172    LoadConst(R2, 100);
    142     LabelStart := IP;
    143     Increment(R1);
    144173    DataPrefix8; StoreMem(R2, R1);
     174    DataPrefix8; Input(R2, 0);
     175    DataPrefix8; Output(0, R2);
    145176    Jump(LabelStart);
    146177    Halt;
    147   end;
    148 end;
     178  IP := LabelText;
     179    WriteString('Hello World!');
     180  end;
     181end;
     182
     183function TFormMain.CpuInput(Port: TAddress): TRegister;
     184begin
     185  Result.Q := 0;
     186  case Port of
     187    0: begin
     188      while (Length(KeyInputBuffer) = 0) and not Cpu.Terminated do begin
     189        Sleep(100);
     190      end;
     191      if Length(KeyInputBuffer) > 0 then begin
     192        Result.B := Ord(KeyInputBuffer[0]);
     193        if Length(KeyInputBuffer) > 1 then
     194          Move(KeyInputBuffer[1], KeyInputBuffer[0], Length(KeyInputBuffer) - 1);
     195        SetLength(KeyInputBuffer, Length(KeyInputBuffer) - 1);
     196      end else Result.B := 0;
     197    end;
     198  end;
     199end;
     200
     201procedure TFormMain.CpuOutput(Port: TAddress; Value: TRegister);
     202begin
     203  case Port of
     204    0: Memo1.Lines.Text := Memo1.Lines.Text + Char(Value.B);
     205  end;
     206end;
     207
    149208
    150209

  • branches/virtualcpu4/UInstructionWriter.pas

    r170 r171  
    1919    procedure Write32(Value: DWord);
    2020    procedure Write64(Value: QWord);
     21    procedure WriteAddress(Value: TAddress);
     22    procedure WriteData(Value: QWord);
     23    procedure WriteString(Text: string);
    2124    procedure Nop;
    2225    procedure Halt;
    2326    procedure LoadConst(Reg: Byte; Value: QWord);
    2427    procedure Increment(Reg: Byte);
     28    procedure Decrement(Reg: Byte);
    2529    procedure Jump(Value: QWord);
     30    procedure JumpNotZero(Value: QWord);
    2631    procedure DataPrefix8;
    2732    procedure StoreMem(RegAddr, RegSrc: Byte);
     33    procedure LoadMem(RegDst, RegAddr: Byte);
     34    procedure Output(Port: TAddress; Reg: Byte);
     35    procedure Input(Reg: Byte; Port: TAddress);
     36    procedure Test(Reg: Byte);
    2837  end;
    2938
    … …  
    4756  Write8(Byte(opLoadConst));
    4857  Write8(Reg);
    49   case Cpu.DataSize of
    50     bw8: Write8(Value);
    51     bw16: Write16(Value);
    52     bw32: Write32(Value);
    53     bw64: Write64(Value);
    54   end;
     58  WriteData(Value);
    5559end;
    5660
    … …  
    6165end;
    6266
     67procedure TInstructionWriter.Decrement(Reg: Byte);
     68begin
     69  Write8(Byte(opDec));
     70  Write8(Reg);
     71end;
     72
    6373procedure TInstructionWriter.Jump(Value: QWord);
    6474begin
    6575  Write8(Byte(opJump));
    66   case Cpu.AddressSize of
    67     bw8: Write8(Value);
    68     bw16: Write16(Value);
    69     bw32: Write32(Value);
    70     bw64: Write64(Value);
    71   end;
     76  WriteAddress(Value);
     77end;
     78
     79procedure TInstructionWriter.JumpNotZero(Value: QWord);
     80begin
     81  Write8(Byte(opJumpNotZero));
     82  WriteAddress(Value);
    7283end;
    7384
    … …  
    8293  Write8(RegAddr);
    8394  Write8(RegSrc);
     95end;
     96
     97procedure TInstructionWriter.LoadMem(RegDst, RegAddr: Byte);
     98begin
     99  Write8(Byte(opLoadMem));
     100  Write8(RegDst);
     101  Write8(RegAddr);
     102end;
     103
     104procedure TInstructionWriter.Output(Port: TAddress; Reg: Byte);
     105begin
     106  Write8(Byte(opOut));
     107  WriteAddress(Port);
     108  Write8(Reg);
     109end;
     110
     111procedure TInstructionWriter.Input(Reg: Byte; Port: TAddress);
     112begin
     113  Write8(Byte(opIn));
     114  Write8(Reg);
     115  WriteAddress(Port);
     116end;
     117
     118procedure TInstructionWriter.Test(Reg: Byte);
     119begin
     120  Write8(Byte(opTest));
     121  Write8(Reg);
     122end;
     123
     124procedure TInstructionWriter.WriteString(Text: string);
     125var
     126  I: Integer;
     127begin
     128  for I := 1 to Length(Text) do
     129    Write8(Ord(Text[I]));
    84130end;
    85131
    … …  
    108154end;
    109155
     156procedure TInstructionWriter.WriteAddress(Value: TAddress);
     157begin
     158  case Cpu.AddressSize of
     159    bw8: Write8(Value);
     160    bw16: Write16(Value);
     161    bw32: Write32(Value);
     162    bw64: Write64(Value);
     163  end;
     164end;
     165
     166procedure TInstructionWriter.WriteData(Value: QWord);
     167begin
     168  case Cpu.DataSize of
     169    bw8: Write8(Value);
     170    bw16: Write16(Value);
     171    bw32: Write32(Value);
     172    bw64: Write64(Value);
     173  end;
     174end;
     175
    110176end.
    111177
Note: See TracChangeset for help on using the changeset viewer.