Changeset 220


Ignore:
Timestamp:
Oct 20, 2020, 1:10:09 AM (4 years ago)
Author:
chronos
Message:
  • Added: Devices form with tree view of connected devices. Device control form can be opened by double click.
  • Modifid: IN/OUT instructions now use also device group index to directly specify which device should be read/written.
Location:
branches/CpuSingleSize
Files:
4 added
14 edited

Legend:

Unmodified
Added
Removed

  • branches/CpuSingleSize/CpuSingleSize.lpi

    r217 r220  
    7575      </Item2>
    7676    </RequiredPackages>
    77     <Units Count="18">
     77    <Units Count="20">
    7878      <Unit0>
    7979        <Filename Value="CpuSingleSize.lpr"/>
    … …  
    175175        <IsPartOfProject Value="True"/>
    176176      </Unit17>
     177      <Unit18>
     178        <Filename Value="Forms/UFormDevices.pas"/>
     179        <IsPartOfProject Value="True"/>
     180        <ComponentName Value="FormDevices"/>
     181        <HasResources Value="True"/>
     182        <ResourceBaseClass Value="Form"/>
     183      </Unit18>
     184      <Unit19>
     185        <Filename Value="Forms/UFormStorage.pas"/>
     186        <IsPartOfProject Value="True"/>
     187        <ComponentName Value="FormStorage"/>
     188        <HasResources Value="True"/>
     189        <ResourceBaseClass Value="Form"/>
     190      </Unit19>
    177191    </Units>
    178192  </ProjectOptions>

  • branches/CpuSingleSize/CpuSingleSize.lpr

    r217 r220  
    1010  Forms, UFormMain, UCpu, UAssembler, UInstructions, UFormScreen, UMachine,
    1111  UFormCpu, UFormConsole, UFormAssembler, UCore, UFormDisassembler,
    12   UDisassembler, UMemory, UFormMessages, UMessages, SysUtils, UFormHelp, UParser;
     12  UDisassembler, UMemory, UFormMessages, UMessages, SysUtils, UFormHelp,
     13  UParser, UFormDevices, UFormStorage;
    1314
    1415{$R *.res}
    … …  
    3031  Application.CreateForm(TCore, Core);
    3132  Application.CreateForm(TFormMain, FormMain);
    32   Application.CreateForm(TFormScreen, FormScreen);
    33   Application.CreateForm(TFormConsole, FormConsole);
    3433  Application.CreateForm(TFormCpu, FormCpu);
    3534  Application.CreateForm(TFormAssembler, FormAssembler);
    … …  
    3736  Application.CreateForm(TFormMessages, FormMessages);
    3837  Application.CreateForm(TFormHelp, FormHelp);
     38  Application.CreateForm(TFormDevices, FormDevices);
    3939  Application.Run;
    4040end.

  • branches/CpuSingleSize/Forms/UFormConsole.pas

    r216 r220  
    1313  { TFormConsole }
    1414
    15   TFormConsole = class(TForm)
     15  TFormConsole = class(TFormDevice)
    1616    MemoConsole: TMemo;
    1717    Timer1: TTimer;
    … …  
    2020    procedure MemoConsoleKeyPress(Sender: TObject; var Key: char);
    2121    procedure Timer1Timer(Sender: TObject);
    22   private
    23 
     22  protected
     23    function GetDevice: TDevice; override;
     24    procedure SetDevice(AValue: TDevice); override;
    2425  public
    2526    Console: TConsole;
    … …  
    5556end;
    5657
     58function TFormConsole.GetDevice: TDevice;
     59begin
     60  Result := Console;
     61end;
     62
     63procedure TFormConsole.SetDevice(AValue: TDevice);
     64begin
     65  if AValue is TConsole then
     66    Console := TConsole(AValue);
     67end;
     68
    5769procedure TFormConsole.MemoConsoleKeyPress(Sender: TObject; var Key: char);
    5870begin

  • branches/CpuSingleSize/Forms/UFormMain.lfm

    r216 r220  
    105105    object MenuItem12: TMenuItem
    106106      Caption = 'View'
    107       object MenuItem13: TMenuItem
    108         Action = Core.AConsole
    109       end
    110107      object MenuItem14: TMenuItem
    111108        Action = Core.ACpu
    112109      end
    113110      object MenuItem15: TMenuItem
    114         Action = Core.AScreen
     111        Action = Core.ADevices
    115112      end
    116113      object MenuItem16: TMenuItem

  • branches/CpuSingleSize/Forms/UFormMain.pas

    r216 r220  
    2222    MenuItem11: TMenuItem;
    2323    MenuItem12: TMenuItem;
    24     MenuItem13: TMenuItem;
    2524    MenuItem14: TMenuItem;
    2625    MenuItem15: TMenuItem;

  • branches/CpuSingleSize/Forms/UFormScreen.pas

    r216 r220  
    1212  { TFormScreen }
    1313
    14   TFormScreen = class(TForm)
     14  TFormScreen = class(TFormDevice)
    1515    PaintBox1: TPaintBox;
    1616    Timer1: TTimer;
    … …  
    2121  private
    2222    TempBitmap: TBitmap;
     23  protected
     24    function GetDevice: TDevice; override;
     25    procedure SetDevice(AValue: TDevice); override;
    2326  public
    2427    Screen: TScreen;
    … …  
    4649      P := TempBitmap.ScanLine[Y];
    4750      for X := 0 to Screen.Size.X - 1 do begin
    48         P^ := Screen.Data[Y * Screen.Size.Y + X] * $010101;
     51        P^ := Screen.VideoMem[Y * Screen.Size.Y + X] * $010101;
    4952        Inc(P);
    5053      end;
    … …  
    5356    PaintBox1.Refresh;
    5457  end;
     58end;
     59
     60function TFormScreen.GetDevice: TDevice;
     61begin
     62  Result := Screen;
     63end;
     64
     65procedure TFormScreen.SetDevice(AValue: TDevice);
     66begin
     67  if AValue is TScreen then
     68    Screen := TScreen(AValue);
    5569end;
    5670

  • branches/CpuSingleSize/Sample.asm

    r219 r220  
    33     NOP
    44     NOP
     5     
     6     VAR  DeviceConsole 1
     7     VAR  ConsoleReadChar 0
     8     VAR  ConsoleWriteChar 0
     9     
     10     VAR  DeviceKeyboard 2
     11     
     12     VAR  DeviceScreen 3
     13     VAR  ScreenGetWidth 0
     14     VAR  ScreenGetHeight 1
     15     VAR  ScreenSetAddr 0
     16     VAR  ScreenWrite 1
    517     
    618     ORG 16
    … …  
    6375    PUSH R2
    6476    PUSH R3
    65     SET  R3, 0
     77    PUSH R4
     78    SET  R3, ConsoleWriteChar
     79    SET  R4, DeviceConsole
    6680WriteStrLoop:
    6781    LD   R2, (R0)
    68     OUT  (R3), R2
     82    OUT  (R4: R3), R2
    6983    INC  R0
    7084    DEC  R1
    7185    JNZ  R1, WriteStrLoop
     86    POP  R4
    7287    POP  R3
    7388    POP  R2
    7489    RET
    75    
     90       
    7691ClearScreen:
    7792    PUSH R0
    7893    PUSH R1
    7994    PUSH R2
    80     SET  R0, 1
     95    PUSH R3
     96    SET  R0, ScreenSetAddr
    8197    SET  R1, 0 
    82     OUT  (R0), R1
    83     SET  R0, 3
    84     IN   R1, (R0)
    85     SET  R0, 4
    86     IN   R2, (R0)
     98    SET  R3, DeviceScreen
     99    OUT  (R3: R0), R1
     100    SET  R0, ScreenGetWidth
     101    IN   R1, (R3: R0)
     102    SET  R0, ScreenGetHeight
     103    IN   R2, (R3: R0)
    87104    MUL  R2, R1
    88     SET  R0, 2
     105    SET  R0, ScreenWrite
    89106    SET  R1, 120
    90107ClearScreenLoop:
    91     OUT  (R0), R1
     108    OUT  (R3: R0), R1
    92109    DEC  R2
    93110    JNZ  R2, ClearScreenLoop
     111    POP  R3
    94112    POP  R2
    95113    POP  R1
    … …  
    104122    PUSH R3
    105123    PUSH R2
    106     SET  R3, 0
    107     IN   R2, (R3)
    108     OUT  (R3), R2
     124    PUSH R4
     125    SET  R4, DeviceConsole
     126    SET  R3, ConsoleReadChar
     127    IN   R2, (R4: R3)
     128    SET  R3, ConsoleWriteChar
     129    OUT  (R4: R3), R2
     130    POP  R4
    109131    POP  R2
    110132    POP  R3

  • branches/CpuSingleSize/UAssembler.pas

    r219 r220  
    2525    FOnError: TErrorEvent;
    2626    Parser: TParser;
     27    function ParseVar: Boolean;
    2728    function ParseDb: Boolean;
    2829    function ParseOrg: Boolean;
    … …  
    3637    Labels: TDictionary<string, Integer>;
    3738    LabelRefs: TList<TLabelRef>;
     39    Variables: TDictionary<string, Integer>;
    3840    Messages: TMessages;
    3941    procedure Error(Text: string; Pos: TPoint);
    … …  
    8183  end else
    8284  if Token.Kind = tkIdentifier then begin;
     85    if Variables.TryGetValue(Token.Value, Addr) then begin
     86      Memory.Write(Addr);
     87    end else
    8388    if Labels.TryGetValue(Token.Value, Addr) then begin
    8489      Memory.Write(Addr);
    … …  
    107112  while not Parser.CheckNextKind(tkEof) do begin
    108113    ParseLabel;
     114    if ParseVar then begin
     115    end else
    109116    if ParseDb then begin
    110117    end else
    … …  
    119126  UpdateLabelRefs;
    120127  Error('Compilation finished.', Point(0, 0));
     128end;
     129
     130function TAssembler.ParseVar: Boolean;
     131var
     132  TokenName: TToken;
     133  TokenValue: TToken;
     134  Number: TInteger;
     135begin
     136  Result := False;
     137  if Parser.CheckNextAndRead(tkIdentifier, 'VAR') then begin
     138    Result := True;
     139    while True do begin
     140      TokenName := Parser.ReadNext;
     141      if TokenName.Kind = tkIdentifier then begin
     142        TokenValue := Parser.ReadNext;
     143        if TokenValue.Kind = tkNumber then begin
     144          if not Labels.ContainsKey(TokenName.Value) then begin
     145            if TryStrToInt(TokenValue.Value, Number) then
     146              Variables.Add(TokenName.Value, Number)
     147            else Error('Expected number', TokenValue.Pos);
     148          end else Error('Duplicate variable name ' + TokenName.Value, TokenName.Pos);
     149        end else Error('Expected variable value.', TokenValue.Pos);
     150      end else Error('Expected variable name.', TokenName.Pos);
     151      if Parser.CheckNextAndRead(tkSpecialSymbol, ',') then begin
     152        Continue;
     153      end;
     154      Break;
     155    end;
     156  end;
    121157end;
    122158
    … …  
    212248        Parser.Expect(tkSpecialSymbol, ')');
    213249      end else
     250      if InstructionInfo.Params[I] = ptRegIndirectGroup then begin
     251        Parser.Expect(tkSpecialSymbol, '(');
     252        Token := Parser.ReadNext;
     253        if (Token.Value <> '') and (Token.Value[1] = 'R') then begin
     254          Token.Value := Copy(Token.Value, 2, MaxInt);
     255          if TryStrToInt(Token.Value, Number) then begin
     256            Memory.Write(Number);
     257            Parser.Expect(tkSpecialSymbol, ':');
     258            Token := Parser.ReadNext;
     259            if (Token.Value <> '') and (Token.Value[1] = 'R') then begin
     260              Token.Value := Copy(Token.Value, 2, MaxInt);
     261              if TryStrToInt(Token.Value, Number) then begin
     262                Memory.Write(Number);
     263              end else Error('Expected numeric register index error', Token.Pos);
     264            end else Error('Expected register name starting with R character.', Token.Pos);
     265          end else Error('Expected numeric register index error', Token.Pos);
     266        end else Error('Expected register name starting with R character.', Token.Pos);
     267        Parser.Expect(tkSpecialSymbol, ')');
     268      end else
    214269    end;
    215270  end;
    … …  
    271326  Labels := TDictionary<string, Integer>.Create;
    272327  LabelRefs := TList<TLabelRef>.Create;
     328  Variables := TDictionary<string, Integer>.Create;
    273329end;
    274330
    275331destructor TAssembler.Destroy;
    276332begin
     333  FreeAndNil(Variables);
    277334  FreeAndNil(Labels);
    278335  FreeAndNil(LabelRefs);

  • branches/CpuSingleSize/UCore.lfm

    r216 r220  
    5858      OnExecute = ACpuExecute
    5959    end
    60     object AConsole: TAction
    61       Caption = 'Console'
    62       OnExecute = AConsoleExecute
    63     end
    64     object AScreen: TAction
    65       Caption = 'Screen'
    66       OnExecute = AScreenExecute
     60    object ADevices: TAction
     61      Caption = 'Devices'
     62      OnExecute = ADevicesExecute
    6763    end
    6864    object AHelp: TAction

  • branches/CpuSingleSize/UCore.pas

    r216 r220  
    1616    AHelp: TAction;
    1717    ADisassembler: TAction;
    18     AConsole: TAction;
    1918    ACpu: TAction;
    20     AScreen: TAction;
     19    ADevices: TAction;
    2120    ARunToCursor: TAction;
    2221    AStop: TAction;
    … …  
    3130    ImageList1: TImageList;
    3231    procedure ACompileExecute(Sender: TObject);
    33     procedure AConsoleExecute(Sender: TObject);
    3432    procedure ACpuExecute(Sender: TObject);
     33    procedure ADevicesExecute(Sender: TObject);
    3534    procedure ADisassemblerExecute(Sender: TObject);
    3635    procedure AExitExecute(Sender: TObject);
    3736    procedure AHelpExecute(Sender: TObject);
    3837    procedure ARunExecute(Sender: TObject);
    39     procedure AScreenExecute(Sender: TObject);
    4038    procedure AStopExecute(Sender: TObject);
    4139    procedure DataModuleCreate(Sender: TObject);
    … …  
    6058uses
    6159  UFormScreen, UFormCpu, UFormAssembler, UFormConsole, UFormHelp,
    62   UFormDisassembler, UFormMessages;
     60  UFormDisassembler, UFormMessages, UFormDevices;
    6361
    6462{ TCore }
    … …  
    7876  ACompile.Execute;
    7977  Machine.PowerOn;
    80 end;
    81 
    82 procedure TCore.AScreenExecute(Sender: TObject);
    83 begin
    84   FormScreen.Screen := Machine.Screen;
    85   FormScreen.Show;
    8678end;
    8779
    … …  
    120112end;
    121113
    122 procedure TCore.AConsoleExecute(Sender: TObject);
    123 begin
    124   FormConsole.Console := Machine.Console;
    125   FormConsole.Show;
    126 end;
    127 
    128114procedure TCore.ACpuExecute(Sender: TObject);
    129115begin
    130116  FormCpu.Cpu := Machine.Cpu;
    131117  FormCpu.Show;
     118end;
     119
     120procedure TCore.ADevicesExecute(Sender: TObject);
     121begin
     122  FormDevices.Devices := Machine.Devices;
     123  FormDevices.Show;
    132124end;
    133125

  • branches/CpuSingleSize/UCpu.pas

    r219 r220  
    1717
    1818  TCpuThread = class;
    19   TOutputEvent = procedure (Port: TInteger; Value: TInteger) of object;
    20   TInputEvent = function (Port: TInteger): TInteger of object;
     19  TOutputEvent = procedure (Device, Port: TInteger; Value: TInteger) of object;
     20  TInputEvent = function (Device, Port: TInteger): TInteger of object;
    2121
    2222  { TCpu }
    … …  
    115115  Port: TInteger;
    116116  Dest: TInteger;
     117  Device: TInteger;
    117118begin
    118119  Instruction := TInstruction(ReadNext);
    … …  
    136137    inIn: begin
    137138      Index := ReadNext;
     139      Device := R[ReadNext];
    138140      Port := R[ReadNext];
    139       if Assigned(FOnInput) then R[Index] := FOnInput(Port);
     141      if Assigned(FOnInput) then R[Index] := FOnInput(Device, Port);
    140142    end;
    141143    inOut: begin
     144      Device := R[ReadNext];
    142145      Port := R[ReadNext];
    143       if Assigned(FOnOutput) then FOnOutput(Port, R[ReadNext]);
     146      if Assigned(FOnOutput) then FOnOutput(Device, Port, R[ReadNext]);
    144147    end;
    145148    inJump: IP := ReadNext;

  • branches/CpuSingleSize/UDisassembler.pas

    r219 r220  
    6666            InstBytes := InstBytes + IntToHex(Value, 2) + ' ';
    6767            InstText := InstText + ' + ' + IntToStr(Value) + ')';
     68          end else
     69          if InstructionInfo.Params[J] = ptRegIndirectGroup then begin
     70            InstText := InstText + '(R' + IntToStr(Value);
     71            Value := Memory.Read;
     72            InstBytes := InstBytes + IntToHex(Value, 2) + ' ';
     73            InstText := InstText + ': R' + IntToStr(Value) + ')';
    6874          end;
    6975        end;

  • branches/CpuSingleSize/UInstructions.pas

    r219 r220  
    99
    1010type
    11   TParamType = (ptNone, ptNumber, ptReg, ptRegIndirect, ptRegIndirectIndex);
     11  TParamType = (ptNone, ptNumber, ptReg, ptRegIndirect, ptRegIndirectIndex,
     12    ptRegIndirectGroup);
    1213  TParamTypeArray = array of TParamType;
    1314
    … …  
    8283  AddNew(inAdd, 'ADD', [ptReg, ptReg], 'Adds second register to first register.');
    8384  AddNew(inSub, 'SUB', [ptReg, ptReg], 'Subtracts second register from first register.');
    84   AddNew(inIn, 'IN', [ptReg, ptRegIndirect], 'Reads value from input port to register.');
    85   AddNew(inOut, 'OUT', [ptRegIndirect, ptReg], 'Writes value from register to output port.');
     85  AddNew(inIn, 'IN', [ptReg, ptRegIndirectGroup], 'Reads value from input port to register.');
     86  AddNew(inOut, 'OUT', [ptRegIndirectGroup, ptReg], 'Writes value from register to output port.');
    8687  AddNew(inJumpZero, 'JZ', [ptReg, ptNumber], 'Jumps to given address if value of register is zero');
    8788  AddNew(inJumpNotZero, 'JNZ', [ptReg, ptNumber], 'Jumps to given address if value of register is not zero');

  • branches/CpuSingleSize/UMachine.pas

    r216 r220  
    66
    77uses
    8   Classes, SysUtils, UCpu, Syncobjs, UMemory, Generics.Collections;
     8  Classes, SysUtils, UCpu, Syncobjs, UMemory, Generics.Collections, Forms;
    99
    1010type
    11   TInputPort = (ipConsoleReadChar, ipConsoleInputCount, ipKeyboardRead,
    12     ipScreenGetWidth, ipScreenGetHeight, ipStorageGetSize, ipStorageRead);
    13   TOutputPort = (opConsoleWriteChar, opScreenSetAddr, opScreenWrite,
    14     opStorageSetAddr, opStorageWrite);
     11  TDeviceClass = (dcNone, dcKeyboard, dcMouse, dcStorage, dcScreen, dcConsole);
     12  TDeviceClassSet = set of TDeviceClass;
     13
     14  TDevice = class;
     15
     16  { TFormDevice }
     17
     18  TFormDevice = class(TForm)
     19  protected
     20    function GetDevice: TDevice; virtual;
     21    procedure SetDevice(AValue: TDevice); virtual;
     22  public
     23    property Device: TDevice read GetDevice write SetDevice;
     24  end;
     25
     26  TFormDeviceClass = class of TFormDevice;
     27
     28  { TDevice }
    1529
    1630  TDevice = class
     31    Index: Integer;
     32    Name: string;
     33    DeviceClass: TDeviceClass;
    1734    Cpu: TCpu;
    1835    InterruptVector: Integer;
    19   end;
     36    Form: TFormDevice;
     37    procedure OutputHandler(Port, Data: TInteger); virtual;
     38    function InputHandler(Port: TInteger): TInteger; virtual;
     39  end;
     40
     41  { TDevices }
     42
     43  TDevices = class(TObjectList<TDevice>)
     44    function GetDevicesCountByClass(DeviceClass: TDeviceClass): Integer;
     45    function GetDevicesByClass(DeviceClass: TDeviceClass): TDevices;
     46    function GetClasses: TDeviceClassSet;
     47  end;
     48
     49  TDeviceManagerOutputPort = (opDeviceManagerClass, opDeviceManagerFirst, opDeviceManagerNext);
     50  TDeviceManagerInputPort = (ipDeviceManagerCount, ipDeviceManagerGet);
     51
     52  { TDeviceManager }
     53
     54  TDeviceManager = class(TDevice)
     55    DeviceClassFilter: TDeviceClass;
     56    Index: Integer;
     57    Devices: TDevices;
     58    constructor Create;
     59    procedure OutputHandler(Port, Data: TInteger); override;
     60    function InputHandler(Port: TInteger): TInteger; override;
     61  end;
     62
     63  TConsoleInputPort = (ipConsoleReadChar, ipConsoleInputCount);
     64  TConsoleOutputPort = (opConsoleWriteChar);
    2065
    2166  { TConsole }
    … …  
    2772    constructor Create;
    2873    destructor Destroy; override;
    29   end;
     74    procedure OutputHandler(Port, Data: TInteger); override;
     75    function InputHandler(Port: TInteger): TInteger; override;
     76  end;
     77
     78  TScreenInputPort = (ipScreenGetWidth, ipScreenGetHeight);
     79  TScreenOutputPort = (opScreenSetAddr, opScreenWrite);
    3080
    3181  { TScreen }
    … …  
    3787  public
    3888    Address: Integer;
    39     Data: array of Byte;
     89    VideoMem: array of Byte;
    4090    Modified: Boolean;
    4191    constructor Create;
     92    procedure OutputHandler(Port, Data: TInteger); override;
     93    function InputHandler(Port: TInteger): TInteger; override;
    4294    property Size: TPoint read FSize write SetSize;
    4395  end;
    4496
     97  TKeyboardInputPort = (ipKeyboardRead);
     98
    4599  { TKeyboard }
    46100
    47101  TKeyboard = class(TDevice)
     102    constructor Create;
    48103    function ReadKey: TInteger;
    49   end;
     104    function InputHandler(Port: TInteger): TInteger; override;
     105  end;
     106
     107  TStorageInputPort = (ipStorageGetSize, ipStorageRead);
     108  TStorageOutputPort = (opStorageSetAddr, opStorageWrite);
     109
     110  { TStorage }
    50111
    51112  TStorage = class(TDevice)
    … …  
    53114    F: TFileStream;
    54115    FileName: string;
     116    constructor Create;
     117    procedure OutputHandler(Port, Data: TInteger); override;
     118    function InputHandler(Port: TInteger): TInteger; override;
     119  end;
     120
     121  { TMouse }
     122
     123  TMouse = class(TDevice)
     124    constructor Create;
    55125  end;
    56126
    … …  
    59129  TMachine = class
    60130  private
    61     procedure OutputHandler(Port, Data: TInteger);
    62     function InputHandler(Port: TInteger): TInteger;
     131    procedure OutputHandler(Device, Port, Data: TInteger);
     132    function InputHandler(Device, Port: TInteger): TInteger;
    63133  public
    64134    Memory: TMemory;
    65135    Cpu: TCpu;
    66     Screen: TScreen;
    67     Keyboard: TKeyboard;
    68     Console: TConsole;
    69     Storage: TStorage;
     136    Devices: TDevices;
     137    procedure RegisterDevice(Device: TDevice);
     138    procedure InitDevices;
    70139    procedure PowerOn;
    71140    procedure PowerOff;
    … …  
    74143  end;
    75144
     145const
     146  DeviceClassText: array[TDeviceClass] of string = ('None', 'Keyboard', 'Mouse', 'Storage', 'Screen', 'Console');
     147
    76148
    77149implementation
    78150
     151{ TDeviceManager }
     152
     153constructor TDeviceManager.Create;
     154begin
     155  DeviceClass := dcNone;
     156end;
     157
     158procedure TDeviceManager.OutputHandler(Port, Data: TInteger);
     159begin
     160  case TDeviceManagerOutputPort(Port) of
     161    opDeviceManagerClass: DeviceClassFilter := TDeviceClass(Data);
     162    opDeviceManagerFirst: Index := 0;
     163    opDeviceManagerNext: Inc(Index);
     164  end;
     165end;
     166
     167function TDeviceManager.InputHandler(Port: TInteger): TInteger;
     168var
     169  ClassDevices: TDevices;
     170begin
     171  case TDeviceManagerInputPort(Port) of
     172    ipDeviceManagerCount: Result := Devices.Count;
     173    ipDeviceManagerGet: begin
     174      ClassDevices := Devices.GetDevicesByClass(DeviceClassFilter);
     175      if (Index >= 0) and (Index < ClassDevices.Count) then
     176        Result := ClassDevices[Index].Index
     177        else Result := 0;
     178      ClassDevices.Free;
     179    end;
     180  end;
     181end;
     182
     183{ TFormDevice }
     184
     185function TFormDevice.GetDevice: TDevice;
     186begin
     187  Result := nil;
     188end;
     189
     190procedure TFormDevice.SetDevice(AValue: TDevice);
     191begin
     192end;
     193
     194
     195{ TDevices }
     196
     197function TDevices.GetDevicesCountByClass(DeviceClass: TDeviceClass): Integer;
     198var
     199  I: Integer;
     200begin
     201  Result := 0;
     202  for I := 0 to Count - 1 do
     203    if Items[I].DeviceClass = DeviceClass then Inc(Result);
     204end;
     205
     206function TDevices.GetDevicesByClass(DeviceClass: TDeviceClass): TDevices;
     207var
     208  I: Integer;
     209begin
     210  Result := TDevices.Create(False);
     211  for I := 0 to Count - 1 do
     212    if Items[I].DeviceClass = DeviceClass then Result.Add(Items[I])
     213end;
     214
     215function TDevices.GetClasses: TDeviceClassSet;
     216var
     217  I: Integer;
     218begin
     219  Result := [];
     220  for I := 0 to Count - 1 do
     221    if not (Items[I].DeviceClass in Result) then
     222      Result := Result + [Items[I].DeviceClass];
     223end;
     224
     225{ TDevice }
     226
     227procedure TDevice.OutputHandler(Port, Data: TInteger);
     228begin
     229end;
     230
     231function TDevice.InputHandler(Port: TInteger): TInteger;
     232begin
     233  Result := 0;
     234end;
     235
     236{ TMouse }
     237
     238constructor TMouse.Create;
     239begin
     240  DeviceClass := dcMouse;
     241end;
     242
     243{ TStorage }
     244
     245constructor TStorage.Create;
     246begin
     247  DeviceClass := dcStorage;
     248end;
     249
     250procedure TStorage.OutputHandler(Port, Data: TInteger);
     251begin
     252  case TStorageOutputPort(Port) of
     253    opStorageSetAddr: F.Position := Data * SizeOf(TInteger);
     254    opStorageWrite: begin
     255      F.WriteBuffer(Data, SizeOf(TInteger));
     256    end;
     257  end;
     258end;
     259
     260function TStorage.InputHandler(Port: TInteger): TInteger;
     261begin
     262  case TStorageInputPort(Port) of
     263    ipStorageGetSize: Result := F.Size div 4;
     264    ipStorageRead: begin
     265      F.ReadBuffer(Result, SizeOf(TInteger));
     266    end;
     267  end;
     268end;
     269
    79270{ TConsole }
    80271
    81272constructor TConsole.Create;
    82273begin
     274  DeviceClass := dcConsole;
    83275  Lock := TCriticalSection.Create;
    84276  InputBuffer := TQueue<TInteger>.Create;
    … …  
    94286end;
    95287
     288procedure TConsole.OutputHandler(Port, Data: TInteger);
     289begin
     290  case TConsoleOutputPort(Port) of
     291    opConsoleWriteChar: begin
     292      Lock.Acquire;
     293      try
     294        OutputBuffer.Enqueue(Data);
     295      finally
     296        Lock.Release;
     297      end;
     298    end;
     299  end;
     300end;
     301
     302function TConsole.InputHandler(Port: TInteger): TInteger;
     303begin
     304  case TConsoleInputPort(Port) of
     305    ipConsoleReadChar: begin
     306      Lock.Acquire;
     307      try
     308        if InputBuffer.Count > 0 then begin
     309          Result := InputBuffer.Dequeue;
     310        end else Result := 0;
     311      finally
     312        Lock.Release;
     313      end;
     314    end;
     315    ipConsoleInputCount: begin
     316      Lock.Acquire;
     317      try
     318        Result := InputBuffer.Count;
     319      finally
     320        Lock.Release;
     321      end;
     322    end;
     323  end;
     324end;
     325
    96326{ TScreen }
    97327
    … …  
    100330  if FSize = AValue then Exit;
    101331  FSize := AValue;
    102   SetLength(Data, FSize.X * FSize.Y);
     332  SetLength(VideoMem, FSize.X * FSize.Y);
    103333end;
    104334
    105335constructor TScreen.Create;
    106336begin
     337  DeviceClass := dcScreen;
    107338  Size := Point(640, 480);
    108339end;
    109340
     341procedure TScreen.OutputHandler(Port, Data: TInteger);
     342begin
     343  case TScreenOutputPort(Port) of
     344    opScreenSetAddr: Address := Data;
     345    opScreenWrite: if (Address >= 0) and (Address < Length(VideoMem)) then begin
     346      VideoMem[Address] := Data;
     347      Inc(Address);
     348      Modified := True;
     349    end;
     350  end;
     351end;
     352
     353function TScreen.InputHandler(Port: TInteger): TInteger;
     354begin
     355  case TScreenInputPort(Port) of
     356    ipScreenGetWidth: Result := Size.X;
     357    ipScreenGetHeight: Result := Size.Y;
     358  end;
     359end;
     360
    110361{ TKeyboard }
    111362
    … …  
    115366end;
    116367
     368function TKeyboard.InputHandler(Port: TInteger): TInteger;
     369begin
     370  case TKeyboardInputPort(Port) of
     371    ipKeyboardRead: Result := ReadKey;
     372  end;
     373end;
     374
     375constructor TKeyboard.Create;
     376begin
     377  DeviceClass := dcKeyboard;
     378end;
     379
    117380{ TMachine }
    118381
    119 procedure TMachine.OutputHandler(Port, Data: TInteger);
    120 begin
    121   case TOutputPort(Port) of
    122     opConsoleWriteChar: begin
    123       Console.Lock.Acquire;
    124       try
    125         Console.OutputBuffer.Enqueue(Data);
    126       finally
    127         Console.Lock.Release;
    128       end;
    129     end;
    130     opScreenSetAddr: Screen.Address := Data;
    131     opScreenWrite: if (Screen.Address >= 0) and (Screen.Address < Length(Screen.Data)) then begin
    132       Screen.Data[Screen.Address] := Data;
    133       Inc(Screen.Address);
    134       Screen.Modified := True;
    135     end;
    136     opStorageSetAddr: Storage.F.Position := Data * SizeOf(TInteger);
    137     opStorageWrite: begin
    138       Storage.F.WriteBuffer(Data, SizeOf(TInteger));
    139     end;
    140   end;
    141 end;
    142 
    143 function TMachine.InputHandler(Port: TInteger): TInteger;
    144 begin
    145   case TInputPort(Port) of
    146     ipConsoleReadChar: begin
    147       Console.Lock.Acquire;
    148       try
    149         if Console.InputBuffer.Count > 0 then begin
    150           Result := Console.InputBuffer.Dequeue;
    151         end else Result := 0;
    152       finally
    153         Console.Lock.Release;
    154       end;
    155     end;
    156     ipConsoleInputCount: begin
    157       Console.Lock.Acquire;
    158       try
    159         Result := Console.InputBuffer.Count;
    160       finally
    161         Console.Lock.Release;
    162       end;
    163     end;
    164     ipKeyboardRead: Result := Keyboard.ReadKey;
    165     ipScreenGetWidth: Result := Screen.Size.X;
    166     ipScreenGetHeight: Result := Screen.Size.Y;
    167     ipStorageGetSize: Result := Storage.F.Size div 4;
    168     ipStorageRead: begin
    169       Storage.F.ReadBuffer(Result, SizeOf(TInteger));
    170     end;
    171   end;
     382procedure TMachine.OutputHandler(Device, Port, Data: TInteger);
     383begin
     384  if (Device > 0) and (Device < Devices.Count) then
     385    Devices[Device].OutputHandler(Port, Data);
     386end;
     387
     388function TMachine.InputHandler(Device, Port: TInteger): TInteger;
     389begin
     390  if (Device > 0) and (Device < Devices.Count) then
     391    Result := Devices[Device].InputHandler(Port)
     392    else Result := 0;
     393end;
     394
     395procedure TMachine.RegisterDevice(Device: TDevice);
     396begin
     397  Device.Index := Devices.Count;
     398  Device.Cpu := Cpu;
     399  Device.Name := DeviceClassText[Device.DeviceClass] + ' ' +
     400    IntToStr(Devices.GetDevicesCountByClass(Device.DeviceClass) + 1);
     401  Devices.Add(Device);
     402end;
     403
     404procedure TMachine.InitDevices;
     405var
     406  Screen: TScreen;
     407  Keyboard: TKeyboard;
     408  Console: TConsole;
     409  Storage: TStorage;
     410  Mouse: TMouse;
     411  DeviceManager: TDeviceManager;
     412begin
     413  DeviceManager := TDeviceManager.Create;
     414  DeviceManager.Devices := Devices;
     415  RegisterDevice(DeviceManager);
     416
     417  Console := TConsole.Create;
     418  RegisterDevice(Console);
     419  Console.InterruptVector := 1;
     420
     421  Keyboard := TKeyboard.Create;
     422  RegisterDevice(Keyboard);
     423
     424  Screen := TScreen.Create;
     425  RegisterDevice(Screen);
     426
     427  Storage := TStorage.Create;
     428  RegisterDevice(Storage);
     429
     430  Storage := TStorage.Create;
     431  RegisterDevice(Storage);
     432
     433  Mouse := TMouse.Create;
     434  RegisterDevice(Mouse);
    172435end;
    173436
    … …  
    185448constructor TMachine.Create;
    186449begin
     450  Devices := TDevices.Create;
    187451  Memory := TMemory.Create;
    188452  Memory.Size := 10000;
    … …  
    190454  Cpu.OnInput := InputHandler;
    191455  Cpu.OnOutput := OutputHandler;
    192   Keyboard := TKeyboard.Create;
    193   Keyboard.Cpu := Cpu;
    194   Screen := TScreen.Create;
    195   Screen.Cpu := Cpu;
    196   Console := TConsole.Create;
    197   Console.Cpu := Cpu;
    198   Console.InterruptVector := 1;
    199   Storage := TStorage.Create;
    200   Storage.Cpu := Cpu;
     456  InitDevices;
    201457end;
    202458
    … …  
    204460begin
    205461  PowerOff;
    206   FreeAndNil(Storage);
    207   FreeAndNil(Console);
    208   FreeAndNil(Screen);
    209   FreeAndNil(Keyboard);
    210   FreeAndNil(Cpu);
    211   FreeAndNil(Memory);
     462  FreeAndNil(Devices);
    212463  inherited;
    213464end;
Note: See TracChangeset for help on using the changeset viewer.