Browse Source

* fix coff section names to fix resourcestrings with
the external linker
* create import libraries for dll imports, this uses
the new objdata framework to generate the binary
object files directly without needing an assembler pass
* store import_dll and import_name in ppu
* external linker uses import libraries
* internal linker uses import info from symtables,
no dlls are needed anymore

git-svn-id: trunk@3255 -

peter 19 years ago
parent
commit
ce58e15393

+ 7 - 0
compiler/finput.pas

@@ -146,6 +146,7 @@ interface
           objfilename,              { fullname of the objectfile }
           newfilename,              { fullname of the assemblerfile }
           ppufilename,              { fullname of the ppufile }
+          importlibfilename,        { fullname of the import libraryfile }
           staticlibfilename,        { fullname of the static libraryfile }
           sharedlibfilename,        { fullname of the shared libraryfile }
           mapfilename,              { fullname of the mapfile }
@@ -630,6 +631,7 @@ uses
          stringdispose(objfilename);
          stringdispose(newfilename);
          stringdispose(ppufilename);
+         stringdispose(importlibfilename);
          stringdispose(staticlibfilename);
          stringdispose(sharedlibfilename);
          stringdispose(mapfilename);
@@ -677,13 +679,16 @@ uses
            if OutputExtension <> '' then extension := OutputExtension;
          end;
 
+         importlibfilename:=stringdup(p+target_info.staticClibprefix+'imp'+n+target_info.staticlibext);
          staticlibfilename:=stringdup(p+target_info.staticlibprefix+n+target_info.staticlibext);
+
          { output dir of exe can be specified separatly }
          if AllowOutput and (OutputExeDir<>'') then
           p:=OutputExeDir
          else
           p:=path^;
          sharedlibfilename:=stringdup(p+prefix+n+suffix+extension);
+
          { don't use extension alone to check, it can be empty !! }
          if (OutputFile<>'') or (OutputExtension<>'') then
            exefilename:=stringdup(p+n+OutputExtension)
@@ -701,6 +706,7 @@ uses
         ppufilename:=nil;
         objfilename:=nil;
         newfilename:=nil;
+        importlibfilename:=nil;
         staticlibfilename:=nil;
         sharedlibfilename:=nil;
         exefilename:=nil;
@@ -731,6 +737,7 @@ uses
         stringdispose(objfilename);
         stringdispose(newfilename);
         stringdispose(ppufilename);
+        stringdispose(importlibfilename);
         stringdispose(staticlibfilename);
         stringdispose(sharedlibfilename);
         stringdispose(exefilename);

+ 1 - 0
compiler/fmodule.pas

@@ -519,6 +519,7 @@ implementation
         stringdispose(objfilename);
         stringdispose(newfilename);
         stringdispose(ppufilename);
+        stringdispose(importlibfilename);
         stringdispose(staticlibfilename);
         stringdispose(sharedlibfilename);
         stringdispose(exefilename);

+ 1 - 1
compiler/globals.pas

@@ -2251,7 +2251,7 @@ end;
         nwcopyright  := '';
         UseDeffileForExports:=false;
         UseDeffileForExportsSetExplicitly:=false;
-        GenerateImportSection:=true;
+        GenerateImportSection:=false;
         RelocSection:=false;
         RelocSectionSetExplicitly:=false;
         LinkTypeSetExplicitly:=false;

+ 1 - 9
compiler/import.pas

@@ -64,15 +64,7 @@ type
    end;
 
    TDLLScanner=class
-   public
-     f:file;
-     impname:string;
-     TheWord:array[0..1]of char;
-     HeaderOffset:cardinal;
-     loaded:integer;
-     function isSuitableFileType(x:cardinal):longbool;virtual;abstract;
-     function GetEdata(HeaderEntry:cardinal):longbool;virtual;abstract;
-     function Scan(const binname:string):longbool;virtual;abstract;
+     function Scan(const binname:string):boolean;virtual;abstract;
    end;
 
    TImportLibClass=class of TImportLib;

+ 46 - 22
compiler/link.pas

@@ -43,18 +43,19 @@ Type
     end;
 
     TLinker = class(TAbstractLinker)
+    private
+       procedure AddProcdefImports(p:tnamedindexitem;arg:pointer);
     public
        HasResources,
        HasExports      : boolean;
        ObjectFiles,
-       DLLFiles,
        SharedLibFiles,
        StaticLibFiles  : TStringList;
        Constructor Create;virtual;
        Destructor Destroy;override;
        procedure AddModuleFiles(hp:tmodule);
+       procedure AddExternalSymbol(const libname,symname:string);virtual;
        Procedure AddObject(const S,unitpath : String;isunit:boolean);
-       Procedure AddDLL(const S : String);
        Procedure AddStaticLibrary(const S : String);
        Procedure AddSharedLibrary(S : String);
        Procedure AddStaticCLibrary(const S : String);
@@ -79,6 +80,8 @@ Type
     private
        FCExeOutput : TExeOutputClass;
        FCObjInput  : TObjInputClass;
+       { Libraries }
+       FExternalLibraryList : TFPHashObjectList;
        procedure Load_ReadObject(const para:string);
        procedure Load_ReadUnitObjects;
        procedure ParseScript_Load;
@@ -88,12 +91,14 @@ Type
     protected
        property CObjInput:TObjInputClass read FCObjInput write FCObjInput;
        property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput;
+       property ExternalLibraryList:TFPHashObjectList read FExternalLibraryList;
        procedure DefaultLinkScript;virtual;abstract;
        linkscript : TStringList;
     public
        Constructor Create;override;
        Destructor Destroy;override;
        Function  MakeExecutable:boolean;override;
+       procedure AddExternalSymbol(const libname,symname:string);override;
      end;
 
 
@@ -119,6 +124,7 @@ uses
   cutils,
   script,globals,verbose,comphook,ppu,
   aasmbase,aasmtai,aasmdata,aasmcpu,
+  symbase,symdef,symtype,symconst,
   ogmap;
 
 type
@@ -281,7 +287,6 @@ Constructor TLinker.Create;
 begin
   Inherited Create;
   ObjectFiles:=TStringList.Create_no_double;
-  DLLFiles:=TStringList.Create_no_double;
   SharedLibFiles:=TStringList.Create_no_double;
   StaticLibFiles:=TStringList.Create_no_double;
 end;
@@ -290,12 +295,21 @@ end;
 Destructor TLinker.Destroy;
 begin
   ObjectFiles.Free;
-  DLLFiles.Free;
   SharedLibFiles.Free;
   StaticLibFiles.Free;
 end;
 
 
+procedure TLinker.AddProcdefImports(p:tnamedindexitem;arg:pointer);
+begin
+  if tdef(p).deftype<>procdef then
+    exit;
+  if assigned(tprocdef(p).import_dll) and
+     assigned(tprocdef(p).import_name) then
+    AddExternalSymbol(tprocdef(p).import_dll^,tprocdef(p).import_name^);
+end;
+
+
 procedure TLinker.AddModuleFiles(hp:tmodule);
 var
   mask : longint;
@@ -378,22 +392,23 @@ begin
       AddStaticCLibrary(linkotherstaticlibs.Getusemask(mask));
      while not linkothersharedlibs.empty do
       AddSharedCLibrary(linkothersharedlibs.Getusemask(mask));
-     { (Windows) DLLs }
-     while not linkdlls.empty do
-      AddDLL(linkdlls.Getusemask(mask));
+     { Known Library/DLL Imports }
+     if assigned(globalsymtable) then
+       globalsymtable.defindex.foreach(@AddProcdefImports,nil);
+     if assigned(localsymtable) then
+       localsymtable.defindex.foreach(@AddProcdefImports,nil);
    end;
 end;
 
 
-Procedure TLinker.AddObject(const S,unitpath : String;isunit:boolean);
-begin
-  ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit));
-end;
+    procedure TLinker.AddExternalSymbol(const libname,symname:string);
+      begin
+      end;
 
 
-Procedure TLinker.AddDLL(const S : String);
+Procedure TLinker.AddObject(const S,unitpath : String;isunit:boolean);
 begin
-  DLLFiles.Concat(s);
+  ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit));
 end;
 
 
@@ -714,6 +729,7 @@ end;
       begin
         inherited Create;
         linkscript:=TStringList.Create;
+        FExternalLibraryList:=TFPHashObjectList.Create(true);
         exemap:=nil;
         exeoutput:=nil;
         CObjInput:=TObjInput;
@@ -723,6 +739,7 @@ end;
     Destructor TInternalLinker.Destroy;
       begin
         linkscript.free;
+        ExternalLibraryList.Free;
         if assigned(exeoutput) then
           begin
             exeoutput.free;
@@ -737,6 +754,20 @@ end;
       end;
 
 
+    procedure TInternalLinker.AddExternalSymbol(const libname,symname:string);
+      var
+        ExtLibrary : TExternalLibrary;
+        ExtSymbol : TFPHashObject;
+      begin
+        ExtLibrary:=TExternalLibrary(ExternalLibraryList.Find(libname));
+        if not assigned(ExtLibrary) then
+          ExtLibrary:=TExternalLibrary.Create(ExternalLibraryList,libname);
+        ExtSymbol:=TFPHashObject(ExtLibrary.ExternalSymbolList.Find(symname));
+        if not assigned(ExtSymbol) then
+          ExtSymbol:=TFPHashObject.Create(ExtLibrary.ExternalSymbolList,symname);
+      end;
+
+
     procedure TInternalLinker.Load_ReadObject(const para:string);
       var
         objdata  : TObjData;
@@ -897,15 +928,8 @@ end;
         { Load .o files and resolve symbols }
         ParseScript_Load;
         exeoutput.ResolveSymbols;
-        { DLL Linking }
-        While not DLLFiles.Empty do
-          begin
-            s:=DLLFiles.GetFirst;
-            if FindDLL(s,s2) then
-              exeoutput.ResolveExternals(s2)
-            else
-              Comment(V_Error,'DLL not found: '+s);
-          end;
+        { Generate symbols and code to do the importing }
+        exeoutput.GenerateLibraryImports(ExternalLibraryList);
         { Fill external symbols data }
         exeoutput.FixupSymbols;
         if ErrorCount>0 then

+ 36 - 9
compiler/ogbase.pas

@@ -314,6 +314,15 @@ interface
       end;
       TExeSectionClass=class of TExeSection;
 
+      TExternalLibrary = class(TFPHashObject)
+      private
+        FExternalSymbolList : TFPHashObjectList;
+      public
+        constructor create(AList:TFPHashObjectList;const AName:string);virtual;
+        destructor  destroy;override;
+        property ExternalSymbolList:TFPHashObjectList read FExternalSymbolList;
+      end;
+
       TExeOutput = class
       private
         { ExeSections }
@@ -349,8 +358,8 @@ interface
       public
         constructor create;virtual;
         destructor  destroy;override;
-        procedure AddObjData(ObjData:TObjData);
         function  FindExeSection(const aname:string):TExeSection;
+        procedure AddObjData(ObjData:TObjData);
         procedure Load_Start;virtual;
         procedure Load_EntryName(const aname:string);virtual;
         procedure Load_Symbol(const aname:string);virtual;
@@ -375,7 +384,7 @@ interface
         procedure MergeStabs;
         procedure RemoveUnreferencedSections;
         procedure RemoveEmptySections;
-        procedure ResolveExternals(const libname:string);virtual;
+        procedure GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);virtual;
         function  writeexefile(const fn:string):boolean;
         property Writer:TObjectWriter read FWriter;
         property ExeSections:TFPHashObjectList read FExeSectionList;
@@ -1200,6 +1209,24 @@ implementation
       end;
 
 
+{****************************************************************************
+                                TExternalLibrary
+****************************************************************************}
+
+    constructor TExternalLibrary.create(AList:TFPHashObjectList;const AName:string);
+      begin
+        inherited create(AList,AName);
+        FExternalSymbolList:=TFPHashObjectList.Create(false);
+      end;
+
+
+    destructor TExternalLibrary.destroy;
+      begin
+        ExternalSymbolList.Free;
+        inherited destroy;
+      end;
+
+
 {****************************************************************************
                                 TExeOutput
 ****************************************************************************}
@@ -1259,17 +1286,17 @@ implementation
       end;
 
 
-    procedure TExeOutput.AddObjData(ObjData:TObjData);
+    function  TExeOutput.FindExeSection(const aname:string):TExeSection;
       begin
-        if ObjData.classtype<>FCObjData then
-          Comment(V_Error,'Invalid input object format for '+ObjData.name+' got '+ObjData.classname+' expected '+FCObjData.classname);
-        ObjDataList.Add(ObjData);
+        result:=TExeSection(FExeSectionList.Find(aname));
       end;
 
 
-    function  TExeOutput.FindExeSection(const aname:string):TExeSection;
+    procedure TExeOutput.AddObjData(ObjData:TObjData);
       begin
-        result:=TExeSection(FExeSectionList.Find(aname));
+        if ObjData.classtype<>FCObjData then
+          Comment(V_Error,'Invalid input object format for '+ObjData.name+' got '+ObjData.classname+' expected '+FCObjData.classname);
+        ObjDataList.Add(ObjData);
       end;
 
 
@@ -1665,7 +1692,7 @@ implementation
       end;
 
 
-    procedure TExeOutput.ResolveExternals(const libname:string);
+    procedure TExeOutput.GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);
       begin
       end;
 

+ 156 - 161
compiler/ogcoff.pas

@@ -184,8 +184,7 @@ interface
          idatalabnr : longint;
        public
          constructor create;override;
-         function  LoadDLL(const dllname:string):boolean;
-         procedure ResolveExternals(const libname:string);override;
+         procedure GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);override;
        end;
 
        TObjSymbolrec = record
@@ -214,6 +213,11 @@ interface
        end;
 
 
+    type
+      Treaddllproc = procedure(const dllname,funcname:string);
+
+    function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean;
+
 implementation
 
     uses
@@ -865,7 +869,7 @@ const win32stub : array[0..131] of byte=(
         secname:=coffsecnames[atype];
         if use_smartlink_section and
            (aname<>'') then
-          result:=secname+'$'+aname
+          result:=secname+'.'+aname
         else
           result:=secname;
       end;
@@ -1204,6 +1208,8 @@ const win32stub : array[0..131] of byte=(
            for i:=0 to ObjSymbolList.Count-1 do
              begin
                objsym:=TObjSymbol(ObjSymbolList[i]);
+               if (objsym.typ=AT_LABEL) and (objsym.bind=AB_LOCAL) then
+                 continue;
                case objsym.bind of
                  AB_GLOBAL :
                    begin
@@ -2132,42 +2138,9 @@ const win32stub : array[0..131] of byte=(
         CObjData:=TPECoffObjData;
       end;
 
-{$ifdef win32}
-    var
-      Wow64DisableWow64FsRedirection : function (var OldValue : pointer) : boolean;stdcall;
-      Wow64RevertWow64FsRedirection : function (OldValue : pointer) : boolean;stdcall;
-{$endif win32}
 
-    function TPECoffexeoutput.LoadDLL(const dllname:string):boolean;
-      type
-       TPECoffExpDir=packed record
-         flag,
-         stamp      : cardinal;
-         Major,
-         Minor      : word;
-         Name,
-         Base,
-         NumFuncs,
-         NumNames,
-         AddrFuncs,
-         AddrNames,
-         AddrOrds   : cardinal;
-       end;
+    procedure TPECoffexeoutput.GenerateLibraryImports(ExternalLibraryList:TFPHashObjectList);
       var
-        basedllname : string;
-        DLLReader : TObjectReader;
-        DosHeader : array[0..$7f] of byte;
-        PEMagic   : array[0..3] of byte;
-        Header    : CoffHeader;
-        peheader  : coffpeoptheader;
-        NameOfs,
-        newheaderofs : longint;
-        expdir    : TPECoffExpDir;
-        i,j       : longint;
-        found     : boolean;
-        sechdr    : CoffSecHdr;
-        FuncName  : string;
-        exesym    : TExeSymbol;
         textobjsection,
         idata2objsection,
         idata4objsection,
@@ -2175,12 +2148,13 @@ const win32stub : array[0..131] of byte=(
         idata6objsection,
         idata7objsection : TObjSection;
 
-        procedure StartImport;
+        procedure StartImport(const dllname:string);
         var
           idata4label,
           idata5label,
           idata7label : TObjSymbol;
-          emptyint : longint;
+          emptyint    : longint;
+          basedllname : string;
         begin
           if assigned(exemap) then
             begin
@@ -2188,6 +2162,7 @@ const win32stub : array[0..131] of byte=(
               exemap.Add('Importing from DLL '+dllname);
             end;
           emptyint:=0;
+          basedllname:=splitfilename(dllname);
           textobjsection:=internalobjdata.createsection(sec_code,'');
           idata2objsection:=internalobjdata.createsection(sec_idata2,'');
           idata4objsection:=internalobjdata.createsection(sec_idata4,'');
@@ -2248,8 +2223,6 @@ const win32stub : array[0..131] of byte=(
         begin
           result:=nil;
           emptyint:=0;
-          if not assigned(idata2objsection) then
-            StartImport;
           if assigned(exemap) then
             exemap.Add(' Importing Function '+afuncname);
           { idata6, import data (ordnr+name) }
@@ -2279,133 +2252,31 @@ const win32stub : array[0..131] of byte=(
           internalobjdata.writebytes(nopopcodes,align(internalobjdata.CurrObjSec.size,sizeof(nopopcodes))-internalobjdata.CurrObjSec.size);
         end;
 
-{$ifdef win32}
       var
-        p : pointer;
-{$endif win32}
+        i,j : longint;
+        ExtLibrary : TExternalLibrary;
+        ExtSymbol  : TFPHashObject;
+        exesym     : TExeSymbol;
       begin
-        result:=false;
-        basedllname:=splitfilename(dllname);
-{$ifdef win32}
-        if (target_info.system=system_x86_64_win64) and
-          assigned(Wow64DisableWow64FsRedirection) then
-          Wow64DisableWow64FsRedirection(p);
-{$endif win32}
-        DLLReader:=TObjectReader.Create;
-        DLLReader.OpenFile(dllname);
-{$ifdef win32}
-        if (target_info.system=system_x86_64_win64) and
-          assigned(Wow64RevertWow64FsRedirection) then
-          Wow64RevertWow64FsRedirection(p);
-{$endif win32}
-        if not DLLReader.Read(DosHeader,sizeof(DosHeader)) or
-           (DosHeader[0]<>$4d) or (DosHeader[1]<>$5a) then
-          begin
-            Comment(V_Error,'Invalid DLL '+dllname+', Dos Header invalid');
-            exit;
-          end;
-        newheaderofs:=longint(DosHeader[$3c]) or (DosHeader[$3d] shl 8) or (DosHeader[$3e] shl 16) or (DosHeader[$3f] shl 24);
-        DLLReader.Seek(newheaderofs);
-        if not DLLReader.Read(PEMagic,sizeof(PEMagic)) or
-           (PEMagic[0]<>$50) or (PEMagic[1]<>$45) or (PEMagic[2]<>$00) or (PEMagic[3]<>$00) then
-          begin
-            Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code');
-            exit;
-          end;
-        if not DLLReader.Read(Header,sizeof(CoffHeader)) or
-           (Header.mach<>COFF_MAGIC) or
-           (Header.opthdr<>sizeof(coffpeoptheader)) then
-          begin
-            Comment(V_Error,'Invalid DLL '+dllname+', invalid header size');
-            exit;
-          end;
-        { Read optheader }
-        DLLreader.Read(peheader,sizeof(coffpeoptheader));
-        { Section headers }
-        found:=false;
-        for i:=1 to header.nsects do
+        for i:=0 to ExternalLibraryList.Count-1 do
           begin
-            if not DLLreader.read(sechdr,sizeof(sechdr)) then
+            ExtLibrary:=TExternalLibrary(ExternalLibraryList[i]);
+            idata2objsection:=nil;
+            idata4objsection:=nil;
+            idata5objsection:=nil;
+            idata6objsection:=nil;
+            idata7objsection:=nil;
+            StartImport(ExtLibrary.Name);
+            for j:=0 to ExtLibrary.ExternalSymbolList.Count-1 do
               begin
-                Comment(V_Error,'Error reading coff file '+DLLName);
-                exit;
-              end;
-            if (sechdr.rvaofs<=peheader.DataDirectory[PE_DATADIR_EDATA].vaddr) and
-               (peheader.DataDirectory[PE_DATADIR_EDATA].vaddr<sechdr.rvaofs+sechdr.vsize) then
-              begin
-                found:=true;
-                break;
-              end;
-          end;
-        if not found then
-          begin
-            Comment(V_Warning,'DLL '+DLLName+' does not contain any exports');
-            exit;
-          end;
-        { Process edata }
-        idata2objsection:=nil;
-        idata4objsection:=nil;
-        idata5objsection:=nil;
-        idata6objsection:=nil;
-        idata7objsection:=nil;
-        DLLReader.Seek(sechdr.datapos+peheader.DataDirectory[PE_DATADIR_EDATA].vaddr-sechdr.rvaofs);
-        DLLReader.Read(expdir,sizeof(expdir));
-        for i:=0 to expdir.NumNames-1 do
-          begin
-            DLLReader.Seek(sechdr.datapos+expdir.AddrNames-sechdr.rvaofs+i*4);
-            DLLReader.Read(NameOfs,4);
-            Dec(NameOfs,sechdr.rvaofs);
-            if (NameOfs<0) or
-               (NameOfs>sechdr.vsize) then
-              begin
-                Comment(V_Error,'DLL does contains invalid exports');
-                break;
-              end;
-            { Read Function name from DLL, prepend _ and terminate with #0 }
-            DLLReader.Seek(sechdr.datapos+NameOfs);
-
-            { target which requires the _ prepention? }
-            if target_info.system in [system_i386_win32] then
-              begin
-                DLLReader.Read(FuncName[2],sizeof(FuncName)-3);
-                { Add underscore to be compatible with ld.exe importing }
-                FuncName[1]:='_';
-                FuncName[sizeof(FuncName)-1]:=#0;
-              end
-            else
-              begin
-                DLLReader.Read(FuncName[1],sizeof(FuncName)-3);
-                FuncName[sizeof(FuncName)-1]:=#0;
-              end;
-            FuncName[0]:=chr(Strlen(@FuncName[1]));
-
-            for j:=0 to UnresolvedExeSymbols.Count-1 do
-              begin
-                exesym:=TExeSymbol(UnresolvedExeSymbols[j]);
+                ExtSymbol:=TFPHashObject(ExtLibrary.ExternalSymbolList[j]);
+                exesym:=TExeSymbol(ExeSymbolList.Find(ExtSymbol.Name));
                 if assigned(exesym) and
-                   not assigned(exesym.objsymbol) and
-                   (exesym.name=FuncName) then
-                  begin
-                    { Remove underscore }
-                    if target_info.system in [system_i386_win32] then
-                      Delete(FuncName,1,1);
-
-                    exesym.objsymbol:=AddProcImport(FuncName);
-                    UnresolvedExeSymbols[j]:=nil;
-                    break;
-                  end;
+                   not assigned(exesym.objsymbol) then
+                  exesym.objsymbol:=AddProcImport(ExtSymbol.Name);
               end;
+            EndImport;
           end;
-        UnresolvedExeSymbols.Pack;
-        if assigned(idata2objsection) then
-          EndImport;
-        DLLReader.Free;
-      end;
-
-
-    procedure TPECoffexeoutput.ResolveExternals(const libname:string);
-      begin
-        LoadDLL(libname);
       end;
 
 
@@ -2505,6 +2376,130 @@ const win32stub : array[0..131] of byte=(
       end;
 
 
+{*****************************************************************************
+                                   DLLReader
+*****************************************************************************}
+
+{$ifdef win32}
+    var
+      Wow64DisableWow64FsRedirection : function (var OldValue : pointer) : boolean;stdcall;
+      Wow64RevertWow64FsRedirection : function (OldValue : pointer) : boolean;stdcall;
+{$endif win32}
+
+    function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean;
+      type
+       TPECoffExpDir=packed record
+         flag,
+         stamp      : cardinal;
+         Major,
+         Minor      : word;
+         Name,
+         Base,
+         NumFuncs,
+         NumNames,
+         AddrFuncs,
+         AddrNames,
+         AddrOrds   : cardinal;
+       end;
+      var
+        DLLReader : TObjectReader;
+        DosHeader : array[0..$7f] of byte;
+        PEMagic   : array[0..3] of byte;
+        Header    : CoffHeader;
+        peheader  : coffpeoptheader;
+        NameOfs,
+        newheaderofs : longint;
+        FuncName  : string;
+        expdir    : TPECoffExpDir;
+        i         : longint;
+        found     : boolean;
+        sechdr    : CoffSecHdr;
+{$ifdef win32}
+        p : pointer;
+{$endif win32}
+      begin
+        result:=false;
+{$ifdef win32}
+        if (target_info.system=system_x86_64_win64) and
+          assigned(Wow64DisableWow64FsRedirection) then
+          Wow64DisableWow64FsRedirection(p);
+{$endif win32}
+        DLLReader:=TObjectReader.Create;
+        DLLReader.OpenFile(dllname);
+{$ifdef win32}
+        if (target_info.system=system_x86_64_win64) and
+          assigned(Wow64RevertWow64FsRedirection) then
+          Wow64RevertWow64FsRedirection(p);
+{$endif win32}
+        if not DLLReader.Read(DosHeader,sizeof(DosHeader)) or
+           (DosHeader[0]<>$4d) or (DosHeader[1]<>$5a) then
+          begin
+            Comment(V_Error,'Invalid DLL '+dllname+', Dos Header invalid');
+            exit;
+          end;
+        newheaderofs:=longint(DosHeader[$3c]) or (DosHeader[$3d] shl 8) or (DosHeader[$3e] shl 16) or (DosHeader[$3f] shl 24);
+        DLLReader.Seek(newheaderofs);
+        if not DLLReader.Read(PEMagic,sizeof(PEMagic)) or
+           (PEMagic[0]<>$50) or (PEMagic[1]<>$45) or (PEMagic[2]<>$00) or (PEMagic[3]<>$00) then
+          begin
+            Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code');
+            exit;
+          end;
+        if not DLLReader.Read(Header,sizeof(CoffHeader)) or
+           (Header.mach<>COFF_MAGIC) or
+           (Header.opthdr<>sizeof(coffpeoptheader)) then
+          begin
+            Comment(V_Error,'Invalid DLL '+dllname+', invalid header size');
+            exit;
+          end;
+        { Read optheader }
+        DLLreader.Read(peheader,sizeof(coffpeoptheader));
+        { Section headers }
+        found:=false;
+        for i:=1 to header.nsects do
+          begin
+            if not DLLreader.read(sechdr,sizeof(sechdr)) then
+              begin
+                Comment(V_Error,'Error reading coff file '+DLLName);
+                exit;
+              end;
+            if (sechdr.rvaofs<=peheader.DataDirectory[PE_DATADIR_EDATA].vaddr) and
+               (peheader.DataDirectory[PE_DATADIR_EDATA].vaddr<sechdr.rvaofs+sechdr.vsize) then
+              begin
+                found:=true;
+                break;
+              end;
+          end;
+        if not found then
+          begin
+            Comment(V_Warning,'DLL '+DLLName+' does not contain any exports');
+            exit;
+          end;
+        { Process edata }
+        DLLReader.Seek(sechdr.datapos+peheader.DataDirectory[PE_DATADIR_EDATA].vaddr-sechdr.rvaofs);
+        DLLReader.Read(expdir,sizeof(expdir));
+        for i:=0 to expdir.NumNames-1 do
+          begin
+            DLLReader.Seek(sechdr.datapos+expdir.AddrNames-sechdr.rvaofs+i*4);
+            DLLReader.Read(NameOfs,4);
+            Dec(NameOfs,sechdr.rvaofs);
+            if (NameOfs<0) or
+               (NameOfs>sechdr.vsize) then
+              begin
+                Comment(V_Error,'DLL does contains invalid exports');
+                break;
+              end;
+            { Read Function name from DLL, prepend _ and terminate with #0 }
+            DLLReader.Seek(sechdr.datapos+NameOfs);
+            DLLReader.Read(FuncName[1],sizeof(FuncName)-3);
+            FuncName[sizeof(FuncName)-1]:=#0;
+            FuncName[0]:=chr(Strlen(@FuncName[1]));
+            readdllproc(DLLName,FuncName);
+          end;
+        DLLReader.Free;
+      end;
+
+
 {*****************************************************************************
                                   Initialize
 *****************************************************************************}

+ 3 - 7
compiler/pdecsub.pas

@@ -1460,10 +1460,12 @@ begin
       if not(token=_SEMICOLON) and not(idtoken=_NAME) then
         begin
           import_dll:=stringdup(get_stringconst);
+          include(procoptions,po_has_importdll);
           if (idtoken=_NAME) then
            begin
              consume(_NAME);
              import_name:=stringdup(get_stringconst);
+             include(procoptions,po_has_importname);
              if import_name^='' then
                message(parser_e_empty_import_name);
            end;
@@ -1483,6 +1485,7 @@ begin
            begin
              consume(_NAME);
              import_name:=stringdup(get_stringconst);
+             include(procoptions,po_has_importname);
              if import_name^='' then
                message(parser_e_empty_import_name);
            end;
@@ -2040,13 +2043,6 @@ const
                     same DLL function. This is also needed for compatability
                     with Delphi and TP7 }
                   case target_info.system of
-                    system_i386_win32 :
-                      begin
-                        { We need to use the name with a _ prefix if we let ld.exe do
-                          the importing for us }
-                        if not GenerateImportSection then
-                          result:=target_info.Cprefix+pd.import_name^;
-                      end;
                     system_i386_wdosx,
                     system_i386_emx,system_i386_os2,
                     system_arm_wince,system_i386_wince :

+ 1 - 1
compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion=56;
+  CurrentPPUVersion=57;
 
 { buffer sizes }
   maxentrysize = 1024;

+ 2 - 10
compiler/psub.pas

@@ -1495,16 +1495,8 @@ implementation
                     (pd.hasforward) and
                     not(
                         assigned(pd.import_dll) and
-                        (
-                         (
-                          GenerateImportSection and
-                          (target_info.system in [system_i386_win32])
-                         ) or
-                         (
-                          target_info.system in [system_i386_wdosx,system_i386_emx,system_i386_os2,
-                                                 system_arm_wince,system_i386_wince]
-                         )
-                        )
+                        (target_info.system in [system_i386_wdosx,system_i386_emx,system_i386_os2,
+                                                system_arm_wince,system_i386_wince])
                        ) then
                    begin
                      s:=proc_get_importname(pd);

+ 4 - 1
compiler/symconst.pas

@@ -263,7 +263,10 @@ type
     { Procedure can be inlined }
     po_inline,
     { Procedure is used for internal compiler calls }
-    po_compilerproc
+    po_compilerproc,
+    { importing }
+    po_has_importdll,
+    po_has_importname
   );
   tprocoptions=set of tprocoption;
 

+ 15 - 3
compiler/symdef.pas

@@ -3175,9 +3175,15 @@ implementation
          ppufile.getderef(libsymderef);
 {$endif powerpc}
          { import stuff }
-         import_dll:=nil;
-         import_name:=nil;
-         import_nr:=0;
+         if po_has_importdll in procoptions then
+           import_dll:=stringdup(ppufile.getstring)
+         else
+           import_dll:=nil;
+         if po_has_importname in procoptions then
+           import_name:=stringdup(ppufile.getstring)
+         else
+           import_name:=nil;
+         import_nr:=ppufile.getword;
          { inline stuff }
          if (po_has_inlininginfo in procoptions) then
            begin
@@ -3303,6 +3309,12 @@ implementation
          { library symbol for AmigaOS/MorphOS }
          ppufile.putderef(libsymderef);
 {$endif powerpc}
+         { import }
+         if po_has_importdll in procoptions then
+           ppufile.putstring(import_dll^);
+         if po_has_importname in procoptions then
+           ppufile.putstring(import_name^);
+         ppufile.putword(import_nr);
          { inline stuff }
          oldintfcrc:=ppufile.do_crc;
          ppufile.do_crc:=false;

+ 272 - 437
compiler/systems/t_win.pas

@@ -31,7 +31,7 @@ interface
        symconst,symdef,symsym,
        script,gendef,
        cpubase,
-       import,export,link,cgobj,i_win,ogcoff;
+       import,export,link,cgobj,i_win;
 
 
   const
@@ -50,13 +50,13 @@ interface
       procedure win32importproc(aprocdef:tprocdef;const func,module : string;index : longint;const name : string);
       procedure importvariable_str(const s:string;const name,module:string);
       procedure importprocedure_str(const func,module:string;index:longint;const name:string);
+      procedure generateimportlib;
+      procedure generateidatasection;
     public
       procedure preparelib(const s:string);override;
       procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override;
       procedure importvariable(vs:tglobalvarsym;const name,module:string);override;
       procedure generatelib;override;
-      procedure generatenasmlib;virtual;
-      procedure generatesmartlib;override;
     end;
 
     texportlibwin32=class(texportlib)
@@ -83,20 +83,15 @@ interface
     end;
 
     tDLLScannerWin32=class(tDLLScanner)
-    private
-      cstring : array[0..127]of char;
-      function DOSstubOK(var x:cardinal):boolean;
-      function ExtractDllName(Const Name : string) : string;
-    public
-      function isSuitableFileType(x:cardinal):longbool;override;
-      function GetEdata(HeaderEntry:cardinal):longbool;override;
-      function Scan(const binname:string):longbool;override;
+      function Scan(const binname:string):boolean;override;
     end;
 
+
 implementation
 
   uses
-    cpuinfo,cgutils,dbgbase;
+    cpuinfo,cgutils,dbgbase,
+    owar,ogbase,ogcoff;
 
 
   const
@@ -131,15 +126,6 @@ implementation
          hp2 : twin32imported_item;
          hs  : string;
       begin
-         { If we don't generate imports then we need to only the dll for
-           the linker }
-         if not GenerateImportSection then
-           begin
-             hs:=AddExtension(module,target_info.sharedlibext);
-             current_module.linkdlls.add(hs,link_always);
-             exit;
-           end;
-
          { procdef or funcname must be give, not both }
          if assigned(aprocdef) and (func<>'') then
            internalerror(200411161);
@@ -213,15 +199,6 @@ implementation
          hp2 : twin32imported_item;
          hs  : string;
       begin
-         { If we don't generate imports then we need to only the dll for
-           the linker }
-         if not GenerateImportSection then
-           begin
-             hs:=AddExtension(module,target_info.sharedlibext);
-             current_module.linkdlls.add(hs,link_always);
-             exit;
-           end;
-
          hs:=AddExtension(module,target_info.sharedlibext);
          { search for the module }
          hp1:=timportlist(current_module.imports.first);
@@ -243,207 +220,246 @@ implementation
       end;
 
 
-    procedure timportlibwin32.generatenasmlib;
+    procedure timportlibwin32.generateimportlib;
+      var
+        ObjWriter        : tarobjectwriter;
+        ObjOutput        : TPECoffObjOutput;
+        basedllname      : string;
+        AsmPrefix        : string;
+        idatalabnr,
+        SmartFilesCount,
+        SmartHeaderCount : longint;
+
+        function CreateObjData(place:tcutplace):TObjData;
+        var
+          s : string;
+        begin
+          s:='';
+          case place of
+            cut_begin :
+              begin
+                inc(SmartHeaderCount);
+                s:=asmprefix+tostr(SmartHeaderCount)+'h';
+              end;
+            cut_normal :
+              s:=asmprefix+tostr(SmartHeaderCount)+'s';
+            cut_end :
+              s:=asmprefix+tostr(SmartHeaderCount)+'t';
+          end;
+          inc(SmartFilesCount);
+          result:=ObjOutput.NewObjData(FixFileName(s+tostr(SmartFilesCount)+target_info.objext));
+          ObjOutput.startobjectfile(Result.Name);
+        end;
+
+        procedure WriteObjData(objdata:TObjData);
+        begin
+          ObjOutput.writeobjectfile(ObjData);
+        end;
+
+        procedure StartImport(const dllname:string);
+        var
+          headlabel,
+          idata4label,
+          idata5label,
+          idata7label : TObjSymbol;
+          emptyint    : longint;
+          objdata     : TObjData;
+          idata2objsection,
+          idata4objsection,
+          idata5objsection : TObjSection;
+        begin
+          objdata:=CreateObjData(cut_begin);
+          idata2objsection:=objdata.createsection(sec_idata2,'');
+          idata4objsection:=objdata.createsection(sec_idata4,'');
+          idata5objsection:=objdata.createsection(sec_idata5,'');
+          emptyint:=0;
+          basedllname:=splitfilename(dllname);
+          { idata4 }
+          objdata.SetSection(idata4objsection);
+          idata4label:=objdata.SymbolDefine(asmprefix+'_names_'+basedllname,AB_GLOBAL,AT_DATA);
+          { idata5 }
+          objdata.SetSection(idata5objsection);
+          idata5label:=objdata.SymbolDefine(asmprefix+'_fixup_'+basedllname,AB_GLOBAL,AT_DATA);
+          { idata2 }
+          objdata.SetSection(idata2objsection);
+          headlabel:=objdata.SymbolDefine(asmprefix+'_head_'+basedllname,AB_GLOBAL,AT_DATA);
+          ObjOutput.exportsymbol(headlabel);
+          objdata.writereloc(0,sizeof(longint),idata4label,RELOC_RVA);
+          objdata.writebytes(emptyint,sizeof(emptyint));
+          objdata.writebytes(emptyint,sizeof(emptyint));
+          idata7label:=objdata.SymbolRef(asmprefix+'_dll_'+basedllname);
+          objdata.writereloc(0,sizeof(longint),idata7label,RELOC_RVA);
+          objdata.writereloc(0,sizeof(longint),idata5label,RELOC_RVA);
+          WriteObjData(objdata);
+          objdata.free;
+        end;
+
+        procedure EndImport;
+        var
+          idata7label : TObjSymbol;
+          emptyint : longint;
+          objdata     : TObjData;
+          idata4objsection,
+          idata5objsection,
+          idata7objsection : TObjSection;
+        begin
+          objdata:=CreateObjData(cut_end);
+          idata4objsection:=objdata.createsection(sec_idata4,'');
+          idata5objsection:=objdata.createsection(sec_idata5,'');
+          idata7objsection:=objdata.createsection(sec_idata7,'');
+          emptyint:=0;
+          { idata4 }
+          objdata.SetSection(idata4objsection);
+          objdata.writebytes(emptyint,sizeof(emptyint));
+          if target_info.system=system_x86_64_win64 then
+            objdata.writebytes(emptyint,sizeof(emptyint));
+          { idata5 }
+          objdata.SetSection(idata5objsection);
+          objdata.writebytes(emptyint,sizeof(emptyint));
+          if target_info.system=system_x86_64_win64 then
+            objdata.writebytes(emptyint,sizeof(emptyint));
+          { idata7 }
+          objdata.SetSection(idata7objsection);
+          idata7label:=objdata.SymbolDefine(asmprefix+'_dll_'+basedllname,AB_GLOBAL,AT_DATA);
+          objoutput.exportsymbol(idata7label);
+          objdata.writebytes(basedllname[1],length(basedllname));
+          objdata.writebytes(emptyint,1);
+          WriteObjData(objdata);
+          objdata.free;
+        end;
+
+        procedure AddImport(const afuncname:string;ordnr:word;isvar:boolean);
+        const
+{$ifdef x86_64}
+          jmpopcode : array[0..2] of byte = (
+            $ff,$24,$25
+          );
+{$else x86_64}
+          jmpopcode : array[0..1] of byte = (
+            $ff,$25
+          );
+{$endif x86_64}
+          nopopcodes : array[0..1] of byte = (
+            $90,$90
+          );
+        var
+          implabel,
+          idata2label,
+          idata5label,
+          idata6label : TObjSymbol;
+          emptyint : longint;
+          objdata     : TObjData;
+          textobjsection,
+          idata4objsection,
+          idata5objsection,
+          idata6objsection,
+          idata7objsection : TObjSection;
+        begin
+          objdata:=CreateObjData(cut_normal);
+          if not isvar then
+            textobjsection:=objdata.createsection(sec_code,'');
+          idata4objsection:=objdata.createsection(sec_idata4,'');
+          idata5objsection:=objdata.createsection(sec_idata5,'');
+          idata6objsection:=objdata.createsection(sec_idata6,'');
+          idata7objsection:=objdata.createsection(sec_idata7,'');
+          emptyint:=0;
+          { idata7, link to head }
+          objdata.SetSection(idata7objsection);
+          idata2label:=objdata.SymbolRef(asmprefix+'_head_'+basedllname);
+          objdata.writereloc(0,sizeof(longint),idata2label,RELOC_RVA);
+          { idata6, import data (ordnr+name) }
+          objdata.SetSection(idata6objsection);
+          inc(idatalabnr);
+          idata6label:=objdata.SymbolDefine(asmprefix+'_'+tostr(idatalabnr),AB_LOCAL,AT_DATA);
+          objdata.writebytes(ordnr,2);
+          objdata.writebytes(afuncname[1],length(afuncname));
+          objdata.writebytes(emptyint,1);
+          objdata.writebytes(emptyint,align(objdata.CurrObjSec.size,2)-objdata.CurrObjSec.size);
+          { idata4, import lookup table }
+          objdata.SetSection(idata4objsection);
+          objdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA);
+          if target_info.system=system_x86_64_win64 then
+            objdata.writebytes(emptyint,sizeof(emptyint));
+          { idata5, import address table }
+          objdata.SetSection(idata5objsection);
+          if isvar then
+            implabel:=objdata.SymbolDefine(afuncname,AB_GLOBAL,AT_DATA)
+          else
+            idata5label:=objdata.SymbolDefine(asmprefix+'_'+afuncname,AB_LOCAL,AT_DATA);
+          objdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA);
+          if target_info.system=system_x86_64_win64 then
+            objdata.writebytes(emptyint,sizeof(emptyint));
+          { text, jmp }
+          if not isvar then
+            begin
+              objdata.SetSection(textobjsection);
+              implabel:=objdata.SymbolDefine(afuncname,AB_GLOBAL,AT_FUNCTION);
+              objdata.writebytes(jmpopcode,sizeof(jmpopcode));
+              objdata.writereloc(0,sizeof(longint),idata5label,RELOC_ABSOLUTE32);
+              objdata.writebytes(nopopcodes,align(objdata.CurrObjSec.size,sizeof(nopopcodes))-objdata.CurrObjSec.size);
+            end;
+          ObjOutput.exportsymbol(implabel);
+          WriteObjData(objdata);
+          objdata.free;
+        end;
+
       var
          hp1 : timportList;
          hp2 : twin32imported_item;
       begin
-         new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
-         hp1:=timportlist(current_module.imports.first);
-         while assigned(hp1) do
-           begin
-             hp2:=twin32imported_item(hp1.imported_items.first);
-             while assigned(hp2) do
-               begin
-                 current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_extern,hp2.func^));
-                 current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_nasm_import,hp2.func^+' '+hp1.dllname^+' '+hp2.name^));
-                 hp2:=twin32imported_item(hp2.next);
-               end;
-             hp1:=timportlist(hp1.next);
-           end;
+        AsmPrefix:='imp'+Lower(current_module.modulename^);
+        idatalabnr:=0;
+        SmartFilesCount:=0;
+        SmartHeaderCount:=0;
+        current_module.linkotherstaticlibs.add(current_module.importlibfilename^,link_always);
+        ObjWriter:=TARObjectWriter.create(current_module.importlibfilename^);
+        ObjOutput:=TPECoffObjOutput.Create(ObjWriter);
+        hp1:=timportlist(current_module.imports.first);
+        while assigned(hp1) do
+          begin
+            StartImport(hp1.dllname^);
+            hp2:=twin32imported_item(hp1.imported_items.first);
+            while assigned(hp2) do
+              begin
+                AddImport(hp2.name^,hp2.ordnr,hp2.is_var);
+                hp2:=twin32imported_item(hp2.next);
+              end;
+            EndImport;
+            hp1:=timportlist(hp1.next);
+          end;
+        ObjOutput.Free;
+        ObjWriter.Free;
       end;
 
 
-    procedure timportlibwin32.generatesmartlib;
+    procedure timportlibwin32.generateidatasection;
       var
          hp1 : timportList;
+         hp2 : twin32imported_item;
+         l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel;
          mangledstring : string;
          importname : string;
          suffix : integer;
-         hp2 : twin32imported_item;
-         lhead,lname,lcode, {$ifdef ARM} lpcode, {$endif ARM}
-         lidata4,lidata5 : tasmlabel;
          href : treference;
       begin
          if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then
-          begin
-            generatenasmlib;
-            exit;
-          end;
-         hp1:=timportlist(current_module.imports.first);
-         while assigned(hp1) do
            begin
-             { Get labels for the sections }
-             current_asmdata.getdatalabel(lhead);
-             current_asmdata.getdatalabel(lname);
-             current_asmdata.getaddrlabel(lidata4);
-             current_asmdata.getaddrlabel(lidata5);
-             { create header for this importmodule }
-             current_asmdata.asmlists[al_imports].concat(Tai_cutobject.Create_begin);
-             new_section(current_asmdata.asmlists[al_imports],sec_idata2,'',0);
-             current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lhead));
-             { pointer to procedure names }
-             current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(lidata4));
-             { two empty entries follow }
-             current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
-             current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
-             { pointer to dll name }
-             current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(lname));
-             { pointer to fixups }
-             current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(lidata5));
-             { first write the name references }
-             new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0);
-             current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
-             current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lidata4));
-             { then the addresses and create also the indirect jump }
-             new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
-             current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
-             current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lidata5));
-
-             { create procedures }
-             hp2:=twin32imported_item(hp1.imported_items.first);
-             while assigned(hp2) do
+             new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
+             hp1:=timportlist(current_module.imports.first);
+             while assigned(hp1) do
                begin
-                 { insert cuts }
-                 current_asmdata.asmlists[al_imports].concat(Tai_cutobject.Create);
-                 { create indirect jump }
-                 if not hp2.is_var then
-                  begin
-                    current_asmdata.getjumplabel(lcode);
-                  {$ifdef ARM}
-                    current_asmdata.getjumplabel(lpcode);
-                  {$endif ARM}
-                    { place jump in al_procedures, insert a code section in the
-                      al_imports to reduce the amount of .s files (PFV) }
-                    new_section(current_asmdata.asmlists[al_imports],sec_code,'',0);
-                    if assigned(hp2.procdef) then
-                      mangledstring:=hp2.procdef.mangledname
-                    else
-                      mangledstring:=hp2.func^;
-                    current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(mangledstring,AT_FUNCTION,0));
-                    current_asmdata.asmlists[al_imports].concat(Tai_function_name.Create(''));
-                  {$ifdef ARM}
-                    reference_reset_symbol(href,lpcode,0);
-                    current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R12,href));
-                    reference_reset_base(href,NR_R12,0);
-                    current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R15,href));
-                    current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lpcode));
-                    reference_reset_symbol(href,lcode,0);
-                    current_asmdata.asmlists[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset));
-                  {$else ARM}
-                    reference_reset_symbol(href,lcode,0);
-                    current_asmdata.asmlists[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href));
-                    current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(4,$90));
-                  {$endif ARM}
-                  end;
-                 { create head link }
-                 new_section(current_asmdata.asmlists[al_imports],sec_idata7,'',0);
-                 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(lhead));
-                 { fixup }
-                 current_asmdata.getjumplabel(tasmlabel(hp2.lab));
-                 new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0);
-                 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab));
-                 if target_info.system=system_x86_64_win64 then
-                   current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
-                 { add jump field to al_imports }
-                 new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
-                 if hp2.is_var then
-                   current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(hp2.func^,AT_FUNCTION,0))
-                 else
-                   current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lcode));
-                 if (cs_debuginfo in aktmoduleswitches) then
-                  begin
-                    if assigned(hp2.name) then
-                      begin
-                        importname:='__imp_'+hp2.name^;
-                        suffix:=0;
-                        while assigned(current_asmdata.getasmsymbol(importname)) do
-                         begin
-                           inc(suffix);
-                           importname:='__imp_'+hp2.name^+'_'+tostr(suffix);
-                         end;
-                        current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
-                      end
-                    else
-                      begin
-                        importname:='__imp_by_ordinal'+tostr(hp2.ordnr);
-                        suffix:=0;
-                        while assigned(current_asmdata.getasmsymbol(importname)) do
-                         begin
-                           inc(suffix);
-                           importname:='__imp_by_ordinal'+tostr(hp2.ordnr)+'_'+tostr(suffix);
-                         end;
-                        current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4));
-                      end;
-                  end;
-                 if hp2.name^<>'' then
+                 hp2:=twin32imported_item(hp1.imported_items.first);
+                 while assigned(hp2) do
                    begin
-                     current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab));
-                     if target_info.system=system_x86_64_win64 then
-                       current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
-                   end
-                 else
-                   begin
-                     if target_info.system=system_x86_64_win64 then
-                       current_asmdata.asmlists[al_imports].concat(Tai_const.Create_64bit(int64($8000000000000000) or int64(hp2.ordnr)))
-                     else
-                       current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or longint(hp2.ordnr)));
+                     current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_extern,hp2.func^));
+                     current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_nasm_import,hp2.func^+' '+hp1.dllname^+' '+hp2.name^));
+                     hp2:=twin32imported_item(hp2.next);
                    end;
-
-                 { finally the import information }
-                 new_section(current_asmdata.asmlists[al_imports],sec_idata6,'',0);
-                 current_asmdata.asmlists[al_imports].concat(Tai_label.Create(hp2.lab));
-                 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_16bit(hp2.ordnr));
-                 current_asmdata.asmlists[al_imports].concat(Tai_string.Create(hp2.name^+#0));
-                 current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(2,0));
-                 hp2:=twin32imported_item(hp2.next);
+                 hp1:=timportlist(hp1.next);
                end;
-
-              { write final section }
-              current_asmdata.asmlists[al_imports].concat(Tai_cutobject.Create_end);
-              { end of name references }
-              new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0);
-              current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
-              if target_info.system=system_x86_64_win64 then
-                current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
-              { end if addresses }
-              new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0);
-              current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0));
-              { dllname }
-              new_section(current_asmdata.asmlists[al_imports],sec_idata7,'',0);
-              current_asmdata.asmlists[al_imports].concat(Tai_label.Create(lname));
-              current_asmdata.asmlists[al_imports].concat(Tai_string.Create(hp1.dllname^+#0));
-
-              hp1:=timportlist(hp1.next);
+             exit;
            end;
-       end;
-
 
-    procedure timportlibwin32.generatelib;
-      var
-         hp1 : timportList;
-         hp2 : twin32imported_item;
-         l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel;
-         mangledstring : string;
-         importname : string;
-         suffix : integer;
-         href : treference;
-      begin
-         if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then
-          begin
-            generatenasmlib;
-            exit;
-          end;
          hp1:=timportlist(current_module.imports.first);
          while assigned(hp1) do
            begin
@@ -595,6 +611,15 @@ implementation
       end;
 
 
+    procedure timportlibwin32.generatelib;
+      begin
+        if GenerateImportSection then
+          generateidatasection
+        else
+          generateimportlib;
+      end;
+
+
 {*****************************************************************************
                              TEXPORTLIBWIN32
 *****************************************************************************}
@@ -876,6 +901,7 @@ implementation
          temtexport.free;
       end;
 
+
     procedure texportlibwin32.generatenasmlib;
       var
          hp : texported_item;
@@ -1032,20 +1058,6 @@ begin
          Add(')');
        end;
 
-      { Write DLLs (=direct DLL linking) }
-      if not DLLFiles.Empty then
-       begin
-         Add('INPUT(') ;
-         While not DLLFiles.Empty do
-          begin
-            s:=DLLFiles.GetFirst;
-            if FindDLL(s,s2) then
-              Add(MaybeQuoted(s2))
-            else
-              Add('-l'+s);
-          end;
-         Add(')');
-       end;
       Add('SEARCH_DIR("/usr/i686-pc-cygwin/lib"); SEARCH_DIR("/usr/lib"); SEARCH_DIR("/usr/lib/w32api");');
       Add('OUTPUT_FORMAT(pei-i386)');
       Add('ENTRY(_mainCRTStartup)');
@@ -1591,226 +1603,49 @@ end;
                             TDLLScannerWin32
 ****************************************************************************}
 
-    function tDLLScannerWin32.DOSstubOK(var x:cardinal):boolean;
-      begin
-        blockread(f,TheWord,2,loaded);
-        if loaded<>2 then
-         DOSstubOK:=false
-        else
-         begin
-           DOSstubOK:=(TheWord='MZ');
-           seek(f,$3C);
-           blockread(f,x,4,loaded);
-           if(loaded<>4)or(longint(x)>filesize(f))then
-            DOSstubOK:=false;
-         end;
-      end;
-
-    function tDLLScannerWin32.ExtractDllName(Const Name : string) : string;
-      var n : string;
+    procedure CheckDLLFunc(const dllname,funcname:string);
+      var
+        hp : tExternalsItem;
       begin
-         n:=Upper(SplitExtension(Name));
-         if (n='.DLL') or (n='.DRV') or (n='.EXE') then
-           ExtractDllName:=Name
-         else
-           ExtractDllName:=Name+target_info.sharedlibext;
+        hp:=tExternalsItem(current_module.Externals.first);
+        while assigned(hp)do
+          begin
+            if (not hp.found) and
+               assigned(hp.data) and
+               (hp.data^=funcname) then
+              begin
+                hp.found:=true;
+                if not(current_module.uses_imports) then
+                  begin
+                    current_module.uses_imports:=true;
+                    importlib.preparelib(current_module.modulename^);
+                  end;
+//                if IsData then
+//                  timportlibwin32(importlib).importvariable_str(funcname,dllname,funcname)
+//                else
+                timportlibwin32(importlib).importprocedure_str(funcname,dllname,0,funcname);
+                exit;
+              end;
+            hp:=tExternalsItem(hp.next);
+          end;
       end;
 
 
-
-function tDLLScannerWin32.isSuitableFileType(x:cardinal):longbool;
- begin
-  seek(f,x);
-  blockread(f,TheWord,2,loaded);
-  isSuitableFileType:=(loaded=2)and(TheWord='PE');
- end;
-
-
-function tDLLScannerWin32.GetEdata(HeaderEntry:cardinal):longbool;
- type
-  TObjInfo=packed record
-   ObjName:array[0..7]of char;
-   VirtSize,
-   VirtAddr,
-   RawSize,
-   RawOffset,
-   Reloc,
-   LineNum:cardinal;
-   RelCount,
-   LineCount:word;
-   flags:cardinal;
-  end;
- var
-  i:cardinal;
-  ObjOfs:cardinal;
-  Obj:TObjInfo;
-  APE_obj,APE_Optsize:word;
-  ExportRVA:cardinal;
-  delta:cardinal;
- const
-  IMAGE_SCN_CNT_CODE=$00000020;
- var
- _d:dirstr;
- _n:namestr;
- _e:extstr;
- function isUsedFunction(name:pchar):longbool;
-  var
-   hp:tExternalsItem;
-  begin
-   isUsedFunction:=false;
-   hp:=tExternalsItem(current_module.Externals.first);
-   while assigned(hp)do
-    begin
-     if(assigned(hp.data))and(not hp.found)then
-      if hp.data^=StrPas(name)then
-       begin
-        isUsedFunction:=true;
-        hp.found:=true;
-        exit;
-       end;
-     hp:=tExternalsItem(hp.next);
-    end;
-  end;
-
- procedure Store(index:cardinal;name:pchar;isData:longbool);
-  begin
-   if not isUsedFunction(name)then
-    exit;
-   if not(current_module.uses_imports) then
-    begin
-     current_module.uses_imports:=true;
-     importlib.preparelib(current_module.modulename^);
-    end;
-   if IsData then
-    timportlibwin32(importlib).importvariable_str(name,_n,name)
-   else
-    timportlibwin32(importlib).importprocedure_str(name,_n,index,name);
-  end;
-
- procedure ProcessEdata;
-  type
-   a8=array[0..7]of char;
-  function GetSectionName(rva:cardinal;var Flags:cardinal):a8;
-   var
-    i:cardinal;
-    LocObjOfs:cardinal;
-    LocObj:TObjInfo;
-   begin
-    GetSectionName:='';
-    Flags:=0;
-    LocObjOfs:=APE_OptSize+HeaderOffset+24;
-    for i:=1 to APE_obj do
-     begin
-      seek(f,LocObjOfs);
-      blockread(f,LocObj,sizeof(LocObj));
-      if(rva>=LocObj.VirtAddr)and(rva<=LocObj.VirtAddr+LocObj.RawSize)then
-       begin
-        GetSectionName:=a8(LocObj.ObjName);
-        Flags:=LocObj.flags;
-       end;
-     end;
-   end;
-  var
-   j,Fl:cardinal;
-   ulongval,procEntry:cardinal;
-   Ordinal:word;
-   isData:longbool;
-   ExpDir:packed record
-    flag,
-    stamp:cardinal;
-    Major,
-    Minor:word;
-    Name,
-    Base,
-    NumFuncs,
-    NumNames,
-    AddrFuncs,
-    AddrNames,
-    AddrOrds:cardinal;
-   end;
-  begin
-   with Obj do
-    begin
-     seek(f,RawOffset+delta);
-     blockread(f,ExpDir,sizeof(ExpDir));
-     fsplit(impname,_d,_n,_e);
-     for j:=0 to pred(ExpDir.NumNames)do
-      begin
-{ Don't know why but this gives serious problems with overflow checking on }
-{$IFOPT Q+}
-{$DEFINE OVERFLOW_CHECK_WAS_ON}
-{$ENDIF}
-{$Q-}
-       seek(f,RawOffset-VirtAddr+ExpDir.AddrOrds+j*2);
-       blockread(f,Ordinal,2);
-       seek(f,RawOffset-VirtAddr+ExpDir.AddrFuncs+cardinal(Ordinal)*4);
-       blockread(f,ProcEntry,4);
-       seek(f,RawOffset-VirtAddr+ExpDir.AddrNames+j*4);
-       blockread(f,ulongval,4);
-       seek(f,RawOffset-VirtAddr+ulongval);
-       blockread(f,cstring,sizeof(cstring));
-       isData:=GetSectionName(procentry,Fl)='';
-{$IFDEF OVERFLOW_CHECK_WAS_ON}
-{$Q+}
-{$ENDIF}
-       if not isData then
-        isData:=Fl and IMAGE_SCN_CNT_CODE<>IMAGE_SCN_CNT_CODE;
-       Store(succ(Ordinal),cstring,isData);
-      end;
-   end;
-  end;
- begin
-  GetEdata:=false;
-  seek(f,HeaderEntry+120);
-  blockread(f,ExportRVA,4);
-  seek(f,HeaderEntry+6);
-  blockread(f,APE_Obj,2);
-  seek(f,HeaderEntry+20);
-  blockread(f,APE_OptSize,2);
-  ObjOfs:=APE_OptSize+HeaderOffset+24;
-  for i:=1 to APE_obj do
-   begin
-    seek(f,ObjOfs);
-    blockread(f,Obj,sizeof(Obj));
-    inc(ObjOfs,sizeof(Obj));
-    with Obj do
-     if(VirtAddr<=ExportRva)and(ExportRva<VirtAddr+VirtSize)then
+    function tDLLScannerWin32.scan(const binname:string):boolean;
+      var
+        hs,
+        dllname : string;
       begin
-       delta:=ExportRva-VirtAddr;
-       ProcessEdata;
-       GetEdata:=true;
+        result:=true;
+        { is there already an import library the we will use that one }
+        if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,hs) then
+          exit;
+        { check if we can find the dll }
+        hs:=AddExtension(binname,target_info.sharedlibext);
+        if not FindDll(hs,dllname) then
+          exit;
+        ReadDLLImports(dllname,@CheckDLLFunc);
       end;
-   end;
- end;
-
-function tDLLScannerWin32.scan(const binname:string):longbool;
- var
-  OldFileMode:byte;
-  hs,
-  foundimp : string;
- begin
-   Scan:=false;
-  { is there already an import library the we will use that one }
-  if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,foundimp) then
-   exit;
-  { check if we can find the dll }
-  hs:=AddExtension(binname,target_info.sharedlibext);
-  if not FindDll(hs,impname) then
-   exit;
-  { read the dll file }
-  assign(f,impname);
-  OldFileMode:=filemode;
-  filemode:=0;
-  reset(f,1);
-  filemode:=OldFileMode;
-  if not DOSstubOK(HeaderOffset)then
-   scan:=false
-  else if not isSuitableFileType(HeaderOffset)then
-   scan:=false
-  else
-   scan:=GetEdata(HeaderOffset);
-  close(f);
- end;
 
 
 {*****************************************************************************

+ 14 - 5
compiler/utils/ppudump.pp

@@ -921,7 +921,10 @@ type
     { Procedure can be inlined }
     po_inline,
     { Procedure is used for internal compiler calls }
-    po_compilerproc
+    po_compilerproc,
+    { importing }
+    po_has_importdll,
+    po_has_importname
   );
   tprocoptions=set of tprocoption;
 procedure read_abstract_proc_def(var proccalloption:tproccalloption;var procoptions:tprocoptions);
@@ -964,7 +967,7 @@ const
      (mask:potype_function;    str:'Function'),
      (mask:potype_procedure;   str:'Procedure')
   );
-  procopts=35;
+  procopts=37;
   procopt : array[1..procopts] of tprocopt=(
      (mask:po_classmethod;     str:'ClassMethod'),
      (mask:po_virtualmethod;   str:'VirtualMethod'),
@@ -1000,7 +1003,9 @@ const
      (mask:po_syscall_r12base; str:'SyscallR12Base'),
      (mask:po_local;           str:'Local'),
      (mask:po_inline;          str:'Inline'),
-     (mask:po_compilerproc;    str:'CompilerProc')
+     (mask:po_compilerproc;    str:'CompilerProc'),
+     (mask:po_has_importdll;   str:'HasImportDLL'),
+     (mask:po_has_importname;  str:'HasImportName')
   );
 var
   proctypeoption  : tproctypeoption;
@@ -1689,11 +1694,15 @@ begin
              write  (space,'       SymOptions : ');
              readsymoptions;
              if tsystemcpu(ppufile.header.cpu)=cpu_powerpc then
-	       begin
+               begin
                  { library symbol for AmigaOS/MorphOS }
                  write  (space,'   Library symbol : ');
                  readderef;
-	       end;
+               end;
+             if (po_has_importdll in procoptions) then
+               writeln(space,'       Import DLL : ',getstring);
+             if (po_has_importname in procoptions) then
+               writeln(space,'      Import Name : ',getstring);
              if (po_inline in procoptions) then
               begin
                 write  (space,'       FuncretSym : ');