{ 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,globtype, { target } systems, { assembler } cpuinfo,cpubase,aasmbase,assemble,link, { output } ogbase,ogmap; type TCoffObjectSection = class(TAsmSection) private orgmempos, coffrelocs, coffrelocpos : longint; public flags : cardinal; constructor create(const Aname:string;Atype:TAsmSectionType;Aalign:longint;Aoptions:TAsmSectionOptions);override; procedure addsymsizereloc(ofs:longint;p:tasmsymbol;size:longint;relative:TAsmRelocationType); procedure fixuprelocs;override; end; TDjCoffObjectSection = class(TCoffObjectSection) constructor create(const Aname:string;Atype:TAsmSectionType;Aalign:longint;Aoptions:TAsmSectionOptions);override; end; TPECoffObjectSection = class(TCoffObjectSection) constructor create(const Aname:string;Atype:TAsmSectionType;Aalign:longint;Aoptions:TAsmSectionOptions);override; end; tcoffobjectdata = class(TAsmObjectData) private win32 : boolean; procedure section_mempos(p:tnamedindexitem;arg:pointer); public constructor createcoff(const n:string;awin32:boolean;acasmsection:TAsmSectionClass); destructor destroy;override; function sectionname(atype:tasmsectiontype;const aname:string):string;override; procedure writereloc(data,len:aint;p:tasmsymbol;relative:TAsmRelocationType);override; procedure writesymbol(p:tasmsymbol);override; procedure writestab(offset:aint;ps:tasmsymbol;nidx,nother,line:longint;p:pchar);override; procedure beforealloc;override; procedure beforewrite;override; procedure afteralloc;override; end; tdjcoffobjectdata = class(TCoffObjectData) constructor create(const n:string);override; end; tpecoffobjectdata = class(TCoffObjectData) constructor create(const n:string);override; end; tcoffobjectoutput = class(tobjectoutput) private win32 : boolean; initsym : longint; FCoffStrs : tdynamicarray; procedure write_symbol(const name:string;value,section,typ,aux:longint); procedure section_write_symbol(p:tnamedindexitem;arg:pointer); procedure section_write_relocs(p:tnamedindexitem;arg:pointer); procedure write_symbols(data:TAsmObjectData); procedure section_set_secsymidx(p:tnamedindexitem;arg:pointer); procedure section_set_datapos(p:tnamedindexitem;arg:pointer); procedure section_set_reloc_datapos(p:tnamedindexitem;arg:pointer); procedure section_write_header(p:tnamedindexitem;arg:pointer); procedure section_write_data(p:tnamedindexitem;arg:pointer); 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;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 TAsmSection; 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 strings, cutils,verbose, 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.create(const aname:string;atype:tasmsectiontype;aalign:longint;aoptions:TAsmSectionOptions); begin inherited create(aname,atype,aalign,aoptions); Flags:=0; end; procedure TCoffObjectSection.addsymsizereloc(ofs:longint;p:tasmsymbol;size:longint;relative:TAsmRelocationType); begin relocations.concat(tasmrelocation.createsymbolsize(ofs,p,size,relative)); end; procedure TCoffObjectSection.fixuprelocs; var r : TAsmRelocation; address, relocval : longint; begin r:=TAsmRelocation(relocations.first); if assigned(r) and (not assigned(data)) then internalerror(200205183); while assigned(r) do begin if assigned(r.symbol) then relocval:=r.symbol.address else internalerror(200205183); data.Seek(r.address); data.Read(address,4); case r.typ of RELOC_RELATIVE : begin dec(address,mempos); inc(address,relocval); end; RELOC_RVA, RELOC_ABSOLUTE : begin if r.symbol.section.sectype=sec_common then dec(address,r.orgsize) else begin { fixup address when the symbol was known in defined object } if (r.symbol.section<>nil) and (r.symbol.owner=owner) then dec(address,TCoffObjectSection(r.symbol.section).orgmempos); end; inc(address,relocval); end; end; data.Seek(r.address); data.Write(address,4); { goto next reloc } r:=TAsmRelocation(r.next); end; end; {**************************************************************************** TDjCoffObjectSection ****************************************************************************} constructor tdjcoffobjectsection.create(const aname:string;atype:tasmsectiontype;aalign:longint;aoptions:TAsmSectionOptions); begin inherited create(aname,atype,aalign,aoptions); case atype of sec_code : begin Flags:=$20; addralign:=16; end; sec_data : begin Flags:=$40; addralign:=16; end; sec_bss : begin Flags:=$80; addralign:=16; end; end; end; {**************************************************************************** TPECoffObjectSection ****************************************************************************} constructor tpecoffobjectsection.create(const aname:string;atype:tasmsectiontype;aalign:longint;aoptions:TAsmSectionOptions); begin inherited create(aname,atype,aalign,aoptions); case atype of sec_code : begin Flags:=$60000020; addralign:=16; end; sec_data : begin Flags:=$c0300040; addralign:=16; end; sec_bss : begin Flags:=$c0300080; addralign:=16; end; sec_idata2, sec_idata4, sec_idata5, sec_idata6, sec_idata7 : begin Flags:=$40000000; end; sec_edata : begin Flags:=$c0300040; end; end; end; {**************************************************************************** tcoffobjectdata ****************************************************************************} constructor tcoffobjectdata.createcoff(const n:string;awin32:boolean;acasmsection:TAsmSectionClass); begin inherited create(n); CAsmSection:=ACAsmSection; win32:=awin32; { we need at least the following 3 sections } createsection(sec_code,'',0,[]); createsection(sec_data,'',0,[]); createsection(sec_bss,'',0,[]); if (cs_use_lineinfo in aktglobalswitches) or (cs_debuginfo in aktmoduleswitches) then begin stabssec:=createsection(sec_stab,'',0,[]); stabstrsec:=createsection(sec_stabstr,'',0,[]); end; end; destructor tcoffobjectdata.destroy; begin inherited destroy; end; function TCoffObjectData.sectionname(atype:tasmsectiontype;const aname:string):string; const secnames : array[tasmsectiontype] of string[16] = ('', '.text','.data','.data','.bss','.threadvar', 'common', '.note', '.text', '.stab','.stabstr', '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', '.eh_frame', '.debug_frame', '.fpc' ); begin { No support for named sections, because section names are limited to 8 chars } result:=secnames[atype]; end; procedure tcoffobjectdata.writesymbol(p:tasmsymbol); begin if currsec=nil then internalerror(200403071); { already written ? } if p.indexnr<>-1 then exit; { 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:aint;p:tasmsymbol;relative:TAsmRelocationType); var curraddr, symaddr : longint; begin if currsec=nil then internalerror(200403072); if assigned(p) then begin { current address } curraddr:=currsec.mempos+currsec.datasize; { external/common symbols don't have a fixed memory position yet } if (p.currbind=AB_COMMON) then begin { For go32v2 we need to use the size as address } if not win32 then symaddr:=p.size else symaddr:=0; end else begin symaddr:=p.address; if assigned(p.section) then inc(symaddr,p.section.mempos); end; { no symbol relocation need inside a section } if (p.section=currsec) and (p.currbind<>AB_COMMON) then begin case relative of RELOC_ABSOLUTE : begin currsec.addsectionreloc(curraddr,currsec,RELOC_ABSOLUTE); inc(data,symaddr); end; RELOC_RELATIVE : begin inc(data,symaddr-len-currsec.datasize); end; RELOC_RVA : begin currsec.addsectionreloc(curraddr,currsec,RELOC_RVA); inc(data,symaddr); end; end; end else begin writesymbol(p); if (p.section<>nil) and (p.currbind<>AB_COMMON) and (relative<>RELOC_RELATIVE) then currsec.addsectionreloc(curraddr,p.section,relative) else currsec.addsymreloc(curraddr,p,relative); if (not win32) or ((relative<>RELOC_RELATIVE) and (p.section<>nil)) then inc(data,symaddr); if relative=RELOC_RELATIVE then begin if win32 then dec(data,len-4) else dec(data,len+currsec.datasize); end; end; end; currsec.write(data,len); end; procedure tcoffobjectdata.writestab(offset:aint;ps:tasmsymbol;nidx,nother,line:longint;p:pchar); var stab : coffstab; curraddr : longint; begin { Win32 does not need an offset if a symbol relocation is used } if win32 and assigned(ps) and (ps.currbind<>AB_LOCAL) then offset:=0; if assigned(p) and (p[0]<>#0) then begin stab.strpos:=StabStrSec.datasize; StabStrSec.write(p^,strlen(p)+1); end else stab.strpos:=0; stab.ntype:=nidx; stab.ndesc:=line; stab.nother:=nother; stab.nvalue:=offset; StabsSec.write(stab,sizeof(stab)); if assigned(ps) then begin writesymbol(ps); { current address } curraddr:=StabsSec.mempos+StabsSec.datasize; if DLLSource and RelocSection then { avoid relocation in the .stab section because it ends up in the .reloc section instead } StabsSec.addsymreloc(curraddr-4,ps,RELOC_RVA) else StabsSec.addsymreloc(curraddr-4,ps,RELOC_ABSOLUTE); end; end; procedure tcoffobjectdata.section_mempos(p:tnamedindexitem;arg:pointer); begin tcoffobjectsection(p).memsize:=tcoffobjectsection(p).datasize; { memory position is in arg } if not win32 then begin tcoffobjectsection(p).mempos:=plongint(arg)^; inc(plongint(arg)^,align(tcoffobjectsection(p).memsize,tcoffobjectsection(p).addralign)); end; end; procedure tcoffobjectdata.beforealloc; begin { create stabs sections if debugging } if (cs_debuginfo in aktmoduleswitches) then begin StabsSec.Alloc(sizeof(coffstab)); StabStrSec.Alloc(length(SplitFileName(current_module.mainsource^))+2); end; end; procedure tcoffobjectdata.beforewrite; var s : string; begin { create stabs sections if debugging } if (cs_debuginfo in aktmoduleswitches) then begin writestab(0,nil,0,0,0,nil); { write zero pchar and name together (PM) } s:=#0+SplitFileName(current_module.mainsource^)+#0; stabstrsec.write(s[1],length(s)); end; end; procedure tcoffobjectdata.afteralloc; var mempos : longint; begin { if debug then also count header stab } if (cs_debuginfo in aktmoduleswitches) then begin StabsSec.Alloc(sizeof(coffstab)); StabStrSec.Alloc(length(SplitFileName(current_module.mainsource^))+2); end; { calc mempos } mempos:=0; sects.foreach(@section_mempos,@mempos); end; {**************************************************************************** tdjcoffobjectdata ****************************************************************************} constructor tdjcoffobjectdata.create(const n:string); begin inherited createcoff(n,false,tdjcoffobjectsection); end; {**************************************************************************** tpecoffobjectdata ****************************************************************************} constructor tpecoffobjectdata.create(const n:string); begin inherited createcoff(n,true,tpecoffobjectsection); 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:=tpecoffobjectdata.create(n) else result:=tdjcoffobjectdata.create(n); end; procedure tcoffobjectoutput.write_symbol(const name:string;value,section,typ,aux:longint); var sym : coffsymbol; begin FillChar(sym,sizeof(sym),0); { symbolname } if length(name)>8 then begin sym.strpos:=FCoffStrs.size+4; FCoffStrs.writestr(name); FCoffStrs.writestr(#0); end else move(name[1],sym.name,length(name)); sym.value:=value; sym.section:=section; sym.typ:=typ; sym.aux:=aux; FWriter.write(sym,sizeof(sym)); end; procedure tcoffobjectoutput.section_write_symbol(p:tnamedindexitem;arg:pointer); var secrec : coffsectionrec; begin write_symbol(tasmsection(p).name,tasmsection(p).mempos,tasmsection(p).secsymidx,3,1); fillchar(secrec,sizeof(secrec),0); secrec.len:=tasmsection(p).aligneddatasize; secrec.nrelocs:=tasmsection(p).relocations.count; FWriter.write(secrec,sizeof(secrec)); end; procedure tcoffobjectoutput.section_write_relocs(p:tnamedindexitem;arg:pointer); var rel : coffreloc; r : TAsmRelocation; begin r:=TasmRelocation(tasmsection(p).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*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<>nil then rel.sym:=2*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; procedure tcoffobjectoutput.write_symbols(data:TAsmObjectData); var filename : string[18]; value : longint; sectionval, globalval : byte; p : tasmsymbol; begin with tcoffobjectdata(data) do begin { The `.file' record, and the file name auxiliary record } write_symbol('.file', 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 } Sects.foreach(@section_write_symbol,nil); { The symbols used } p:=Tasmsymbol(symbols.First); while assigned(p) do begin if assigned(p.section) and (p.currbind<>AB_COMMON) then sectionval:=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+p.section.mempos else value:=p.size; { symbolname } write_symbol(p.name,value,sectionval,globalval,0); p:=tasmsymbol(p.indexnext); end; end; end; procedure tcoffobjectoutput.section_set_secsymidx(p:tnamedindexitem;arg:pointer); begin inc(plongint(arg)^); tasmsection(p).secsymidx:=plongint(arg)^; end; procedure tcoffobjectoutput.section_set_datapos(p:tnamedindexitem;arg:pointer); begin tasmsection(p).datapos:=plongint(arg)^; if not(aso_alloconly in tasmsection(p).secoptions) then inc(plongint(arg)^,tasmsection(p).aligneddatasize); end; procedure tcoffobjectoutput.section_set_reloc_datapos(p:tnamedindexitem;arg:pointer); begin TCoffObjectSection(p).coffrelocpos:=plongint(arg)^; inc(plongint(arg)^,sizeof(coffreloc)*tasmsection(p).relocations.count); end; procedure tcoffobjectoutput.section_write_header(p:tnamedindexitem;arg:pointer); var sechdr : coffsechdr; s : string; begin fillchar(sechdr,sizeof(sechdr),0); s:=tasmsection(p).name; { section names are limited to 8 chars } if length(s)>8 then internalerror(200403312); move(s[1],sechdr.name,length(s)); if not win32 then begin sechdr.rvaofs:=tasmsection(p).mempos; sechdr.vsize:=tasmsection(p).mempos; end else begin if tasmsection(p).sectype=sec_bss then sechdr.vsize:=tasmsection(p).aligneddatasize; end; sechdr.datasize:=tasmsection(p).aligneddatasize; if (tasmsection(p).datasize>0) and not(aso_alloconly in tasmsection(p).secoptions) then sechdr.datapos:=tasmsection(p).datapos; sechdr.nrelocs:=tasmsection(p).relocations.count; sechdr.relocpos:=TCoffObjectSection(p).coffrelocpos; sechdr.flags:=TCoffObjectSection(p).flags; FWriter.write(sechdr,sizeof(sechdr)); end; procedure tcoffobjectoutput.section_write_data(p:tnamedindexitem;arg:pointer); var hp : pdynamicblock; begin if (aso_alloconly in tasmsection(p).secoptions) then exit; if tasmsection(p).data=nil then internalerror(200403073); tasmsection(p).alignsection; hp:=tasmsection(p).data.firstblock; while assigned(hp) do begin FWriter.write(hp^.data,hp^.used); hp:=hp^.next; end; end; function tcoffobjectoutput.writedata(data:TAsmObjectData):boolean; var orgdatapos, datapos, nsects, sympos,i : longint; hstab : coffstab; gotreloc : boolean; header : coffheader; empty : array[0..15] of byte; hp : pdynamicblock; s : string; 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; Sects.foreach(@section_set_secsymidx,@nsects); initsym:=2+nsects*2; { 2 for the file } { For the stab section we need an HdrSym which can now be calculated more easily } if StabsSec<>nil then begin { header stab } s:=#0+SplitFileName(current_module.mainsource^)+#0; stabstrsec.write(s[1],length(s)); hstab.strpos:=1; hstab.ntype:=0; hstab.nother:=0; hstab.ndesc:=(StabsSec.datasize div sizeof(coffstab))-1{+1 according to gas output PM}; hstab.nvalue:=StabStrSec.datasize; StabsSec.data.seek(0); StabsSec.data.write(hstab,sizeof(hstab)); end; { Calculate the filepositions } datapos:=sizeof(coffheader)+sizeof(coffsechdr)*nsects; { sections first } Sects.foreach(@section_set_datapos,@datapos); { relocs } orgdatapos:=datapos; Sects.foreach(@section_set_reloc_datapos,@datapos); gotreloc:=(orgdatapos<>datapos); { symbols } sympos:=datapos; { COFF header } fillchar(header,sizeof(coffheader),0); {$ifdef i386} header.mach:=$14c; {$endif i386} {$ifdef arm} header.mach:=$1c0; {$endif arm} 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 } Sects.foreach(@section_write_header,nil); { Sections } Sects.foreach(@section_write_data,nil); { Relocs } Sects.foreach(@section_write_relocs,nil); { 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;value,section,typ,aux:longint); var sym : coffsymbol; begin FillChar(sym,sizeof(sym),0); if length(name)>8 then begin sym.strpos:=FCoffStrs.size+4; FCoffStrs.writestr(name); FCoffStrs.writestr(#0); end else move(name[1],sym.name,length(name)); sym.value:=value; sym.section:=section; sym.typ:=typ; sym.aux:=aux; FWriter.write(sym,sizeof(sym)); end; procedure tcoffexeoutput.write_symbols; var value, sectionval, globalval : byte; objdata : TAsmObjectData; p : tasmsymbol; begin {$ifdef internallinker} 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.name].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; {$endif internallinker} end; procedure tcoffexeoutput.CalculateMemoryMap; var objdata : TAsmObjectData; secsymidx, mempos, datapos : longint; begin {$ifdef internallinker} { 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; {$endif internallinker} end; function tcoffexeoutput.writedata:boolean; var i : longint; header : coffheader; optheader : coffoptheader; sechdr : coffsechdr; hp : pdynamicblock; objdata : TAsmObjectData; hsym : tasmsymbol; begin result:=false; {$ifdef internallinker} 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 FWriter.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; {$endif internallinker} 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:=tpecoffobjectdata.create(n) else result:=tdjcoffobjectdata.create(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 size, address, i,nsyms, symidx : longint; sym : coffsymbol; strname : string; p : tasmsymbol; bind : Tasmsymbind; auxrec : array[0..17] of byte; begin {$ifdef internallinker} 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 (symidx0 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; {$endif internallinker} end; function tcoffobjectinput.readobjectdata(data:TAsmObjectData):boolean; var strsize, i : longint; header : coffheader; sechdr : coffsechdr; secname : array[0..15] of char; begin result:=false; {$ifdef internallinker} 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; {$ifdef i386} if header.mach<>$14c then {$endif i386} {$ifdef arm} if header.mach<>$1c0 then {$endif arm} 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; {$endif internallinker} 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; flags : [af_outputbinary]; labelprefix : '.L'; comment : ''; ); as_i386_pecoff_info : tasminfo = ( id : as_i386_pecoff; idtxt : 'PECOFF'; asmbin : ''; asmcmd : ''; supported_target : system_i386_win32; flags : [af_outputbinary]; labelprefix : '.L'; comment : ''; ); as_i386_pecoffwdosx_info : tasminfo = ( id : as_i386_pecoffwdosx; idtxt : 'PEWDOSX'; asmbin : ''; asmcmd : ''; supported_target : system_i386_wdosx; flags : [af_outputbinary]; labelprefix : '.L'; comment : ''; ); as_i386_pecoffwince_info : tasminfo = ( id : as_i386_pecoffwince; idtxt : 'PECOFFWINCE'; asmbin : ''; asmcmd : ''; supported_target : system_i386_wince; flags : [af_outputbinary]; labelprefix : '.L'; comment : ''; ); as_arm_pecoffwince_info : tasminfo = ( id : as_arm_pecoffwince; idtxt : 'PECOFFWINCE'; asmbin : ''; asmcmd : ''; supported_target : system_arm_wince; flags : [af_outputbinary]; labelprefix : '.L'; comment : ''; ); initialization {$ifdef i386} RegisterAssembler(as_i386_coff_info,TCoffAssembler); RegisterAssembler(as_i386_pecoff_info,TPECoffAssembler); RegisterAssembler(as_i386_pecoffwdosx_info,TPECoffAssembler); RegisterAssembler(as_i386_pecoffwince_info,TPECoffAssembler); {$endif i386} {$ifdef arm} RegisterAssembler(as_arm_pecoffwince_info,TPECoffAssembler); {$endif arm} end.