paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-07 14:10:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Basic ld script parsing capabilities (barely enough to parse glibc2.1 'libc.so' files, lacks any error handling).

Browse Source 
+ Support linker input source grouping functionality.
* Promote TStaticLibrary to something like generic linker input statement, it can now hold regular ObjData or a group of other TStaticLibrary objects in addition to tarobjectreader.

git-svn-id: trunk@22155 -
This commit is contained in:
sergei 2012-08-21 08:37:39 +00:00
parent a110490a5e
commit d79511f96e
5 changed files with 539 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -248,6 +248,7 @@ compiler/jvm/rjvmsri.inc svneol=native#text/plain
compiler/jvm/rjvmstd.inc svneol=native#text/plain
compiler/jvm/rjvmsup.inc svneol=native#text/plain
compiler/jvm/tgcpu.pas svneol=native#text/plain
compiler/ldscript.pas svneol=native#text/plain
compiler/link.pas svneol=native#text/plain
compiler/m68k/aasmcpu.pas svneol=native#text/plain
compiler/m68k/ag68kgas.pas svneol=native#text/plain

311
compiler/ldscript.pas Normal file
View File

@ -0,0 +1,311 @@
{
Copyright (c) 2012 by Sergei Gorelkin
A basic lexer for GNU ld scripts
This program is free software; you can redistribute it and/or modify
iu 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 ldscript;
{$i fpcdefs.inc}
interface
uses
owbase;
type
TldScriptToken=char;
TScriptLexer=class(TObject)
data: ansistring;
curtoken: TldScriptToken;
curtokenstr: string;
curpos: longint;
line: longint;
linestart: longint;
public
constructor Create(aReader:TObjectReader);
procedure nextToken;
function CheckForIdent(const s:string):boolean;
function CheckFor(c:TldScriptToken):boolean;
procedure Expect(c:TldScriptToken);
property token:TldScriptToken read curtoken;
property tokenstr:string read curtokenstr;
end;
const
tkEOF = #0;
tkINVALID = #1;
tkIDENT = #2;
tkNUMBER = #3;
tkLITERAL = #4;
tkLSHIFT = #5; { << }
tkLE = #6; { <= }
tkRSHIFT = #7; { >> }
tkGE = #8; { >= }
tkANDAND = #9; { && }
tkANDEQ = #10; { &= }
tkOROR = #11; { || }
tkOREQ = #12; { |= }
tkDIVEQ = #13; { /= }
tkMULTEQ = #14; { *= }
tkMINUSEQ = #15; { -= }
tkPLUSEQ = #16; { += }
tkNE = #17; { != }
tkEQ = #18; { == }
tkRSHIFTEQ = #19; { >>= }
tkLSHIFTEQ = #20; { <<= }
implementation
uses
sysutils;
const
NameChars=['A'..'Z','a'..'z','_','.','$','0'..'9','+','-','=',',','*','?','/','~','\','[',']'];
{*****************************************************************************
TSCRIPTLEXER
*****************************************************************************}
constructor TScriptLexer.Create(AReader:TObjectReader);
begin
{ Expected data size is few hundred bytes, }
SetLength(data,AReader.size);
AReader.Read(data[1],AReader.size);
curpos:=1;
end;
procedure TScriptLexer.nextToken;
var
p,start: longint;
begin
p:=curpos;
repeat
{ skip whitespace }
while (data[p] in [#32,#9,#13]) do
inc(p);
start:=p;
{ C-style comment }
if (data[p]='/') and (data[p+1]='*') then
begin
inc(p,2);
while (data[p]<>'*') and (data[p+1]<>'/') do
begin
if (data[p]=#0) then
begin
curtoken:=tkINVALID;
exit;
end;
if (data[p]=#10) then
begin
inc(line);
linestart:=p+1;
end;
inc(p);
end;
inc(p,2);
continue;
end
else if (data[p]=#10) then
begin
inc(p);
inc(line);
linestart:=p;
continue;
end
else if (data[p]='#') then { line comment }
begin
inc(p);
while (data[p]<>#0) and (data[p]<>#10) do
inc(p);
continue;
end;
case data[p] of
#0: curtoken:=tkEOF;
'/':
if (data[p+1] in NameChars) then
begin
inc(p);
while (data[p] in NameChars) do
inc(p);
curtoken:=tkIDENT;
end
else if (data[p+1]='=') then
curtoken:=tkDIVEQ
else
curtoken:='/';
'A'..'Z','a'..'z','_','.','$','\':
begin
inc(p);
while (data[p] in NameChars) do
inc(p);
curtoken:=tkIDENT;
end;
'0'..'9':
begin
if (data[p]='0') and (data[p+1] in ['x','X']) then
begin
inc(p,2);
while data[p] in ['0'..'9','a'..'f','A'..'F'] do
inc(p);
end
else
while (data[p] in ['0'..'9']) do
inc(p);
curtoken:=tkNUMBER;
end;
'"':
begin
inc(p);
while (data[p]<>'"') and (data[p]<>#10) do
inc(p);
if data[p]=#10 then
begin
curtoken:=tkINVALID;
exit;
end;
inc(p);
curtoken:=tkLITERAL;
end;
'<':
if (data[p+1]='<') then
begin
if (data[p+2]='=') then
curtoken:=tkLSHIFTEQ
else
curtoken:=tkLSHIFT;
end
else if (data[p+1]='=') then
curtoken:=tkLE
else
curtoken:='<';
'>':
if (data[p+1]='>') then
begin
if (data[p+2]='=') then
curtoken:=tkRSHIFTEQ
else
curtoken:=tkRSHIFT;
end
else if (data[p+1]='=') then
curtoken:=tkGE
else
curtoken:='>';
'!':
if (data[p+1]='=') then
curtoken:=tkNE
else
curtoken:='!';
'&':
if (data[p+1]='&') then
curtoken:=tkANDAND
else if (data[p+1]='=') then
curtoken:=tkANDEQ
else
curtoken:='&';
'|':
if (data[p+1]='|') then
curtoken:=tkOROR
else if (data[p+1]='=') then
curtoken:=tkOREQ
else
curtoken:='|';
'*':
if (data[p+1]='=') then
curtoken:=tkMULTEQ
else
curtoken:='*';
'+':
if (data[p+1]='=') then
curtoken:=tkPLUSEQ
else
curtoken:='+';
'-':
if (data[p+1]='=') then
curtoken:=tkMINUSEQ
else
curtoken:='-';
'=':
if (data[p+1]='=') then
curtoken:=tkEQ
else
curtoken:='=';
'(',')','{','}','[',']',';','?',':':
curtoken:=data[p];
else
curtoken:=tkINVALID;
exit;
end;
break;
until false;
case curtoken of
tkRSHIFTEQ,tkLSHIFTEQ: inc(p,3);
tkLSHIFT..tkEQ: inc(p,2);
#32..#255: inc(p);
tkIDENT,tkNUMBER:
setstring(curtokenstr,@data[start],p-start);
tkLITERAL:
setstring(curtokenstr,@data[start+1],p-start-2);
end;
curpos:=p;
end;
procedure TScriptLexer.Expect(c:TldScriptToken);
begin
if (curtoken=c) then
nextToken
else
{error};
end;
function TScriptLexer.CheckForIdent(const s:string):boolean;
begin
result:=(curtoken=tkIDENT) and (curtokenstr=s);
if result then
nextToken;
end;
function TScriptLexer.CheckFor(c:TldScriptToken):boolean;
begin
result:=(curtoken=c);
if result then
nextToken;
end;
end.

98
compiler/link.pas
View File

@ -32,6 +32,7 @@ interface
systems,
fmodule,
globtype,
ldscript,
ogbase;
Type
@ -95,6 +96,7 @@ interface
{ Libraries }
FStaticLibraryList : TFPObjectList;
FImportLibraryList : TFPHashObjectList;
FGroupStack : TFPObjectList;
procedure Load_ReadObject(const para:TCmdStr);
procedure Load_ReadStaticLibrary(const para:TCmdStr);
procedure ParseScript_Handle;
@ -106,6 +108,7 @@ interface
procedure ParseScript_DataPos;
procedure PrintLinkerScript;
function RunLinkScript(const outputname:TCmdStr):boolean;
procedure ParseLdScript(src:TScriptLexer);
protected
linkscript : TCmdStrList;
ScriptCount : longint;
@ -850,6 +853,7 @@ Implementation
linkscript:=TCmdStrList.Create;
FStaticLibraryList:=TFPObjectList.Create(true);
FImportLibraryList:=TFPHashObjectList.Create(true);
FGroupStack:=TFPObjectList.Create(false);
exemap:=nil;
exeoutput:=nil;
UseStabs:=false;
@ -861,6 +865,7 @@ Implementation
Destructor TInternalLinker.Destroy;
begin
FGroupStack.Free;
linkscript.free;
StaticLibraryList.Free;
ImportLibraryList.Free;
@ -927,6 +932,66 @@ Implementation
end;
procedure TInternalLinker.ParseLdScript(src:TScriptLexer);
var
asneeded: boolean;
group: TStaticLibrary;
procedure ParseInputList;
var
saved_asneeded: boolean;
begin
src.Expect('(');
repeat
if src.CheckForIdent('AS_NEEDED') then
begin
saved_asneeded:=asneeded;
asneeded:=true;
ParseInputList;
asneeded:=saved_asneeded;
end
else if src.token in [tkIDENT,tkLITERAL] then
begin
Load_ReadStaticLibrary(src.tokenstr);
src.nextToken;
end
else if src.CheckFor('-') then
begin
{ TODO: no whitespace between '-' and name;
name must begin with 'l' }
src.nextToken;
end
else { syntax error, no input_list_element term }
Break;
if src.CheckFor(',') then
Continue;
until src.CheckFor(')');
end;
begin
asneeded:=false;
src.nextToken;
repeat
if src.CheckForIdent('OUTPUT_FORMAT') then
begin
src.Expect('(');
//writeln('output_format(',src.tokenstr,')');
src.nextToken;
src.Expect(')');
end
else if src.CheckForIdent('GROUP') then
begin
group:=TStaticLibrary.create_group;
TFPObjectList(FGroupStack.Last).Add(group);
FGroupStack.Add(group.GroupMembers);
ParseInputList;
FGroupStack.Delete(FGroupStack.Count-1);
end
else if src.CheckFor(';') then
{skip semicolon};
until src.token in [tkEOF,tkINVALID];
end;
procedure TInternalLinker.Load_ReadObject(const para:TCmdStr);
var
objdata : TObjData;
@ -952,15 +1017,41 @@ Implementation
procedure TInternalLinker.Load_ReadStaticLibrary(const para:TCmdStr);
var
objreader : TObjectReader;
objreader : TArObjectReader;
objinput: TObjInput;
objdata: TObjData;
ScriptLexer: TScriptLexer;
begin
{ TODO: Cleanup ignoring of FPC generated libimp*.a files}
{ Don't load import libraries }
if copy(ExtractFileName(para),1,6)='libimp' then
exit;
Comment(V_Tried,'Opening library '+para);
objreader:=TArObjectreader.create(para);
StaticLibraryList.Add(TStaticLibrary.Create(para,objreader,CObjInput));
objreader:=TArObjectreader.create(para,true);
if objreader.isarchive then
TFPObjectList(FGroupStack.Last).Add(TStaticLibrary.Create(para,objreader,CObjInput))
else
if CObjInput.CanReadObjData(objreader) then
begin
{ may be a regular object as well as a dynamic one }
objinput:=CObjInput.Create;
objdata:=objinput.newObjData(para);
if objinput.ReadObjData(objreader,objdata) then
begin
TFPObjectList(FGroupStack.Last).Add(TStaticLibrary.create_object(objdata));
//exeoutput.addobjdata(objdata);
end;
objinput.Free;
objreader.Free;
end
else { try parsing as script }
begin
Comment(V_Tried,'Interpreting '+para+' as ld script');
ScriptLexer:=TScriptLexer.Create(objreader);
ParseLdScript(ScriptLexer);
ScriptLexer.Free;
objreader.Free;
end;
end;
@ -1275,6 +1366,7 @@ Implementation
{ Check that syntax is OK }
ParseScript_Handle;
{ Load .o files and resolve symbols }
FGroupStack.Add(FStaticLibraryList);
ParseScript_Load;
if ErrorCount>0 then
goto myexit;

177
compiler/ogbase.pas
View File

@ -373,16 +373,31 @@ interface
end;
TExeSectionClass=class of TExeSection;
TlibKind = (lkArchive,lkObject,lkGroup);
TStaticLibrary = class(TObject)
private
FName : TCmdStr;
FArReader : TObjectReader;
FPayload : TObject; { lkArchive: TObjectReader }
{ lkObject: TObjData }
{ lkGroup: TFPObjectList }
FObjInputClass : TObjInputClass;
FKind: TlibKind;
FAsNeeded : Boolean;
function GetArReader:TObjectReader;
function GetGroupMembers:TFPObjectList;
function GetObjData:TObjData;
public
constructor create(const AName:TCmdStr;AReader:TObjectReader;AObjInputClass:TObjInputClass);
constructor create_object(AObjData:TObjData);
constructor create_group;
destructor destroy;override;
property ArReader:TObjectReader read FArReader;
property ArReader:TObjectReader read GetArReader;
property ObjInputClass:TObjInputClass read FObjInputClass;
property GroupMembers:TFPObjectList read GetGroupMembers;
property ObjData:TObjData read GetObjData;
property AsNeeded:Boolean read FAsNeeded write FAsNeeded;
property Kind:TLibKind read FKind;
end;
TImportLibrary = class(TFPHashObject)
@ -1488,18 +1503,56 @@ implementation
constructor TStaticLibrary.create(const AName:TCmdStr;AReader:TObjectReader;AObjInputClass:TObjInputClass);
begin
FName:=AName;
FArReader:=AReader;
FPayload:=AReader;
FObjInputClass:=AObjInputClass;
FKind:=lkArchive;
end;
constructor TStaticLibrary.create_object(AObjData:TObjData);
begin
FPayload:=AObjData;
FKind:=lkObject;
end;
constructor TStaticLibrary.create_group;
begin
FPayload:=TFPObjectList.Create(true);
FKind:=lkGroup;
end;
destructor TStaticLibrary.destroy;
begin
ArReader.Free;
FPayload.Free;
inherited destroy;
end;
function TStaticLibrary.GetArReader: TObjectReader;
begin
if (FKind<>lkArchive) then
InternalError(2012071501);
result:=TObjectReader(FPayload);
end;
function TStaticLibrary.GetGroupMembers: TFPObjectList;
begin
if (FKind<>lkGroup) then
InternalError(2012071502);
result:=TFPObjectList(FPayload);
end;
function TStaticLibrary.GetObjData: TObjData;
begin
if (FKind<>lkObject) then
InternalError(2012071503);
result:=TObjData(FPayload);
end;
{****************************************************************************
TImportLibrary
****************************************************************************}
@ -2121,11 +2174,9 @@ implementation
exesym : TExeSymbol;
objsym,
commonsym : TObjSymbol;
objinput : TObjInput;
StaticLibrary : TStaticLibrary;
firstarchive,
firstcommon : boolean;
i,j : longint;
i : longint;
VTEntryList,
VTInheritList : TFPObjectList;
@ -2206,6 +2257,77 @@ implementation
end;
end;
procedure LoadLibrary(lib:TStaticLibrary);
var
j,k,oldcount: longint;
members: TFPObjectList;
exesym: TExeSymbol;
objinput: TObjInput;
begin
case lib.Kind of
lkArchive:
begin
{ 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
exesym:=TExeSymbol(UnresolvedExeSymbols[j]);
{ Check first if the symbol is still undefined }
if (exesym.State=symstate_undefined) and (exesym.ObjSymbol.bind<>AB_WEAK_EXTERNAL) then
begin
if lib.ArReader.OpenFile(exesym.name) then
begin
if assigned(exemap) then
begin
if firstarchive then
begin
exemap.Add('');
exemap.Add('Archive member included because of file (symbol)');
exemap.Add('');
firstarchive:=false;
end;
exemap.Add(lib.ArReader.FileName+' - '+
{exesym.ObjSymbol.ObjSection.FullName+}
'('+exesym.Name+')');
end;
objinput:=lib.ObjInputClass.Create;
objdata:=objinput.newObjData(lib.ArReader.FileName);
objinput.ReadObjData(lib.ArReader,objdata);
objinput.free;
AddObjData(objdata);
LoadObjDataSymbols(objdata);
lib.ArReader.CloseFile;
end;
end;
inc(j);
end;
end;
lkGroup:
begin
{ repeatedly process members of the group until no new
unresolved symbols appear }
members:=lib.GroupMembers;
repeat
oldcount:=UnresolvedExeSymbols.count;
for k:=0 to members.Count-1 do
LoadLibrary(TStaticLibrary(members[k]));
until UnresolvedExeSymbols.count=oldcount;
end;
lkObject:
{ TODO: ownership of objdata }
//if lib.objdata.is_dynamic then
Load_DynamicObject(lib.objdata);
{else
begin
AddObjData(lib.objdata);
LoadObjDataSymbols(lib.objdata);
end;}
end;
end;
begin
VTEntryList:=TFPObjectList.Create(false);
VTInheritList:=TFPObjectList.Create(false);
@ -2229,45 +2351,8 @@ implementation
{ 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
exesym:=TExeSymbol(UnresolvedExeSymbols[j]);
{ Check first if the symbol is still undefined }
if exesym.State=symstate_undefined then
begin
if StaticLibrary.ArReader.OpenFile(exesym.name) then
begin
if assigned(exemap) then
begin
if firstarchive then
begin
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;
end;
inc(j);
end;
end;
LoadLibrary(TStaticLibrary(StaticLibraryList[i]));
PackUnresolvedExeSymbols('after static libraries');
{ Step 3, handle symbols provided in script }

1
compiler/owar.pas
View File

@ -334,6 +334,7 @@ implementation
ReadArchive
else if (not allow_nonar) then
Comment(V_Error,'Not a ar file, illegal magic: '+filename);
Seek(0);
end;
end;