paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-03 12:30:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

* create generic toutputsection for binary writers

Browse Source
This commit is contained in:
peter 2000-11-12 22:20:37 +00:00
parent e0a874dc4f
commit 5ac2599649
13 changed files with 1161 additions and 1682 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
compiler/ag386bin.pas
View File

@ -25,7 +25,6 @@ unit ag386bin;
{$i defines.inc}
{$define MULTIPASS}
{$define EXTERNALBSS}
interface
@ -83,7 +82,8 @@ interface
{$ifdef GDB}
gdb,
{$endif}
og386,og386dbg,og386cff,og386elf;
ogbase,
ogcoff,ogelf;
{$ifdef GDB}
@ -380,7 +380,6 @@ interface
end;
ait_datablock :
begin
{$ifdef EXTERNALBSS}
if not SmartAsm then
begin
if not pai_datablock(hp)^.is_global then
@ -395,7 +394,6 @@ interface
end
else
begin
{$endif}
l:=pai_datablock(hp)^.size;
if l>2 then
objectalloc^.sectionalign(4)
@ -477,7 +475,6 @@ interface
begin
if objectalloc^.currsec<>sec_bss then
Message(asmw_e_alloc_data_only_in_bss);
{$ifdef EXTERNALBSS}
if not SmartAsm then
begin
if pai_datablock(hp)^.is_global then
@ -500,7 +497,6 @@ interface
end;
end
else
{$endif}
begin
l:=pai_datablock(hp)^.size;
if l>2 then
@ -664,18 +660,14 @@ interface
ait_datablock :
begin
objectoutput^.writesymbol(pai_datablock(hp)^.sym);
if SmartAsm
{$ifdef EXTERNALBSS}
or (not pai_datablock(hp)^.is_global)
{$endif}
then
if SmartAsm or (not pai_datablock(hp)^.is_global) then
begin
l:=pai_datablock(hp)^.size;
if l>2 then
objectoutput^.writealign(4)
objectoutput^.allocalign(4)
else if l>1 then
objectoutput^.writealign(2);
objectoutput^.writealloc(pai_datablock(hp)^.size);
objectoutput^.allocalign(2);
objectoutput^.alloc(pai_datablock(hp)^.size);
end;
end;
ait_const_32bit :
@ -852,10 +844,10 @@ interface
objectalloc^.resetsections;
objectalloc^.setsection(startsec);
TreePass0(hp);
{$endif}
{ leave if errors have occured }
if errorcount>0 then
exit;
{$endif MULTIPASS}
{ Pass 1 }
currpass:=1;
@ -977,14 +969,14 @@ interface
case t of
og_none :
Message(asmw_f_no_binary_writer_selected);
og_dbg :
objectoutput:=new(pdbgoutput,init(smart));
og_coff :
objectoutput:=new(pdjgppcoffoutput,init(smart));
objectoutput:=new(pcoffoutput,initdjgpp(smart));
og_pecoff :
objectoutput:=new(pwin32coffoutput,init(smart));
objectoutput:=new(pcoffoutput,initwin32(smart));
og_elf :
objectoutput:=new(pelf32output,init(smart));
else
internalerror(43243432);
end;
objectalloc:=new(pobjectalloc,init);
SmartAsm:=smart;
@ -1011,7 +1003,10 @@ interface
end.
{
$Log$
Revision 1.8 2000-09-24 15:06:10 peter
Revision 1.9 2000-11-12 22:20:37 peter
* create generic toutputsection for binary writers
Revision 1.8 2000/09/24 15:06:10 peter
* use defines.inc
Revision 1.7 2000/08/27 16:11:49 peter

14
compiler/cobjects.pas
View File

@ -260,6 +260,7 @@ interface
procedure align(i:longint);
procedure seek(i:longint);
procedure write(const d;len:longint);
procedure writestr(const s:string);
function read(var d;len:longint):longint;
procedure blockwrite(var f:file);
private
@ -1631,6 +1632,12 @@ end;
end;
procedure tdynamicarray.writestr(const s:string);
begin
write(s[1],length(s));
end;
function tdynamicarray.read(var d;len:longint):longint;
var
p : pchar;
@ -1846,7 +1853,10 @@ end;
end.
{
$Log$
Revision 1.18 2000-11-04 14:25:19 florian
Revision 1.19 2000-11-12 22:20:37 peter
* create generic toutputsection for binary writers
Revision 1.18 2000/11/04 14:25:19 florian
+ merged Attila's changes for interfaces, not tested yet
Revision 1.17 2000/11/03 19:41:06 jonas
@ -1903,4 +1913,4 @@ end.
Revision 1.2 2000/07/13 11:32:38 michael
+ removed logs
}
}

9
compiler/globals.pas
View File

@ -1257,7 +1257,7 @@ implementation
{ must_be_valid:=true; obsolete PM }
not_unit_proc:=true;
apptype:=at_cui;
apptype:=app_cui;
end;
begin
@ -1270,7 +1270,10 @@ begin
end.
{
$Log$
Revision 1.18 2000-11-04 14:25:19 florian
Revision 1.19 2000-11-12 22:20:37 peter
* create generic toutputsection for binary writers
Revision 1.18 2000/11/04 14:25:19 florian
+ merged Attila's changes for interfaces, not tested yet
Revision 1.17 2000/10/31 22:02:46 peter
@ -1327,4 +1330,4 @@ end.
Revision 1.2 2000/07/13 11:32:41 michael
+ removed logs
}
}

11
compiler/globtype.pas
View File

@ -139,8 +139,8 @@ interface
tmodeswitches = set of tmodeswitch;
{ win32 sub system }
tapptype = (at_none,
at_gui,at_cui
tapptype = (app_none,
app_gui,app_cui
);
{ interface types }
@ -210,7 +210,10 @@ implementation
end.
{
$Log$
Revision 1.8 2000-11-04 14:25:19 florian
Revision 1.9 2000-11-12 22:20:37 peter
* create generic toutputsection for binary writers
Revision 1.8 2000/11/04 14:25:19 florian
+ merged Attila's changes for interfaces, not tested yet
Revision 1.7 2000/09/24 15:06:16 peter
@ -232,4 +235,4 @@ end.
Revision 1.2 2000/07/13 11:32:41 michael
+ removed logs
}
}

11
compiler/htypechk.pas
View File

@ -765,9 +765,9 @@ implementation
(hsym^.owner = aktprocsym^.definition^.localst)) then
begin
if tloadnode(p).symtable^.symtabletype=localsymtable then
CGMessage1(sym_n_uninitialized_local_variable,hsym^.name)
CGMessage1(sym_n_uninitialized_local_variable,hsym^.realname)
else
CGMessage1(sym_n_uninitialized_variable,hsym^.name);
CGMessage1(sym_n_uninitialized_variable,hsym^.realname);
end;
end;
end;
@ -887,7 +887,10 @@ implementation
end.
{
$Log$
Revision 1.14 2000-11-04 14:25:19 florian
Revision 1.15 2000-11-12 22:20:37 peter
* create generic toutputsection for binary writers
Revision 1.14 2000/11/04 14:25:19 florian
+ merged Attila's changes for interfaces, not tested yet
Revision 1.13 2000/10/31 22:02:47 peter
@ -931,4 +934,4 @@ end.
Revision 1.2 2000/07/13 11:32:41 michael
+ removed logs
}
}

10
compiler/i386/cpuasm.pas
View File

@ -146,7 +146,8 @@ type
implementation
uses
cutils,og386;
cutils,
ogbase;
{*****************************************************************************
TaiRegAlloc
@ -1669,7 +1670,10 @@ end;
end.
{
$Log$
Revision 1.2 2000-10-15 10:50:46 florian
Revision 1.3 2000-11-12 22:20:37 peter
* create generic toutputsection for binary writers
Revision 1.2 2000/10/15 10:50:46 florian
* fixed xmm register access
Revision 1.1 2000/10/15 09:39:37 peter
@ -1689,4 +1693,4 @@ end.
Revision 1.2 2000/07/13 11:32:38 michael
+ removed logs
}
}

1068
compiler/og386cff.pas
View File

File diff suppressed because it is too large Load Diff

196
compiler/og386dbg.pas
View File

@ -1,196 +0,0 @@
{
$Id$
Copyright (c) 1998-2000 by Peter Vreman
Contains the 386 binary writer for debugging purposes
* 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 og386dbg;
{$i defines.inc}
interface
uses
systems,aasm,cpubase,og386;
type
pdbgoutput = ^tdbgoutput;
tdbgoutput = object(tobjectoutput)
nsyms : longint;
rawidx : longint;
constructor init(smart:boolean);
destructor done;virtual;
procedure initwriting(Aplace:tcutplace);virtual;
procedure donewriting;virtual;
procedure writebytes(var data;len:longint);virtual;
procedure writealloc(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;
end;
implementation
{****************************************************************************
Tdbgoutput
****************************************************************************}
constructor tdbgoutput.init(smart:boolean);
begin
inherited init(smart);
rawidx:=-1;
nsyms:=0;
end;
destructor tdbgoutput.done;
begin
end;
procedure tdbgoutput.initwriting(Aplace:tcutplace);
begin
inherited initwriting(Aplace);
writeln('initwriting '+Objfile);
end;
procedure tdbgoutput.donewriting;
begin
if rawidx<>-1 then
begin
writeln;
rawidx:=-1;
end;
writeln('donewriting');
end;
procedure tdbgoutput.writesymbol(p:pasmsymbol);
begin
if rawidx<>-1 then
begin
writeln;
rawidx:=-1;
end;
p^.idx:=nsyms;
write('symbol [',nsyms,'] '+p^.name+' (',target_asm.secnames[p^.section],',',p^.address,',',p^.size,',');
case p^.bind of
AB_LOCAL :
writeln('local)');
AB_GLOBAL :
writeln('global)');
AB_EXTERNAL :
writeln('extern)');
else
writeln('unknown)');
end;
inc(nsyms);
end;
procedure tdbgoutput.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
begin
if rawidx<>-1 then
begin
writeln;
rawidx:=-1;
end;
if assigned(p) then
write('reloc: ',data,' [',target_asm.secnames[p^.section],',',p^.address,']')
else
write('reloc: ',data);
case relative of
relative_true : writeln(' relative');
relative_false: writeln(' not relative');
relative_rva : writeln(' relative virtual address');
end;
end;
procedure tdbgoutput.writebytes(var data;len:longint);
function hexstr(val : longint;cnt : byte) : string;
const
HexTbl : array[0..15] of char='0123456789ABCDEF';
var
i : longint;
begin
hexstr[0]:=char(cnt);
for i:=cnt downto 1 do
begin
hexstr[i]:=hextbl[val and $f];
val:=val shr 4;
end;
end;
var
p : pchar;
i : longint;
begin
if len=0 then
exit;
p:=@data;
if rawidx=-1 then
begin
write('raw: ');
rawidx:=0;
end;
for i:=1to len do
begin
if rawidx>=16 then
begin
writeln;
write('raw: ');
rawidx:=0;
end;
write(hexstr(ord(p[i-1]),2),' ');
inc(rawidx);
end;
end;
procedure tdbgoutput.writealloc(len:longint);
begin
writeln('alloc: ',len);
end;
procedure tdbgoutput.writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);
begin
writeln('stabs: ',line,',',nidx,'"',p,'"');
end;
end.
{
$Log$
Revision 1.4 2000-09-24 15:06:20 peter
* use defines.inc
Revision 1.3 2000/07/13 12:08:26 michael
+ patched to 1.1.0 with former 1.09patch from peter
Revision 1.2 2000/07/13 11:32:43 michael
+ removed logs
}

298
compiler/og386.pas → compiler/ogbase.pas
View File

@ -2,11 +2,7 @@
$Id$
Copyright (c) 1998-2000 by Peter Vreman
Contains the base stuff for 386 binary object file writers
* This code was inspired by the NASM sources
The Netwide Assembler is copyright (C) 1996 Simon Tatham and
Julian Hall. All rights reserved.
Contains the base stuff for binary object file writers
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
@ -24,7 +20,7 @@
****************************************************************************
}
unit og386;
unit ogbase;
{$i defines.inc}
@ -38,14 +34,68 @@ interface
strings,
dos,
{$endif Delphi}
{ common }
cobjects,
{ targets }
systems,
{ outputwriters }
owbase,owar,
systems,cpubase,aasm;
{ assembler }
cpubase,aasm;
type
tsecsize = array[tsection] of longint;
relative_type = (relative_false,relative_true,relative_rva);
poutputreloc = ^toutputreloc;
toutputreloc = packed record
next : poutputreloc;
address : longint;
symbol : pasmsymbol;
section : tsection; { only used if symbol=nil }
typ : relative_type;
end;
poutputsymbol = ^toutputsymbol;
toutputsymbol = packed record
namestr : string[8]; { namestr or nameidx is used }
nameidx : longint;
section : tsection;
value : longint;
bind : TAsmsymbind;
typ : TAsmsymtype;
size : longint;
end;
poutputsection = ^toutputsection;
toutputsection = object
name : string[32];
secsymidx : longint; { index for the section in symtab }
addralign : longint;
{ size of the data and in the file }
data : PDynamicArray;
datasize : longint;
datapos : longint;
{ size and position in memory, set by setsectionsize }
memsize,
mempos : longint;
{ relocation }
nrelocs : longint;
relochead : POutputReloc;
reloctail : ^POutputReloc;
constructor init(const Aname:string;Aalign:longint;alloconly:boolean);
destructor done;
function write(var d;l:longint):longint;
function writestr(const s:string):longint;
procedure writealign(l:longint);
function aligneddatasize:longint;
procedure alignsection;
procedure alloc(l:longint);
procedure addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
procedure addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
end;
pobjectalloc = ^tobjectalloc;
tobjectalloc = object
currsec : tsection;
@ -62,31 +112,35 @@ interface
pobjectoutput = ^tobjectoutput;
tobjectoutput = object
SmartFilesCount,
SmartHeaderCount : longint;
objsmart : boolean;
writer : pobjectwriter;
path : pathstr;
ObjFile : string;
{ smartlinking }
objsmart : boolean;
place : tcutplace;
SmartFilesCount,
SmartHeaderCount : longint;
{ section }
currsec : tsection;
sects : array[TSection] of POutputSection;
constructor init(smart:boolean);
destructor done;virtual;
{ Writing }
procedure NextSmartName;
procedure initwriting(Aplace:tcutplace);virtual;
procedure donewriting;virtual;
procedure createsection(sec:tsection);virtual;
procedure defaultsection(sec:tsection);
function sectionsize(s:tsection):longint;virtual;
procedure setsectionsizes(var s:tsecsize);virtual;
procedure alloc(len:longint);virtual;
procedure allocalign(len:longint);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;
procedure defaultsection(sec:tsection);
end;
var
@ -101,7 +155,7 @@ interface
{****************************************************************************
tobjectoutput
tobjectalloc
****************************************************************************}
constructor tobjectalloc.init;
@ -153,6 +207,131 @@ interface
end;
{****************************************************************************
TSectionOutput
****************************************************************************}
constructor toutputsection.init(const Aname:string;Aalign:longint;alloconly:boolean);
begin
name:=Aname;
secsymidx:=0;
addralign:=Aalign;
{ data }
datasize:=0;
datapos:=0;
if alloconly then
data:=nil
else
new(Data,Init(8192));
{ position }
mempos:=0;
memsize:=0;
{ relocation }
NRelocs:=0;
relocHead:=nil;
relocTail:=@relocHead;
end;
destructor toutputsection.done;
begin
if assigned(Data) then
dispose(Data,done);
end;
function toutputsection.write(var d;l:longint):longint;
begin
write:=datasize;
if not assigned(Data) then
Internalerror(3334441);
Data^.write(d,l);
inc(datasize,l);
end;
function toutputsection.writestr(const s:string):longint;
begin
writestr:=datasize;
if not assigned(Data) then
Internalerror(3334441);
Data^.write(s[1],length(s));
inc(datasize,length(s));
end;
procedure toutputsection.writealign(l:longint);
var
i : longint;
empty : array[0..63] of char;
begin
{ no alignment needed for 0 or 1 }
if l<=1 then
exit;
i:=datasize mod l;
if i>0 then
begin
if assigned(data) then
begin
fillchar(empty,sizeof(empty),0);
data^.write(empty,l-i);
end;
inc(datasize,l-i);
end;
end;
function toutputsection.aligneddatasize:longint;
begin
aligneddatasize:=align(datasize,addralign);
end;
procedure toutputsection.alignsection;
begin
writealign(addralign);
end;
procedure toutputsection.alloc(l:longint);
begin
if assigned(Data) then
Internalerror(3334442);
inc(datasize,l);
end;
procedure toutputsection.addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
var
r : POutputReloc;
begin
new(r);
reloctail^:=r;
reloctail:=@r^.next;
r^.next:=nil;
r^.address:=ofs;
r^.symbol:=p;
r^.section:=sec_none;
r^.typ:=relative;
inc(nrelocs);
end;
procedure toutputsection.addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
var
r : POutputReloc;
begin
new(r);
reloctail^:=r;
reloctail:=@r^.next;
r^.next:=nil;
r^.address:=ofs;
r^.symbol:=nil;
r^.section:=sec;
r^.typ:=relative;
inc(nrelocs);
end;
{****************************************************************************
tobjectoutput
@ -179,8 +358,7 @@ interface
path:=current_module^.path^;
{ init writer }
if objsmart and
not(cs_asm_leave in aktglobalswitches) then
writer:=New(parobjectwriter,Init(current_module^.staticlibfilename^))
not(cs_asm_leave in aktglobalswitches) then writer:=New(parobjectwriter,Init(current_module^.staticlibfilename^))
else
writer:=New(pobjectwriter,Init);
end;
@ -221,63 +399,99 @@ interface
procedure tobjectoutput.initwriting(Aplace:tcutplace);
begin
place:=Aplace;
{ open the writer }
if objsmart then
NextSmartName;
writer^.create(objfile);
{ reset }
FillChar(Sects,sizeof(Sects),0);
end;
procedure tobjectoutput.donewriting;
var
sec : tsection;
begin
{ free memory }
for sec:=low(tsection) to high(tsection) do
if assigned(sects[sec]) then
dispose(sects[sec],done);
{ close the writer }
writer^.close;
end;
procedure tobjectoutput.createsection(sec:tsection);
begin
sects[sec]:=new(poutputsection,init(target_asm.secnames[sec],1,(sec=sec_bss)));
end;
function tobjectoutput.sectionsize(s:tsection):longint;
begin
sectionsize:=0;
end;
procedure tobjectoutput.setsectionsizes(var s:tsecsize);
begin
end;
procedure tobjectoutput.defaultsection(sec:tsection);
begin
currsec:=sec;
end;
procedure tobjectoutput.writebytes(var data;len:longint);
begin
if not assigned(sects[currsec]) then
createsection(currsec);
sects[currsec]^.write(data,len);
end;
procedure tobjectoutput.alloc(len:longint);
begin
if not assigned(sects[currsec]) then
createsection(currsec);
sects[currsec]^.alloc(len);
end;
procedure tobjectoutput.allocalign(len:longint);
var
modulo : longint;
begin
if not assigned(sects[currsec]) then
createsection(currsec);
modulo:=sects[currsec]^.datasize mod len;
if modulo > 0 then
sects[currsec]^.alloc(len-modulo);
end;
procedure tobjectoutput.writesymbol(p:pasmsymbol);
begin
Do_halt(211);
end;
procedure tobjectoutput.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
begin
Do_halt(211);
end;
procedure tobjectoutput.writebytes(var data;len:longint);
begin
Do_halt(211);
end;
procedure tobjectoutput.writealloc(len:longint);
begin
Do_halt(211);
end;
procedure tobjectoutput.writealign(len:longint);
begin
Do_halt(211);
end;
procedure tobjectoutput.writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);
begin
Do_halt(211);
end;
procedure tobjectoutput.writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
nidx,nother,line:longint;reloc:boolean);
nidx,nother,line:longint;reloc:boolean);
begin
Do_halt(211);
end;
@ -285,23 +499,7 @@ interface
end.
{
$Log$
Revision 1.7 2000-10-01 19:48:25 peter
* lot of compile updates for cg11
Revision 1.1 2000-11-12 22:20:37 peter
* create generic toutputsection for binary writers
Revision 1.6 2000/09/24 15:06:19 peter
* use defines.inc
Revision 1.5 2000/08/27 16:11:51 peter
* moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule
Revision 1.4 2000/08/06 10:42:29 peter
* merged patches name generation in lib and asm constant eval
Revision 1.3 2000/07/13 12:08:26 michael
+ patched to 1.1.0 with former 1.09patch from peter
Revision 1.2 2000/07/13 11:32:43 michael
+ removed logs
}
}

753
compiler/ogcoff.pas Normal file
View File

@ -0,0 +1,753 @@
{
$Id$
Copyright (c) 1998-2000 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 defines.inc}
interface
uses
{ common }
cobjects,
{ target }
systems,
{ assembler }
cpubase,aasm,
{ output }
ogbase;
type
pcoffsection = ^tcoffsection;
tcoffsection = object(toutputsection)
flags : longint;
relocpos : longint;
constructor initsec(sec:TSection;AAlign,AFlags:longint);
end;
pcoffoutput = ^tcoffoutput;
tcoffoutput = object(tobjectoutput)
win32 : boolean;
strs,
syms : Pdynamicarray;
initsym : longint;
constructor initdjgpp(smart:boolean);
constructor initwin32(smart:boolean);
destructor done;virtual;
procedure initwriting(Aplace:tcutplace);virtual;
procedure donewriting;virtual;
procedure setsectionsizes(var s:tsecsize);virtual;
procedure createsection(sec:tsection);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;
private
procedure write_relocs(s:poutputsection);
procedure write_symbol(const name:string;strpos,value,section,typ,aux:longint);
procedure write_symbols;
procedure writetodisk;
end;
implementation
uses
{$ifdef delphi}
sysutils,
{$else}
strings,
{$endif}
cutils,verbose,
globtype,globals,fmodule;
const
symbolresize = 200*18;
strsresize = 8192;
DataResize = 8192;
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;
datasize : 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 : smallint;
empty : smallint;
typ : byte;
aux : byte;
end;
pcoffstab=^coffstab;
coffstab=packed record
strpos : longint;
ntype : byte;
nother : byte;
ndesc : word;
nvalue : longint;
end;
{****************************************************************************
TCoffSection
****************************************************************************}
constructor tcoffsection.initsec(sec:TSection;AAlign,AFlags:longint);
begin
inherited init(target_asm.secnames[sec],AAlign,(sec=sec_bss));
Flags:=AFlags;
end;
{****************************************************************************
TCoffOutput
****************************************************************************}
constructor tcoffoutput.initdjgpp(smart:boolean);
begin
inherited init(smart);
win32:=false;
end;
constructor tcoffoutput.initwin32(smart:boolean);
begin
inherited init(smart);
win32:=true;
end;
destructor tcoffoutput.done;
begin
inherited done;
end;
procedure tcoffoutput.initwriting(Aplace:tcutplace);
var
s : string;
begin
inherited initwriting(Aplace);
{ reset }
initsym:=0;
new(syms,init(symbolresize));
new(strs,init(strsresize));
{ 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 tcoffoutput.donewriting;
begin
{ Only write the .o if there are no errors }
if errorcount=0 then
writetodisk;
dispose(syms,done);
dispose(strs,done);
inherited donewriting;
end;
procedure tcoffoutput.createsection(sec:TSection);
var
Flags,
AAlign : longint;
begin
{ defaults }
Flags:=0;
Aalign:=1;
{ alignment after section }
case sec of
sec_code :
begin
if win32 then
Flags:=$60000020
else
Flags:=$20;
Aalign:=4;
end;
sec_data :
begin
if win32 then
Flags:=$c0300040
else
Flags:=$40;
Aalign:=4;
end;
sec_bss :
begin
if win32 then
Flags:=$c0300080
else
Flags:=$80;
Aalign:=4;
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]:=new(PcoffSection,InitSec(Sec,AAlign,Flags));
end;
procedure tcoffoutput.writesymbol(p:pasmsymbol);
var
sym : toutputsymbol;
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);
FillChar(sym,sizeof(sym),0);
sym.value:=p^.size;
sym.bind:=p^.bind;
sym.typ:=AT_NONE;
{ if local of global then set the section value to the address
of the symbol }
if sym.bind in [AB_LOCAL,AB_GLOBAL] then
begin
sym.section:=p^.section;
sym.value:=p^.address+sects[sym.section]^.mempos;
end;
{ store the symbol, but not the local ones }
if (sym.bind<>AB_LOCAL) then
begin
{ symbolname }
s:=p^.name;
if length(s)>8 then
begin
sym.nameidx:=strs^.size+4;
strs^.writestr(s);
strs^.writestr(#0);
end
else
begin
sym.nameidx:=-1;
sym.namestr:=s;
end;
{ update the asmsymbol index }
p^.idx:=syms^.size div sizeof(TOutputSymbol);
{ write the symbol }
syms^.write(sym,sizeof(toutputsymbol));
end
else
begin
p^.idx:=-2; { local }
end;
{ make the exported syms known to the objectwriter
(needed for .a generation) }
if (sym.bind in [AB_GLOBAL,AB_COMMON]) then
writer^.writesym(p^.name);
end;
procedure tcoffoutput.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
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
relative_false :
begin
sects[currsec]^.addsectionreloc(curraddr,currsec,relative_false);
inc(data,symaddr);
end;
relative_true :
begin
inc(data,symaddr-len-sects[currsec]^.datasize);
end;
relative_rva :
begin
sects[currsec]^.addsectionreloc(curraddr,currsec,relative_rva);
inc(data,symaddr);
end;
end;
end
else
begin
writesymbol(p);
if (p^.section<>sec_none) and (relative<>relative_true) 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<>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]^.datasize);
end;
end;
end;
sects[currsec]^.write(data,len);
end;
procedure tcoffoutput.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]^.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
if DLLSource and RelocSection then
{ avoid relocation in the .stab section
because it ends up in the .reloc section instead }
sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.datasize-4,s,relative_rva)
else
sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.datasize-4,s,relative_false);
end;
procedure tcoffoutput.writesymstabs(section:tsection;offset:longint;p:pchar;ps:pasmsymbol;
nidx,nother,line:longint;reloc:boolean);
var
stab : coffstab;
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
if DLLSource and RelocSection then
{ avoid relocation in the .stab section
because it ends up in the .reloc section instead }
sects[sec_stab]^.addsymreloc(sects[sec_stab]^.datasize-4,ps,relative_rva)
else
sects[sec_stab]^.addsymreloc(sects[sec_stab]^.datasize-4,ps,relative_false);
end;
end;
procedure tcoffoutput.setsectionsizes(var s:tsecsize);
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;
{***********************************************
Writing to disk
***********************************************}
procedure tcoffoutput.write_relocs(s:poutputsection);
var
rel : coffreloc;
hr,r : poutputreloc;
begin
r:=s^.relochead;
while assigned(r) do
begin
rel.address:=r^.address;
if assigned(r^.symbol) then
begin
if (r^.symbol^.bind=AB_LOCAL) then
rel.sym:=2*sects[r^.symbol^.section]^.secsymidx
else
begin
if r^.symbol^.idx=-1 then
internalerror(4321);
rel.sym:=r^.symbol^.idx+initsym;
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
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 tcoffoutput.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 tcoffoutput.write_symbols;
var
filename : string[18];
sec : tsection;
value,
sectionval,
i : longint;
globalval : byte;
secrec : coffsectionrec;
sym : toutputsymbol;
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]^.secsymidx,3,1);
fillchar(secrec,sizeof(secrec),0);
secrec.len:=sects[sec]^.aligneddatasize;
secrec.nrelocs:=sects[sec]^.nrelocs;
writer^.write(secrec,sizeof(secrec));
end;
{ The real symbols }
syms^.seek(0);
for i:=1 to syms^.size div sizeof(TOutputSymbol) do
begin
syms^.read(sym,sizeof(TOutputSymbol));
if sym.bind=AB_LOCAL then
globalval:=3
else
globalval:=2;
if assigned(sects[sym.section]) then
sectionval:=sects[sym.section]^.secsymidx
else
sectionval:=0;
write_symbol(sym.namestr,sym.nameidx,sym.value,sectionval,globalval,0);
end;
end;
procedure tcoffoutput.writetodisk;
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
{ 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
PCoffSection(sects[sec])^.relocpos:=datapos;
inc(datapos,10*sects[sec]^.nrelocs);
if (not gotreloc) and (sects[sec]^.nrelocs>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:=(syms^.size div sizeof(TOutputSymbol))+initsym;
if gotreloc then
header.flag:=$104
else
header.flag:=$105;
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]^.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]^.nrelocs;
sechdr.relocpos:=PCoffSection(sects[sec])^.relocpos;
sechdr.flags:=PCoffSection(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
sects[sec]^.alignsection;
hp:=sects[sec]^.data^.firstblock;
while assigned(hp) do
begin
writer^.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
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^.size+4;
writer^.write(i,4);
hp:=strs^.firstblock;
while assigned(hp) do
begin
writer^.write(hp^.data,hp^.used);
hp:=hp^.next;
end;
end;
end.
{
$Log$
Revision 1.1 2000-11-12 22:20:37 peter
* create generic toutputsection for binary writers
}

384
compiler/og386elf.pas → compiler/ogelf.pas
View File

@ -24,76 +24,41 @@
****************************************************************************
}
unit og386elf;
unit ogelf;
{$i defines.inc}
interface
uses
{ common }
cobjects,
systems,cpubase,aasm,og386;
{ target }
systems,
{ assembler }
cpubase,aasm,
{ output }
ogbase;
type
preloc = ^treloc;
treloc = packed record
next : preloc;
address : longint;
symbol : pasmsymbol;
section : tsection; { only used if symbol=nil }
typ : relative_type;
end;
psymbol = ^tsymbol;
tsymbol = packed record
name : longint;
section : tsection;
value : longint;
bind : TAsmsymbind;
typ : TAsmsymtype;
size : longint;
end;
pelf32section = ^telf32section;
telf32section = object
name : string[16];
secshidx,
secsymidx : longint; { index for the section in symtab }
telf32section = object(toutputsection)
secshidx : longint; { index for the section in symtab }
shstridx,
shtype,
shflags,
shlink,
shinfo,
addralign,
entsize : longint;
{ size of the data and in the file }
data : PDynamicArray;
datalen,
datapos : longint;
{ settings after setsectionsize }
size : longint;
fillsize : longint;
{ relocation }
nrelocs : longint;
relochead : PReloc;
reloctail : ^PReloc;
relocsect : PElf32Section;
constructor init(sec:TSection);
constructor initsec(sec:TSection);
constructor initname(const Aname:string;Atype,Aflags,Alink,Ainfo,Aalign,Aentsize:longint);
destructor done;
function write(var d;l:longint):longint;
function writestr(const s:string):longint;
procedure writealign(l:longint);
function aligneddatalen:longint;
procedure alignsection;
procedure alloc(l:longint);
procedure addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
procedure addsectionreloc(ofs:longint;sec:tsection;relative:relative_type);
end;
pelf32output = ^telf32output;
telf32output = object(tobjectoutput)
sects : array[TSection] of pelf32Section;
symtabsect,
strtabsect,
shstrtabsect,
@ -103,24 +68,20 @@ interface
pltsect,
symsect : pelf32Section;
strs,
syms : Pdynamicarray;
initsym : longint;
syms : Pdynamicarray;
initsym : longint;
constructor init(smart:boolean);
destructor done;virtual;
procedure initwriting(Aplace:tcutplace);virtual;
procedure donewriting;virtual;
function sectionsize(s:tsection):longint;virtual;
procedure createsection(sec:tsection);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;
nidx,nother,line:longint;reloc:boolean);virtual;
private
procedure createsection(sec:tsection);
procedure createrelocsection(s:pelf32section);
procedure createshstrtab;
procedure createsymtab;
@ -246,7 +207,7 @@ interface
TSection
****************************************************************************}
constructor telf32section.init(sec:TSection);
constructor telf32section.initsec(sec:TSection);
var
Aflags,Atype,Aalign,Aentsize : longint;
begin
@ -291,133 +252,23 @@ interface
constructor telf32section.initname(const Aname:string;Atype,Aflags,Alink,Ainfo,Aalign,Aentsize:longint);
begin
name:=Aname;
inherited init(Aname,Aalign,(AType=SHT_NOBITS));
secshidx:=0;
secsymidx:=0;
shstridx:=0;
shtype:=AType;
shflags:=AFlags;
shlink:=Alink;
shinfo:=Ainfo;
addralign:=Aalign;
entsize:=Aentsize;
{ setsectionsize data }
fillsize:=0;
size:=0;
{ data }
dataLen:=0;
dataPos:=0;
if shtype=SHT_NOBITS then
data:=nil
else
new(Data,Init(8192));
{ relocation }
NRelocs:=0;
relocHead:=nil;
relocTail:=@relocHead;
relocsect:=nil;
end;
destructor telf32section.done;
begin
if assigned(Data) then
dispose(Data,done);
if assigned(relocsect) then
dispose(relocsect,done);
end;
function telf32section.write(var d;l:longint):longint;
begin
write:=datalen;
if not assigned(Data) then
Internalerror(3334441);
Data^.write(d,l);
inc(datalen,l);
end;
function telf32section.writestr(const s:string):longint;
begin
writestr:=datalen;
if not assigned(Data) then
Internalerror(3334441);
Data^.write(s[1],length(s));
inc(datalen,length(s));
end;
procedure telf32section.writealign(l:longint);
var
i : longint;
empty : array[0..63] of char;
begin
{ no alignment needed for 0 or 1 }
if l<=1 then
exit;
i:=datalen mod l;
if i>0 then
begin
if assigned(data) then
begin
fillchar(empty,sizeof(empty),0);
data^.write(empty,l-i);
end;
inc(datalen,l-i);
end;
end;
function telf32section.aligneddatalen:longint;
begin
aligneddatalen:=align(datalen,addralign);
end;
procedure telf32section.alignsection;
begin
writealign(addralign);
end;
procedure telf32section.alloc(l:longint);
begin
if assigned(Data) then
Internalerror(3334442);
inc(datalen,l);
end;
procedure telf32section.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;
r^.symbol:=p;
r^.section:=sec_none;
r^.typ:=relative;
inc(nrelocs);
end;
procedure telf32section.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;
r^.symbol:=nil;
r^.section:=sec;
r^.typ:=relative;
inc(nrelocs);
inherited done;
end;
@ -445,7 +296,6 @@ interface
{ reset }
initsym:=0;
new(syms,init(symbolresize));
FillChar(Sects,sizeof(Sects),0);
{ default sections }
new(symtabsect,initname('.symtab',2,0,0,0,4,16));
new(strtabsect,initname('.strtab',3,0,0,0,1,0));
@ -471,8 +321,6 @@ interface
procedure telf32output.donewriting;
var
sec : tsection;
begin
writetodisk;
{ free memory }
@ -480,31 +328,19 @@ interface
dispose(symtabsect,done);
dispose(strtabsect,done);
dispose(shstrtabsect,done);
for sec:=low(tsection) to high(tsection) do
if assigned(sects[sec]) then
dispose(sects[sec],done);
inherited donewriting;
end;
function telf32output.sectionsize(s:tsection):longint;
begin
if assigned(sects[s]) then
sectionsize:=sects[s]^.datalen
else
sectionsize:=0;
end;
procedure telf32output.createsection(sec:tsection);
begin
sects[sec]:=new(pelf32Section,init(Sec));
sects[sec]:=new(pelf32Section,initsec(Sec))
end;
procedure telf32output.writesymbol(p:pasmsymbol);
var
sym : tsymbol;
sym : toutputsymbol;
begin
{ already written ? }
if p^.idx<>-1 then
@ -530,16 +366,21 @@ interface
sym.value:=$10;
end;
end;
{ update the asmsymbol index }
p^.idx:=syms^.size div sizeof(tsymbol);
{ store the symbol, but not the local ones (PM) }
{ store the symbol, but not the local ones }
if (sym.bind<>AB_LOCAL) then
begin
{ symbolname, write the #0 separate to overcome 255+1 char not possible }
sym.name:=strtabsect^.writestr(p^.name);
sym.nameidx:=strtabsect^.datasize;
strtabsect^.writestr(p^.name);
strtabsect^.writestr(#0);
{ update the asmsymbol index }
p^.idx:=syms^.size div sizeof(toutputsymbol);
{ symbol }
syms^.write(sym,sizeof(tsymbol));
syms^.write(sym,sizeof(toutputsymbol));
end
else
begin
p^.idx:=-2; { local }
end;
{ make the exported syms known to the objectwriter
(needed for .a generation) }
@ -548,34 +389,6 @@ interface
end;
procedure telf32output.writebytes(var data;len:longint);
begin
if not assigned(sects[currsec]) then
createsection(currsec);
sects[currsec]^.write(data,len);
end;
procedure telf32output.writealloc(len:longint);
begin
if not assigned(sects[currsec]) then
createsection(currsec);
sects[currsec]^.alloc(len);
end;
procedure telf32output.writealign(len:longint);
var
modulo : longint;
begin
if not assigned(sects[currsec]) then
createsection(currsec);
modulo:=sects[currsec]^.datalen mod len;
if modulo > 0 then
sects[currsec]^.alloc(len-modulo);
end;
procedure telf32output.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
var
symaddr : longint;
@ -592,12 +405,12 @@ interface
case relative of
relative_false :
begin
sects[currsec]^.addsectionreloc(sects[currsec]^.datalen,currsec,relative_false);
sects[currsec]^.addsectionreloc(sects[currsec]^.datasize,currsec,relative_false);
inc(data,symaddr);
end;
relative_true :
begin
inc(data,symaddr-len-sects[currsec]^.datalen);
inc(data,symaddr-len-sects[currsec]^.datasize);
end;
relative_rva :
internalerror(3219583);
@ -608,17 +421,17 @@ interface
writesymbol(p);
if (p^.section<>sec_none) and (relative<>relative_true) then
begin
sects[currsec]^.addsectionreloc(sects[currsec]^.datalen,p^.section,relative);
sects[currsec]^.addsectionreloc(sects[currsec]^.datasize,p^.section,relative);
inc(data,symaddr);
end
else
sects[currsec]^.addsymreloc(sects[currsec]^.datalen,p,relative);
sects[currsec]^.addsymreloc(sects[currsec]^.datasize,p,relative);
if relative=relative_true then
begin
if p^.bind=AB_EXTERNAL then
dec(data,len)
else
dec(data,len+sects[currsec]^.datalen);
dec(data,len+sects[currsec]^.datasize);
end;
end;
end;
@ -639,13 +452,13 @@ interface
if s=sec_none then
offset:=0
else
offset:=sects[s]^.datalen;
offset:=sects[s]^.datasize;
end;
end;
fillchar(stab,sizeof(telf32stab),0);
if assigned(p) and (p[0]<>#0) then
begin
stab.strpos:=sects[sec_stabstr]^.datalen;
stab.strpos:=sects[sec_stabstr]^.datasize;
sects[sec_stabstr]^.write(p^,strlen(p)+1);
end;
stab.ntype:=nidx;
@ -656,7 +469,7 @@ interface
{ 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]^.datalen-4,s,relative_false);
sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.datasize-4,s,relative_false);
end;
@ -664,23 +477,21 @@ interface
nidx,nother,line:longint;reloc:boolean);
var
stab : telf32stab;
s : tsection;
begin
s:=section;
if reloc then
begin
if (offset=-1) then
begin
if s=sec_none then
if section=sec_none then
offset:=0
else
offset:=sects[s]^.datalen;
offset:=sects[section]^.datasize;
end;
end;
fillchar(stab,sizeof(telf32stab),0);
if assigned(p) and (p[0]<>#0) then
begin
stab.strpos:=sects[sec_stabstr]^.datalen;
stab.strpos:=sects[sec_stabstr]^.datasize;
sects[sec_stabstr]^.write(p^,strlen(p)+1);
end;
stab.ntype:=nidx;
@ -691,38 +502,12 @@ interface
{ 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]^.datalen-4,ps,relative_false);
sects[sec_stab]^.addsymreloc(sects[sec_stab]^.datasize-4,ps,relative_false);
end;
procedure telf32output.setsectionsizes(var s:tsecsize);
var
align : longint;
sec : tsection;
begin
{ multiply stab with real size }
s[sec_stab]:=s[sec_stab]*sizeof(telf32stab);
{ if debug then also count header stab }
if (cs_debuginfo in aktmoduleswitches) then
begin
inc(s[sec_stab],sizeof(telf32stab));
inc(s[sec_stabstr],length(SplitFileName(current_module^.mainsource^))+2);
end;
{ fix all section }
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]^.size:=s[sec];
{ calculate the alignment }
align:=sects[sec]^.addralign;
sects[sec]^.fillsize:=align-(sects[sec]^.size and (align-1));
if sects[sec]^.fillsize=align then
sects[sec]^.fillsize:=0;
end;
end;
end;
@ -733,7 +518,7 @@ interface
procedure telf32output.createrelocsection(s:pelf32section);
var
rel : telf32reloc;
hr,r : preloc;
hr,r : poutputreloc;
relsym,reltyp : longint;
begin
{ create the reloc section }
@ -779,7 +564,7 @@ interface
procedure telf32output.createsymtab;
var
elfsym : telf32symbol;
sym : tsymbol;
sym : toutputsymbol;
sec : tsection;
locals,
i : longint;
@ -798,19 +583,19 @@ interface
if assigned(sects[sec]) then
begin
fillchar(elfsym,sizeof(elfsym),0);
elfsym.st_name:=sects[sec]^.shstridx;
elfsym.st_name:=pelf32section(sects[sec])^.shstridx;
elfsym.st_info:=STT_SECTION;
elfsym.st_shndx:=sects[sec]^.secshidx;
elfsym.st_shndx:=pelf32section(sects[sec])^.secshidx;
symtabsect^.write(elfsym,sizeof(elfsym));
inc(locals);
end;
{ symbols }
syms^.seek(0);
for i:=1 to (syms^.size div sizeof(TSymbol)) do
for i:=1 to (syms^.size div sizeof(toutputsymbol)) do
begin
syms^.read(sym,sizeof(TSymbol));
syms^.read(sym,sizeof(toutputsymbol));
fillchar(elfsym,sizeof(elfsym),0);
elfsym.st_name:=sym.name;
elfsym.st_name:=sym.nameidx;
elfsym.st_value:=sym.value;
elfsym.st_size:=sym.size;
case sym.bind of
@ -837,7 +622,7 @@ interface
elfsym.st_shndx:=SHN_COMMON
else
if assigned(sects[sym.section]) then
elfsym.st_shndx:=sects[sym.section]^.secshidx
elfsym.st_shndx:=pelf32section(sects[sym.section])^.secshidx
else
elfsym.st_shndx:=SHN_UNDEF;
symtabsect^.write(elfsym,sizeof(elfsym));
@ -861,9 +646,9 @@ interface
for sec:=low(tsection) to high(tsection) do
if assigned(sects[sec]) then
begin
sects[sec]^.shstridx:=writestr(sects[sec]^.name+#0);
if assigned(sects[sec]^.relocsect) then
sects[sec]^.relocsect^.shstridx:=writestr(sects[sec]^.relocsect^.name+#0);
pelf32section(sects[sec])^.shstridx:=writestr(sects[sec]^.name+#0);
if assigned(pelf32section(sects[sec])^.relocsect) then
pelf32section(sects[sec])^.relocsect^.shstridx:=writestr(pelf32section(sects[sec])^.relocsect^.name+#0);
end;
end;
end;
@ -878,7 +663,7 @@ interface
sechdr.sh_type:=s^.shtype;
sechdr.sh_flags:=s^.shflags;
sechdr.sh_offset:=s^.datapos;
sechdr.sh_size:=s^.datalen;
sechdr.sh_size:=s^.datasize;
sechdr.sh_link:=s^.shlink;
sechdr.sh_info:=s^.shinfo;
sechdr.sh_addralign:=s^.addralign;
@ -898,7 +683,7 @@ interface
empty : array[0..63] of byte;
hp : pdynamicblock;
begin
{ calc amount of sections we have and align sections at 4 bytes }
{ calc amount of sections we have }
fillchar(empty,sizeof(empty),0);
nsects:=1;
initsym:=2;
@ -909,7 +694,7 @@ interface
sects[sec]^.secsymidx:=initsym;
inc(initsym);
{ also create the index in the section header table }
sects[sec]^.secshidx:=nsects;
pelf32section(sects[sec])^.secshidx:=nsects;
inc(nsects);
if assigned(sects[sec]^.relochead) then
inc(nsects);
@ -925,7 +710,7 @@ interface
for sec:=low(tsection) to high(tsection) do
if assigned(sects[sec]) and
(sects[sec]^.nrelocs>0) then
createrelocsection(sects[sec]);
createrelocsection(pelf32section(sects[sec]));
{ create .symtab }
createsymtab;
{ create .shstrtab }
@ -938,27 +723,27 @@ interface
begin
sects[sec]^.datapos:=datapos;
if assigned(sects[sec]^.data) then
inc(datapos,sects[sec]^.aligneddatalen);
inc(datapos,sects[sec]^.aligneddatasize);
end;
{ shstrtab }
shstrtabsect^.datapos:=datapos;
inc(datapos,shstrtabsect^.aligneddatalen);
inc(datapos,shstrtabsect^.aligneddatasize);
{ section headers }
shoffset:=datapos;
inc(datapos,nsects*sizeof(telf32sechdr));
{ symtab }
symtabsect^.datapos:=datapos;
inc(datapos,symtabsect^.aligneddatalen);
inc(datapos,symtabsect^.aligneddatasize);
{ strtab }
strtabsect^.datapos:=datapos;
inc(datapos,align(strtabsect^.datalen,4));
inc(datapos,align(strtabsect^.datasize,4));
{ .rel sections }
for sec:=low(tsection) to high(tsection) do
if assigned(sects[sec]) and
assigned(sects[sec]^.relocsect) then
assigned(pelf32section(sects[sec])^.relocsect) then
begin
sects[sec]^.relocsect^.datapos:=datapos;
inc(datapos,sects[sec]^.relocsect^.aligneddatalen);
pelf32section(sects[sec])^.relocsect^.datapos:=datapos;
inc(datapos,pelf32section(sects[sec])^.relocsect^.aligneddatasize);
end;
{ Write ELF Header }
fillchar(header,sizeof(header),0);
@ -988,8 +773,8 @@ interface
hstab.strpos:=1;
hstab.ntype:=0;
hstab.nother:=0;
hstab.ndesc:=(sects[sec_stab]^.datalen div sizeof(telf32stab))-1{+1 according to gas output PM};
hstab.nvalue:=sects[sec_stabstr]^.datalen;
hstab.ndesc:=(sects[sec_stab]^.datasize div sizeof(telf32stab))-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;
@ -1014,9 +799,9 @@ interface
for sec:=low(tsection) to high(tsection) do
if assigned(sects[sec]) then
begin
writesectionheader(sects[sec]);
if assigned(sects[sec]^.relocsect) then
writesectionheader(sects[sec]^.relocsect);
writesectionheader(pelf32section(sects[sec]));
if assigned(pelf32section(sects[sec])^.relocsect) then
writesectionheader(pelf32section(sects[sec])^.relocsect);
end;
writesectionheader(shstrtabsect);
writesectionheader(symtabsect);
@ -1040,10 +825,10 @@ interface
{ .rel sections }
for sec:=low(tsection) to high(tsection) do
if assigned(sects[sec]) and
assigned(sects[sec]^.relocsect) then
assigned(pelf32section(sects[sec])^.relocsect) then
begin
sects[sec]^.relocsect^.alignsection;
hp:=sects[sec]^.relocsect^.data^.firstblock;
pelf32section(sects[sec])^.relocsect^.alignsection;
hp:=pelf32section(sects[sec])^.relocsect^.data^.firstblock;
while assigned(hp) do
begin
writer^.write(hp^.data,hp^.used);
@ -1056,28 +841,7 @@ interface
end.
{
$Log$
Revision 1.8 2000-10-14 21:52:55 peter
* fixed memory leaks
Revision 1.7 2000/09/24 15:06:20 peter
* use defines.inc
Revision 1.6 2000/08/27 16:11:51 peter
* moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule
Revision 1.5 2000/08/19 18:44:27 peter
* new tdynamicarray implementation using blocks instead of
reallocmem (merged)
Revision 1.4 2000/08/12 19:14:58 peter
* ELF writer works now also with -g
* ELF writer is default again for linux
Revision 1.3 2000/07/13 12:08:26 michael
+ patched to 1.1.0 with former 1.09patch from peter
Revision 1.2 2000/07/13 11:32:43 michael
+ removed logs
Revision 1.1 2000-11-12 22:20:37 peter
* create generic toutputsection for binary writers
}

25
compiler/options.pas
View File

@ -743,14 +743,14 @@ begin
{Remove non core targetname extra defines}
CASE target_info.target OF
target_i386_freebsd: begin
undef_symbol('LINUX');
undef_symbol('BSD');
undef_symbol('UNIX');
end;
undef_symbol('LINUX');
undef_symbol('BSD');
undef_symbol('UNIX');
end;
target_i386_linux: undef_symbol('UNIX');
end;
end;
{ remove old target define }
{ remove old target define }
undef_symbol(target_info.short_name);
{ load new target }
@ -809,9 +809,9 @@ begin
end;
break;
end;
'C': apptype:=at_cui;
'C': apptype:=app_cui;
'D': ForceDeffileForExport:=true;
'G': apptype:=at_gui;
'G': apptype:=app_gui;
'N': begin
RelocSection:=false;
RelocSectionSetExplicitly:=true;
@ -1379,7 +1379,7 @@ begin
if target_info.target=target_i386_linux then
begin
def_symbol('LINUX');
def_symbol('LINUX');
def_symbol('UNIX');
end;
@ -1515,7 +1515,10 @@ end;
end.
{
$Log$
Revision 1.15 2000-11-07 15:09:27 marco
Revision 1.16 2000-11-12 22:20:37 peter
* create generic toutputsection for binary writers
Revision 1.15 2000/11/07 15:09:27 marco
* Define UNIX for FreeBSD and Linux. Checked crosscompile thingy.
Revision 1.14 2000/11/07 14:25:08 marco
@ -1564,4 +1567,4 @@ end.
Revision 1.2 2000/07/13 11:32:44 michael
+ removed logs
}
}

29
compiler/t_win32.pas
View File

@ -962,7 +962,7 @@ begin
if RelocSection then
{ Using short form to avoid problems with 128 char limitation under Dos. }
RelocStr:='-b base.$$$';
if apptype=at_gui then
if apptype=app_gui then
AppTypeStr:='--subsystem windows';
if assigned(DLLImageBase) then
ImageBaseStr:='--image-base=0x'+DLLImageBase^;
@ -1043,7 +1043,7 @@ begin
if RelocSection then
{ Using short form to avoid problems with 128 char limitation under Dos. }
RelocStr:='-b base.$$$';
if apptype=at_gui then
if apptype=app_gui then
AppTypeStr:='--subsystem windows';
if assigned(DLLImageBase) then
ImageBaseStr:='--image-base=0x'+DLLImageBase^;
@ -1194,10 +1194,12 @@ begin
{ when -s is used or it's a dll then quit }
if (cs_link_extern in aktglobalswitches) then
begin
if apptype=at_gui then
cmdstr:='--subsystem gui'
else if apptype=at_cui then
cmdstr:='--subsystem console';
case apptype of
app_gui :
cmdstr:='--subsystem gui';
app_cui :
cmdstr:='--subsystem console';
end;
if dllversion<>'' then
cmdstr:=cmdstr+' --version '+dllversion;
cmdstr:=cmdstr+' --input '+fn;
@ -1228,10 +1230,12 @@ begin
{ sub system }
{ gui=2 }
{ cui=3 }
if apptype=at_gui then
peheader.Subsystem:=2
else if apptype=at_cui then
peheader.Subsystem:=3;
case apptype of
app_gui :
peheader.Subsystem:=2;
app_cui :
peheader.Subsystem:=3;
end;
if dllversion<>'' then
begin
peheader.MajorImageVersion:=dllmajor;
@ -1301,7 +1305,10 @@ end;
end.
{
$Log$
Revision 1.5 2000-09-24 15:06:31 peter
Revision 1.6 2000-11-12 22:20:37 peter
* create generic toutputsection for binary writers
Revision 1.5 2000/09/24 15:06:31 peter
* use defines.inc
Revision 1.4 2000/08/27 16:11:54 peter