Sfoglia il codice sorgente

* Initial linkordering subsystem. Not active (need t_* mods which I want in a different revision to ease merging)

git-svn-id: trunk@3788 -
marco 19 anni fa
parent
commit
179451dcfd
4 ha cambiato i file con 254 aggiunte e 5 eliminazioni
  1. 193 0
      compiler/cclasses.pas
  2. 7 0
      compiler/globals.pas
  3. 32 0
      compiler/link.pas
  4. 22 5
      compiler/options.pas

+ 193 - 0
compiler/cclasses.pas

@@ -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.

+ 7 - 0
compiler/globals.pas

@@ -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.

+ 32 - 0
compiler/link.pas

@@ -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

+ 22 - 5
compiler/options.pas

@@ -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');