{
$Id: ogbase.pas,v 1.13 2003/04/22 14:33:38 peter Exp $
Copyright (c) 1998-2002 by Peter Vreman
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
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 ogbase;
{$i fpcdefs.inc}
interface
uses
{$ifdef Delphi}
sysutils,
dmisc,
{$else Delphi}
strings,
dos,
{$endif Delphi}
{ common }
cclasses,
{ targets }
systems,
{ outputwriters }
owbase,owar,
{ assembler }
cpubase,aasmbase,aasmtai;
type
tobjectoutput = class
protected
{ writer }
FWriter : tobjectwriter;
function writedata(data:TAsmObjectData):boolean;virtual;abstract;
public
constructor create(smart:boolean);
destructor destroy;override;
function newobjectdata(const n:string):TAsmObjectData;virtual;
function startobjectfile(const fn:string):boolean;
function writeobjectfile(data:TAsmObjectData):boolean;
procedure exportsymbol(p:tasmsymbol);
property Writer:TObjectWriter read FWriter;
end;
tobjectinput = class
protected
{ reader }
FReader : tobjectreader;
protected
function str2sec(const s:string):TSection;
function readobjectdata(data:TAsmObjectData):boolean;virtual;abstract;
public
constructor create;
destructor destroy;override;
function newobjectdata(const n:string):TAsmObjectData;virtual;
function readobjectfile(const fn:string;data:TAsmObjectData):boolean;virtual;
property Reader:TObjectReader read FReader;
end;
texesection = class
public
name : string[32];
available : boolean;
secsymidx,
datasize,
datapos,
memsize,
mempos : longint;
flags : cardinal;
DataList : TLinkedList;
constructor create(const n:string);
destructor destroy;override;
end;
texeoutput = class
protected
{ writer }
FWriter : tobjectwriter;
procedure WriteZeros(l:longint);
procedure MapObjectdata(var datapos:longint;var mempos:longint);
function writedata:boolean;virtual;abstract;
public
{ info for each section }
sections : array[TSection] of texesection;
{ global symbols }
externalsyms : tsinglelist;
commonsyms : tsinglelist;
globalsyms : tdictionary;
{ list of all data of the object files to link }
objdatalist : tlinkedlist;
constructor create;
destructor destroy;override;
function newobjectinput:tobjectinput;virtual;
procedure GenerateExecutable(const fn:string);virtual;abstract;
function writeexefile(const fn:string):boolean;
function CalculateSymbols:boolean;
procedure CalculateMemoryMap;virtual;abstract;
procedure addobjdata(objdata:TAsmObjectData);
procedure FixUpSymbols;
procedure FixUpRelocations;
procedure addglobalsym(const name:string;ofs:longint);
property Writer:TObjectWriter read FWriter;
end;
var
exeoutput : texeoutput;
implementation
uses
cutils,globtype,globals,verbose,fmodule,ogmap;
{****************************************************************************
tobjectoutput
****************************************************************************}
constructor tobjectoutput.create(smart:boolean);
begin
{ init writer }
if smart and
not(cs_asm_leave in aktglobalswitches) then
FWriter:=tarobjectwriter.create(current_module.staticlibfilename^)
else
FWriter:=tobjectwriter.create;
end;
destructor tobjectoutput.destroy;
begin
FWriter.free;
end;
function tobjectoutput.newobjectdata(const n:string):TAsmObjectData;
begin
result:=TAsmObjectData.create(n);
end;
function tobjectoutput.startobjectfile(const fn:string):boolean;
begin
result:=false;
{ start the writer already, so the .a generation can initialize
the position of the current objectfile }
if not FWriter.createfile(fn) then
Comment(V_Fatal,'Can''t create object '+fn);
result:=true;
end;
function tobjectoutput.writeobjectfile(data:TAsmObjectData):boolean;
begin
if errorcount=0 then
result:=writedata(data)
else
result:=true;
{ close the writer }
FWriter.closefile;
end;
procedure tobjectoutput.exportsymbol(p:tasmsymbol);
begin
{ export globals and common symbols, this is needed
for .a files }
if p.currbind in [AB_GLOBAL,AB_COMMON] then
FWriter.writesym(p.name);
end;
{****************************************************************************
texesection
****************************************************************************}
constructor texesection.create(const n:string);
begin
name:=n;
mempos:=0;
memsize:=0;
datapos:=0;
datasize:=0;
secsymidx:=0;
available:=false;
flags:=0;
datalist:=TLinkedList.Create;
end;
destructor texesection.destroy;
begin
end;
{****************************************************************************
texeoutput
****************************************************************************}
constructor texeoutput.create;
var
sec : TSection;
begin
{ init writer }
FWriter:=tobjectwriter.create;
{ object files }
objdatalist:=tlinkedlist.create;
{ symbols }
globalsyms:=tdictionary.create;
globalsyms.usehash;
globalsyms.noclear:=true;
externalsyms:=tsinglelist.create;
commonsyms:=tsinglelist.create;
{ sections }
for sec:=low(TSection) to high(TSection) do
sections[sec]:=texesection.create(target_asm.secnames[sec]);
end;
destructor texeoutput.destroy;
var
sec : TSection;
begin
for sec:=low(TSection) to high(TSection) do
sections[sec].free;
globalsyms.free;
externalsyms.free;
commonsyms.free;
objdatalist.free;
FWriter.free;
end;
function texeoutput.newobjectinput:tobjectinput;
begin
result:=tobjectinput.create;
end;
function texeoutput.writeexefile(const fn:string):boolean;
begin
result:=false;
if FWriter.createfile(fn) then
begin
{ Only write the .o if there are no errors }
if errorcount=0 then
result:=writedata
else
result:=true;
{ close the writer }
FWriter.closefile;
end
else
Comment(V_Fatal,'Can''t create executable '+fn);
end;
procedure texeoutput.addobjdata(objdata:TAsmObjectData);
var
sec : TSection;
begin
objdatalist.concat(objdata);
{ check which sections are available }
for sec:=low(TSection) to high(TSection) do
begin
if assigned(objdata.sects[sec]) then
begin
sections[sec].available:=true;
sections[sec].flags:=objdata.sects[sec].flags;
end;
end;
end;
procedure texeoutput.MapObjectdata(var datapos:longint;var mempos:longint);
var
sec : TSection;
s : TAsmSection;
alignedpos : longint;
objdata : TAsmObjectData;
begin
{ calculate offsets of each objdata }
for sec:=low(TSection) to high(TSection) do
begin
if sections[sec].available then
begin
{ set start position of section }
sections[sec].datapos:=datapos;
sections[sec].mempos:=mempos;
{ update objectfiles }
objdata:=TAsmObjectData(objdatalist.first);
while assigned(objdata) do
begin
s:=objdata.sects[sec];
if assigned(s) then
begin
{ align section }
mempos:=align(mempos,$10);
if assigned(s.data) then
begin
alignedpos:=align(datapos,$10);
s.dataalignbytes:=alignedpos-datapos;
datapos:=alignedpos;
end;
{ set position and size of this objectfile }
s.mempos:=mempos;
s.datapos:=datapos;
inc(mempos,s.datasize);
if assigned(s.data) then
inc(datapos,s.datasize);
end;
objdata:=TAsmObjectData(objdata.next);
end;
{ calculate size of the section }
sections[sec].datasize:=datapos-sections[sec].datapos;
sections[sec].memsize:=mempos-sections[sec].mempos;
end;
end;
end;
procedure texeoutput.WriteZeros(l:longint);
var
empty : array[0..63] of char;
begin
if l>0 then
begin
fillchar(empty,l,0);
FWriter.Write(empty,l);
end;
end;
procedure texeoutput.FixUpSymbols;
var
sec : TSection;
objdata : TAsmObjectData;
sym,
hsym : tasmsymbol;
begin
{
Fixing up symbols is done in the following steps:
1. Update addresses
2. Update common references
3. Update external references
}
{ Step 1, Update addresses }
if assigned(exemap) then
exemap.AddMemoryMapHeader;
for sec:=low(TSection) to high(TSection) do
if sections[sec].available then
begin
if assigned(exemap) then
exemap.AddMemoryMapSection(sections[sec]);
objdata:=TAsmObjectData(objdatalist.first);
while assigned(objdata) do
begin
if assigned(objdata.sects[sec]) then
begin
if assigned(exemap) then
exemap.AddMemoryMapObjectData(objdata,sec);
hsym:=tasmsymbol(objdata.symbols.first);
while assigned(hsym) do
begin
{ process only the symbols that are defined in this section
and are located in this module }
if ((hsym.section=sec) or
((sec=sec_bss) and (hsym.section=sec_common))) then
begin
if hsym.currbind=AB_EXTERNAL then
internalerror(200206303);
inc(hsym.address,TAsmObjectData(hsym.objectdata).sects[sec].mempos);
if assigned(exemap) then
exemap.AddMemoryMapSymbol(hsym);
end;
hsym:=tasmsymbol(hsym.indexnext);
end;
end;
objdata:=TAsmObjectData(objdata.next);
end;
end;
{ Step 2, Update commons }
sym:=tasmsymbol(commonsyms.first);
while assigned(sym) do
begin
if sym.currbind=AB_COMMON then
begin
{ update this symbol }
sym.currbind:=sym.altsymbol.currbind;
sym.address:=sym.altsymbol.address;
sym.size:=sym.altsymbol.size;
sym.section:=sym.altsymbol.section;
sym.typ:=sym.altsymbol.typ;
sym.objectdata:=sym.altsymbol.objectdata;
end;
sym:=tasmsymbol(sym.listnext);
end;
{ Step 3, Update externals }
sym:=tasmsymbol(externalsyms.first);
while assigned(sym) do
begin
if sym.currbind=AB_EXTERNAL then
begin
{ update this symbol }
sym.currbind:=sym.altsymbol.currbind;
sym.address:=sym.altsymbol.address;
sym.size:=sym.altsymbol.size;
sym.section:=sym.altsymbol.section;
sym.typ:=sym.altsymbol.typ;
sym.objectdata:=sym.altsymbol.objectdata;
end;
sym:=tasmsymbol(sym.listnext);
end;
end;
procedure texeoutput.FixUpRelocations;
var
objdata : TAsmObjectData;
begin
objdata:=TAsmObjectData(objdatalist.first);
while assigned(objdata) do
begin
objdata.fixuprelocs;
objdata:=TAsmObjectData(objdata.next);
end;
end;
procedure texeoutput.addglobalsym(const name:string;ofs:longint);
var
sym : tasmsymbol;
begin
sym:=tasmsymbol(globalsyms.search(name));
if not assigned(sym) then
begin
sym:=tasmsymbol.create(name,AB_GLOBAL,AT_FUNCTION);
globalsyms.insert(sym);
end;
sym.currbind:=AB_GLOBAL;
sym.address:=ofs;
end;
function TExeOutput.CalculateSymbols:boolean;
var
commonobjdata,
objdata : TAsmObjectData;
s : TAsmSection;
sym,p : tasmsymbol;
begin
commonobjdata:=nil;
CalculateSymbols:=true;
{
The symbol calculation is done in 3 steps:
1. register globals
register externals
register commons
2. try to find commons, if not found then
add to the globals (so externals can be resolved)
3. try to find externals
}
{ Step 1, Register symbols }
objdata:=TAsmObjectData(objdatalist.first);
while assigned(objdata) do
begin
sym:=tasmsymbol(objdata.symbols.first);
while assigned(sym) do
begin
if not assigned(sym.objectdata) then
internalerror(200206302);
case sym.currbind of
AB_GLOBAL :
begin
p:=tasmsymbol(globalsyms.search(sym.name));
if not assigned(p) then
globalsyms.insert(sym)
else
begin
Comment(V_Error,'Multiple defined symbol '+sym.name);
CalculateSymbols:=false;
end;
end;
AB_EXTERNAL :
externalsyms.insert(sym);
AB_COMMON :
commonsyms.insert(sym);
end;
sym:=tasmsymbol(sym.indexnext);
end;
objdata:=TAsmObjectData(objdata.next);
end;
{ Step 2, Match common symbols or add to the globals }
sym:=tasmsymbol(commonsyms.first);
while assigned(sym) do
begin
if sym.currbind=AB_COMMON then
begin
p:=tasmsymbol(globalsyms.search(sym.name));
if assigned(p) then
begin
if p.size<>sym.size then
internalerror(200206301);
end
else
begin
{ allocate new symbol in .bss and store it in the
*COMMON* module }
if not assigned(commonobjdata) then
begin
if assigned(exemap) then
exemap.AddCommonSymbolsHeader;
{ create .bss section and add to list }
s:=TAsmSection.create(target_asm.secnames[sec_common],0,true);
commonobjdata:=TAsmObjectData.create('*COMMON*');
commonobjdata.sects[sec_bss]:=s;
addobjdata(commonobjdata);
end;
p:=TAsmSymbol.Create(sym.name,AB_GLOBAL,AT_FUNCTION);
p.SetAddress(0,sec_common,s.datasize,sym.size);
p.objectdata:=commonobjdata;
commonobjdata.sects[sec_bss].alloc(sym.size);
commonobjdata.symbols.insert(p);
{ update this symbol }
if assigned(exemap) then
exemap.AddCommonSymbol(p);
{ make this symbol available as a global }
globalsyms.insert(p);
end;
sym.altsymbol:=p;
end;
sym:=tasmsymbol(sym.listnext);
end;
{ Step 3 }
sym:=tasmsymbol(externalsyms.first);
while assigned(sym) do
begin
if sym.currbind=AB_EXTERNAL then
begin
p:=tasmsymbol(globalsyms.search(sym.name));
if assigned(p) then
begin
sym.altsymbol:=p;
end
else
begin
Comment(V_Error,'Undefined symbol: '+sym.name);
CalculateSymbols:=false;
end;
end;
sym:=tasmsymbol(sym.listnext);
end;
end;
{****************************************************************************
tobjectinput
****************************************************************************}
constructor tobjectinput.create;
begin
{ init reader }
FReader:=tobjectreader.create;
end;
destructor tobjectinput.destroy;
begin
FReader.free;
end;
function tobjectinput.newobjectdata(const n:string):TAsmObjectData;
begin
result:=TAsmObjectData.create(n);
end;
function tobjectinput.readobjectfile(const fn:string;data:TAsmObjectData):boolean;
begin
result:=false;
{ start the reader }
if FReader.openfile(fn) then
begin
result:=readobjectdata(data);
FReader.closefile;
end;
end;
function tobjectinput.str2sec(const s:string):TSection;
var
t : TSection;
begin
for t:=low(TSection) to high(TSection) do
begin
if (s=target_asm.secnames[t]) then
begin
str2sec:=t;
exit;
end;
end;
str2sec:=sec_none;
end;
end.
{
$Log: ogbase.pas,v $
Revision 1.13 2003/04/22 14:33:38 peter
* removed some notes/hints
Revision 1.12 2002/07/01 18:46:24 peter
* internal linker
* reorganized aasm layer
Revision 1.11 2002/05/18 13:34:10 peter
* readded missing revisions
Revision 1.9 2002/05/14 19:34:43 peter
* removed old logs and updated copyright year
}
syntax highlighted by Code2HTML, v. 0.9.1