source: branches/UltimatOS/UMachine.pas

unit UMachine;

interface

uses
  Classes, SysUtils, UCpu, UMemory, ExtCtrls;

type
  TMachine = class;

  { TDevice }

  TDevice = class
    Machine: TMachine;
    procedure Reset; virtual;
    procedure OutputHandler(Port: TAddress; Data: TData); virtual; abstract;
    function InputHandler(Port: TAddress): TData;  virtual; abstract;
  end;

  { TMouse }

  TMouse = class(TDevice)
    Position: TPoint;
    InterruptVector: Integer;
    procedure Move(X, Y: Integer);
  end;

  { TScreen }

  TScreen = class(TDevice)
  private
    FWidth: Integer;
    FHeight: Integer;
    Pointer: Integer;
    function GetSize: TPoint;
    procedure SetSize(AValue: TPoint);
  public
    Memory: TMemory;
    PendingRefresh: Boolean;
    procedure Reset; override;
    procedure SetPointer(Value: Integer);
    procedure WriteData(Value: Integer);
    property Size: TPoint read GetSize write SetSize;
    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    constructor Create;
    destructor Destroy; override;
  end;

  { TFifo }

  TFifo = class
    Data: array of Integer;
    procedure Put(Value: Integer);
    function Get: Integer;
    function Size: Integer;
    procedure Clear;
  end;

  { TKeyboard }

  TKeyboard = class(TDevice)
    Buffer: TFifo;
    InterruptVector: Integer;
    function ReadKey: Integer;
    function KeyReady: Integer;
    constructor Create;
    destructor Destroy; override;
    procedure Reset; override;
    procedure Press(KeyCode: Integer);
  end;

  { TCounter }

  TCounter = class(TDevice)
  private
    Timer: TTimer;
    function GetEnabled: Boolean;
    function GetInterval: Integer;
    procedure SetEnabled(AValue: Boolean);
    procedure SetInterval(AValue: Integer);
    procedure DoTimer(Sender: TObject);
  public
    InterruptVector: Integer;
    constructor Create;
    destructor Destroy; override;
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property Interval: Integer read GetInterval write SetInterval;
  end;

  { TStorage }

  TStorage = class(TDevice)
  public
    F: TFileStream;
    FileName: string;
    constructor Create;
    procedure OutputHandler(Port: TAddress; Data: TData); override;
    function InputHandler(Port: TAddress): TData; override;
  end;

  { TMachine }

  TMachine = class
  private
    function CpuInput(Address: TAddress): TData;
    procedure CpuOutput(Address: TAddress; Value: TData);
    function GetRunning: Boolean;
    procedure SetRunning(AValue: Boolean);
  public
    Cpu: TCpu;
    Memory: TMemory;
    Keyboard: TKeyboard;
    Mouse: TMouse;
    Screen: TScreen;
    Counter: TCounter;
    procedure Reset;
    constructor Create;
    destructor Destroy; override;
    property Running: Boolean read GetRunning write SetRunning;
  end;


implementation

{ TStorage }

constructor TStorage.Create;
begin

end;

procedure TStorage.OutputHandler(Port: TAddress; Data: TData);
begin

end;

function TStorage.InputHandler(Port: TAddress): TData;
begin

end;

{ TMouse }

procedure TMouse.Move(X, Y: Integer);
begin
  Position := Point(X, Y);
  Machine.Cpu.Interrupt(InterruptVector);
end;

{ TCounter }

function TCounter.GetEnabled: Boolean;
begin
  Result := Timer.Enabled;
end;

function TCounter.GetInterval: Integer;
begin
  Result := Timer.Interval;
end;

procedure TCounter.SetEnabled(AValue: Boolean);
begin
  Timer.Enabled := AValue;
end;

procedure TCounter.SetInterval(AValue: Integer);
begin
  Timer.Interval := AValue;
end;

procedure TCounter.DoTimer(Sender: TObject);
begin
  Machine.Cpu.Interrupt(InterruptVector);
end;

constructor TCounter.Create;
begin
  Timer := TTimer.Create(nil);
  Timer.OnTimer := DoTimer;
  Enabled := False;
end;

destructor TCounter.Destroy;
begin
  FreeAndNil(Timer);
  inherited;
end;

{ TDevice }

procedure TDevice.Reset;
begin
end;

{ TScreen }

function TScreen.GetSize: TPoint;
begin
  Result := Point(FWidth, FHeight);
end;

procedure TScreen.SetSize(AValue: TPoint);
begin
  FWidth := AValue.X;
  FHeight := AValue.Y;
  Memory.Size := FWidth * FHeight * SizeOf(Integer);
end;

procedure TScreen.Reset;
begin
  Pointer := 0;
end;

procedure TScreen.SetPointer(Value: Integer);
begin
  Pointer := Value;
end;

procedure TScreen.WriteData(Value: Integer);
begin
  PInteger(@Memory.Data[Pointer])^ := Value;
  Pointer := (Pointer + SizeOf(Integer)) mod Memory.Size;
  PendingRefresh := True;
end;

constructor TScreen.Create;
begin
  Memory := TMemory.Create;
end;

destructor TScreen.Destroy;
begin
  FreeAndNil(Memory);
  inherited;
end;

{ TFifo }

procedure TFifo.Put(Value: Integer);
begin
  SetLength(Data, Length(Data) + 1);
  Data[Length(Data) - 1] := Value;
end;

function TFifo.Get: Integer;
begin
  if Size > 0 then begin
    Result := Data[0];
    Move(Data[1], Data[0], (Size - 1) * SizeOf(Integer));
    SetLength(Data, Length(Data) - 1);
  end else raise Exception.Create('Read from empty FIFO buffer');
end;

function TFifo.Size: Integer;
begin
  Result := Length(Data);
end;

procedure TFifo.Clear;
begin
  SetLength(Data, 0);
end;

{ TKeyboard }

function TKeyboard.ReadKey: Integer;
begin
  Result := Buffer.Get;
end;

function TKeyboard.KeyReady: Integer;
begin
  if Buffer.Size > 0 then Result := 1
    else Result := 0;
end;

constructor TKeyboard.Create;
begin
  Buffer := TFifo.Create;
end;

destructor TKeyboard.Destroy;
begin
  FreeAndNil(Buffer);
  inherited;
end;

procedure TKeyboard.Reset;
begin
  Buffer.Clear;
end;

procedure TKeyboard.Press(KeyCode: Integer);
begin
  Buffer.Put(KeyCode);
  Machine.Cpu.Interrupt(InterruptVector);
end;

{ TMachine }

function TMachine.CpuInput(Address: TAddress): TData;
begin
  if Address = 0 then Result := Keyboard.ReadKey
  else if Address = 1 then Result := Mouse.Position.X
  else if Address = 2 then Result := Mouse.Position.Y
  else if Address = 3 then Result := Screen.Size.X
  else if Address = 4 then Result := Screen.Size.Y
  else if Address = 5 then Result := Keyboard.KeyReady
  else Result := 0;
end;

procedure TMachine.CpuOutput(Address: TAddress; Value: TData);
begin
  if Address = 0 then Screen.SetPointer(Value)
  else if Address = 1 then Screen.WriteData(Value)
  else if Address = 2 then Counter.Interval := Value
  else if Address = 3 then Counter.Enabled := Value = 1;
end;

function TMachine.GetRunning: Boolean;
begin
  Result := Cpu.Running;
end;

procedure TMachine.SetRunning(AValue: Boolean);
begin
  Cpu.Running := AValue;
end;

procedure TMachine.Reset;
begin
  Screen.Reset;
  Cpu.Reset;
  FillChar(Memory.Data^, Memory.Size, 0);
end;

constructor TMachine.Create;
begin
  Counter := TCounter.Create;
  Counter.Machine := Self;
  Counter.InterruptVector := 2;
  Memory := TMemory.Create;
  Memory.Size := 200000;
  Keyboard := TKeyboard.Create;
  Keyboard.Machine := Self;
  Keyboard.InterruptVector := 4;
  Mouse := TMouse.Create;
  Mouse.Machine := Self;
  Mouse.InterruptVector := 3;
  Screen := TScreen.Create;
  Screen.Size := Point(640, 480);
  Cpu := TCpu.Create;
  Cpu.Memory := Memory;
  Cpu.OnInput := CpuInput;
  Cpu.OnOutput := CpuOutput;
end;

destructor TMachine.Destroy;
begin
  FreeAndNil(Cpu);
  FreeAndNil(Mouse);
  FreeAndNil(Keyboard);
  FreeAndNil(Screen);
  FreeAndNil(Memory);
  FreeAndNil(Counter);
  inherited;
end;

end.