fpc/compiler/link.pas

{
    $Id$
    Copyright (c) 1998-2000 by Peter Vreman

    This unit handles the linker and binder calls for programs and
    libraries

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

 ****************************************************************************
}
unit link;

{$i defines.inc}

{ Needed for LFN support in path to the executable }
{$ifdef GO32V2}
  {$define ALWAYSSHELL}
{$endif}

interface
uses
  cobjects,cclasses,
  fmodule;

Type
    TLinkerInfo=record
      ExeCmd,
      DllCmd        : array[1..3] of string[100];
      ResName       : string[12];
      ExtraOptions  : string;
      DynamicLinker : string[100];
    end;

    TLinker = class
    public
       Info            : TLinkerInfo;
       ObjectFiles,
       SharedLibFiles,
       StaticLibFiles  : TStringList;
     { Methods }
       Constructor Create;
       Destructor Destroy;override;
       procedure AddModuleFiles(hp:tmodule);
       function  FindObjectFile(s : string;const unitpath:string) : string;
       function  FindLibraryFile(s:string;const ext:string;var found : boolean) : string;
       Procedure AddObject(const S,unitpath : String);
       Procedure AddStaticLibrary(const S : String);
       Procedure AddSharedLibrary(S : String);
       Function  FindUtil(const s:string):String;
       Function  DoExec(const command,para:string;showinfo,useshell:boolean):boolean;
     { Virtuals }
       procedure SetDefaultInfo;virtual;
       Function  MakeExecutable:boolean;virtual;
       Function  MakeSharedLibrary:boolean;virtual;
       Function  MakeStaticLibrary:boolean;virtual;
     end;

Var
  Linker : TLinker;

procedure InitLinker;
procedure DoneLinker;


Implementation

uses
{$ifdef Delphi}
  dmisc,
{$else Delphi}
  dos,
{$endif Delphi}
  cutils,globtype,systems,
  script,globals,verbose,ppu
{$ifdef i386}
  {$ifndef NOTARGETLINUX}
    ,t_linux
  {$endif}
  {$ifndef NOTARGETFREEBSD}
    ,t_fbsd
  {$endif}
  {$ifndef NOTARGETOS2}
    ,t_os2
  {$endif}
  {$ifndef NOTARGETWIN32}
    ,t_win32
  {$endif}
  {$ifndef NOTARGETNETWARE}
    ,t_nwm
  {$endif}
  {$ifndef NOTARGETGO32V1}
    ,t_go32v1
  {$endif}
  {$ifndef NOTARGETGO32V2}
    ,t_go32v2
  {$endif}
{$endif}
{$ifdef m68k}
  {$ifndef NOTARGETLINUX}
    ,t_linux
  {$endif}
{$endif}
{$ifdef powerpc}
  {$ifndef NOTARGETLINUX}
    ,t_linux
  {$endif}
{$endif}
{$ifdef alpha}
  {$ifndef NOTARGETLINUX}
    ,t_linux
  {$endif}
{$endif}
  ;

{*****************************************************************************
                                   TLINKER
*****************************************************************************}

Constructor TLinker.Create;
begin
  ObjectFiles:=TStringList.Create_no_double;
  SharedLibFiles:=TStringList.Create_no_double;
  StaticLibFiles:=TStringList.Create_no_double;
{ set generic defaults }
  FillChar(Info,sizeof(Info),0);
  Info.ResName:='link.res';
{ set the linker specific defaults }
  SetDefaultInfo;
{ Allow Parameter overrides for linker info }
  with Info do
   begin
     if ParaLinkOptions<>'' then
      ExtraOptions:=ParaLinkOptions;
     if ParaDynamicLinker<>'' then
      DynamicLinker:=ParaDynamicLinker;
   end;
end;


Destructor TLinker.Destroy;
begin
  ObjectFiles.Free;
  SharedLibFiles.Free;
  StaticLibFiles.Free;
end;


Procedure TLinker.SetDefaultInfo;
begin
end;


procedure TLinker.AddModuleFiles(hp:tmodule);
var
  mask : longint;
begin
  with hp do
   begin
   { link unit files }
     if (flags and uf_no_link)=0 then
      begin
        { create mask which unit files need linking }
        mask:=link_allways;
        { static linking ? }
        if (cs_link_static in aktglobalswitches) then
         begin
           if (flags and uf_static_linked)=0 then
            begin
              { if smart not avail then try static linking }
              if (flags and uf_smart_linked)<>0 then
               begin
                 Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^);
                 mask:=mask or link_smart;
               end
              else
               Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
            end
           else
             mask:=mask or link_static;
         end;
        { smart linking ? }
        if (cs_link_smart in aktglobalswitches) then
         begin
           if (flags and uf_smart_linked)=0 then
            begin
              { if smart not avail then try static linking }
              if (flags and uf_static_linked)<>0 then
               begin
                 Message1(exec_t_unit_not_smart_linkable_switch_to_static,modulename^);
                 mask:=mask or link_static;
               end
              else
               Message1(exec_e_unit_not_smart_or_static_linkable,modulename^);
            end
           else
            mask:=mask or link_smart;
         end;
        { shared linking }
        if (cs_link_shared in aktglobalswitches) then
         begin
           if (flags and uf_shared_linked)=0 then
            begin
              { if shared not avail then try static linking }
              if (flags and uf_static_linked)<>0 then
               begin
                 Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^);
                 mask:=mask or link_static;
               end
              else
               Message1(exec_e_unit_not_shared_or_static_linkable,modulename^);
            end
           else
            mask:=mask or link_shared;
         end;
        { unit files }
        while not linkunitofiles.empty do
         AddObject(linkunitofiles.getusemask(mask),path^);
        while not linkunitstaticlibs.empty do
         AddStaticLibrary(linkunitstaticlibs.getusemask(mask));
        while not linkunitsharedlibs.empty do
         AddSharedLibrary(linkunitsharedlibs.getusemask(mask));
      end;
   { Other needed .o and libs, specified using $L,$LINKLIB,external }
     mask:=link_allways;
     while not linkotherofiles.empty do
      AddObject(linkotherofiles.Getusemask(mask),path^);
     while not linkotherstaticlibs.empty do
      AddStaticLibrary(linkotherstaticlibs.Getusemask(mask));
     while not linkothersharedlibs.empty do
      AddSharedLibrary(linkothersharedlibs.Getusemask(mask));
   end;
end;


Function TLinker.FindUtil(const s:string):string;
var
  ldfound : boolean;
  LastBin : string;
begin
  LastBin:='';
  if utilsdirectory<>'' then
   LastBin:=FindFile(s+source_os.exeext,utilsdirectory,ldfound)+s+source_os.exeext;
  if LastBin='' then
   LastBin:=FindExe(s,ldfound);
  if (not ldfound) and not(cs_link_extern in aktglobalswitches) then
   begin
     Message1(exec_w_util_not_found,s);
     aktglobalswitches:=aktglobalswitches+[cs_link_extern];
   end;
  if ldfound then
   Message1(exec_t_using_util,LastBin);
  FindUtil:=LastBin;
end;


{ searches an object file }
function TLinker.FindObjectFile(s:string;const unitpath:string) : string;
var
  found : boolean;
begin
  findobjectfile:='';
  if s='' then
   exit;
  if pos('.',s)=0 then
   s:=s+target_info.objext;
  s:=FixFileName(s);
  if FileExists(s) then
   begin
     Findobjectfile:=s;
     exit;
   end;
  { find object file
     1. specified unit path (if specified)
     2. cwd
     3. unit search path
     4. local object path
     5. global object path
     6. exepath }
  found:=false;
  if unitpath<>'' then
   findobjectfile:=FindFile(s,unitpath,found)+s;
  if (not found) then
   findobjectfile:=FindFile(s,'.'+DirSep,found)+s;
  if (not found) then
   findobjectfile:=UnitSearchPath.FindFile(s,found)+s;
  if (not found) then
   findobjectfile:=current_module.localobjectsearchpath.FindFile(s,found)+s;
  if (not found) then
   findobjectfile:=objectsearchpath.FindFile(s,found)+s;
  if (not found) then
   findobjectfile:=FindFile(s,exepath,found)+s;
  if not(cs_link_extern in aktglobalswitches) and (not found) then
   Message1(exec_w_objfile_not_found,s);
end;


{ searches an library file }
function TLinker.FindLibraryFile(s:string;const ext:string;var found : boolean) : string;
begin
  found:=false;
  findlibraryfile:='';
  if s='' then
   exit;
  if pos('.',s)=0 then
   s:=s+ext;
  if FileExists(s) then
   begin
     found:=true;
     FindLibraryFile:=s;
     exit;
   end;
  { find libary
     1. cwd
     2. local libary dir
     3. global libary dir
     4. exe path of the compiler }
  found:=false;
  findlibraryfile:=FindFile(s,'.'+DirSep,found)+s;
  if (not found) then
   findlibraryfile:=current_module.locallibrarysearchpath.FindFile(s,found)+s;
  if (not found) then
   findlibraryfile:=librarysearchpath.FindFile(s,found)+s;
  if (not found) then
   findlibraryfile:=FindFile(s,exepath,found)+s;
end;


Procedure TLinker.AddObject(const S,unitpath : String);
begin
  ObjectFiles.Insert(FindObjectFile(s,unitpath));
end;


Procedure TLinker.AddSharedLibrary(S:String);
begin
  if s='' then
   exit;
{ remove prefix 'lib' }
  if Copy(s,1,length(target_os.libprefix))=target_os.libprefix then
   Delete(s,1,length(target_os.libprefix));
{ remove extension if any }
  if Copy(s,length(s)-length(target_os.sharedlibext)+1,length(target_os.sharedlibext))=target_os.sharedlibext then
   Delete(s,length(s)-length(target_os.sharedlibext)+1,length(target_os.sharedlibext)+1);
{ ready to be inserted }
  SharedLibFiles.Insert (S);
end;


Procedure TLinker.AddStaticLibrary(const S:String);
var
  ns : string;
  found : boolean;
begin
  if s='' then
   exit;
  ns:=FindLibraryFile(s,target_os.staticlibext,found);
  if not(cs_link_extern in aktglobalswitches) and (not found) then
   Message1(exec_w_libfile_not_found,s);
  StaticLibFiles.Insert(ns);
end;


Function TLinker.DoExec(const command,para:string;showinfo,useshell:boolean):boolean;
begin
  DoExec:=true;
  if not(cs_link_extern in aktglobalswitches) then
   begin
     swapvectors;
{$ifdef ALWAYSSHELL}
     shell(command+' '+para);
{$else}
     if useshell then
      shell(command+' '+para)
     else
      exec(command,para);
{$endif}
     swapvectors;
     if (doserror<>0) then
      begin
         Message(exec_w_cant_call_linker);
         aktglobalswitches:=aktglobalswitches+[cs_link_extern];
         DoExec:=false;
      end
     else
      if (dosexitcode<>0) then
       begin
        Message(exec_w_error_while_linking);
        aktglobalswitches:=aktglobalswitches+[cs_link_extern];
        DoExec:=false;
       end;
   end;
{ Update asmres when externmode is set }
  if cs_link_extern in aktglobalswitches then
   begin
     if showinfo then
       begin
         if DLLsource then
           AsmRes.AddLinkCommand(Command,Para,current_module.sharedlibfilename^)
         else
           AsmRes.AddLinkCommand(Command,Para,current_module.exefilename^);
       end
     else
      AsmRes.AddLinkCommand(Command,Para,'');
   end;
end;


function TLinker.MakeExecutable:boolean;
begin
  MakeExecutable:=false;
  Message(exec_e_exe_not_supported);
end;


Function TLinker.MakeSharedLibrary:boolean;
begin
  MakeSharedLibrary:=false;
  Message(exec_e_dll_not_supported);
end;


Function TLinker.MakeStaticLibrary:boolean;
var
  smartpath,
  cmdstr,
  binstr  : string;
  success : boolean;
begin
  MakeStaticLibrary:=false;
{ remove the library, to be sure that it is rewritten }
  RemoveFile(current_module.staticlibfilename^);
{ Call AR }
  smartpath:=current_module.outputpath^+FixPath(FixFileName(current_module.modulename^)+target_info.smartext,false);
  SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
  Replace(cmdstr,'$LIB',current_module.staticlibfilename^);
  Replace(cmdstr,'$FILES',FixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext));
  success:=DoExec(FindUtil(binstr),cmdstr,false,true);
{ Clean up }
  if not(cs_asm_leave in aktglobalswitches) then
   if not(cs_link_extern in aktglobalswitches) then
    begin
      while not SmartLinkOFiles.Empty do
       RemoveFile(SmartLinkOFiles.GetFirst);
      RemoveDir(smartpath);
    end
   else
    begin
      AsmRes.AddDeleteCommand(FixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext));
      AsmRes.Add('rmdir '+smartpath);
    end;
  MakeStaticLibrary:=success;
end;


{*****************************************************************************
                                 Init/Done
*****************************************************************************}

procedure InitLinker;
begin
  case target_info.target of
{$ifdef i386}
  {$ifndef NOTARGETLINUX}
    target_i386_linux :
      linker:=Tlinkerlinux.Create;
  {$endif}
  {$ifndef NOTARGETFreeBSD}
    target_i386_FreeBSD :
      linker:=TlinkerFreeBSD.Create;
  {$endif}
  {$ifndef NOTARGETWIN32}
    target_i386_Win32 :
      linker:=Tlinkerwin32.Create;
  {$endif}
  {$ifndef NOTARGETNETWARE}
    target_i386_Netware :
      linker:=Tlinkernetware.Create;
  {$endif}
  {$ifndef NOTARGETGO32V1}
    target_i386_Go32v1 :
      linker:=TLinkergo32v1.Create;
  {$endif}
  {$ifndef NOTARGETGO32V2}
    target_i386_Go32v2 :
      linker:=TLinkergo32v2.Create;
  {$endif}
  {$ifndef NOTARGETOS2}
    target_i386_os2 :
      linker:=TLinkeros2.Create;
  {$endif}
{$endif i386}
{$ifdef m68k}
  {$ifndef NOTARGETPALMOS}
    target_m68k_palmos:
      linker:=Tlinker.Create;
  {$endif}
  {$ifndef NOTARGETLINUX}
    target_m68k_linux :
      linker:=Tlinkerlinux.Create;
  {$endif}
{$endif m68k}
{$ifdef alpha}
  {$ifndef NOTARGETLINUX}
    target_alpha_linux :
      linker:=Tlinkerlinux.Create;
  {$endif}
{$endif alpha}
{$ifdef powerpc}
  {$ifndef NOTARGETLINUX}
    target_powerpc_linux :
      linker:=Tlinkerlinux.Create;
  {$endif}
{$endif powerpc}
    else
      linker:=Tlinker.Create;
  end;
end;


procedure DoneLinker;
begin
  if assigned(linker) then
   Linker.Free;
end;


end.
{
  $Log$
  Revision 1.11  2000-12-25 00:07:26  peter
    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
      tlinkedlist objects)

  Revision 1.10  2000/11/29 00:30:31  florian
    * unused units removed from uses clause
    * some changes for widestrings

  Revision 1.9  2000/09/24 21:33:46  peter
    * message updates merges

  Revision 1.8  2000/09/24 15:06:18  peter
    * use defines.inc

  Revision 1.7  2000/09/16 12:22:52  peter
    * freebsd support merged

  Revision 1.6  2000/09/11 17:00:23  florian
    + first implementation of Netware Module support, thanks to
      Armin Diehl ([email protected]) for providing the patches

  Revision 1.5  2000/09/04 09:40:23  michael
  + merged Patch from peter

  Revision 1.4  2000/08/27 16:11:51  peter
    * moved some util functions from globals,cobjects to cutils
    * splitted files into finput,fmodule

  Revision 1.3  2000/07/26 13:08:19  jonas
    * merged from fixes branch (v_hint to v_tried changed when attempting
      to smart/static/shared link)

  Revision 1.2  2000/07/13 11:32:43  michael
  + removed logs
}