Changeset 185


Ignore:
Timestamp:
May 1, 2019, 9:48:46 PM (6 years ago)
Author:
chronos
Message:
  • Added: Assembler labels reference address calculation.
  • Fixed: Displaying address/data hex numbers in opcode and instruction.
Location:
branches/virtualcpu4
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • branches/virtualcpu4/Forms/UFormAssembler.lfm

    r184 r185  
    11object FormAssembler: TFormAssembler
    22  Left = 474
    3   Height = 540
     3  Height = 648
    44  Top = 313
    5   Width = 705
     5  Width = 846
    66  Caption = 'Assembler'
    7   ClientHeight = 540
    8   ClientWidth = 705
    9   DesignTimePPI = 120
     7  ClientHeight = 648
     8  ClientWidth = 846
     9  DesignTimePPI = 144
    1010  OnCreate = FormCreate
    1111  OnDestroy = FormDestroy
    12   LCLVersion = '2.0.2.0'
     12  LCLVersion = '2.0.0.4'
    1313  object MemoSource: TMemo
    14     Left = 8
    15     Height = 383
    16     Top = 8
    17     Width = 691
     14    Left = 10
     15    Height = 459
     16    Top = 10
     17    Width = 829
    1818    Anchors = [akTop, akLeft, akRight, akBottom]
    1919    Lines.Strings = (
    20       'LD R1, R2'
    21       'LDI R1, 10'
     20      '  // Print Hello world text'
     21      '  LDI R1, HelloWorld'
     22      '  LDI R2, 13'
     23      '  CALL Print'
     24      '  HALT'
     25      ''
     26      'Print:'
     27      '  PUSH R3'
     28      '  PUSH R2'
     29      '  PUSH R1'
     30      'PrintLoop:'
     31      '  DP8 ;LDM R3, R1'
     32      '  AP8; DP8; OUT (0), R3'
     33      '  INC R1'
     34      '  DEC R2'
     35      '  TEST R2'
     36      '  AP8; JRNZ PrintLoop'
     37      '  POP R1'
     38      '  POP R2'
     39      '  POP R3'
     40      '  RET'
     41      'HelloWorld:'
     42      '  STRING ''Hello_World!'''
    2243    )
     44    ParentFont = False
    2345    ScrollBars = ssAutoBoth
    2446    TabOrder = 0
    2547  end
    2648  object ButtonLoadFromFile: TButton
    27     Left = 8
    28     Height = 31
    29     Top = 502
    30     Width = 136
     49    Left = 10
     50    Height = 37
     51    Top = 603
     52    Width = 163
    3153    Anchors = [akLeft, akBottom]
    3254    Caption = 'Load from file'
    3355    OnClick = ButtonLoadFromFileClick
     56    ParentFont = False
    3457    TabOrder = 1
    3558  end
    3659  object ButtonSaveToFile: TButton
    37     Left = 160
    38     Height = 31
    39     Top = 502
    40     Width = 128
     60    Left = 192
     61    Height = 37
     62    Top = 603
     63    Width = 154
    4164    Anchors = [akLeft, akBottom]
    4265    Caption = 'Save to file'
    4366    OnClick = ButtonSaveToFileClick
     67    ParentFont = False
    4468    TabOrder = 2
    4569  end
    4670  object ButtonCompile: TButton
    47     Left = 297
    48     Height = 31
    49     Top = 502
    50     Width = 126
     71    Left = 356
     72    Height = 37
     73    Top = 603
     74    Width = 151
    5175    Anchors = [akLeft, akBottom]
    5276    Caption = 'Compile'
    5377    OnClick = ButtonCompileClick
     78    ParentFont = False
    5479    TabOrder = 3
    5580  end
    5681  object MemoMessages: TMemo
    57     Left = 8
    58     Height = 97
    59     Top = 402
    60     Width = 689
     82    Left = 10
     83    Height = 116
     84    Top = 483
     85    Width = 826
    6186    Anchors = [akLeft, akRight, akBottom]
     87    ParentFont = False
    6288    ReadOnly = True
    6389    ScrollBars = ssAutoBoth
    … …  
    6591  end
    6692  object OpenDialog1: TOpenDialog
    67     left = 114
    68     top = 152
     93    left = 137
     94    top = 182
    6995  end
    7096  object SaveDialog1: TSaveDialog
    71     left = 379
    72     top = 152
     97    left = 455
     98    top = 182
    7399  end
    74100end

  • branches/virtualcpu4/Forms/UFormMain.lfm

    r184 r185  
    11object FormMain: TFormMain
    22  Left = 780
    3   Height = 224
     3  Height = 269
    44  Top = 527
    5   Width = 549
     5  Width = 659
    66  Caption = 'VirtCpu4'
    7   ClientHeight = 224
    8   ClientWidth = 549
    9   DesignTimePPI = 120
     7  ClientHeight = 269
     8  ClientWidth = 659
     9  DesignTimePPI = 144
    1010  OnCreate = FormCreate
    1111  OnDestroy = FormDestroy
    1212  OnShow = FormShow
    13   LCLVersion = '2.0.2.0'
     13  LCLVersion = '2.0.0.4'
    1414  object ButtonStart: TButton
    15     Left = 191
    16     Height = 31
    17     Top = 14
    18     Width = 94
     15    Left = 229
     16    Height = 37
     17    Top = 17
     18    Width = 113
    1919    Caption = 'Start'
    2020    OnClick = ButtonStartClick
    … …  
    2323  end
    2424  object ButtonStop: TButton
    25     Left = 191
    26     Height = 31
    27     Top = 54
    28     Width = 94
     25    Left = 229
     26    Height = 37
     27    Top = 65
     28    Width = 113
    2929    Caption = 'Stop'
    3030    OnClick = ButtonStopClick
    … …  
    3333  end
    3434  object ButtonDisassembler: TButton
    35     Left = 309
    36     Height = 32
    37     Top = 14
    38     Width = 154
     35    Left = 371
     36    Height = 38
     37    Top = 17
     38    Width = 185
    3939    Caption = 'Disassembler'
    4040    OnClick = ButtonDisassemblerClick
    … …  
    4343  end
    4444  object ButtonMemory: TButton
    45     Left = 309
    46     Height = 32
    47     Top = 53
    48     Width = 154
     45    Left = 371
     46    Height = 38
     47    Top = 64
     48    Width = 185
    4949    Caption = 'Memory'
    5050    OnClick = ButtonMemoryClick
    … …  
    5353  end
    5454  object ButtonCpuState: TButton
    55     Left = 309
    56     Height = 32
    57     Top = 92
    58     Width = 154
     55    Left = 371
     56    Height = 38
     57    Top = 110
     58    Width = 185
    5959    Caption = 'CPU state'
    6060    OnClick = ButtonCpuStateClick
    … …  
    6363  end
    6464  object ButtonScreen: TButton
    65     Left = 20
    66     Height = 32
    67     Top = 13
    68     Width = 154
     65    Left = 24
     66    Height = 38
     67    Top = 16
     68    Width = 185
    6969    Caption = 'Screen'
    7070    OnClick = ButtonScreenClick
    … …  
    7373  end
    7474  object ButtonConsole: TButton
    75     Left = 20
    76     Height = 32
    77     Top = 53
    78     Width = 154
     75    Left = 24
     76    Height = 38
     77    Top = 64
     78    Width = 185
    7979    Caption = 'Console'
    8080    OnClick = ButtonConsoleClick
    … …  
    8383  end
    8484  object ButtonAssembler: TButton
    85     Left = 309
    86     Height = 32
    87     Top = 128
    88     Width = 154
     85    Left = 371
     86    Height = 38
     87    Top = 154
     88    Width = 185
    8989    Caption = 'Assembler'
    9090    OnClick = ButtonAssemblerClick
    … …  
    9292    TabOrder = 7
    9393  end
     94  object ButtonClearMemory: TButton
     95    Left = 371
     96    Height = 38
     97    Top = 192
     98    Width = 185
     99    Caption = 'Clear memory'
     100    OnClick = ButtonClearMemoryClick
     101    ParentFont = False
     102    TabOrder = 8
     103  end
    94104end

  • branches/virtualcpu4/Forms/UFormMain.pas

    r184 r185  
    1515  TFormMain = class(TForm)
    1616    ButtonAssembler: TButton;
     17    ButtonClearMemory: TButton;
    1718    ButtonScreen: TButton;
    1819    ButtonDisassembler: TButton;
    … …  
    2324    ButtonStop: TButton;
    2425    procedure ButtonAssemblerClick(Sender: TObject);
     26    procedure ButtonClearMemoryClick(Sender: TObject);
    2527    procedure ButtonConsoleClick(Sender: TObject);
    2628    procedure ButtonCpuStateClick(Sender: TObject);
    … …  
    111113end;
    112114
     115procedure TFormMain.ButtonClearMemoryClick(Sender: TObject);
     116begin
     117  Machine.ClearMemory;
     118end;
     119
    113120procedure TFormMain.ButtonStopClick(Sender: TObject);
    114121begin

  • branches/virtualcpu4/UAssembler.pas

    r184 r185  
    2020    Text: string;
    2121    procedure Expect(Text: string);
     22    function IsOperator(C: Char): Boolean;
     23    function IsWhiteSpace(C: Char): Boolean;
    2224    function ReadNext: string;
    2325    function EndOfText: Boolean;
    … …  
    2527  end;
    2628
     29  TLabelRef = class
     30    Address: QWord;
     31    BitWidth: TBitWidth;
     32    Relative: Boolean;
     33  end;
     34
     35  { TLabel }
     36
    2737  TLabel = class
    2838    Name: string;
    2939    Address: QWord;
    30   end;
     40    Refs: TFPGList<TLabelRef>;
     41    constructor Create;
     42    destructor Destroy; override;
     43  end;
     44
     45  { TLabels }
    3146
    3247  TLabels = class(TFPGObjecTList<TLabel>)
    33 
     48    function SearchByName(Name: string): TLabel;
    3449  end;
    3550
    … …  
    4055    FOnError: TErrorEvent;
    4156    OpcodeDefs: TOpcodeDefs;
     57    InstructionIP: QWord;
    4258    procedure Error(Text: string);
    4359    procedure ParseParam(Param: TOpcodeParam);
     60    procedure WriteRefAddr(Name: string; Relative: Boolean = False);
     61    procedure WriteRefData(Name: string);
     62    procedure UpdateLabelRef;
     63    procedure ParseInstruction;
    4464  public
    4565    Parser: TParser;
    … …  
    5676implementation
    5777
     78{ TLabels }
     79
     80function TLabels.SearchByName(Name: string): TLabel;
     81var
     82  I: Integer;
     83begin
     84  I := 0;
     85  while (I < Count) and (Items[I].Name <> Name) do Inc(I);
     86  if I < Count then Result := Items[I]
     87    else Result := nil;
     88end;
     89
     90{ TLabel }
     91
     92constructor TLabel.Create;
     93begin
     94  Refs := TFPGList<TLabelRef>.Create;
     95end;
     96
     97destructor TLabel.Destroy;
     98begin
     99  Refs.Free;
     100  inherited Destroy;
     101end;
     102
    58103{ TParser }
    59104
    … …  
    72117end;
    73118
     119function TParser.IsOperator(C: Char): Boolean;
     120begin
     121  Result := (C = ',') or (C = ';');
     122end;
     123
     124function TParser.IsWhiteSpace(C: Char): Boolean;
     125begin
     126  Result := (C = ' ') or (C = #8);
     127end;
     128
    74129function TParser.ReadNext: string;
    75130var
    … …  
    78133  Text := Trim(Text);
    79134  P := 1;
    80   if (Length(Text) > 0) and (Text[P] = ',') then begin
     135  if (Length(Text) > 0) and IsOperator(Text[P]) then begin
    81136    Result := Text[P];
    82137    Delete(Text, 1, 1);
    83138  end else begin
    84     while (P <= Length(Text)) and (Text[P] <> ' ') and (Text[P] <> ',') do Inc(P);
     139    while (P <= Length(Text)) and not IsWhiteSpace(Text[P]) and not IsOperator(Text[P]) do Inc(P);
    85140    Result := Copy(Text, 1, P - 1);
    86141    Delete(Text, 1, P - 1);
    … …  
    103158var
    104159  Reg: TRegIndex;
    105   Addr: QWord;
     160  Addr: Int64;
    106161  Next: string;
    107162begin
    … …  
    115170  if Param = prData then begin
    116171    Next := Parser.ReadNext;
    117     InstructionWriter.WriteData(StrToInt(Next));
     172    if TryStrToInt64(Next, Addr) then
     173      InstructionWriter.WriteData(Addr)
     174      else WriteRefData(Next);
    118175  end else
    119176  if Param = prAddr then begin
    120177    Next := Parser.ReadNext;
    121     InstructionWriter.WriteAddress(StrToInt(Next));
     178    if TryStrToInt64(Next, Addr) then
     179      InstructionWriter.WriteAddress(Addr)
     180      else WriteRefAddr(Next);
    122181  end else
    123182  if Param = prAddrRel then begin
    124183    Next := Parser.ReadNext;
    125     InstructionWriter.WriteAddress(StrToInt(Next));
    126   end;
     184    if TryStrToInt64(Next, Addr) then
     185      InstructionWriter.WriteAddress(InstructionWriter.IP + Addr)
     186      else WriteRefAddr(Next, True);
     187  end;
     188end;
     189
     190procedure TAssembler.WriteRefAddr(Name: string; Relative: Boolean = False);
     191var
     192  L: TLabel;
     193  NewRef: TLabelRef;
     194begin
     195  L := Labels.SearchByName(Name);
     196  if Assigned(L) then begin
     197    if Relative then
     198      InstructionWriter.WriteAddressSigned(InstructionWriter.GetRelativeAddr(
     199        InstructionWriter.AddrSize, InstructionIP, L.Address))
     200      else InstructionWriter.WriteAddress(L.Address);
     201  end else begin
     202    L := TLabel.Create;
     203    L.Name := Name;
     204    NewRef := TLabelRef.Create;
     205    NewRef.Address := InstructionWriter.IP;
     206    NewRef.BitWidth := InstructionWriter.AddrSize;
     207    if Relative then NewRef.Relative := True;
     208    L.Refs.Add(NewRef);
     209    Labels.Add(L);
     210    InstructionWriter.WriteAddress(0);
     211  end;
     212end;
     213
     214procedure TAssembler.WriteRefData(Name: string);
     215var
     216  L: TLabel;
     217  NewRef: TLabelRef;
     218begin
     219  L := Labels.SearchByName(Name);
     220  if Assigned(L) then begin
     221    InstructionWriter.WriteData(L.Address);
     222  end else begin
     223    L := TLabel.Create;
     224    L.Name := Name;
     225    NewRef := TLabelRef.Create;
     226    NewRef.Address := InstructionWriter.IP;
     227    NewRef.BitWidth := InstructionWriter.DataSize;
     228    L.Refs.Add(NewRef);
     229    Labels.Add(L);
     230    InstructionWriter.WriteData(0);
     231  end;
     232end;
     233
     234procedure TAssembler.UpdateLabelRef;
     235var
     236  I: Integer;
     237  R: Integer;
     238begin
     239  for I := 0 to Labels.Count - 1 do
     240  with TLabel(Labels[I]) do begin
     241    for R := 0 to Refs.Count - 1 do
     242    begin
     243      InstructionWriter.IP := Refs[R].Address;
     244      InstructionWriter.AddrSize := Refs[R].BitWidth;
     245      if Refs[R].Relative then InstructionWriter.WriteAddressSigned(InstructionWriter.GetRelativeAddr(
     246        InstructionWriter.AddrSize, InstructionWriter.IP - 1, Address))
     247        else InstructionWriter.WriteAddress(Address);
     248    end;
     249  end;
     250end;
     251
     252procedure TAssembler.ParseInstruction;
     253var
     254  Next: string;
     255  LabelName: string;
     256  NewLabel: TLabel;
     257  OpcodeDef: TOpcodeDef;
     258begin
     259  Next := Parser.ReadNext;
     260  if Next = '' then Exit;
     261  if (Length(Next) > 0) and (Next[Length(Next)] = ':') then begin
     262    LabelName := Copy(Next, 1, Length(Next) - 1);
     263    NewLabel := Labels.SearchByName(LabelName);
     264    if not Assigned(NewLabel) then begin
     265      NewLabel := TLabel.Create;
     266      NewLabel.Name := LabelName;
     267      Labels.Add(NewLabel);
     268    end;
     269    NewLabel.Address := InstructionWriter.IP;
     270    Next := Parser.ReadNext;
     271  end;
     272  if Next = '' then Exit;
     273  OpcodeDef := OpcodeDefs.SearchByName(Next);
     274  if Assigned(OpcodeDef) then begin
     275    if OpcodeDef.Prefix then InstructionWriter.Prefix := True;
     276    if OpcodeDef.Opcode = opDataPrefix16 then InstructionWriter.DataSize := bw8
     277    else if OpcodeDef.Opcode = opDataPrefix16 then InstructionWriter.DataSize := bw16
     278    else if OpcodeDef.Opcode = opDataPrefix32 then InstructionWriter.DataSize := bw32
     279    else if OpcodeDef.Opcode = opDataPrefix64 then InstructionWriter.DataSize := bw64
     280    else if OpcodeDef.Opcode = opAddrPrefix8 then InstructionWriter.AddrSize := bw8
     281    else if OpcodeDef.Opcode = opAddrPrefix16 then InstructionWriter.AddrSize := bw16
     282    else if OpcodeDef.Opcode = opAddrPrefix32 then InstructionWriter.AddrSize := bw32
     283    else if OpcodeDef.Opcode = opAddrPrefix64 then InstructionWriter.AddrSize := bw64;
     284    InstructionIP := InstructionWriter.IP;
     285    InstructionWriter.Write8(Byte(OpcodeDef.Opcode));
     286    ParseParam(OpcodeDef.Param1);
     287    if OpcodeDef.Param2 <> prNone then begin
     288      Parser.Expect(',');
     289      ParseParam(OpcodeDef.Param2);
     290      if OpcodeDef.Param3 <> prNone then begin
     291        Parser.Expect(',');
     292        ParseParam(OpcodeDef.Param3);
     293      end;
     294    end;
     295    if not OpcodeDef.Prefix then begin
     296      InstructionWriter.DataSize := InstructionWriter.DataSizeBase;
     297      InstructionWriter.AddrSize := InstructionWriter.AddrSizeBase;
     298    end;
     299  end else
     300  if Next = 'STRING' then begin
     301    Next := Parser.ReadNext;
     302    if (Length(Next) >= 2) and (Next[1] = '''') and (Next[Length(Next)] = '''') then
     303      InstructionWriter.WriteString(Copy(Next, 2, Length(Next) - 2));
     304  end else
     305  Error('Unknown instruction ' + Next);
    127306end;
    128307
    … …  
    130309var
    131310  I: Integer;
    132   NewLabel: TLabel;
    133311  Next: string;
    134   OpcodeDef: TOpcodeDef;
    135312begin
    136313  InstructionWriter.Init;
    … …  
    138315  for I := 0 to Source.Count - 1 do begin
    139316    Parser.Text := Source[I];
    140     Next := Parser.ReadNext;
    141     if (Length(Next) > 0) and (Next[Length(Next)] = ':') then begin
    142       NewLabel := TLabel.Create;
    143       NewLabel.Name := Copy(Next, 1, Length(Next) - 1);
    144       //NewLabel.Address := ;
    145       Labels.Add(NewLabel);
     317    ParseInstruction;
     318    repeat
    146319      Next := Parser.ReadNext;
    147     end;
    148     OpcodeDef := OpcodeDefs.SearchByName(Next);
    149     if Assigned(OpcodeDef) then begin
    150       InstructionWriter.Write8(Byte(OpcodeDef.Opcode));
    151       ParseParam(OpcodeDef.Param1);
    152       if OpcodeDef.Param2 <> prNone then begin
    153         Parser.Expect(',');
    154         ParseParam(OpcodeDef.Param2);
    155         if OpcodeDef.Param3 <> prNone then begin
    156           Parser.Expect(',');
    157           ParseParam(OpcodeDef.Param3);
    158         end;
    159       end;
    160     end else Error('Unknown instruction ' + Next);
    161   end;
     320      if (Next = '') or (Next <> ';') then Break;
     321      ParseInstruction;
     322    until False;
     323  end;
     324  UpdateLabelRef;
    162325end;
    163326

  • branches/virtualcpu4/UDisassembler.pas

    r184 r185  
    2929
    3030implementation
    31 
    32 const
    33   SignText: array[TValueSign] of string = ('-', '', '+');
    34 
    35 function SignedIntToHex(Value: Int64; Digits: Byte): string;
    36 begin
    37   Result := SignText[Sign(Value)] + IntToHex(Abs(Value), Digits);
    38 end;
    3931
    4032{ TDisassembler }
    … …  
    8476          Data := ReadData;
    8577          Line.Opcode := Line.Opcode + ' ' + IntToHex(Data, BitWidthBytes[DataSize] * 2);
    86           Line.Instruction := Line.Instruction + ' $' + IntToHex(Data, BitWidthBytes[DataSize] * 2);
     78          Line.Instruction := Line.Instruction + ' ' + IntToHexEx(Data, -1, '$');
    8779        end;
    8880        prAddr: begin
    8981          Address := ReadAddress;
    9082          Line.Opcode := Line.Opcode + ' ' + IntToHex(Address, BitWidthBytes[AddrSize] * 2);
    91           Line.Instruction := Line.Instruction + ' $' + IntToHex(Address, BitWidthBytes[AddrSize] * 2);
     83          Line.Instruction := Line.Instruction + ' ' + IntToHexEx(Address, -1, '$');
    9284        end;
    9385        prAddrRel: begin
    9486          AddressRel := ReadAddressSigned;
    95           Line.Opcode := Line.Opcode + ' ' + IntToHex(QWord(AddressRel), BitWidthBytes[AddrSize] * 2);
    96           Line.Instruction := Line.Instruction + ' $' + SignedIntToHex(AddressRel, BitWidthBytes[AddrSize] * 2);
     87          Line.Opcode := Line.Opcode + ' ' + IntToHexEx(QWord(AddressRel), BitWidthBytes[AddrSize] * 2);
     88          Line.Instruction := Line.Instruction + ' ' + IntToHexEx(AddressRel, -1, '$');
    9789        end;
    9890      end;
    … …  
    10597        prData: begin
    10698          Data := ReadData;
    107           Line.Opcode := Line.Opcode + ' ' + IntToHex(Data, BitWidthBytes[DataSize] * 2);
    108           Line.Instruction := Line.Instruction + ', $' + IntToHex(Data, BitWidthBytes[DataSize] * 2);
     99          Line.Opcode := Line.Opcode + ' ' + IntToHexEx(Data, BitWidthBytes[DataSize] * 2);
     100          Line.Instruction := Line.Instruction + ', ' + IntToHexEx(Data, -1, '$');
    109101        end;
    110102        prAddr: begin
    111103          Address := ReadAddress;
    112104          Line.Opcode := Line.Opcode + ' ' + IntToHex(Address, BitWidthBytes[AddrSize] * 2);
    113           Line.Instruction := Line.Instruction + ', $' + IntToHex(Address, BitWidthBytes[AddrSize] * 2);
     105          Line.Instruction := Line.Instruction + ', ' + IntToHexEx(Address, -1, '$');
    114106        end;
    115107        prAddrRel: begin
    116108          AddressRel := ReadAddressSigned;
    117           Line.Opcode := Line.Opcode + ' ' + IntToHex(AddressRel, BitWidthBytes[AddrSize] * 2);
    118           Line.Instruction := Line.Instruction + ', $' + SignedIntToHex(AddressRel, BitWidthBytes[AddrSize] * 2);
     109          Line.Opcode := Line.Opcode + ' ' + IntToHex(QWord(AddressRel), BitWidthBytes[AddrSize] * 2);
     110          Line.Instruction := Line.Instruction + ', ' + IntToHexEx(AddressRel, -1, '$');
    119111        end;
    120112      end;
    … …  
    128120          Data := ReadData;
    129121          Line.Opcode := Line.Opcode + ' ' + IntToHex(Data, BitWidthBytes[DataSize] * 2);
    130           Line.Instruction := Line.Instruction + ', $' + IntToHex(Data, BitWidthBytes[DataSize] * 2);
     122          Line.Instruction := Line.Instruction + ', ' + IntToHexEx(Data, -1, '$');
    131123        end;
    132124        prAddr: begin
    133125          Address := ReadAddress;
    134126          Line.Opcode := Line.Opcode + ' ' + IntToHex(Address, BitWidthBytes[AddrSize] * 2);
    135           Line.Instruction := Line.Instruction + ', $' + IntToHex(Address, BitWidthBytes[AddrSize] * 2);
     127          Line.Instruction := Line.Instruction + ', ' + IntToHexEx(Address, -1, '$');
    136128        end;
    137129        prAddrRel: begin
    138130          AddressRel := ReadAddressSigned;
    139131          Line.Opcode := Line.Opcode + ' ' + IntToHex(QWord(AddressRel), BitWidthBytes[AddrSize] * 2);
    140           Line.Instruction := Line.Instruction + ', $' + SignedIntToHex(AddressRel, BitWidthBytes[AddrSize] * 2);
     132          Line.Instruction := Line.Instruction + ', ' + IntToHexEx(AddressRel, -1, '$');
    141133        end;
    142134      end;
    143135      Output.Add(Line);
     136      if not Prefix then begin
     137        DataSize := DataSizeBase;
     138        AddrSize := AddrSizeBase;
     139      end;
    144140    end else begin
    145141      {Line := TDisassemblerLine.Create;
    … …  
    149145      Output.Add(Line);
    150146      }
    151     end;
    152     if not Prefix then begin
    153       DataSize := DataSizeBase;
    154       AddrSize := AddrSizeBase;
    155147    end;
    156148  end;

  • branches/virtualcpu4/UInstructionWriter.pas

    r184 r185  
    2525    Prefix: Boolean;
    2626    procedure Init;
     27    function GetRelativeAddr(BitWidth: TBitWidth; BaseIP, TargetAddr: QWord): Int64;
    2728    procedure Write8(Value: Byte);
    2829    procedure Write16(Value: Word);
    … …  
    132133end;
    133134
     135function TInstructionWriter.GetRelativeAddr(BitWidth: TBitWidth; BaseIP, TargetAddr: QWord): Int64;
     136begin
     137  Result := Int64(TargetAddr) - (BaseIP + 1 + BitWidthBytes[BitWidth]);
     138end;
     139
    134140procedure TInstructionWriter.JumpRel(Addr: QWord);
    135141var
    136   NextIP: QWord;
    137 begin
    138   PrefixBegin;
    139   NextIP := IP + 1 + BitWidthBytes[Cpu.AddrSize];
     142  RelAddr: Int64;
     143begin
     144  PrefixBegin;
     145  RelAddr := GetRelativeAddr(AddrSize, IP, Addr);
    140146  Write8(Byte(opJumpRel));
    141   WriteAddressSigned(Int64(Addr) - Int64(NextIP));
     147  WriteAddressSigned(RelAddr);
    142148  PrefixEnd;
    143149end;
    … …  
    145151procedure TInstructionWriter.JumpRelNotZero(Addr: QWord);
    146152var
    147   NextIP: QWord;
    148 begin
    149   PrefixBegin;
    150   NextIP := IP + 1 + BitWidthBytes[Cpu.AddrSize];
     153  RelAddr: Int64;
     154begin
     155  PrefixBegin;
     156  RelAddr := GetRelativeAddr(AddrSize, IP, Addr);
    151157  Write8(Byte(opJumpRelNotZero));
    152   WriteAddressSigned(Int64(Addr) - Int64(NextIP));
     158  WriteAddressSigned(RelAddr);
    153159  PrefixEnd;
    154160end;
    … …  
    156162procedure TInstructionWriter.JumpRelZero(Addr: QWord);
    157163var
    158   NextIP: QWord;
    159 begin
    160   PrefixBegin;
    161   NextIP := IP + 1 + BitWidthBytes[Cpu.AddrSize];
     164  RelAddr: Int64;
     165begin
     166  PrefixBegin;
     167  RelAddr := GetRelativeAddr(AddrSize, IP, Addr);
    162168  Write8(Byte(opJumpRelZero));
    163   WriteAddressSigned(Int64(Addr) - Int64(NextIP));
     169  WriteAddressSigned(RelAddr);
    164170  PrefixEnd;
    165171end;
    … …  
    360366begin
    361367  case AddrSize of
    362     bw8: Write8(Value);
    363     bw16: Write16(Value);
    364     bw32: Write32(Value);
     368    bw8: Write8(Value and $ff);
     369    bw16: Write16(Value and $ffff);
     370    bw32: Write32(Value and $ffffffff);
    365371    bw64: Write64(Value);
    366372  end;
    … …  
    370376begin
    371377  case AddrSize of
    372     bw8: Write8(Byte(Value));
    373     bw16: Write16(Word(Value));
    374     bw32: Write32(DWord(Value));
     378    bw8: Write8(Byte(Value and $ff));
     379    bw16: Write16(Word(Value and $ffff));
     380    bw32: Write32(DWord(Value and $ffffffff));
    375381    bw64: Write64(QWord(Value));
    376382  end;
    … …  
    380386begin
    381387  case DataSize of
    382     bw8: Write8(Value);
    383     bw16: Write16(Value);
    384     bw32: Write32(Value);
     388    bw8: Write8(Value and $ff);
     389    bw16: Write16(Value and $ffff);
     390    bw32: Write32(Value and $ffffffff);
    385391    bw64: Write64(Value);
    386392  end;

  • branches/virtualcpu4/UMachine.pas

    r182 r185  
    3434    LockInput: TCriticalSection;
    3535    LockOutput: TCriticalSection;
    36     property MemorySize: Integer read GetMemorySize write SetMemorySize;
     36    procedure ClearMemory;
    3737    constructor Create;
    3838    destructor Destroy; override;
     39    property MemorySize: Integer read GetMemorySize write SetMemorySize;
    3940  end;
    4041
    … …  
    159160end;
    160161
     162procedure TMachine.ClearMemory;
     163begin
     164  FillChar(Memory^, MemorySize, $ff);
     165end;
     166
    161167
    162168end.

  • branches/virtualcpu4/UOpcode.pas

    r184 r185  
    2929  end;
    3030
     31  function IntToHexEx(Value: Int64; Digits: ShortInt; Prefix: string = ''): string; overload;
     32  function IntToHexEx(Value: QWord; Digits: ShortInt; Prefix: string = ''): string; overload;
     33
    3134
    3235implementation
     36
     37const
     38  HexChars: array[0..15] of Char = '0123456789ABCDEF';
     39
     40function IntToHexEx(Value: Int64; Digits: ShortInt; Prefix: string = ''): string;
     41var
     42  I: Integer;
     43  Negative: Boolean;
     44begin
     45  Negative := Value < 0;
     46  if Negative then Value := -Value;
     47  Result := '';
     48  if Digits >= 0 then begin
     49    for I := 0 to Digits - 1 do begin
     50      Result := HexChars[Value and $f] + Result;
     51      Value := Value shr 4;
     52    end;
     53  end else begin
     54    if Value <> 0 then begin
     55      while QWord(Value) > 0 do begin
     56        Result := HexChars[Value and $f] + Result;
     57        Value := Value shr 4;
     58      end;
     59    end else Result := '0';
     60  end;
     61  Result := Prefix + Result;
     62  if Negative then Result := '-' + Result;
     63end;
     64
     65function IntToHexEx(Value: QWord; Digits: ShortInt; Prefix: string = ''): string;
     66var
     67  I: Integer;
     68begin
     69  Result := '';
     70  if Digits >= 0 then begin
     71    for I := 0 to Digits - 1 do begin
     72      Result := HexChars[Value and $f] + Result;
     73      Value := Value shr 4;
     74    end;
     75  end else begin
     76    if Value <> 0 then begin
     77      while Value > 0 do begin
     78        Result := HexChars[Value and $f] + Result;
     79        Value := Value shr 4;
     80      end;
     81    end else Result := '0';
     82  end;
     83  Result := Prefix + Result;
     84end;
    3385
    3486{ TOpcodeDefs }
    … …  
    100152  AddNew(opShr, 'SHR', prReg, prReg, prNone, False);
    101153  AddNew(opDataPrefix8, 'DP8', prNone, prNone, prNone, True);
    102   AddNew(opDataPrefix16, 'DP16', prNone, prNone, prNone, False);
     154  AddNew(opDataPrefix16, 'DP16', prNone, prNone, prNone, True);
    103155  AddNew(opDataPrefix32, 'DP32', prNone, prNone, prNone, True);
    104156  AddNew(opDataPrefix64, 'DP64', prNone, prNone, prNone, True);
    … …  
    117169  AddNew(opAddrPrefix16, 'AP16', prNone, prNone, prNone, True);
    118170  AddNew(opAddrPrefix32, 'AP32', prNone, prNone, prNone, True);
    119   AddNew(opDataPrefix64, 'AP64', prNone, prNone, prNone, True);
     171  AddNew(opAddrPrefix64, 'AP64', prNone, prNone, prNone, True);
    120172  AddNew(opConvert, 'CON', prReg, prNone, prNone, True);
    121173end;

  • branches/virtualcpu4/virtucpu4.lpi

    r184 r185  
    154154        <IsPartOfProject Value="True"/>
    155155        <ComponentName Value="FormAssembler"/>
     156        <HasResources Value="True"/>
    156157        <ResourceBaseClass Value="Form"/>
    157158      </Unit15>
Note: See TracChangeset for help on using the changeset viewer.