paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 16:39:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

* support static library (.a) linking

Browse Source 
* move win linker script to t_win
  * rename some win32 to win in t_win

git-svn-id: trunk@3991 -
This commit is contained in:
peter 2006-06-28 20:26:53 +00:00
parent 6dd5ee65f5
commit f5c1839ff0
8 changed files with 1683 additions and 1233 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
compiler/link.pas
View File

@ -64,7 +64,7 @@ Type
Function MakeSharedLibrary:boolean;virtual;
Function MakeStaticLibrary:boolean;virtual;
procedure ExpandAndApplyOrder(var Src:TStringList);
procedure LoadPredefinedLibraryOrder;virtual;
procedure LoadPredefinedLibraryOrder;virtual;
function ReOrderEntries : boolean;
end;
@ -84,9 +84,10 @@ Type
FCExeOutput : TExeOutputClass;
FCObjInput : TObjInputClass;
{ Libraries }
FStaticLibraryList : TFPHashObjectList;
FExternalLibraryList : TFPHashObjectList;
procedure Load_ReadObject(const para:string);
procedure Load_ReadUnitObjects;
procedure Load_ReadStaticLibrary(const para:string);
procedure ParseScript_Load;
procedure ParseScript_Order;
procedure ParseScript_CalcPos;
@ -95,6 +96,7 @@ Type
protected
property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
property StaticLibraryList:TFPHashObjectList read FStaticLibraryList;
property ExternalLibraryList:TFPHashObjectList read FExternalLibraryList;
procedure DefaultLinkScript;virtual;abstract;
linkscript : TStringList;
@ -131,7 +133,7 @@ uses
script,globals,verbose,comphook,ppu,
aasmbase,aasmtai,aasmdata,aasmcpu,
symbase,symdef,symtype,symconst,
ogmap;
owbase,owar,ogmap;
type
TLinkerClass = class of Tlinker;
@ -505,18 +507,18 @@ begin
LoadPredefinedLibraryOrder;
// something to do?
if (LinkLibraryAliases.count=0) and (LinkLibraryOrder.Count=0) Then
if (LinkLibraryAliases.count=0) and (LinkLibraryOrder.Count=0) Then
exit;
p:=TLinkStrMap.Create;
// expand libaliases, clears src
LinkLibraryAliases.expand(src,p);
// writeln(src.count,' ',p.count,' ',linklibraryorder.count,' ',linklibraryaliases.count);
// apply order
p.UpdateWeights(LinkLibraryOrder);
p.UpdateWeights(LinkLibraryOrder);
p.SortOnWeight;
// put back in src
for i:=0 to p.count-1 do
src.insert(p[i].Key);
@ -773,6 +775,7 @@ end;
begin
inherited Create;
linkscript:=TStringList.Create;
FStaticLibraryList:=TFPHashObjectList.Create(true);
FExternalLibraryList:=TFPHashObjectList.Create(true);
exemap:=nil;
exeoutput:=nil;
@ -783,6 +786,7 @@ end;
Destructor TInternalLinker.Destroy;
begin
linkscript.free;
StaticLibraryList.Free;
ExternalLibraryList.Free;
if assigned(exeoutput) then
begin
@ -814,31 +818,38 @@ end;
procedure TInternalLinker.Load_ReadObject(const para:string);
var
objdata : TObjData;
objinput : TObjinput;
fn : string;
objdata : TObjData;
objinput : TObjinput;
objreader : TObjectReader;
fn : string;
begin
fn:=FindObjectFile(para,'',false);
Comment(V_Tried,'Reading object '+fn);
objinput:=CObjInput.Create;
objdata:=objinput.newObjData(para);
if objinput.readobjectfile(fn,objdata) then
exeoutput.addobjdata(objdata);
objreader:=TObjectreader.create;
if objreader.openfile(fn) then
begin
if objinput.ReadObjData(objreader,objdata) then
exeoutput.addobjdata(objdata);
end;
{ release input object }
objinput.free;
objreader.free;
end;
procedure TInternalLinker.Load_ReadUnitObjects;
procedure TInternalLinker.Load_ReadStaticLibrary(const para:string);
var
s : string;
objreader : TObjectReader;
begin
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.GetFirst;
if s<>'' then
Load_ReadObject(s);
end;
{$warning TODO Cleanup ignoring of FPC generated libimp*.a files}
{ Don't load import libraries }
if copy(splitfilename(para),1,6)='libimp' then
exit;
Comment(V_Tried,'Opening library '+para);
objreader:=TArObjectreader.create(para);
TStaticLibrary.Create(StaticLibraryList,para,objreader,CObjInput);
end;
@ -868,8 +879,8 @@ end;
ExeOutput.Load_ImageBase(para)
else if keyword='READOBJECT' then
Load_ReadObject(para)
else if keyword='READUNITOBJECTS' then
Load_ReadUnitObjects;
else if keyword='READSTATICLIBRARY' then
Load_ReadStaticLibrary(para);
hp:=tstringlistitem(hp.next);
end;
end;
@ -973,7 +984,7 @@ end;
{ Load .o files and resolve symbols }
ParseScript_Load;
exeoutput.ResolveSymbols;
exeoutput.ResolveSymbols(StaticLibraryList);
{ Generate symbols and code to do the importing }
exeoutput.GenerateLibraryImports(ExternalLibraryList);
{ Fill external symbols data }

382
compiler/ogbase.pas
View File

@ -27,6 +27,7 @@ interface
uses
{ common }
cutils,
cclasses,
{ targets }
systems,globtype,
@ -142,6 +143,7 @@ interface
private
FData : TDynamicArray;
FSecOptions : TObjSectionOptions;
FCachedFullName : pstring;
procedure SetSecOptions(Aoptions:TObjSectionOptions);
public
ObjData : TObjData;
@ -158,7 +160,7 @@ interface
ObjSymbolDefines : TFPObjectList;
{ executable linking }
ExeSection : TExeSection;
Used : boolean;
USed : Boolean;
VTRefList : TFPObjectList;
constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);virtual;
destructor destroy;override;
@ -262,15 +264,14 @@ interface
FCObjData : TObjDataClass;
protected
{ reader }
FReader : TObjectreader;
function readObjData(Data:TObjData):boolean;virtual;abstract;
FReader : TObjectReader;
InputFileName : string;
property CObjData : TObjDataClass read FCObjData write FCObjData;
public
constructor create;virtual;
destructor destroy;override;
function newObjData(const n:string):TObjData;
function readobjectfile(const fn:string;Data:TObjData):boolean;virtual;
property Reader:TObjectReader read FReader;
function ReadObjData(AReader:TObjectreader;Data:TObjData):boolean;virtual;abstract;
procedure inputerror(const s : string);
end;
TObjInputClass=class of TObjInput;
@ -300,9 +301,12 @@ interface
function VTableRef(VTableIdx:Longint):TObjRelocation;
end;
TSymbolState = (symstate_undefined,symstate_defined,symstate_common);
TExeSymbol = class(TFPHashObject)
ObjSymbol : TObjSymbol;
ExeSection : TExeSection;
State : TSymbolState;
{ Used for vmt references optimization }
VTable : TExeVTable;
end;
@ -325,11 +329,22 @@ interface
end;
TExeSectionClass=class of TExeSection;
TStaticLibrary = class(TFPHashObject)
private
FArReader : TObjectReader;
FObjInputClass : TObjInputClass;
public
constructor create(AList:TFPHashObjectList;const AName:string;AReader:TObjectReader;AObjInputClass:TObjInputClass);
destructor destroy;override;
property ArReader:TObjectReader read FArReader;
property ObjInputClass:TObjInputClass read FObjInputClass;
end;
TExternalLibrary = class(TFPHashObject)
private
FExternalSymbolList : TFPHashObjectList;
public
constructor create(AList:TFPHashObjectList;const AName:string);virtual;
constructor create(AList:TFPHashObjectList;const AName:string);
destructor destroy;override;
property ExternalSymbolList:TFPHashObjectList read FExternalSymbolList;
end;
@ -391,7 +406,8 @@ interface
procedure CalcPos_Start;virtual;
procedure CalcPos_Symbols;virtual;
procedure BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
procedure ResolveSymbols;
procedure PackUnresolvedExeSymbols(const s:string);
procedure ResolveSymbols(StaticLibraryList:TFPHashObjectList);
procedure PrintMemoryMap;
procedure FixupSymbols;
procedure FixupRelocations;
@ -423,7 +439,7 @@ interface
implementation
uses
cutils,globals,verbose,fmodule,ogmap;
globals,verbose,fmodule,ogmap;
const
sectionDatagrowsize = 256-sizeof(ptrint);
@ -669,15 +685,24 @@ implementation
ObjRelocations:=nil;
ObjSymbolDefines.Free;
ObjSymbolDefines:=nil;
if assigned(FCachedFullName) then
begin
stringdispose(FCachedFullName);
FCachedFullName:=nil;
end;
end;
function TObjSection.FullName:string;
begin
if assigned(ObjData) then
result:=ObjData.Name+'('+Name+')'
else
result:=Name;
if not assigned(FCachedFullName) then
begin
if assigned(ObjData) then
FCachedFullName:=stringdup(ObjData.Name+'('+Name+')')
else
FCachedFullName:=stringdup(Name);
end;
result:=FCachedFullName^;
end;
@ -1104,7 +1129,7 @@ implementation
constructor TExeVTable.Create(AExeSymbol:TExeSymbol);
begin
ExeSymbol:=AExeSymbol;
if not assigned(ExeSymbol.ObjSymbol) then
if ExeSymbol.State=symstate_undefined then
internalerror(200604012);
ChildList:=TFPObjectList.Create(false);
end;
@ -1234,6 +1259,25 @@ implementation
end;
{****************************************************************************
TStaticLibrary
****************************************************************************}
constructor TStaticLibrary.create(AList:TFPHashObjectList;const AName:string;AReader:TObjectReader;AObjInputClass:TObjInputClass);
begin
inherited create(AList,AName);
FArReader:=AReader;
FObjInputClass:=AObjInputClass;
end;
destructor TStaticLibrary.destroy;
begin
ArReader.Free;
inherited destroy;
end;
{****************************************************************************
TExternalLibrary
****************************************************************************}
@ -1352,8 +1396,18 @@ implementation
procedure TExeOutput.Load_ImageBase(const avalue:string);
var
code : integer;
objsec : TObjSection;
objsym : TObjSymbol;
exesym : TExeSymbol;
begin
val(avalue,ImageBase,code);
{ Create __image_base__ symbol, create the symbol
in a section with adress 0 and at offset 0 }
objsec:=internalObjData.createsection('*__image_base__',0,[]);
internalObjData.setsection(objsec);
objsym:=internalObjData.SymbolDefine('__image_base__',AB_GLOBAL,AT_FUNCTION);
exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
exesym.ObjSymbol:=objsym;
end;
@ -1395,24 +1449,45 @@ implementation
end;
function ObjSectionNameCompare(Item1, Item2: Pointer): Integer;
var
I1 : TObjSection absolute Item1;
I2 : TObjSection absolute Item2;
begin
//writeln(I1.FullName);
Result:=CompareStr(I1.FullName,I2.FullName);
end;
procedure TExeOutput.Order_ObjSection(const aname:string);
var
i,j : longint;
ObjData : TObjData;
objsec : TObjSection;
TmpObjSectionList : TFPObjectList;
begin
if not assigned(CurrExeSec) then
internalerror(200602181);
TmpObjSectionList:=TFPObjectList.Create(false);
for i:=0 to ObjDataList.Count-1 do
begin
ObjData:=TObjData(ObjDataList[i]);
for j:=0 to ObjData.ObjSectionList.Count-1 do
begin
objsec:=TObjSection(ObjData.ObjSectionList[j]);
if MatchPattern(aname,objsec.name) then
CurrExeSec.AddObjSection(objsec);
if (not objsec.Used) and
MatchPattern(aname,objsec.name) then
TmpObjSectionList.Add(objsec);
end;
end;
{ Sort list if needed }
TmpObjSectionList.Sort(@ObjSectionNameCompare);
{ Add the (sorted) list to the current ExeSection }
for i:=0 to TmpObjSectionList.Count-1 do
begin
objsec:=TObjSection(TmpObjSectionList[i]);
CurrExeSec.AddObjSection(objsec);
end;
end;
@ -1591,92 +1666,180 @@ implementation
end;
procedure TExeOutput.ResolveSymbols;
procedure TExeOutput.PackUnresolvedExeSymbols(const s:string);
var
i : longint;
exesym : TExeSymbol;
begin
{ Generate a list of Unresolved External symbols }
for i:=0 to UnresolvedExeSymbols.count-1 do
begin
exesym:=TExeSymbol(UnresolvedExeSymbols[i]);
if exesym.State<>symstate_undefined then
UnresolvedExeSymbols[i]:=nil;
end;
UnresolvedExeSymbols.Pack;
Comment(V_Debug,'Number of unresolved externals '+s+' '+tostr(UnresolvedExeSymbols.Count));
end;
procedure TExeOutput.ResolveSymbols(StaticLibraryList:TFPHashObjectList);
var
ObjData : TObjData;
exesym : TExeSymbol;
objsym,
commonsym : TObjSymbol;
objinput : TObjInput;
StaticLibrary : TStaticLibrary;
firstarchive,
firstcommon : boolean;
i,j : longint;
hs : string;
VTEntryList,
VTInheritList : TFPObjectList;
procedure LoadObjDataSymbols(ObjData:TObjData);
var
j : longint;
hs : string;
exesym : TExeSymbol;
objsym : TObjSymbol;
begin
for j:=0 to ObjData.ObjSymbolList.Count-1 do
begin
objsym:=TObjSymbol(ObjData.ObjSymbolList[j]);
{ From the local symbols we are only interressed in the
VTENTRY and VTINHERIT symbols }
if objsym.bind=AB_LOCAL then
begin
if cs_link_opt_vtable in aktglobalswitches then
begin
hs:=objsym.name;
if (hs[1]='V') then
begin
if Copy(hs,1,5)='VTREF' then
begin
if not assigned(objsym.ObjSection.VTRefList) then
objsym.ObjSection.VTRefList:=TFPObjectList.Create(false);
objsym.ObjSection.VTRefList.Add(objsym);
end
else if Copy(hs,1,7)='VTENTRY' then
VTEntryList.Add(objsym)
else if Copy(hs,1,9)='VTINHERIT' then
VTInheritList.Add(objsym);
end;
end;
continue;
end;
{ Search for existing exesymbol }
exesym:=texesymbol(FExeSymbolList.Find(objsym.name));
if not assigned(exesym) then
begin
exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
exesym.ObjSymbol:=objsym;
end;
objsym.ExeSymbol:=exesym;
case objsym.bind of
AB_GLOBAL :
begin
if exesym.State<>symstate_defined then
begin
exesym.ObjSymbol:=objsym;
exesym.State:=symstate_defined;
end
else
Comment(V_Error,'Multiple defined symbol '+objsym.name);
end;
AB_EXTERNAL :
begin
ExternalObjSymbols.add(objsym);
{ Register unresolved symbols only the first time they
are registered }
if exesym.ObjSymbol=objsym then
UnresolvedExeSymbols.Add(exesym);
end;
AB_COMMON :
begin
if exesym.State=symstate_undefined then
begin
exesym.ObjSymbol:=objsym;
exesym.State:=symstate_common;
end;
CommonObjSymbols.add(objsym);
end;
end;
end;
end;
begin
VTEntryList:=TFPObjectList.Create(false);
VTInheritList:=TFPObjectList.Create(false);
{
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
The symbol resolving is done in 3 steps:
1. Register symbols from objects
2. Find symbols in static libraries
3. Define stil undefined common symbols
}
{ Step 1, Register symbols }
{ Step 1, Register symbols from objects }
for i:=0 to ObjDataList.Count-1 do
begin
ObjData:=TObjData(ObjDataList[i]);
for j:=0 to ObjData.ObjSymbolList.Count-1 do
LoadObjDataSymbols(ObjData);
end;
PackUnresolvedExeSymbols('in objects');
{ Step 2, Find unresolved symbols in the libraries }
firstarchive:=true;
for i:=0 to StaticLibraryList.Count-1 do
begin
StaticLibrary:=TStaticLibrary(StaticLibraryList[i]);
{ Process list of Unresolved External symbols, we need
to use a while loop because the list can be extended when
we load members from the library. }
j:=0;
while (j<UnresolvedExeSymbols.count) do
begin
objsym:=TObjSymbol(ObjData.ObjSymbolList[j]);
{ From the local symbols we are only interressed in the
VTENTRY and VTINHERIT symbols }
if objsym.bind=AB_LOCAL then
exesym:=TExeSymbol(UnresolvedExeSymbols[j]);
{ Check first if the symbol is still undefined }
if exesym.State=symstate_undefined then
begin
if cs_link_opt_vtable in aktglobalswitches then
if StaticLibrary.ArReader.OpenFile(exesym.name) then
begin
hs:=objsym.name;
if (hs[1]='V') then
if assigned(exemap) then
begin
if Copy(hs,1,5)='VTREF' then
if firstarchive then
begin
if not assigned(objsym.ObjSection.VTRefList) then
objsym.ObjSection.VTRefList:=TFPObjectList.Create(false);
objsym.ObjSection.VTRefList.Add(objsym);
end
else if Copy(hs,1,7)='VTENTRY' then
VTEntryList.Add(objsym)
else if Copy(hs,1,9)='VTINHERIT' then
VTInheritList.Add(objsym);
exemap.Add('');
exemap.Add('Archive member included because of file (symbol)');
exemap.Add('');
firstarchive:=false;
end;
exemap.Add(StaticLibrary.ArReader.FileName+' - '+{exesym.ObjSymbol.ObjSection.FullName+}'('+exesym.Name+')');
end;
objinput:=StaticLibrary.ObjInputClass.Create;
objdata:=objinput.newObjData(StaticLibrary.ArReader.FileName);
objinput.ReadObjData(StaticLibrary.ArReader,objdata);
objinput.free;
AddObjData(objdata);
LoadObjDataSymbols(objdata);
StaticLibrary.ArReader.CloseFile;
end;
continue;
end;
{ Search for existing exesymbol }
exesym:=texesymbol(FExeSymbolList.Find(objsym.name));
if not assigned(exesym) then
exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
{ Defining the symbol? }
if objsym.bind=AB_GLOBAL then
begin
if not assigned(exesym.ObjSymbol) then
exesym.ObjSymbol:=objsym
else
Comment(V_Error,'Multiple defined symbol '+objsym.name);
end;
objsym.exesymbol:=exesym;
case objsym.bind of
AB_EXTERNAL :
ExternalObjSymbols.add(objsym);
AB_COMMON :
CommonObjSymbols.add(objsym);
end;
end;
inc(j);
end;
end;
PackUnresolvedExeSymbols('after static libraries');
{ Step 2, Match common symbols or add to the globals }
{ Step 3, Match common symbols or add to the globals }
firstcommon:=true;
for i:=0 to CommonObjSymbols.count-1 do
begin
objsym:=TObjSymbol(CommonObjSymbols[i]);
if assigned(objsym.exesymbol.objsymbol) then
if objsym.exesymbol.State=symstate_defined then
begin
if objsym.exesymbol.ObjSymbol.size<>objsym.size then
internalerror(200206301);
Comment(V_Debug,'Size of common symbol '+objsym.name+' is different, expected '+tostr(objsym.size)+' got '+tostr(objsym.exesymbol.ObjSymbol.size));
end
else
begin
@ -1695,18 +1858,11 @@ implementation
if assigned(exemap) then
exemap.AddCommonSymbol(commonsym);
{ Assign to the exesymbol }
objsym.exesymbol.objsymbol:=commonsym
objsym.exesymbol.objsymbol:=commonsym;
objsym.exesymbol.state:=symstate_defined;
end;
end;
{ Generate a list of Unresolved External symbols }
for i:=0 to ExeSymbolList.count-1 do
begin
exesym:=TExeSymbol(ExeSymbolList[i]);
if exesym.objsymbol=nil then
UnresolvedExeSymbols.Add(exesym);
end;
Comment(V_Debug,'Number of unresolved externals in objects '+tostr(UnresolvedExeSymbols.Count));
PackUnresolvedExeSymbols('after defining COMMON symbols');
{ Find entry symbol and print in map }
exesym:=texesymbol(ExeSymbolList.Find(EntryName));
@ -1764,10 +1920,29 @@ implementation
procedure TExeOutput.FixupSymbols;
procedure UpdateSymbol(objsym:TObjSymbol);
begin
objsym.bind:=objsym.ExeSymbol.ObjSymbol.bind;
objsym.offset:=objsym.ExeSymbol.ObjSymbol.offset;
objsym.size:=objsym.ExeSymbol.ObjSymbol.size;
objsym.typ:=objsym.ExeSymbol.ObjSymbol.typ;
objsym.ObjSection:=objsym.ExeSymbol.ObjSymbol.ObjSection;
end;
var
i : longint;
sym : TObjSymbol;
i : longint;
objsym : TObjSymbol;
exesym : TExeSymbol;
begin
{ Print list of Unresolved External symbols }
for i:=0 to UnresolvedExeSymbols.count-1 do
begin
exesym:=TExeSymbol(UnresolvedExeSymbols[i]);
if exesym.State<>symstate_defined then
Comment(V_Error,'Undefined symbol: '+exesym.name);
end;
{ Update ImageBase to ObjData so it can access from ObjSymbols }
for i:=0 to ObjDataList.Count-1 do
TObjData(ObjDataList[i]).imagebase:=imagebase;
@ -1781,36 +1956,19 @@ implementation
{ Step 1, Update commons }
for i:=0 to CommonObjSymbols.count-1 do
begin
sym:=TObjSymbol(CommonObjSymbols[i]);
if sym.bind=AB_COMMON then
begin
{ update this symbol }
sym.bind:=sym.exesymbol.ObjSymbol.bind;
sym.offset:=sym.exesymbol.ObjSymbol.offset;
sym.size:=sym.exesymbol.ObjSymbol.size;
sym.typ:=sym.exesymbol.ObjSymbol.typ;
sym.ObjSection:=sym.exesymbol.ObjSymbol.ObjSection;
end;
objsym:=TObjSymbol(CommonObjSymbols[i]);
if objsym.bind<>AB_COMMON then
internalerror(200606241);
UpdateSymbol(objsym);
end;
{ Step 2, Update externals }
for i:=0 to ExternalObjSymbols.count-1 do
begin
sym:=TObjSymbol(ExternalObjSymbols[i]);
if sym.bind=AB_EXTERNAL then
begin
if assigned(sym.exesymbol.ObjSymbol) then
begin
{ update this symbol }
sym.bind:=sym.exesymbol.ObjSymbol.bind;
sym.offset:=sym.exesymbol.ObjSymbol.offset;
sym.size:=sym.exesymbol.ObjSymbol.size;
sym.typ:=sym.exesymbol.ObjSymbol.typ;
sym.ObjSection:=sym.exesymbol.ObjSymbol.ObjSection;
end
else
Comment(V_Error,'Undefined symbol: '+sym.name);
end;
objsym:=TObjSymbol(ExternalObjSymbols[i]);
if objsym.bind<>AB_EXTERNAL then
internalerror(200606242);
UpdateSymbol(objsym);
end;
end;
@ -2024,7 +2182,7 @@ implementation
if objsym.bind<>AB_LOCAL then
begin
if not(assigned(objsym.exesymbol) and
assigned(objsym.exesymbol.objsymbol)) then
(objsym.exesymbol.State=symstate_defined)) then
internalerror(200603063);
objsym:=objsym.exesymbol.objsymbol;
end;
@ -2185,14 +2343,11 @@ implementation
constructor TObjInput.create;
begin
{ init reader }
FReader:=TObjectreader.create;
end;
destructor TObjInput.destroy;
begin
FReader.free;
inherited destroy;
end;
@ -2203,20 +2358,9 @@ implementation
end;
function TObjInput.readobjectfile(const fn:string;Data:TObjData):boolean;
begin
result:=false;
{ start the reader }
if FReader.openfile(fn) then
begin
result:=readObjData(Data);
FReader.closefile;
end;
end;
procedure TObjInput.inputerror(const s : string);
begin
Comment(V_Error,s+' while reading '+reader.filename);
Comment(V_Error,s+' while reading '+InputFileName);
end;

202
compiler/ogcoff.pas
View File

@ -188,11 +188,10 @@ interface
procedure read_symbols(objdata:TObjData);
procedure ObjSections_read_data(p:TObject;arg:pointer);
procedure ObjSections_read_relocs(p:TObject;arg:pointer);
protected
function readObjData(objdata:TObjData):boolean;override;
public
constructor createcoff(awin32:boolean);
destructor destroy;override;
function ReadObjData(AReader:TObjectreader;objdata:TObjData):boolean;override;
end;
TDJCoffObjInput = class(TCoffObjInput)
@ -266,16 +265,6 @@ interface
constructor create(smart:boolean);override;
end;
TDJCofflinker = class(tinternallinker)
constructor create;override;
procedure DefaultLinkScript;override;
end;
TPECofflinker = class(tinternallinker)
constructor create;override;
procedure DefaultLinkScript;override;
end;
type
Treaddllproc = procedure(const dllname,funcname:string) of object;
@ -1736,8 +1725,8 @@ const pemagic : array[0..3] of byte = (
if assigned(data) then
begin
Reader.Seek(datapos);
if not Reader.ReadArray(data,Size) then
FReader.Seek(datapos);
if not FReader.ReadArray(data,Size) then
begin
Comment(V_Error,'Error reading coff file, can''t read object data');
exit;
@ -1758,14 +1747,14 @@ const pemagic : array[0..3] of byte = (
if coffrelocs>0 then
begin
Reader.Seek(coffrelocpos);
FReader.Seek(coffrelocpos);
read_relocs(TCoffObjSection(p));
end;
end;
end;
function TCoffObjInput.readObjData(objdata:TObjData):boolean;
function TCoffObjInput.ReadObjData(AReader:TObjectreader;objdata:TObjData):boolean;
var
secalign : shortint;
strsize,
@ -1779,37 +1768,39 @@ const pemagic : array[0..3] of byte = (
secname : string;
secnamebuf : array[0..15] of char;
begin
FReader:=AReader;
InputFileName:=AReader.FileName;
result:=false;
FCoffSyms:=TDynamicArray.Create(symbolresize);
FCoffStrs:=TDynamicArray.Create(strsresize);
with TCoffObjData(objdata) do
begin
{ Read COFF header }
if not reader.read(header,sizeof(tcoffheader)) then
if not AReader.read(header,sizeof(tcoffheader)) then
begin
Comment(V_Error,'Error reading coff file, can''t read header: '+reader.filename);
InputError('Can''t read COFF Header');
exit;
end;
if header.mach<>COFF_MAGIC then
begin
Comment(V_Error,'Not a coff file, illegal magic: '+reader.filename);
InputError('Illegal COFF Magic');
exit;
end;
{ Strings }
Reader.Seek(header.sympos+header.syms*sizeof(CoffSymbol));
if not Reader.Read(strsize,4) then
AReader.Seek(header.sympos+header.syms*sizeof(CoffSymbol));
if not AReader.Read(strsize,4) then
begin
Comment(V_Error,'Error reading coff file');
InputError('Error reading COFF Symtable');
exit;
end;
if strsize<4 then
begin
Comment(V_Error,'Error reading coff file');
InputError('Error reading COFF Symtable');
exit;
end;
if not Reader.ReadArray(FCoffStrs,Strsize-4) then
if not AReader.ReadArray(FCoffStrs,Strsize-4) then
begin
Comment(V_Error,'Error reading coff file: '+reader.filename);
InputError('Error reading COFF Symtable');
exit;
end;
{ Section headers }
@ -1817,12 +1808,12 @@ const pemagic : array[0..3] of byte = (
FSecCount:=header.nsects;
GetMem(FSecTbl,(header.nsects+1)*sizeof(TObjSection));
FillChar(FSecTbl^,(header.nsects+1)*sizeof(TObjSection),0);
reader.Seek(sizeof(tcoffheader)+header.opthdr);
AReader.Seek(sizeof(tcoffheader)+header.opthdr);
for i:=1 to header.nsects do
begin
if not reader.read(sechdr,sizeof(sechdr)) then
if not AReader.read(sechdr,sizeof(sechdr)) then
begin
Comment(V_Error,'Error reading coff file, can''t read section header: '+reader.filename);
InputError('Error reading COFF Section Headers');
exit;
end;
move(sechdr.name,secnamebuf,8);
@ -1835,7 +1826,7 @@ const pemagic : array[0..3] of byte = (
secname:=Read_str(strpos)
else
begin
Comment(V_Error,'Error reading section headers coff file');
InputError('Error reading COFF Section Headers');
secname:='error';
end;
end;
@ -1863,8 +1854,8 @@ const pemagic : array[0..3] of byte = (
objsec.Size:=sechdr.dataSize;
end;
{ ObjSymbols }
Reader.Seek(header.sympos);
if not Reader.ReadArray(FCoffSyms,header.syms*sizeof(CoffSymbol)) then
AReader.Seek(header.sympos);
if not AReader.ReadArray(FCoffSyms,header.syms*sizeof(CoffSymbol)) then
begin
Comment(V_Error,'Error reading coff file');
exit;
@ -1930,11 +1921,6 @@ const pemagic : array[0..3] of byte = (
begin
inherited create;
win32:=awin32;
if win32 then
if target_info.system in [system_arm_wince] then
imagebase:=$10000
else
imagebase:=$400000;
end;
@ -1961,6 +1947,7 @@ const pemagic : array[0..3] of byte = (
procedure TCoffexeoutput.globalsyms_write_symbol(p:TObject;arg:pointer);
var
secval,
value : aint;
globalval : byte;
exesec : TExeSection;
@ -1970,18 +1957,24 @@ const pemagic : array[0..3] of byte = (
with texesymbol(p).objsymbol do
begin
exesec:=TExeSection(objsection.exesection);
if not assigned(exesec) then
{ There is no exesection defined for special internal symbols
like __image_base__ }
if assigned(exesec) then
begin
Comment(V_Error, 'Section ' + objsection.FullName + ' does not supported.');
exit;
secval:=exesec.secsymidx;
value:=address-exesec.mempos;
end
else
begin
secval:=-1;
value:=address;
end;
if bind=AB_LOCAL then
globalval:=3
else
globalval:=2;
{ reloctype address to the section in the executable }
value:=address-exesec.mempos;
write_symbol(name,value,exesec.secsymidx,globalval,0);
write_symbol(name,value,secval,globalval,0);
end;
end;
@ -2326,9 +2319,9 @@ const pemagic : array[0..3] of byte = (
emptyint : longint;
begin
emptyint:=0;
idata4objsection:=internalobjdata.createsection(sec_idata4, 'end_'+basedllname);
idata4objsection:=internalobjdata.createsection(sec_idata4, basedllname+'_z_');
internalobjdata.SymbolDefine('__imp_names_end_'+basedllname,AB_LOCAL,AT_DATA);
idata5objsection:=internalobjdata.createsection(sec_idata5, 'end_'+basedllname);
idata5objsection:=internalobjdata.createsection(sec_idata5, basedllname+'_z_');
internalobjdata.SymbolDefine('__imp_fixup_end_'+basedllname,AB_LOCAL,AT_DATA);
{ idata4 }
internalobjdata.SetSection(idata4objsection);
@ -2368,6 +2361,7 @@ const pemagic : array[0..3] of byte = (
idata5label,
idata6label : TObjSymbol;
emptyint : longint;
secname,
num : string;
begin
result:=nil;
@ -2376,10 +2370,13 @@ const pemagic : array[0..3] of byte = (
exemap.Add(' Importing Function '+afuncname);
with internalobjdata do
textobjsection:=createsection(sectionname(sec_code,'__'+afuncname),sectiontype2align(sec_code),sectiontype2options(sec_code) - [oso_keep]);
idata4objsection:=internalobjdata.createsection(sec_idata4, afuncname);
idata5objsection:=internalobjdata.createsection(sec_idata5, afuncname);
idata6objsection:=internalobjdata.createsection(sec_idata6, afuncname);
begin
secname:=basedllname+'_i_'+afuncname;
textobjsection:=createsection(sectionname(sec_code,secname),sectiontype2align(sec_code),sectiontype2options(sec_code) - [oso_keep]);
idata4objsection:=createsection(sec_idata4, secname);
idata5objsection:=createsection(sec_idata5, secname);
idata6objsection:=createsection(sec_idata6, secname);
end;
{ idata6, import data (ordnr+name) }
internalobjdata.SetSection(idata6objsection);
@ -2433,16 +2430,18 @@ const pemagic : array[0..3] of byte = (
ExtSymbol:=TFPHashObject(ExtLibrary.ExternalSymbolList[j]);
exesym:=TExeSymbol(ExeSymbolList.Find(ExtSymbol.Name));
if assigned(exesym) and
not assigned(exesym.objsymbol) then
(exesym.State<>symstate_defined) then
begin
if not assigned(idata2objsection) then
StartImport(ExtLibrary.Name);
exesym.objsymbol:=AddProcImport(ExtSymbol.Name);
exesym.State:=symstate_defined;
end;
end;
if assigned(idata2objsection) then
EndImport;
end;
PackUnresolvedExeSymbols('after DLL imports');
end;
@ -2468,113 +2467,6 @@ const pemagic : array[0..3] of byte = (
end;
{****************************************************************************
TCoffLinker
****************************************************************************}
constructor TDJCoffLinker.Create;
begin
inherited Create;
CExeoutput:=TDJCoffexeoutput;
CObjInput:=TDJCoffObjInput;
end;
procedure TDJCoffLinker.DefaultLinkScript;
begin
end;
constructor TPECoffLinker.Create;
begin
inherited Create;
CExeoutput:=TPECoffexeoutput;
CObjInput:=TPECoffObjInput;
end;
procedure TPECoffLinker.DefaultLinkScript;
var
ibase: string;
begin
with LinkScript do
begin
Concat('READUNITOBJECTS');
if assigned(DLLImageBase) then
ibase:=DLLImageBase^
else
ibase:='';
if IsSharedLibrary then
begin
if ibase = '' then
ibase:='10000000';
Concat('ISSHAREDLIBRARY');
if apptype=app_gui then
Concat('ENTRYNAME _DLLWinMainCRTStartup')
else
Concat('ENTRYNAME _DLLMainCRTStartup');
end
else
begin
if apptype=app_gui then
Concat('ENTRYNAME _WinMainCRTStartup')
else
Concat('ENTRYNAME _mainCRTStartup');
end;
if ibase <> '' then
Concat('IMAGEBASE $' + ibase);
Concat('HEADER');
Concat('EXESECTION .text');
{$ifdef arm}
Concat(' OBJSECTION .pdata.FPC_EH_PROLOG');
{$endif arm}
Concat(' OBJSECTION .text*');
Concat(' SYMBOL etext');
Concat('ENDEXESECTION');
Concat('EXESECTION .data');
Concat(' SYMBOL __data_start__');
Concat(' OBJSECTION .data*');
Concat(' SYMBOL edata');
Concat(' SYMBOL __data_end__');
Concat('ENDEXESECTION');
Concat('EXESECTION .rdata');
Concat(' OBJSECTION .rodata*');
Concat('ENDEXESECTION');
Concat('EXESECTION .pdata');
Concat(' OBJSECTION .pdata');
Concat('ENDEXESECTION');
Concat('EXESECTION .bss');
Concat(' SYMBOL __bss_start__');
Concat(' OBJSECTION .bss*');
Concat(' SYMBOL __bss_end__');
Concat('ENDEXESECTION');
Concat('EXESECTION .idata');
Concat(' OBJSECTION .idata$2*');
Concat(' OBJSECTION .idata$3*');
Concat(' ZEROS 20');
Concat(' OBJSECTION .idata$4*');
Concat(' OBJSECTION .idata$5*');
Concat(' OBJSECTION .idata$6*');
Concat(' OBJSECTION .idata$7*');
Concat('ENDEXESECTION');
Concat('EXESECTION .edata');
Concat(' OBJSECTION .edata*');
Concat('ENDEXESECTION');
Concat('EXESECTION .rsrc');
Concat(' OBJSECTION .rsrc*');
Concat('ENDEXESECTION');
Concat('EXESECTION .stab');
Concat(' OBJSECTION .stab');
Concat('ENDEXESECTION');
Concat('EXESECTION .stabstr');
Concat(' OBJSECTION .stabstr');
Concat('ENDEXESECTION');
Concat('STABS');
Concat('SYMBOLS');
end;
end;
{*****************************************************************************
DLLReader
*****************************************************************************}

642
compiler/owar.pas
View File

@ -61,226 +61,464 @@ type
procedure writear;
end;
tarobjectreader=class(tobjectreader)
private
ArSymbols : TFPHashObjectList;
LFNStrs : PChar;
LFNSize : longint;
CurrMemberPos,
CurrMemberSize : longint;
CurrMemberName : string;
function DecodeMemberName(ahdr:TArHdr):string;
function DecodeMemberSize(ahdr:TArHdr):longint;
procedure ReadArchive;
protected
function getfilename:string;override;
public
constructor create(const Aarfn:string);
destructor destroy;override;
function openfile(const fn:string):boolean;override;
procedure closefile;override;
procedure seek(len:longint);override;
end;
implementation
uses
cstreams,
systems,
globals,
verbose,
dos;
uses
cstreams,
systems,
globals,
verbose,
dos;
const
symrelocbufsize = 4096;
symstrbufsize = 8192;
lfnstrbufsize = 4096;
arbufsize = 65536;
armagic:array[1..8] of char='!<arch>'#10;
type
TArSymbol = class(TFPHashObject)
MemberPos : longint;
end;
const
symrelocbufsize = 4096;
symstrbufsize = 8192;
lfnstrbufsize = 4096;
arbufsize = 65536;
{*****************************************************************************
Helpers
*****************************************************************************}
const
C1970=2440588;
D0=1461;
D1=146097;
D2=1721119;
Function Gregorian2Julian(DT:DateTime):LongInt;
Var
Century,XYear,Month : LongInt;
Begin
Month:=DT.Month;
If Month<=2 Then
Begin
Dec(DT.Year);
Inc(Month,12);
End;
Dec(Month,3);
Century:=(longint(DT.Year Div 100)*D1) shr 2;
XYear:=(longint(DT.Year Mod 100)*D0) shr 2;
Gregorian2Julian:=((((Month*153)+2) div 5)+DT.Day)+D2+XYear+Century;
End;
const
C1970=2440588;
D0=1461;
D1=146097;
D2=1721119;
Function Gregorian2Julian(DT:DateTime):LongInt;
Var
Century,XYear,Month : LongInt;
Begin
Month:=DT.Month;
If Month<=2 Then
Begin
Dec(DT.Year);
Inc(Month,12);
End;
Dec(Month,3);
Century:=(longint(DT.Year Div 100)*D1) shr 2;
XYear:=(longint(DT.Year Mod 100)*D0) shr 2;
Gregorian2Julian:=((((Month*153)+2) div 5)+DT.Day)+D2+XYear+Century;
End;
function DT2Unix(DT:DateTime):LongInt;
Begin
DT2Unix:=(Gregorian2Julian(DT)-C1970)*86400+(LongInt(DT.Hour)*3600)+(DT.Min*60)+DT.Sec;
end;
function DT2Unix(DT:DateTime):LongInt;
Begin
DT2Unix:=(Gregorian2Julian(DT)-C1970)*86400+(LongInt(DT.Hour)*3600)+(DT.Min*60)+DT.Sec;
end;
function lsb2msb(l:longint):longint;
type
bytearr=array[0..3] of byte;
begin
{$ifndef FPC_BIG_ENDIAN}
bytearr(result)[0]:=bytearr(l)[3];
bytearr(result)[1]:=bytearr(l)[2];
bytearr(result)[2]:=bytearr(l)[1];
bytearr(result)[3]:=bytearr(l)[0];
{$else}
result:=l;
{$endif}
end;
{*****************************************************************************
TArObjectWriter
*****************************************************************************}
constructor tarobjectwriter.create(const Aarfn:string);
var
time : datetime;
dummy : word;
begin
arfn:=Aarfn;
ardata:=TDynamicArray.Create(arbufsize);
symreloc:=TDynamicArray.Create(symrelocbufsize);
symstr:=TDynamicArray.Create(symstrbufsize);
lfnstr:=TDynamicArray.Create(lfnstrbufsize);
{ create timestamp }
getdate(time.year,time.month,time.day,dummy);
gettime(time.hour,time.min,time.sec,dummy);
Str(DT2Unix(time),timestamp);
end;
destructor tarobjectwriter.destroy;
begin
if Errorcount=0 then
writear;
arData.Free;
symreloc.Free;
symstr.Free;
lfnstr.Free;
end;
procedure tarobjectwriter.createarhdr(fn:string;asize:longint;const gid,uid,mode:string);
var
tmp : string[9];
hfn : string;
begin
fillchar(arhdr,sizeof(tarhdr),' ');
{ create ar header }
{ win32 will change names starting with .\ to ./ when using lfn, corrupting
the sort order required for the idata sections. To prevent this strip
always the path from the filename. (PFV) }
hfn:=SplitFileName(fn);
if hfn='' then
hfn:=fn;
fn:=hfn+'/';
if length(fn)>16 then
begin
arhdr.name[0]:='/';
str(lfnstr.size,tmp);
move(tmp[1],arhdr.name[1],length(tmp));
fn:=fn+#10;
lfnstr.write(fn[1],length(fn));
end
else
move(fn[1],arhdr.name,length(fn));
{ don't write a date if also no gid/uid/mode is specified }
if gid<>'' then
move(timestamp[1],arhdr.date,length(timestamp));
str(asize,tmp);
move(tmp[1],arhdr.size,length(tmp));
move(gid[1],arhdr.gid,length(gid));
move(uid[1],arhdr.uid,length(uid));
move(mode[1],arhdr.mode,length(mode));
arhdr.fmag:='`'#10;
end;
function tarobjectwriter.createfile(const fn:string):boolean;
begin
objfn:=fn;
objpos:=ardata.size;
ardata.seek(objpos + sizeof(tarhdr));
createfile:=true;
fobjsize:=0;
end;
procedure tarobjectwriter.closefile;
begin
ardata.align(2);
{ fix the size in the header }
createarhdr(objfn,ardata.size-objpos-sizeof(tarhdr),'42','42','644');
{ write the header }
ardata.seek(objpos);
ardata.write(arhdr,sizeof(tarhdr));
fobjsize:=0;
end;
procedure tarobjectwriter.writesym(const sym:string);
var
c : char;
begin
c:=#0;
symreloc.write(objpos,4);
symstr.write(sym[1],length(sym));
symstr.write(c,1);
end;
procedure tarobjectwriter.write(const b;len:longint);
begin
inc(fobjsize,len);
inc(fsize,len);
ardata.write(b,len);
end;
procedure tarobjectwriter.writear;
function lsb2msb(l:longint):longint;
type
bytearr=array[0..3] of byte;
var
l1 : longint;
begin
bytearr(l1)[0]:=bytearr(l)[3];
bytearr(l1)[1]:=bytearr(l)[2];
bytearr(l1)[2]:=bytearr(l)[1];
bytearr(l1)[3]:=bytearr(l)[0];
lsb2msb:=l1;
end;
const
armagic:array[1..8] of char='!<arch>'#10;
var
arf : TCFileStream;
fixup,l,
relocs,i : longint;
begin
arf:=TCFileStream.Create(arfn,fmCreate);
if CStreamError<>0 then
begin
Message1(exec_e_cant_create_archivefile,arfn);
exit;
end;
arf.Write(armagic,sizeof(armagic));
{ align first, because we need the size for the fixups of the symbol reloc }
if lfnstr.size>0 then
lfnstr.align(2);
if symreloc.size>0 then
begin
symstr.align(2);
fixup:=12+sizeof(tarhdr)+symreloc.size+symstr.size;
if lfnstr.size>0 then
inc(fixup,lfnstr.size+sizeof(tarhdr));
relocs:=symreloc.size div 4;
{ fixup relocs }
for i:=0to relocs-1 do
constructor tarobjectwriter.create(const Aarfn:string);
var
time : datetime;
dummy : word;
begin
symreloc.seek(i*4);
symreloc.read(l,4);
symreloc.seek(i*4);
l:=lsb2msb(l+fixup);
symreloc.write(l,4);
arfn:=Aarfn;
ardata:=TDynamicArray.Create(arbufsize);
symreloc:=TDynamicArray.Create(symrelocbufsize);
symstr:=TDynamicArray.Create(symstrbufsize);
lfnstr:=TDynamicArray.Create(lfnstrbufsize);
{ create timestamp }
getdate(time.year,time.month,time.day,dummy);
gettime(time.hour,time.min,time.sec,dummy);
Str(DT2Unix(time),timestamp);
end;
createarhdr('',4+symreloc.size+symstr.size,'0','0','0');
arf.Write(arhdr,sizeof(tarhdr));
relocs:=lsb2msb(relocs);
arf.Write(relocs,4);
symreloc.WriteStream(arf);
symstr.WriteStream(arf);
end;
if lfnstr.size>0 then
begin
createarhdr('/',lfnstr.size,'','','');
arf.Write(arhdr,sizeof(tarhdr));
lfnstr.WriteStream(arf);
end;
ardata.WriteStream(arf);
Arf.Free;
end;
destructor tarobjectwriter.destroy;
begin
if Errorcount=0 then
writear;
arData.Free;
symreloc.Free;
symstr.Free;
lfnstr.Free;
end;
procedure tarobjectwriter.createarhdr(fn:string;asize:longint;const gid,uid,mode:string);
var
tmp : string[9];
hfn : string;
begin
{ create ar header }
fillchar(arhdr,sizeof(tarhdr),' ');
{ win32 will change names starting with .\ to ./ when using lfn, corrupting
the sort order required for the idata sections. To prevent this strip
always the path from the filename. (PFV) }
hfn:=SplitFileName(fn);
if hfn='' then
hfn:=fn;
fn:=hfn+'/';
if length(fn)>16 then
begin
arhdr.name[0]:='/';
str(lfnstr.size,tmp);
move(tmp[1],arhdr.name[1],length(tmp));
fn:=fn+#10;
lfnstr.write(fn[1],length(fn));
end
else
move(fn[1],arhdr.name,length(fn));
{ don't write a date if also no gid/uid/mode is specified }
if gid<>'' then
move(timestamp[1],arhdr.date,length(timestamp));
str(asize,tmp);
move(tmp[1],arhdr.size,length(tmp));
move(gid[1],arhdr.gid,length(gid));
move(uid[1],arhdr.uid,length(uid));
move(mode[1],arhdr.mode,length(mode));
arhdr.fmag:='`'#10;
end;
function tarobjectwriter.createfile(const fn:string):boolean;
begin
objfn:=fn;
objpos:=ardata.size;
ardata.seek(objpos + sizeof(tarhdr));
createfile:=true;
fobjsize:=0;
end;
procedure tarobjectwriter.closefile;
begin
ardata.align(2);
{ fix the size in the header }
createarhdr(objfn,ardata.size-objpos-sizeof(tarhdr),'42','42','644');
{ write the header }
ardata.seek(objpos);
ardata.write(arhdr,sizeof(tarhdr));
fobjsize:=0;
end;
procedure tarobjectwriter.writesym(const sym:string);
var
c : char;
begin
c:=#0;
symreloc.write(objpos,4);
symstr.write(sym[1],length(sym));
symstr.write(c,1);
end;
procedure tarobjectwriter.write(const b;len:longint);
begin
inc(fobjsize,len);
inc(fsize,len);
ardata.write(b,len);
end;
procedure tarobjectwriter.writear;
var
arf : TCFileStream;
fixup,l,
relocs,i : longint;
begin
arf:=TCFileStream.Create(arfn,fmCreate);
if CStreamError<>0 then
begin
Message1(exec_e_cant_create_archivefile,arfn);
exit;
end;
arf.Write(armagic,sizeof(armagic));
{ align first, because we need the size for the fixups of the symbol reloc }
if lfnstr.size>0 then
lfnstr.align(2);
if symreloc.size>0 then
begin
symstr.align(2);
fixup:=12+sizeof(tarhdr)+symreloc.size+symstr.size;
if lfnstr.size>0 then
inc(fixup,lfnstr.size+sizeof(tarhdr));
relocs:=symreloc.size div 4;
{ fixup relocs }
for i:=0to relocs-1 do
begin
symreloc.seek(i*4);
symreloc.read(l,4);
symreloc.seek(i*4);
l:=lsb2msb(l+fixup);
symreloc.write(l,4);
end;
createarhdr('',4+symreloc.size+symstr.size,'0','0','0');
arf.Write(arhdr,sizeof(tarhdr));
relocs:=lsb2msb(relocs);
arf.Write(relocs,4);
symreloc.WriteStream(arf);
symstr.WriteStream(arf);
end;
if lfnstr.size>0 then
begin
createarhdr('/',lfnstr.size,'','','');
arf.Write(arhdr,sizeof(tarhdr));
lfnstr.WriteStream(arf);
end;
ardata.WriteStream(arf);
Arf.Free;
end;
{*****************************************************************************
TArObjectReader
*****************************************************************************}
constructor tarobjectreader.create(const Aarfn:string);
begin
inherited Create;
ArSymbols:=TFPHashObjectList.Create(true);
CurrMemberPos:=0;
CurrMemberSize:=0;
CurrMemberName:='';
if inherited openfile(Aarfn) then
ReadArchive;
end;
destructor tarobjectreader.destroy;
begin
inherited closefile;
ArSymbols.destroy;
if assigned(LFNStrs) then
FreeMem(LFNStrs);
inherited Destroy;
end;
function tarobjectreader.getfilename : string;
begin
result:=inherited getfilename;
if CurrMemberName<>'' then
result:=result+'('+CurrMemberName+')';
end;
function tarobjectreader.DecodeMemberName(ahdr:TArHdr):string;
var
hs : string;
code : integer;
hsp,
p : pchar;
lfnidx : longint;
begin
result:='';
p:=@ahdr.name[0];
hsp:=@hs[1];
while (p^<>' ') and (hsp-@hs[1]<16) do
begin
hsp^:=p^;
inc(p);
inc(hsp);
end;
hs[0]:=chr(hsp-@hs[1]);
if (hs[1]='/') and (hs[2] in ['0'..'9']) then
begin
Delete(hs,1,1);
val(hs,lfnidx,code);
if (lfnidx<0) or (lfnidx>=LFNSize) then
begin
Comment(V_Error,'Invalid ar member lfn name index in '+filename);
exit;
end;
p:=@LFNStrs[lfnidx];
hsp:=@result[1];
while p^<>#10 do
begin
hsp^:=p^;
inc(p);
inc(hsp);
end;
result[0]:=chr(hsp-@result[1]);
end
else
result:=hs;
{ Strip ending / }
if result[length(result)]='/' then
dec(result[0]);
end;
function tarobjectreader.DecodeMemberSize(ahdr:TArHdr):longint;
var
hs : string;
code : integer;
hsp,
p : pchar;
begin
p:=@ahdr.size[0];
hsp:=@hs[1];
while p^<>' ' do
begin
hsp^:=p^;
inc(p);
inc(hsp);
end;
hs[0]:=chr(hsp-@hs[1]);
val(hs,result,code);
if result<=0 then
Comment(V_Error,'Invalid ar member size in '+filename);
end;
procedure tarobjectreader.ReadArchive;
var
currarmagic : array[0..sizeof(armagic)-1] of char;
currarhdr : tarhdr;
nrelocs,
relocidx,
currfilesize,
relocsize,
symsize : longint;
arsym : TArSymbol;
s : string;
syms,
currp,
endp,
startp : pchar;
relocs : plongint;
begin
Read(currarmagic,sizeof(armagic));
if CompareByte(currarmagic,armagic,sizeof(armagic))<>0 then
begin
Comment(V_Error,'Not a ar file, illegal magic: '+filename);
exit;
end;
Read(currarhdr,sizeof(currarhdr));
{ Read number of relocs }
Read(nrelocs,sizeof(nrelocs));
nrelocs:=lsb2msb(nrelocs);
{ Calculate sizes }
currfilesize:=DecodeMemberSize(currarhdr);
relocsize:=nrelocs*4;
symsize:=currfilesize-relocsize-4;
if symsize<0 then
begin
Comment(V_Error,'Illegal symtable in ar file '+filename);
exit;
end;
{ Read relocs }
getmem(Relocs,relocsize);
Read(relocs^,relocsize);
{ Read symbols, force terminating #0 to prevent overflow }
getmem(syms,symsize+1);
syms[symsize]:=#0;
Read(syms^,symsize);
{ Parse symbols }
relocidx:=0;
currp:=syms;
endp:=syms+symsize;
for relocidx:=0 to nrelocs-1 do
begin
startp:=currp;
while (currp^<>#0) do
inc(currp);
s[0]:=chr(currp-startp);
move(startp^,s[1],byte(s[0]));
arsym:=TArSymbol.create(ArSymbols,s);
arsym.MemberPos:=lsb2msb(relocs[relocidx]);
inc(currp);
if currp>endp then
begin
Comment(V_Error,'Illegal symtable in ar file '+filename);
break;
end;
end;
freemem(relocs);
freemem(syms);
{ LFN names }
Read(currarhdr,sizeof(currarhdr));
if DecodeMemberName(currarhdr)='/' then
begin
lfnsize:=DecodeMemberSize(currarhdr);
getmem(lfnstrs,lfnsize);
Read(lfnstrs^,lfnsize);
end;
end;
function tarobjectreader.openfile(const fn:string):boolean;
var
arsym : TArSymbol;
arhdr : TArHdr;
begin
result:=false;
arsym:=TArSymbol(ArSymbols.Find(fn));
if not assigned(arsym) then
exit;
inherited Seek(arsym.MemberPos);
Read(arhdr,sizeof(arhdr));
CurrMemberName:=DecodeMemberName(arhdr);
CurrMemberSize:=DecodeMemberSize(arhdr);
CurrMemberPos:=arsym.MemberPos+sizeof(arhdr);
result:=true;
end;
procedure tarobjectreader.closefile;
begin
CurrMemberPos:=0;
CurrMemberSize:=0;
CurrMemberName:='';
end;
procedure tarobjectreader.seek(len:longint);
begin
inherited Seek(CurrMemberPos+len);
end;
end.

7
compiler/owbase.pas
View File

@ -60,13 +60,14 @@ type
bufidx,
bufmax : longint;
function readbuf:boolean;
function getfilename : string;
protected
function getfilename : string;virtual;
public
constructor create;
destructor destroy;override;
function openfile(const fn:string):boolean;virtual;
procedure closefile;virtual;
procedure seek(len:longint);
procedure seek(len:longint);virtual;
function read(out b;len:longint):boolean;virtual;
function readarray(a:TDynamicArray;len:longint):boolean;
property filename : string read getfilename;
@ -317,7 +318,7 @@ begin
if not readbuf then
exit;
orglen:=len;
idx:=0;
idx:=0;
while len>0 do
begin
bufleft:=bufmax-bufidx;

60
compiler/systems/t_go32v2.pas
View File

@ -34,23 +34,45 @@ implementation
cutils,cclasses,
globtype,globals,systems,verbose,script,fmodule,i_go32v2,ogcoff;
type
tlinkergo32v2=class(texternallinker)
private
Function WriteResponseFile(isdll:boolean) : Boolean;
Function WriteScript(isdll:boolean) : Boolean;
public
constructor Create;override;
procedure SetDefaultInfo;override;
function MakeExecutable:boolean;override;
end;
type
TInternalLinkerGo32v2=class(TInternallinker)
constructor create;override;
procedure DefaultLinkScript;override;
end;
TExternalLinkerGo32v2=class(texternallinker)
private
Function WriteResponseFile(isdll:boolean) : Boolean;
Function WriteScript(isdll:boolean) : Boolean;
public
constructor Create;override;
procedure SetDefaultInfo;override;
function MakeExecutable:boolean;override;
end;
{****************************************************************************
TLinkerGo32v2
TCoffLinker
****************************************************************************}
Constructor TLinkerGo32v2.Create;
constructor TInternalLinkerGo32v2.Create;
begin
inherited Create;
CExeoutput:=TDJCoffexeoutput;
CObjInput:=TDJCoffObjInput;
end;
procedure TInternalLinkerGo32v2.DefaultLinkScript;
begin
end;
{****************************************************************************
TExternalLinkerGo32v2
****************************************************************************}
Constructor TExternalLinkerGo32v2.Create;
begin
Inherited Create;
{ allow duplicated libs (PM) }
@ -59,7 +81,7 @@ begin
end;
procedure TLinkerGo32v2.SetDefaultInfo;
procedure TExternalLinkerGo32v2.SetDefaultInfo;
begin
with Info do
begin
@ -68,7 +90,7 @@ begin
end;
Function TLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean;
Function TExternalLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
@ -126,7 +148,7 @@ begin
end;
Function TLinkerGo32v2.WriteScript(isdll:boolean) : Boolean;
Function TExternalLinkerGo32v2.WriteScript(isdll:boolean) : Boolean;
Var
scriptres : TLinkRes;
HPath : TStringListItem;
@ -208,7 +230,7 @@ end;
function TLinkerGo32v2.MakeExecutable:boolean;
function TExternalLinkerGo32v2.MakeExecutable:boolean;
var
binstr : String;
cmdstr : TCmdStr;
@ -249,7 +271,7 @@ end;
{$ifdef notnecessary}
procedure tlinkergo32v2.postprocessexecutable(const n : string);
procedure TExternalLinkerGo32v2.postprocessexecutable(const n : string);
type
tcoffheader=packed record
mach : word;
@ -356,7 +378,7 @@ end;
*****************************************************************************}
initialization
RegisterExternalLinker(system_i386_go32v2_info,TLinkerGo32v2);
RegisterInternalLinker(system_i386_go32v2_info,TDJCoffLinker);
RegisterExternalLinker(system_i386_go32v2_info,TExternalLinkerGo32v2);
RegisterInternalLinker(system_i386_go32v2_info,TInternalLinkerGo32v2);
RegisterTarget(system_i386_go32v2_info);
end.

14
compiler/systems/t_wdosx.pas
View File

@ -34,17 +34,17 @@ implementation
import,export,link,t_win,i_wdosx;
type
timportlibwdosx=class(timportlibwin32)
timportlibwdosx=class(TImportLibWin)
end;
texportlibwdosx=texportlibwin32;
texportlibwdosx=TExportLibWin;
tlinkerwdosx=class(tlinkerwin32)
TExternalLinkerwdosx=class(TExternalLinkerWin)
public
function MakeExecutable:boolean;override;
end;
tDLLScannerWdosx=class(tDLLScannerWin32)
tDLLScannerWdosx=class(TDLLScannerWin)
end;
@ -53,9 +53,9 @@ implementation
*****************************************************************************}
{*****************************************************************************
TLINKERWDOSX
TExternalLinkerWDOSX
*****************************************************************************}
function TLinkerWdosx.MakeExecutable:boolean;
function TExternalLinkerWdosx.MakeExecutable:boolean;
var
b: boolean;
begin
@ -74,7 +74,7 @@ end;
*****************************************************************************}
initialization
RegisterExternalLinker(system_i386_wdosx_info,TLinkerWdosx);
RegisterExternalLinker(system_i386_wdosx_info,TExternalLinkerWdosx);
RegisterImport(system_i386_wdosx,TImportLibWdosx);
RegisterExport(system_i386_wdosx,TExportLibWdosx);
RegisterDLLScanner(system_i386_wdosx,TDLLScannerWdosx);

1550
compiler/systems/t_win.pas
View File

File diff suppressed because it is too large Load Diff