mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 10:11:27 +01:00 
			
		
		
		
	 fb1a842118
			
		
	
	
		fb1a842118
		
	
	
	
	
		
			
			activated by defining 'newst', but doesn't compile yet. Changes in type checking and oop are completed. What is left is to write a new symtablestack and adapt the parser to use it.
		
			
				
	
	
		
			227 lines
		
	
	
		
			5.8 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			227 lines
		
	
	
		
			5.8 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     $Id$
 | |
|     Copyright (c) 1998-2000 by Peter Vreman
 | |
| 
 | |
|     This unit implements support import,export,link routines
 | |
|     for the (i386) go32v1 target
 | |
| 
 | |
|     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 t_go32v1;
 | |
| 
 | |
|   interface
 | |
|   uses
 | |
|     link;
 | |
| 
 | |
|   type
 | |
|     plinkergo32v1=^tlinkergo32v1;
 | |
|     tlinkergo32v1=object(tlinker)
 | |
|     private
 | |
|        Function  WriteResponseFile(isdll:boolean) : Boolean;
 | |
|     public
 | |
|        constructor Init;
 | |
|        procedure SetDefaultInfo;virtual;
 | |
|        function  MakeExecutable:boolean;virtual;
 | |
|     end;
 | |
| 
 | |
| 
 | |
|   implementation
 | |
| 
 | |
|     uses
 | |
|        globtype,globals,cobjects,systems,verbose,script,files;
 | |
| 
 | |
| 
 | |
| {****************************************************************************
 | |
|                                TLinkergo32v1
 | |
| ****************************************************************************}
 | |
| 
 | |
| Constructor TLinkergo32v1.Init;
 | |
| begin
 | |
|   Inherited Init;
 | |
|   { allow duplicated libs (PM) }
 | |
|   SharedLibFiles.doubles:=true;
 | |
|   StaticLibFiles.doubles:=true;
 | |
| end;
 | |
| 
 | |
| 
 | |
| procedure TLinkergo32v1.SetDefaultInfo;
 | |
| begin
 | |
|   with Info do
 | |
|    begin
 | |
|      ExeCmd[1]:='ld -oformat coff-go32 $OPT $STRIP -o $EXE @$RES';
 | |
|      ExeCmd[2]:='aout2exe $EXE';
 | |
|    end;
 | |
| end;
 | |
| 
 | |
| 
 | |
| Function TLinkergo32v1.WriteResponseFile(isdll:boolean) : Boolean;
 | |
| Var
 | |
|   linkres  : TLinkRes;
 | |
|   i        : longint;
 | |
| {$IFDEF NEWST}
 | |
|   HPath    : PStringItem;
 | |
| {$ELSE}
 | |
|   HPath    : PStringQueueItem;
 | |
| {$ENDIF}
 | |
|   s        : string;
 | |
|   linklibc : boolean;
 | |
| begin
 | |
|   WriteResponseFile:=False;
 | |
| 
 | |
|   { 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('-L'+HPath^.Data^);
 | |
|      HPath:=HPath^.Next;
 | |
|    end;
 | |
|   HPath:=LibrarySearchPath.First;
 | |
|   while assigned(HPath) do
 | |
|    begin
 | |
|      LinkRes.Add('-L'+HPath^.Data^);
 | |
|      HPath:=HPath^.Next;
 | |
|    end;
 | |
| 
 | |
|   { add objectfiles, start with prt0 always }
 | |
|   LinkRes.AddFileName(FindObjectFile('prt0'));
 | |
|   while not ObjectFiles.Empty do
 | |
|    begin
 | |
|      s:=ObjectFiles.Get;
 | |
|      if s<>'' then
 | |
|       LinkRes.AddFileName(s);
 | |
|    end;
 | |
| 
 | |
|   { Write staticlibraries }
 | |
|   if not StaticLibFiles.Empty then
 | |
|    begin
 | |
|      LinkRes.Add('-(');
 | |
|      While not StaticLibFiles.Empty do
 | |
|       begin
 | |
|         S:=StaticLibFiles.Get;
 | |
|         LinkRes.AddFileName(s)
 | |
|       end;
 | |
|      LinkRes.Add('-)');
 | |
|    end;
 | |
| 
 | |
|   { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
 | |
|     here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
 | |
|   linklibc:=false;
 | |
|   While not SharedLibFiles.Empty do
 | |
|    begin
 | |
|      S:=SharedLibFiles.Get;
 | |
|      if s<>'c' then
 | |
|       begin
 | |
|         i:=Pos(target_os.sharedlibext,S);
 | |
|         if i>0 then
 | |
|          Delete(S,i,255);
 | |
|         LinkRes.Add('-l'+s);
 | |
|       end
 | |
|      else
 | |
|       begin
 | |
|         LinkRes.Add('-l'+s);
 | |
|         linklibc:=true;
 | |
|       end;
 | |
|    end;
 | |
|   { be sure that libc&libgcc is the last lib }
 | |
|   if linklibc then
 | |
|    begin
 | |
|      LinkRes.Add('-lc');
 | |
|      LinkRes.Add('-lgcc');
 | |
|    end;
 | |
| 
 | |
| { Write and Close response }
 | |
|   linkres.writetodisk;
 | |
|   linkres.done;
 | |
| 
 | |
|   WriteResponseFile:=True;
 | |
| end;
 | |
| 
 | |
| 
 | |
| function TLinkergo32v1.MakeExecutable:boolean;
 | |
| var
 | |
|   binstr,
 | |
|   cmdstr  : string;
 | |
|   success : boolean;
 | |
|   StripStr : string[40];
 | |
| begin
 | |
|   if not(cs_link_extern in aktglobalswitches) then
 | |
|    Message1(exec_i_linking,current_module^.exefilename^);
 | |
| 
 | |
| { Create some replacements }
 | |
|   StripStr:='';
 | |
|   if (cs_link_strip in aktglobalswitches) then
 | |
|    StripStr:='-s';
 | |
| 
 | |
| { Write used files and libraries }
 | |
|   WriteResponseFile(false);
 | |
| 
 | |
| { Call linker }
 | |
|   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
 | |
|   Replace(cmdstr,'$EXE',current_module^.exefilename^);
 | |
|   Replace(cmdstr,'$OPT',Info.ExtraOptions);
 | |
|   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
 | |
|   Replace(cmdstr,'$STRIP',StripStr);
 | |
|   success:=DoExec(FindUtil(BinStr),cmdstr,true,false);
 | |
| 
 | |
| { Remove ReponseFile }
 | |
|   if (success) and not(cs_link_extern in aktglobalswitches) then
 | |
|    RemoveFile(outputexedir+Info.ResName);
 | |
| 
 | |
|   MakeExecutable:=success;   { otherwise a recursive call to link method }
 | |
| end;
 | |
| 
 | |
| end.
 | |
| {
 | |
|   $Log$
 | |
|   Revision 1.9  2000-02-28 17:23:57  daniel
 | |
|   * Current work of symtable integration committed. The symtable can be
 | |
|     activated by defining 'newst', but doesn't compile yet. Changes in type
 | |
|     checking and oop are completed. What is left is to write a new
 | |
|     symtablestack and adapt the parser to use it.
 | |
| 
 | |
|   Revision 1.8  2000/02/09 13:23:06  peter
 | |
|     * log truncated
 | |
| 
 | |
|   Revision 1.7  2000/01/09 00:55:51  pierre
 | |
|     * GROUP of smartlink units put before the C libraries
 | |
|       to allow for smartlinking code that uses C code.
 | |
| 
 | |
|   Revision 1.6  2000/01/07 01:14:42  peter
 | |
|     * updated copyright to 2000
 | |
| 
 | |
|   Revision 1.5  1999/11/16 23:39:04  peter
 | |
|     * use outputexedir for link.res location
 | |
| 
 | |
|   Revision 1.4  1999/11/12 11:03:50  peter
 | |
|     * searchpaths changed to stringqueue object
 | |
| 
 | |
|   Revision 1.3  1999/11/04 10:55:31  peter
 | |
|     * TSearchPathString for the string type of the searchpaths, which is
 | |
|       ansistring under FPC/Delphi
 | |
| 
 | |
|   Revision 1.2  1999/10/22 14:42:40  peter
 | |
|     * reset linklibc
 | |
| 
 | |
|   Revision 1.1  1999/10/21 14:29:38  peter
 | |
|     * redesigned linker object
 | |
|     + library support for linux (only procedures can be exported)
 | |
| 
 | |
| }
 |