assembler.pas

一个编译器源代码。用法看里面的“使用说明”

unit Assembler;

interface

uses
  SysUtils, Windows, Classes, Errors, Common, Parser;

const
  TSize: Array[0..2] of Integer = (0,1,3);
  xFileAlignment = $200;

type

TFormatMZ = record
  signature: word;
  bytes_in_last_block: word;
  blocks_in_file: word;
  num_relocs: word;
  header_paragraphs: word;
  min_extra_paragraphs: word;
  max_extra_paragraphs: word;
  ss: word;
  sp: word;
  checksum: word;
  ip: word;
  cs: word;
  reloc_table_offset: word;
  overlay_number: word;
  reloc_offset: word;
  reloc_segment: word;
end;

PImageImportDescriptor = ^TImageImportDescriptor;
TImageImportDescriptor = packed record
  Characteristics: LongWord;
  TimeDateStamp: LongWord;
  ForwarderChain: LongWord;
  Name: LongWord;
  FirstThunk: LongWord;
end;

TFixType = (ftJump, ftDataAddress);
TSymbolSize = (ss8, ss16, ss32, ssString);
TSymbolType = (stConstant, stLabel, stVariable, stString);

PFixUp = ^TFixUp;
TFixUp = record
  Offset: Integer;
  Extra: String;
  FixType: TFixType;
  FlName: String;
  LnNum: Integer;
  Size: TSymbolSize;
  Value: LongWord;
  FStub: Boolean;
end;

PSymbol = ^TSymbol;
TSymbol = record
  Offset: LongWord;
  Size: TSymbolSize;
  SymbolType: TSymbolType;
  Value: String;
end;

TRegister = (rEAX, rECX, rEDX, rEBX, rESP, rEBP, rESI, rEDI,
  rAX, rCX, rDX, rBX, rSP, rBP, rSI, rDI,
  rAL, rCL, rDL, rBL, rAH, rCH, rDH, rBH);

TAcculumator = (raEAX,raAX,raAL);

TSegment = (sCS,sSS,sDS,sES,sFS,sGS);

TAsm = class
public
  Format,Code,Data,Stub,StubData: AnsiString;
  FormatterError: Boolean;
  Fixups, Offsets: TList;
  Alias, Equs, Symbols: TStringList;
  Parser: ^TParser;
  CurrLine: Integer;
  CurrFile, CurrFunc: String;
  CurrSize: TSymbolSize;
  InStub: Boolean;
  PEHeaderSize: LongWord;
  constructor Create;
  destructor Destroy; override;
  procedure WriteMsg(Msg: String; Err: Boolean = True);
  function GetNumber(Str: String): Integer;
  procedure AddBytes(var X; Bytes: Integer);
  procedure AddDBytes(var X; Bytes: Integer);
  procedure AddFBytes(var X; Bytes: Integer);
  function AddDataBuffer(MaxSize: Integer): Word;
  procedure AddPrefix;
  procedure AsmMovRegImm(Reg: TRegister; Value: LongWord);
  procedure AsmMovRegVal(Reg: TRegister; Value: LongWord);
  procedure AsmMovValReg(Reg: TRegister; Value: LongWord);
  procedure AsmMovAccImm(Size: TSymbolSize; Value: LongWord);
  procedure AsmMovImmAcc(Value: LongWord; Size: TSymbolSize);
  procedure AsmMovReg(Reg1, Reg2: TRegister);
  procedure AsmAddAccImm(Acc: TAcculumator; Value: LongWord);
  procedure AsmSubAccImm(Acc: TAcculumator; Value: LongWord);
  procedure AsmMulAccImm(Acc: TAcculumator; Value: LongWord);
  procedure AsmDivAccImm(Acc: TAcculumator; Value: LongWord);
  procedure AsmAddAccVal(Acc: TAcculumator; Value: LongWord);
  procedure AsmSubAccVal(Acc: TAcculumator; Value: LongWord);
  procedure AsmMulAccVal(Acc: TAcculumator; Value: LongWord);
  procedure AsmDivAccVal(Acc: TAcculumator; Value: LongWord);
  procedure AsmPushReg(Reg: TRegister);
  procedure AsmPushSeg(Seg: TSegment);
  procedure AsmPopReg(Reg: TRegister);
  procedure AsmPopSeg(Seg: TSegment);
  procedure AsmXorReg(Reg: TRegister);
  procedure AsmJmp(Value: LongWord; Size: TSymbolSize);
  procedure AsmJe(Value: LongWord; Size: TSymbolSize);
  procedure AsmJg(Value: LongWord; Size: TSymbolSize);
  procedure AsmJl(Value: LongWord; Size: TSymbolSize);
  procedure AsmJng(Value: LongWord; Size: TSymbolSize);
  procedure AsmJnl(Value: LongWord; Size: TSymbolSize);
  procedure AsmJne(Value: LongWord; Size: TSymbolSize);
  procedure AsmJge(Value: LongWord; Size: TSymbolSize);
  procedure AsmJle(Value: LongWord; Size: TSymbolSize);
  procedure AsmCmp(Val1, Val2: LongWord; Size: TSymbolSize);
  procedure AsmCmpV(Val1, Val2: LongWord; Size: TSymbolSize);
  procedure AsmCmpVV(Val1, Val2: LongWord; Size: TSymbolSize);
  procedure AsmInt(Value: Byte);
  procedure AsmCall(Value: LongWord; Size: TSymbolSize);
  procedure AsmRet(FarRet: Boolean = False);
  procedure FuncAE(SAssign, Extra: String);
  procedure FuncVar(Name, VType, Value: String);
  procedure FuncBegin;
  procedure FuncWriteLn;
  procedure FuncWrite;
  procedure FuncSetColor(Color: String; Len: String = '$07D0');
  procedure FuncGetCursor(X, Y: String);
  procedure FuncMoveCursor(X, Y: String);
  procedure FuncClearScreen;
  procedure FuncBeep;
  procedure FuncRandom(SAssign, Extra: String);
  procedure FuncNewLine;
  procedure FuncWait;
  procedure FuncSleep;
  procedure FuncGetCount(X, Extra: String);
  procedure FuncSetCount(X: String);
  procedure FuncLoop(Lab: String);
  procedure FuncRead(SAssign, Extra: String);
  procedure FuncReadLn(SAssign: String);
  procedure FuncEnd;
  procedure FuncEndWin;
  procedure FuncExpr(SAssign, Extra: String);
  procedure FuncIf(Cmp1, Cmp2, CmpMode, JumpTo: String; IsNot: Boolean = False);
  procedure FuncReturn;
  procedure FuncResult(Value,Func: String);
  procedure FuncSetMode(Mode: String);
  procedure FuncPixel(X, Y, Color: String);
  procedure FormatPE(GUI: Boolean);
  procedure FormatMZ(IsStub: Boolean = False);
  procedure SaveFile(Filename: String; Mode: String);
  function AddData(Str: String; Terminator: Char = '$'): LongWord;
  function AddVar(Str: String; Size: TSymbolSize): LongWord;
  procedure AddSymbol(Name: String; Size: TSymbolSize; SymbolType: TSymbolType; Offset: LongWord = 0);
  function GetSymbol(Name: String): PSymbol;
  function IsSymbol(Name: String): Boolean;
  procedure AddFixup(Value: LongWord; Size: TSymbolSize; FixType: TFixType; Extra: String = '');
  function Size(IncFormat: Boolean = False; IncData: Boolean = False; IsWritten: Boolean = True): LongWord;
  procedure AddOffset(Offset: LongWord);
  procedure ClearOffsets;
  procedure AddEqu(Name: String; Value: Integer);
  function GetEqu(Name: String): Integer;
  procedure AddAlias(Name: String; Value: String);
  function GetAlias(Name: String): String;
end;

implementation

constructor TAsm.Create;
begin
  inherited;
  Fixups := TList.Create;
  Offsets := TList.Create;
  Alias := TStringList.Create;
  Equs := TStringList.Create;
  Symbols := TStringList.Create;
  FormatterError := False;
  AddEqu('true',1);
  AddEqu('false',0);
  AddEqu('cr',13);
  AddEqu('lf',10);
  AddEqu('quote.single',$27);
  AddEqu('quote.double',$22);
  AddEqu('color.black',$00);
  AddEqu('color.navy',$01);
  AddEqu('color.green',$02);
  AddEqu('color.teal',$03);
  AddEqu('color.marron',$04);
  AddEqu('color.purple',$05);
  AddEqu('color.olive',$06);
  AddEqu('color.silver',$07);
  AddEqu('color.grey',$08);
  AddEqu('color.blue',$09);
  AddEqu('color.lime',$0A);
  AddEqu('color.aqua',$0B);
  AddEqu('color.red',$0C);
  AddEqu('color.fuchsia',$0D);
  AddEqu('color.yellow',$0E);
  AddEqu('color.white',$0F);
  AddEqu('colorbk.black',$00);
  AddEqu('colorbk.navy',$10);
  AddEqu('colorbk.green',$20);
  AddEqu('colorbk.teal',$30);
  AddEqu('colorbk.marron',$40);
  AddEqu('colorbk.purple',$50);
  AddEqu('colorbk.olive',$60);
  AddEqu('colorbk.silver',$70);
  AddEqu('colorbk.grey',$80);
  AddEqu('colorbk.blue',$90);
  AddEqu('colorbk.lime',$A0);
  AddEqu('colorbk.aqua',$B0);
  AddEqu('colorbk.red',$C0);
  AddEqu('colorbk.fuchsia',$D0);
  AddEqu('colorbk.yellow',$E0);
  AddEqu('colorbk.white',$F0);
  InStub := False;
  PEHeaderSize := Length(Format);
end;

destructor TAsm.Destroy;
begin
  Symbols.Free;
  Equs.Free;
  Alias.Free;
  Offsets.Free;
  Fixups.Free;
  inherited;
end;

procedure TAsm.WriteMsg(Msg: String; Err: Boolean = True);
begin
  Parser.AddMsg(Msg,CurrFile,CurrLine,Err);
end;

function TAsm.GetNumber(Str: String): Integer;
var
  num: Array[0..1] of String;
  i,cnt: Integer;
begin
  result := 0;
  if Pos('+',Str) > 0 then
  begin
    num[0] := Copy(Str,1,Pos('+',Str)-1);
    num[1] := Copy(Str,Pos('+',Str)+1,Length(Str));
    cnt := 1;
  end
  else
  begin
    num[0] := Str;
    num[1] := '';
    cnt := 0;
  end;
  for i := 0 to cnt do
  begin
    if IsNumeric(num[i]) then
    begin
      if num[i][1] = '$' then
        result := result or HexToInt(Copy(num[i],2,Length(num[i])))
      else
        result := result or StrToInt(num[i]);
    end
    else if Equs.IndexOf(LowerCase(num[i])) > -1 then
      result := result or GetEqu(num[i])
    else if (Length(num[i]) = 3) and (num[i][1] = '''') and (num[i][3] = '''') then
      result := result or Integer(num[i][2])
    else
      WriteMsg(NotConstant);
  end;
end;

procedure TAsm.AddBytes(var X; Bytes: Integer);
var
  S: AnsiString;
begin
  SetString (S, PChar(@X), Bytes);
  if inStub then
    Stub := Stub + S
  else
    Code := Code + S;
end;

procedure TAsm.AddDBytes(var X; Bytes: Integer);
var
  S: AnsiString;
begin
  SetString (S, PChar(@X), Bytes);
  if inStub then
    StubData := StubData + S
  else
    Data := Data + S;
end;

procedure TAsm.AddFBytes(var X; Bytes: Integer);
var
  S: AnsiString;
begin
  SetString (S, PChar(@X), Bytes);
  Format := Format + S;
end;

function TAsm.AddDataBuffer(MaxSize: Integer): Word;
var
  X: Array[0..254] of Byte;
begin
  result := Length(Data);
  if MaxSize > 255 then
    WriteMsg(WrongMaxSize)
  else
  begin
    X[0] := MaxSize;
    X[1] := 0;
    AddDBytes(X,2);
    FillChar(X,MaxSize,$FF);
    AddDBytes(X,MaxSize);
  end;
end;

procedure TAsm.AddPrefix;
var
  X: Byte;
begin
  X := $66;
  AddBytes(X,1);
end;

procedure TAsm.AsmMovRegImm(Reg: TRegister; Value: LongWord);
var
  X: Array[0..4] of Byte;
begin
  if Reg in [rEAX..rEDI] then
  begin
    X[0] := $B8 + Ord(Reg);
    LongWord((@X[1])^) := Value;
    AddBytes(X,5);
  end
  else if Reg in [rAX..rDI] then
  begin
    Dec(Reg,Ord(rAX));
    X[0] := $B8 + Ord(Reg);
    Word((@X[1])^) := Value;
    AddBytes(X,3);
  end
  else
  begin
    Dec(Reg,Ord(rAL));
    X[0] := $B0 + Ord(Reg);
    X[1] := Byte(Value);
    AddBytes(X,2);
  end;
end;

procedure TAsm.AsmMovRegVal(Reg: TRegister; Value: LongWord);
var
  X: Array[0..3] of Byte;
begin
  X[0] := $8A;
  if Reg in [rAX..rDI] then
  begin
    Dec(Reg,Ord(rAX));
  end
  else if Reg in [rAL..rBH] then
  begin
    Dec(Reg,Ord(rAL));
  end;
  X[1] := 6 + (Ord(Reg) * 8);
  Word((@X[2])^) := Value;
  AddBytes(X,4);
end;

procedure TAsm.AsmMovValReg(Reg: TRegister; Value: LongWord);
var
  X: Array[0..3] of Byte;
begin
  X[0] := $88;
  if Reg in [rAX..rDI] then
  begin
    Dec(Reg,Ord(rAX));
  end
  else if Reg in [rAL..rBH] then
  begin
    Dec(Reg,Ord(rAL));
  end;
  X[1] := 6 + (Ord(Reg) * 8);
  Word((@X[2])^) := Value;
  AddBytes(X,4);
end;

procedure TAsm.AsmMovAccImm(Size: TSymbolSize; Value: LongWord);
var
  X: Array[0..4] of Byte;
begin
  if Size = ss32 then
  begin
    X[0] := $A1;
    LongWord((@X[1])^) := Value;
    AddBytes(X,5);
  end
  else if Size = ss16 then
  begin
    X[0] := $A1;
    Word((@X[1])^) := Value;
    AddBytes(X,3);
  end
  else
  begin
    X[0] := $A0;
    Word((@X[1])^) := Value;
    AddBytes(X,3);
  end;
end;

procedure TAsm.AsmMovImmAcc(Value: LongWord; Size: TSymbolSize);
var
  X: Array[0..4] of Byte;
begin
  if Size = ss32 then
  begin
    X[0] := $A3;
    LongWord((@X[1])^) := Value;
    AddBytes(X,5);
  end
  else if Size = ss16 then
  begin
    X[0] := $A2;
    Word((@X[1])^) := Value;
    AddBytes(X,3);
  end
  else
  begin
    X[0] := $A2;
    Word((@X[1])^) := Value;
    AddBytes(X,3);
  end;
end;

procedure TAsm.AsmMovReg(Reg1, Reg2: TRegister);
var
  X: Array[0..1] of Byte;
begin
  X[0] := 0;
  AddBytes(X,1);
end;

procedure TAsm.AsmAddAccImm(Acc: TAcculumator; Value: LongWord);
var
  X: Array[0..4] of Byte;
begin
  if Acc = raEAX then
  begin
    X[0] := $05;
    LongWord((@X[1])^) := Value;
    AddBytes(X,5);
  end
  else if Acc = raAX then
  begin
    X[0] := $05;
    Word((@X[1])^) := Value;
    AddBytes(X,3);
  end
  else if Acc = raAL then
  begin
    X[0] := $04;
    X[1] := Byte(Value);
    AddBytes(X,2);
  end;
end;

procedure TAsm.AsmSubAccImm(Acc: TAcculumator; Value: LongWord);
var
  X: Array[0..4] of Byte;
begin
  if Acc = raEAX then
  begin
    X[0] := $2D;
    LongWord((@X[1])^) := Value;
    AddBytes(X,5);
  end
  else if Acc = raAX then
  begin
    X[0] := $2D;
    Word((@X[1])^) := Value;
    AddBytes(X,3);
  end
  else if Acc = raAL then
  begin
    X[0] := $2C;
    X[1] := Byte(Value);
    AddBytes(X,2);
  end;
end;

procedure TAsm.AsmMulAccImm(Acc: TAcculumator; Value: LongWord);
var
  X: Array[0..2] of Byte;
begin
  if Acc = raAX then
  begin
    AsmMovRegImm(rCX,Value);
    X[0] := $0F;
    X[1] := $AF;
    X[2] := $C1;
    AddBytes(X,3);
  end;
end;

procedure TAsm.AsmDivAccImm(Acc: TAcculumator; Value: LongWord);
var
  X: Array[0..2] of Byte;
begin
  if Acc = raAX then
  begin
    AsmMovRegImm(rCX,Value);
    X[0] := $99;
    X[1] := $F7;
    X[2] := $F9;
    AddBytes(X,3);
  end;
end;

procedure TAsm.AsmAddAccVal(Acc: TAcculumator; Value: LongWord);
var
  X: Array[0..3] of Byte;
begin
  if Acc = raAX then
  begin
    X[0] := $03;
    X[1] := $06;
    Word((@X[2])^) := Value;
    AddBytes(X,4);
  end
  else if Acc = raAL then
  begin
    X[0] := $02;
    X[1] := $06;
    Word((@X[2])^) := Value;
    AddBytes(X,4);
  end;
end;

procedure TAsm.AsmSubAccVal(Acc: TAcculumator; Value: LongWord);
var
  X: Array[0..3] of Byte;
begin
  if Acc = raAX then
  begin
    X[0] := $2B;
    X[1] := $06;
    Word((@X[2])^) := Value;
    AddBytes(X,4);
  end
  else if Acc = raAL then
  begin
    X[0] := $2A;
    X[1] := $06;
    Word((@X[2])^) := Value;
    AddBytes(X,4);
  end;
end;

procedure TAsm.AsmMulAccVal(Acc: TAcculumator; Value: LongWord);
var
  X: Array[0..2] of Byte;
begin
  if Acc = raAX then
  begin
    AsmMovRegVal(rCX,0);
    AddFixUp(Value,ss16,ftDataAddress);
    X[0] := $0F;
    X[1] := $AF;
    X[2] := $C1;
    AddBytes(X,3);
  end;
end;

procedure TAsm.AsmDivAccVal(Acc: TAcculumator; Value: LongWord);
var
  X: Array[0..2] of Byte;
begin
  if Acc = raAX then
  begin
    AsmMovRegVal(rCX,0);
    AddFixUp(Value,ss16,ftDataAddress);
    X[0] := $99;
    X[1] := $F7;
    X[2] := $F9;
    AddBytes(X,3);
  end;
end;

procedure TAsm.AsmPushReg(Reg: TRegister);
var
  X: Byte;
begin
  if Reg in [rEAX..rEDI] then
  begin
    X := $50 + Ord(Reg);
    AddBytes(X,1);
  end
  else if Reg in [rAX..rDI] then
  begin
    Dec(Reg,Ord(rAX));
    X := $50 + Ord(Reg);
    AddBytes(X,1);
  end;
end;

procedure TAsm.AsmPushSeg(Seg: TSegment);
var
  X: Array[0..1] of Byte;
begin
  case Seg of
    sCS:
      X[0] := $0E;
    sSS:
      X[0] := $16;
    sDS:
      X[0] := $1E;
    sES:
      X[0] := $06;
    sFS:
    begin
      X[0] := $0F;
      X[1] := $A0;
    end;
    sGS:
    begin
      X[0] := $0F;
      X[1] := $A8;
    end;
  end;
  if X[1] = 0 then
    AddBytes(X,1)
  else
    AddBytes(X,2);
end;

procedure TAsm.AsmPopReg(Reg: TRegister);
var
  X: Byte;
begin
  if Reg in [rEAX..rEDI] then
  begin
    X := $58 + Ord(Reg);
    AddBytes(X,1);
  end