source: branches/virtualcpu4/UOpcode.pas

unit UOpcode;

{$mode delphi}

interface

uses
  Classes, SysUtils, fgl, UCpu;

type
  TOpcodeParam = (prNone, prReg, prData, prAddr, prAddrRel);
  TOpcodeDef = class
    Opcode: TOpcode;
    Name: string;
    Param1: TOpcodeParam;
    Param2: TOpcodeParam;
    Param3: TOpcodeParam;
    Prefix: Boolean;
  end;

  { TOpcodeDefs }

  TOpcodeDefs = class(TFPGObjectList<TOpcodeDef>)
    function SearchByOpcode(Opcode: TOpcode): TOpcodeDef;
    function SearchByName(Name: string): TOpcodeDef;
    function AddNew(Opcode: TOpcode; Name: string; Param1, Param2, Param3:
      TOpcodeParam; Prefix: Boolean): TOpcodeDef;
    constructor Create(FreeObjects: Boolean = True);
  end;

  function IntToHexEx(Value: Int64; Digits: ShortInt = -1; Prefix: string = ''): string; overload;
  function IntToHexEx(Value: QWord; Digits: ShortInt = -1; Prefix: string = ''): string; overload;


implementation

const
  HexChars: array[0..15] of Char = '0123456789ABCDEF';

function IntToHexEx(Value: Int64; Digits: ShortInt = -1; Prefix: string = ''): string;
var
  I: Integer;
  Negative: Boolean;
begin
  Negative := Value < 0;
  if Negative then Value := -Value;
  Result := '';
  if Digits >= 0 then begin
    for I := 0 to Digits - 1 do begin
      Result := HexChars[Value and $f] + Result;
      Value := Value shr 4;
    end;
  end else begin
    if Value <> 0 then begin
      while QWord(Value) > 0 do begin
        Result := HexChars[Value and $f] + Result;
        Value := Value shr 4;
      end;
    end else Result := '0';
  end;
  Result := Prefix + Result;
  if Negative then Result := '-' + Result;
end;

function IntToHexEx(Value: QWord; Digits: ShortInt = -1; Prefix: string = ''): string;
var
  I: Integer;
begin
  Result := '';
  if Digits >= 0 then begin
    for I := 0 to Digits - 1 do begin
      Result := HexChars[Value and $f] + Result;
      Value := Value shr 4;
    end;
  end else begin
    if Value <> 0 then begin
      while Value > 0 do begin
        Result := HexChars[Value and $f] + Result;
        Value := Value shr 4;
      end;
    end else Result := '0';
  end;
  Result := Prefix + Result;
end;

{ TOpcodeDefs }

function TOpcodeDefs.SearchByOpcode(Opcode: TOpcode): TOpcodeDef;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].Opcode <> Opcode) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

function TOpcodeDefs.SearchByName(Name: string): TOpcodeDef;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].Name <> Name) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

function TOpcodeDefs.AddNew(Opcode: TOpcode; Name: string; Param1, Param2,
  Param3: TOpcodeParam; Prefix: Boolean): TOpcodeDef;
begin
  Result := TOpcodeDef.Create;
  Result.Opcode := Opcode;
  Result.Name := Name;
  Result.Param1 := Param1;
  Result.Param2 := Param2;
  Result.Param3 := Param3;
  Result.Prefix := Prefix;
  Add(Result);
end;

constructor TOpcodeDefs.Create(FreeObjects: Boolean = True);
begin
  inherited;
  AddNew(opNop, 'NOP', prNone, prNone, prNone, False);
  AddNew(opHalt, 'HALT', prNone, prNone, prNone, False);
  AddNew(opLoad, 'LD', prReg, prReg, prNone, False);
  AddNew(opLoadi, 'LDI', prReg, prData, prNone, False);
  AddNew(opJump, 'JP', prAddr, prNone, prNone, False);
  AddNew(opJumpZero, 'JPZ', prAddr, prNone, prNone, False);
  AddNew(opJumpNotZero ,'JPNZ', prAddr, prNone, prNone, False);
  AddNew(opJumpRel, 'JR', prAddrRel, prNone, prNone, False);
  AddNew(opJumpRelZero, 'JRZ', prAddrRel, prNone, prNone, False);
  AddNew(opJumpRelNotZero, 'JRNZ', prAddrRel, prNone, prNone, False);
  AddNew(opNeg, 'NEG', prReg, prNone, prNone, False);
  AddNew(opClear, 'CLR', prReg, prNone, prNone, False);
  AddNew(opLoadMem, 'LDM', prReg, prReg, prNone, False);
  AddNew(opStoreMem, 'STM', prReg, prReg, prNone, False);
  AddNew(opExchg, 'EX', prReg, prReg, prNone, False);
  AddNew(opPush, 'PUSH', prReg, prNone, prNone, False);
  AddNew(opPop, 'POP', prReg, prNone, prNone, False);
  AddNew(opCall, 'CALL', prAddr, prNone, prNone, False);
  AddNew(opRet, 'RET', prNone, prNone, prNone, False);
  AddNew(opAdd, 'ADD', prReg, prReg, prNone, False);
  AddNew(opAddi, 'ADDI', prReg, prData, prNone, False);
  AddNew(opSub, 'SUB', prReg, prReg, prNone, False);
  AddNew(opSubi, 'SUBI', prReg, prData, prNone, False);
  AddNew(opInc, 'INC', prReg, prNone, prNone, False);
  AddNew(opDec, 'DEC', prReg, prNone, prNone, False);
  AddNew(opIn, 'IN', prReg, prAddr, prNone, False);
  AddNew(opOut, 'OUT', prAddr, prReg, prNone, False);
  AddNew(opShl, 'SHL', prReg, prReg, prNone, False);
  AddNew(opShr, 'SHR', prReg, prReg, prNone, False);
  AddNew(opDataPrefix8, 'DP8', prNone, prNone, prNone, True);
  AddNew(opDataPrefix16, 'DP16', prNone, prNone, prNone, True);
  AddNew(opDataPrefix32, 'DP32', prNone, prNone, prNone, True);
  AddNew(opDataPrefix64, 'DP64', prNone, prNone, prNone, True);
  AddNew(opDataSize, 'DS', prNone, prNone, prNone, False);
  AddNew(opAddrSize, 'AS', prNone, prNone, prNone, False);
  AddNew(opTest, 'TEST', prReg, prNone, prNone, False);
  AddNew(opAnd, 'AND', prReg, prReg, prNone, False);
  AddNew(opOr, 'OR', prReg, prReg, prNone, False);
  AddNew(opXor, 'XOR', prReg, prReg, prNone, False);
  AddNew(opLdir, 'LDIR', prReg, prReg, prReg, False);
  AddNew(opLddr, 'LDDR', prReg, prReg, prReg, False);
  AddNew(opMul, 'MUL', prReg, prReg, prNone, False);
  AddNew(opDiv, 'DIV', prReg, prReg, prNone, False);
  AddNew(opMod, 'MOD', prReg, prReg, prNone, False);
  AddNew(opAddrPrefix8, 'AP8', prNone, prNone, prNone, True);
  AddNew(opAddrPrefix16, 'AP16', prNone, prNone, prNone, True);
  AddNew(opAddrPrefix32, 'AP32', prNone, prNone, prNone, True);
  AddNew(opAddrPrefix64, 'AP64', prNone, prNone, prNone, True);
  AddNew(opConvert, 'CON', prReg, prNone, prNone, True);
end;

end.