source: branches/configured machine/CpuLevels.pas

unit CpuLevels;

interface

uses
  Classes, SysUtils, Math;

type
  TInstruction = (inNop, inReti, inLoadMem, inStoreMem, inInput, inOutput,
    inDescend, inAscend, inStoreSys, inSysCall);

  TInstructionCall = procedure of object;

  TData = Integer;
  PData = ^TData;

  { TLevel }

  TLevel = class
    Level: Byte;
    MemoryBase: PByte;
    MemorySize: Integer;
    VirtMemBase: TData;
    VirtMemSize: TData;
    SP: TData;
    PC: TData;
    InstructionHandlers: array[TInstruction] of TInstructionCall;
    function ReadMem(Address: TData): TData;
    procedure WriteMem(Address: TData; Data: TData);
  end;

  TInputEvent = function(Address: TData): TData of object;
  TOutputEvent = procedure(Address: TData; Data: TData) of object;

  { TCpu }

  TCpu = class
  private
    FLevelIndex: Integer;
    FOnInput: TInputEvent;
    FOnOutput: TOutputEvent;
    procedure InitInstructionHandlers(Level: TLevel; Index: Integer);
    procedure SetLevelIndex(AValue: Integer);
    procedure InstructionNop;
    procedure InstructionLoadMem;
    procedure InstructionStoreMem;
    procedure InstructionReti;
    procedure InstructionUnknown;
    procedure InstructionInput;
    procedure InstructionOutput;
    procedure InstructionDescend;
    procedure InstructionAscend;
    procedure InstructionStoreSys;
    procedure InstructionSysCall;
    procedure RebuildMem;
  public
    Levels: array of TLevel;
    Level: TLevel;
    InterruptedLevel: Integer;
    InterruptEnabled: Boolean;
    InterruptPending: Boolean;
    InterruptVector: Integer;
    Terminated: Boolean;
    A: TData;
    function ReadByte: Byte;
    function ReadData: TData;
    procedure Step;
    procedure Run;
    procedure Reset;
    procedure Interrupt(Vector: Integer);
    procedure Push(Value: TData);
    function Pop: TData;
    constructor Create;
    property LevelIndex: Integer read FLevelIndex write SetLevelIndex;
    property OnInput: TInputEvent read FOnInput write FOnInput;
    property OnOutput: TOutputEvent read FOnOutput write FOnOutput;
  end;

const
  InterruptVectorReset = 0;
  InterruptVectorUnknownInstruction = 1;
  InterruptVectorSysCall = 2;

implementation

{ TLevel }

function TLevel.ReadMem(Address: TData): TData;
begin
  Result := PData(MemoryBase + Address)^;
end;

procedure TLevel.WriteMem(Address: TData; Data: TData);
begin
  PData(MemoryBase + Address)^ := Data;
end;

{ TCpu }

procedure TCpu.InitInstructionHandlers(Level: TLevel; Index: Integer);
begin
  with Level do begin
    InstructionHandlers[inNop] := InstructionNop;
    InstructionHandlers[inLoadMem] := InstructionLoadMem;
    InstructionHandlers[inStoreMem] := InstructionStoreMem;
    InstructionHandlers[inAscend] := InstructionAscend;
    InstructionHandlers[inDescend] := InstructionDescend;
    InstructionHandlers[inStoreSys] := InstructionStoreSys;
    if Index = 0 then begin
      InstructionHandlers[inInput] := InstructionInput;
      InstructionHandlers[inOutput] := InstructionOutput;
      InstructionHandlers[inReti] := InstructionReti;
    end else begin
      InstructionHandlers[inInput] := InstructionUnknown;
      InstructionHandlers[inOutput] := InstructionUnknown;
      InstructionHandlers[inReti] := InstructionUnknown;
    end;
  end;
end;

procedure TCpu.SetLevelIndex(AValue: Integer);
begin
  if FLevelIndex = AValue then Exit;
  FLevelIndex := AValue;
  Level := Levels[FLevelIndex];
end;

procedure TCpu.InstructionNop;
begin
  // Do nothing
end;

procedure TCpu.InstructionLoadMem;
var
  Addr: Byte;
begin
  Addr := ReadByte;
  A := Level.ReadMem(Addr);
end;

procedure TCpu.InstructionStoreMem;
var
  Addr: Byte;
begin
  Addr := ReadByte;
  Level.WriteMem(Addr, A);
end;

function TCpu.ReadByte: Byte;
begin
  Result := PByte(Level.MemoryBase + Level.PC)^;
  Inc(Level.PC);
end;

function TCpu.ReadData: TData;
begin
  Result := PData(Level.MemoryBase + Level.PC)^;
  Inc(Level.PC, SizeOf(TData));
end;

procedure TCpu.Step;
var
  Instruction: TInstruction;
begin
  if InterruptEnabled and InterruptPending then begin
    InterruptEnabled := False;
    InterruptPending := False;
    InterruptedLevel := LevelIndex;
    LevelIndex := 0;
    Push(Level.PC);
    Level.PC := InterruptVector;
  end else begin
    Instruction := TInstruction(ReadByte);
    Level.InstructionHandlers[Instruction];
  end;
end;

procedure TCpu.Run;
begin
  Reset;
  while not Terminated do
    Step;
end;

procedure TCpu.Reset;
begin
  Terminated := False;
  InterruptEnabled := True;
  InterruptPending := False;
  InterruptVector := 0;
  LevelIndex := 0;
  Level.PC := 0;
  Level.SP := 0;
  InitInstructionHandlers(Level, 0);
end;

procedure TCpu.Interrupt(Vector: Integer);
begin
  InterruptPending := True;
  InterruptVector := Vector;
end;

procedure TCpu.InstructionReti;
begin
  Level.PC := Pop;
  LevelIndex := InterruptedLevel;
  InterruptEnabled := True;
end;

procedure TCpu.InstructionUnknown;
begin
  if LevelIndex = 0 then Interrupt(1)
  else begin
    InterruptedLevel := LevelIndex;
    LevelIndex := LevelIndex - 1;
    Level.PC := InterruptVectorUnknownInstruction;
    //Level.A := LastInstruction;
  end;
end;

procedure TCpu.InstructionInput;
var
  Address: TData;
begin
  Address := ReadData;
  if Assigned(FOnInput) then A := FOnInput(Address);
end;

procedure TCpu.InstructionOutput;
var
  Address: TData;
begin
  Address := ReadData;
  if Assigned(FOnOutput) then FOnOutput(Address, A);
end;

procedure TCpu.InstructionDescend;
begin
  if LevelIndex < Length(Levels) - 1 then
    LevelIndex := LevelIndex + 1;
end;

procedure TCpu.InstructionAscend;
begin
  if LevelIndex > 0 then
    LevelIndex := LevelIndex - 1;
end;

procedure TCpu.InstructionStoreSys;
var
  Index: Byte;
  Data: TData;
begin
  Index := ReadByte;
  Data := ReadData;
  case Index of
    0: Levels[LevelIndex + 1].PC := Data;
    1: Levels[LevelIndex + 1].SP := Data;
    2: begin
      Levels[LevelIndex + 1].VirtMemBase := Data;
      RebuildMem;
    end;
    3: begin
      Levels[LevelIndex + 1].VirtMemSize := Data;
      RebuildMem;
    end;
  end;
end;

procedure TCpu.InstructionSysCall;
var
  Index: TData;
begin
  Index := ReadData;
  InstructionAscend;
  Level.PC := InterruptVectorSysCall;
  A := Index;
end;

procedure TCpu.RebuildMem;
var
  I: Integer;
begin
  for I := 0 to Length(Levels) - 2 do begin
    Levels[I + 1].MemoryBase := Levels[I].MemoryBase + Levels[I + 1].VirtMemBase;
    Levels[I + 1].MemorySize := Min(Levels[I].MemorySize - Levels[I + 1].VirtMemBase, Levels[I + 1].VirtMemSize);
  end;
end;

procedure TCpu.Push(Value: TData);
begin
  Dec(Level.SP, SizeOf(TData));
  Level.WriteMem(Level.SP, Value);
end;

function TCpu.Pop: TData;
begin
  Result := Level.ReadMem(Level.SP);
  Inc(Level.SP, SizeOf(TData));
end;

constructor TCpu.Create;
var
  I: Integer;
begin
  SetLength(Levels, 8);
  for I := 0 to Length(Levels) - 1 do
    Levels[I].Level := I;
end;

end.

LD   A, n
LDM  A, (n)
LDM  A, (B)
STM  (A), B
LDS  A, (B)
STS  (A), B
ASCD
DSND
IN   A, (n)
OUT  (n), A
SYS  n
RETI