source: branches/UltimatOS/UCpu.pas

unit UCpu;

interface

uses
  Classes, SysUtils, UMemory;

type
  TInstruction = (inNop, inHalt, inSet, inInput, inOutput, inInc, inDec, inJp,
    inJpz, inJpnz, inAdd, inSub, inCall, inRet, inPush, inPop, inCopy,
    inShl, inShr, inLoad, inLoadi, inStore, inMul, inAnd, inAndi, inOr, inXor,
    inInt, inReti, inEnableInt, inDisableInt);
  TAddress = Integer;
  PAddress = ^TAddress;
  TData = Integer;
  PData = ^TData;
  TRegister = Integer;

  TOnInput = function (Address: Integer): TData of object;
  TOnOutput = procedure (Address: Integer; Value: TData) of object;

  TCpu = class;
  TInstructionHandler = procedure of object;

  { TCpuThread }

  TCpuThread = class(TThread)
    Cpu: TCpu;
    procedure Execute; override;
    destructor Destroy; override;
  end;

  { TCpu }

  TCpu = class
  private
    FCpuThread: TCpuThread;
    FOnInput: TOnInput;
    FOnOutput: TOnOutput;
    InterruptPending: Boolean;
    InterruptVector: Integer;
    InterruptEnabled: Boolean;
    FInstructionHandlers: array[TInstruction] of TInstructionHandler;
    function GetRunning: Boolean;
    function ReadByte: Byte; inline;
    function ReadAddress: TAddress; inline;
    function ReadData: TData; inline;
    procedure Push(Value: Integer); inline;
    function Pop: Integer; inline;
    procedure SetRunning(AValue: Boolean);
    procedure InitInstructions;
    procedure InstructionNop;
    procedure InstructionHalt;
    procedure InstructionSet;
    procedure InstructionInput;
    procedure InstructionOutput;
    procedure InstructionInc;
    procedure InstructionDec;
    procedure InstructionJp;
    procedure InstructionJpnz;
    procedure InstructionJpz;
    procedure InstructionAdd;
    procedure InstructionSub;
    procedure InstructionCall;
    procedure InstructionRet;
    procedure InstructionPush;
    procedure InstructionPop;
    procedure InstructionCopy;
    procedure InstructionShl;
    procedure InstructionShr;
    procedure InstructionLoad;
    procedure InstructionLoadi;
    procedure InstructionStore;
    procedure InstructionMul;
    procedure InstructionAnd;
    procedure InstructionAndi;
    procedure InstructionOr;
    procedure InstructionXor;
    procedure InstructionInt;
    procedure InstructionReti;
    procedure InstructionEnableInt;
    procedure InstructionDisableInt;
  public
    Ticks: Int64;
    InterruptCount: Integer;
    Terminated: Boolean;
    Memory: TMemory;
    R: array[0..15] of TRegister;
    IP: TAddress;
    SP: TAddress;
    procedure Run;
    procedure Start;
    procedure Stop;
    procedure Step;
    procedure Reset;
    procedure Interrupt(Vector: Integer);
    constructor Create;
    destructor Destroy; override;
    property OnInput: TOnInput read FOnInput write FOnInput;
    property OnOutput: TOnOutput read FOnOutput write FOnOutput;
    property Running: Boolean read GetRunning write SetRunning;
  end;


implementation

{ TCpuThread }

procedure TCpuThread.Execute;
begin
  Cpu.Run;
end;

destructor TCpuThread.Destroy;
begin
  Cpu.FCpuThread := nil;
  inherited;
end;

{ TCpu }

function TCpu.ReadByte: Byte;
begin
  Result := Memory.Data[IP];
  IP := (IP + 1) mod Memory.Size;
end;

function TCpu.GetRunning: Boolean;
begin
  Result := Assigned(FCpuThread);
end;

function TCpu.ReadAddress: TAddress;
begin
  Result := PAddress(@Memory.Data[IP])^;
  IP := (IP + SizeOf(TAddress)) mod Memory.Size;
end;

function TCpu.ReadData: TData;
begin
  Result := PData(@Memory.Data[IP])^;
  IP := (IP + SizeOf(TData)) mod Memory.Size;
end;

procedure TCpu.Push(Value: Integer);
begin
  SP := (SP - SizeOf(TAddress) + Memory.Size) mod Memory.Size;
  PAddress(@Memory.Data[SP])^ := Value;
end;

function TCpu.Pop: Integer;
begin
  Result := PAddress(@Memory.Data[SP])^;
  SP := (SP + SizeOf(TAddress)) mod Memory.Size;
end;

procedure TCpu.SetRunning(AValue: Boolean);
begin
  if AValue and not Assigned(FCpuThread) then begin
    FCpuThread := TCpuThread.Create(True);
    FCpuThread.FreeOnTerminate := False;
    FCpuThread.Cpu := Self;
    FCpuThread.Start;
  end else
  if not AValue and Assigned(FCpuThread) then begin
    Terminated := True;
    FreeAndNil(FCpuThread);
  end;
end;

procedure TCpu.InitInstructions;
begin
  FInstructionHandlers[inNop] := InstructionNop;
  FInstructionHandlers[inHalt] := InstructionHalt;
  FInstructionHandlers[inSet] := InstructionSet;
  FInstructionHandlers[inInput] := InstructionInput;
  FInstructionHandlers[inOutput] := InstructionOutput;
  FInstructionHandlers[inInc] := InstructionInc;
  FInstructionHandlers[inDec] := InstructionDec;
  FInstructionHandlers[inJp] := InstructionJp;
  FInstructionHandlers[inJpz] := InstructionJpz;
  FInstructionHandlers[inJpnz] := InstructionJpnz;
  FInstructionHandlers[inAdd] := InstructionAdd;
  FInstructionHandlers[inSub] := InstructionSub;
  FInstructionHandlers[inCall] := InstructionCall;
  FInstructionHandlers[inRet] := InstructionRet;
  FInstructionHandlers[inPush] := InstructionPush;
  FInstructionHandlers[inPop] := InstructionPop;
  FInstructionHandlers[inCopy] := InstructionCopy;
  FInstructionHandlers[inShl] := InstructionShl;
  FInstructionHandlers[inShr] := InstructionShr;
  FInstructionHandlers[inLoad] := InstructionLoad;
  FInstructionHandlers[inLoadi] := InstructionLoadi;
  FInstructionHandlers[inStore] := InstructionStore;
  FInstructionHandlers[inMul] := InstructionMul;
  FInstructionHandlers[inAnd] := InstructionAnd;
  FInstructionHandlers[inAndi] := InstructionAndi;
  FInstructionHandlers[inOr] := InstructionOr;
  FInstructionHandlers[inXor] := InstructionXor;
  FInstructionHandlers[inInt] := InstructionInt;
  FInstructionHandlers[inReti] := InstructionReti;
  FInstructionHandlers[inEnableInt] := InstructionEnableInt;
  FInstructionHandlers[inDisableInt] := InstructionDisableInt;
end;

procedure TCpu.InstructionNop;
begin
  // No operation
end;

procedure TCpu.InstructionHalt;
begin
  Terminated := True;
end;

procedure TCpu.InstructionSet;
var
  RegIndex: Byte;
begin
  RegIndex := ReadByte;
  R[RegIndex] := ReadData;
end;

procedure TCpu.InstructionInput;
var
  RegIndex: Byte;
  Address: TAddress;
begin
  RegIndex := ReadByte;
  Address := ReadAddress;
  if Assigned(FOnInput) then R[RegIndex] := FOnInput(Address)
    else R[RegIndex] := 0;
end;

procedure TCpu.InstructionOutput;
var
  RegIndex: Byte;
  Address: TAddress;
begin
  Address := ReadAddress;
  RegIndex := ReadByte;
  if Assigned(FOnOutput) then FOnOutput(Address, R[RegIndex]);
end;

procedure TCpu.InstructionInc;
var
  RegIndex: Byte;
begin
  RegIndex := ReadByte;
  R[RegIndex] := R[RegIndex] + 1;
end;

procedure TCpu.InstructionDec;
var
  RegIndex: Byte;
begin
  RegIndex := ReadByte;
  R[RegIndex] := R[RegIndex] - 1;
end;

procedure TCpu.InstructionJp;
begin
  IP := ReadAddress;
end;

procedure TCpu.InstructionJpnz;
var
  RegIndex: Byte;
  Address: TAddress;
begin
  RegIndex := ReadByte;
  Address := ReadAddress;
  if R[RegIndex] <> 0 then IP := Address;
end;

procedure TCpu.InstructionJpz;
var
  RegIndex: Byte;
  Address: TAddress;
begin
  RegIndex := ReadByte;
  Address := ReadAddress;
  if R[RegIndex] = 0 then IP := Address;
end;

procedure TCpu.InstructionAdd;
var
  RegIndex: Byte;
  RegIndex2: Byte;
begin
  RegIndex := ReadByte;
  RegIndex2 := ReadByte;
  R[RegIndex] := R[RegIndex] + R[RegIndex2];
end;

procedure TCpu.InstructionSub;
var
  RegIndex: Byte;
  RegIndex2: Byte;
begin
  RegIndex := ReadByte;
  RegIndex2 := ReadByte;
  R[RegIndex] := R[RegIndex] - R[RegIndex2];
end;

procedure TCpu.InstructionCall;
var
  Address: TAddress;
begin
  Address := ReadAddress;
  Push(IP);
  IP := Address;
end;

procedure TCpu.InstructionRet;
begin
  IP := Pop;
end;

procedure TCpu.InstructionPush;
begin
  Push(R[ReadByte]);
end;

procedure TCpu.InstructionPop;
begin
  R[ReadByte] := Pop;
end;

procedure TCpu.InstructionCopy;
var
  RegIndex: Byte;
  RegIndex2: Byte;
begin
  RegIndex := ReadByte;
  RegIndex2 := ReadByte;
  R[RegIndex] := R[RegIndex2];
end;

procedure TCpu.InstructionShl;
var
  RegIndex: Byte;
  Num: Byte;
begin
  RegIndex := ReadByte;
  Num := ReadByte;
  R[RegIndex] := R[RegIndex] shl Num;
end;

procedure TCpu.InstructionShr;
var
  RegIndex: Byte;
  Num: Byte;
begin
  RegIndex := ReadByte;
  Num := ReadByte;
  R[RegIndex] := R[RegIndex] shr Num;
end;

procedure TCpu.InstructionLoad;
var
  RegIndex: Byte;
  RegIndex2: Byte;
begin
  RegIndex := ReadByte;
  RegIndex2 := ReadByte;
  R[RegIndex] := PData(@Memory.Data[R[RegIndex2]])^;
end;

procedure TCpu.InstructionLoadi;
var
  RegIndex: Byte;
  Address: TAddress;
begin
  RegIndex := ReadByte;
  Address := ReadAddress;
  R[RegIndex] := PData(@Memory.Data[Address])^;
end;

procedure TCpu.InstructionStore;
var
  RegIndex: Byte;
  RegIndex2: Byte;
begin
  RegIndex := ReadByte;
  RegIndex2 := ReadByte;
  PData(@Memory.Data[R[RegIndex2]])^ := R[RegIndex];
end;

procedure TCpu.InstructionMul;
var
  RegIndex: Byte;
  RegIndex2: Byte;
begin
  RegIndex := ReadByte;
  RegIndex2 := ReadByte;
  R[RegIndex] := R[RegIndex] * R[RegIndex2];
end;

procedure TCpu.InstructionAnd;
var
  RegIndex: Byte;
  RegIndex2: Byte;
begin
  RegIndex := ReadByte;
  RegIndex2 := ReadByte;
  R[RegIndex] := R[RegIndex] and R[RegIndex2];
end;

procedure TCpu.InstructionAndi;
var
  RegIndex: Byte;
begin
  RegIndex := ReadByte;
  R[RegIndex] := R[RegIndex] and ReadData;
end;

procedure TCpu.InstructionOr;
var
  RegIndex: Byte;
  RegIndex2: Byte;
begin
  RegIndex := ReadByte;
  RegIndex2 := ReadByte;
  R[RegIndex] := R[RegIndex] or R[RegIndex2];
end;

procedure TCpu.InstructionXor;
var
  RegIndex: Byte;
  RegIndex2: Byte;
begin
  RegIndex := ReadByte;
  RegIndex2 := ReadByte;
  R[RegIndex] := R[RegIndex] xor R[RegIndex2];
end;

procedure TCpu.InstructionInt;
begin
  Interrupt(ReadByte);
end;

procedure TCpu.InstructionReti;
begin
  IP := Pop;
  InterruptEnabled := True;
end;

procedure TCpu.InstructionEnableInt;
begin
  InterruptEnabled := True;
end;

procedure TCpu.InstructionDisableInt;
begin
  InterruptEnabled := False;
end;

procedure TCpu.Run;
begin
  while not Terminated do begin
    if InterruptEnabled and InterruptPending then begin
      InterruptEnabled := False;
      InterruptPending := False;
      Push(IP);
      IP := PAddress(@Memory.Data[InterruptVector * SizeOf(TAddress)])^;
    end;
    Step;
  end;
end;

procedure TCpu.Start;
begin
  Running := True;
end;

procedure TCpu.Stop;
begin
  Running := False;
end;

procedure TCpu.Step;
var
  Instruction: TInstruction;
begin
  Instruction := TInstruction(ReadByte);
  if Assigned(FInstructionHandlers[Instruction]) then
    FInstructionHandlers[Instruction]
    else raise Exception.Create('Missing handler for instruction ' + IntToStr(Integer(Instruction)));
  Inc(Ticks);
end;

procedure TCpu.Reset;
begin
  Terminated := False;
  IP := 0;
  SP := 0;
  Ticks := 0;
  InterruptEnabled := True;
  InterruptPending := False;
  InterruptCount := 0;
end;

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

constructor TCpu.Create;
begin
  InitInstructions;
end;

destructor TCpu.Destroy;
begin
  Running := False;
  inherited;
end;

end.