unit Cpu;

interface

uses
  Classes, SysUtils;

type
  TCell = Int64;

  TMemory = array of TCell;

  TInstruction = (
    inNop,
    inHalt,
    inCopy_R_n,
    inCopy_R_R,
    inCopy_M_R,
    inCopy_R_M,
    inCopy_M_M,
    inCopy_MD_R,
    inCopy_R_MD,
    inJump_n,
    inJumpZero_R_n,
    inJumpNotZero_R_n,
    inJumpRel_n,
    inInc_R,
    inDec_R,
    inAdd_R_R,
    inAdd_R_n,
    inSub_R_R,
    inSub_R_n,
    inMul_R_R,
    inMul_R_n,
    inDiv_R_R,
    inDiv_R_n,
    inAnd_R_R,
    inAnd_R_n,
    inOr_R_R,
    inOr_R_n,
    inXor_R_R,
    inXor_R_n,
    inShl_R_R,
    inShl_R_n,
    inShr_R_R,
    inShr_R_n,
    inCall_n,
    inRet,
    inPush_R,
    inPush_n,
    inPop_R,
    inIn_R_n,
    inIn_R_R,
    inOut_n_R,
    inOut_n_n,
    inOut_R_R,
    inOut_R_n,
    inNegative_R,
    inEi,
    inDi,
    inInt_n,
    inLdir_R_R_R,
    inLddr_R_R_R,
    inRepeatInc_R_R_n,
    inRepeatDec_R_R_n,
    inRepeatIncInc_R_R_R_n,
    inRepeatDecDec_R_R_R_n,
    inRepeatIncDec_R_R_R_n,
    inEnterUser_R,
    inExitUser,
    inSys_n,
    inSysRet,
    inSetTaskReg_R_R,
    inGetTaskReg_R_R
  );

  TCpu = class;

  { TCpuContext }

  TCpuContext = class
    PC: TCell;
    SP: TCell;
    Stack: TMemory;
    Code: TMemory;
    Data: TMemory;
    IO: TMemory;
    Regs: TMemory;
    Interrupts: TMemory;
    Tasks: array of TCpuContext;
    SelectedTask: Integer;
    Halted: Boolean;
    Parent: TCpuContext;
    InterruptEnabled: Boolean;
    Cpu: TCpu;
    CodeBase: TCell;
    CodeSize: TCell;
    DataBase: TCell;
    DataSize: TCell;
    StackBase: TCell;
    StackSize: TCell;
    procedure SetCurrentContext(CpuContext: TCpuContext);
    function GetPreviousContext: TCpuContext;
    function Fetch: TCell;
    function Pop: TCell;
    procedure Push(Value: TCell);
    procedure Step;
    procedure Reset;
  end;

  { TCpu }

  TCpu = class
    BaseContext: TCpuContext;
    CurrentContext: TCpuContext;
    PreviousContext: TCpuContext;
    InterruptPending: Boolean;
    InterruptPendingValue: TCell;
    procedure Reset;
    procedure Run;
    procedure Step;
    procedure Interrupt(Value: TCell);
    procedure InvokeInterrupt(Value: TCell);
    constructor Create;
  end;


implementation

{ TCpuContext }

procedure TCpuContext.Step;
var
  Instruction: TInstruction;
  Source: TCell;
  Dest: TCell;
  Disp: TCell;
  Count: TCell;
begin
  Instruction := TInstruction(Fetch);
  case Instruction of
    inNop: ;
    inHalt: Halted := True;
    inCopy_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Source;
    end;
    inCopy_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Source];
    end;
    inCopy_M_R: begin
      Dest := Fetch;
      Source := Fetch;
      Data[Regs[Dest]] := Regs[Source];
    end;
    inCopy_R_M: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Data[Regs[Source]];
    end;
    inCopy_M_M: begin
      Dest := Fetch;
      Source := Fetch;
      Data[Regs[Dest]] := Data[Regs[Source]];
    end;
    inCopy_MD_R: begin
      Dest := Fetch;
      Disp := Fetch;
      Source := Fetch;
      Data[Regs[Dest] + Disp] := Regs[Source];
    end;
    inCopy_R_MD: begin
      Dest := Fetch;
      Source := Fetch;
      Disp := Fetch;
      Regs[Dest] := Data[Regs[Source] + Disp];
    end;
    inJump_n: begin
      Dest := Fetch;
      PC := Dest;
    end;
    inJumpZero_R_n: begin
      Source := Fetch;
      Dest := Fetch;
      if Regs[Source] = 0 then PC := Dest;
    end;
    inJumpNotZero_R_n: begin
      Source := Fetch;
      Dest := Fetch;
      if Regs[Source] <> 0 then PC := Dest;
    end;
    inJumpRel_n: begin
      PC := PC + Fetch;
    end;
    inCall_n: begin
      Dest := Fetch;
      Push(PC);
      PC := Dest;
    end;
    inRet: begin
      PC := Pop;
    end;
    inPush_R: begin
      Source := Fetch;
      Push(Regs[Source]);
    end;
    inPush_n: begin
      Source := Fetch;
      Push(Source);
    end;
    inPop_R: Regs[Fetch] := Pop;
    inInc_R: begin
      Dest := Fetch;
      Regs[Dest] := Regs[Dest] + 1;
    end;
    inDec_R: begin
      Dest := Fetch;
      Regs[Dest] := Regs[Dest] - 1;
    end;
    inAdd_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] + Regs[Source];
    end;
    inAdd_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] + Source;
    end;
    inSub_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] - Regs[Source];
    end;
    inSub_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] - Source;
    end;
    inMul_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] * Regs[Source];
    end;
    inMul_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] * Source;
    end;
    inDiv_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] div Regs[Source];
    end;
    inDiv_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] div Source;
    end;
    inAnd_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] and Regs[Source];
    end;
    inAnd_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] and Source;
    end;
    inOr_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] or Regs[Source];
    end;
    inOr_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] or Source;
    end;
    inXor_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] xor Regs[Source];
    end;
    inXor_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] xor Source;
    end;
    inShl_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] shl Regs[Source];
    end;
    inShl_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] shl Source;
    end;
    inShr_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] shr Regs[Source];
    end;
    inShr_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Regs[Dest] := Regs[Dest] shr Source;
    end;
    inIn_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      IO[Regs[Dest]] := Source;
    end;
    inIn_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      IO[Regs[Dest]] := Regs[Source];
    end;
    inOut_n_n: begin
      Dest := Fetch;
      Source := Fetch;
      IO[Dest] := Source;
    end;
    inOut_n_R: begin
      Dest := Fetch;
      Source := Fetch;
      IO[Dest] := Regs[Source];
    end;
    inOut_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      IO[Regs[Dest]] := Source;
    end;
    inOut_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      IO[Regs[Dest]] := Regs[Source];
    end;
    inNegative_R: begin
      Dest := Fetch;
      Regs[Dest] := -Regs[Dest];
    end;
    inEI: InterruptEnabled := True;
    inDI: InterruptEnabled := False;
    inLdir_R_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Count := Fetch;
      while Regs[Count] <> 0 do begin
        Data[Regs[Dest]] := Data[Regs[Source]];
        Regs[Dest] := Regs[Dest] + 1;
        Regs[Source] := Regs[Source] + 1;
        Regs[Count] := Regs[Count] - 1;
      end;
    end;
    inLddr_R_R_R: begin
      Dest := Fetch;
      Source := Fetch;
      Count := Fetch;
      while Regs[Count] <> 0 do begin
        Data[Regs[Dest]] := Data[Regs[Source]];
        Regs[Dest] := Regs[Dest] - 1;
        Regs[Source] := Regs[Source] - 1;
        Regs[Count] := Regs[Count] - 1;
      end;
    end;
    inRepeatInc_R_R_n: begin
      Dest := Fetch;
      Count := Fetch;
      Disp := Fetch;
      Regs[Dest] := Regs[Dest] + 1;
      Regs[Count] := Regs[Count] - 1;
      if Regs[Count] <> 0 then PC := PC + Disp;
    end;
    inRepeatDec_R_R_n: begin
      Dest := Fetch;
      Count := Fetch;
      Disp := Fetch;
      Regs[Dest] := Regs[Dest] + 1;
      Regs[Count] := Regs[Count] - 1;
      if Regs[Count] <> 0 then PC := PC + Disp;
    end;
    inRepeatIncInc_R_R_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Count := Fetch;
      Disp := Fetch;
      Regs[Dest] := Regs[Dest] + 1;
      Regs[Source] := Regs[Source] + 1;
      Regs[Count] := Regs[Count] - 1;
      if Regs[Count] <> 0 then PC := PC + Disp;
    end;
    inRepeatDecDec_R_R_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Count := Fetch;
      Disp := Fetch;
      Regs[Dest] := Regs[Dest] - 1;
      Regs[Source] := Regs[Source] - 1;
      Regs[Count] := Regs[Count] - 1;
      if Regs[Count] <> 0 then PC := PC + Disp;
    end;
    inRepeatIncDec_R_R_R_n: begin
      Dest := Fetch;
      Source := Fetch;
      Count := Fetch;
      Disp := Fetch;
      Regs[Dest] := Regs[Dest] + 1;
      Regs[Source] := Regs[Source] - 1;
      Regs[Count] := Regs[Count] - 1;
      if Regs[Count] <> 0 then PC := PC + Disp;
    end;
    inEnterUser_R: begin
      Dest := Fetch;
      if (Dest >= 0) and (Dest < Length(Tasks)) then
        SetCurrentContext(Tasks[Dest])
        else Exception.Create('User task ' + IntToStr(Dest) + ' not found.');
    end;
    inExitUser: begin
      if Assigned(Parent) then SetCurrentContext(Parent)
        else Exception.Create('Can''t exit user mode as not in user mode.');
    end;
    inSys_n: begin
      Dest := Fetch;
      if Assigned(Parent) then SetCurrentContext(Parent)
        else Exception.Create('Can''t exit user mode as not in user mode.');
      PC := Interrupts[Dest];
    end;
    inSysRet: begin
      SetCurrentContext(GetPreviousContext);
    end;
    inSetTaskReg_R_R: begin
      Dest := Regs[Fetch];
      Source := Regs[Fetch];
      case Dest of
        0: SelectedTask := Source;
        1: Tasks[SelectedTask].PC := Source;
        2: Tasks[SelectedTask].SP := Source;
        3: Tasks[SelectedTask].CodeBase := Source;
        4: Tasks[SelectedTask].CodeSize := Source;
        5: Tasks[SelectedTask].DataBase := Source;
        6: Tasks[SelectedTask].DataSize := Source;
        7: Tasks[SelectedTask].StackBase := Source;
        8: Tasks[SelectedTask].StackSize := Source;
      end;
    end;
    inGetTaskReg_R_R: begin
      Dest := Fetch;
      Source := Regs[Fetch];
      case Source of
        0: Regs[Dest] := SelectedTask;
        1: Regs[Dest] := Tasks[SelectedTask].PC;
        2: Regs[Dest] := Tasks[SelectedTask].SP;
        3: Regs[Dest] := Tasks[SelectedTask].CodeBase;
        4: Regs[Dest] := Tasks[SelectedTask].CodeSize;
        5: Regs[Dest] := Tasks[SelectedTask].DataBase;
        6: Regs[Dest] := Tasks[SelectedTask].DataSize;
        7: Regs[Dest] := Tasks[SelectedTask].StackBase;
        8: Regs[Dest] := Tasks[SelectedTask].StackSize;
      end;
    end;
  end;
end;

procedure TCpuContext.SetCurrentContext(CpuContext: TCpuContext);
begin
  if Assigned(Cpu) then begin
    Cpu.PreviousContext := Cpu.CurrentContext;
    Cpu.CurrentContext := CpuContext
  end else if Assigned(Parent) then Parent.SetCurrentContext(CpuContext)
    else Exception.Create('Cannot set CPU context.');
end;

function TCpuContext.GetPreviousContext: TCpuContext;
begin
  if Assigned(Cpu) then Result := Cpu.PreviousContext
  else if Assigned(Parent) then Result := Parent.GetPreviousContext
    else Exception.Create('Cannot get previous CPU context.');
end;

function TCpuContext.Fetch: TCell;
begin
  Result := Code[PC];
  Inc(PC);
end;

procedure TCpuContext.Reset;
begin
  PC := 0;
  SP := 0;
  Halted := False;
end;

function TCpuContext.Pop: TCell;
begin
  Dec(SP);
  Result := Stack[SP];
end;

procedure TCpuContext.Push(Value: TCell);
begin
  Stack[SP] := Value;
  Inc(SP);
end;

{ TCpu }

procedure TCpu.Reset;
begin
  CurrentContext := BaseContext;
  CurrentContext.Reset;
end;

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

procedure TCpu.Step;
begin
  CurrentContext.Step;

{  if InterruptEnabled and InterruptPending then begin
    InterruptEnabled := False;
    Interrupt(InterruptPendingValue);
    InterruptPending := False;
    InterruptEnabled := True;
  end;
}end;

procedure TCpu.Interrupt(Value: TCell);
begin
{  Push(PC);
  PC := Interrupts[Value];
  }end;

procedure TCpu.InvokeInterrupt(Value: TCell);
begin
  InterruptPending := True;
  InterruptPendingValue := Value;
end;

constructor TCpu.Create;
begin
  BaseContext := TCpuContext.Create;
  BaseContext.Cpu := Self;
  SetLength(BaseContext.Stack, 10000);
  SetLength(BaseContext.Code, 10000);
  SetLength(BaseContext.Data, 10000);
  SetLength(BaseContext.IO, 10000);
  SetLength(BaseContext.Interrupts, 10000);
  SetLength(BaseContext.Regs, 100);
end;

end.