mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 21:09:24 +02:00
* Initial linkordering subsystem. Not active (need t_* mods which I want in a different revision to ease merging)
git-svn-id: trunk@3788 -
This commit is contained in:
parent
a24a329d1c
commit
179451dcfd
@ -520,6 +520,36 @@ type
|
||||
end;
|
||||
|
||||
|
||||
Const WeightDefault = 100;
|
||||
|
||||
Type
|
||||
TLinkRec = record
|
||||
Key : AnsiString;
|
||||
Value : AnsiString; // key expands to valuelist "value"
|
||||
Weight: longint;
|
||||
end;
|
||||
|
||||
TLinkStrMap = class
|
||||
private
|
||||
itemcnt : longint;
|
||||
fmap : Array Of TLinkRec;
|
||||
function Lookup(key:Ansistring):longint;
|
||||
function getlinkrec(i:longint):TLinkRec;
|
||||
public
|
||||
procedure Add(key:ansistring;value:AnsiString='';weight:longint=weightdefault);
|
||||
procedure addseries(keys:AnsiString;weight:longint=weightdefault);
|
||||
function AddDep(keyvalue:String):boolean;
|
||||
function AddWeight(keyvalue:String):boolean;
|
||||
procedure SetValue(key:AnsiString;Weight:Integer);
|
||||
procedure SortonWeight;
|
||||
function Find(key:AnsiString):AnsiString;
|
||||
procedure Expand(src:TStringList;dest: TLinkStrMap);
|
||||
procedure UpdateWeights(Weightmap:TLinkStrMap);
|
||||
constructor Create;
|
||||
property count : longint read itemcnt;
|
||||
property items[I:longint]:TLinkRec read getlinkrec; default;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{*****************************************************************************
|
||||
@ -3275,5 +3305,168 @@ end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
TLinkStrMap
|
||||
****************************************************************************}
|
||||
|
||||
Constructor TLinkStrMap.create;
|
||||
|
||||
begin
|
||||
inherited;
|
||||
itemcnt:=0;
|
||||
end;
|
||||
|
||||
procedure TLinkStrMap.Add(key:ansistring;value:AnsiString='';weight:longint=weightdefault);
|
||||
|
||||
begin
|
||||
if lookup(key)<>-1 Then
|
||||
exit;
|
||||
if itemcnt<=length(fmap) Then
|
||||
setlength(fmap,itemcnt+10);
|
||||
fmap[itemcnt].key:=key;
|
||||
fmap[itemcnt].value:=value;
|
||||
fmap[itemcnt].weight:=weight;
|
||||
inc(itemcnt);
|
||||
end;
|
||||
|
||||
function TLinkStrMap.AddDep(keyvalue:String):boolean;
|
||||
|
||||
var i : Longint;
|
||||
|
||||
begin
|
||||
AddDep:=false;
|
||||
i:=pos('=',keyvalue);
|
||||
if i=0 then
|
||||
exit;
|
||||
Add(Copy(KeyValue,1,i-1),Copy(KeyValue,i+1,length(KeyValue)-i));
|
||||
AddDep:=True;
|
||||
end;
|
||||
|
||||
function TLinkStrMap.AddWeight(keyvalue:String):boolean;
|
||||
|
||||
var i : Longint;
|
||||
Code : Word;
|
||||
s : AnsiString;
|
||||
|
||||
begin
|
||||
AddWeight:=false;
|
||||
i:=pos('=',keyvalue);
|
||||
if i=0 then
|
||||
exit;
|
||||
s:=Copy(KeyValue,i+1,length(KeyValue)-i);
|
||||
val(s,i,code);
|
||||
if code<>0 Then
|
||||
begin
|
||||
Add(Copy(KeyValue,1,i-1),'',i);
|
||||
AddWeight:=True;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TLinkStrMap.addseries(keys:AnsiString;weight:longint);
|
||||
|
||||
var i,j,k : longint;
|
||||
begin
|
||||
k:=length(keys);
|
||||
i:=1;
|
||||
while i<=k do
|
||||
begin
|
||||
j:=i;
|
||||
while (i<=k) and (keys[i]<>';') do
|
||||
inc(i);
|
||||
add(copy(keys,j,i-j),'',weight);
|
||||
inc(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TLinkStrMap.SetValue(Key:Ansistring;weight:Integer);
|
||||
|
||||
var j : longint;
|
||||
|
||||
begin
|
||||
j:=lookup(key);
|
||||
if j<>-1 then
|
||||
fmap[j].weight:=weight;
|
||||
end;
|
||||
|
||||
function TLinkStrMap.find(key:Ansistring):Ansistring;
|
||||
|
||||
var j : longint;
|
||||
|
||||
begin
|
||||
find:='';
|
||||
j:=lookup(key);
|
||||
if j<>-1 then
|
||||
find:=fmap[j].value;
|
||||
end;
|
||||
|
||||
function TLinkStrMap.lookup(key:Ansistring):longint;
|
||||
|
||||
var i : longint;
|
||||
|
||||
begin
|
||||
lookup:=-1;
|
||||
i:=0;
|
||||
{$B-}
|
||||
while (i<itemcnt) and (fmap[i].key<>key) do inc(i);
|
||||
{$B+}
|
||||
if i<>itemcnt then
|
||||
lookup:=i;
|
||||
end;
|
||||
|
||||
procedure TLinkStrMap.SortOnWeight;
|
||||
|
||||
var i, j : longint;
|
||||
m : TLinkRec;
|
||||
begin
|
||||
if itemcnt <2 then exit;
|
||||
for i:=0 to itemcnt-1 do
|
||||
for j:=i+1 to itemcnt-1 do
|
||||
begin
|
||||
if fmap[i].weight>fmap[j].weight Then
|
||||
begin
|
||||
m:=fmap[i];
|
||||
fmap[i]:=fmap[j];
|
||||
fmap[j]:=m;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TLinkStrMap.getlinkrec(i:longint):TLinkRec;
|
||||
|
||||
begin
|
||||
result:=fmap[i];
|
||||
end;
|
||||
|
||||
procedure TLinkStrMap.Expand(Src:TStringList;Dest:TLinkStrMap);
|
||||
// expands every thing in Src to Dest for linkorder purposes.
|
||||
|
||||
var l,r : longint;
|
||||
LibN : String;
|
||||
|
||||
begin
|
||||
while not src.empty do
|
||||
begin
|
||||
LibN:=src.getfirst;
|
||||
r:=lookup (LibN);
|
||||
if r=-1 then
|
||||
dest.add(LibN)
|
||||
else
|
||||
dest.addseries(fmap[r].value);
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TLinkStrMap.UpdateWeights(Weightmap:TLinkStrMap);
|
||||
|
||||
var l,r : longint;
|
||||
begin
|
||||
for l := 0 to itemcnt-1 do
|
||||
begin
|
||||
r:=weightmap.lookup (fmap[l].key);
|
||||
if r<>-1 then
|
||||
fmap[l].weight:=weightmap[r].weight;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
@ -203,6 +203,9 @@ interface
|
||||
inlining_procedure : boolean; { are we inlining a procedure }
|
||||
exceptblockcounter : integer; { each except block gets a unique number check gotos }
|
||||
aktexceptblock : integer; { the exceptblock number of the current block (0 if none) }
|
||||
LinkLibraryAliases : TLinkStrMap;
|
||||
LinkLibraryOrder : TLinkStrMap;
|
||||
|
||||
|
||||
{ commandline values }
|
||||
initglobalswitches : tglobalswitches;
|
||||
@ -2314,6 +2317,10 @@ end;
|
||||
{$endif x86_64}
|
||||
if initoptimizecputype=cpu_none then
|
||||
initoptimizecputype:=initcputype;
|
||||
|
||||
LinkLibraryAliases :=TLinkStrMap.Create;
|
||||
LinkLibraryOrder :=TLinkStrMap.Create;
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
|
@ -63,6 +63,8 @@ Type
|
||||
Function MakeExecutable:boolean;virtual;
|
||||
Function MakeSharedLibrary:boolean;virtual;
|
||||
Function MakeStaticLibrary:boolean;virtual;
|
||||
procedure ExpandAndApplyOrder(var Src:TStringList);
|
||||
procedure LoadPredefinedLibraryOrder;virtual;
|
||||
end;
|
||||
|
||||
TExternalLinker = class(TLinker)
|
||||
@ -493,6 +495,36 @@ begin
|
||||
Message(exec_e_dll_not_supported);
|
||||
end;
|
||||
|
||||
Procedure TLinker.ExpandAndApplyOrder(var Src:TStringList);
|
||||
|
||||
var p : TLinkStrMap;
|
||||
i : Integer;
|
||||
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);
|
||||
|
||||
// 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;
|
||||
|
||||
{*****************************************************************************
|
||||
TEXTERNALLINKER
|
||||
|
@ -26,9 +26,9 @@ unit options;
|
||||
interface
|
||||
|
||||
uses
|
||||
globtype,globals,verbose,systems,cpuinfo;
|
||||
CClasses,globtype,globals,verbose,systems,cpuinfo;
|
||||
|
||||
type
|
||||
Type
|
||||
TOption=class
|
||||
FirstPass,
|
||||
ParaLogo,
|
||||
@ -76,7 +76,7 @@ uses
|
||||
{$ENDIF USE_SYSUTILS}
|
||||
version,
|
||||
cutils,cmsgs,
|
||||
comphook,
|
||||
comphook,
|
||||
symtable,scanner,rabase
|
||||
{$ifdef BrowserLog}
|
||||
,browlog
|
||||
@ -108,8 +108,6 @@ begin
|
||||
initglobalswitches:=initglobalswitches-[cs_link_shared,cs_link_smart];
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Toption
|
||||
****************************************************************************}
|
||||
@ -1279,6 +1277,25 @@ begin
|
||||
DefaultReplacements(utilsprefix);
|
||||
More:='';
|
||||
end;
|
||||
'L' : begin // -XLO is link order -XLA is link alias
|
||||
if (j=length(more)) or not ((more[j+1]='O') or (more[j+1]='A')) then
|
||||
IllegalPara(opt)
|
||||
else
|
||||
begin
|
||||
case more[j+1] of
|
||||
'A' : begin
|
||||
s:=Copy(more,3,length(More)-2);
|
||||
if not LinkLibraryAliases.AddDep(s) Then
|
||||
IllegalPara(opt);
|
||||
end;
|
||||
'O' : begin
|
||||
s:=Copy(more,3,length(More)-2);
|
||||
if not LinkLibraryAliases.AddWeight(s) Then
|
||||
IllegalPara(opt);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
'S' :
|
||||
begin
|
||||
def_system_macro('FPC_LINK_STATIC');
|
||||
|
Loading…
Reference in New Issue
Block a user