* support static library (.a) linking

  * move win linker script to t_win
  * rename some win32 to win in t_win

git-svn-id: trunk@3991 -

compiler/link.pas

@@ -64,7 +64,7 @@ Type
        Function  MakeSharedLibrary:boolean;virtual;
        Function  MakeStaticLibrary:boolean;virtual;
        procedure ExpandAndApplyOrder(var Src:TStringList);
-       procedure LoadPredefinedLibraryOrder;virtual; 
+       procedure LoadPredefinedLibraryOrder;virtual;
        function  ReOrderEntries : boolean;
      end;
 
@@ -84,9 +84,10 @@ Type
        FCExeOutput : TExeOutputClass;
        FCObjInput  : TObjInputClass;
        { Libraries }
+       FStaticLibraryList : TFPHashObjectList;
        FExternalLibraryList : TFPHashObjectList;
        procedure Load_ReadObject(const para:string);
-       procedure Load_ReadUnitObjects;
+       procedure Load_ReadStaticLibrary(const para:string);
        procedure ParseScript_Load;
        procedure ParseScript_Order;
        procedure ParseScript_CalcPos;
@@ -95,6 +96,7 @@ Type
     protected
        property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
        property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
+       property StaticLibraryList:TFPHashObjectList read FStaticLibraryList;
        property ExternalLibraryList:TFPHashObjectList read FExternalLibraryList;
        procedure DefaultLinkScript;virtual;abstract;
        linkscript : TStringList;
@@ -131,7 +133,7 @@ uses
   script,globals,verbose,comphook,ppu,
   aasmbase,aasmtai,aasmdata,aasmcpu,
   symbase,symdef,symtype,symconst,
-  ogmap;
+  owbase,owar,ogmap;
 
 type
  TLinkerClass = class of Tlinker;
@@ -505,18 +507,18 @@ begin
   LoadPredefinedLibraryOrder;
 
   // something to do?
-  if (LinkLibraryAliases.count=0) and (LinkLibraryOrder.Count=0) Then 
+  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.UpdateWeights(LinkLibraryOrder);
   p.SortOnWeight;
-  
+
   // put back in src
   for i:=0 to p.count-1 do
     src.insert(p[i].Key);
@@ -773,6 +775,7 @@ end;
       begin
         inherited Create;
         linkscript:=TStringList.Create;
+        FStaticLibraryList:=TFPHashObjectList.Create(true);
         FExternalLibraryList:=TFPHashObjectList.Create(true);
         exemap:=nil;
         exeoutput:=nil;
@@ -783,6 +786,7 @@ end;
     Destructor TInternalLinker.Destroy;
       begin
         linkscript.free;
+        StaticLibraryList.Free;
         ExternalLibraryList.Free;
         if assigned(exeoutput) then
           begin
@@ -814,31 +818,38 @@ end;
 
     procedure TInternalLinker.Load_ReadObject(const para:string);
       var
-        objdata  : TObjData;
-        objinput : TObjinput;
-        fn       : string;
+        objdata   : TObjData;
+        objinput  : TObjinput;
+        objreader : TObjectReader;
+        fn        : string;
       begin
         fn:=FindObjectFile(para,'',false);
         Comment(V_Tried,'Reading object '+fn);
         objinput:=CObjInput.Create;
         objdata:=objinput.newObjData(para);
-        if objinput.readobjectfile(fn,objdata) then
-          exeoutput.addobjdata(objdata);
+        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_ReadUnitObjects;
+    procedure TInternalLinker.Load_ReadStaticLibrary(const para:string);
       var
-        s : string;
+        objreader : TObjectReader;
       begin
-        while not ObjectFiles.Empty do
-          begin
-            s:=ObjectFiles.GetFirst;
-            if s<>'' then
-              Load_ReadObject(s);
-          end;
+{$warning TODO Cleanup ignoring of   FPC generated libimp*.a files}
+        { Don't load import libraries }
+        if copy(splitfilename(para),1,6)='libimp' then
+          exit;
+        Comment(V_Tried,'Opening library '+para);
+        objreader:=TArObjectreader.create(para);
+        TStaticLibrary.Create(StaticLibraryList,para,objreader,CObjInput);
       end;
 
 
@@ -868,8 +879,8 @@ end;
               ExeOutput.Load_ImageBase(para)
             else if keyword='READOBJECT' then
               Load_ReadObject(para)
-            else if keyword='READUNITOBJECTS' then
-              Load_ReadUnitObjects;
+            else if keyword='READSTATICLIBRARY' then
+              Load_ReadStaticLibrary(para);
             hp:=tstringlistitem(hp.next);
           end;
       end;
@@ -973,7 +984,7 @@ end;
 
         { Load .o files and resolve symbols }
         ParseScript_Load;
-        exeoutput.ResolveSymbols;
+        exeoutput.ResolveSymbols(StaticLibraryList);
         { Generate symbols and code to do the importing }
         exeoutput.GenerateLibraryImports(ExternalLibraryList);
         { Fill external symbols data }

compiler/ogbase.pas

@@ -27,6 +27,7 @@ interface
 
     uses
       { common }
+      cutils,
       cclasses,
       { targets }
       systems,globtype,
@@ -142,6 +143,7 @@ interface
      private
        FData       : TDynamicArray;
        FSecOptions : TObjSectionOptions;
+       FCachedFullName : pstring;
        procedure SetSecOptions(Aoptions:TObjSectionOptions);
      public
        ObjData    : TObjData;
@@ -158,7 +160,7 @@ interface
        ObjSymbolDefines : TFPObjectList;
        { executable linking }
        ExeSection  : TExeSection;
-       Used       : boolean;
+       USed        : Boolean;
        VTRefList : TFPObjectList;
        constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);virtual;
        destructor  destroy;override;
@@ -262,15 +264,14 @@ interface
         FCObjData : TObjDataClass;
       protected
         { reader }
-        FReader    : TObjectreader;
-        function  readObjData(Data:TObjData):boolean;virtual;abstract;
+        FReader    : TObjectReader;
+        InputFileName : string;
         property CObjData : TObjDataClass read FCObjData write FCObjData;
       public
         constructor create;virtual;
         destructor  destroy;override;
         function  newObjData(const n:string):TObjData;
-        function  readobjectfile(const fn:string;Data:TObjData):boolean;virtual;
-        property Reader:TObjectReader read FReader;
+        function  ReadObjData(AReader:TObjectreader;Data:TObjData):boolean;virtual;abstract;
         procedure inputerror(const s : string);
       end;
       TObjInputClass=class of TObjInput;
@@ -300,9 +301,12 @@ interface
         function  VTableRef(VTableIdx:Longint):TObjRelocation;
       end;
 
+      TSymbolState = (symstate_undefined,symstate_defined,symstate_common);
+
       TExeSymbol = class(TFPHashObject)
         ObjSymbol  : TObjSymbol;
         ExeSection : TExeSection;
+        State      : TSymbolState;
         { Used for vmt references optimization }
         VTable     : TExeVTable;
       end;
@@ -325,11 +329,22 @@ interface
       end;
       TExeSectionClass=class of TExeSection;
 
+      TStaticLibrary = class(TFPHashObject)
+      private
+        FArReader : TObjectReader;
+        FObjInputClass : TObjInputClass;
+      public
+        constructor create(AList:TFPHashObjectList;const AName:string;AReader:TObjectReader;AObjInputClass:TObjInputClass);
+        destructor  destroy;override;
+        property ArReader:TObjectReader read FArReader;
+        property ObjInputClass:TObjInputClass read FObjInputClass;
+      end;
+
       TExternalLibrary = class(TFPHashObject)
       private
         FExternalSymbolList : TFPHashObjectList;
       public
-        constructor create(AList:TFPHashObjectList;const AName:string);virtual;
+        constructor create(AList:TFPHashObjectList;const AName:string);
         destructor  destroy;override;
         property ExternalSymbolList:TFPHashObjectList read FExternalSymbolList;
       end;
@@ -391,7 +406,8 @@ interface
         procedure CalcPos_Start;virtual;
         procedure CalcPos_Symbols;virtual;
         procedure BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList);
-        procedure ResolveSymbols;
+        procedure PackUnresolvedExeSymbols(const s:string);
+        procedure ResolveSymbols(StaticLibraryList:TFPHashObjectList);
         procedure PrintMemoryMap;
         procedure FixupSymbols;
         procedure FixupRelocations;
@@ -423,7 +439,7 @@ interface
 implementation
 
     uses
-      cutils,globals,verbose,fmodule,ogmap;
+      globals,verbose,fmodule,ogmap;
 
     const
       sectionDatagrowsize = 256-sizeof(ptrint);
@@ -669,15 +685,24 @@ implementation
         ObjRelocations:=nil;
         ObjSymbolDefines.Free;
         ObjSymbolDefines:=nil;
+        if assigned(FCachedFullName) then
+          begin
+            stringdispose(FCachedFullName);
+            FCachedFullName:=nil;
+          end;
       end;
 
 
     function  TObjSection.FullName:string;
       begin
-        if assigned(ObjData) then
-          result:=ObjData.Name+'('+Name+')'
-        else
-          result:=Name;
+        if not assigned(FCachedFullName) then
+          begin
+            if assigned(ObjData) then
+              FCachedFullName:=stringdup(ObjData.Name+'('+Name+')')
+            else
+              FCachedFullName:=stringdup(Name);
+          end;
+        result:=FCachedFullName^;
       end;
 
 
@@ -1104,7 +1129,7 @@ implementation
     constructor TExeVTable.Create(AExeSymbol:TExeSymbol);
       begin
         ExeSymbol:=AExeSymbol;
-        if not assigned(ExeSymbol.ObjSymbol) then
+        if ExeSymbol.State=symstate_undefined then
           internalerror(200604012);
         ChildList:=TFPObjectList.Create(false);
       end;
@@ -1234,6 +1259,25 @@ implementation
       end;
 
 
+{****************************************************************************
+                                TStaticLibrary
+****************************************************************************}
+
+    constructor TStaticLibrary.create(AList:TFPHashObjectList;const AName:string;AReader:TObjectReader;AObjInputClass:TObjInputClass);
+      begin
+        inherited create(AList,AName);
+        FArReader:=AReader;
+        FObjInputClass:=AObjInputClass;
+      end;
+
+
+    destructor TStaticLibrary.destroy;
+      begin
+        ArReader.Free;
+        inherited destroy;
+      end;
+
+
 {****************************************************************************
                                 TExternalLibrary
 ****************************************************************************}
@@ -1352,8 +1396,18 @@ implementation
     procedure TExeOutput.Load_ImageBase(const avalue:string);
       var
         code : integer;
+        objsec : TObjSection;
+        objsym : TObjSymbol;
+        exesym : TExeSymbol;
       begin
         val(avalue,ImageBase,code);
+        { Create __image_base__ symbol, create the symbol
+          in a section with adress 0 and at offset 0 }
+        objsec:=internalObjData.createsection('*__image_base__',0,[]);
+        internalObjData.setsection(objsec);
+        objsym:=internalObjData.SymbolDefine('__image_base__',AB_GLOBAL,AT_FUNCTION);
+        exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
+        exesym.ObjSymbol:=objsym;
       end;
 
 
@@ -1395,24 +1449,45 @@ implementation
       end;
 
 
+    function ObjSectionNameCompare(Item1, Item2: Pointer): Integer;
+      var
+        I1 : TObjSection absolute Item1;
+        I2 : TObjSection absolute Item2;
+      begin
+//writeln(I1.FullName);
+        Result:=CompareStr(I1.FullName,I2.FullName);
+      end;
+
+
     procedure TExeOutput.Order_ObjSection(const aname:string);
       var
         i,j     : longint;
         ObjData : TObjData;
         objsec  : TObjSection;
+        TmpObjSectionList : TFPObjectList;
       begin
         if not assigned(CurrExeSec) then
           internalerror(200602181);
+        TmpObjSectionList:=TFPObjectList.Create(false);
         for i:=0 to ObjDataList.Count-1 do
           begin
             ObjData:=TObjData(ObjDataList[i]);
             for j:=0 to ObjData.ObjSectionList.Count-1 do
               begin
                 objsec:=TObjSection(ObjData.ObjSectionList[j]);
-                if MatchPattern(aname,objsec.name) then
-                  CurrExeSec.AddObjSection(objsec);
+                if (not objsec.Used) and
+                   MatchPattern(aname,objsec.name) then
+                  TmpObjSectionList.Add(objsec);
               end;
           end;
+        { Sort list if needed }
+        TmpObjSectionList.Sort(@ObjSectionNameCompare);
+        { Add the (sorted) list to the current ExeSection }
+        for i:=0 to TmpObjSectionList.Count-1 do
+          begin
+            objsec:=TObjSection(TmpObjSectionList[i]);
+            CurrExeSec.AddObjSection(objsec);
+          end;
       end;
 
 
@@ -1591,92 +1666,180 @@ implementation
       end;
 
 
-    procedure TExeOutput.ResolveSymbols;
+    procedure TExeOutput.PackUnresolvedExeSymbols(const s:string);
+      var
+        i : longint;
+        exesym : TExeSymbol;
+      begin
+        { Generate a list of Unresolved External symbols }
+        for i:=0 to UnresolvedExeSymbols.count-1 do
+          begin
+            exesym:=TExeSymbol(UnresolvedExeSymbols[i]);
+            if exesym.State<>symstate_undefined then
+              UnresolvedExeSymbols[i]:=nil;
+          end;
+        UnresolvedExeSymbols.Pack;
+        Comment(V_Debug,'Number of unresolved externals '+s+' '+tostr(UnresolvedExeSymbols.Count));
+      end;
+
+
+    procedure TExeOutput.ResolveSymbols(StaticLibraryList:TFPHashObjectList);
       var
         ObjData   : TObjData;
         exesym    : TExeSymbol;
         objsym,
         commonsym : TObjSymbol;
+        objinput : TObjInput;
+        StaticLibrary : TStaticLibrary;
+        firstarchive,
         firstcommon : boolean;
         i,j       : longint;
-        hs        : string;
         VTEntryList,
         VTInheritList : TFPObjectList;
+
+        procedure LoadObjDataSymbols(ObjData:TObjData);
+        var
+          j      : longint;
+          hs     : string;
+          exesym : TExeSymbol;
+          objsym : TObjSymbol;
+        begin
+          for j:=0 to ObjData.ObjSymbolList.Count-1 do
+            begin
+              objsym:=TObjSymbol(ObjData.ObjSymbolList[j]);
+              { From the local symbols we are only interressed in the
+                VTENTRY and VTINHERIT symbols }
+              if objsym.bind=AB_LOCAL then
+                begin
+                  if cs_link_opt_vtable in aktglobalswitches then
+                    begin
+                      hs:=objsym.name;
+                      if (hs[1]='V') then
+                        begin
+                          if Copy(hs,1,5)='VTREF' then
+                            begin
+                              if not assigned(objsym.ObjSection.VTRefList) then
+                                objsym.ObjSection.VTRefList:=TFPObjectList.Create(false);
+                              objsym.ObjSection.VTRefList.Add(objsym);
+                            end
+                          else if Copy(hs,1,7)='VTENTRY' then
+                            VTEntryList.Add(objsym)
+                          else if Copy(hs,1,9)='VTINHERIT' then
+                            VTInheritList.Add(objsym);
+                        end;
+                    end;
+                  continue;
+                end;
+              { Search for existing exesymbol }
+              exesym:=texesymbol(FExeSymbolList.Find(objsym.name));
+              if not assigned(exesym) then
+                begin
+                  exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
+                  exesym.ObjSymbol:=objsym;
+                end;
+              objsym.ExeSymbol:=exesym;
+              case objsym.bind of
+                AB_GLOBAL :
+                  begin
+                    if exesym.State<>symstate_defined then
+                      begin
+                        exesym.ObjSymbol:=objsym;
+                        exesym.State:=symstate_defined;
+                      end
+                    else
+                      Comment(V_Error,'Multiple defined symbol '+objsym.name);
+                  end;
+                AB_EXTERNAL :
+                  begin
+                    ExternalObjSymbols.add(objsym);
+                    { Register unresolved symbols only the first time they
+                      are registered }
+                    if exesym.ObjSymbol=objsym then
+                      UnresolvedExeSymbols.Add(exesym);
+                  end;
+                AB_COMMON :
+                  begin
+                    if exesym.State=symstate_undefined then
+                      begin
+                        exesym.ObjSymbol:=objsym;
+                        exesym.State:=symstate_common;
+                      end;
+                    CommonObjSymbols.add(objsym);
+                  end;
+              end;
+            end;
+        end;
+
       begin
         VTEntryList:=TFPObjectList.Create(false);
         VTInheritList:=TFPObjectList.Create(false);
 
         {
-          The symbol calculation is done in 3 steps:
-           1. register globals
-              register externals
-              register commons
-           2. try to find commons, if not found then
-              add to the globals (so externals can be resolved)
-           3. try to find externals
+          The symbol resolving is done in 3 steps:
+           1. Register symbols from objects
+           2. Find symbols in static libraries
+           3. Define stil undefined common symbols
         }
 
-        { Step 1, Register symbols }
+        { Step 1, Register symbols from objects }
         for i:=0 to ObjDataList.Count-1 do
           begin
             ObjData:=TObjData(ObjDataList[i]);
-            for j:=0 to ObjData.ObjSymbolList.Count-1 do
+            LoadObjDataSymbols(ObjData);
+          end;
+        PackUnresolvedExeSymbols('in objects');
+
+        { 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
-                objsym:=TObjSymbol(ObjData.ObjSymbolList[j]);
-                { From the local symbols we are only interressed in the
-                  VTENTRY and VTINHERIT symbols }
-                if objsym.bind=AB_LOCAL then
+                exesym:=TExeSymbol(UnresolvedExeSymbols[j]);
+                { Check first if the symbol is still undefined }
+                if exesym.State=symstate_undefined then
                   begin
-                    if cs_link_opt_vtable in aktglobalswitches then
+                    if StaticLibrary.ArReader.OpenFile(exesym.name) then
                       begin
-                        hs:=objsym.name;
-                        if (hs[1]='V') then
+                        if assigned(exemap) then
                           begin
-                            if Copy(hs,1,5)='VTREF' then
+                            if firstarchive then
                               begin
-                                if not assigned(objsym.ObjSection.VTRefList) then
-                                  objsym.ObjSection.VTRefList:=TFPObjectList.Create(false);
-                                objsym.ObjSection.VTRefList.Add(objsym);
-                              end
-                            else if Copy(hs,1,7)='VTENTRY' then
-                              VTEntryList.Add(objsym)
-                            else if Copy(hs,1,9)='VTINHERIT' then
-                              VTInheritList.Add(objsym);
+                                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;
-                    continue;
-                  end;
-                { Search for existing exesymbol }
-                exesym:=texesymbol(FExeSymbolList.Find(objsym.name));
-                if not assigned(exesym) then
-                  exesym:=texesymbol.Create(FExeSymbolList,objsym.name);
-                { Defining the symbol? }
-                if objsym.bind=AB_GLOBAL then
-                  begin
-                    if not assigned(exesym.ObjSymbol) then
-                      exesym.ObjSymbol:=objsym
-                    else
-                      Comment(V_Error,'Multiple defined symbol '+objsym.name);
-                  end;
-                objsym.exesymbol:=exesym;
-                case objsym.bind of
-                  AB_EXTERNAL :
-                    ExternalObjSymbols.add(objsym);
-                  AB_COMMON :
-                    CommonObjSymbols.add(objsym);
-                end;
+                   end;
+                inc(j);
               end;
           end;
+        PackUnresolvedExeSymbols('after static libraries');
 
-        { Step 2, Match common symbols or add to the globals }
+        { Step 3, Match common symbols or add to the globals }
         firstcommon:=true;
         for i:=0 to CommonObjSymbols.count-1 do
           begin
             objsym:=TObjSymbol(CommonObjSymbols[i]);
-            if assigned(objsym.exesymbol.objsymbol) then
+            if objsym.exesymbol.State=symstate_defined then
               begin
                 if objsym.exesymbol.ObjSymbol.size<>objsym.size then
-                  internalerror(200206301);
+                  Comment(V_Debug,'Size of common symbol '+objsym.name+' is different, expected '+tostr(objsym.size)+' got '+tostr(objsym.exesymbol.ObjSymbol.size));
               end
             else
               begin
@@ -1695,18 +1858,11 @@ implementation
                 if assigned(exemap) then
                   exemap.AddCommonSymbol(commonsym);
                 { Assign to the exesymbol }
-                objsym.exesymbol.objsymbol:=commonsym
+                objsym.exesymbol.objsymbol:=commonsym;
+                objsym.exesymbol.state:=symstate_defined;
               end;
           end;
-
-        { Generate a list of Unresolved External symbols }
-        for i:=0 to ExeSymbolList.count-1 do
-          begin
-            exesym:=TExeSymbol(ExeSymbolList[i]);
-            if exesym.objsymbol=nil then
-              UnresolvedExeSymbols.Add(exesym);
-          end;
-        Comment(V_Debug,'Number of unresolved externals in objects '+tostr(UnresolvedExeSymbols.Count));
+        PackUnresolvedExeSymbols('after defining COMMON symbols');
 
         { Find entry symbol and print in map }
         exesym:=texesymbol(ExeSymbolList.Find(EntryName));
@@ -1764,10 +1920,29 @@ implementation
 
 
     procedure TExeOutput.FixupSymbols;
+
+        procedure UpdateSymbol(objsym:TObjSymbol);
+        begin
+          objsym.bind:=objsym.ExeSymbol.ObjSymbol.bind;
+          objsym.offset:=objsym.ExeSymbol.ObjSymbol.offset;
+          objsym.size:=objsym.ExeSymbol.ObjSymbol.size;
+          objsym.typ:=objsym.ExeSymbol.ObjSymbol.typ;
+          objsym.ObjSection:=objsym.ExeSymbol.ObjSymbol.ObjSection;
+        end;
+
       var
-        i   : longint;
-        sym : TObjSymbol;
+        i      : longint;
+        objsym : TObjSymbol;
+        exesym : TExeSymbol;
       begin
+        { Print list of Unresolved External symbols }
+        for i:=0 to UnresolvedExeSymbols.count-1 do
+          begin
+            exesym:=TExeSymbol(UnresolvedExeSymbols[i]);
+            if exesym.State<>symstate_defined then
+              Comment(V_Error,'Undefined symbol: '+exesym.name);
+          end;
+
         { Update ImageBase to ObjData so it can access from ObjSymbols }
         for i:=0 to ObjDataList.Count-1 do
           TObjData(ObjDataList[i]).imagebase:=imagebase;
@@ -1781,36 +1956,19 @@ implementation
         { Step 1, Update commons }
         for i:=0 to CommonObjSymbols.count-1 do
           begin
-            sym:=TObjSymbol(CommonObjSymbols[i]);
-            if sym.bind=AB_COMMON then
-              begin
-                { update this symbol }
-                sym.bind:=sym.exesymbol.ObjSymbol.bind;
-                sym.offset:=sym.exesymbol.ObjSymbol.offset;
-                sym.size:=sym.exesymbol.ObjSymbol.size;
-                sym.typ:=sym.exesymbol.ObjSymbol.typ;
-                sym.ObjSection:=sym.exesymbol.ObjSymbol.ObjSection;
-              end;
+            objsym:=TObjSymbol(CommonObjSymbols[i]);
+            if objsym.bind<>AB_COMMON then
+              internalerror(200606241);
+            UpdateSymbol(objsym);
           end;
 
         { Step 2, Update externals }
         for i:=0 to ExternalObjSymbols.count-1 do
           begin
-            sym:=TObjSymbol(ExternalObjSymbols[i]);
-            if sym.bind=AB_EXTERNAL then
-              begin
-                if assigned(sym.exesymbol.ObjSymbol) then
-                  begin
-                    { update this symbol }
-                    sym.bind:=sym.exesymbol.ObjSymbol.bind;
-                    sym.offset:=sym.exesymbol.ObjSymbol.offset;
-                    sym.size:=sym.exesymbol.ObjSymbol.size;
-                    sym.typ:=sym.exesymbol.ObjSymbol.typ;
-                    sym.ObjSection:=sym.exesymbol.ObjSymbol.ObjSection;
-                  end
-                else
-                  Comment(V_Error,'Undefined symbol: '+sym.name);
-              end;
+            objsym:=TObjSymbol(ExternalObjSymbols[i]);
+            if objsym.bind<>AB_EXTERNAL then
+              internalerror(200606242);
+            UpdateSymbol(objsym);
           end;
       end;
 
@@ -2024,7 +2182,7 @@ implementation
               if objsym.bind<>AB_LOCAL then
                 begin
                   if not(assigned(objsym.exesymbol) and
-                        assigned(objsym.exesymbol.objsymbol)) then
+                         (objsym.exesymbol.State=symstate_defined)) then
                     internalerror(200603063);
                   objsym:=objsym.exesymbol.objsymbol;
                 end;
@@ -2185,14 +2343,11 @@ implementation
 
     constructor TObjInput.create;
       begin
-        { init reader }
-        FReader:=TObjectreader.create;
       end;
 
 
     destructor TObjInput.destroy;
       begin
-        FReader.free;
         inherited destroy;
       end;
 
@@ -2203,20 +2358,9 @@ implementation
       end;
 
 
-    function TObjInput.readobjectfile(const fn:string;Data:TObjData):boolean;
-      begin
-        result:=false;
-        { start the reader }
-        if FReader.openfile(fn) then
-         begin
-           result:=readObjData(Data);
-           FReader.closefile;
-         end;
-      end;
-
     procedure TObjInput.inputerror(const s : string);
       begin
-        Comment(V_Error,s+' while reading '+reader.filename);
+        Comment(V_Error,s+' while reading '+InputFileName);
       end;
 
 

compiler/ogcoff.pas

@@ -188,11 +188,10 @@ interface
          procedure read_symbols(objdata:TObjData);
          procedure ObjSections_read_data(p:TObject;arg:pointer);
          procedure ObjSections_read_relocs(p:TObject;arg:pointer);
-       protected
-         function  readObjData(objdata:TObjData):boolean;override;
        public
          constructor createcoff(awin32:boolean);
          destructor destroy;override;
+         function  ReadObjData(AReader:TObjectreader;objdata:TObjData):boolean;override;
        end;
 
        TDJCoffObjInput = class(TCoffObjInput)
@@ -266,16 +265,6 @@ interface
          constructor create(smart:boolean);override;
        end;
 
-       TDJCofflinker = class(tinternallinker)
-         constructor create;override;
-         procedure DefaultLinkScript;override;
-       end;
-
-       TPECofflinker = class(tinternallinker)
-         constructor create;override;
-         procedure DefaultLinkScript;override;
-       end;
-
 
     type
       Treaddllproc = procedure(const dllname,funcname:string) of object;
@@ -1736,8 +1725,8 @@ const pemagic : array[0..3] of byte = (
 
             if assigned(data) then
               begin
-                Reader.Seek(datapos);
-                if not Reader.ReadArray(data,Size) then
+                FReader.Seek(datapos);
+                if not FReader.ReadArray(data,Size) then
                   begin
                     Comment(V_Error,'Error reading coff file, can''t read object data');
                     exit;
@@ -1758,14 +1747,14 @@ const pemagic : array[0..3] of byte = (
 
             if coffrelocs>0 then
               begin
-                Reader.Seek(coffrelocpos);
+                FReader.Seek(coffrelocpos);
                 read_relocs(TCoffObjSection(p));
               end;
           end;
       end;
 
 
-    function  TCoffObjInput.readObjData(objdata:TObjData):boolean;
+    function  TCoffObjInput.ReadObjData(AReader:TObjectreader;objdata:TObjData):boolean;
       var
         secalign : shortint;
         strsize,
@@ -1779,37 +1768,39 @@ const pemagic : array[0..3] of byte = (
         secname  : string;
         secnamebuf : array[0..15] of char;
       begin
+        FReader:=AReader;
+        InputFileName:=AReader.FileName;
         result:=false;
         FCoffSyms:=TDynamicArray.Create(symbolresize);
         FCoffStrs:=TDynamicArray.Create(strsresize);
         with TCoffObjData(objdata) do
          begin
            { Read COFF header }
-           if not reader.read(header,sizeof(tcoffheader)) then
+           if not AReader.read(header,sizeof(tcoffheader)) then
              begin
-               Comment(V_Error,'Error reading coff file, can''t read header: '+reader.filename);
+               InputError('Can''t read COFF Header');
                exit;
              end;
            if header.mach<>COFF_MAGIC then
              begin
-               Comment(V_Error,'Not a coff file, illegal magic: '+reader.filename);
+               InputError('Illegal COFF Magic');
                exit;
              end;
            { Strings }
-           Reader.Seek(header.sympos+header.syms*sizeof(CoffSymbol));
-           if not Reader.Read(strsize,4) then
+           AReader.Seek(header.sympos+header.syms*sizeof(CoffSymbol));
+           if not AReader.Read(strsize,4) then
              begin
-               Comment(V_Error,'Error reading coff file');
+               InputError('Error reading COFF Symtable');
                exit;
              end;
            if strsize<4 then
              begin
-               Comment(V_Error,'Error reading coff file');
+               InputError('Error reading COFF Symtable');
                exit;
              end;
-           if not Reader.ReadArray(FCoffStrs,Strsize-4) then
+           if not AReader.ReadArray(FCoffStrs,Strsize-4) then
              begin
-               Comment(V_Error,'Error reading coff file: '+reader.filename);
+               InputError('Error reading COFF Symtable');
                exit;
              end;
            { Section headers }
@@ -1817,12 +1808,12 @@ const pemagic : array[0..3] of byte = (
            FSecCount:=header.nsects;
            GetMem(FSecTbl,(header.nsects+1)*sizeof(TObjSection));
            FillChar(FSecTbl^,(header.nsects+1)*sizeof(TObjSection),0);
-           reader.Seek(sizeof(tcoffheader)+header.opthdr);
+           AReader.Seek(sizeof(tcoffheader)+header.opthdr);
            for i:=1 to header.nsects do
              begin
-               if not reader.read(sechdr,sizeof(sechdr)) then
+               if not AReader.read(sechdr,sizeof(sechdr)) then
                 begin
-                  Comment(V_Error,'Error reading coff file, can''t read section header: '+reader.filename);
+                  InputError('Error reading COFF Section Headers');
                   exit;
                 end;
                move(sechdr.name,secnamebuf,8);
@@ -1835,7 +1826,7 @@ const pemagic : array[0..3] of byte = (
                      secname:=Read_str(strpos)
                    else
                      begin
-                       Comment(V_Error,'Error reading section headers coff file');
+                       InputError('Error reading COFF Section Headers');
                        secname:='error';
                      end;
                  end;
@@ -1863,8 +1854,8 @@ const pemagic : array[0..3] of byte = (
                objsec.Size:=sechdr.dataSize;
              end;
            { ObjSymbols }
-           Reader.Seek(header.sympos);
-           if not Reader.ReadArray(FCoffSyms,header.syms*sizeof(CoffSymbol)) then
+           AReader.Seek(header.sympos);
+           if not AReader.ReadArray(FCoffSyms,header.syms*sizeof(CoffSymbol)) then
              begin
                Comment(V_Error,'Error reading coff file');
                exit;
@@ -1930,11 +1921,6 @@ const pemagic : array[0..3] of byte = (
       begin
         inherited create;
         win32:=awin32;
-        if win32 then
-          if target_info.system in [system_arm_wince] then
-            imagebase:=$10000
-          else
-            imagebase:=$400000;
       end;
 
 
@@ -1961,6 +1947,7 @@ const pemagic : array[0..3] of byte = (
 
     procedure TCoffexeoutput.globalsyms_write_symbol(p:TObject;arg:pointer);
       var
+        secval,
         value  : aint;
         globalval : byte;
         exesec : TExeSection;
@@ -1970,18 +1957,24 @@ const pemagic : array[0..3] of byte = (
         with texesymbol(p).objsymbol do
           begin
             exesec:=TExeSection(objsection.exesection);
-            if not assigned(exesec) then
+            { There is no exesection defined for special internal symbols
+              like __image_base__ }
+            if assigned(exesec) then
               begin
-                Comment(V_Error, 'Section ' + objsection.FullName + ' does not supported.');
-                exit;
+                secval:=exesec.secsymidx;
+                value:=address-exesec.mempos;
+              end
+            else
+              begin
+                secval:=-1;
+                value:=address;
               end;
             if bind=AB_LOCAL then
               globalval:=3
             else
               globalval:=2;
             { reloctype address to the section in the executable }
-            value:=address-exesec.mempos;
-            write_symbol(name,value,exesec.secsymidx,globalval,0);
+            write_symbol(name,value,secval,globalval,0);
           end;
       end;
 
@@ -2326,9 +2319,9 @@ const pemagic : array[0..3] of byte = (
           emptyint : longint;
         begin
           emptyint:=0;
-          idata4objsection:=internalobjdata.createsection(sec_idata4, 'end_'+basedllname);
+          idata4objsection:=internalobjdata.createsection(sec_idata4, basedllname+'_z_');
           internalobjdata.SymbolDefine('__imp_names_end_'+basedllname,AB_LOCAL,AT_DATA);
-          idata5objsection:=internalobjdata.createsection(sec_idata5, 'end_'+basedllname);
+          idata5objsection:=internalobjdata.createsection(sec_idata5, basedllname+'_z_');
           internalobjdata.SymbolDefine('__imp_fixup_end_'+basedllname,AB_LOCAL,AT_DATA);
           { idata4 }
           internalobjdata.SetSection(idata4objsection);
@@ -2368,6 +2361,7 @@ const pemagic : array[0..3] of byte = (
           idata5label,
           idata6label : TObjSymbol;
           emptyint : longint;
+          secname,
           num : string;
         begin
           result:=nil;
@@ -2376,10 +2370,13 @@ const pemagic : array[0..3] of byte = (
             exemap.Add(' Importing Function '+afuncname);
 
           with internalobjdata do
-            textobjsection:=createsection(sectionname(sec_code,'__'+afuncname),sectiontype2align(sec_code),sectiontype2options(sec_code) - [oso_keep]);
-          idata4objsection:=internalobjdata.createsection(sec_idata4, afuncname);
-          idata5objsection:=internalobjdata.createsection(sec_idata5, afuncname);
-          idata6objsection:=internalobjdata.createsection(sec_idata6, afuncname);
+            begin
+              secname:=basedllname+'_i_'+afuncname;
+              textobjsection:=createsection(sectionname(sec_code,secname),sectiontype2align(sec_code),sectiontype2options(sec_code) - [oso_keep]);
+              idata4objsection:=createsection(sec_idata4, secname);
+              idata5objsection:=createsection(sec_idata5, secname);
+              idata6objsection:=createsection(sec_idata6, secname);
+            end;
 
           { idata6, import data (ordnr+name) }
           internalobjdata.SetSection(idata6objsection);
@@ -2433,16 +2430,18 @@ const pemagic : array[0..3] of byte = (
                 ExtSymbol:=TFPHashObject(ExtLibrary.ExternalSymbolList[j]);
                 exesym:=TExeSymbol(ExeSymbolList.Find(ExtSymbol.Name));
                 if assigned(exesym) and
-                   not assigned(exesym.objsymbol) then
+                   (exesym.State<>symstate_defined) then
                   begin
                     if not assigned(idata2objsection) then
                       StartImport(ExtLibrary.Name);
                     exesym.objsymbol:=AddProcImport(ExtSymbol.Name);
+                    exesym.State:=symstate_defined;
                   end;
               end;
             if assigned(idata2objsection) then
               EndImport;
           end;
+        PackUnresolvedExeSymbols('after DLL imports');
       end;
 
 
@@ -2468,113 +2467,6 @@ const pemagic : array[0..3] of byte = (
       end;
 
 
-{****************************************************************************
-                                  TCoffLinker
-****************************************************************************}
-
-    constructor TDJCoffLinker.Create;
-      begin
-        inherited Create;
-        CExeoutput:=TDJCoffexeoutput;
-        CObjInput:=TDJCoffObjInput;
-      end;
-
-
-    procedure TDJCoffLinker.DefaultLinkScript;
-      begin
-      end;
-
-
-    constructor TPECoffLinker.Create;
-      begin
-        inherited Create;
-        CExeoutput:=TPECoffexeoutput;
-        CObjInput:=TPECoffObjInput;
-      end;
-
-
-    procedure TPECoffLinker.DefaultLinkScript;
-      var
-        ibase: string;
-      begin
-        with LinkScript do
-          begin
-            Concat('READUNITOBJECTS');
-            if assigned(DLLImageBase) then
-              ibase:=DLLImageBase^
-            else
-              ibase:='';
-            if IsSharedLibrary then
-              begin
-                if ibase = '' then
-                  ibase:='10000000';
-                Concat('ISSHAREDLIBRARY');
-                if apptype=app_gui then
-                  Concat('ENTRYNAME _DLLWinMainCRTStartup')
-                else
-                  Concat('ENTRYNAME _DLLMainCRTStartup');
-              end
-            else
-              begin
-                if apptype=app_gui then
-                  Concat('ENTRYNAME _WinMainCRTStartup')
-                else
-                  Concat('ENTRYNAME _mainCRTStartup');
-              end;
-            if ibase <> '' then
-              Concat('IMAGEBASE $' + ibase);
-            Concat('HEADER');
-            Concat('EXESECTION .text');
-{$ifdef arm}
-            Concat('  OBJSECTION .pdata.FPC_EH_PROLOG');
-{$endif arm}
-            Concat('  OBJSECTION .text*');
-            Concat('  SYMBOL etext');
-            Concat('ENDEXESECTION');
-            Concat('EXESECTION .data');
-            Concat('  SYMBOL __data_start__');
-            Concat('  OBJSECTION .data*');
-            Concat('  SYMBOL edata');
-            Concat('  SYMBOL __data_end__');
-            Concat('ENDEXESECTION');
-            Concat('EXESECTION .rdata');
-            Concat('  OBJSECTION .rodata*');
-            Concat('ENDEXESECTION');
-            Concat('EXESECTION .pdata');
-            Concat('  OBJSECTION .pdata');
-            Concat('ENDEXESECTION');
-            Concat('EXESECTION .bss');
-            Concat('  SYMBOL __bss_start__');
-            Concat('  OBJSECTION .bss*');
-            Concat('  SYMBOL __bss_end__');
-            Concat('ENDEXESECTION');
-            Concat('EXESECTION .idata');
-            Concat('  OBJSECTION .idata$2*');
-            Concat('  OBJSECTION .idata$3*');
-            Concat('  ZEROS 20');
-            Concat('  OBJSECTION .idata$4*');
-            Concat('  OBJSECTION .idata$5*');
-            Concat('  OBJSECTION .idata$6*');
-            Concat('  OBJSECTION .idata$7*');
-            Concat('ENDEXESECTION');
-            Concat('EXESECTION .edata');
-            Concat('  OBJSECTION .edata*');
-            Concat('ENDEXESECTION');
-            Concat('EXESECTION .rsrc');
-            Concat('  OBJSECTION .rsrc*');
-            Concat('ENDEXESECTION');
-            Concat('EXESECTION .stab');
-            Concat('  OBJSECTION .stab');
-            Concat('ENDEXESECTION');
-            Concat('EXESECTION .stabstr');
-            Concat('  OBJSECTION .stabstr');
-            Concat('ENDEXESECTION');
-            Concat('STABS');
-            Concat('SYMBOLS');
-          end;
-      end;
-
-
 {*****************************************************************************
                                    DLLReader
 *****************************************************************************}

compiler/owar.pas

@@ -61,226 +61,464 @@ type
     procedure writear;
   end;
 
+  tarobjectreader=class(tobjectreader)
+  private
+    ArSymbols : TFPHashObjectList;
+    LFNStrs   : PChar;
+    LFNSize   : longint;
+    CurrMemberPos,
+    CurrMemberSize : longint;
+    CurrMemberName : string;
+    function  DecodeMemberName(ahdr:TArHdr):string;
+    function  DecodeMemberSize(ahdr:TArHdr):longint;
+    procedure ReadArchive;
+  protected
+    function getfilename:string;override;
+  public
+    constructor create(const Aarfn:string);
+    destructor  destroy;override;
+    function  openfile(const fn:string):boolean;override;
+    procedure closefile;override;
+    procedure seek(len:longint);override;
+  end;
+
 
 implementation
 
-uses
-   cstreams,
-   systems,
-   globals,
-   verbose,
-   dos;
-
-const
-  symrelocbufsize = 4096;
-  symstrbufsize = 8192;
-  lfnstrbufsize = 4096;
-  arbufsize  = 65536;
+    uses
+      cstreams,
+      systems,
+      globals,
+      verbose,
+      dos;
+
+    const
+      symrelocbufsize = 4096;
+      symstrbufsize = 8192;
+      lfnstrbufsize = 4096;
+      arbufsize  = 65536;
+
+      armagic:array[1..8] of char='!<arch>'#10;
+
+    type
+      TArSymbol = class(TFPHashObject)
+        MemberPos : longint;
+      end;
+
 
 {*****************************************************************************
                                    Helpers
 *****************************************************************************}
 
-const
-  C1970=2440588;
-  D0=1461;
-  D1=146097;
-  D2=1721119;
-Function Gregorian2Julian(DT:DateTime):LongInt;
-Var
-  Century,XYear,Month : LongInt;
-Begin
-  Month:=DT.Month;
-  If Month<=2 Then
-   Begin
-     Dec(DT.Year);
-     Inc(Month,12);
-   End;
-  Dec(Month,3);
-  Century:=(longint(DT.Year Div 100)*D1) shr 2;
-  XYear:=(longint(DT.Year Mod 100)*D0) shr 2;
-  Gregorian2Julian:=((((Month*153)+2) div 5)+DT.Day)+D2+XYear+Century;
-End;
-
-function DT2Unix(DT:DateTime):LongInt;
-Begin
-  DT2Unix:=(Gregorian2Julian(DT)-C1970)*86400+(LongInt(DT.Hour)*3600)+(DT.Min*60)+DT.Sec;
-end;
+      const
+        C1970=2440588;
+        D0=1461;
+        D1=146097;
+        D2=1721119;
+    Function Gregorian2Julian(DT:DateTime):LongInt;
+      Var
+        Century,XYear,Month : LongInt;
+      Begin
+        Month:=DT.Month;
+        If Month<=2 Then
+         Begin
+           Dec(DT.Year);
+           Inc(Month,12);
+         End;
+        Dec(Month,3);
+        Century:=(longint(DT.Year Div 100)*D1) shr 2;
+        XYear:=(longint(DT.Year Mod 100)*D0) shr 2;
+        Gregorian2Julian:=((((Month*153)+2) div 5)+DT.Day)+D2+XYear+Century;
+      End;
+
+
+    function DT2Unix(DT:DateTime):LongInt;
+      Begin
+        DT2Unix:=(Gregorian2Julian(DT)-C1970)*86400+(LongInt(DT.Hour)*3600)+(DT.Min*60)+DT.Sec;
+      end;
+
+
+    function lsb2msb(l:longint):longint;
+      type
+        bytearr=array[0..3] of byte;
+      begin
+{$ifndef FPC_BIG_ENDIAN}
+        bytearr(result)[0]:=bytearr(l)[3];
+        bytearr(result)[1]:=bytearr(l)[2];
+        bytearr(result)[2]:=bytearr(l)[1];
+        bytearr(result)[3]:=bytearr(l)[0];
+{$else}
+        result:=l;
+{$endif}
+      end;
 
 
 {*****************************************************************************
                                 TArObjectWriter
 *****************************************************************************}
 
-constructor tarobjectwriter.create(const Aarfn:string);
-var
-  time  : datetime;
-  dummy : word;
-begin
-  arfn:=Aarfn;
-  ardata:=TDynamicArray.Create(arbufsize);
-  symreloc:=TDynamicArray.Create(symrelocbufsize);
-  symstr:=TDynamicArray.Create(symstrbufsize);
-  lfnstr:=TDynamicArray.Create(lfnstrbufsize);
-{ create timestamp }
-  getdate(time.year,time.month,time.day,dummy);
-  gettime(time.hour,time.min,time.sec,dummy);
-  Str(DT2Unix(time),timestamp);
-end;
-
-
-destructor tarobjectwriter.destroy;
-begin
-  if Errorcount=0 then
-   writear;
-  arData.Free;
-  symreloc.Free;
-  symstr.Free;
-  lfnstr.Free;
-end;
-
-
-procedure tarobjectwriter.createarhdr(fn:string;asize:longint;const gid,uid,mode:string);
-var
-  tmp : string[9];
-  hfn : string;
-begin
-  fillchar(arhdr,sizeof(tarhdr),' ');
-{ create ar header }
-  { win32 will change names starting with .\ to ./ when using lfn, corrupting
-    the sort order required for the idata sections. To prevent this strip
-    always the path from the filename. (PFV) }
-  hfn:=SplitFileName(fn);
-  if hfn='' then
-    hfn:=fn;
-  fn:=hfn+'/';
-  if length(fn)>16 then
-   begin
-     arhdr.name[0]:='/';
-     str(lfnstr.size,tmp);
-     move(tmp[1],arhdr.name[1],length(tmp));
-     fn:=fn+#10;
-     lfnstr.write(fn[1],length(fn));
-   end
-  else
-   move(fn[1],arhdr.name,length(fn));
-  { don't write a date if also no gid/uid/mode is specified }
-  if gid<>'' then
-    move(timestamp[1],arhdr.date,length(timestamp));
-  str(asize,tmp);
-  move(tmp[1],arhdr.size,length(tmp));
-  move(gid[1],arhdr.gid,length(gid));
-  move(uid[1],arhdr.uid,length(uid));
-  move(mode[1],arhdr.mode,length(mode));
-  arhdr.fmag:='`'#10;
-end;
-
-
-function tarobjectwriter.createfile(const fn:string):boolean;
-begin
-  objfn:=fn;
-  objpos:=ardata.size;
-  ardata.seek(objpos + sizeof(tarhdr));
-  createfile:=true;
-  fobjsize:=0;
-end;
-
-
-procedure tarobjectwriter.closefile;
-begin
-  ardata.align(2);
-{ fix the size in the header }
-  createarhdr(objfn,ardata.size-objpos-sizeof(tarhdr),'42','42','644');
-{ write the header }
-  ardata.seek(objpos);
-  ardata.write(arhdr,sizeof(tarhdr));
-  fobjsize:=0;
-end;
-
-
-procedure tarobjectwriter.writesym(const sym:string);
-var
-  c : char;
-begin
-  c:=#0;
-  symreloc.write(objpos,4);
-  symstr.write(sym[1],length(sym));
-  symstr.write(c,1);
-end;
-
-
-procedure tarobjectwriter.write(const b;len:longint);
-begin
-  inc(fobjsize,len);
-  inc(fsize,len);
-  ardata.write(b,len);
-end;
-
-
-procedure tarobjectwriter.writear;
-
-  function lsb2msb(l:longint):longint;
-  type
-    bytearr=array[0..3] of byte;
-  var
-    l1 : longint;
-  begin
-    bytearr(l1)[0]:=bytearr(l)[3];
-    bytearr(l1)[1]:=bytearr(l)[2];
-    bytearr(l1)[2]:=bytearr(l)[1];
-    bytearr(l1)[3]:=bytearr(l)[0];
-    lsb2msb:=l1;
-  end;
+    constructor tarobjectwriter.create(const Aarfn:string);
+      var
+        time  : datetime;
+        dummy : word;
+      begin
+        arfn:=Aarfn;
+        ardata:=TDynamicArray.Create(arbufsize);
+        symreloc:=TDynamicArray.Create(symrelocbufsize);
+        symstr:=TDynamicArray.Create(symstrbufsize);
+        lfnstr:=TDynamicArray.Create(lfnstrbufsize);
+        { create timestamp }
+        getdate(time.year,time.month,time.day,dummy);
+        gettime(time.hour,time.min,time.sec,dummy);
+        Str(DT2Unix(time),timestamp);
+      end;
+
+
+    destructor tarobjectwriter.destroy;
+      begin
+        if Errorcount=0 then
+         writear;
+        arData.Free;
+        symreloc.Free;
+        symstr.Free;
+        lfnstr.Free;
+      end;
+
+
+    procedure tarobjectwriter.createarhdr(fn:string;asize:longint;const gid,uid,mode:string);
+      var
+        tmp : string[9];
+        hfn : string;
+      begin
+        { create ar header }
+        fillchar(arhdr,sizeof(tarhdr),' ');
+        { win32 will change names starting with .\ to ./ when using lfn, corrupting
+          the sort order required for the idata sections. To prevent this strip
+          always the path from the filename. (PFV) }
+        hfn:=SplitFileName(fn);
+        if hfn='' then
+          hfn:=fn;
+        fn:=hfn+'/';
+        if length(fn)>16 then
+         begin
+           arhdr.name[0]:='/';
+           str(lfnstr.size,tmp);
+           move(tmp[1],arhdr.name[1],length(tmp));
+           fn:=fn+#10;
+           lfnstr.write(fn[1],length(fn));
+         end
+        else
+         move(fn[1],arhdr.name,length(fn));
+        { don't write a date if also no gid/uid/mode is specified }
+        if gid<>'' then
+          move(timestamp[1],arhdr.date,length(timestamp));
+        str(asize,tmp);
+        move(tmp[1],arhdr.size,length(tmp));
+        move(gid[1],arhdr.gid,length(gid));
+        move(uid[1],arhdr.uid,length(uid));
+        move(mode[1],arhdr.mode,length(mode));
+        arhdr.fmag:='`'#10;
+      end;
+
+
+    function tarobjectwriter.createfile(const fn:string):boolean;
+      begin
+        objfn:=fn;
+        objpos:=ardata.size;
+        ardata.seek(objpos + sizeof(tarhdr));
+        createfile:=true;
+        fobjsize:=0;
+      end;
+
+
+    procedure tarobjectwriter.closefile;
+      begin
+        ardata.align(2);
+        { fix the size in the header }
+        createarhdr(objfn,ardata.size-objpos-sizeof(tarhdr),'42','42','644');
+        { write the header }
+        ardata.seek(objpos);
+        ardata.write(arhdr,sizeof(tarhdr));
+        fobjsize:=0;
+      end;
+
+
+    procedure tarobjectwriter.writesym(const sym:string);
+      var
+        c : char;
+      begin
+        c:=#0;
+        symreloc.write(objpos,4);
+        symstr.write(sym[1],length(sym));
+        symstr.write(c,1);
+      end;
+
+
+    procedure tarobjectwriter.write(const b;len:longint);
+      begin
+        inc(fobjsize,len);
+        inc(fsize,len);
+        ardata.write(b,len);
+      end;
+
+
+    procedure tarobjectwriter.writear;
+      var
+        arf      : TCFileStream;
+        fixup,l,
+        relocs,i : longint;
+      begin
+        arf:=TCFileStream.Create(arfn,fmCreate);
+        if CStreamError<>0 then
+          begin
+             Message1(exec_e_cant_create_archivefile,arfn);
+             exit;
+          end;
+        arf.Write(armagic,sizeof(armagic));
+        { align first, because we need the size for the fixups of the symbol reloc }
+        if lfnstr.size>0 then
+         lfnstr.align(2);
+        if symreloc.size>0 then
+         begin
+           symstr.align(2);
+           fixup:=12+sizeof(tarhdr)+symreloc.size+symstr.size;
+           if lfnstr.size>0 then
+            inc(fixup,lfnstr.size+sizeof(tarhdr));
+           relocs:=symreloc.size div 4;
+           { fixup relocs }
+           for i:=0to relocs-1 do
+            begin
+              symreloc.seek(i*4);
+              symreloc.read(l,4);
+              symreloc.seek(i*4);
+              l:=lsb2msb(l+fixup);
+              symreloc.write(l,4);
+            end;
+           createarhdr('',4+symreloc.size+symstr.size,'0','0','0');
+           arf.Write(arhdr,sizeof(tarhdr));
+           relocs:=lsb2msb(relocs);
+           arf.Write(relocs,4);
+           symreloc.WriteStream(arf);
+           symstr.WriteStream(arf);
+         end;
+        if lfnstr.size>0 then
+         begin
+           createarhdr('/',lfnstr.size,'','','');
+           arf.Write(arhdr,sizeof(tarhdr));
+           lfnstr.WriteStream(arf);
+         end;
+        ardata.WriteStream(arf);
+        Arf.Free;
+      end;
+
+
+{*****************************************************************************
+                                TArObjectReader
+*****************************************************************************}
+
+
+    constructor tarobjectreader.create(const Aarfn:string);
+      begin
+        inherited Create;
+        ArSymbols:=TFPHashObjectList.Create(true);
+        CurrMemberPos:=0;
+        CurrMemberSize:=0;
+        CurrMemberName:='';
+        if inherited openfile(Aarfn) then
+          ReadArchive;
+      end;
+
+
+    destructor  tarobjectreader.destroy;
+      begin
+        inherited closefile;
+        ArSymbols.destroy;
+        if assigned(LFNStrs) then
+          FreeMem(LFNStrs);
+        inherited Destroy;
+      end;
+
+
+    function tarobjectreader.getfilename : string;
+      begin
+        result:=inherited getfilename;
+        if CurrMemberName<>'' then
+          result:=result+'('+CurrMemberName+')';
+      end;
+
+
+    function tarobjectreader.DecodeMemberName(ahdr:TArHdr):string;
+      var
+        hs : string;
+        code : integer;
+        hsp,
+        p : pchar;
+        lfnidx : longint;
+      begin
+        result:='';
+        p:[email protected][0];
+        hsp:=@hs[1];
+        while (p^<>' ') and (hsp-@hs[1]<16) do
+          begin
+            hsp^:=p^;
+            inc(p);
+            inc(hsp);
+          end;
+        hs[0]:=chr(hsp-@hs[1]);
+        if (hs[1]='/') and (hs[2] in ['0'..'9']) then
+          begin
+            Delete(hs,1,1);
+            val(hs,lfnidx,code);
+            if (lfnidx<0) or (lfnidx>=LFNSize) then
+              begin
+                Comment(V_Error,'Invalid ar member lfn name index in '+filename);
+                exit;
+              end;
+            p:=@LFNStrs[lfnidx];
+            hsp:=@result[1];
+            while p^<>#10 do
+              begin
+                hsp^:=p^;
+                inc(p);
+                inc(hsp);
+              end;
+            result[0]:=chr(hsp-@result[1]);
+          end
+        else
+          result:=hs;
+        { Strip ending / }
+        if result[length(result)]='/' then
+         dec(result[0]);
+      end;
+
 
-const
-  armagic:array[1..8] of char='!<arch>'#10;
-var
-  arf      : TCFileStream;
-  fixup,l,
-  relocs,i : longint;
-begin
-  arf:=TCFileStream.Create(arfn,fmCreate);
-  if CStreamError<>0 then
-    begin
-       Message1(exec_e_cant_create_archivefile,arfn);
-       exit;
-    end;
-  arf.Write(armagic,sizeof(armagic));
-  { align first, because we need the size for the fixups of the symbol reloc }
-  if lfnstr.size>0 then
-   lfnstr.align(2);
-  if symreloc.size>0 then
-   begin
-     symstr.align(2);
-     fixup:=12+sizeof(tarhdr)+symreloc.size+symstr.size;
-     if lfnstr.size>0 then
-      inc(fixup,lfnstr.size+sizeof(tarhdr));
-     relocs:=symreloc.size div 4;
-     { fixup relocs }
-     for i:=0to relocs-1 do
+    function tarobjectreader.DecodeMemberSize(ahdr:TArHdr):longint;
+      var
+        hs : string;
+        code : integer;
+        hsp,
+        p : pchar;
       begin
-        symreloc.seek(i*4);
-        symreloc.read(l,4);
-        symreloc.seek(i*4);
-        l:=lsb2msb(l+fixup);
-        symreloc.write(l,4);
+        p:[email protected][0];
+        hsp:=@hs[1];
+        while p^<>' ' do
+          begin
+            hsp^:=p^;
+            inc(p);
+            inc(hsp);
+          end;
+        hs[0]:=chr(hsp-@hs[1]);
+        val(hs,result,code);
+        if result<=0 then
+          Comment(V_Error,'Invalid ar member size in '+filename);
       end;
-     createarhdr('',4+symreloc.size+symstr.size,'0','0','0');
-     arf.Write(arhdr,sizeof(tarhdr));
-     relocs:=lsb2msb(relocs);
-     arf.Write(relocs,4);
-     symreloc.WriteStream(arf);
-     symstr.WriteStream(arf);
-   end;
-  if lfnstr.size>0 then
-   begin
-     createarhdr('/',lfnstr.size,'','','');
-     arf.Write(arhdr,sizeof(tarhdr));
-     lfnstr.WriteStream(arf);
-   end;
-  ardata.WriteStream(arf);
-  Arf.Free;
-end;
 
 
+    procedure tarobjectreader.ReadArchive;
+      var
+        currarmagic : array[0..sizeof(armagic)-1] of char;
+        currarhdr   : tarhdr;
+        nrelocs,
+        relocidx,
+        currfilesize,
+        relocsize,
+        symsize     : longint;
+        arsym       : TArSymbol;
+        s           : string;
+        syms,
+        currp,
+        endp,
+        startp      : pchar;
+        relocs      : plongint;
+      begin
+        Read(currarmagic,sizeof(armagic));
+        if CompareByte(currarmagic,armagic,sizeof(armagic))<>0 then
+          begin
+            Comment(V_Error,'Not a ar file, illegal magic: '+filename);
+            exit;
+          end;
+        Read(currarhdr,sizeof(currarhdr));
+        { Read number of relocs }
+        Read(nrelocs,sizeof(nrelocs));
+        nrelocs:=lsb2msb(nrelocs);
+        { Calculate sizes }
+        currfilesize:=DecodeMemberSize(currarhdr);
+        relocsize:=nrelocs*4;
+        symsize:=currfilesize-relocsize-4;
+        if symsize<0 then
+          begin
+            Comment(V_Error,'Illegal symtable in ar file '+filename);
+            exit;
+          end;
+        { Read relocs }
+        getmem(Relocs,relocsize);
+        Read(relocs^,relocsize);
+        { Read symbols, force terminating #0 to prevent overflow }
+        getmem(syms,symsize+1);
+        syms[symsize]:=#0;
+        Read(syms^,symsize);
+        { Parse symbols }
+        relocidx:=0;
+        currp:=syms;
+        endp:=syms+symsize;
+        for relocidx:=0 to nrelocs-1 do
+          begin
+            startp:=currp;
+            while (currp^<>#0) do
+              inc(currp);
+            s[0]:=chr(currp-startp);
+            move(startp^,s[1],byte(s[0]));
+            arsym:=TArSymbol.create(ArSymbols,s);
+            arsym.MemberPos:=lsb2msb(relocs[relocidx]);
+            inc(currp);
+            if currp>endp then
+              begin
+                Comment(V_Error,'Illegal symtable in ar file '+filename);
+                break;
+              end;
+          end;
+        freemem(relocs);
+        freemem(syms);
+        { LFN names }
+        Read(currarhdr,sizeof(currarhdr));
+        if DecodeMemberName(currarhdr)='/' then
+          begin
+            lfnsize:=DecodeMemberSize(currarhdr);
+            getmem(lfnstrs,lfnsize);
+            Read(lfnstrs^,lfnsize);
+          end;
+      end;
+
+
+    function  tarobjectreader.openfile(const fn:string):boolean;
+      var
+        arsym : TArSymbol;
+        arhdr : TArHdr;
+      begin
+        result:=false;
+        arsym:=TArSymbol(ArSymbols.Find(fn));
+        if not assigned(arsym) then
+          exit;
+        inherited Seek(arsym.MemberPos);
+        Read(arhdr,sizeof(arhdr));
+        CurrMemberName:=DecodeMemberName(arhdr);
+        CurrMemberSize:=DecodeMemberSize(arhdr);
+        CurrMemberPos:=arsym.MemberPos+sizeof(arhdr);
+        result:=true;
+      end;
+
+
+    procedure tarobjectreader.closefile;
+      begin
+        CurrMemberPos:=0;
+        CurrMemberSize:=0;
+        CurrMemberName:='';
+      end;
+
+
+    procedure tarobjectreader.seek(len:longint);
+      begin
+        inherited Seek(CurrMemberPos+len);
+      end;
+
 end.

compiler/owbase.pas

@@ -60,13 +60,14 @@ type
     bufidx,
     bufmax : longint;
     function readbuf:boolean;
-    function getfilename : string;
+  protected
+    function getfilename : string;virtual;
   public
     constructor create;
     destructor  destroy;override;
     function  openfile(const fn:string):boolean;virtual;
     procedure closefile;virtual;
-    procedure seek(len:longint);
+    procedure seek(len:longint);virtual;
     function  read(out b;len:longint):boolean;virtual;
     function  readarray(a:TDynamicArray;len:longint):boolean;
     property filename : string read getfilename;
@@ -317,7 +318,7 @@ begin
    if not readbuf then
     exit;
   orglen:=len;
-  idx:=0;
+      idx:=0;
   while len>0 do
    begin
      bufleft:=bufmax-bufidx;

compiler/systems/t_go32v2.pas

@@ -34,23 +34,45 @@ implementation
        cutils,cclasses,
        globtype,globals,systems,verbose,script,fmodule,i_go32v2,ogcoff;
 
-  type
-    tlinkergo32v2=class(texternallinker)
-    private
-       Function  WriteResponseFile(isdll:boolean) : Boolean;
-       Function  WriteScript(isdll:boolean) : Boolean;
-    public
-       constructor Create;override;
-       procedure SetDefaultInfo;override;
-       function  MakeExecutable:boolean;override;
-    end;
+    type
+      TInternalLinkerGo32v2=class(TInternallinker)
+        constructor create;override;
+        procedure DefaultLinkScript;override;
+      end;
+
+      TExternalLinkerGo32v2=class(texternallinker)
+      private
+         Function  WriteResponseFile(isdll:boolean) : Boolean;
+         Function  WriteScript(isdll:boolean) : Boolean;
+      public
+         constructor Create;override;
+         procedure SetDefaultInfo;override;
+         function  MakeExecutable:boolean;override;
+      end;
+
+
+{****************************************************************************
+                                  TCoffLinker
+****************************************************************************}
+
+    constructor TInternalLinkerGo32v2.Create;
+      begin
+        inherited Create;
+        CExeoutput:=TDJCoffexeoutput;
+        CObjInput:=TDJCoffObjInput;
+      end;
+
+
+    procedure TInternalLinkerGo32v2.DefaultLinkScript;
+      begin
+      end;
 
 
 {****************************************************************************
-                               TLinkerGo32v2
+                               TExternalLinkerGo32v2
 ****************************************************************************}
 
-Constructor TLinkerGo32v2.Create;
+Constructor TExternalLinkerGo32v2.Create;
 begin
   Inherited Create;
   { allow duplicated libs (PM) }
@@ -59,7 +81,7 @@ begin
 end;
 
 
-procedure TLinkerGo32v2.SetDefaultInfo;
+procedure TExternalLinkerGo32v2.SetDefaultInfo;
 begin
   with Info do
    begin
@@ -68,7 +90,7 @@ begin
 end;
 
 
-Function TLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean;
+Function TExternalLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean;
 Var
   linkres  : TLinkRes;
   i        : longint;
@@ -126,7 +148,7 @@ begin
 end;
 
 
-Function TLinkerGo32v2.WriteScript(isdll:boolean) : Boolean;
+Function TExternalLinkerGo32v2.WriteScript(isdll:boolean) : Boolean;
 Var
   scriptres  : TLinkRes;
   HPath    : TStringListItem;
@@ -208,7 +230,7 @@ end;
 
 
 
-function TLinkerGo32v2.MakeExecutable:boolean;
+function TExternalLinkerGo32v2.MakeExecutable:boolean;
 var
   binstr : String;
   cmdstr  : TCmdStr;
@@ -249,7 +271,7 @@ end;
 
 
 {$ifdef notnecessary}
-procedure tlinkergo32v2.postprocessexecutable(const n : string);
+procedure TExternalLinkerGo32v2.postprocessexecutable(const n : string);
 type
   tcoffheader=packed record
     mach   : word;
@@ -356,7 +378,7 @@ end;
 *****************************************************************************}
 
 initialization
-  RegisterExternalLinker(system_i386_go32v2_info,TLinkerGo32v2);
-  RegisterInternalLinker(system_i386_go32v2_info,TDJCoffLinker);
+  RegisterExternalLinker(system_i386_go32v2_info,TExternalLinkerGo32v2);
+  RegisterInternalLinker(system_i386_go32v2_info,TInternalLinkerGo32v2);
   RegisterTarget(system_i386_go32v2_info);
 end.

compiler/systems/t_wdosx.pas

@@ -34,17 +34,17 @@ implementation
        import,export,link,t_win,i_wdosx;
 
   type
-    timportlibwdosx=class(timportlibwin32)
+    timportlibwdosx=class(TImportLibWin)
     end;
 
-    texportlibwdosx=texportlibwin32;
+    texportlibwdosx=TExportLibWin;
 
-    tlinkerwdosx=class(tlinkerwin32)
+    TExternalLinkerwdosx=class(TExternalLinkerWin)
     public
        function  MakeExecutable:boolean;override;
     end;
 
-    tDLLScannerWdosx=class(tDLLScannerWin32)
+    tDLLScannerWdosx=class(TDLLScannerWin)
     end;
 
 
@@ -53,9 +53,9 @@ implementation
 *****************************************************************************}
 
 {*****************************************************************************
-                             TLINKERWDOSX
+                             TExternalLinkerWDOSX
 *****************************************************************************}
-function TLinkerWdosx.MakeExecutable:boolean;
+function TExternalLinkerWdosx.MakeExecutable:boolean;
 var
  b: boolean;
 begin
@@ -74,7 +74,7 @@ end;
 *****************************************************************************}
 
 initialization
-  RegisterExternalLinker(system_i386_wdosx_info,TLinkerWdosx);
+  RegisterExternalLinker(system_i386_wdosx_info,TExternalLinkerWdosx);
   RegisterImport(system_i386_wdosx,TImportLibWdosx);
   RegisterExport(system_i386_wdosx,TExportLibWdosx);
   RegisterDLLScanner(system_i386_wdosx,TDLLScannerWdosx);