Changeset 46


Ignore:
Timestamp:
Oct 23, 2023, 11:34:54 PM (14 months ago)
Author:
chronos
Message:
  • Added: Various useful forms, assembler and disassembler classes.
Location:
branches/ByteArray
Files:
17 added
8 edited

Legend:

Unmodified
Added
Removed

  • branches/ByteArray

    • Property svn:ignore set to
      heaptrclog.trc
      lib
      ByteArray
      ByteArray.exe
      ByteArray.lps
      ByteArray.res
      ByteArray.dbg

  • branches/ByteArray/BigInt.pas

    r45 r46  
    2323    class operator Implicit(A: QWord): TBigInt;
    2424    class operator Implicit(A: Int64): TBigInt;
    25     class operator Implicit(A: TBigInt): Byte;
    26     class operator Implicit(A: TBigInt): ShortInt;
    27     class operator Implicit(A: TBigInt): Word;
    28     class operator Implicit(A: TBigInt): Integer;
    29     class operator Implicit(A: TBigInt): LongWord;
     25    class operator Implicit(A: TBigInt): UInt8; // Byte
     26    class operator Implicit(A: TBigInt): Int8; // ShortInt
     27    class operator Implicit(A: TBigInt): UInt16; // Word
     28    class operator Implicit(A: TBigInt): Int16; // SmallInt
     29    class operator Implicit(A: TBigInt): UInt32; // LongWord, DWord, Cardinal
     30    class operator Implicit(A: TBigInt): Int32; // Int32, LongInt
     31    class operator Implicit(A: TBigInt): UInt64; // QWord
     32    class operator Implicit(A: TBigInt): Int64;
    3033    class operator Implicit(A: TBigInt): PByte;
    31     class operator Implicit(A: TBigInt): QWord;
    32     class operator Implicit(A: TBigInt): Int64;
    3334    class operator Inc(A: TBigInt) : TBigInt;
    3435    class operator Add(A, B: TBigInt): TBigInt;
    3536    class operator Subtract(A, B: TBigInt): TBigInt;
     37    class operator Equal(A, B: TBigInt): Boolean;
     38    class operator NotEqual(A, B: TBigInt): Boolean;
     39    class operator LessThan(A, B: TBigInt): Boolean;
     40    class operator LessThanOrEqual(A, B: TBigInt): Boolean;
     41    class operator GreaterThan(A, B: TBigInt): Boolean;
     42    class operator GreaterThanOrEqual(A, B: TBigInt): Boolean;
    3643    procedure Shrink;
    3744    procedure SetByteArray(AData: TArrayOfByte; ASize: Byte);
    … …  
    4148  end;
    4249
     50function TryStrToBigInt(const S: string; Out I: TBigInt): Boolean;
    4351
    4452implementation
     53
     54function TryStrToBigInt(const S: string; Out I: TBigInt): Boolean;
     55var
     56  Value: Int64;
     57begin
     58  Result := TryStrToInt64(S, Value);
     59  I := Value;
     60end;
    4561
    4662{ TBigInt }
    … …  
    102118end;
    103119
    104 class operator TBigInt.Implicit(A: TBigInt): Byte;
     120class operator TBigInt.Implicit(A: TBigInt): UInt8;
    105121begin
    106122  if A.Size = 1 then Result := A.Data[0]
    … …  
    108124end;
    109125
    110 class operator TBigInt.Implicit(A: TBigInt): ShortInt;
     126class operator TBigInt.Implicit(A: TBigInt): Int8;
    111127begin
    112128  if A.Size = 1 then Result := A.Data[0]
    … …  
    114130end;
    115131
    116 class operator TBigInt.Implicit(A: TBigInt): Word;
    117 begin
    118   if A.Size = 2 then Result := PWord(@A.Data[0])^
    119     else raise Exception.Create('x');
    120 end;
    121 
    122 class operator TBigInt.Implicit(A: TBigInt): Integer;
     132class operator TBigInt.Implicit(A: TBigInt): UInt16;
     133begin
     134  if A.Size = 2 then Result := PUInt16(@A.Data[0])^
     135    else raise Exception.Create('x');
     136end;
     137
     138class operator TBigInt.Implicit(A: TBigInt): Int16;
     139begin
     140  if A.Size = 2 then Result := PInt16(@A.Data[0])^
     141    else raise Exception.Create('x');
     142end;
     143
     144class operator TBigInt.Implicit(A: TBigInt): Int32;
    123145begin
    124146  case A.Size of
    … …  
    131153end;
    132154
    133 class operator TBigInt.Implicit(A: TBigInt): LongWord;
    134 begin
    135   if A.Size = 4 then Result := PLongWord(@A.Data[0])^
     155class operator TBigInt.Implicit(A: TBigInt): UInt32;
     156begin
     157  if A.Size = 4 then Result := PInt32(@A.Data[0])^
     158    else raise Exception.Create('x');
     159end;
     160
     161class operator TBigInt.Implicit(A: TBigInt): UInt64;
     162begin
     163  if A.Size = 8 then Result := PUInt64(@A.Data[0])^
     164    else raise Exception.Create('x');
     165end;
     166
     167class operator TBigInt.Implicit(A: TBigInt): Int64;
     168begin
     169  if A.Size = 8 then Result := PInt64(@A.Data[0])^
    136170    else raise Exception.Create('x');
    137171end;
    … …  
    140174begin
    141175  if A.Size = 4 then Result := PByte(@PInteger(@A.Data[0])^)
    142     else raise Exception.Create('x');
    143 end;
    144 
    145 class operator TBigInt.Implicit(A: TBigInt): QWord;
    146 begin
    147   if A.Size = 8 then Result := PQWord(@A.Data[0])^
    148     else raise Exception.Create('x');
    149 end;
    150 
    151 class operator TBigInt.Implicit(A: TBigInt): Int64;
    152 begin
    153   if A.Size = 8 then Result := PInt64(@A.Data[0])^
    154176    else raise Exception.Create('x');
    155177end;
    … …  
    198220end;
    199221
     222class operator TBigInt.Equal(A, B: TBigInt): Boolean;
     223begin
     224
     225end;
     226
     227class operator TBigInt.NotEqual(A, B: TBigInt): Boolean;
     228begin
     229
     230end;
     231
     232class operator TBigInt.LessThan(A, B: TBigInt): Boolean;
     233begin
     234
     235end;
     236
     237class operator TBigInt.LessThanOrEqual(A, B: TBigInt): Boolean;
     238begin
     239
     240end;
     241
     242class operator TBigInt.GreaterThan(A, B: TBigInt): Boolean;
     243begin
     244
     245end;
     246
     247class operator TBigInt.GreaterThanOrEqual(A, B: TBigInt): Boolean;
     248begin
     249
     250end;
     251
    200252procedure TBigInt.Shrink;
    201253var

  • branches/ByteArray/ByteArray.lpi

    r45 r46  
    2626    <RequiredPackages>
    2727      <Item>
     28        <PackageName Value="SynEdit"/>
     29      </Item>
     30      <Item>
    2831        <PackageName Value="LCL"/>
    2932      </Item>
    … …  
    102105        <Filename Value="Devices/Mouse.pas"/>
    103106        <IsPartOfProject Value="True"/>
     107      </Unit>
     108      <Unit>
     109        <Filename Value="Disassembler.pas"/>
     110        <IsPartOfProject Value="True"/>
     111      </Unit>
     112      <Unit>
     113        <Filename Value="Instructions.pas"/>
     114        <IsPartOfProject Value="True"/>
     115      </Unit>
     116      <Unit>
     117        <Filename Value="Parser.pas"/>
     118        <IsPartOfProject Value="True"/>
     119      </Unit>
     120      <Unit>
     121        <Filename Value="Forms/FormDisassembler.pas"/>
     122        <IsPartOfProject Value="True"/>
     123        <ComponentName Value="FormDisassembler"/>
     124        <HasResources Value="True"/>
     125        <ResourceBaseClass Value="Form"/>
     126      </Unit>
     127      <Unit>
     128        <Filename Value="Forms/FormAssembler.pas"/>
     129        <IsPartOfProject Value="True"/>
     130        <ComponentName Value="FormAssembler"/>
     131        <HasResources Value="True"/>
     132        <ResourceBaseClass Value="Form"/>
     133      </Unit>
     134      <Unit>
     135        <Filename Value="Forms/FormSourceEditor.pas"/>
     136        <IsPartOfProject Value="True"/>
     137        <ComponentName Value="FormSourceEditor"/>
     138        <HasResources Value="True"/>
     139        <ResourceBaseClass Value="Form"/>
     140      </Unit>
     141      <Unit>
     142        <Filename Value="Forms/FormMessages.pas"/>
     143        <IsPartOfProject Value="True"/>
     144        <ComponentName Value="FormMessages"/>
     145        <ResourceBaseClass Value="Form"/>
     146      </Unit>
     147      <Unit>
     148        <Filename Value="Message.pas"/>
     149        <IsPartOfProject Value="True"/>
     150      </Unit>
     151      <Unit>
     152        <Filename Value="Assembler.pas"/>
     153        <IsPartOfProject Value="True"/>
     154      </Unit>
     155      <Unit>
     156        <Filename Value="Common.pas"/>
     157        <IsPartOfProject Value="True"/>
     158      </Unit>
     159      <Unit>
     160        <Filename Value="Forms/FormMemory.pas"/>
     161        <IsPartOfProject Value="True"/>
     162        <ComponentName Value="FormMemory"/>
     163        <HasResources Value="True"/>
     164        <ResourceBaseClass Value="Form"/>
    104165      </Unit>
    105166    </Units>

  • branches/ByteArray/ByteArray.lpr

    r45 r46  
    1111  {$ENDIF}
    1212  Interfaces, SysUtils,// this includes the LCL widgetset
    13   Forms, FormMain, FormConsole, FormDevice, FormScreen, Cpu, BigInt, Channel,
    14   Memory, FrameBuffer, Device, Storage, DeviceMapper, Machine, Serial, Mouse
     13  Forms, FormMain, FormConsole, FormDevice, FormScreen, FormDisassembler,
     14  FormAssembler, Cpu, BigInt, Channel, Memory, FrameBuffer, Device, Storage,
     15  DeviceMapper, Machine, Disassembler, Instructions, Parser, Message, Assembler,
     16  Serial, Mouse, FormSourceEditor, FormMessages, FormMemory, Common
    1517  { you can add units after this };
    1618

  • branches/ByteArray/Cpu.pas

    r45 r46  
    2222    inJump, inJumpSize,
    2323    inJumpNotZero, inJumpNotZeroSize,
     24    inJumpZero, inJumpZeroSize,
    2425    inJumpRel, inJumpRelSize,
    2526    inCall, inCallSize,
    … …  
    3637    inOtir, inOti, inOtdr, inOtd,
    3738    inCpir, inCpi, inCpdr, inCpd,
    38     inEx,
    39     inCp);
     39    inEx, inEnableInterrupts, inDisableInterrupts,
     40    inCompare);
    4041
    4142  TRegIndex = (riA, riB, riC, riD, riE, riF, riG, riH);
    … …  
    6465    procedure InstructionJumpNotZero;
    6566    procedure InstructionJumpNotZeroSize;
     67    procedure InstructionJumpZero;
     68    procedure InstructionJumpZeroSize;
    6669    procedure InstructionJumpRel;
    6770    procedure InstructionJumpRelSize;
    … …  
    257260end;
    258261
     262procedure TCpu.InstructionJumpZero;
     263var
     264  RegIndex: TRegIndex;
     265  Address: TBigInt;
     266begin
     267  RegIndex := ReadRegIndex;
     268  Address := Read(AddressWidth);
     269  if Byte(Regs[RegIndex]) = 0 then
     270    PC := Address;
     271end;
     272
     273procedure TCpu.InstructionJumpZeroSize;
     274var
     275  RegIndex: TRegIndex;
     276  Address: TBigInt;
     277  DataSize: Byte;
     278  AddressSize: Byte;
     279begin
     280  DataSize := Read(1);
     281  AddressSize := Read(1);
     282  RegIndex := ReadRegIndex;
     283  Address := Read(AddressSize);
     284  if Int64(Regs[RegIndex].Copy(DataSize)) = 0 then
     285    PC := Address;
     286end;
     287
    259288procedure TCpu.InstructionJumpRel;
    260289begin
    … …  
    430459  Instructions[inJumpNotZero] := InstructionJumpNotZero;
    431460  Instructions[inJumpNotZeroSize] := InstructionJumpNotZeroSize;
     461  Instructions[inJumpZero] := InstructionJumpZero;
     462  Instructions[inJumpZeroSize] := InstructionJumpZeroSize;
    432463  Instructions[inJumpRel] := InstructionJumpRel;
    433464  Instructions[inJumpRelSize] := InstructionJumpRelSize;

  • branches/ByteArray/Devices/Memory.pas

    r45 r46  
    1616    procedure SetSize(AValue: Integer);
    1717  public
     18    Position: Integer;
    1819    function Read(Address: TBigInt; Size: Byte): TBigInt;
     20    function ReadPos(Size: Byte): TBigInt;
    1921    procedure Write(Address: TBigInt; Size: Byte; Value: TBigInt);
     22    procedure WritePos(Size: Byte; Value: TBigInt);
     23    procedure WriteStringPos(Value: string);
    2024    function GetAddressCount: Integer; override;
    2125    procedure SetChannel(Channel: TChannel); override;
    … …  
    4953end;
    5054
     55function TMemory.ReadPos(Size: Byte): TBigInt;
     56begin
     57  Result := Read(Position, Size);
     58end;
     59
    5160procedure TMemory.Write(Address: TBigInt; Size: Byte; Value: TBigInt);
    5261begin
    … …  
    5665    4: PDWord(FData + Integer(Address))^ := Value;
    5766    8: PQWord(FData + Integer(Address))^ := Value;
     67  end;
     68end;
     69
     70procedure TMemory.WritePos(Size: Byte; Value: TBigInt);
     71begin
     72  Write(Position, Size, Value);
     73end;
     74
     75procedure TMemory.WriteStringPos(Value: string);
     76var
     77  I: Integer;
     78begin
     79  if Length(Value) > 0 then begin
     80    if Position + Length(Value) > Size then Size := Position + Length(Value);
     81    for I := 0 to Length(Value) - 1 do
     82      Write(Position + I, 1, Ord(Value[I + 1]));
     83    Inc(Position, Length(Value));
    5884  end;
    5985end;

  • branches/ByteArray/Forms/FormMain.lfm

    r45 r46  
    1414    Left = 331
    1515    Top = 79
     16    object MenuItem4: TMenuItem
     17      Caption = 'File'
     18      object MenuItem6: TMenuItem
     19        Action = AExit
     20      end
     21    end
    1622    object MenuItem1: TMenuItem
    1723      Caption = 'View'
    … …  
    2733        Caption = 'Storage'
    2834      end
     35      object MenuItem7: TMenuItem
     36        Action = AMemory
     37      end
     38    end
     39    object MenuItem2: TMenuItem
     40      Caption = 'Tools'
     41      object MenuItem3: TMenuItem
     42        Action = ASourceEditor
     43      end
     44      object MenuItem5: TMenuItem
     45        Action = ADebugger
     46      end
     47    end
     48  end
     49  object ActionList1: TActionList
     50    Left = 448
     51    Top = 80
     52    object ASourceEditor: TAction
     53      Caption = 'Source editor'
     54      OnExecute = ASourceEditorExecute
     55    end
     56    object ADebugger: TAction
     57      Caption = 'Debugger'
     58      OnExecute = ADebuggerExecute
     59    end
     60    object ADevices: TAction
     61      Caption = 'Devices'
     62    end
     63    object AExit: TAction
     64      Caption = 'Exit'
     65      OnExecute = AExitExecute
     66    end
     67    object AMemory: TAction
     68      Caption = 'Memory'
     69      OnExecute = AMemoryExecute
    2970    end
    3071  end

  • branches/ByteArray/Forms/FormMain.pas

    r45 r46  
    44
    55uses
    6   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, FormConsole,
    7   FormScreen, Machine;
     6  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, ActnList,
     7  FormConsole, FormScreen, Machine, FormSourceEditor, FormMemory;
    88
    99type
    … …  
    1212
    1313  TFormMain = class(TForm)
     14    AMemory: TAction;
     15    AExit: TAction;
     16    ADevices: TAction;
     17    ADebugger: TAction;
     18    ASourceEditor: TAction;
     19    ActionList1: TActionList;
    1420    MainMenu1: TMainMenu;
    1521    MenuItem1: TMenuItem;
     22    MenuItem2: TMenuItem;
     23    MenuItem3: TMenuItem;
     24    MenuItem4: TMenuItem;
     25    MenuItem5: TMenuItem;
     26    MenuItem6: TMenuItem;
     27    MenuItem7: TMenuItem;
    1628    MenuItemViewScreen: TMenuItem;
    1729    MenuItemViewStorage: TMenuItem;
    1830    MenuItemViewConsole: TMenuItem;
     31    procedure ADebuggerExecute(Sender: TObject);
     32    procedure AExitExecute(Sender: TObject);
     33    procedure AMemoryExecute(Sender: TObject);
     34    procedure ASourceEditorExecute(Sender: TObject);
    1935    procedure FormCreate(Sender: TObject);
    2036    procedure FormDestroy(Sender: TObject);
    … …  
    2541    FormScreen: TFormScreen;
    2642    FormConsole: TFormConsole;
     43    FormMemory: TFormMemory;
     44    FormSourceEditor: TFormSourceEditor;
    2745    Machine: TMachine;
    2846    procedure InitMachine;
    2947  public
    30     procedure DockForm(Form: TForm; DockSite: TWinControl);
    3148  end;
    3249
    … …  
    4057
    4158uses
    42   Cpu, BigInt;
     59  Cpu, BigInt, Common;
    4360
    4461{ TFormMain }
    … …  
    6178end;
    6279
     80procedure TFormMain.AExitExecute(Sender: TObject);
     81begin
     82  Close;
     83end;
     84
     85procedure TFormMain.AMemoryExecute(Sender: TObject);
     86begin
     87  if not Assigned(FormMemory) then begin
     88    FormMemory := TFormMemory.Create(nil);
     89    FormMemory.Memory := Machine.Memory;
     90  end;
     91  FormMemory.Show;
     92end;
     93
     94procedure TFormMain.ADebuggerExecute(Sender: TObject);
     95begin
     96
     97end;
     98
     99procedure TFormMain.ASourceEditorExecute(Sender: TObject);
     100begin
     101  if not Assigned(FormSourceEditor) then begin
     102    FormSourceEditor := TFormSourceEditor.Create(nil);
     103  end;
     104  FormSourceEditor.Show;
     105end;
     106
    63107procedure TFormMain.FormDestroy(Sender: TObject);
    64108begin
    65   FreeAndNil(FormScreen);
    66   FreeAndNil(FormConsole);
     109  if Assigned(FormSourceEditor) then FreeAndNil(FormSourceEditor);
     110  if Assigned(FormScreen) then FreeAndNil(FormScreen);
     111  if Assigned(FormConsole) then FreeAndNil(FormConsole);
     112  if Assigned(FormMemory) then FreeAndNil(FormMemory);
    67113  FreeAndNil(Machine);
    68114end;
    … …  
    125171end;
    126172
    127 procedure TFormMain.DockForm(Form: TForm; DockSite: TWinControl);
    128 begin
    129   Form.ManualDock(DockSite, nil, alClient);
    130   Form.Align := alClient;
    131   Form.Show;
    132 end;
    133 
    134173end.
    135174
Note: See TracChangeset for help on using the changeset viewer.