+ pavel's code integrated, but onyl inside

ifdef pavel_linklib !

compiler/impdef.pas

@@ -0,0 +1,146 @@
+unit impdef;
+{
+C source code of DEWIN Windows disassembler (written by A. Milukov) was
+partially used
+}
+interface
+function makedef(const binname,textname:string):longbool;
+implementation
+var
+f:file;
+t:text;
+TheWord:array[0..1]of char;
+PEoffset:cardinal;
+loaded:{$ifdef fpc}longint{$else}integer{$endif};
+FileCreated:longbool;
+function DOSstubOK(var x:cardinal):longbool;
+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(x>filesize(f))then
+     DOSstubOK:=false;
+   end;
+end;
+function isPE(x:cardinal):longbool;
+begin
+  seek(f,x);
+  blockread(f,TheWord,2,loaded);
+  isPE:=(loaded=2)and(TheWord='PE');
+end;
+var
+cstring:array[0..127]of char;
+
+function GetEdata(PE: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;
+procedure ProcessEdata;
+  var
+   j:cardinal;
+   ulongval:cardinal;
+   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));
+     seek(f,RawOffset-VirtAddr+ExpDir.Name);
+     blockread(f,cstring,sizeof(cstring));
+     for j:=0 to pred(ExpDir.NumNames)do
+      begin
+       seek(f,RawOffset-VirtAddr+ExpDir.AddrNames+j*4);
+       blockread(f,ulongval,4);
+       seek(f,RawOffset-VirtAddr+ulongval);
+       blockread(f,cstring,sizeof(cstring));
+       if not FileCreated then
+        begin
+         FileCreated:=true;
+         rewrite(t);
+         writeln(t,'EXPORTS');
+        end;
+       { do not use the implicit '_' }
+       writeln(t,cstring,'=',cstring);
+      end;
+   end;
+  end;
+begin
+  GetEdata:=false;
+  FileCreated:=false;
+  seek(f,PE+120);
+  blockread(f,ExportRVA,4);
+  seek(f,PE+6);
+  blockread(f,APE_Obj,2);
+  seek(f,PE+20);
+  blockread(f,APE_OptSize,2);
+  ObjOfs:=APE_OptSize+PEoffset+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
+      begin
+       delta:=ExportRva-VirtAddr;
+       ProcessEdata;
+       GetEdata:=true;
+      end;
+   end;
+end;
+function makedef(const binname,textname:string):longbool;
+var
+  OldFileMode:longint;
+begin
+  FileCreated:=false;
+  assign(f,binname);
+  assign(t,textname);
+  OldFileMode:=filemode;
+  filemode:=0;
+  reset(f,1);
+  filemode:=OldFileMode;
+  if not DOSstubOK(PEoffset)then
+   makedef:=false
+  else if not IsPE(PEoffset)then
+   makedef:=false
+  else
+   makedef:=GetEdata(PEoffset);
+  close(f);
+  if FileCreated then
+   close(t);
+end;
+end.

compiler/scandir.inc

@@ -784,7 +784,7 @@ const
           Message(scan_e_resourcefiles_not_supported);
       end;
 
-
+{$ifndef PAVEL_LINKLIB}
     procedure dir_linklib(t:tdirectivetoken);
       var
         s : string;
@@ -821,6 +821,86 @@ const
          insert(s,link_allways);
       {$ENDIF}
       end;
+{$else PAVEL_LINKLIB}
+    procedure dir_linklib(t:tdirectivetoken);
+      var
+       s:string;
+       libname,linkmodeStr:string;
+       p:longint;
+      type
+       tLinkMode=(lm_dynamic,lm_static);
+      var
+       linkMode:tLinkMode;
+      function ExtractLinkMode:tLinkMode;
+       var
+        p:longint;
+       begin
+        p:=pos(',',linkmodeStr);
+        if p>0 then
+         linkmodeStr:=copy(linkmodeStr,1,pred(p));
+        for p:=1 to length(linkmodeStr)do
+         linkmodeStr[p]:=upcase(linkmodeStr[p]);
+        if linkmodeStr='STATIC' then
+         ExtractLinkMode:=lm_static
+        else
+         ExtractLinkMode:=lm_dynamic
+       end;
+      procedure MangleLibName(mode:tLinkMode);
+       begin
+        if (libname[1]='''')and(libname[length(libname)]='''')then
+         begin
+          delete(libname,1,1);
+          delete(libname,length(libname),1);
+         end
+        else
+         begin
+          libname:=target_os.libprefix+libname;
+          case mode of
+           lm_static:
+            libname:=AddExtension(FixFileName(libname),target_os.staticlibext);
+           lm_dynamic:
+            libname:=AddExtension(FixFileName(libname),target_os.sharedlibext);
+          end;
+         end;
+       end;
+      begin
+       current_scanner^.skipspace;
+       s:=current_scanner^.readcomment;
+       p:=pos(',',s);
+       if p=0 then
+        begin
+         libname:=s;
+         linkmodeStr:=''
+        end
+       else
+        begin
+         libname:=copy(s,1,pred(p));
+         linkmodeStr:=copy(s,succ(p),255);
+        end;
+       if(libname='')or(libname='''''')then
+        exit;
+       linkMode:=ExtractLinkMode;
+       MangleLibName(linkMode);
+       if linkMode=lm_static then
+{$IFDEF NEWST}
+        current_module^.linkOtherStaticLibs.
+         insert(new(Plinkitem,init(FixFileName(libname),link_allways)))
+{$ELSE}
+        current_module^.linkOtherStaticLibs.
+         insert(FixFileName(libname),link_allways)
+{$ENDIF}
+       else
+{$IFDEF NEWST}
+        current_module^.linkOtherSharedLibs.
+         insert(new(Plinkitem,init(FixFileName(libname),link_allways)));
+{$ELSE}
+        current_module^.linkOtherSharedLibs.
+         insert(FixFileName(libname),link_allways);
+{$ENDIF}
+      end;
+
+
+{$endif PAVEL_LINKLIB}
 
 
     procedure dir_outputformat(t:tdirectivetoken);
@@ -1335,7 +1415,11 @@ const
 
 {
   $Log$
-  Revision 1.80  2000-05-09 21:31:50  pierre
+  Revision 1.81  2000-05-23 20:18:25  pierre
+    + pavel's code integrated, but onyl inside
+      ifdef pavel_linklib !
+
+  Revision 1.80  2000/05/09 21:31:50  pierre
    * fix problem when modifying several local switches in a row
 
   Revision 1.79  2000/05/03 14:36:58  pierre

compiler/t_win32.pas

@@ -67,6 +67,14 @@ unit t_win32;
   implementation
 
     uses
+{$ifdef PAVEL_LINKLIB}
+{$ifdef Delphi}
+      dmisc,
+{$else Delphi}
+      dos,
+{$endif Delphi}
+       impdef,
+{$endif PAVEL_LINKLIB}
        aasm,files,globtype,globals,cobjects,systems,verbose,
        script,gendef,
        cpubase,cpuasm
@@ -643,7 +651,7 @@ begin
    end;
 end;
 
-
+{$ifndef PAVEL_LINKLIB}
 Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
 Var
   linkres  : TLinkRes;
@@ -749,6 +757,183 @@ begin
 
   WriteResponseFile:=True;
 end;
+{$else PAVEL_LINKLIB}
+Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
+Var
+  linkres  : TLinkRes;
+  HPath    : {$ifdef NEWST} PStringItem {$else} PStringQueueItem {$endif};
+  s,s2        : string;
+  success : boolean;
+function ExpandName(const s:string):string;
+var
+  sysdir:string;
+procedure GetSysDir;
+  begin
+   sysdir:=GetEnv('windir');
+   if sysdir<>''then
+    begin
+     if not(sysdir[length(sysdir)]in['\','/'])then
+      sysdir:=sysdir+dirsep;
+    end;
+  end;
+function IsFile(d:string;var PathToDll:string):longbool;
+  var
+   f:file;
+   attr:word;
+  begin
+   PathToDll:='';
+   if d<>''then
+    if d[length(d)]<>dirsep then
+     d:=d+dirsep;
+   d:=d+s;
+   assign(f,d);
+   GetFattr(f,Attr);
+   if DOSerror<>0 then
+    IsFile:=false
+   else
+    begin
+     if(attr and directory)=0 then
+      begin
+       IsFile:=true;
+       PathToDll:=GetShortName(d);
+      end
+     else
+      IsFile:=false;
+    end;
+  end;
+var
+  PathToDll:string;
+begin
+  if not isFile('',PathToDll)then
+   begin
+    HPath:=LibrarySearchPath.First;
+     while assigned(HPath) do
+      begin
+       if isFile(GetShortName(HPath^.Data^),PathToDll)then
+        break;
+       HPath:=HPath^.Next;
+      end;
+    if PathToDll='' then
+     begin
+      GetSysDir;
+      if not isFile(sysdir,PathToDll)then
+       if not isFile(sysdir+'system32',PathToDll)then
+        if not isFile(sysdir+'system',PathToDll)then
+         begin
+          message1(exec_w_libfile_not_found,S2);
+          PathToDll:=S2;
+         end;
+     end;
+   end;
+  ExpandName:=PathToDll;
+end;
+function DotPos(const s:string):longint;
+var
+  i:longint;
+begin
+  DotPos:=0;
+  for i:=length(s)downto 1 do
+   begin
+    if s[i]in['/','\',':']then
+     exit
+    else if s[i]='.'then
+     begin
+      DotPos:=i;
+      exit;
+     end;
+   end;
+end;
+procedure strip(var s:string);
+  var
+   d:dirstr;
+   n:namestr;
+   e:extstr;
+  begin
+   fsplit(s,d,n,e);
+   s:=n;
+  end;
+function do_makedef(const s:string):longbool;
+  begin
+   if cs_link_extern in aktglobalswitches then
+    do_makedef:=DoExec(FindUtil('fpimpdef'),'-o deffile.$$$ -i '+s,false,false)
+   else
+    do_makedef:=makedef(s,'deffile.$$$');
+  end;
+begin
+  WriteResponseFile:=False;
+  While not SharedLibFiles.Empty do
+   begin
+     S:=SharedLibFiles.Get;
+     if DotPos(s)=0 then
+      s2:=s+target_os.sharedlibext
+     else
+      s2:=s;
+     strip(s);
+     if not do_makedef(ExpandName(s2))then
+      begin
+       Message(exec_w_error_while_linking);
+       aktglobalswitches:=aktglobalswitches+[cs_link_extern];
+      end
+     else
+      begin
+       s:=target_os.libprefix+s+target_os.staticlibext;
+       success:=DoExec(FindUtil('dlltool'),'-l '+s+' -D '+s2+' -d deffile.$$$',false,false);
+       ObjectFiles.insert(s);
+       if not success then
+        break;
+      end;
+   end;
+
+  { Open link.res file }
+  LinkRes.Init(outputexedir+Info.ResName);
+
+  { Write path to search libraries }
+  HPath:=current_module^.locallibrarysearchpath.First;
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('SEARCH_DIR('+GetShortName(HPath^.Data^)+')');
+     HPath:=HPath^.Next;
+   end;
+  HPath:=LibrarySearchPath.First;
+  while assigned(HPath) do
+   begin
+     LinkRes.Add('SEARCH_DIR('+GetShortName(HPath^.Data^)+')');
+     HPath:=HPath^.Next;
+   end;
+
+  { add objectfiles, start with prt0 always }
+  LinkRes.Add('INPUT(');
+  if isdll then
+   LinkRes.AddFileName(GetShortName(FindObjectFile('wdllprt0')))
+  else
+   LinkRes.AddFileName(GetShortName(FindObjectFile('wprt0')));
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.Get;
+     if s<>'' then
+      LinkRes.AddFileName(GetShortName(s));
+   end;
+  LinkRes.Add(')');
+
+  { Write staticlibraries }
+  if not StaticLibFiles.Empty then
+   begin
+     LinkRes.Add('GROUP(');
+     While not StaticLibFiles.Empty do
+      begin
+        S:=StaticLibFiles.Get;
+        LinkRes.AddFileName(GetShortName(s));
+      end;
+     LinkRes.Add(')');
+   end;
+
+{ Write and Close response }
+  linkres.writetodisk;
+  linkres.done;
+
+  WriteResponseFile:=True;
+end;
+{$endif PAVEL_LINKLIB}
 
 
 function TLinkerWin32.MakeExecutable:boolean;
@@ -824,6 +1009,7 @@ begin
      RemoveFile(outputexedir+Info.ResName);
      RemoveFile('base.$$$');
      RemoveFile('exp.$$$');
+     RemoveFile('deffile.$$$');
    end;
 
   MakeExecutable:=success;   { otherwise a recursive call to link method }
@@ -1114,7 +1300,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.22  2000-04-14 11:16:10  pierre
+  Revision 1.23  2000-05-23 20:18:25  pierre
+    + pavel's code integrated, but onyl inside
+      ifdef pavel_linklib !
+
+  Revision 1.22  2000/04/14 11:16:10  pierre
     * partial linklib change
       I could not use Pavel's code because it broke the current way
       linklib is used, which is messy :(

compiler/utils/fpimpdef.pp

@@ -0,0 +1,56 @@
+program FPimpdef;
+uses
+ImpDef;
+var
+binname:string;
+function Ofound(const short,full:string):longint;
+var
+  i:longint;
+begin
+  Ofound:=-1;
+  for i:=1 to ParamCount do
+   if(paramstr(i)=short)or(paramstr(i)=full)then
+    begin
+     Ofound:=i;
+     exit;
+    end;
+end;
+function GetOption(const short,full:string):string;
+var
+  i:longint;
+begin
+  i:=Ofound(short,full);
+  if i>0 then
+   GetOption:=paramstr(succ(i))
+  else
+   GetOption:='';
+end;
+procedure help_info;
+var
+  fn:string[255];
+  jj:cardinal;
+begin
+  fn:=paramstr(0);
+  for jj:=length(fn)downto 1 do
+   if fn[jj] in [':','\','/']then
+    begin
+     fn:=copy(fn,succ(jj),255);
+     break;
+    end;
+  writeln('Usage: ',fn,' [options]');
+  writeln('Options:');
+  writeln('-i | --input  <file> - set input file;');
+  writeln('-o | --output <file> - set output file');
+  writeln('-h | --help          - show this screen');
+  halt;
+end;
+begin
+binname:=GetOption('-i','--input');
+if(binname='')or(Ofound('-h','--help')>0)then
+  help_info;
+if not makedef(binname,GetOption('-o','--output'))then
+  begin
+   writeln('Export names not found');
+   halt(1);
+  end;
+end.