source: branches/CpuSingleSize/Machine.pas

unit Machine;

interface

uses
  Classes, SysUtils, Cpu, Syncobjs, Memory, Generics.Collections, Forms;

type
  TDeviceClass = (dcNone, dcKeyboard, dcMouse, dcStorage, dcScreen, dcConsole,
    dcTimer);
  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;
    Form: TFormDevice;
    destructor Destroy; override;
    procedure PulseInterrupt;
    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);

  { TDeviceConsole }

  TDeviceConsole = class(TDevice)
    Lock: TCriticalSection;
    InputBuffer: TQueue<TInteger>;
    OutputBuffer: TQueue<TInteger>;
    constructor Create;
    destructor Destroy; override;
    procedure OutputHandler(Port, Data: TInteger); override;
    function InputHandler(Port: TInteger): TInteger; override;
  end;

  TScreenInputPort = (ipScreenGetWidth, ipScreenGetHeight);
  TScreenOutputPort = (opScreenSetAddr, opScreenWrite);

  { TDeviceScreen }

  TDeviceScreen = class(TDevice)
  private
    FSize: TPoint;
    procedure SetSize(AValue: TPoint);
  public
    Address: Integer;
    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);

  { TDeviceKeyboard }

  TDeviceKeyboard = class(TDevice)
    constructor Create;
    function ReadKey: TInteger;
    function InputHandler(Port: TInteger): TInteger; override;
  end;

  TStorageInputPort = (ipStorageGetSize, ipStorageRead);
  TStorageOutputPort = (opStorageSetAddr, opStorageWrite);

  { TDeviceStorage }

  TDeviceStorage = class(TDevice)
  public
    F: TFileStream;
    FileName: string;
    constructor Create;
    procedure OutputHandler(Port, Data: TInteger); override;
    function InputHandler(Port: TInteger): TInteger; override;
  end;

  { TDeviceMouse }

  TDeviceMouse = class(TDevice)
    constructor Create;
  end;

  TTimerOutputPort = (opTimerSetInterval, opTimerSetEnabled);
  { TDeviceTimer }

  TDeviceTimer = class(TDevice)
    Interval: Integer;
    Enabled: Boolean;
    constructor Create;
    procedure OutputHandler(Port, Data: TInteger); override;
  end;

  { TMachine }

  TMachine = class
  private
    procedure OutputHandler(Device, Port, Data: TInteger);
    function InputHandler(Device, Port: TInteger): TInteger;
  public
    Memory: TMemory;
    Cpu: TCpu;
    Devices: TDevices;
    procedure RegisterDevice(Device: TDevice);
    procedure InitDevices;
    procedure PowerOn;
    procedure PowerOff;
    constructor Create;
    destructor Destroy; override;
  end;

const
  DeviceClassText: array[TDeviceClass] of string = ('None', 'Keyboard', 'Mouse', 'Storage', 'Screen', 'Console', 'Timer');


implementation

{ TDeviceTimer }

constructor TDeviceTimer.Create;
begin
  DeviceClass := dcTimer;
end;

procedure TDeviceTimer.OutputHandler(Port, Data: TInteger);
begin
  case TTimerOutputPort(Port) of
    opTimerSetInterval: Interval := Data;
    opTimerSetEnabled: Enabled := Data > 0;
  end;
end;

{ 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 }

destructor TDevice.Destroy;
begin
  if Assigned(Form) then FreeAndNil(Form);
  inherited;
end;

procedure TDevice.PulseInterrupt;
begin
  Cpu.Interrupt(InterruptVector);
end;

procedure TDevice.OutputHandler(Port, Data: TInteger);
begin
end;

function TDevice.InputHandler(Port: TInteger): TInteger;
begin
  Result := 0;
end;

{ TDeviceMouse }

constructor TDeviceMouse.Create;
begin
  DeviceClass := dcMouse;
end;

{ TDeviceStorage }

constructor TDeviceStorage.Create;
begin
  DeviceClass := dcStorage;
end;

procedure TDeviceStorage.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 TDeviceStorage.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;

{ TDeviceConsole }

constructor TDeviceConsole.Create;
begin
  DeviceClass := dcConsole;
  Lock := TCriticalSection.Create;
  InputBuffer := TQueue<TInteger>.Create;
  OutputBuffer := TQueue<TInteger>.Create;
end;

destructor TDeviceConsole.Destroy;
begin
  InputBuffer.Free;
  OutputBuffer.Free;
  Lock.Free;
  inherited;
end;

procedure TDeviceConsole.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 TDeviceConsole.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;

{ TDeviceScreen }

procedure TDeviceScreen.SetSize(AValue: TPoint);
begin
  if FSize = AValue then Exit;
  FSize := AValue;
  SetLength(VideoMem, FSize.X * FSize.Y);
end;

constructor TDeviceScreen.Create;
begin
  DeviceClass := dcScreen;
  Size := Point(640, 480);
end;

procedure TDeviceScreen.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 TDeviceScreen.InputHandler(Port: TInteger): TInteger;
begin
  case TScreenInputPort(Port) of
    ipScreenGetWidth: Result := Size.X;
    ipScreenGetHeight: Result := Size.Y;
  end;
end;

{ TDeviceKeyboard }

function TDeviceKeyboard.ReadKey: TInteger;
begin
  Result := 0;
end;

function TDeviceKeyboard.InputHandler(Port: TInteger): TInteger;
begin
  case TKeyboardInputPort(Port) of
    ipKeyboardRead: Result := ReadKey;
  end;
end;

constructor TDeviceKeyboard.Create;
begin
  DeviceClass := dcKeyboard;
end;

{ TMachine }

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: TDeviceScreen;
  Keyboard: TDeviceKeyboard;
  Console: TDeviceConsole;
  Storage: TDeviceStorage;
  Mouse: TDeviceMouse;
  DeviceManager: TDeviceManager;
  Timer: TDeviceTimer;
begin
  DeviceManager := TDeviceManager.Create;
  DeviceManager.Devices := Devices;
  RegisterDevice(DeviceManager);

  Console := TDeviceConsole.Create;
  RegisterDevice(Console);
  Console.InterruptVector := 1;

  Keyboard := TDeviceKeyboard.Create;
  Keyboard.InterruptVector := 4;
  RegisterDevice(Keyboard);

  Screen := TDeviceScreen.Create;
  RegisterDevice(Screen);

  Storage := TDeviceStorage.Create;
  RegisterDevice(Storage);

  Storage := TDeviceStorage.Create;
  RegisterDevice(Storage);

  Mouse := TDeviceMouse.Create;
  Mouse.InterruptVector := 3;
  RegisterDevice(Mouse);

  Timer := TDeviceTimer.Create;
  Timer.InterruptVector := 2;
  RegisterDevice(Timer);
end;

procedure TMachine.PowerOn;
begin
  Cpu.Memory := Memory.Data;
  Cpu.Start;
end;

procedure TMachine.PowerOff;
begin
  Cpu.Stop;
end;

constructor TMachine.Create;
begin
  Devices := TDevices.Create;
  Memory := TMemory.Create;
  Memory.Size := 10000;
  Cpu := TCpu.Create;
  Cpu.OnInput := InputHandler;
  Cpu.OnOutput := OutputHandler;
  InitDevices;
end;

destructor TMachine.Destroy;
begin
  PowerOff;
  FreeAndNil(Cpu);
  FreeAndNil(Memory);
  FreeAndNil(Devices);
  inherited;
end;

end.