assembler.pas

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

end;

procedure TAsm.FuncWait;
begin
  AsmXorReg(rAX);
  AsmInt($16);
end;

procedure TAsm.FuncRead(SAssign, Extra: String);
begin
  AsmMovRegImm(rAH,7);
  AsmInt($21);
  FuncAE(SAssign,Extra);
end;

procedure TAsm.FuncReadLn(SAssign: String);
var
  X: Array[0..10] of Byte;
begin
  AsmMovRegImm(rAH,$0A);
  AsmMovRegImm(rDX,0);
  AddFixup(GetSymbol(SAssign+'.size').Offset,ss16,ftDataAddress);
  AsmInt($21);
  FuncNewLine;
  AsmMovRegImm(rBX,0);
  AddFixup(GetSymbol(SAssign+'.size').Offset,ss16,ftDataAddress);
  X[0] := $28;
  X[1] := $ED;
  X[2] := $8A;
  X[3] := $4F;
  X[4] := $01;
  X[5] := $89;
  X[6] := $CE;
  X[7] := $C6;
  X[8] := $40;
  X[9] := $02;
  X[10] := $24;
  AddBytes(X,11);
end;

procedure TAsm.FuncEnd;
begin
  if InStub then
    AsmMovRegImm(rAX,$4C01)
  else
    AsmMovRegImm(rAX,$4C00);
  AsmInt($21);
end;

procedure TAsm.FuncEndWin;
begin
  //
end;

procedure TAsm.FuncExpr(SAssign, Extra: String);
var
  i,lp,Curr: Integer;
  src: Array[0..9] of String;
  sym: Array[0..8] of String;
  rA: TAcculumator;
  raA: TRegister;
procedure FAdd(X: String);
begin
  if IsSymbol(X) then
  begin
    AsmAddAccVal(rA,0);
    AddFixUp(GetSymbol(X).Offset,CurrSize,ftDataAddress);
  end
  else
    AsmAddAccImm(rA,GetNumber(X));
end;
procedure FSub(X: String);
begin
  if IsSymbol(X) then
  begin
    AsmSubAccVal(rA,GetSymbol(X).Offset);
    AddFixUp(GetSymbol(X).Offset,CurrSize,ftDataAddress);
  end
  else
    AsmSubAccImm(rA,GetNumber(X));
end;
procedure FMul(X: String);
begin
  if IsSymbol(X) then
    AsmMulAccVal(rA,GetSymbol(X).Offset)
  else
    AsmMulAccImm(rA,GetNumber(X));
end;
procedure FDiv(X: String);
begin
  if IsSymbol(X) then
    AsmDivAccVal(rA,GetSymbol(X).Offset)
  else
    AsmDivAccImm(rA,GetNumber(X));
end;
begin
  Curr := 0;
  lp := 1;
  rA := raAX;
  raA := rAX;
  if CurrSize = ss32 then
  begin
    rA := raEAX;
    raA := rEAX;
  end;
  for i := 1 to Length(Extra) do
  begin
    if (Extra[i] in ['+','-','*','/']) then
    begin
      src[Curr] := Trim(Copy(Extra,lp,i-lp));
      sym[Curr] := Extra[i];
      lp := i+1;
      Curr := Curr + 1;
    end;
  end;
  src[Curr] := Trim(Copy(Extra,lp,Length(Extra)));

  if IsNumeric(src[0]) or (Equs.IndexOf(LowerCase(src[0])) > -1) then
    AsmMovRegImm(raA,GetNumber(src[0]))
  else
  begin
    if IsSymbol(CurrFunc+src[0]) then src[0] := CurrFunc+src[0];
    AsmMovAccImm(CurrSize,0);
    AddFixup(GetSymbol(src[0]).Offset,CurrSize,ftDataAddress);
  end;

  for i := 1 to Curr do
  begin
    if IsSymbol(CurrFunc+src[i]) then src[i] := CurrFunc+src[i];
    if sym[i-1] = '+' then
      FAdd(src[i])
    else if sym[i-1] = '-' then
      FSub(src[i])
    else if sym[i-1] = '*' then
      FMul(src[i])
    else if sym[i-1] = '/' then
      FDiv(src[i]);
  end;

  AsmMovImmAcc(0,CurrSize);
  if IsSymbol(CurrFunc+SAssign) then SAssign := CurrFunc+SAssign;
  AddFixup(GetSymbol(SAssign).Offset,CurrSize,ftDataAddress);
end;

procedure TAsm.FuncIf(Cmp1, Cmp2, CmpMode, JumpTo: String; IsNot: Boolean = False);
begin
  if IsNumeric(Cmp1) then
    AsmCmp(StrToInt(Cmp1),GetNumber(Cmp2),CurrSize)
  else if not IsSymbol(Cmp2) then
    AsmCmpV(GetSymbol(Cmp1).Offset,GetNumber(Cmp2),GetSymbol(Cmp1).Size)
  else
    AsmCmpVV(GetSymbol(Cmp1).Offset,GetSymbol(Cmp2).Offset,GetSymbol(Cmp1).Size);

  if IsNot then
  begin
    if CmpMode = '>' then
      AsmJng(0,CurrSize)
    else if CmpMode = '<' then
      AsmJnl(0,CurrSize)
    else if CmpMode = '=' then
      AsmJne(0,CurrSize)
    else if CmpMode = '>=' then
      AsmJl(0,CurrSize)
    else if CmpMode = '<=' then
      AsmJg(0,CurrSize)
    else if CmpMode = '<>' then
      AsmJe(0,CurrSize);
  end
  else
  begin
    if CmpMode = '>' then
      AsmJg(0,CurrSize)
    else if CmpMode = '<' then
      AsmJl(0,CurrSize)
    else if CmpMode = '=' then
      AsmJe(0,CurrSize)
    else if CmpMode = '>=' then
      AsmJge(0,CurrSize)
    else if CmpMode = '<=' then
      AsmJle(0,CurrSize)
    else if CmpMode = '<>' then
      AsmJne(0,CurrSize);
  end;
  AddFixup(Size(True),CurrSize,ftJump,CurrFunc+JumpTo);
end;

procedure TAsm.FuncReturn;
begin
  AsmRet;
end;

procedure TAsm.FuncResult(Value,Func: String);
begin
  if Value <> '' then FuncExpr(Value,Func+'.result');
end;

procedure TAsm.FuncSetMode(Mode: String);
begin
  if LowerCase(Mode) = 'text' then
    AsmMovRegImm(rAX,$03)
  else if LowerCase(Mode) = 'vga' then
    AsmMovRegImm(rAX,$13);
  AsmInt($10);
end;

procedure TAsm.FuncPixel(X, Y, Color: String);
var
  Xe: Array[0..5] of Byte;
begin
  AsmMovRegImm(rDI,$A000);
  Xe[0] := $8E;
  Xe[1] := $C7;
  AddBytes(Xe,2);
  AsmMovRegImm(rAX,320);

  if Symbols.IndexOf(LowerCase(Y)) > -1 then
  begin
    Xe[0] := $F7;
    Xe[1] := $26;
    Xe[2] := $00;
    Xe[3] := $00;
    AddBytes(Xe,4);
    AddFixup(GetSymbol(Y).Offset,ss16,ftDataAddress);
  end
  else
    WriteMsg(SymbolRequired);

  if Symbols.IndexOf(LowerCase(X)) > -1 then
  begin
    Xe[0] := $89;
    Xe[1] := $C7;
    Xe[2] := $03;
    Xe[3] := $3E;
    Xe[4] := 0;
    Xe[5] := 0;
    AddBytes(Xe,6);
    AddFixup(GetSymbol(X).Offset,ss16,ftDataAddress);
  end
  else
    WriteMsg(SymbolRequired);

  if Symbols.IndexOf(LowerCase(Color)) > -1 then
  begin
    AsmMovRegVal(rAL,0);
    AddFixup(GetSymbol(Color).Offset,ss16,ftDataAddress);
  end
  else
    AsmMovRegImm(rAL,GetNumber(Color));

  Xe[0] := $AA;
  AddBytes(Xe,1);
end;

procedure TAsm.FormatPE(GUI: Boolean);
  procedure WriteZeroes (Count: Cardinal);
  var
    Buf: array[0..4095] of Byte;
    C: Cardinal;
  begin
    FillChar(Buf,SizeOf(Buf),0);
    while Count <> 0 do begin
      C := Count;
      if C > SizeOf(Buf) then C := SizeOf(Buf);
      AddFBytes(Buf,C);
    end;
  end;
  procedure PadForFileAlignment;
  var
    I: Integer;
    Slack: array[0..xFileAlignment-1] of Byte;
  begin
    I := xFileAlignment - (Length(Format) mod xFileAlignment);
    if I > 0 then begin
      FillChar(Slack,I,0);
      AddFBytes(Slack,I);
    end;
  end;
const
  IDataRVA = $1000;
  CodeRVA = $2000;
  BSSRVA = $3000;
var
  PESig: LongWord;
  PEHeader: TImageFileHeader;
  OptHeader: TImageOptionalHeader;
  Sec: TImageSectionHeader;
begin
  Format := '';
  PESig := $00004550;
  AddFBytes(PESig,4);
  FillChar(PEHeader,SizeOf(PEHeader),0);
  PEHeader.Machine := IMAGE_FILE_MACHINE_I386;
  PEHeader.NumberOfSections := 3;
  PEHeader.TimeDateStamp := 0;
  PEHeader.PointerToSymbolTable := 0;
  PEHeader.NumberOfSymbols := 0;
  PEHeader.SizeOfOptionalHeader := SizeOf(OptHeader);
  PEHeader.Characteristics := $818E or IMAGE_FILE_RELOCS_STRIPPED;
  AddFBytes(PEHeader,SizeOf(PEHeader));

  FillChar (OptHeader, SizeOf(OptHeader), 0);
  OptHeader.Magic := $010B;
  OptHeader.MajorLinkerVersion := 0;
  OptHeader.MinorLinkerVersion := 0;
  OptHeader.SizeOfCode := Length(Code+Data);;
  OptHeader.SizeOfInitializedData := 0;
  OptHeader.SizeOfUninitializedData := 0;
  OptHeader.AddressOfEntryPoint := CodeRVA;
  OptHeader.BaseOfCode := CodeRVA;
  OptHeader.BaseOfData := 0;
  OptHeader.ImageBase := $400000;
  OptHeader.SectionAlignment := $1000;
  OptHeader.FileAlignment := xFileAlignment;
  OptHeader.MajorOperatingSystemVersion := 1;
  OptHeader.MinorOperatingSystemVersion := 0;
  OptHeader.MajorImageVersion := 0;
  OptHeader.MajorImageVersion := 0;
  OptHeader.MajorSubsystemVersion := 4;
  OptHeader.Win32VersionValue := 0;
  OptHeader.SizeOfImage := $1000 + $3000;
  OptHeader.SizeOfHeaders := $200;
  OptHeader.CheckSum := 0;
  if GUI then OptHeader.Subsystem := IMAGE_SUBSYSTEM_WINDOWS_GUI
  else OptHeader.Subsystem := IMAGE_SUBSYSTEM_WINDOWS_CUI;
  OptHeader.DllCharacteristics := 0;
  OptHeader.SizeOfStackReserve := $100000;
  OptHeader.SizeOfStackCommit := $4000;
  OptHeader.SizeOfHeapReserve := $100000;
  OptHeader.SizeOfHeapCommit := $1000;
  OptHeader.LoaderFlags := 0;
  OptHeader.NumberOfRvaAndSizes := IMAGE_NUMBEROF_DIRECTORY_ENTRIES;
  OptHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress := IDataRVA;
  AddFBytes(OptHeader,SizeOf(OptHeader));

  FillChar(Sec,SizeOf(Sec),0);
  StrPCopy(@Sec.Name, '.idata');
  Sec.Misc.VirtualSize := $1000;
  Sec.VirtualAddress := IDataRVA;
  Sec.SizeOfRawData := $200;
  Sec.PointerToRawData := $200;
  Sec.Characteristics := IMAGE_SCN_CNT_INITIALIZED_DATA or IMAGE_SCN_MEM_READ or IMAGE_SCN_MEM_WRITE;
  AddFBytes(Sec,SizeOf(Sec));

  FillChar(Sec,SizeOf(Sec),0);
  StrPCopy(@Sec.Name,'.code');
  Sec.Misc.VirtualSize := $1000;
  Sec.VirtualAddress := CodeRVA;
  Sec.SizeOfRawData := $200;
  Sec.PointerToRawData := $400;
  Sec.Characteristics := IMAGE_SCN_CNT_CODE or IMAGE_SCN_MEM_EXECUTE or IMAGE_SCN_MEM_READ;
  AddFBytes(Sec,SizeOf(Sec));

  FillChar(Sec,SizeOf(Sec),0);
  StrPCopy(@Sec.Name,'.rsrc');
  Sec.Misc.VirtualSize := $1000;
  Sec.VirtualAddress := CodeRVA;
  Sec.SizeOfRawData := $200;
  Sec.PointerToRawData := $400;
  Sec.Characteristics := IMAGE_DIRECTORY_ENTRY_RESOURCE or IMAGE_SCN_CNT_INITIALIZED_DATA or
    IMAGE_SCN_MEM_READ;
  AddFBytes(Sec,SizeOf(Sec));

  PadForFileAlignment;
end;

procedure TAsm.FormatMZ(IsStub: Boolean = False);
var
  EXE: TFormatMZ;
  FileSize, Blocks: Word;
  i, C: Integer;
begin
  if IsStub then
    FileSize := SizeOf(TFormatMZ) + Length(Stub) + Length(StubData)
  else
    FileSize := SizeOf(TFormatMZ) + Length(Code) + Length(Data);
  Blocks := 0;
  C := 0;
  for i := 1 to FileSize do
  begin
    C := C + 1;
    if C = 512 then
    begin
      C := 0;
      Blocks := Blocks + 1;
    end;
  end;
  EXE.signature := $5A4D;
  EXE.bytes_in_last_block := C;
  EXE.blocks_in_file := Blocks + 1;
  EXE.num_relocs := 0;
  EXE.header_paragraphs := 2;
  EXE.min_extra_paragraphs := $100;
  EXE.max_extra_paragraphs := $FFFF;
  EXE.ss := $1;
  EXE.sp := $1000;
  EXE.checksum := 0;
  EXE.ip := 0;
  EXE.cs := 0;
  EXE.reloc_table_offset := $1C;
  EXE.overlay_number := 0;
  EXE.reloc_offset := 0;
  EXE.reloc_segment := 0;
  AddFBytes(EXE,SizeOf(EXE));
end;

procedure TAsm.SaveFile(Filename: String; Mode: String);
var
  fs: TFileStream;
  i: Integer;
begin
  for i := 0 to Fixups.Count - 1 do
  begin
    CurrFile := PFixUp(Fixups[i]).FlName;
    CurrLine := PFixUp(Fixups[i]).LnNum;
    if PFixUp(Fixups[i]).FStub = True then
    begin
      if PFixUp(Fixups[i]).Size = ss8 then
      begin
        if PFixUp(Fixups[i]).FixType = ftDataAddress then
          Byte((@Stub[PFixUp(Fixups[i]).Offset])^) := LongWord(Length(Stub)) + PFixUp(Fixups[i]).Value
        else if PFixUp(Fixups[i]).FixType = ftJump then
          Byte((@Stub[PFixUp(Fixups[i]).Offset])^) := GetSymbol(PFixUp(Fixups[i]).Extra).Offset - PFixUp(Fixups[i]).Value;
      end
      else if PFixUp(Fixups[i]).Size = ss16 then
      begin
        if PFixUp(Fixups[i]).FixType = ftDataAddress then
          Word((@Stub[PFixUp(Fixups[i]).Offset])^) := LongWord(Length(Stub)) + PFixUp(Fixups[i]).Value
        else if PFixUp(Fixups[i]).FixType = ftJump then
          Word((@Stub[PFixUp(Fixups[i]).Offset])^) := GetSymbol(PFixUp(Fixups[i]).Extra).Offset - PFixUp(Fixups[i]).Value;
      end
      else if PFixUp(Fixups[i]).Size = ss32 then
      begin
        if PFixUp(Fixups[i]).FixType = ftDataAddress then
          LongWord((@Stub[PFixUp(Fixups[i]).Offset])^) := LongWord(Length(Stub)) + PFixUp(Fixups[i]).Value
        else if PFixUp(Fixups[i]).FixType = ftJump then
          LongWord((@Stub[PFixUp(Fixups[i]).Offset])^) := GetSymbol(PFixUp(Fixups[i]).Extra).Offset - PFixUp(Fixups[i]).Value;
      end;
    end
    else
    begin
      if PFixUp(Fixups[i]).Size = ss8 then
      begin
        if PFixUp(Fixups[i]).FixType = ftDataAddress then
          Byte((@Code[PFixUp(Fixups[i]).Offset])^) := LongWord(Length(Code)) + PFixUp(Fixups[i]).Value
        else if PFixUp(Fixups[i]).FixType = ftJump then
          Byte((@Code[PFixUp(Fixups[i]).Offset])^) := GetSymbol(PFixUp(Fixups[i]).Extra).Offset - PFixUp(Fixups[i]).Value;
      end
      else if PFixUp(Fixups[i]).Size = ss16 then
      begin
        if PFixUp(Fixups[i]).FixType = ftDataAddress then
          Word((@Code[PFixUp(Fixups[i]).Offset])^) := LongWord(Length(Code)) + PFixUp(Fixups[i]).Value
        else if PFixUp(Fixups[i]).FixType = ftJump then
          Word((@Code[PFixUp(Fixups[i]).Offset])^) := GetSymbol(PFixUp(Fixups[i]).Extra).Offset - PFixUp(Fixups[i]).Value;
      end
      else if PFixUp(Fixups[i]).Size = ss32 then
      begin
        if PFixUp(Fixups[i]).FixType = ftDataAddress then
          LongWord((@Code[PFixUp(Fixups[i]).Offset])^) := LongWord(Length(Code)) + PFixUp(Fixups[i]).Value
        else if PFixUp(Fixups[i]).FixType = ftJump then
          LongWord((@Code[PFixUp(Fixups[i]).Offset])^) := GetSymbol(PFixUp(Fixups[i]).Extra).Offset - PFixUp(Fixups[i]).Value;
      end;
    end;
  end;
  fs := TFileStream.Create(Filename, fmCreate or fmOpenReadWrite);
  if Mode = 'none' then
  begin
    fs.Write(PChar(Code)^, Length(Code));
    fs.Write(PChar(Data)^, Length(Data));
  end
  else if Mode = 'dos.mz' then
  begin
    FormatMZ;
    fs.Write(PChar(Format)^, Length(Format));
    fs.Write(PChar(Code)^, Length(Code));
    fs.Write(PChar(Data)^, Length(Data));
  end
  else if (Mode = 'windows.gui') or (Mode = 'windows.console') then
  begin
    FormatMZ(True);
    fs.Write(PChar(Format)^, Length(Format));
    fs.Write(PChar(Stub)^, Length(Stub));
    fs.Write(PChar(StubData)^, Length(StubData));
    FormatPE((Mode = 'windows.gui'));
    fs.Write(PChar(Format)^, Length(Format));
    fs.Write(PChar(Code)^, Length(Code));
    fs.Write(PChar(Data)^, Length(Data));
  end
  else
  begin
    WriteToScreen('Fatal error: '+NotSupportedFormat+'.');
    FormatterError := True;
  end;
  fs.Destroy;
end;

function TAsm.AddData(Str: String; Terminator: Char = '$'): LongWord;
begin
  if InStub then
  begin
    result := Length(StubData);
    StubData := StubData + Str;
    if Terminator <> '*' then StubData := StubData + Terminator;
  end
  else
  begin
    result := Length(Data);
    Data := Data + Str;
    if Terminator <> '*' then
    begin
      if (CurrSize = ss32) then
        Data := Data + #0
      else
        Data := Data + Terminator;
    end;
  end;
end;

function TAsm.AddVar(Str: String; Size: TSymbolSize): LongWord;
var
  X: Array[0..3] of Integer;
begin
  result := Length(Data);
  if Size = ss8 then
    X[0] := GetNumber(Str)
  else if Size = ss16 then
    Word((@X[0])^) := GetNumber(Str)
  else if Size = ss32 then
    LongWord((@X[0])^) := GetNumber(Str);
  AddDBytes(X,TSize[Ord(Size)]+1);
  X[0] := $24;
  AddDBytes(X,1);
end;

procedure TAsm.AddSymbol(Name: String; Size: TSymbolSize; SymbolType: TSymbolType; Offset: LongWord = 0);
var
  p: PSymbol;
begin
  New(p);
  if Offsets.Count >= 1 then
    p.Offset := Cardinal(Offsets[0]);
  ClearOffsets;
  if Offset <> 0 then p.Offset := Offset;
  p.Size := Size;
  p.SymbolType := SymbolType;
  if Symbols.IndexOf(LowerCase(CurrFunc+Name)) = -1 then
    Symbols.AddObject(LowerCase(CurrFunc+Name),TObject(p))
  else
    WriteMsg(SymbolAlreadyExists);
end;

function TAsm.GetSymbol(Name: String): PSymbol;
var
  t: PSymbol;
begin
  if Symbols.IndexOf(LowerCase(Name)) = -1 then
  begin
    WriteMsg(DontExists);
    New(t);
    result := t;
  end
  else
    result := PSymbol(Symbols.Objects[Symbols.IndexOf(LowerCase(Name))]);
end;

function TAsm.IsSymbol(Name: String): Boolean;
begin
  if Symbols.IndexOf(LowerCase(Name)) = -1 then
    result := False
  else
    result := True;
end;

procedure TAsm.AddFixup(Value: LongWord; Size: TSymbolSize; FixType: TFixType; Extra: String = '');
var
  Rec: PFixUp;
begin
  New(Rec);
  Rec.FixType := FixType;
  if InStub then Rec.Offset := Length(Stub) - 1
  else Rec.Offset := Length(Code) - TSize[Ord(Size)];
  Rec.Extra := Extra;
  Rec.FlName := CurrFile;
  Rec.LnNum := CurrLine;
  Rec.Size := Size;
  Rec.Value := Value;
  Rec.FStub := InStub;
  Fixups.Add(Rec);
end;

function TAsm.Size(IncFormat: Boolean = False; IncData: Boolean = False; IsWritten: Boolean = True): LongWord;
begin
  result := Length(Code);
  if IncFormat then
  begin
    result := result + SizeOf(TFormatMZ);
    if CurrSize = ss32 then result := result + PEHeaderSize;
  end;
  if IncData then result := result + LongWord(Length(Data));
  if CurrSize = ss32 then result := result + LongWord(Length(Stub+StubData));
  if not IsWritten then result := 0;
end;

procedure TAsm.AddOffset(Offset: LongWord);
begin
  Offsets.Add(Pointer(Offset));
end;

procedure TAsm.ClearOffsets;
begin
  Offsets.Clear;
end;

procedure TAsm.AddEqu(Name: String; Value: Integer);
begin
  if Equs.IndexOf(LowerCase(Name)) = -1 then
    Equs.AddObject(LowerCase(Name),TObject(Value))
  else
    WriteMsg(SymbolAlreadyExists);
end;

function TAsm.GetEqu(Name: String): Integer;
begin
  if Equs.IndexOf(LowerCase(Name)) = -1 then
  begin
    WriteMsg(DontExists);
    result := 0;
  end
  else
    result := Integer(Equs.Objects[Equs.IndexOf(LowerCase(Name))]);
end;

procedure TAsm.AddAlias(Name: String; Value: String);
begin
  if Alias.IndexOf(LowerCase(Name)) = -1 then
    Alias.AddObject(LowerCase(Name),TObject(Value))
  else
    WriteMsg(SymbolAlreadyExists);
end;

function TAsm.GetAlias(Name: String): String;
begin
  if Alias.IndexOf(LowerCase(Name)) = -1 then
  begin
    WriteMsg(DontExists);
    result := '';
  end
  else
    result := String(Alias.Objects[Alias.IndexOf(LowerCase(Name))]);
end;

end.