Changeset 220 for branches/CpuSingleSize/UMachine.pas

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.

File:

• branches/CpuSingleSize/UMachine.pas (modified) (12 diffs)

branches/CpuSingleSize/UMachine.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, UCpu, Syncobjs, UMemory, Generics.Collections;
+  Classes, SysUtils, UCpu, Syncobjs, UMemory, Generics.Collections, Forms;
 
 type
-  TInputPort = (ipConsoleReadChar, ipConsoleInputCount, ipKeyboardRead,
-    ipScreenGetWidth, ipScreenGetHeight, ipStorageGetSize, ipStorageRead);
-  TOutputPort = (opConsoleWriteChar, opScreenSetAddr, opScreenWrite,
-    opStorageSetAddr, opStorageWrite);
+  TDeviceClass = (dcNone, dcKeyboard, dcMouse, dcStorage, dcScreen, dcConsole);
+  TDeviceClassSet = set of TDeviceClass;
+
+  TDevice = class;
+
+  { TFormDevice }
+
+  TFormDevice = class(TForm)
+  protected
+    function GetDevice: TDevice; virtual;
+    procedure SetDevice(AValue: TDevice); virtual;
+  public
+    property Device: TDevice read GetDevice write SetDevice;
+  end;
+
+  TFormDeviceClass = class of TFormDevice;
+
+  { TDevice }
 
   TDevice = class
+    Index: Integer;
+    Name: string;
+    DeviceClass: TDeviceClass;
     Cpu: TCpu;
     InterruptVector: Integer;
-  end;
+    Form: TFormDevice;
+    procedure OutputHandler(Port, Data: TInteger); virtual;
+    function InputHandler(Port: TInteger): TInteger; virtual;
+  end;
+
+  { TDevices }
+
+  TDevices = class(TObjectList<TDevice>)
+    function GetDevicesCountByClass(DeviceClass: TDeviceClass): Integer;
+    function GetDevicesByClass(DeviceClass: TDeviceClass): TDevices;
+    function GetClasses: TDeviceClassSet;
+  end;
+
+  TDeviceManagerOutputPort = (opDeviceManagerClass, opDeviceManagerFirst, opDeviceManagerNext);
+  TDeviceManagerInputPort = (ipDeviceManagerCount, ipDeviceManagerGet);
+
+  { TDeviceManager }
+
+  TDeviceManager = class(TDevice)
+    DeviceClassFilter: TDeviceClass;
+    Index: Integer;
+    Devices: TDevices;
+    constructor Create;
+    procedure OutputHandler(Port, Data: TInteger); override;
+    function InputHandler(Port: TInteger): TInteger; override;
+  end;
+
+  TConsoleInputPort = (ipConsoleReadChar, ipConsoleInputCount);
+  TConsoleOutputPort = (opConsoleWriteChar);
 
   { TConsole }
@@ -27 +72 @@
     constructor Create;
     destructor Destroy; override;
-  end;
+    procedure OutputHandler(Port, Data: TInteger); override;
+    function InputHandler(Port: TInteger): TInteger; override;
+  end;
+
+  TScreenInputPort = (ipScreenGetWidth, ipScreenGetHeight);
+  TScreenOutputPort = (opScreenSetAddr, opScreenWrite);
 
   { TScreen }
@@ -37 +87 @@
   public
     Address: Integer;
-    Data: array of Byte;
+    VideoMem: array of Byte;
     Modified: Boolean;
     constructor Create;
+    procedure OutputHandler(Port, Data: TInteger); override;
+    function InputHandler(Port: TInteger): TInteger; override;
     property Size: TPoint read FSize write SetSize;
   end;
 
+  TKeyboardInputPort = (ipKeyboardRead);
+
   { TKeyboard }
 
   TKeyboard = class(TDevice)
+    constructor Create;
     function ReadKey: TInteger;
-  end;
+    function InputHandler(Port: TInteger): TInteger; override;
+  end;
+
+  TStorageInputPort = (ipStorageGetSize, ipStorageRead);
+  TStorageOutputPort = (opStorageSetAddr, opStorageWrite);
+
+  { TStorage }
 
   TStorage = class(TDevice)
@@ -53 +114 @@
     F: TFileStream;
     FileName: string;
+    constructor Create;
+    procedure OutputHandler(Port, Data: TInteger); override;
+    function InputHandler(Port: TInteger): TInteger; override;
+  end;
+
+  { TMouse }
+
+  TMouse = class(TDevice)
+    constructor Create;
   end;
 
@@ -59 +129 @@
   TMachine = class
   private
-    procedure OutputHandler(Port, Data: TInteger);
-    function InputHandler(Port: TInteger): TInteger;
+    procedure OutputHandler(Device, Port, Data: TInteger);
+    function InputHandler(Device, Port: TInteger): TInteger;
   public
     Memory: TMemory;
     Cpu: TCpu;
-    Screen: TScreen;
-    Keyboard: TKeyboard;
-    Console: TConsole;
-    Storage: TStorage;
+    Devices: TDevices;
+    procedure RegisterDevice(Device: TDevice);
+    procedure InitDevices;
     procedure PowerOn;
     procedure PowerOff;
@@ -74 +143 @@
   end;
 
+const
+  DeviceClassText: array[TDeviceClass] of string = ('None', 'Keyboard', 'Mouse', 'Storage', 'Screen', 'Console');
+
 
 implementation
 
+{ TDeviceManager }
+
+constructor TDeviceManager.Create;
+begin
+  DeviceClass := dcNone;
+end;
+
+procedure TDeviceManager.OutputHandler(Port, Data: TInteger);
+begin
+  case TDeviceManagerOutputPort(Port) of
+    opDeviceManagerClass: DeviceClassFilter := TDeviceClass(Data);
+    opDeviceManagerFirst: Index := 0;
+    opDeviceManagerNext: Inc(Index);
+  end;
+end;
+
+function TDeviceManager.InputHandler(Port: TInteger): TInteger;
+var
+  ClassDevices: TDevices;
+begin
+  case TDeviceManagerInputPort(Port) of
+    ipDeviceManagerCount: Result := Devices.Count;
+    ipDeviceManagerGet: begin
+      ClassDevices := Devices.GetDevicesByClass(DeviceClassFilter);
+      if (Index >= 0) and (Index < ClassDevices.Count) then
+        Result := ClassDevices[Index].Index
+        else Result := 0;
+      ClassDevices.Free;
+    end;
+  end;
+end;
+
+{ TFormDevice }
+
+function TFormDevice.GetDevice: TDevice;
+begin
+  Result := nil;
+end;
+
+procedure TFormDevice.SetDevice(AValue: TDevice);
+begin
+end;
+
+
+{ TDevices }
+
+function TDevices.GetDevicesCountByClass(DeviceClass: TDeviceClass): Integer;
+var
+  I: Integer;
+begin
+  Result := 0;
+  for I := 0 to Count - 1 do
+    if Items[I].DeviceClass = DeviceClass then Inc(Result);
+end;
+
+function TDevices.GetDevicesByClass(DeviceClass: TDeviceClass): TDevices;
+var
+  I: Integer;
+begin
+  Result := TDevices.Create(False);
+  for I := 0 to Count - 1 do
+    if Items[I].DeviceClass = DeviceClass then Result.Add(Items[I])
+end;
+
+function TDevices.GetClasses: TDeviceClassSet;
+var
+  I: Integer;
+begin
+  Result := [];
+  for I := 0 to Count - 1 do
+    if not (Items[I].DeviceClass in Result) then
+      Result := Result + [Items[I].DeviceClass];
+end;
+
+{ TDevice }
+
+procedure TDevice.OutputHandler(Port, Data: TInteger);
+begin
+end;
+
+function TDevice.InputHandler(Port: TInteger): TInteger;
+begin
+  Result := 0;
+end;
+
+{ TMouse }
+
+constructor TMouse.Create;
+begin
+  DeviceClass := dcMouse;
+end;
+
+{ TStorage }
+
+constructor TStorage.Create;
+begin
+  DeviceClass := dcStorage;
+end;
+
+procedure TStorage.OutputHandler(Port, Data: TInteger);
+begin
+  case TStorageOutputPort(Port) of
+    opStorageSetAddr: F.Position := Data * SizeOf(TInteger);
+    opStorageWrite: begin
+      F.WriteBuffer(Data, SizeOf(TInteger));
+    end;
+  end;
+end;
+
+function TStorage.InputHandler(Port: TInteger): TInteger;
+begin
+  case TStorageInputPort(Port) of
+    ipStorageGetSize: Result := F.Size div 4;
+    ipStorageRead: begin
+      F.ReadBuffer(Result, SizeOf(TInteger));
+    end;
+  end;
+end;
+
 { TConsole }
 
 constructor TConsole.Create;
 begin
+  DeviceClass := dcConsole;
   Lock := TCriticalSection.Create;
   InputBuffer := TQueue<TInteger>.Create;
@@ -94 +286 @@
 end;
 
+procedure TConsole.OutputHandler(Port, Data: TInteger);
+begin
+  case TConsoleOutputPort(Port) of
+    opConsoleWriteChar: begin
+      Lock.Acquire;
+      try
+        OutputBuffer.Enqueue(Data);
+      finally
+        Lock.Release;
+      end;
+    end;
+  end;
+end;
+
+function TConsole.InputHandler(Port: TInteger): TInteger;
+begin
+  case TConsoleInputPort(Port) of
+    ipConsoleReadChar: begin
+      Lock.Acquire;
+      try
+        if InputBuffer.Count > 0 then begin
+          Result := InputBuffer.Dequeue;
+        end else Result := 0;
+      finally
+        Lock.Release;
+      end;
+    end;
+    ipConsoleInputCount: begin
+      Lock.Acquire;
+      try
+        Result := InputBuffer.Count;
+      finally
+        Lock.Release;
+      end;
+    end;
+  end;
+end;
+
 { TScreen }
 
@@ -100 +330 @@
   if FSize = AValue then Exit;
   FSize := AValue;
-  SetLength(Data, FSize.X * FSize.Y);
+  SetLength(VideoMem, FSize.X * FSize.Y);
 end;
 
 constructor TScreen.Create;
 begin
+  DeviceClass := dcScreen;
   Size := Point(640, 480);
 end;
 
+procedure TScreen.OutputHandler(Port, Data: TInteger);
+begin
+  case TScreenOutputPort(Port) of
+    opScreenSetAddr: Address := Data;
+    opScreenWrite: if (Address >= 0) and (Address < Length(VideoMem)) then begin
+      VideoMem[Address] := Data;
+      Inc(Address);
+      Modified := True;
+    end;
+  end;
+end;
+
+function TScreen.InputHandler(Port: TInteger): TInteger;
+begin
+  case TScreenInputPort(Port) of
+    ipScreenGetWidth: Result := Size.X;
+    ipScreenGetHeight: Result := Size.Y;
+  end;
+end;
+
 { TKeyboard }
 
@@ -115 +366 @@
 end;
 
+function TKeyboard.InputHandler(Port: TInteger): TInteger;
+begin
+  case TKeyboardInputPort(Port) of
+    ipKeyboardRead: Result := ReadKey;
+  end;
+end;
+
+constructor TKeyboard.Create;
+begin
+  DeviceClass := dcKeyboard;
+end;
+
 { TMachine }
 
-procedure TMachine.OutputHandler(Port, Data: TInteger);
-begin
-  case TOutputPort(Port) of
-    opConsoleWriteChar: begin
-      Console.Lock.Acquire;
-      try
-        Console.OutputBuffer.Enqueue(Data);
-      finally
-        Console.Lock.Release;
-      end;
-    end;
-    opScreenSetAddr: Screen.Address := Data;
-    opScreenWrite: if (Screen.Address >= 0) and (Screen.Address < Length(Screen.Data)) then begin
-      Screen.Data[Screen.Address] := Data;
-      Inc(Screen.Address);
-      Screen.Modified := True;
-    end;
-    opStorageSetAddr: Storage.F.Position := Data * SizeOf(TInteger);
-    opStorageWrite: begin
-      Storage.F.WriteBuffer(Data, SizeOf(TInteger));
-    end;
-  end;
-end;
-
-function TMachine.InputHandler(Port: TInteger): TInteger;
-begin
-  case TInputPort(Port) of
-    ipConsoleReadChar: begin
-      Console.Lock.Acquire;
-      try
-        if Console.InputBuffer.Count > 0 then begin
-          Result := Console.InputBuffer.Dequeue;
-        end else Result := 0;
-      finally
-        Console.Lock.Release;
-      end;
-    end;
-    ipConsoleInputCount: begin
-      Console.Lock.Acquire;
-      try
-        Result := Console.InputBuffer.Count;
-      finally
-        Console.Lock.Release;
-      end;
-    end;
-    ipKeyboardRead: Result := Keyboard.ReadKey;
-    ipScreenGetWidth: Result := Screen.Size.X;
-    ipScreenGetHeight: Result := Screen.Size.Y;
-    ipStorageGetSize: Result := Storage.F.Size div 4;
-    ipStorageRead: begin
-      Storage.F.ReadBuffer(Result, SizeOf(TInteger));
-    end;
-  end;
+procedure TMachine.OutputHandler(Device, Port, Data: TInteger);
+begin
+  if (Device > 0) and (Device < Devices.Count) then
+    Devices[Device].OutputHandler(Port, Data);
+end;
+
+function TMachine.InputHandler(Device, Port: TInteger): TInteger;
+begin
+  if (Device > 0) and (Device < Devices.Count) then
+    Result := Devices[Device].InputHandler(Port)
+    else Result := 0;
+end;
+
+procedure TMachine.RegisterDevice(Device: TDevice);
+begin
+  Device.Index := Devices.Count;
+  Device.Cpu := Cpu;
+  Device.Name := DeviceClassText[Device.DeviceClass] + ' ' +
+    IntToStr(Devices.GetDevicesCountByClass(Device.DeviceClass) + 1);
+  Devices.Add(Device);
+end;
+
+procedure TMachine.InitDevices;
+var
+  Screen: TScreen;
+  Keyboard: TKeyboard;
+  Console: TConsole;
+  Storage: TStorage;
+  Mouse: TMouse;
+  DeviceManager: TDeviceManager;
+begin
+  DeviceManager := TDeviceManager.Create;
+  DeviceManager.Devices := Devices;
+  RegisterDevice(DeviceManager);
+
+  Console := TConsole.Create;
+  RegisterDevice(Console);
+  Console.InterruptVector := 1;
+
+  Keyboard := TKeyboard.Create;
+  RegisterDevice(Keyboard);
+
+  Screen := TScreen.Create;
+  RegisterDevice(Screen);
+
+  Storage := TStorage.Create;
+  RegisterDevice(Storage);
+
+  Storage := TStorage.Create;
+  RegisterDevice(Storage);
+
+  Mouse := TMouse.Create;
+  RegisterDevice(Mouse);
 end;
 
@@ -185 +448 @@
 constructor TMachine.Create;
 begin
+  Devices := TDevices.Create;
   Memory := TMemory.Create;
   Memory.Size := 10000;
@@ -190 +454 @@
   Cpu.OnInput := InputHandler;
   Cpu.OnOutput := OutputHandler;
-  Keyboard := TKeyboard.Create;
-  Keyboard.Cpu := Cpu;
-  Screen := TScreen.Create;
-  Screen.Cpu := Cpu;
-  Console := TConsole.Create;
-  Console.Cpu := Cpu;
-  Console.InterruptVector := 1;
-  Storage := TStorage.Create;
-  Storage.Cpu := Cpu;
+  InitDevices;
 end;
 
@@ -204 +460 @@
 begin
   PowerOff;
-  FreeAndNil(Storage);
-  FreeAndNil(Console);
-  FreeAndNil(Screen);
-  FreeAndNil(Keyboard);
-  FreeAndNil(Cpu);
-  FreeAndNil(Memory);
+  FreeAndNil(Devices);
   inherited;
 end;