1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720 |
- {
- Copyright (c) 1998-2002 by Peter Vreman
- This unit handles the linker and binder calls for programs and
- libraries
- 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 link;
- {$i fpcdefs.inc}
- interface
- uses
- sysutils,
- cclasses,
- systems,
- fmodule,
- globtype,
- ldscript,
- ogbase,
- owbase;
- Type
- TLinkerInfo=record
- ExeCmd,
- DllCmd,
- ExtDbgCmd : array[1..3] of string;
- ResName : string[100];
- ScriptName : string[100];
- ExtraOptions : TCmdStr;
- DynamicLinker : string[100];
- end;
- TLinker = class(TObject)
- public
- HasResources,
- HasExports : boolean;
- SysInitUnit : string[20];
- ObjectFiles,
- SharedLibFiles,
- StaticLibFiles,
- FrameworkFiles,
- OrderedSymbols: TCmdStrList;
- Constructor Create;virtual;
- Destructor Destroy;override;
- procedure AddModuleFiles(hp:tmodule);
- Procedure AddObject(const S,unitpath : TPathStr;isunit:boolean);
- Procedure AddStaticLibrary(const S : TCmdStr);
- Procedure AddSharedLibrary(S : TCmdStr);
- Procedure AddStaticCLibrary(const S : TCmdStr);
- Procedure AddSharedCLibrary(S : TCmdStr);
- Procedure AddFramework(S : TCmdStr);
- Procedure AddOrderedSymbol(const s: TCmdStr);
- procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);virtual;
- Procedure InitSysInitUnitName;virtual;
- Function MakeExecutable:boolean;virtual;
- Function MakeSharedLibrary:boolean;virtual;
- Function MakeStaticLibrary:boolean;virtual;
- procedure ExpandAndApplyOrder(var Src:TCmdStrList);
- procedure LoadPredefinedLibraryOrder;virtual;
- function ReOrderEntries : boolean;
- end;
- TExternalLinker = class(TLinker)
- public
- Info : TLinkerInfo;
- Constructor Create;override;
- Destructor Destroy;override;
- Function FindUtil(const s:TCmdStr):TCmdStr;
- Function CatFileContent(para:TCmdStr):TCmdStr;
- Function DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean;
- procedure SetDefaultInfo;virtual;
- Function MakeStaticLibrary:boolean;override;
- end;
- TBooleanArray = array [1..1024] of boolean;
- PBooleanArray = ^TBooleanArray;
- TInternalLinker = class(TLinker)
- private
- FCExeOutput : TExeOutputClass;
- FCObjInput : TObjInputClass;
- FCArObjectReader : TObjectReaderClass;
- { Libraries }
- FStaticLibraryList : TFPObjectList;
- FImportLibraryList : TFPHashObjectList;
- FGroupStack : TFPObjectList;
- procedure Load_ReadObject(const para:TCmdStr);
- procedure Load_ReadStaticLibrary(const para:TCmdStr;asneededflag:boolean=false);
- procedure Load_Group;
- procedure Load_EndGroup;
- procedure ParseScript_Handle;
- procedure ParseScript_PostCheck;
- procedure ParseScript_Load;
- function ParsePara(const para : string) : string;
- procedure ParseScript_Order;
- procedure ParseScript_MemPos;
- procedure ParseScript_DataPos;
- procedure PrintLinkerScript;
- function RunLinkScript(const outputname:TCmdStr):boolean;
- procedure ParseLdScript(src:TScriptLexer);
- protected
- linkscript : TCmdStrList;
- ScriptCount : longint;
- IsHandled : PBooleanArray;
- property CArObjectReader:TObjectReaderClass read FCArObjectReader write FCArObjectReader;
- property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
- property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
- property StaticLibraryList:TFPObjectList read FStaticLibraryList;
- property ImportLibraryList:TFPHashObjectList read FImportLibraryList;
- procedure DefaultLinkScript;virtual;abstract;
- procedure ScriptAddGenericSections(secnames:string);
- procedure ScriptAddSourceStatements(AddSharedAsStatic:boolean);virtual;
- function GetCodeSize(aExeOutput: TExeOutput): QWord;virtual;
- function GetDataSize(aExeOutput: TExeOutput): QWord;virtual;
- function GetBssSize(aExeOutput: TExeOutput): QWord;virtual;
- public
- IsSharedLibrary : boolean;
- UseStabs : boolean;
- Constructor Create;override;
- Destructor Destroy;override;
- Function MakeExecutable:boolean;override;
- Function MakeSharedLibrary:boolean;override;
- procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);override;
- end;
- TLinkerClass = class of Tlinker;
- var
- Linker : TLinker;
- function FindObjectFile(s : TCmdStr;const unitpath:TCmdStr;isunit:boolean) : TCmdStr;
- function FindLibraryFile(s:TCmdStr;const prefix,ext:TCmdStr;var foundfile : TCmdStr) : boolean;
- function FindDLL(const s:TCmdStr;var founddll:TCmdStr):boolean;
- procedure RegisterLinker(id:tlink;c:TLinkerClass);
- procedure InitLinker;
- procedure DoneLinker;
- Implementation
- uses
- cutils,cfileutl,cstreams,
- {$ifdef hasUnix}
- baseunix,
- {$endif hasUnix}
- cscript,globals,verbose,comphook,ppu,fpccrc,
- aasmbase,aasmcpu,
- ogmap;
- var
- CLinker : array[tlink] of TLinkerClass;
- {*****************************************************************************
- Helpers
- *****************************************************************************}
- function GetFileCRC(const fn:TPathStr):cardinal;
- var
- fs : TCStream;
- bufcount,
- bufsize : Integer;
- buf : pbyte;
- begin
- result:=0;
- bufsize:=64*1024;
- fs:=CFileStreamClass.Create(fn,fmOpenRead or fmShareDenyNone);
- if CStreamError<>0 then
- begin
- fs.Free;
- Comment(V_Error,'Can''t open file: '+fn);
- exit;
- end;
- getmem(buf,bufsize);
- repeat
- bufcount:=fs.Read(buf^,bufsize);
- result:=UpdateCrc32(result,buf^,bufcount);
- until bufcount<bufsize;
- freemem(buf);
- fs.Free;
- end;
- { searches an object file }
- function FindObjectFile(s:TCmdStr;const unitpath:TCmdStr;isunit:boolean) : TCmdStr;
- var
- found : boolean;
- foundfile : TCmdStr;
- begin
- findobjectfile:='';
- if s='' then
- exit;
- {When linking on target, the units has not been assembled yet,
- so there is no object files to look for at
- the host. Look for the corresponding assembler file instead,
- because it will be assembled to object file on the target.}
- if isunit and (cs_link_on_target in current_settings.globalswitches) then
- s:=ChangeFileExt(s,target_info.asmext);
- { when it does not belong to the unit then check if
- the specified file exists without searching any paths }
- if not isunit then
- begin
- if FileExists(FixFileName(s),false) then
- begin
- foundfile:=ScriptFixFileName(s);
- found:=true;
- end;
- end;
- if pos('.',s)=0 then
- s:=s+target_info.objext;
- { find object file
- 1. output unit path
- 2. output exe path
- 3. specified unit path (if specified)
- 4. cwd
- 5. unit search path
- 6. local object path
- 7. global object path
- 8. exepath (not when linking on target)
- for all finds don't use the directory caching }
- found:=false;
- if isunit and (OutputUnitDir<>'') then
- found:=FindFile(s,OutPutUnitDir,false,foundfile)
- else
- if OutputExeDir<>'' then
- found:=FindFile(s,OutPutExeDir,false,foundfile);
- if (not found) and (unitpath<>'') then
- found:=FindFile(s,unitpath,false,foundfile);
- if (not found) then
- found:=FindFile(s, CurDirRelPath(source_info),false,foundfile);
- if (not found) then
- found:=UnitSearchPath.FindFile(s,false,foundfile);
- if (not found) then
- found:=current_module.localobjectsearchpath.FindFile(s,false,foundfile);
- if (not found) then
- found:=objectsearchpath.FindFile(s,false,foundfile);
- if not(cs_link_on_target in current_settings.globalswitches) and (not found) then
- found:=FindFile(s,exepath,false,foundfile);
- if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
- Message1(exec_w_objfile_not_found,s);
- {Restore file extension}
- if isunit and (cs_link_on_target in current_settings.globalswitches) then
- foundfile:= ChangeFileExt(foundfile,target_info.objext);
- findobjectfile:=ScriptFixFileName(foundfile);
- end;
- { searches a (windows) DLL file }
- function FindDLL(const s:TCmdStr;var founddll:TCmdStr):boolean;
- var
- sysdir : TCmdStr;
- Found : boolean;
- begin
- Found:=false;
- { Look for DLL in:
- 1. Current dir
- 2. Library Path
- 3. windir,windir/system,windir/system32 }
- Found:=FindFile(s,'.'+source_info.DirSep,false,founddll);
- if (not found) then
- Found:=librarysearchpath.FindFile(s,false,founddll);
- { when cross compiling, it is pretty useless to search windir etc. for dlls }
- if (not found) and (source_info.system=target_info.system) then
- begin
- sysdir:=FixPath(GetEnvironmentVariable('windir'),false);
- Found:=FindFile(s,sysdir+';'+sysdir+'system'+source_info.DirSep+';'+sysdir+'system32'+source_info.DirSep,false,founddll);
- end;
- if (not found) then
- begin
- message1(exec_w_libfile_not_found,s);
- FoundDll:=s;
- end;
- FindDll:=Found;
- end;
- { searches an library file }
- function FindLibraryFile(s:TCmdStr;const prefix,ext:TCmdStr;var foundfile : TCmdStr) : boolean;
- var
- found : boolean;
- paths : TCmdStr;
- begin
- findlibraryfile:=false;
- foundfile:=s;
- if s='' then
- exit;
- { split path from filename }
- paths:=ExtractFilePath(s);
- s:=ExtractFileName(s);
- { add prefix 'lib' }
- if (prefix<>'') and (Copy(s,1,length(prefix))<>prefix) then
- s:=prefix+s;
- { add extension }
- if (ext<>'') and (Copy(s,length(s)-length(ext)+1,length(ext))<>ext) then
- s:=s+ext;
- { readd the split path }
- s:=paths+s;
- if FileExists(s,false) then
- begin
- foundfile:=ScriptFixFileName(s);
- FindLibraryFile:=true;
- exit;
- end;
- { find libary
- 1. cwd
- 2. local libary dir
- 3. global libary dir
- 4. exe path of the compiler (not when linking on target)
- for all searches don't use the directory cache }
- found:=FindFile(s, CurDirRelPath(source_info), false,foundfile);
- if (not found) and (current_module.outputpath<>'') then
- found:=FindFile(s,current_module.outputpath,false,foundfile);
- if (not found) then
- found:=current_module.locallibrarysearchpath.FindFile(s,false,foundfile);
- if (not found) then
- found:=librarysearchpath.FindFile(s,false,foundfile);
- if not(cs_link_on_target in current_settings.globalswitches) and (not found) then
- found:=FindFile(s,exepath,false,foundfile);
- foundfile:=ScriptFixFileName(foundfile);
- findlibraryfile:=found;
- end;
- {*****************************************************************************
- TLINKER
- *****************************************************************************}
- Constructor TLinker.Create;
- begin
- Inherited Create;
- ObjectFiles:=TCmdStrList.Create_no_double;
- SharedLibFiles:=TCmdStrList.Create_no_double;
- StaticLibFiles:=TCmdStrList.Create_no_double;
- FrameworkFiles:=TCmdStrList.Create_no_double;
- OrderedSymbols:=TCmdStrList.Create;
- end;
- Destructor TLinker.Destroy;
- begin
- ObjectFiles.Free;
- SharedLibFiles.Free;
- StaticLibFiles.Free;
- FrameworkFiles.Free;
- OrderedSymbols.Free;
- inherited;
- end;
- procedure TLinker.AddModuleFiles(hp:tmodule);
- var
- mask : longint;
- i,j : longint;
- ImportLibrary : TImportLibrary;
- ImportSymbol : TImportSymbol;
- begin
- with hp do
- begin
- if mf_has_resourcefiles in moduleflags then
- HasResources:=true;
- if mf_has_exports in moduleflags then
- HasExports:=true;
- { link unit files }
- if (headerflags and uf_no_link)=0 then
- begin
- { create mask which unit files need linking }
- mask:=link_always;
- { lto linking ?}
- if (cs_lto in current_settings.moduleswitches) and
- ((headerflags and uf_lto_linked)<>0) and
- (not(cs_lto_nosystem in init_settings.globalswitches) or
- (hp.modulename^<>'SYSTEM')) then
- begin
- mask:=mask or link_lto;
- end
- else
- begin
- { static linking ? }
- if (cs_link_static in current_settings.globalswitches) then
- begin
- if (headerflags and uf_static_linked)=0 then
- begin
- { if static not avail then try smart linking }
- if (headerflags and uf_smart_linked)<>0 then
- begin
- Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
- mask:=mask or link_smart;
- end
- else
- Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
- end
- else
- mask:=mask or link_static;
- end;
- { smart linking ? }
- if (cs_link_smart in current_settings.globalswitches) then
- begin
- if (headerflags and uf_smart_linked)=0 then
- begin
- { if smart not avail then try static linking }
- if (headerflags and uf_static_linked)<>0 then
- begin
- { if not create_smartlink_library, then smart linking happens using the
- regular object files
- }
- if create_smartlink_library then
- Message1(exec_t_unit_not_smart_linkable_switch_to_static,modulename^);
- mask:=mask or link_static;
- end
- else
- Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
- end
- else
- mask:=mask or link_smart;
- end;
- { shared linking }
- if (cs_link_shared in current_settings.globalswitches) then
- begin
- if (headerflags and uf_shared_linked)=0 then
- begin
- { if shared not avail then try static linking }
- if (headerflags and uf_static_linked)<>0 then
- begin
- Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
- mask:=mask or link_static;
- end
- else
- Message1(exec_e_unit_not_shared_or_static_linkable,modulename^);
- end
- else
- mask:=mask or link_shared;
- end;
- end;
- { unit files }
- while not linkunitofiles.empty do
- AddObject(linkunitofiles.getusemask(mask),path,true);
- while not linkunitstaticlibs.empty do
- AddStaticLibrary(linkunitstaticlibs.getusemask(mask));
- while not linkunitsharedlibs.empty do
- AddSharedLibrary(linkunitsharedlibs.getusemask(mask));
- end;
- { Other needed .o and libs, specified using $L,$LINKLIB,external }
- mask:=link_always;
- while not linkotherofiles.empty do
- AddObject(linkotherofiles.Getusemask(mask),path,false);
- while not linkotherstaticlibs.empty do
- AddStaticCLibrary(linkotherstaticlibs.Getusemask(mask));
- while not linkothersharedlibs.empty do
- AddSharedCLibrary(linkothersharedlibs.Getusemask(mask));
- while not linkotherframeworks.empty do
- AddFramework(linkotherframeworks.Getusemask(mask));
- { Known Library/DLL Imports }
- for i:=0 to ImportLibraryList.Count-1 do
- begin
- ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
- for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
- begin
- ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
- AddImportSymbol(ImportLibrary.Name,ImportSymbol.Name,
- ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar);
- end;
- end;
- { ordered symbols }
- OrderedSymbols.concatList(linkorderedsymbols);
- end;
- end;
- procedure TLinker.AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);
- begin
- end;
- Procedure TLinker.AddObject(const S,unitpath : TPathStr;isunit:boolean);
- begin
- ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit))
- end;
- Procedure TLinker.AddSharedLibrary(S:TCmdStr);
- begin
- if s='' then
- exit;
- { remove prefix 'lib' }
- if Copy(s,1,length(target_info.sharedlibprefix))=target_info.sharedlibprefix then
- Delete(s,1,length(target_info.sharedlibprefix));
- { remove extension if any }
- if Copy(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext))=target_info.sharedlibext then
- Delete(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext)+1);
- { ready to be added }
- SharedLibFiles.Concat(S);
- end;
- Procedure TLinker.AddStaticLibrary(const S:TCmdStr);
- var
- ns : TCmdStr;
- found : boolean;
- begin
- if s='' then
- exit;
- found:=FindLibraryFile(s,target_info.staticlibprefix,target_info.staticlibext,ns);
- if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
- Message1(exec_w_libfile_not_found,s);
- StaticLibFiles.Concat(ns);
- end;
- Procedure TLinker.AddSharedCLibrary(S:TCmdStr);
- begin
- if s='' then
- exit;
- { remove prefix 'lib' }
- if Copy(s,1,length(target_info.sharedclibprefix))=target_info.sharedclibprefix then
- Delete(s,1,length(target_info.sharedclibprefix));
- { remove extension if any }
- if Copy(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext))=target_info.sharedclibext then
- Delete(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext)+1);
- { ready to be added }
- SharedLibFiles.Concat(S);
- end;
- Procedure TLinker.AddFramework(S:TCmdStr);
- begin
- if s='' then
- exit;
- { ready to be added }
- FrameworkFiles.Concat(S);
- end;
- procedure TLinker.AddOrderedSymbol(const s: TCmdStr);
- begin
- OrderedSymbols.Concat(s);
- end;
- Procedure TLinker.AddStaticCLibrary(const S:TCmdStr);
- var
- ns : TCmdStr;
- found : boolean;
- begin
- if s='' then
- exit;
- found:=FindLibraryFile(s,target_info.staticclibprefix,target_info.staticclibext,ns);
- if not(cs_link_nolink in current_settings.globalswitches) and (not found) then
- Message1(exec_w_libfile_not_found,s);
- StaticLibFiles.Concat(ns);
- end;
- procedure TLinker.InitSysInitUnitName;
- begin
- end;
- function TLinker.MakeExecutable:boolean;
- begin
- MakeExecutable:=false;
- Message(exec_e_exe_not_supported);
- end;
- Function TLinker.MakeSharedLibrary:boolean;
- begin
- MakeSharedLibrary:=false;
- Message(exec_e_dll_not_supported);
- end;
- Function TLinker.MakeStaticLibrary:boolean;
- begin
- MakeStaticLibrary:=false;
- Message(exec_e_static_lib_not_supported);
- end;
- Procedure TLinker.ExpandAndApplyOrder(var Src:TCmdStrList);
- var
- p : TLinkStrMap;
- i : longint;
- begin
- // call Virtual TLinker method to initialize
- LoadPredefinedLibraryOrder;
- // something to do?
- 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.SortOnWeight;
- // put back in src
- for i:=0 to p.count-1 do
- src.insert(p[i].Key);
- p.free;
- end;
- procedure TLinker.LoadPredefinedLibraryOrder;
- begin
- end;
- function TLinker.ReOrderEntries : boolean;
- begin
- result:=(LinkLibraryOrder.count>0) or (LinkLibraryAliases.count>0);
- end;
- {*****************************************************************************
- TEXTERNALLINKER
- *****************************************************************************}
- Constructor TExternalLinker.Create;
- begin
- inherited Create;
- { set generic defaults }
- FillChar(Info,sizeof(Info),0);
- if cs_link_on_target in current_settings.globalswitches then
- begin
- Info.ResName:=ChangeFileExt(inputfilename,'_link.res');
- Info.ScriptName:=ChangeFileExt(inputfilename,'_script.res');
- end
- else
- begin
- if GetProcessID>0 then
- begin
- Info.ResName:='link'+tostr(GetProcessID)+'.res';
- Info.ScriptName:='script'+tostr(GetProcessID)+'.res';
- end
- else
- begin
- Info.ResName:='link.res';
- Info.ScriptName:='script.res';
- end;
- end;
- { set the linker specific defaults }
- SetDefaultInfo;
- { Allow Parameter overrides for linker info }
- with Info do
- begin
- if ParaLinkOptions<>'' then
- ExtraOptions:=ParaLinkOptions;
- if ParaDynamicLinker<>'' then
- DynamicLinker:=ParaDynamicLinker;
- end;
- end;
- Destructor TExternalLinker.Destroy;
- begin
- inherited destroy;
- end;
- Procedure TExternalLinker.SetDefaultInfo;
- begin
- end;
- Function TExternalLinker.FindUtil(const s:TCmdStr):TCmdStr;
- var
- Found : boolean;
- FoundBin : TCmdStr;
- UtilExe : TCmdStr;
- begin
- if cs_link_on_target in current_settings.globalswitches then
- begin
- { If linking on target, don't add any path PM }
- { change extension only on platforms that use an exe extension, otherwise on OpenBSD 'ld.bfd' gets
- converted to 'ld' }
- if target_info.exeext<>'' then
- FindUtil:=ChangeFileExt(s,target_info.exeext)
- else
- FindUtil:=s;
- exit;
- end;
- { change extension only on platforms that use an exe extension, otherwise on OpenBSD 'ld.bfd' gets converted
- to 'ld' }
- if source_info.exeext<>'' then
- UtilExe:=ChangeFileExt(s,source_info.exeext)
- else
- UtilExe:=s;
- FoundBin:='';
- Found:=false;
- if utilsdirectory<>'' then
- Found:=FindFile(utilexe,utilsdirectory,false,Foundbin);
- if (not Found) then
- Found:=FindExe(utilexe,false,Foundbin);
- if (not Found) and not(cs_link_nolink in current_settings.globalswitches) then
- begin
- Message1(exec_e_util_not_found,utilexe);
- current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
- end;
- if (FoundBin<>'') then
- Message1(exec_t_using_util,FoundBin);
- FindUtil:=FoundBin;
- end;
- Function TExternalLinker.CatFileContent(para : TCmdStr) : TCmdStr;
- var
- filecontent : TCmdStr;
- f : text;
- st : TCmdStr;
- begin
- if not (tf_no_backquote_support in source_info.flags) or
- (cs_link_on_target in current_settings.globalswitches) then
- begin
- CatFileContent:='`cat '+MaybeQuoted(para)+'`';
- Exit;
- end;
- assign(f,para);
- filecontent:='';
- {$push}{$I-}
- reset(f);
- {$pop}
- if IOResult<>0 then
- begin
- Message1(exec_n_backquote_cat_file_not_found,para);
- end
- else
- begin
- while not eof(f) do
- begin
- readln(f,st);
- if st<>'' then
- filecontent:=filecontent+' '+st;
- end;
- close(f);
- end;
- CatFileContent:=filecontent;
- end;
- Function TExternalLinker.DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean;
- var
- exitcode: longint;
- begin
- DoExec:=true;
- if not(cs_link_nolink in current_settings.globalswitches) then
- begin
- FlushOutput;
- if useshell then
- exitcode:=shell(maybequoted(command)+' '+para)
- else
- try
- exitcode:=RequotedExecuteProcess(command,para);
- except on E:EOSError do
- begin
- Message(exec_e_cant_call_linker);
- current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
- DoExec:=false;
- end;
- end;
- if (exitcode<>0) then
- begin
- Message(exec_e_error_while_linking);
- current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
- DoExec:=false;
- end;
- end;
- { Update asmres when externmode is set }
- if cs_link_nolink in current_settings.globalswitches then
- begin
- if showinfo then
- begin
- if current_module.islibrary then
- AsmRes.AddLinkCommand(Command,Para,current_module.sharedlibfilename)
- else
- AsmRes.AddLinkCommand(Command,Para,current_module.exefilename);
- end
- else
- AsmRes.AddLinkCommand(Command,Para,'');
- end;
- end;
- Function TExternalLinker.MakeStaticLibrary:boolean;
- function GetNextFiles(const maxCmdLength : Longint; var item : TCmdStrListItem; const addfilecmd : string) : TCmdStr;
- begin
- result := '';
- while (assigned(item) and ((length(result) + length(item.str) + 1) < maxCmdLength)) do begin
- result := result + ' ' + addfilecmd + item.str;
- item := TCmdStrListItem(item.next);
- end;
- end;
- var
- binstr, firstbinstr, scriptfile : TCmdStr;
- cmdstr, firstcmd, nextcmd, smartpath : TCmdStr;
- current : TCmdStrListItem;
- script: Text;
- scripted_ar : boolean;
- ar_creates_different_output_file : boolean;
- success : boolean;
- first : boolean;
- begin
- MakeStaticLibrary:=false;
- { remove the library, to be sure that it is rewritten }
- DeleteFile(current_module.staticlibfilename);
- { Call AR }
- smartpath:=FixPath(ChangeFileExt(current_module.asmfilename,target_info.smartext),false);
- SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
- binstr := FindUtil(utilsprefix + binstr);
- if target_ar.arfirstcmd<>'' then
- begin
- SplitBinCmd(target_ar.arfirstcmd,firstbinstr,firstcmd);
- firstbinstr := FindUtil(utilsprefix + firstbinstr);
- end
- else
- begin
- firstbinstr:=binstr;
- firstcmd:=cmdstr;
- end;
- scripted_ar:=(target_ar.id=ar_gnu_ar_scripted) or
- (target_ar.id=ar_watcom_wlib_omf_scripted);
- if scripted_ar then
- begin
- scriptfile := FixFileName(smartpath+'arscript.txt');
- Replace(cmdstr,'$SCRIPT',maybequoted(scriptfile));
- Assign(script, scriptfile);
- Rewrite(script);
- try
- if (target_ar.id=ar_gnu_ar_scripted) then
- writeln(script, 'CREATE ' + current_module.staticlibfilename)
- else { wlib case }
- writeln(script,'-q -fo -c -b '+
- maybequoted(current_module.staticlibfilename));
- current := TCmdStrListItem(SmartLinkOFiles.First);
- while current <> nil do
- begin
- if (target_ar.id=ar_gnu_ar_scripted) then
- writeln(script, 'ADDMOD ' + current.str)
- else
- writeln(script,'+' + current.str);
- current := TCmdStrListItem(current.next);
- end;
- if (target_ar.id=ar_gnu_ar_scripted) then
- begin
- writeln(script, 'SAVE');
- writeln(script, 'END');
- end;
- finally
- Close(script);
- end;
- success:=DoExec(binstr,cmdstr,false,true);
- end
- else
- begin
- ar_creates_different_output_file:=(Pos('$OUTPUTLIB',cmdstr)>0) or (Pos('$OUTPUTLIB',firstcmd)>0);
- Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename));
- Replace(firstcmd,'$LIB',maybequoted(current_module.staticlibfilename));
- Replace(cmdstr,'$OUTPUTLIB',maybequoted(current_module.staticlibfilename+'.tmp'));
- Replace(firstcmd,'$OUTPUTLIB',maybequoted(current_module.staticlibfilename+'.tmp'));
- { create AR commands }
- success := true;
- current := TCmdStrListItem(SmartLinkOFiles.First);
- first := true;
- repeat
- if first then
- nextcmd := firstcmd
- else
- nextcmd := cmdstr;
- Replace(nextcmd,'$FILES',GetNextFiles(2047, current, target_ar.addfilecmd));
- if first then
- success:=DoExec(firstbinstr,nextcmd,false,true)
- else
- success:=DoExec(binstr,nextcmd,false,true);
- if ar_creates_different_output_file then
- begin
- if FileExists(current_module.staticlibfilename,false) then
- DeleteFile(current_module.staticlibfilename);
- if FileExists(current_module.staticlibfilename+'.tmp',false) then
- RenameFile(current_module.staticlibfilename+'.tmp',current_module.staticlibfilename);
- end;
- first := false;
- until (not assigned(current)) or (not success);
- end;
- if (target_ar.arfinishcmd <> '') then
- begin
- SplitBinCmd(target_ar.arfinishcmd,binstr,cmdstr);
- binstr := FindUtil(utilsprefix + binstr);
- Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename));
- success:=DoExec(binstr,cmdstr,false,true);
- end;
- { Clean up }
- if not(cs_asm_leave in current_settings.globalswitches) then
- if not(cs_link_nolink in current_settings.globalswitches) then
- begin
- while not SmartLinkOFiles.Empty do
- DeleteFile(SmartLinkOFiles.GetFirst);
- if scripted_ar then
- DeleteFile(scriptfile);
- RemoveDir(smartpath);
- end
- else
- begin
- while not SmartLinkOFiles.Empty do
- AsmRes.AddDeleteCommand(SmartLinkOFiles.GetFirst);
- if scripted_ar then
- AsmRes.AddDeleteCommand(scriptfile);
- AsmRes.AddDeleteDirCommand(smartpath);
- end;
- MakeStaticLibrary:=success;
- end;
- {*****************************************************************************
- TINTERNALLINKER
- *****************************************************************************}
- Constructor TInternalLinker.Create;
- begin
- inherited Create;
- linkscript:=TCmdStrList.Create;
- FStaticLibraryList:=TFPObjectList.Create(true);
- FImportLibraryList:=TFPHashObjectList.Create(true);
- FGroupStack:=TFPObjectList.Create(false);
- exemap:=nil;
- exeoutput:=nil;
- UseStabs:=false;
- CObjInput:=TObjInput;
- ScriptCount:=0;
- IsHandled:=nil;
- end;
- Destructor TInternalLinker.Destroy;
- begin
- FGroupStack.Free;
- linkscript.free;
- StaticLibraryList.Free;
- ImportLibraryList.Free;
- if assigned(IsHandled) then
- begin
- FreeMem(IsHandled,sizeof(boolean)*ScriptCount);
- IsHandled:=nil;
- ScriptCount:=0;
- end;
- if assigned(exeoutput) then
- begin
- exeoutput.free;
- exeoutput:=nil;
- end;
- if assigned(exemap) then
- begin
- exemap.free;
- exemap:=nil;
- end;
- inherited destroy;
- end;
- procedure TInternalLinker.AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);
- var
- ImportLibrary : TImportLibrary;
- ImportSymbol : TFPHashObject;
- begin
- ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname));
- if not assigned(ImportLibrary) then
- ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname);
- ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname));
- if not assigned(ImportSymbol) then
- ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,symmangledname,OrdNr,isvar);
- end;
- procedure TInternalLinker.ScriptAddSourceStatements(AddSharedAsStatic:boolean);
- var
- s,s2: TCmdStr;
- begin
- while not ObjectFiles.Empty do
- begin
- s:=ObjectFiles.GetFirst;
- if s<>'' then
- LinkScript.Concat('READOBJECT '+MaybeQuoted(s));
- end;
- while not StaticLibFiles.Empty do
- begin
- s:=StaticLibFiles.GetFirst;
- if s<>'' then
- LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s));
- end;
- if not AddSharedAsStatic then
- exit;
- while not SharedLibFiles.Empty do
- begin
- S:=SharedLibFiles.GetFirst;
- if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then
- LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s2))
- else
- Comment(V_Error,'Import library not found for '+S);
- end;
- end;
- function TInternalLinker.GetCodeSize(aExeOutput: TExeOutput): QWord;
- begin
- Result:=aExeOutput.findexesection('.text').size;
- end;
- function TInternalLinker.GetDataSize(aExeOutput: TExeOutput): QWord;
- begin
- Result:=aExeOutput.findexesection('.data').size;
- end;
- function TInternalLinker.GetBssSize(aExeOutput: TExeOutput): QWord;
- var
- bsssec: TExeSection;
- begin
- bsssec:=aExeOutput.findexesection('.bss');
- if assigned(bsssec) then
- Result:=bsssec.size
- else
- Result:=0;
- 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,asneeded);
- 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;
- objinput : TObjinput;
- objreader : TObjectReader;
- fn : TCmdStr;
- begin
- fn:=FindObjectFile(para,'',false);
- Comment(V_Tried,'Reading object '+fn);
- objinput:=CObjInput.Create;
- 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_ReadStaticLibrary(const para:TCmdStr;asneededflag:boolean);
- var
- objreader : TObjectReader;
- objinput: TObjInput;
- objdata: TObjData;
- ScriptLexer: TScriptLexer;
- stmt:TStaticLibrary;
- 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:=CArObjectreader.createAr(para,true);
- if ErrorCount>0 then
- exit;
- 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;
- if objinput.ReadObjData(objreader,objdata) then
- begin
- stmt:=TStaticLibrary.create_object(objdata);
- stmt.AsNeeded:=asneededflag;
- TFPObjectList(FGroupStack.Last).Add(stmt);
- 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;
- procedure TInternalLinker.Load_Group;
- var
- group: TStaticLibrary;
- begin
- group:=TStaticLibrary.create_group;
- TFPObjectList(FGroupStack.Last).Add(group);
- FGroupStack.Add(group.GroupMembers);
- end;
- procedure TInternalLinker.Load_EndGroup;
- begin
- FGroupStack.Delete(FGroupStack.Count-1);
- end;
- procedure TInternalLinker.ParseScript_Handle;
- var
- s{, para}, keyword : String;
- hp : TCmdStrListItem;
- i : longint;
- begin
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- s:=hp.str;
- if (s='') or (s[1]='#') then
- begin
- hp:=TCmdStrListItem(hp.next);
- continue;
- end;
- keyword:=Upper(GetToken(s,' '));
- {para:=}GetToken(s,' ');
- if Trim(s)<>'' then
- Comment(V_Warning,'Unknown part "'+s+'" in "'+hp.str+'" internal linker script');
- if (keyword<>'SYMBOL') and
- (keyword<>'SYMBOLS') and
- (keyword<>'STABS') and
- (keyword<>'PROVIDE') and
- (keyword<>'ZEROS') and
- (keyword<>'BYTE') and
- (keyword<>'WORD') and
- (keyword<>'LONG') and
- (keyword<>'QUAD') and
- (keyword<>'ENTRYNAME') and
- (keyword<>'ISSHAREDLIBRARY') and
- (keyword<>'IMAGEBASE') and
- (keyword<>'READOBJECT') and
- (keyword<>'READSTATICLIBRARY') and
- (keyword<>'EXESECTION') and
- (keyword<>'ENDEXESECTION') and
- (keyword<>'OBJSECTION') and
- (keyword<>'HEADER') and
- (keyword<>'GROUP') and
- (keyword<>'ENDGROUP')
- then
- Comment(V_Warning,'Unknown keyword "'+keyword+'" in "'+hp.str
- +'" internal linker script');
- hp:=TCmdStrListItem(hp.next);
- end;
- ScriptCount:=i;
- if ScriptCount>0 then
- begin
- GetMem(IsHandled,sizeof(boolean)*ScriptCount);
- Fillchar(IsHandled^,sizeof(boolean)*ScriptCount,#0);
- end;
- end;
- procedure TInternalLinker.ParseScript_PostCheck;
- var
- hp : TCmdStrListItem;
- i : longint;
- begin
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- if not IsHandled^[i] then
- begin
- Comment(V_Warning,'"'+hp.str+
- '" internal linker script not handled');
- end;
- hp:=TCmdStrListItem(hp.next);
- end;
- end;
- function TInternalLinker.ParsePara(const para : string) : string;
- var
- res : string;
- begin
- res:=trim(para);
- { Remove enclosing braces }
- if (length(res)>0) and (res[1]='(') and
- (res[length(res)]=')') then
- res:=trim(copy(res,2,length(res)-2));
- result:=res;
- end;
- procedure TInternalLinker.ParseScript_Load;
- var
- s,
- para,
- keyword : String;
- hp : TCmdStrListItem;
- i : longint;
- handled : boolean;
- begin
- exeoutput.Load_Start;
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- s:=hp.str;
- if (s='') or (s[1]='#') then
- begin
- IsHandled^[i]:=true;
- hp:=TCmdStrListItem(hp.next);
- continue;
- end;
- handled:=true;
- keyword:=Upper(GetToken(s,' '));
- para:=ParsePara(GetToken(s,' '));
- if keyword='SYMBOL' then
- ExeOutput.Load_Symbol(para)
- else if keyword='PROVIDE' then
- ExeOutput.Load_ProvideSymbol(para)
- else if keyword='ENTRYNAME' then
- ExeOutput.Load_EntryName(para)
- else if keyword='ISSHAREDLIBRARY' then
- ExeOutput.Load_IsSharedLibrary
- else if keyword='IMAGEBASE' then
- ExeOutput.Load_ImageBase(para)
- else if keyword='READOBJECT' then
- Load_ReadObject(para)
- else if keyword='STABS' then
- UseStabs:=true
- else if keyword='READSTATICLIBRARY' then
- Load_ReadStaticLibrary(para)
- else if keyword='GROUP' then
- Load_Group
- else if keyword='ENDGROUP' then
- Load_EndGroup
- else
- handled:=false;
- if handled then
- IsHandled^[i]:=true;
- hp:=TCmdStrListItem(hp.next);
- end;
- end;
- procedure TInternalLinker.ParseScript_Order;
- var
- s,
- para,
- keyword : String;
- hp : TCmdStrListItem;
- i : longint;
- handled : boolean;
- begin
- exeoutput.Order_Start;
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- s:=hp.str;
- if (s='') or (s[1]='#') then
- begin
- hp:=TCmdStrListItem(hp.next);
- continue;
- end;
- handled:=true;
- keyword:=Upper(GetToken(s,' '));
- para:=ParsePara(GetToken(s,' '));
- if keyword='EXESECTION' then
- ExeOutput.Order_ExeSection(para)
- else if keyword='ENDEXESECTION' then
- ExeOutput.Order_EndExeSection
- else if keyword='OBJSECTION' then
- ExeOutput.Order_ObjSection(para)
- else if keyword='ZEROS' then
- ExeOutput.Order_Zeros(para)
- else if keyword='BYTE' then
- ExeOutput.Order_Values(1,para)
- else if keyword='WORD' then
- ExeOutput.Order_Values(2,para)
- else if keyword='LONG' then
- ExeOutput.Order_Values(4,para)
- else if keyword='QUAD' then
- ExeOutput.Order_Values(8,para)
- else if keyword='SYMBOL' then
- ExeOutput.Order_Symbol(para)
- else if keyword='PROVIDE' then
- ExeOutput.Order_ProvideSymbol(para)
- else
- handled:=false;
- if handled then
- IsHandled^[i]:=true;
- hp:=TCmdStrListItem(hp.next);
- end;
- exeoutput.Order_End;
- end;
- procedure TInternalLinker.ParseScript_MemPos;
- var
- s,
- para,
- keyword : String;
- hp : TCmdStrListItem;
- i : longint;
- handled : boolean;
- begin
- exeoutput.MemPos_Start;
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- s:=hp.str;
- if (s='') or (s[1]='#') then
- begin
- hp:=TCmdStrListItem(hp.next);
- continue;
- end;
- handled:=true;
- keyword:=Upper(GetToken(s,' '));
- para:=ParsePara(GetToken(s,' '));
- if keyword='EXESECTION' then
- ExeOutput.MemPos_ExeSection(para)
- else if keyword='ENDEXESECTION' then
- ExeOutput.MemPos_EndExeSection
- else if keyword='HEADER' then
- ExeOutput.MemPos_Header
- else
- handled:=false;
- if handled then
- IsHandled^[i]:=true;
- hp:=TCmdStrListItem(hp.next);
- end;
- end;
- procedure TInternalLinker.ParseScript_DataPos;
- var
- s,
- para,
- keyword : String;
- hp : TCmdStrListItem;
- i : longint;
- handled : boolean;
- begin
- exeoutput.DataPos_Start;
- hp:=TCmdStrListItem(linkscript.first);
- i:=0;
- while assigned(hp) do
- begin
- inc(i);
- s:=hp.str;
- if (s='') or (s[1]='#') then
- begin
- hp:=TCmdStrListItem(hp.next);
- continue;
- end;
- handled:=true;
- keyword:=Upper(GetToken(s,' '));
- para:=ParsePara(GetToken(s,' '));
- if keyword='EXESECTION' then
- ExeOutput.DataPos_ExeSection(para)
- else if keyword='ENDEXESECTION' then
- ExeOutput.DataPos_EndExeSection
- else if keyword='HEADER' then
- ExeOutput.DataPos_Header
- else if keyword='SYMBOLS' then
- ExeOutput.DataPos_Symbols
- else
- handled:=false;
- if handled then
- IsHandled^[i]:=true;
- hp:=TCmdStrListItem(hp.next);
- end;
- end;
- procedure TInternalLinker.PrintLinkerScript;
- var
- hp : TCmdStrListItem;
- begin
- if not assigned(exemap) then
- exit;
- exemap.Add('Used linker script');
- exemap.Add('');
- hp:=TCmdStrListItem(linkscript.first);
- while assigned(hp) do
- begin
- exemap.Add(hp.str);
- hp:=TCmdStrListItem(hp.next);
- end;
- end;
- function TInternalLinker.RunLinkScript(const outputname:TCmdStr):boolean;
- label
- myexit;
- var
- bsssize : aword;
- dbgname : TCmdStr;
- begin
- result:=false;
- Message1(exec_i_linking,outputname);
- FlushOutput;
- exeoutput:=CExeOutput.Create;
- { TODO: Load custom linker script}
- DefaultLinkScript;
- if (cs_link_map in current_settings.globalswitches) then
- exemap:=texemap.create(current_module.mapfilename);
- PrintLinkerScript;
- { Check that syntax is OK }
- ParseScript_Handle;
- { Load .o files and resolve symbols }
- FGroupStack.Add(FStaticLibraryList);
- ParseScript_Load;
- if ErrorCount>0 then
- goto myexit;
- exeoutput.ResolveSymbols(StaticLibraryList);
- { Generate symbols and code to do the importing }
- exeoutput.GenerateLibraryImports(ImportLibraryList);
- { Fill external symbols data }
- exeoutput.FixupSymbols;
- if ErrorCount>0 then
- goto myexit;
- { parse linker options specific for output format }
- exeoutput.ParseScript (linkscript);
- { Create .exe sections and add .o sections }
- ParseScript_Order;
- exeoutput.RemoveUnreferencedSections;
- { if UseStabs then, this would remove
- STABS for empty linker scripts }
- exeoutput.MergeStabs;
- exeoutput.MarkEmptySections;
- exeoutput.AfterUnusedSectionRemoval;
- if ErrorCount>0 then
- goto myexit;
- { Calc positions in mem }
- ParseScript_MemPos;
- exeoutput.FixupRelocations;
- exeoutput.RemoveUnusedExeSymbols;
- exeoutput.PrintMemoryMap;
- if ErrorCount>0 then
- goto myexit;
- if cs_link_separate_dbg_file in current_settings.globalswitches then
- begin
- { create debuginfo, which is an executable without data on disk }
- dbgname:=ChangeFileExt(outputname,'.dbg');
- exeoutput.ExeWriteMode:=ewm_dbgonly;
- ParseScript_DataPos;
- exeoutput.WriteExeFile(dbgname);
- { create executable with link to just created debuginfo file }
- exeoutput.ExeWriteMode:=ewm_exeonly;
- exeoutput.RemoveDebugInfo;
- exeoutput.GenerateDebugLink(ExtractFileName(dbgname),GetFileCRC(dbgname));
- ParseScript_MemPos;
- ParseScript_DataPos;
- exeoutput.WriteExeFile(outputname);
- end
- else
- begin
- exeoutput.ExeWriteMode:=ewm_exefull;
- ParseScript_DataPos;
- exeoutput.WriteExeFile(outputname);
- end;
- { Post check that everything was handled }
- ParseScript_PostCheck;
- status.codesize:=GetCodeSize(exeoutput);
- status.datasize:=GetDataSize(exeoutput);
- bsssize:=GetBssSize(exeoutput);
- { Executable info }
- Message1(execinfo_x_codesize,tostr(status.codesize));
- Message1(execinfo_x_initdatasize,tostr(status.datasize));
- Message1(execinfo_x_uninitdatasize,tostr(bsssize));
- Message1(execinfo_x_stackreserve,tostr(stacksize));
- myexit:
- { close map }
- if assigned(exemap) then
- begin
- exemap.free;
- exemap:=nil;
- end;
- { close exe }
- exeoutput.free;
- exeoutput:=nil;
- result:=true;
- end;
- function TInternalLinker.MakeExecutable:boolean;
- begin
- IsSharedLibrary:=false;
- result:=RunLinkScript(current_module.exefilename);
- {$ifdef hasUnix}
- fpchmod(current_module.exefilename,493);
- {$endif hasUnix}
- end;
- function TInternalLinker.MakeSharedLibrary:boolean;
- begin
- IsSharedLibrary:=true;
- result:=RunLinkScript(current_module.sharedlibfilename);
- end;
- procedure TInternalLinker.ScriptAddGenericSections(secnames:string);
- var
- secname:string;
- begin
- repeat
- secname:=gettoken(secnames,',');
- if secname='' then
- break;
- linkscript.Concat('EXESECTION '+secname);
- linkscript.Concat(' OBJSECTION '+secname+'*');
- linkscript.Concat('ENDEXESECTION');
- until false;
- end;
- {*****************************************************************************
- Init/Done
- *****************************************************************************}
- procedure RegisterLinker(id:tlink;c:TLinkerClass);
- begin
- CLinker[id]:=c;
- end;
- procedure InitLinker;
- begin
- if (cs_link_extern in current_settings.globalswitches) and
- assigned(CLinker[target_info.linkextern]) then
- begin
- linker:=CLinker[target_info.linkextern].Create;
- end
- else
- if assigned(CLinker[target_info.link]) then
- begin
- linker:=CLinker[target_info.link].Create;
- end
- else
- linker:=Tlinker.Create;
- end;
- procedure DoneLinker;
- begin
- if assigned(linker) then
- Linker.Free;
- end;
- {*****************************************************************************
- Initialize
- *****************************************************************************}
- const
- ar_gnu_ar_info : tarinfo =
- (
- id : ar_gnu_ar;
- addfilecmd : '';
- arfirstcmd : '';
- arcmd : 'ar qS $LIB $FILES';
- arfinishcmd : 'ar s $LIB'
- );
- ar_gnu_ar_scripted_info : tarinfo =
- (
- id : ar_gnu_ar_scripted;
- addfilecmd : '';
- arfirstcmd : '';
- arcmd : 'ar -M < $SCRIPT';
- arfinishcmd : ''
- );
- ar_gnu_gar_info : tarinfo =
- ( id : ar_gnu_gar;
- addfilecmd : '';
- arfirstcmd : '';
- arcmd : 'gar qS $LIB $FILES';
- arfinishcmd : 'gar s $LIB'
- );
- ar_watcom_wlib_omf_info : tarinfo =
- ( id : ar_watcom_wlib_omf;
- addfilecmd : '+';
- arfirstcmd : 'wlib -q -fo -c -b -n -o=$OUTPUTLIB $LIB $FILES';
- arcmd : 'wlib -q -fo -c -b -o=$OUTPUTLIB $LIB $FILES';
- arfinishcmd : ''
- );
- ar_watcom_wlib_omf_scripted_info : tarinfo =
- (
- id : ar_watcom_wlib_omf_scripted;
- addfilecmd : '+';
- arfirstcmd : '';
- arcmd : 'wlib @$SCRIPT';
- arfinishcmd : ''
- );
- initialization
- RegisterAr(ar_gnu_ar_info);
- RegisterAr(ar_gnu_ar_scripted_info);
- RegisterAr(ar_gnu_gar_info);
- RegisterAr(ar_watcom_wlib_omf_info);
- RegisterAr(ar_watcom_wlib_omf_scripted_info);
- end.
|