* Improve ogbase linker script support, add warnings for unknown entries

git-svn-id: trunk@17784 -

compiler/link.pas

@@ -93,6 +93,7 @@ interface
          FImportLibraryList : TFPHashObjectList;
          procedure Load_ReadObject(const para:TCmdStr);
          procedure Load_ReadStaticLibrary(const para:TCmdStr);
+         procedure ParseScript_Handle;
          procedure ParseScript_Load;
          procedure ParseScript_Order;
          procedure ParseScript_MemPos;
@@ -371,6 +372,7 @@ Implementation
                    mask:=mask or link_static;
                end;
               { smart linking ? }
+
               if (cs_link_smart in current_settings.globalswitches) then
                begin
                  if (flags and uf_smart_linked)=0 then
@@ -882,6 +884,47 @@ Implementation
       end;
 
 
+    procedure TInternalLinker.ParseScript_Handle;
+      var
+        s,
+        para,
+        keyword : String;
+        hp : TCmdStrListItem;
+      begin
+        exeoutput.Load_Start;
+        hp:=TCmdStrListItem(linkscript.first);
+        while assigned(hp) do
+          begin
+            s:=hp.str;
+            if (s='') or (s[1]='#') then
+              continue;
+            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<>'PROVIDE') and
+               (keyword<>'ZEROES') 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')
+               then
+              Comment(V_Warning,'Unknown keyword "'+keyword+'" in "'+hp.str
+                +'" internal linker script');
+            hp:=TCmdStrListItem(hp.next);
+          end;
+      end;
+
     procedure TInternalLinker.ParseScript_Load;
       var
         s,
@@ -900,6 +943,8 @@ Implementation
             para:=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
@@ -939,8 +984,18 @@ Implementation
               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);
+              ExeOutput.Order_Symbol(para)
+            else if keyword='PROVIDE' then
+              ExeOutput.Order_ProvideSymbol(para);
             hp:=TCmdStrListItem(hp.next);
           end;
         exeoutput.Order_End;

compiler/ogbase.pas

@@ -413,6 +413,7 @@ interface
         FCurrExeSec       : TExeSection;
         FExeSectionList   : TFPHashObjectList;
         Fzeronr           : longint;
+        Fvaluesnr         : longint;
         { Symbols }
         FExeSymbolList    : TFPHashObjectList;
         FUnresolvedExeSymbols : TFPObjectList;
@@ -450,6 +451,7 @@ interface
         procedure Load_Start;virtual;
         procedure Load_EntryName(const aname:string);virtual;
         procedure Load_Symbol(const aname:string);virtual;
+        procedure Load_ProvideSymbol(const aname:string);virtual;
         procedure Load_IsSharedLibrary;
         procedure Load_ImageBase(const avalue:string);
         procedure Order_Start;virtual;
@@ -457,7 +459,9 @@ interface
         procedure Order_ExeSection(const aname:string);virtual;
         procedure Order_Align(const avalue:string);virtual;
         procedure Order_Zeros(const avalue:string);virtual;
+        procedure Order_Values(bytesize : aword; const avalue:string);virtual;
         procedure Order_Symbol(const aname:string);virtual;
+        procedure Order_ProvideSymbol(const aname:string);virtual;
         procedure Order_EndExeSection;virtual;
         procedure Order_ObjSection(const aname:string);virtual;
         procedure MemPos_Start;virtual;
@@ -549,9 +553,15 @@ implementation
           internalerror(200603016);
         if not assigned(aobjsec) then
           internalerror(200603017);
-        if (bind in [AB_EXTERNAL,AB_LAZY]) then
+        if (bind in [AB_EXTERNAL,AB_LAZY]) or
+          { Put all COMMON to GLOBAL in step 3 of
+            TExeOutput.ResolveSymbols }
+           ((abind=AB_GLOBAL) and (bind=AB_COMMON)) then
           begin
-            bind:=abind;
+            { Do not change the AB_TYPE of common symbols yet }
+            { This will be done in FixupSymbols }
+            if (pass<>0) or (bind<>AB_COMMON) then
+              bind:=abind;
             typ:=atyp;
           end
         else
@@ -1620,6 +1630,15 @@ implementation
         internalObjData.SymbolDefine(aname,AB_GLOBAL,AT_FUNCTION);
       end;
 
+    procedure TExeOutput.Load_ProvideSymbol(const aname:string);
+      begin
+        if assigned(ExeSymbolList.Find(aname)) then
+          exit;
+        internalObjData.createsection('*'+aname,0,[]);
+        // Use AB_COMMON to avoid muliple defined complaints
+        internalObjData.SymbolDefine(aname,AB_COMMON,AT_DATA);
+      end;
+
 
     procedure TExeOutput.Order_Start;
       begin
@@ -1700,6 +1719,19 @@ implementation
         CurrExeSec.AddObjSection(ObjSection);
       end;
 
+    procedure TExeOutput.Order_ProvideSymbol(const aname:string);
+      var
+        ObjSection : TObjSection;
+      begin
+        ObjSection:=internalObjData.findsection('*'+aname);
+        if not assigned(ObjSection) then
+          internalerror(200603041);
+        { Only include this section if the symbol doesn't
+          exist otherwisee }
+        if not assigned(ExeSymbolList.Find(aname)) then
+          CurrExeSec.AddObjSection(ObjSection);
+      end;
+
 
     procedure TExeOutput.Order_Align(const avalue:string);
       var
@@ -1740,6 +1772,86 @@ implementation
         CurrExeSec.AddObjSection(objsec);
       end;
 
+    procedure TExeOutput.Order_Values(bytesize : aword; const avalue:string);
+      const
+        MAXVAL = 128;
+      var
+        bytevalues : array[0..MAXVAL-1] of byte;
+        twobytevalues : array[0..MAXVAL-1] of word;
+        fourbytevalues : array[0..MAXVAL-1] of dword;
+        eightbytevalues : array[0..MAXVAL-1] of qword;
+        allvals, oneval : string;
+        len, commapos : longint;
+        indexpos, code  : integer;
+        anumval : qword;
+        signedval : int64;
+        objsec : TObjSection;
+      begin
+        indexpos:=0;
+        allvals:=avalue;
+        repeat
+          commapos:=pos(',',allvals);
+          if commapos>0 then
+            begin
+              oneval:=trim(copy(allvals,1,commapos-1));
+              allvals:=copy(allvals,commapos+1,length(allvals));
+            end
+          else
+            begin
+              oneval:=trim(allvals);
+              allvals:='';
+            end;
+          if oneval<>'' then
+            begin
+              if oneval[1]='-' then
+                val(oneval,signedval,code)
+              else
+                val(oneval,anumval,code);
+              if code<>0 then
+                Comment(V_Error,'Invalid number '+avalue)
+              else if (indexpos<MAXVAL) then
+                begin
+                  anumval:=qword(signedval);
+                  if source_info.endian<>target_info.endian then
+                    swapendian(anumval);
+                  { No range checking here }
+
+                  if bytesize=1 then
+                    bytevalues[indexpos]:=byte(anumval)
+                  else if bytesize=2 then
+                    twobytevalues[indexpos]:=word(anumval)
+                  else if bytesize=4 then
+                    fourbytevalues[indexpos]:=dword(anumval)
+                  else if bytesize=8 then
+                    eightbytevalues[indexpos]:=anumval;
+                  inc(indexpos);
+                end;
+            end;
+        until allvals='';
+        if indexpos=0 then
+          begin
+            Comment(V_Error,'Invalid number '+avalue);
+            exit;
+          end;
+        if indexpos=MAXVAL then
+          begin
+            Comment(V_Error,'Too many values '+avalue);
+            internalerror(200602254);
+          end;
+        len:=bytesize*indexpos;
+        inc(Fvaluesnr);
+        objsec:=internalObjData.createsection('*values'+tostr(Fvaluesnr),0,CurrExeSec.SecOptions+[oso_Data,oso_keep]);
+        if bytesize=1 then
+          internalObjData.writebytes(bytevalues,len)
+        else if bytesize=2 then
+          internalObjData.writebytes(twobytevalues,len)
+        else if bytesize=4 then
+          internalObjData.writebytes(fourbytevalues,len)
+        else if bytesize=8 then
+          internalObjData.writebytes(eightbytevalues,len);
+        CurrExeSec.AddObjSection(objsec);
+      end;
+
 
     procedure TExeOutput.MemPos_Start;
       begin

compiler/systems/t_win.pas

@@ -1019,6 +1019,31 @@ implementation
             Concat('  OBJSECTION .bss*');
             Concat('  SYMBOL __bss_end__');
             Concat('ENDEXESECTION');
+            Concat('EXESECTION .tls');
+            Concat('  SYMBOL __tls_start__');
+            Concat('  OBJSECTION .tls*');
+            Concat('  SYMBOL __tls_end__');
+            Concat('ENDEXESECTION');
+            Concat('EXESECTION .CRT');
+            Concat('  SYMBOL ___crt_xc_start__');
+            Concat('  OBJSECTION .CRT$XC*');{  /* C initialization */');}
+            Concat('  SYMBOL ___crt_xc_end__');
+            Concat('  SYMBOL ___crt_xi_start__');
+            Concat('  OBJSECTION .CRT$XI*');{  /* C++ initialization */');}
+            Concat('  SYMBOL ___crt_xi_end__');
+            Concat('  SYMBOL ___crt_xl_start__');
+            Concat('  OBJSECTION .CRT$XL*'); {  /* TLS callbacks */'); }
+            { In GNU ld, this is defined in the TLS Directory support code }
+            Concat('  PROVIDE(___crt_xl_end__)');
+            { Add a nil pointer as last element }
+            Concat('  LONG 0');
+            Concat('  SYMBOL ___crt_xp_start__');
+            Concat('  OBJSECTION SORT(.CRT$XP*'); {  /* Pre-termination */');}
+            Concat('  SYMBOL ___crt_xp_end__');
+            Concat('  SYMBOL ___crt_xt_start__');
+            Concat('  OBJSECTION SORT(.CRT$XT*');{  /* Termination */');}
+            Concat('  SYMBOL ___crt_xt_end__');
+            Concat('ENDEXESECTION');
             Concat('EXESECTION .idata');
             Concat('  OBJSECTION .idata$2*');
             Concat('  OBJSECTION .idata$3*');
@@ -1286,6 +1311,7 @@ implementation
             Add('    ___crt_xl_start__ = . ;');
             Add('    *(SORT(.CRT$XL*))  /* TLS callbacks */');
             Add('    /* ___crt_xl_end__ is defined in the TLS Directory support code */');
+            Add('    PROVIDE (___crt_xl_end__ = .);');
             Add('    ___crt_xp_start__ = . ;');
             Add('    *(SORT(.CRT$XP*))  /* Pre-termination */');
             Add('    ___crt_xp_end__ = . ;');