{
$Id: ogcoff.pas,v 1.27 2003/04/23 11:37:15 peter Exp $
Copyright (c) 1998-2002 by Peter Vreman and Pierre Muller
Contains the binary coff reader and writer
* This code was inspired by the NASM sources
The Netwide Assembler is copyright (C) 1996 Simon Tatham and
Julian Hall. All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit ogcoff;
{$i fpcdefs.inc}
interface
uses
{ common }
cclasses,
{ target }
systems,
{ assembler }
cpubase,aasmbase,assemble,link,
{ output }
ogbase,ogmap;
type
TCoffObjectSection = class(TAsmSection)
private
orgmempos,
coffrelocs,
coffrelocpos : longint;
public
constructor createsec(sec:TSection;AAlign,AFlags:cardinal);
procedure addsymsizereloc(ofs:longint;p:tasmsymbol;size:longint;relative:TAsmRelocationType);
end;
tcoffobjectdata = class(TAsmObjectData)
private
win32 : boolean;
procedure reset;
public
constructor createdjgpp(const n:string);
constructor createwin32(const n:string);
destructor destroy;override;
procedure seTSectionsizes(var s:TAsmSectionSizes);override;
procedure createsection(sec:TSection);override;
procedure writereloc(data,len:longint;p:tasmsymbol;relative:TAsmRelocationType);override;
procedure writesymbol(p:tasmsymbol);override;
procedure writestabs(section:TSection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);override;
procedure writesymstabs(section:TSection;offset:longint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);override;
procedure fixuprelocs;override;
end;
tcoffobjectoutput = class(tobjectoutput)
private
win32 : boolean;
initsym : longint;
FCoffStrs : tdynamicarray;
procedure write_symbol(const name:string;strpos,value,section,typ,aux:longint);
procedure write_symbols(data:TAsmObjectData);
procedure write_relocs(data:TAsmObjectData);
protected
function writedata(data:TAsmObjectData):boolean;override;
public
constructor createdjgpp(smart:boolean);
constructor createwin32(smart:boolean);
function newobjectdata(const n:string):TAsmObjectData;override;
end;
tcoffexeoutput = class(texeoutput)
private
FCoffsyms,
FCoffStrs : tdynamicarray;
win32 : boolean;
nsects,
nsyms,
sympos : longint;
procedure write_symbol(const name:string;strpos,value,section,typ,aux:longint);
procedure write_symbols;
protected
function writedata:boolean;override;
public
constructor createdjgpp;
constructor createwin32;
function newobjectinput:tobjectinput;override;
procedure CalculateMemoryMap;override;
procedure GenerateExecutable(const fn:string);override;
end;
ttasmsymbolrec = record
sym : tasmsymbol;
orgsize : longint;
end;
ttasmsymbolarray = array[0..high(word)] of ttasmsymbolrec;
tcoffobjectinput = class(tobjectinput)
private
Fidx2sec : array[0..255] of TSection;
FCoffsyms,
FCoffStrs : tdynamicarray;
FSymTbl : ^ttasmsymbolarray;
win32 : boolean;
procedure read_relocs(s:TCoffObjectSection);
procedure handle_symbols(data:TAsmObjectData);
protected
function readobjectdata(data:TAsmObjectData):boolean;override;
public
constructor createdjgpp;
constructor createwin32;
function newobjectdata(const n:string):TAsmObjectData;override;
end;
tcoffassembler = class(tinternalassembler)
constructor create(smart:boolean);override;
end;
tpecoffassembler = class(tinternalassembler)
constructor create(smart:boolean);override;
end;
tcofflinker = class(tinternallinker)
constructor create;override;
end;
implementation
uses
{$ifdef delphi}
sysutils,
{$else}
strings,
{$endif}
cutils,verbose,
globtype,globals,fmodule;
const
COFF_FLAG_NORELOCS = $0001;
COFF_FLAG_EXE = $0002;
COFF_FLAG_NOLINES = $0004;
COFF_FLAG_NOLSYMS = $0008;
COFF_FLAG_AR16WR = $0080; { 16bit little endian }
COFF_FLAG_AR32WR = $0100; { 32bit little endian }
COFF_FLAG_AR32W = $0200; { 32bit big endian }
COFF_FLAG_DLL = $2000;
COFF_SYM_GLOBAL = 2;
COFF_SYM_LOCAL = 3;
COFF_SYM_LABEL = 6;
COFF_SYM_FUNCTION = 101;
COFF_SYM_FILE = 103;
COFF_SYM_SECTION = 104;
type
{ Structures which are written directly to the output file }
coffheader=packed record
mach : word;
nsects : word;
time : longint;
sympos : longint;
syms : longint;
opthdr : word;
flag : word;
end;
coffoptheader=packed record
magic : word;
vstamp : word;
tsize : longint;
dsize : longint;
bsize : longint;
entry : longint;
text_start : longint;
data_start : longint;
end;
coffsechdr=packed record
name : array[0..7] of char;
vsize : longint;
rvaofs : longint;
datasize : longint;
datapos : longint;
relocpos : longint;
lineno1 : longint;
nrelocs : word;
lineno2 : word;
flags : cardinal;
end;
coffsectionrec=packed record
len : longint;
nrelocs : word;
empty : array[0..11] of char;
end;
coffreloc=packed record
address : longint;
sym : longint;
relative : word;
end;
coffsymbol=packed record
name : array[0..3] of char; { real is [0..7], which overlaps the strpos ! }
strpos : longint;
value : longint;
section : smallint;
empty : smallint;
typ : byte;
aux : byte;
end;
coffstab=packed record
strpos : longint;
ntype : byte;
nother : byte;
ndesc : word;
nvalue : longint;
end;
const
symbolresize = 200*sizeof(coffsymbol);
strsresize = 8192;
const go32v2stub : array[0..2047] of byte=(
$4D,$5A,$00,$00,$04,$00,$00,$00,$20,$00,$27,$00,$FF,$FF,$00,
$00,$60,$07,$00,$00,$54,$00,$00,$00,$00,$00,$00,$00,$0D,$0A,
$73,$74,$75,$62,$2E,$68,$20,$67,$65,$6E,$65,$72,$61,$74,$65,
$64,$20,$66,$72,$6F,$6D,$20,$73,$74,$75,$62,$2E,$61,$73,$6D,
$20,$62,$79,$20,$64,$6A,$61,$73,$6D,$2C,$20,$6F,$6E,$20,$54,
$68,$75,$20,$44,$65,$63,$20,$20,$39,$20,$31,$30,$3A,$35,$39,
$3A,$33,$31,$20,$31,$39,$39,$39,$0D,$0A,$54,$68,$65,$20,$53,
$54,$55,$42,$2E,$45,$58,$45,$20,$73,$74,$75,$62,$20,$6C,$6F,
$61,$64,$65,$72,$20,$69,$73,$20,$43,$6F,$70,$79,$72,$69,$67,
$68,$74,$20,$28,$43,$29,$20,$31,$39,$39,$33,$2D,$31,$39,$39,
$35,$20,$44,$4A,$20,$44,$65,$6C,$6F,$72,$69,$65,$2E,$20,$0D,
$0A,$50,$65,$72,$6D,$69,$73,$73,$69,$6F,$6E,$20,$67,$72,$61,
$6E,$74,$65,$64,$20,$74,$6F,$20,$75,$73,$65,$20,$66,$6F,$72,
$20,$61,$6E,$79,$20,$70,$75,$72,$70,$6F,$73,$65,$20,$70,$72,
$6F,$76,$69,$64,$65,$64,$20,$74,$68,$69,$73,$20,$63,$6F,$70,
$79,$72,$69,$67,$68,$74,$20,$0D,$0A,$72,$65,$6D,$61,$69,$6E,
$73,$20,$70,$72,$65,$73,$65,$6E,$74,$20,$61,$6E,$64,$20,$75,
$6E,$6D,$6F,$64,$69,$66,$69,$65,$64,$2E,$20,$0D,$0A,$54,$68,
$69,$73,$20,$6F,$6E,$6C,$79,$20,$61,$70,$70,$6C,$69,$65,$73,
$20,$74,$6F,$20,$74,$68,$65,$20,$73,$74,$75,$62,$2C,$20,$61,
$6E,$64,$20,$6E,$6F,$74,$20,$6E,$65,$63,$65,$73,$73,$61,$72,
$69,$6C,$79,$20,$74,$68,$65,$20,$77,$68,$6F,$6C,$65,$20,$70,
$72,$6F,$67,$72,$61,$6D,$2E,$0A,$0D,$0A,$24,$49,$64,$3A,$20,
$73,$74,$75,$62,$2E,$61,$73,$6D,$20,$62,$75,$69,$6C,$74,$20,
$31,$32,$2F,$30,$39,$2F,$39,$39,$20,$31,$30,$3A,$35,$39,$3A,
$33,$31,$20,$62,$79,$20,$64,$6A,$61,$73,$6D,$20,$24,$0A,$0D,
$0A,$40,$28,$23,$29,$20,$73,$74,$75,$62,$2E,$61,$73,$6D,$20,
$62,$75,$69,$6C,$74,$20,$31,$32,$2F,$30,$39,$2F,$39,$39,$20,
$31,$30,$3A,$35,$39,$3A,$33,$31,$20,$62,$79,$20,$64,$6A,$61,
$73,$6D,$0A,$0D,$0A,$1A,$00,$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$67,$6F,$33,$32,$73,$74,$75,$62,$2C,$20,$76,$20,$32,
$2E,$30,$32,$54,$00,$00,$00,$00,$00,$08,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$43,$57,$53,$44,$50,
$4D,$49,$2E,$45,$58,$45,$00,$00,$00,$00,$00,$0E,$1F,$8C,$1E,
$24,$00,$8C,$06,$60,$07,$FC,$B4,$30,$CD,$21,$3C,$03,$73,$08,
$B0,$6D,$BA,$A7,$05,$E9,$D4,$03,$A2,$69,$08,$BE,$20,$00,$8B,
$04,$09,$C0,$75,$02,$B4,$FE,$BB,$70,$08,$39,$C3,$73,$02,$89,
$C3,$89,$1C,$FE,$C7,$B9,$04,$FF,$D3,$EB,$B4,$4A,$CD,$21,$73,
$08,$D3,$E3,$FE,$CF,$89,$1C,$EB,$D8,$26,$8E,$06,$2C,$00,$31,
$FF,$30,$C0,$A9,$F2,$AE,$26,$81,$3D,$50,$41,$75,$15,$AF,$26,
$81,$3D,$54,$48,$75,$0D,$AF,$26,$80,$3D,$3D,$75,$06,$47,$89,
$3E,$8C,$04,$4F,$AE,$75,$DF,$AF,$B4,$3E,$BB,$13,$00,$CD,$21,
$B4,$3E,$BB,$12,$00,$CD,$21,$06,$57,$31,$C9,$74,$12,$B0,$6E,
$BA,$7E,$05,$E9,$5E,$03,$09,$C9,$75,$F4,$41,$E8,$A1,$03,$72,
$EE,$B8,$87,$16,$CD,$2F,$09,$C0,$75,$ED,$80,$E3,$01,$74,$E8,
$89,$3E,$00,$06,$8C,$06,$02,$06,$89,$36,$04,$06,$5F,$07,$E8,
$D3,$02,$89,$3E,$2A,$00,$89,$36,$62,$07,$80,$3E,$2C,$00,$00,
$74,$23,$B9,$08,$00,$BF,$2C,$00,$8A,$05,$47,$08,$C0,$74,$05,
$88,$07,$43,$E2,$F4,$66,$C7,$07,$2E,$45,$58,$45,$83,$C3,$04,
$C6,$07,$00,$89,$1E,$62,$07,$B8,$00,$3D,$BA,$64,$07,$CD,$21,
$0F,$82,$B3,$02,$A3,$06,$06,$89,$C3,$B9,$06,$00,$BA,$B5,$07,
$B4,$3F,$CD,$21,$31,$D2,$31,$C9,$A1,$B5,$07,$3D,$4C,$01,$74,
$1B,$3D,$4D,$5A,$0F,$85,$98,$02,$8B,$16,$B9,$07,$C1,$E2,$09,
$8B,$1E,$B7,$07,$09,$DB,$74,$05,$80,$EE,$02,$01,$DA,$89,$16,
$BB,$07,$89,$0E,$BD,$07,$B8,$00,$42,$8B,$1E,$06,$06,$CD,$21,
$B9,$A8,$00,$BA,$BF,$07,$B4,$3F,$CD,$21,$3D,$A8,$00,$75,$06,
$81,$3E,$BF,$07,$4C,$01,$0F,$85,$61,$02,$66,$A1,$E3,$07,$66,
$A3,$10,$06,$66,$8B,$0E,$BB,$07,$66,$A1,$03,$08,$66,$01,$C8,
$66,$A3,$08,$06,$66,$A1,$2B,$08,$66,$01,$C8,$66,$A3,$0C,$06,
$66,$8B,$1E,$4B,$08,$66,$A1,$4F,$08,$66,$01,$C3,$66,$B8,$01,
$00,$01,$00,$66,$39,$C3,$73,$03,$66,$89,$C3,$66,$81,$C3,$FF,
$FF,$00,$00,$31,$DB,$66,$89,$1E,$1C,$00,$E8,$F5,$02,$8B,$1E,
$04,$06,$09,$DB,$74,$0A,$B4,$48,$CD,$21,$0F,$82,$15,$02,$8E,
$C0,$E8,$08,$03,$B8,$01,$00,$FF,$1E,$00,$06,$0F,$82,$0F,$02,
$8C,$06,$26,$00,$8C,$0E,$28,$00,$8C,$D8,$A3,$22,$00,$8E,$C0,
$31,$C0,$B9,$01,$00,$CD,$31,$72,$07,$A3,$14,$06,$31,$C0,$CD,
$31,$0F,$82,$F3,$01,$A3,$16,$06,$66,$8B,$0E,$1C,$00,$B8,$01,
$05,$8B,$1E,$1E,$00,$CD,$31,$0F,$82,$E5,$01,$89,$1E,$1A,$06,
$89,$0E,$18,$06,$89,$36,$1A,$00,$89,$3E,$18,$00,$B8,$07,$00,
$8B,$1E,$14,$06,$8B,$0E,$1A,$06,$8B,$16,$18,$06,$CD,$31,$B8,
$09,$00,$8C,$C9,$83,$E1,$03,$C1,$E1,$05,$51,$81,$C9,$9B,$C0,
$CD,$31,$B8,$08,$00,$8B,$0E,$1E,$00,$49,$BA,$FF,$FF,$CD,$31,
$B8,$07,$00,$8B,$1E,$16,$06,$8B,$0E,$1A,$06,$8B,$16,$18,$06,
$CD,$31,$B8,$09,$00,$59,$81,$C9,$93,$C0,$CD,$31,$B8,$08,$00,
$8B,$0E,$1E,$00,$49,$BA,$FF,$FF,$CD,$31,$B8,$00,$01,$BB,$00,
$0F,$CD,$31,$73,$10,$3D,$08,$00,$0F,$85,$73,$01,$B8,$00,$01,
$CD,$31,$0F,$82,$6A,$01,$A3,$1C,$06,$89,$16,$1E,$06,$C1,$E3,
$04,$89,$1E,$20,$06,$66,$8B,$36,$08,$06,$66,$8B,$3E,$FB,$07,
$66,$8B,$0E,$FF,$07,$E8,$49,$00,$66,$8B,$36,$0C,$06,$66,$8B,
$3E,$23,$08,$66,$8B,$0E,$27,$08,$E8,$37,$00,$8E,$06,$16,$06,
$66,$8B,$3E,$4B,$08,$66,$8B,$0E,$4F,$08,$66,$31,$C0,$66,$C1,
$E9,$02,$67,$F3,$66,$AB,$B4,$3E,$8B,$1E,$06,$06,$CD,$21,$B8,
$01,$01,$8B,$16,$1E,$06,$CD,$31,$1E,$0F,$A1,$8E,$1E,$16,$06,
$66,$64,$FF,$2E,$10,$06,$66,$89,$F0,$66,$25,$FF,$01,$00,$00,
$66,$01,$C1,$29,$C6,$66,$29,$C7,$66,$89,$0E,$26,$06,$66,$89,
$3E,$22,$06,$E8,$0F,$01,$89,$36,$3E,$06,$66,$C1,$EE,$10,$89,
$36,$42,$06,$8B,$1E,$06,$06,$89,$1E,$3A,$06,$C7,$06,$46,$06,
$00,$42,$E8,$03,$01,$A1,$1C,$06,$A3,$4E,$06,$C7,$06,$3E,$06,
$00,$00,$C6,$06,$47,$06,$3F,$A1,$28,$06,$09,$C0,$75,$09,$A1,
$26,$06,$3B,$06,$20,$06,$76,$03,$A1,$20,$06,$A3,$42,$06,$E8,
$D9,$00,$66,$31,$C9,$8B,$0E,$46,$06,$66,$8B,$3E,$22,$06,$66,
$01,$0E,$22,$06,$66,$29,$0E,$26,$06,$66,$31,$F6,$C1,$E9,$02,
$1E,$06,$8E,$06,$16,$06,$8E,$1E,$1E,$06,$67,$F3,$66,$A5,$07,
$1F,$66,$03,$0E,$26,$06,$75,$AF,$C3,$3C,$3A,$74,$06,$3C,$2F,
$74,$02,$3C,$5C,$C3,$BE,$64,$07,$89,$F3,$26,$8A,$05,$47,$88,
$04,$38,$E0,$74,$0E,$08,$C0,$74,$0A,$46,$E8,$DE,$FF,$75,$EC,
$89,$F3,$74,$E8,$C3,$B0,$66,$BA,$48,$05,$EB,$0C,$B0,$67,$BA,
$55,$05,$EB,$05,$B0,$68,$BA,$5F,$05,$52,$8B,$1E,$62,$07,$C6,
$07,$24,$BB,$64,$07,$EB,$28,$E8,$F5,$00,$B0,$69,$BA,$99,$05,
$EB,$1A,$B0,$6A,$BA,$B2,$05,$EB,$13,$B0,$6B,$BA,$C4,$05,$EB,
$0C,$B0,$6C,$BA,$D6,$05,$EB,$05,$B0,$69,$BA,$99,$05,$52,$BB,
$3B,$05,$E8,$15,$00,$5B,$E8,$11,$00,$BB,$67,$04,$E8,$0B,$00,
$B4,$4C,$CD,$21,$43,$50,$B4,$02,$CD,$21,$58,$8A,$17,$80,$FA,
$24,$75,$F2,$C3,$0D,$0A,$24,$50,$51,$57,$31,$C0,$BF,$2A,$06,
$B9,$19,$00,$F3,$AB,$5F,$59,$58,$C3,$B8,$00,$03,$BB,$21,$00,
$31,$C9,$66,$BF,$2A,$06,$00,$00,$CD,$31,$C3,$00,$00,$30,$E4,
$E8,$4E,$FF,$89,$DE,$8B,$3E,$8C,$04,$EB,$17,$B4,$3B,$E8,$41,
$FF,$81,$FE,$64,$07,$74,$12,$8A,$44,$FF,$E8,$2A,$FF,$74,$04,
$C6,$04,$5C,$46,$E8,$03,$00,$72,$E4,$C3,$E8,$34,$00,$BB,$44,
$00,$8A,$07,$88,$04,$43,$46,$08,$C0,$75,$F6,$06,$57,$1E,$07,
$E8,$9B,$FF,$BB,$2A,$06,$8C,$5F,$04,$89,$5F,$02,$BA,$64,$07,
$B8,$00,$4B,$CD,$21,$5F,$07,$72,$09,$B4,$4D,$CD,$21,$2D,$00,
$03,$F7,$D8,$EB,$28,$80,$3E,$69,$08,$05,$72,$20,$B8,$00,$58,
$CD,$21,$A2,$67,$08,$B8,$02,$58,$CD,$21,$A2,$68,$08,$B8,$01,
$58,$BB,$80,$00,$CD,$21,$B8,$03,$58,$BB,$01,$00,$CD,$21,$C3,
$9C,$80,$3E,$69,$08,$05,$72,$1A,$50,$53,$B8,$03,$58,$8A,$1E,
$68,$08,$30,$FF,$CD,$21,$B8,$01,$58,$8A,$1E,$67,$08,$30,$FF,
$CD,$21,$5B,$58,$9D,$C3,$4C,$6F,$61,$64,$20,$65,$72,$72,$6F,
$72,$3A,$20,$24,$3A,$20,$63,$61,$6E,$27,$74,$20,$6F,$70,$65,
$6E,$24,$3A,$20,$6E,$6F,$74,$20,$45,$58,$45,$24,$3A,$20,$6E,
$6F,$74,$20,$43,$4F,$46,$46,$20,$28,$43,$68,$65,$63,$6B,$20,
$66,$6F,$72,$20,$76,$69,$72,$75,$73,$65,$73,$29,$24,$6E,$6F,
$20,$44,$50,$4D,$49,$20,$2D,$20,$47,$65,$74,$20,$63,$73,$64,
$70,$6D,$69,$2A,$62,$2E,$7A,$69,$70,$24,$6E,$6F,$20,$44,$4F,
$53,$20,$6D,$65,$6D,$6F,$72,$79,$24,$6E,$65,$65,$64,$20,$44,
$4F,$53,$20,$33,$24,$63,$61,$6E,$27,$74,$20,$73,$77,$69,$74,
$63,$68,$20,$6D,$6F,$64,$65,$24,$6E,$6F,$20,$44,$50,$4D,$49,
$20,$73,$65,$6C,$65,$63,$74,$6F,$72,$73,$24,$6E,$6F,$20,$44,
$50,$4D,$49,$20,$6D,$65,$6D,$6F,$72,$79,$24,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,
$90,$90,$90,$90,$90,$90,$90,$90);
{****************************************************************************
TCoffObjectSection
****************************************************************************}
constructor TCoffObjectSection.createsec(sec:TSection;AAlign,AFlags:cardinal);
begin
inherited create(target_asm.secnames[sec],AAlign,(sec=sec_bss));
Flags:=AFlags;
end;
procedure TCoffObjectSection.addsymsizereloc(ofs:longint;p:tasmsymbol;size:longint;relative:TAsmRelocationType);
begin
relocations.concat(tasmrelocation.createsymbolsize(ofs,p,size,relative));
end;
{****************************************************************************
tcoffobjectdata
****************************************************************************}
constructor tcoffobjectdata.createdjgpp(const n:string);
begin
inherited create(n);
win32:=false;
reset;
end;
constructor tcoffobjectdata.createwin32(const n:string);
begin
inherited create(n);
win32:=true;
reset;
end;
destructor tcoffobjectdata.destroy;
begin
inherited destroy;
end;
procedure tcoffobjectdata.reset;
var
s : string;
begin
{ we need at least the following 3 sections }
createsection(sec_code);
createsection(sec_data);
createsection(sec_bss);
if (cs_gdb_lineinfo in aktglobalswitches) or
(cs_debuginfo in aktmoduleswitches) then
begin
createsection(sec_stab);
createsection(sec_stabstr);
writestabs(sec_none,0,nil,0,0,0,false);
{ write zero pchar and name together (PM) }
s:=#0+SplitFileName(current_module.mainsource^)+#0;
sects[sec_stabstr].write(s[1],length(s));
end;
end;
procedure tcoffobjectdata.createsection(sec:TSection);
var
Flags,
AAlign : cardinal;
begin
{ defaults }
Flags:=0;
Aalign:=1;
{ alignment after section }
case sec of
sec_code :
begin
if win32 then
Flags:=$60000020
else
Flags:=$20;
Aalign:=16;
end;
sec_data :
begin
if win32 then
Flags:=$c0300040
else
Flags:=$40;
Aalign:=16;
end;
sec_bss :
begin
if win32 then
Flags:=$c0300080
else
Flags:=$80;
Aalign:=16;
end;
sec_idata2,
sec_idata4,
sec_idata5,
sec_idata6,
sec_idata7 :
begin
if win32 then
Flags:=$40000000;
end;
sec_edata :
begin
if win32 then
Flags:=$c0300040;
end;
end;
sects[sec]:=TCoffObjectSection.createsec(Sec,AAlign,Flags);
end;
procedure tcoffobjectdata.writesymbol(p:tasmsymbol);
begin
{ already written ? }
if p.indexnr<>-1 then
exit;
{ be sure that the section will exists }
if (p.section<>sec_none) and not(assigned(sects[p.section])) then
createsection(p.section);
{ calculate symbol index }
if (p.currbind<>AB_LOCAL) then
begin
{ insert the symbol in the local index, the indexarray
will take care of the numbering }
symbols.insert(p);
end
else
p.indexnr:=-2; { local }
end;
procedure tcoffobjectdata.writereloc(data,len:longint;p:tasmsymbol;relative:TAsmRelocationType);
var
curraddr,
symaddr : longint;
begin
if not assigned(sects[currsec]) then
createsection(currsec);
if assigned(p) then
begin
{ current address }
curraddr:=sects[currsec].mempos+sects[currsec].datasize;
{ real address of the symbol }
symaddr:=p.address;
if p.section<>sec_none then
inc(symaddr,sects[p.section].mempos);
{ no symbol relocation need inside a section }
if p.section=currsec then
begin
case relative of
RELOC_ABSOLUTE :
begin
sects[currsec].addsectionreloc(curraddr,currsec,RELOC_ABSOLUTE);
inc(data,symaddr);
end;
RELOC_RELATIVE :
begin
inc(data,symaddr-len-sects[currsec].datasize);
end;
RELOC_RVA :
begin
sects[currsec].addsectionreloc(curraddr,currsec,RELOC_RVA);
inc(data,symaddr);
end;
end;
end
else
begin
writesymbol(p);
if (p.section<>sec_none) and (relative<>RELOC_RELATIVE) then
sects[currsec].addsectionreloc(curraddr,p.section,relative)
else
sects[currsec].addsymreloc(curraddr,p,relative);
if not win32 then {seems wrong to me (PM) }
inc(data,symaddr)
else
if (relative<>RELOC_RELATIVE) and (p.section<>sec_none) then
inc(data,symaddr);
if relative=RELOC_RELATIVE then
begin
if win32 then
dec(data,len-4)
else
dec(data,len+sects[currsec].datasize);
end;
end;
end;
sects[currsec].write(data,len);
end;
procedure tcoffobjectdata.writestabs(section:TSection;offset:longint;p:pchar;nidx,nother,line:longint;reloc : boolean);
var
stab : coffstab;
s : TSection;
curraddr : longint;
begin
s:=section;
{ local var can be at offset -1 !! PM }
if reloc then
begin
if (offset=-1) then
begin
if s=sec_none then
offset:=0
else
offset:=sects[s].datasize;
end;
if (s<>sec_none) then
inc(offset,sects[s].datapos);
end;
if assigned(p) and (p[0]<>#0) then
begin
stab.strpos:=sects[sec_stabstr].datasize;
sects[sec_stabstr].write(p^,strlen(p)+1);
end
else
stab.strpos:=0;
stab.ntype:=nidx;
stab.ndesc:=line;
stab.nother:=nother;
stab.nvalue:=offset;
sects[sec_stab].write(stab,sizeof(stab));
{ when the offset is not 0 then write a relocation, take also the
hdrstab into account with the offset }
if reloc then
begin
{ current address }
curraddr:=sects[sec_stab].mempos+sects[sec_stab].datasize;
if DLLSource and RelocSection then
{ avoid relocation in the .stab section
because it ends up in the .reloc section instead }
sects[sec_stab].addsectionreloc(curraddr-4,s,RELOC_RVA)
else
sects[sec_stab].addsectionreloc(curraddr-4,s,RELOC_ABSOLUTE);
end;
end;
procedure tcoffobjectdata.writesymstabs(section:TSection;offset:longint;p:pchar;ps:tasmsymbol;
nidx,nother,line:longint;reloc:boolean);
var
stab : coffstab;
curraddr : longint;
begin
{ do not use the size stored in offset field
this is DJGPP specific ! PM }
if win32 then
offset:=0;
{ local var can be at offset -1 !! PM }
if reloc then
begin
if (offset=-1) then
begin
if section=sec_none then
offset:=0
else
offset:=sects[section].datasize;
end;
if (section<>sec_none) then
inc(offset,sects[section].mempos);
end;
if assigned(p) and (p[0]<>#0) then
begin
stab.strpos:=sects[sec_stabstr].datasize;
sects[sec_stabstr].write(p^,strlen(p)+1);
end
else
stab.strpos:=0;
stab.ntype:=nidx;
stab.ndesc:=line;
stab.nother:=nother;
stab.nvalue:=offset;
sects[sec_stab].write(stab,sizeof(stab));
{ when the offset is not 0 then write a relocation, take also the
hdrstab into account with the offset }
if reloc then
begin
{ current address }
curraddr:=sects[sec_stab].mempos+sects[sec_stab].datasize;
if DLLSource and RelocSection then
{ avoid relocation in the .stab section
because it ends up in the .reloc section instead }
sects[sec_stab].addsymreloc(curraddr-4,ps,RELOC_RVA)
else
sects[sec_stab].addsymreloc(curraddr-4,ps,RELOC_ABSOLUTE);
end;
end;
procedure tcoffobjectdata.seTSectionsizes(var s:TAsmSectionSizes);
var
mempos : longint;
sec : TSection;
begin
{ multiply stab with real size }
s[sec_stab]:=s[sec_stab]*sizeof(coffstab);
{ if debug then also count header stab }
if (cs_debuginfo in aktmoduleswitches) then
begin
inc(s[sec_stab],sizeof(coffstab));
inc(s[sec_stabstr],length(SplitFileName(current_module.mainsource^))+2);
end;
{ calc mempos }
mempos:=0;
for sec:=low(TSection) to high(TSection) do
begin
if (s[sec]>0) and
(not assigned(sects[sec])) then
createsection(sec);
if assigned(sects[sec]) then
begin
sects[sec].memsize:=s[sec];
{ memory position }
if not win32 then
begin
sects[sec].mempos:=mempos;
inc(mempos,align(sects[sec].memsize,sects[sec].addralign));
end;
end;
end;
end;
procedure tcoffobjectdata.fixuprelocs;
var
r : TAsmRelocation;
address,
relocval : longint;
sec : TSection;
begin
for sec:=low(TSection) to high(TSection) do
if assigned(sects[sec]) then
begin
r:=TAsmRelocation(sects[sec].relocations.first);
if assigned(r) and
(not assigned(sects[sec].data)) then
internalerror(200205183);
while assigned(r) do
begin
if assigned(r.symbol) then
relocval:=r.symbol.address
else
internalerror(200205183);
sects[sec].data.Seek(r.address);
sects[sec].data.Read(address,4);
case r.typ of
RELOC_RELATIVE :
begin
dec(address,sects[sec].mempos);
inc(address,relocval);
end;
RELOC_RVA,
RELOC_ABSOLUTE :
begin
if r.symbol.section=sec_common then
dec(address,r.orgsize)
else
begin
{ fixup address when the symbol was known in defined object }
if (r.symbol.section<>sec_none) and
(r.symbol.objectdata=pointer(self)) then
dec(address,TCoffObjectSection(sects[r.symbol.section]).orgmempos);
end;
inc(address,relocval);
end;
end;
sects[sec].data.Seek(r.address);
sects[sec].data.Write(address,4);
{ goto next reloc }
r:=TAsmRelocation(r.next);
end;
end;
end;
{****************************************************************************
tcoffobjectoutput
****************************************************************************}
constructor tcoffobjectoutput.createdjgpp(smart:boolean);
begin
inherited create(smart);
win32:=false;
end;
constructor tcoffobjectoutput.createwin32(smart:boolean);
begin
inherited create(smart);
win32:=true;
end;
function tcoffobjectoutput.newobjectdata(const n:string):TAsmObjectData;
begin
if win32 then
result:=tcoffobjectdata.createwin32(n)
else
result:=tcoffobjectdata.createdjgpp(n);
end;
procedure tcoffobjectoutput.write_symbol(const name:string;strpos,value,section,typ,aux:longint);
var
sym : coffsymbol;
begin
FillChar(sym,sizeof(sym),0);
if strpos=-1 then
move(name[1],sym.name,length(name))
else
sym.strpos:=strpos;
sym.value:=value;
sym.section:=section;
sym.typ:=typ;
sym.aux:=aux;
FWriter.write(sym,sizeof(sym));
end;
procedure tcoffobjectoutput.write_symbols(data:TAsmObjectData);
var
filename : string[18];
sec : TSection;
namestr : string[8];
value,
nameidx : longint;
sectionval,
globalval : byte;
secrec : coffsectionrec;
p : tasmsymbol;
s : string;
begin
with tcoffobjectdata(data) do
begin
{ The `.file' record, and the file name auxiliary record }
write_symbol('.file', -1, 0, -2, $67, 1);
fillchar(filename,sizeof(filename),0);
filename:=SplitFileName(current_module.mainsource^);
FWriter.write(filename[1],sizeof(filename)-1);
{ The section records, with their auxiliaries, also store the
symbol index }
for sec:=low(TSection) to high(TSection) do
if assigned(sects[sec]) then
begin
write_symbol(target_asm.secnames[sec],-1,sects[sec].mempos,sects[sec].secsymidx,3,1);
fillchar(secrec,sizeof(secrec),0);
secrec.len:=sects[sec].aligneddatasize;
secrec.nrelocs:=sects[sec].relocations.count;
FWriter.write(secrec,sizeof(secrec));
end;
{ The symbols used }
p:=Tasmsymbol(symbols.First);
while assigned(p) do
begin
if assigned(sects[p.section]) then
sectionval:=sects[p.section].secsymidx
else
sectionval:=0;
if p.currbind=AB_LOCAL then
globalval:=3
else
globalval:=2;
{ if local of global then set the section value to the address
of the symbol }
if p.currbind in [AB_LOCAL,AB_GLOBAL] then
value:=p.address+sects[p.section].mempos
else
value:=p.size;
{ symbolname }
s:=p.name;
if length(s)>8 then
begin
nameidx:=FCoffStrs.size+4;
FCoffStrs.writestr(s);
FCoffStrs.writestr(#0);
end
else
begin
nameidx:=-1;
namestr:=s;
end;
write_symbol(namestr,nameidx,value,sectionval,globalval,0);
p:=tasmsymbol(p.indexnext);
end;
end;
end;
procedure tcoffobjectoutput.write_relocs(data:TAsmObjectData);
var
rel : coffreloc;
r : TAsmRelocation;
sec : TSection;
begin
with data do
begin
for sec:=low(TSection) to high(TSection) do
if assigned(sects[sec]) then
begin
r:=TasmRelocation(sects[sec].relocations.first);
while assigned(r) do
begin
rel.address:=r.address;
if assigned(r.symbol) then
begin
if (r.symbol.currbind=AB_LOCAL) then
rel.sym:=2*sects[r.symbol.section].secsymidx
else
begin
if r.symbol.indexnr=-1 then
internalerror(4321);
{ indexnr starts with 1, coff starts with 0 }
rel.sym:=r.symbol.indexnr+initsym-1;
end;
end
else
begin
if r.section<>sec_none then
rel.sym:=2*sects[r.section].secsymidx
else
rel.sym:=0;
end;
case r.typ of
RELOC_RELATIVE : rel.relative:=$14;
RELOC_ABSOLUTE : rel.relative:=$6;
RELOC_RVA : rel.relative:=$7;
end;
FWriter.write(rel,sizeof(rel));
r:=TAsmRelocation(r.next);
end;
end;
end;
end;
function tcoffobjectoutput.writedata(data:TAsmObjectData):boolean;
var
datapos,
secsymidx,
nsects,
sympos,i : longint;
hstab : coffstab;
gotreloc : boolean;
sec : TSection;
header : coffheader;
sechdr : coffsechdr;
empty : array[0..15] of byte;
hp : pdynamicblock;
begin
result:=false;
FCoffStrs:=TDynamicArray.Create(strsresize);
with tcoffobjectdata(data) do
begin
{ calc amount of sections we have }
fillchar(empty,sizeof(empty),0);
nsects:=0;
initsym:=2; { 2 for the file }
secsymidx:=0;
for sec:=low(TSection) to high(TSection) do
if assigned(sects[sec]) then
begin
inc(nsects);
inc(secsymidx);
sects[sec].secsymidx:=secsymidx;
inc(initsym,2); { 2 for each section }
end;
{ For the stab section we need an HdrSym which can now be
calculated more easily }
if assigned(sects[sec_stab]) then
begin
hstab.strpos:=1;
hstab.ntype:=0;
hstab.nother:=0;
hstab.ndesc:=(sects[sec_stab].datasize div sizeof(coffstab))-1{+1 according to gas output PM};
hstab.nvalue:=sects[sec_stabstr].datasize;
sects[sec_stab].data.seek(0);
sects[sec_stab].data.write(hstab,sizeof(hstab));
end;
{ Calculate the filepositions }
datapos:=sizeof(coffheader)+sizeof(coffsechdr)*nsects;
{ sections first }
for sec:=low(TSection) to high(TSection) do
if assigned(sects[sec]) then
begin
sects[sec].datapos:=datapos;
if assigned(sects[sec].data) then
inc(datapos,sects[sec].aligneddatasize);
end;
{ relocs }
gotreloc:=false;
for sec:=low(TSection) to high(TSection) do
if assigned(sects[sec]) then
begin
TCoffObjectSection(sects[sec]).coffrelocpos:=datapos;
inc(datapos,10*sects[sec].relocations.count);
if (not gotreloc) and (sects[sec].relocations.count>0) then
gotreloc:=true;
end;
{ symbols }
sympos:=datapos;
{ COFF header }
fillchar(header,sizeof(coffheader),0);
header.mach:=$14c;
header.nsects:=nsects;
header.sympos:=sympos;
header.syms:=symbols.count+initsym;
header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_NOLINES;
if not gotreloc then
header.flag:=header.flag or COFF_FLAG_NORELOCS;
FWriter.write(header,sizeof(header));
{ Section headers }
for sec:=low(TSection) to high(TSection) do
if assigned(sects[sec]) then
begin
fillchar(sechdr,sizeof(sechdr),0);
move(target_asm.secnames[sec][1],sechdr.name,length(target_asm.secnames[sec]));
if not win32 then
begin
sechdr.rvaofs:=sects[sec].mempos;
sechdr.vsize:=sects[sec].mempos;
end
else
begin
if sec=sec_bss then
sechdr.vsize:=sects[sec].aligneddatasize;
end;
sechdr.datasize:=sects[sec].aligneddatasize;
if (sects[sec].datasize>0) and assigned(sects[sec].data) then
sechdr.datapos:=sects[sec].datapos;
sechdr.nrelocs:=sects[sec].relocations.count;
sechdr.relocpos:=TCoffObjectSection(sects[sec]).coffrelocpos;
sechdr.flags:=TCoffObjectSection(sects[sec]).flags;
FWriter.write(sechdr,sizeof(sechdr));
end;
{ Sections }
for sec:=low(TSection) to high(TSection) do
if assigned(sects[sec]) and
assigned(sects[sec].data) then
begin
sects[sec].alignsection;
hp:=sects[sec].data.firstblock;
while assigned(hp) do
begin
FWriter.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
end;
{ Relocs }
write_relocs(data);
{ Symbols }
write_symbols(data);
{ Strings }
i:=FCoffStrs.size+4;
FWriter.write(i,4);
hp:=FCoffStrs.firstblock;
while assigned(hp) do
begin
FWriter.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
end;
FCoffStrs.Free;
end;
{****************************************************************************
tcoffexeoutput
****************************************************************************}
constructor tcoffexeoutput.createdjgpp;
begin
inherited create;
win32:=false;
end;
constructor tcoffexeoutput.createwin32;
begin
inherited create;
win32:=true;
end;
function tcoffexeoutput.newobjectinput:tobjectinput;
begin
if win32 then
result:=tcoffobjectinput.createwin32
else
result:=tcoffobjectinput.createdjgpp;
end;
procedure tcoffexeoutput.write_symbol(const name:string;strpos,value,section,typ,aux:longint);
var
sym : coffsymbol;
begin
FillChar(sym,sizeof(sym),0);
if strpos=-1 then
move(name[1],sym.name,length(name))
else
sym.strpos:=strpos;
sym.value:=value;
sym.section:=section;
sym.typ:=typ;
sym.aux:=aux;
FWriter.write(sym,sizeof(sym));
end;
procedure tcoffexeoutput.write_symbols;
var
namestr : string[8];
nameidx : longint;
value,
sectionval,
globalval : byte;
objdata : TAsmObjectData;
p : tasmsymbol;
s : string;
begin
objdata:=TAsmObjectData(objdatalist.first);
while assigned(objdata) do
begin
with tcoffobjectdata(objdata) do
begin
{ The symbols used }
p:=Tasmsymbol(symbols.First);
while assigned(p) do
begin
if p.section=sec_common then
sectionval:=sections[sec_bss].secsymidx
else
sectionval:=sections[p.section].secsymidx;
if p.currbind=AB_LOCAL then
globalval:=3
else
globalval:=2;
{ if local of global then set the section value to the address
of the symbol }
if p.currbind in [AB_LOCAL,AB_GLOBAL] then
value:=p.address
else
value:=p.size;
{ symbolname }
s:=p.name;
if length(s)>8 then
begin
nameidx:=FCoffStrs.size+4;
FCoffStrs.writestr(s);
FCoffStrs.writestr(#0);
end
else
begin
nameidx:=-1;
namestr:=s;
end;
write_symbol(namestr,nameidx,value,sectionval,globalval,0);
p:=tasmsymbol(p.indexnext);
end;
end;
objdata:=TAsmObjectData(objdata.next);
end;
end;
procedure tcoffexeoutput.CalculateMemoryMap;
var
objdata : TAsmObjectData;
secsymidx,
mempos,
datapos : longint;
sec : TSection;
begin
{ retrieve amount of sections }
nsects:=0;
secsymidx:=0;
for sec:=low(TSection) to high(TSection) do
begin
if sections[sec].available then
begin
inc(nsects);
inc(secsymidx);
sections[sec].secsymidx:=secsymidx;
end;
end;
{ calculate start positions after the headers }
datapos:=sizeof(coffheader)+sizeof(coffoptheader)+sizeof(coffsechdr)*nsects;
mempos:=sizeof(coffheader)+sizeof(coffoptheader)+sizeof(coffsechdr)*nsects;
if not win32 then
inc(mempos,sizeof(go32v2stub)+$1000);
{ add sections }
MapObjectdata(datapos,mempos);
{ end symbol }
AddGlobalSym('_etext',sections[sec_code].mempos+sections[sec_code].memsize);
AddGlobalSym('_edata',sections[sec_data].mempos+sections[sec_data].memsize);
AddGlobalSym('end',mempos);
{ symbols }
nsyms:=0;
sympos:=0;
if not(cs_link_strip in aktglobalswitches) then
begin
sympos:=datapos;
objdata:=TAsmObjectData(objdatalist.first);
while assigned(objdata) do
begin
inc(nsyms,objdata.symbols.count);
objdata:=TAsmObjectData(objdata.next);
end;
end;
end;
function tcoffexeoutput.writedata:boolean;
var
i : longint;
sec : TSection;
header : coffheader;
optheader : coffoptheader;
sechdr : coffsechdr;
hp : pdynamicblock;
objdata : TAsmObjectData;
hsym : tasmsymbol;
begin
result:=false;
FCoffSyms:=TDynamicArray.Create(symbolresize);
FCoffStrs:=TDynamicArray.Create(strsresize);
{ Stub }
if not win32 then
FWriter.write(go32v2stub,sizeof(go32v2stub));
{ COFF header }
fillchar(header,sizeof(header),0);
header.mach:=$14c;
header.nsects:=nsects;
header.sympos:=sympos;
header.syms:=nsyms;
header.opthdr:=sizeof(coffoptheader);
header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_EXE or COFF_FLAG_NORELOCS or COFF_FLAG_NOLINES;
FWriter.write(header,sizeof(header));
{ Optional COFF Header }
fillchar(optheader,sizeof(optheader),0);
optheader.magic:=$10b;
optheader.tsize:=sections[sec_code].memsize;
optheader.dsize:=sections[sec_data].memsize;
optheader.bsize:=sections[sec_bss].memsize;
hsym:=tasmsymbol(globalsyms.search('start'));
if not assigned(hsym) then
begin
Comment(V_Error,'Entrypoint "start" not defined');
exit;
end;
optheader.entry:=hsym.address;
optheader.text_start:=sections[sec_code].mempos;
optheader.data_start:=sections[sec_data].mempos;
FWriter.write(optheader,sizeof(optheader));
{ Section headers }
for sec:=low(TSection) to high(TSection) do
if sections[sec].available then
begin
fillchar(sechdr,sizeof(sechdr),0);
move(target_asm.secnames[sec][1],sechdr.name,length(target_asm.secnames[sec]));
if not win32 then
begin
sechdr.rvaofs:=sections[sec].mempos;
sechdr.vsize:=sections[sec].mempos;
end
else
begin
if sec=sec_bss then
sechdr.vsize:=sections[sec].memsize;
end;
if sec=sec_bss then
sechdr.datasize:=sections[sec].memsize
else
begin
sechdr.datasize:=sections[sec].datasize;
sechdr.datapos:=sections[sec].datapos;
end;
sechdr.nrelocs:=0;
sechdr.relocpos:=0;
sechdr.flags:=sections[sec].flags;
FWriter.write(sechdr,sizeof(sechdr));
end;
{ Sections }
for sec:=low(TSection) to high(TSection) do
if sections[sec].available then
begin
{ update objectfiles }
objdata:=TAsmObjectData(objdatalist.first);
while assigned(objdata) do
begin
if assigned(objdata.sects[sec]) and
assigned(objdata.sects[sec].data) then
begin
WriteZeros(objdata.sects[sec].dataalignbytes);
hp:=objdata.sects[sec].data.firstblock;
while assigned(hp) do
begin
FWriter.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
end;
objdata:=TAsmObjectData(objdata.next);
end;
end;
{ Optional symbols }
if not(cs_link_strip in aktglobalswitches) then
begin
{ Symbols }
write_symbols;
{ Strings }
i:=FCoffStrs.size+4;
FWriter.write(i,4);
hp:=FCoffStrs.firstblock;
while assigned(hp) do
begin
FWriter.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
end;
{ Release }
FCoffStrs.Free;
FCoffSyms.Free;
result:=true;
end;
procedure tcoffexeoutput.GenerateExecutable(const fn:string);
begin
AddGlobalSym('_etext',0);
AddGlobalSym('_edata',0);
AddGlobalSym('end',0);
if not CalculateSymbols then
exit;
CalculateMemoryMap;
FixupSymbols;
FixupRelocations;
writeexefile(fn);
end;
{****************************************************************************
tcoffobjectinput
****************************************************************************}
constructor tcoffobjectinput.createdjgpp;
begin
inherited create;
win32:=false;
end;
constructor tcoffobjectinput.createwin32;
begin
inherited create;
win32:=true;
end;
function tcoffobjectinput.newobjectdata(const n:string):TAsmObjectData;
begin
if win32 then
result:=tcoffobjectdata.createwin32(n)
else
result:=tcoffobjectdata.createdjgpp(n);
end;
procedure tcoffobjectinput.read_relocs(s:TCoffObjectSection);
var
rel : coffreloc;
rel_type : TAsmRelocationType;
i : longint;
p : tasmsymbol;
begin
for i:=1 to s.coffrelocs do
begin
FReader.read(rel,sizeof(rel));
case rel.relative of
$14 : rel_type:=RELOC_RELATIVE;
$06 : rel_type:=RELOC_ABSOLUTE;
$07 : rel_type:=RELOC_RVA;
else
begin
Comment(V_Error,'Error reading coff file');
exit;
end;
end;
p:=FSymTbl^[rel.sym].sym;
if assigned(p) then
begin
s.addsymsizereloc(rel.address-s.mempos,p,FSymTbl^[rel.sym].orgsize,rel_type);
end
else
begin
Comment(V_Error,'Error reading coff file');
exit;
end;
end;
end;
procedure tcoffobjectinput.handle_symbols(data:TAsmObjectData);
var
sec : TSection;
size,
address,
i,nsyms,
symidx : longint;
sym : coffsymbol;
strname : string;
p : tasmsymbol;
bind : Tasmsymbind;
auxrec : array[0..17] of byte;
begin
with tcoffobjectdata(data) do
begin
nsyms:=FCoffSyms.Size div sizeof(CoffSymbol);
{ Allocate memory for symidx -> tasmsymbol table }
GetMem(FSymTbl,nsyms*sizeof(ttasmsymbolrec));
FillChar(FSymTbl^,nsyms*sizeof(ttasmsymbolrec),0);
{ Loop all symbols }
FCoffSyms.Seek(0);
symidx:=0;
while (symidx<nsyms) do
begin
FCoffSyms.Read(sym,sizeof(sym));
if plongint(@sym.name)^<>0 then
begin
move(sym.name,strname[1],8);
strname[9]:=#0;
end
else
begin
FCoffStrs.Seek(sym.strpos-4);
FCoffStrs.Read(strname[1],255);
strname[255]:=#0;
end;
strname[0]:=chr(strlen(@strname[1]));
if strname='' then
Internalerror(200205172);
bind:=AB_EXTERNAL;
sec:=sec_none;
size:=0;
address:=0;
case sym.typ of
COFF_SYM_GLOBAL :
begin
if sym.section=0 then
begin
if sym.value=0 then
bind:=AB_EXTERNAL
else
begin
bind:=AB_COMMON;
size:=sym.value;
end;
end
else
begin
bind:=AB_GLOBAL;
sec:=Fidx2sec[sym.section];
if assigned(sects[sec]) then
begin
if sym.value>=sects[sec].mempos then
address:=sym.value-sects[sec].mempos
else
internalerror(432432432);
end
else
internalerror(34243214);
end;
p:=TAsmSymbol.Create(strname,bind,AT_FUNCTION);
p.SetAddress(0,sec,address,size);
p.objectdata:=data;
symbols.insert(p);
end;
COFF_SYM_LABEL,
COFF_SYM_LOCAL :
begin
{ do not add constants (section=-1) }
if sym.section<>-1 then
begin
bind:=AB_LOCAL;
sec:=Fidx2sec[sym.section];
if assigned(sects[sec]) then
begin
if sym.value>=sects[sec].mempos then
address:=sym.value-sects[sec].mempos
else
internalerror(432432432);
end
else
internalerror(34243214);
p:=TAsmSymbol.Create(strname,bind,AT_FUNCTION);
p.SetAddress(0,sec,address,size);
p.objectdata:=data;
symbols.insert(p);
end;
end;
COFF_SYM_SECTION,
COFF_SYM_FUNCTION,
COFF_SYM_FILE :
;
else
internalerror(4342343);
end;
FSymTbl^[symidx].sym:=p;
FSymTbl^[symidx].orgsize:=size;
{ read aux records }
for i:=1 to sym.aux do
begin
FCoffSyms.Read(auxrec,sizeof(auxrec));
inc(symidx);
end;
inc(symidx);
end;
end;
end;
function tcoffobjectinput.readobjectdata(data:TAsmObjectData):boolean;
var
strsize,
i : longint;
sec : TSection;
header : coffheader;
sechdr : coffsechdr;
secname : array[0..15] of char;
begin
result:=false;
FCoffSyms:=TDynamicArray.Create(symbolresize);
FCoffStrs:=TDynamicArray.Create(strsresize);
with tcoffobjectdata(data) do
begin
FillChar(Fidx2sec,sizeof(Fidx2sec),0);
{ Read COFF header }
if not reader.read(header,sizeof(coffheader)) then
begin
Comment(V_Error,'Error reading coff file');
exit;
end;
if header.mach<>$14c then
begin
Comment(V_Error,'Not a coff file');
exit;
end;
if header.nsects>255 then
begin
Comment(V_Error,'To many sections');
exit;
end;
{ Section headers }
for i:=1 to header.nsects do
begin
if not reader.read(sechdr,sizeof(sechdr)) then
begin
Comment(V_Error,'Error reading coff file');
exit;
end;
move(sechdr.name,secname,8);
secname[8]:=#0;
sec:=str2sec(strpas(secname));
if sec<>sec_none then
begin
Fidx2sec[i]:=sec;
createsection(sec);
if not win32 then
sects[sec].mempos:=sechdr.rvaofs;
TCoffObjectSection(sects[sec]).coffrelocs:=sechdr.nrelocs;
TCoffObjectSection(sects[sec]).coffrelocpos:=sechdr.relocpos;
sects[sec].datapos:=sechdr.datapos;
sects[sec].datasize:=sechdr.datasize;
sects[sec].memsize:=sechdr.datasize;
TCoffObjectSection(sects[sec]).orgmempos:=sects[sec].mempos;
sects[sec].flags:=sechdr.flags;
end
else
Comment(V_Warning,'skipping unsupported section '+strpas(sechdr.name));
end;
{ Symbols }
Reader.Seek(header.sympos);
if not Reader.ReadArray(FCoffSyms,header.syms*sizeof(CoffSymbol)) then
begin
Comment(V_Error,'Error reading coff file');
exit;
end;
{ Strings }
if not Reader.Read(strsize,4) then
begin
Comment(V_Error,'Error reading coff file');
exit;
end;
if strsize<4 then
begin
Comment(V_Error,'Error reading coff file');
exit;
end;
if not Reader.ReadArray(FCoffStrs,Strsize-4) then
begin
Comment(V_Error,'Error reading coff file');
exit;
end;
{ Insert all symbols }
handle_symbols(data);
{ Sections }
for sec:=low(TSection) to high(TSection) do
if assigned(sects[sec]) and
(sec<>sec_bss) then
begin
Reader.Seek(sects[sec].datapos);
if not Reader.ReadArray(sects[sec].data,sects[sec].datasize) then
begin
Comment(V_Error,'Error reading coff file');
exit;
end;
end;
{ Relocs }
for sec:=low(TSection) to high(TSection) do
if assigned(sects[sec]) and
(TCoffObjectSection(sects[sec]).coffrelocs>0) then
begin
Reader.Seek(TCoffObjectSection(sects[sec]).coffrelocpos);
read_relocs(TCoffObjectSection(sects[sec]));
end;
end;
FCoffStrs.Free;
FCoffSyms.Free;
result:=true;
end;
{****************************************************************************
TCoffAssembler
****************************************************************************}
constructor TCoffAssembler.Create(smart:boolean);
begin
inherited Create(smart);
objectoutput:=tcoffobjectoutput.createdjgpp(smart);
end;
{****************************************************************************
TPECoffAssembler
****************************************************************************}
constructor TPECoffAssembler.Create(smart:boolean);
begin
inherited Create(smart);
objectoutput:=tcoffobjectoutput.createwin32(smart);
end;
{****************************************************************************
TCoffLinker
****************************************************************************}
constructor TCoffLinker.Create;
begin
inherited Create;
exeoutput:=tcoffexeoutput.createdjgpp;
end;
{*****************************************************************************
Initialize
*****************************************************************************}
const
as_i386_coff_info : tasminfo =
(
id : as_i386_coff;
idtxt : 'COFF';
asmbin : '';
asmcmd : '';
supported_target : system_i386_go32v2;
outputbinary : true;
allowdirect : false;
needar : false;
labelprefix_only_inside_procedure: false;
labelprefix : '.L';
comment : '';
secnames : ('',
'.text','.data','.bss',
'.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
'.stab','.stabstr','COMMON')
);
const
as_i386_pecoff_info : tasminfo =
(
id : as_i386_pecoff;
idtxt : 'PECOFF';
asmbin : '';
asmcmd : '';
supported_target : system_i386_win32;
outputbinary : true;
allowdirect : false;
needar : false;
labelprefix_only_inside_procedure: false;
labelprefix : '.L';
comment : '';
secnames : ('',
'.text','.data','.bss',
'.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
'.stab','.stabstr','COMMON')
);
as_i386_pecoffwdosx_info : tasminfo =
(
id : as_i386_pecoffwdosx;
idtxt : 'PEWDOSX';
asmbin : '';
asmcmd : '';
supported_target : system_i386_wdosx;
outputbinary : true;
allowdirect : false;
needar : false;
labelprefix_only_inside_procedure: false;
labelprefix : '.L';
comment : '';
secnames : ('',
'.text','.data','.bss',
'.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
'.stab','.stabstr','COMMON')
);
initialization
RegisterAssembler(as_i386_coff_info,TCoffAssembler);
RegisterAssembler(as_i386_pecoff_info,TPECoffAssembler);
RegisterAssembler(as_i386_pecoffwdosx_info,TPECoffAssembler);
end.
{
$Log: ogcoff.pas,v $
Revision 1.27 2003/04/23 11:37:15 peter
* fix range check error after previous commit
Revision 1.26 2003/04/22 14:33:38 peter
* removed some notes/hints
Revision 1.25 2002/12/07 14:08:11 carl
* fix warning
Revision 1.24 2002/08/12 15:08:39 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class
* many many updates for m68k (will soon start to compile)
- removed some ifdef or correct them for correct cpu
Revision 1.23 2002/07/26 21:15:38 florian
* rewrote the system handling
Revision 1.22 2002/07/01 18:46:24 peter
* internal linker
* reorganized aasm layer
Revision 1.21 2002/05/18 13:34:10 peter
* readded missing revisions
Revision 1.20 2002/05/16 19:46:39 carl
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+ try to fix temp allocation (still in ifdef)
+ generic constructor calls
+ start of tassembler / tmodulebase class cleanup
Revision 1.19 2002/05/14 19:34:43 peter
* removed old logs and updated copyright year
Revision 1.18 2002/04/04 19:05:58 peter
* removed unused units
* use tlocation.size in cg.a_*loc*() routines
Revision 1.17 2002/04/04 18:38:30 carl
+ added wdosx support (patch from Pavel)
}
syntax highlighted by Code2HTML, v. 0.9.1