mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-28 06:23:48 +02:00
96fdcfb1f2
* external bss vars had wrong stabs for pecoff
+ -WB11000000 to specify default image base, allows to
load several DLLs with debugging info included
(relocatable DLL are stripped because the relocation
of the .Stab section is misplaced by ldw)
1058 lines
32 KiB
ObjectPascal
1058 lines
32 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1999 by Florian Klaempfl
|
|
|
|
Contains the 386 binary coff 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 og386cff;
|
|
|
|
{
|
|
Notes on COFF:
|
|
|
|
(0) When I say `standard COFF' below, I mean `COFF as output and
|
|
used by DJGPP'. I assume DJGPP gets it right.
|
|
|
|
(1) Win32 appears to interpret the term `relative relocation'
|
|
differently from standard COFF. Standard COFF understands a
|
|
relative relocation to mean that during relocation you add the
|
|
address of the symbol you're referencing, and subtract the base
|
|
address of the section you're in. Win32 COFF, by contrast, seems
|
|
to add the address of the symbol and then subtract the address
|
|
of THE BYTE AFTER THE RELOCATED DWORD. Hence the two formats are
|
|
subtly incompatible.
|
|
|
|
(2) Win32 doesn't bother putting any flags in the header flags
|
|
field (at offset 0x12 into the file).
|
|
|
|
(3) Win32 uses some extra flags into the section header table:
|
|
it defines flags 0x80000000 (writable), 0x40000000 (readable)
|
|
and 0x20000000 (executable), and uses them in the expected
|
|
combinations. It also defines 0x00100000 through 0x00700000 for
|
|
section alignments of 1 through 64 bytes.
|
|
|
|
(4) Both standard COFF and Win32 COFF seem to use the DWORD
|
|
field directly after the section name in the section header
|
|
table for something strange: they store what the address of the
|
|
section start point _would_ be, if you laid all the sections end
|
|
to end starting at zero. Dunno why. Microsoft's documentation
|
|
lists this field as "Virtual Size of Section", which doesn't
|
|
seem to fit at all. In fact, Win32 even includes non-linked
|
|
sections such as .drectve in this calculation.
|
|
|
|
(5) Standard COFF does something very strange to common
|
|
variables: the relocation point for a common variable is as far
|
|
_before_ the variable as its size stretches out _after_ it. So
|
|
we must fix up common variable references. Win32 seems to be
|
|
sensible on this one.
|
|
}
|
|
interface
|
|
|
|
uses
|
|
cobjects,
|
|
systems,cpubase,aasm,og386;
|
|
|
|
type
|
|
preloc = ^treloc;
|
|
treloc = packed record
|
|
next : preloc;
|
|
address : longint;
|
|
symbol : pasmsymbol;
|
|
section : tsection; { only used if symbol=nil }
|
|
relative : relative_type;
|
|
end;
|
|
|
|
psymbol = ^tsymbol;
|
|
tsymbol = packed record
|
|
name : string[8];
|
|
strpos : longint;
|
|
section : tsection;
|
|
value : longint;
|
|
typ : TAsmsymtype;
|
|
end;
|
|
|
|
pcoffsection = ^tcoffsection;
|
|
tcoffsection = object
|
|
index : tsection;
|
|
secidx : longint;
|
|
data : PDynamicArray;
|
|
size,
|
|
fillsize,
|
|
mempos,
|
|
len,
|
|
datapos,
|
|
relocpos,
|
|
nrelocs,
|
|
flags : longint;
|
|
relochead : PReloc;
|
|
reloctail : ^PReloc;
|
|
constructor init(sec:TSection;Aflags:longint);
|
|
destructor done;
|
|
procedure write(var d;l:longint);
|
|
procedure alloc(l:longint);
|
|
procedure addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
|
|
procedure addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
|
|
end;
|
|
|
|
pgenericcoffoutput = ^tgenericcoffoutput;
|
|
tgenericcoffoutput = object(tobjectoutput)
|
|
win32 : boolean;
|
|
sects : array[TSection] of PCoffSection;
|
|
strs,
|
|
syms : Pdynamicarray;
|
|
initsym : longint;
|
|
constructor init(smart:boolean);
|
|
destructor done;virtual;
|
|
procedure initwriting;virtual;
|
|
procedure donewriting;virtual;
|
|
procedure setsectionsizes(var s:tsecsize);virtual;
|
|
procedure writebytes(var data;len:longint);virtual;
|
|
procedure writealloc(len:longint);virtual;
|
|
procedure writealign(len:longint);virtual;
|
|
procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;
|
|
procedure writesymbol(p:pasmsymbol);virtual;
|
|
procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;
|
|
procedure writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
|
|
nidx,nother,line:longint;reloc:boolean);virtual;
|
|
function text_flags : longint;virtual;
|
|
function data_flags : longint;virtual;
|
|
function bss_flags : longint;virtual;
|
|
function idata_flags : longint;virtual;
|
|
function edata_flags : longint;virtual;
|
|
private
|
|
procedure createsection(sec:tsection);
|
|
procedure write_relocs(s:pcoffsection);
|
|
procedure write_symbol(const name:string;strpos,value,section,typ,aux:longint);
|
|
procedure write_symbols;
|
|
procedure writetodisk;
|
|
end;
|
|
|
|
pdjgppcoffoutput = ^tdjgppcoffoutput;
|
|
tdjgppcoffoutput = object(tgenericcoffoutput)
|
|
constructor init(smart:boolean);
|
|
function text_flags : longint;virtual;
|
|
function data_flags : longint;virtual;
|
|
function bss_flags : longint;virtual;
|
|
end;
|
|
|
|
pwin32coffoutput = ^twin32coffoutput;
|
|
twin32coffoutput = object(tgenericcoffoutput)
|
|
constructor init(smart:boolean);
|
|
function text_flags : longint;virtual;
|
|
function data_flags : longint;virtual;
|
|
function bss_flags : longint;virtual;
|
|
function idata_flags : longint;virtual;
|
|
function edata_flags : longint;virtual;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
strings,verbose,
|
|
globtype,globals,files;
|
|
|
|
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;
|
|
coffsechdr=packed record
|
|
name : array[0..7] of char;
|
|
vsize : longint;
|
|
rvaofs : longint;
|
|
datalen : longint;
|
|
datapos : longint;
|
|
relocpos : longint;
|
|
lineno1 : longint;
|
|
nrelocs : word;
|
|
lineno2 : word;
|
|
flags : longint;
|
|
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 : integer;
|
|
empty : integer;
|
|
typ : byte;
|
|
aux : byte;
|
|
end;
|
|
pcoffstab=^coffstab;
|
|
coffstab=packed record
|
|
strpos : longint;
|
|
ntype : byte;
|
|
nother : byte;
|
|
ndesc : word;
|
|
nvalue : longint;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TSection
|
|
****************************************************************************}
|
|
|
|
constructor tcoffsection.init(sec:TSection;Aflags:longint);
|
|
begin
|
|
index:=sec;
|
|
secidx:=0;
|
|
flags:=AFlags;
|
|
{ filled after pass 1 }
|
|
size:=0;
|
|
fillsize:=0;
|
|
mempos:=0;
|
|
{ pass 2 data }
|
|
relocHead:=nil;
|
|
relocTail:=@relocHead;
|
|
Len:=0;
|
|
NRelocs:=0;
|
|
if sec=sec_bss then
|
|
data:=nil
|
|
else
|
|
new(Data,Init(1,8192));
|
|
end;
|
|
|
|
|
|
destructor tcoffsection.done;
|
|
begin
|
|
if assigned(Data) then
|
|
dispose(Data,done);
|
|
end;
|
|
|
|
|
|
procedure tcoffsection.write(var d;l:longint);
|
|
begin
|
|
if not assigned(Data) then
|
|
Internalerror(3334441);
|
|
Data^.write(d,l);
|
|
inc(len,l);
|
|
end;
|
|
|
|
|
|
procedure tcoffsection.alloc(l:longint);
|
|
begin
|
|
if assigned(Data) then
|
|
Internalerror(3334442);
|
|
inc(len,l);
|
|
end;
|
|
|
|
|
|
procedure tcoffsection.addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
|
|
var
|
|
r : PReloc;
|
|
begin
|
|
new(r);
|
|
reloctail^:=r;
|
|
reloctail:=@r^.next;
|
|
r^.next:=nil;
|
|
r^.address:=ofs+mempos;
|
|
r^.symbol:=p;
|
|
r^.section:=sec_none;
|
|
r^.relative:=relative;
|
|
inc(nrelocs);
|
|
end;
|
|
|
|
|
|
procedure tcoffsection.addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
|
|
var
|
|
r : PReloc;
|
|
begin
|
|
new(r);
|
|
reloctail^:=r;
|
|
reloctail:=@r^.next;
|
|
r^.next:=nil;
|
|
r^.address:=ofs+mempos;
|
|
r^.symbol:=nil;
|
|
r^.section:=sec;
|
|
r^.relative:=relative;
|
|
inc(nrelocs);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
Genericcoffoutput
|
|
****************************************************************************}
|
|
|
|
const
|
|
{$ifdef TP}
|
|
symbolresize = 50;
|
|
strsresize = 200;
|
|
{$else}
|
|
symbolresize = 200;
|
|
strsresize = 8192;
|
|
{$endif}
|
|
|
|
constructor tgenericcoffoutput.init(smart:boolean);
|
|
begin
|
|
inherited init(smart);
|
|
end;
|
|
|
|
|
|
destructor tgenericcoffoutput.done;
|
|
begin
|
|
inherited done;
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.initwriting;
|
|
var
|
|
s : string;
|
|
begin
|
|
inherited initwriting;
|
|
{ reset }
|
|
initsym:=0;
|
|
new(syms,init(sizeof(TSymbol),symbolresize));
|
|
new(strs,init(1,strsresize));
|
|
FillChar(Sects,sizeof(Sects),0);
|
|
{ we need at least the following 3 sections }
|
|
createsection(sec_code);
|
|
createsection(sec_data);
|
|
createsection(sec_bss);
|
|
if (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 tgenericcoffoutput.donewriting;
|
|
var
|
|
sec : tsection;
|
|
begin
|
|
{ Only write the .o if there are no errors }
|
|
if errorcount=0 then
|
|
writetodisk;
|
|
dispose(syms,done);
|
|
dispose(strs,done);
|
|
for sec:=low(tsection) to high(tsection) do
|
|
if assigned(sects[sec]) then
|
|
dispose(sects[sec],done);
|
|
inherited donewriting;
|
|
end;
|
|
|
|
|
|
function tgenericcoffoutput.text_flags : longint;
|
|
begin
|
|
text_flags:=0;
|
|
end;
|
|
|
|
function tgenericcoffoutput.data_flags : longint;
|
|
begin
|
|
data_flags:=0;
|
|
end;
|
|
|
|
function tgenericcoffoutput.bss_flags : longint;
|
|
begin
|
|
bss_flags:=0;
|
|
end;
|
|
|
|
function tgenericcoffoutput.edata_flags : longint;
|
|
begin
|
|
edata_flags:=0;
|
|
end;
|
|
|
|
function tgenericcoffoutput.idata_flags : longint;
|
|
begin
|
|
idata_flags:=0;
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.createsection(sec:TSection);
|
|
var
|
|
Aflags : longint;
|
|
begin
|
|
Aflags:=0;
|
|
case sec of
|
|
sec_code :
|
|
Aflags:=text_flags;
|
|
sec_data :
|
|
Aflags:=data_flags;
|
|
sec_bss :
|
|
Aflags:=bss_flags;
|
|
sec_idata2,
|
|
sec_idata4,
|
|
sec_idata5,
|
|
sec_idata6,
|
|
sec_idata7 :
|
|
Aflags:=idata_flags;
|
|
sec_edata :
|
|
Aflags:=edata_flags;
|
|
else
|
|
Aflags:=0;
|
|
end;
|
|
sects[sec]:=new(PcoffSection,init(Sec,Aflags));
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.writesymbol(p:pasmsymbol);
|
|
var
|
|
pos : longint;
|
|
sym : tsymbol;
|
|
c : char;
|
|
s : string;
|
|
begin
|
|
{ already written ? }
|
|
if p^.idx<>-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);
|
|
{ symbolname }
|
|
pos:=strs^.usedsize+4;
|
|
c:=#0;
|
|
s:=p^.name;
|
|
if length(s)>8 then
|
|
begin
|
|
s:=s+#0;
|
|
strs^.write(s[1],length(s));
|
|
end
|
|
else
|
|
pos:=-1;
|
|
FillChar(sym,sizeof(sym),0);
|
|
sym.strpos:=pos;
|
|
if pos=-1 then
|
|
sym.name:=s;
|
|
sym.value:=p^.size;
|
|
sym.typ:=p^.typ;
|
|
{ if local of global then set the section value to the address
|
|
of the symbol }
|
|
if p^.typ in [AS_LOCAL,AS_GLOBAL] then
|
|
begin
|
|
sym.section:=p^.section;
|
|
sym.value:=p^.address+sects[p^.section]^.mempos;
|
|
end;
|
|
{ update the asmsymbol index }
|
|
p^.idx:=syms^.count;
|
|
{ store the symbol, but not the local ones (PM) }
|
|
if (p^.typ<>AS_LOCAL) or ((copy(s,1,2)<>'.L') and
|
|
((copy(s,1,1)<>'L') or not win32)) then
|
|
syms^.write(sym,1);
|
|
{ make the exported syms known to the objectwriter
|
|
(needed for .a generation) }
|
|
if (p^.typ=AS_GLOBAL) or
|
|
((p^.typ=AS_EXTERNAL) and (sym.value=p^.size) and (sym.value>0)) then
|
|
writer^.writesym(p^.name);
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.writebytes(var data;len:longint);
|
|
begin
|
|
if not assigned(sects[currsec]) then
|
|
createsection(currsec);
|
|
sects[currsec]^.write(data,len);
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.writealloc(len:longint);
|
|
begin
|
|
if not assigned(sects[currsec]) then
|
|
createsection(currsec);
|
|
sects[currsec]^.alloc(len);
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.writealign(len:longint);
|
|
var modulo : longint;
|
|
begin
|
|
if not assigned(sects[currsec]) then
|
|
createsection(currsec);
|
|
modulo:=sects[currsec]^.len mod len;
|
|
if modulo > 0 then
|
|
sects[currsec]^.alloc(len-modulo);
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
|
|
var
|
|
symaddr : longint;
|
|
begin
|
|
if not assigned(sects[currsec]) then
|
|
createsection(currsec);
|
|
if assigned(p) then
|
|
begin
|
|
{ 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
|
|
relative_false :
|
|
begin
|
|
sects[currsec]^.addsectionreloc(sects[currsec]^.len,currsec,relative_false);
|
|
inc(data,symaddr);
|
|
end;
|
|
relative_true :
|
|
begin
|
|
inc(data,symaddr-len-sects[currsec]^.len);
|
|
end;
|
|
relative_rva :
|
|
begin
|
|
{ don't know if this can happens !! }
|
|
{ does this work ?? }
|
|
sects[currsec]^.addsectionreloc(sects[currsec]^.len,currsec,relative_rva);
|
|
inc(data,symaddr);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
writesymbol(p);
|
|
if (p^.section<>sec_none) and (relative=relative_false) then
|
|
sects[currsec]^.addsectionreloc(sects[currsec]^.len,p^.section,relative_false)
|
|
else
|
|
sects[currsec]^.addsymreloc(sects[currsec]^.len,p,relative);
|
|
if not win32 then {seems wrong to me (PM) }
|
|
inc(data,symaddr)
|
|
else
|
|
if (relative<>relative_true) and (p^.section<>sec_none) then
|
|
inc(data,symaddr);
|
|
if relative=relative_true then
|
|
begin
|
|
if win32 then
|
|
dec(data,len-4)
|
|
else
|
|
dec(data,len+sects[currsec]^.len);
|
|
end;
|
|
end;
|
|
end;
|
|
sects[currsec]^.write(data,len);
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc : boolean);
|
|
var
|
|
stab : coffstab;
|
|
s : tsection;
|
|
begin
|
|
{ This is wrong because
|
|
sec_none is used only for external bss
|
|
if section=sec_none then
|
|
s:=currsec
|
|
else }
|
|
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]^.len;
|
|
end;
|
|
if (s<>sec_none) then
|
|
inc(offset,sects[s]^.mempos);
|
|
end;
|
|
fillchar(stab,sizeof(coffstab),0);
|
|
if assigned(p) and (p[0]<>#0) then
|
|
begin
|
|
stab.strpos:=sects[sec_stabstr]^.len;
|
|
sects[sec_stabstr]^.write(p^,strlen(p)+1);
|
|
end;
|
|
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
|
|
sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.len-4,s,relative_false);
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
|
|
nidx,nother,line:longint;reloc:boolean);
|
|
var
|
|
stab : coffstab;
|
|
s : tsection;
|
|
begin
|
|
{ This is wrong because
|
|
sec_none is used only for external bss
|
|
if section=sec_none then
|
|
s:=currsec
|
|
else }
|
|
s:=section;
|
|
{ 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 s=sec_none then
|
|
offset:=0
|
|
else
|
|
offset:=sects[s]^.len;
|
|
end;
|
|
if (s<>sec_none) then
|
|
inc(offset,sects[s]^.mempos);
|
|
end;
|
|
fillchar(stab,sizeof(coffstab),0);
|
|
if assigned(p) and (p[0]<>#0) then
|
|
begin
|
|
stab.strpos:=sects[sec_stabstr]^.len;
|
|
sects[sec_stabstr]^.write(p^,strlen(p)+1);
|
|
end;
|
|
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
|
|
sects[sec_stab]^.addsymreloc(sects[sec_stab]^.len-4,ps,relative_false);
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.write_relocs(s:pcoffsection);
|
|
var
|
|
rel : coffreloc;
|
|
hr,r : preloc;
|
|
begin
|
|
r:=s^.relochead;
|
|
while assigned(r) do
|
|
begin
|
|
rel.address:=r^.address;
|
|
if assigned(r^.symbol) then
|
|
begin
|
|
if (r^.symbol^.typ=AS_LOCAL) then
|
|
rel.sym:=2*sects[r^.symbol^.section]^.secidx
|
|
else
|
|
rel.sym:=r^.symbol^.idx+initsym;
|
|
end
|
|
else if r^.section<>sec_none then
|
|
rel.sym:=2*sects[r^.section]^.secidx
|
|
else
|
|
rel.sym:=0;
|
|
case r^.relative of
|
|
relative_true : rel.relative:=$14;
|
|
relative_false : rel.relative:=$6;
|
|
relative_rva : rel.relative:=$7;
|
|
end;
|
|
writer^.write(rel,sizeof(rel));
|
|
{ goto next and dispose this reloc }
|
|
hr:=r;
|
|
r:=r^.next;
|
|
dispose(hr);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.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;
|
|
writer^.write(sym,sizeof(sym));
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.write_symbols;
|
|
var
|
|
filename : string[18];
|
|
sec : tsection;
|
|
sectionval,
|
|
i : longint;
|
|
globalval : byte;
|
|
secrec : coffsectionrec;
|
|
sym : tsymbol;
|
|
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^);
|
|
writer^.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]^.secidx,3,1);
|
|
fillchar(secrec,sizeof(secrec),0);
|
|
secrec.len:=sects[sec]^.len;
|
|
secrec.nrelocs:=sects[sec]^.nrelocs;
|
|
writer^.write(secrec,sizeof(secrec));
|
|
end;
|
|
{ The real symbols. }
|
|
syms^.seek(0);
|
|
for i:=1 to syms^.count do
|
|
begin
|
|
syms^.read(sym,1);
|
|
if sym.typ=AS_LOCAL then
|
|
globalval:=3
|
|
else
|
|
globalval:=2;
|
|
if assigned(sects[sym.section]) then
|
|
sectionval:=sects[sym.section]^.secidx
|
|
else
|
|
sectionval:=0;
|
|
write_symbol(sym.name,sym.strpos,sym.value,sectionval,globalval,0);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.setsectionsizes(var s:tsecsize);
|
|
var
|
|
align,
|
|
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;
|
|
{ fix all section }
|
|
mempos:=0;
|
|
for sec:=low(tsection) to high(tsection) do
|
|
if s[sec]>0 then
|
|
begin
|
|
if not assigned(sects[sec]) then
|
|
createsection(sec);
|
|
sects[sec]^.size:=s[sec];
|
|
sects[sec]^.mempos:=mempos;
|
|
{ calculate the alignment }
|
|
if sects[sec]^.flags=0 then
|
|
align:=1
|
|
else
|
|
align:=4;
|
|
sects[sec]^.fillsize:=align-(sects[sec]^.size and (align-1));
|
|
if sects[sec]^.fillsize=align then
|
|
sects[sec]^.fillsize:=0;
|
|
{ next section position, not for win32 which uses
|
|
relative addresses }
|
|
if not win32 then
|
|
inc(mempos,sects[sec]^.size+sects[sec]^.fillsize);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tgenericcoffoutput.writetodisk;
|
|
var
|
|
datapos,secidx,
|
|
nsects,sympos,i : longint;
|
|
sec : tsection;
|
|
header : coffheader;
|
|
sechdr : coffsechdr;
|
|
empty : array[0..15] of byte;
|
|
begin
|
|
{ calc amount of sections we have and align sections at 4 bytes }
|
|
fillchar(empty,sizeof(empty),0);
|
|
nsects:=0;
|
|
for sec:=low(tsection) to high(tsection) do
|
|
if assigned(sects[sec]) then
|
|
begin
|
|
{$ifdef EXTDEBUG}
|
|
{ check if the section is still the same size }
|
|
if (sects[sec]^.len<>sects[sec]^.size) then
|
|
Comment(V_Warning,'Size of section changed '+tostr(sects[sec]^.size)+'->'+tostr(sects[sec]^.len)+
|
|
' ['+target_asm.secnames[sec]+']');
|
|
{$endif EXTDEBUG}
|
|
{ fill with zero }
|
|
if sects[sec]^.fillsize>0 then
|
|
begin
|
|
if assigned(sects[sec]^.data) then
|
|
sects[sec]^.write(empty,sects[sec]^.fillsize)
|
|
else
|
|
sects[sec]^.alloc(sects[sec]^.fillsize);
|
|
end;
|
|
inc(nsects);
|
|
end;
|
|
{ Calculate the filepositions }
|
|
datapos:=sizeof(coffheader)+sizeof(coffsechdr)*nsects;
|
|
initsym:=2; { 2 for the file }
|
|
{ sections first }
|
|
secidx:=0;
|
|
for sec:=low(tsection) to high(tsection) do
|
|
if assigned(sects[sec]) then
|
|
begin
|
|
inc(secidx);
|
|
sects[sec]^.secidx:=secidx;
|
|
sects[sec]^.datapos:=datapos;
|
|
if assigned(sects[sec]^.data) then
|
|
inc(datapos,sects[sec]^.len);
|
|
inc(initsym,2); { 2 for each section }
|
|
end;
|
|
{ relocs }
|
|
for sec:=low(tsection) to high(tsection) do
|
|
if assigned(sects[sec]) then
|
|
begin
|
|
sects[sec]^.relocpos:=datapos;
|
|
inc(datapos,10*sects[sec]^.nrelocs);
|
|
end;
|
|
{ symbols }
|
|
sympos:=datapos;
|
|
{ COFF header }
|
|
fillchar(header,sizeof(coffheader),0);
|
|
header.mach:=$14c;
|
|
header.nsects:=nsects;
|
|
header.sympos:=sympos;
|
|
header.syms:=syms^.count+initsym;
|
|
header.flag:=$104;
|
|
writer^.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]^.len;
|
|
end;
|
|
sechdr.datalen:=sects[sec]^.len;
|
|
if (sects[sec]^.len>0) and assigned(sects[sec]^.data) then
|
|
sechdr.datapos:=sects[sec]^.datapos;
|
|
sechdr.relocpos:=sects[sec]^.relocpos;
|
|
sechdr.nrelocs:=sects[sec]^.nrelocs;
|
|
sechdr.flags:=sects[sec]^.flags;
|
|
writer^.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
|
|
{ For the stab section we need an HdrSym which can now be
|
|
calculated more easily }
|
|
if sec=sec_stab then
|
|
begin
|
|
pcoffstab(sects[sec_stab]^.data^.data)^.nvalue:=sects[sec_stabstr]^.len;
|
|
pcoffstab(sects[sec_stab]^.data^.data)^.strpos:=1;
|
|
pcoffstab(sects[sec_stab]^.data^.data)^.ndesc:=
|
|
(sects[sec_stab]^.len div sizeof(coffstab))-1{+1 according to gas output PM};
|
|
end;
|
|
writer^.write(sects[sec]^.data^.data^,sects[sec]^.data^.usedsize);
|
|
end;
|
|
{ Relocs }
|
|
for sec:=low(tsection) to high(tsection) do
|
|
if assigned(sects[sec]) then
|
|
write_relocs(sects[sec]);
|
|
{ Symbols }
|
|
write_symbols;
|
|
{ Strings }
|
|
i:=strs^.usedsize+4;
|
|
writer^.write(i,4);
|
|
writer^.write(strs^.data^,strs^.usedsize);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
DJGppcoffoutput
|
|
****************************************************************************}
|
|
|
|
constructor tdjgppcoffoutput.init(smart:boolean);
|
|
begin
|
|
inherited init(smart);
|
|
win32:=false;
|
|
end;
|
|
|
|
function tdjgppcoffoutput.text_flags : longint;
|
|
begin
|
|
text_flags:=$20;
|
|
end;
|
|
|
|
function tdjgppcoffoutput.data_flags : longint;
|
|
begin
|
|
data_flags:=$40;
|
|
end;
|
|
|
|
function tdjgppcoffoutput.bss_flags : longint;
|
|
begin
|
|
bss_flags:=$80;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
Win32coffoutput
|
|
****************************************************************************}
|
|
|
|
constructor twin32coffoutput.init(smart:boolean);
|
|
begin
|
|
inherited init(smart);
|
|
win32:=true;
|
|
end;
|
|
|
|
function twin32coffoutput.text_flags : longint;
|
|
begin
|
|
text_flags:=$60000020; { same as as 2.9.1 }
|
|
end;
|
|
|
|
function twin32coffoutput.data_flags : longint;
|
|
begin
|
|
data_flags:=$c0300040;
|
|
end;
|
|
|
|
function twin32coffoutput.bss_flags : longint;
|
|
begin
|
|
bss_flags:=$c0300080;
|
|
end;
|
|
|
|
function twin32coffoutput.edata_flags : longint;
|
|
begin
|
|
edata_flags:=$c0300040;
|
|
end;
|
|
|
|
function twin32coffoutput.idata_flags : longint;
|
|
begin
|
|
idata_flags:=$40000000;
|
|
end;
|
|
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.12 1999-08-16 15:35:25 pierre
|
|
* fix for DLL relocation problems
|
|
* external bss vars had wrong stabs for pecoff
|
|
+ -WB11000000 to specify default image base, allows to
|
|
load several DLLs with debugging info included
|
|
(relocatable DLL are stripped because the relocation
|
|
of the .Stab section is misplaced by ldw)
|
|
|
|
Revision 1.11 1999/08/11 17:17:38 peter
|
|
* fixed rva writting for section relocs
|
|
* fixed section flags for edata and idata
|
|
|
|
Revision 1.10 1999/08/04 00:23:05 florian
|
|
* renamed i386asm and i386base to cpuasm and cpubase
|
|
|
|
Revision 1.9 1999/07/03 00:27:02 peter
|
|
* better smartlinking support
|
|
|
|
Revision 1.8 1999/06/03 16:39:09 pierre
|
|
* EXTERNALBSS fixed for stabs and default again
|
|
|
|
Revision 1.7 1999/05/21 13:55:03 peter
|
|
* NEWLAB for label as symbol
|
|
|
|
Revision 1.6 1999/05/19 11:54:19 pierre
|
|
+ experimental code for externalbss and stabs problem
|
|
|
|
Revision 1.5 1999/05/09 11:38:05 peter
|
|
* don't write .o and link if errors occure during assembling
|
|
|
|
Revision 1.4 1999/05/07 00:36:57 pierre
|
|
* added alignment code for .bss
|
|
* stabs correct but externalbss disabled
|
|
would need a special treatment in writestabs
|
|
|
|
Revision 1.3 1999/05/05 17:34:31 peter
|
|
* output is more like as 2.9.1
|
|
* stabs really working for go32v2
|
|
|
|
Revision 1.2 1999/05/02 22:36:35 peter
|
|
* fixed section index when not all sections are used
|
|
|
|
Revision 1.1 1999/05/01 13:24:24 peter
|
|
* merged nasm compiler
|
|
* old asm moved to oldasm/
|
|
|
|
Revision 1.13 1999/03/18 20:30:49 peter
|
|
+ .a writer
|
|
|
|
Revision 1.12 1999/03/12 00:20:06 pierre
|
|
+ win32 output working !
|
|
|
|
Revision 1.11 1999/03/11 13:43:08 pierre
|
|
* more fixes for win32
|
|
|
|
Revision 1.10 1999/03/10 13:41:10 pierre
|
|
+ partial implementation for win32 !
|
|
winhello works but pp still does not !
|
|
|
|
Revision 1.9 1999/03/08 14:51:09 peter
|
|
+ smartlinking for ag386bin
|
|
|
|
Revision 1.8 1999/03/05 13:09:52 peter
|
|
* first things for tai_cut support for ag386bin
|
|
|
|
Revision 1.7 1999/03/04 13:44:58 pierre
|
|
* win32 pecoff sections datapos allways zero
|
|
|
|
Revision 1.6 1999/03/03 11:41:54 pierre
|
|
+ stabs info corrected to give results near to GAS output
|
|
* local labels (with .L are not stored in object anymore)
|
|
so we get the same number of symbols as from GAS !
|
|
|
|
Revision 1.5 1999/03/03 01:36:46 pierre
|
|
+ stabs output working (though not really tested)
|
|
for a simple file the only difference to GAS output is due
|
|
to the VMA of the different sections
|
|
|
|
Revision 1.4 1999/03/02 02:56:27 peter
|
|
+ stabs support for binary writers
|
|
* more fixes and missing updates from the previous commit :(
|
|
|
|
Revision 1.3 1999/03/01 15:46:25 peter
|
|
* ag386bin finally make cycles correct
|
|
* prefixes are now also normal opcodes
|
|
|
|
Revision 1.2 1999/02/25 21:03:10 peter
|
|
* ag386bin updates
|
|
+ coff writer
|
|
|
|
}
|