source: branches/Machine/UMachine.pas

unit UMachine;

{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, Math;

type
  //TAddrInt = Int8;
  TAddrInt = Int16;
  //TAddrInt = Int32;
  //TAddrInt = Int64;
  TDataInt = Int16;
  //TDataInt = Int16;
  //TDataInt = Int32;
  //TDataInt = Int64;

  TOpcode = (opNop, opHalt, opCopy, opAdd, opSub, opMul, opDiv, opSet,
    opParamClearAll, opParamSelect, opParamSet, opParamIndirect, opParamNext,
    opSkip, opSign, opParamSize);

  TAreaType = (atAddress, atMemory, atIOPort, atRegister, atSysRegister);

  TSysAddr = (saInstructionPointer, saAddrWidth, saDataWidth, saRegisterCount);

  TParameter = record
    Number: TAddrInt;
    Area: Integer;
    Size: Integer;
    Defined: Boolean;
  end;

  TOpcodeHandler = procedure of object;

  { TMachine }

  TMachine = class
  private
    OpcodeTable: array[TOpcode] of TOpcodeHandler;
    SkipNextInstruction: Boolean;
    CurrentParam: Integer;
    procedure OpcodeNop;
    procedure OpcodeHalt;
    procedure OpcodeCopy;
    procedure OpcodeAdd;
    procedure OpcodeSub;
    procedure OpcodeMul;
    procedure OpcodeDiv;
    procedure OpcodeParamNext;
    procedure OpcodeParamSelect;
    procedure OpcodeParamSet;
    procedure OpcodeParamIndirect;
    procedure OpcodeParamClearAll;
    procedure OpcodeParamSize;
    procedure OpcodeSkip;
    procedure OpcodeSign;
    function ReadNext: Integer;
  public
    Memory: array of Byte;
    Registers: array of TAddrInt;
    IP: TAddrInt;
    Params: array of TParameter;
    Terminated: Boolean;
    function ReadPort(Address: Integer): TDataInt;
    procedure WritePort(Address: TAddrInt; Value: TDataInt);
    function ReadArea(AreaIndex: Integer; Address: TAddrInt): TDataInt;
    procedure WriteArea(AreaIndex: Integer; Address: TAddrInt; Value: TDataInt);
    function ReadSys(Address: TAddrInt): TDataInt;
    procedure Run;
    constructor Create;
  end;

implementation

{ TMachine }

procedure TMachine.OpcodeNop;
begin
end;

procedure TMachine.OpcodeHalt;
begin
  Terminated := True;
end;

procedure TMachine.OpcodeCopy;
begin
//  for I := 0 to Params[0].Size - 1 do begin
    WriteArea(Params[0].Area, Params[0].Number, ReadArea(Params[1].Area, Params[1].Number));
end;

procedure TMachine.OpcodeAdd;
begin
  if Params[2].Defined then
    WriteArea(Params[0].Area, Params[0].Number, ReadArea(Params[2].Area, Params[2].Number) + ReadArea(Params[1].Area, Params[1].Number))
    else if Params[1].Defined then WriteArea(Params[0].Area, Params[0].Number, ReadArea(Params[0].Area, Params[0].Number) + ReadArea(Params[1].Area, Params[1].Number))
    else WriteArea(Params[0].Area, Params[0].Number, ReadArea(Params[0].Area, Params[0].Number) + 1);
end;

procedure TMachine.OpcodeSub;
begin
  if Params[2].Defined then
    WriteArea(Params[0].Area, Params[0].Number, ReadArea(Params[2].Area, Params[2].Number) - ReadArea(Params[1].Area, Params[1].Number))
    else if Params[1].Defined then WriteArea(Params[0].Area, Params[0].Number, ReadArea(Params[0].Area, Params[0].Number) - ReadArea(Params[1].Area, Params[1].Number))
    else WriteArea(Params[0].Area, Params[0].Number, ReadArea(Params[0].Area, Params[0].Number) - 1);
end;

procedure TMachine.OpcodeMul;
begin
  if Params[2].Defined then
    WriteArea(Params[0].Area, Params[0].Number, ReadArea(Params[2].Area, Params[2].Number) * ReadArea(Params[1].Area, Params[1].Number))
    else WriteArea(Params[0].Area, Params[0].Number, ReadArea(Params[0].Area, Params[0].Number) * ReadArea(Params[1].Area, Params[1].Number));
end;

procedure TMachine.OpcodeDiv;
begin
  if Params[2].Defined then
    WriteArea(Params[0].Area, Params[0].Number, ReadArea(Params[2].Area, Params[2].Number) div ReadArea(Params[1].Area, Params[1].Number))
    else WriteArea(Params[0].Area, Params[0].Number, ReadArea(Params[0].Area, Params[0].Number) div ReadArea(Params[1].Area, Params[1].Number));
end;

procedure TMachine.OpcodeParamNext;
begin
  Inc(CurrentParam);
end;

procedure TMachine.OpcodeParamSelect;
begin
  CurrentParam := ReadNext;
end;

procedure TMachine.OpcodeParamSet;
begin
  Params[CurrentParam].Number := ReadNext;
  Params[CurrentParam].Area := Integer(atAddress);
  Params[CurrentParam].Defined := True;
end;

procedure TMachine.OpcodeParamIndirect;
begin
  if not Params[CurrentParam].Defined then
    raise Exception.Create('Undefined parameter ' + IntToStr(CurrentParam));
  if Params[CurrentParam].Area = Integer(atAddress) then
    Params[CurrentParam].Area := ReadNext
    else begin
      Params[CurrentParam].Number := ReadArea(Params[CurrentParam].Area, Params[CurrentParam].Number);
      Params[CurrentParam].Area := ReadNext;
    end;
end;

procedure TMachine.OpcodeParamClearAll;
var
  I: Integer;
begin
  for I := 0 to Length(Params) - 1 do begin
    Params[I].Number := 0;
    Params[I].Area := Integer(atAddress);
    Params[I].Defined := False;
    Params[I].Size := 1;
  end;
  CurrentParam := 0;
end;

procedure TMachine.OpcodeParamSize;
begin
  Params[CurrentParam].Size := ReadNext;
end;

procedure TMachine.OpcodeSkip;
begin
  if ReadArea(Params[0].Area, Params[0].Number) < 0 then begin
    SkipNextInstruction := True;
  end;
end;

procedure TMachine.OpcodeSign;
begin
  if not Params[1].Defined then
    WriteArea(Params[0].Area, Params[0].Number, Sign(ReadArea(Params[1].Area, Params[1].Number)))
    else WriteArea(Params[0].Area, Params[0].Number, Sign(ReadArea(Params[0].Area, Params[0].Number)));
end;

function TMachine.ReadNext: Integer;
begin
  if (IP >= 0) and (IP < Length(Memory)) then Result := Memory[IP]
    else raise Exception.Create('Memory access out of range ' + IntToHex(IP, 8));
  Inc(IP);
end;

function TMachine.ReadPort(Address: Integer): TDataInt;
begin
  Result := 0;
end;

procedure TMachine.WritePort(Address: TAddrInt; Value: TDataInt);
begin

end;

function TMachine.ReadArea(AreaIndex: Integer; Address: TAddrInt): TDataInt;
begin
  if AreaIndex = Integer(atAddress) then Result := Address
  else if AreaIndex = Integer(atMemory) then Result := Memory[Address]
  else if AreaIndex = Integer(atIOPort) then Result := ReadPort(Address)
  else if AreaIndex = Integer(atRegister) then Result := Registers[Address]
  else if AreaIndex = Integer(atSysRegister) then Result := ReadSys(Address)
  else raise Exception.Create('Unsupported area number ' + IntToStr(AreaIndex));
end;

procedure TMachine.WriteArea(AreaIndex: Integer; Address: TAddrInt;
  Value: TDataInt);
begin
  if AreaIndex = Integer(atAddress) then
  else if AreaIndex = Integer(atMemory) then Memory[Address] := Value
  else if AreaIndex = Integer(atIOPort) then WritePort(Address, Value)
  else if AreaIndex = Integer(atRegister) then Registers[Address] := Value
  else if AreaIndex = Integer(atSysRegister) then begin
    if Address = 0 then IP := Value
  end else raise Exception.Create('Unsupported area number ' + IntToStr(AreaIndex));
end;

function TMachine.ReadSys(Address: TAddrInt): TDataInt;
begin
  if Address = Integer(saInstructionPointer) then Result := IP
  else if Address = Integer(saAddrWidth) then Result := SizeOf(TAddrInt)
  else if Address = Integer(saDataWidth) then Result := SizeOf(TDataInt)
  else if Address = Integer(saRegisterCount) then Result := Length(Registers)
  else Result := 0;
end;

procedure TMachine.Run;
var
  Opcode: TOpcode;
  I: Integer;
begin
  IP := 0;
  Terminated := False;
  CurrentParam := 0;
  while not Terminated do begin
    Opcode := TOpcode(ReadNext);
    if SkipNextInstruction and ((Opcode <> opParamIndirect) and (Opcode <> opParamSelect) and
    (Opcode <> opParamClearAll) and (Opcode <> opParamSet) and (Opcode <> opParamNext)) then begin
      SkipNextInstruction := False;
    end else begin
      if Assigned(OpcodeTable[Opcode]) then
        OpcodeTable[Opcode]
        else raise Exception.Create('Unknown opcode ' + IntToStr(Integer(Opcode)));
    end;
  end;
end;

constructor TMachine.Create;
begin
  SetLength(Registers, 16);
  SetLength(Params, 4);

  // Opcode table initialization
  OpcodeTable[opNop] := OpcodeNop;
  OpcodeTable[opHalt] := OpcodeHalt;
  OpcodeTable[opCopy] := OpcodeCopy;
  OpcodeTable[opAdd] := OpcodeAdd;
  OpcodeTable[opSub] := OpcodeSub;
  OpcodeTable[opMul] := OpcodeMul;
  OpcodeTable[opDiv] := OpcodeDiv;
  OpcodeTable[opParamSelect] := OpcodeParamSelect;
  OpcodeTable[opParamSet] := OpcodeParamSet;
  OpcodeTable[opParamIndirect] := OpcodeParamIndirect;
  OpcodeTable[opParamClearAll] := OpcodeParamClearAll;
  OpcodeTable[opSkip] := OpcodeSkip;
  OpcodeTable[opSign] := OpcodeSign;
  OpcodeTable[opParamNext] := OpcodeParamNext;
  OpcodeTable[opParamSize] := OpcodeParamSize;
end;

end.