paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 15:47:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

* redesigned linker object

Browse Source 
+ library support for linux (only procedures can be exported)
This commit is contained in:
peter 1999-10-21 14:29:32 +00:00
parent 46b5193e9b
commit fefc839b29
18 changed files with 1980 additions and 1403 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/cgai386.pas
View File

@ -27,7 +27,7 @@ unit cgai386;
uses
cobjects,tree,
cpubase,cpuasm,
symconst,symtable,aasm,win_targ;
symconst,symtable,aasm;
{$define TESTGETTEMP to store const that
are written into temps for later release PM }
@ -150,6 +150,9 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
tgeni386,temp_gen,hcodegen,ppu
{$ifdef GDB}
,gdb
{$endif}
{$ifndef NOTARGETWIN32}
,t_win32
{$endif}
;
@ -2605,6 +2608,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
exprasmlist^.concat(new(paicpu,
op_const_reg(A_IMUL,S_L,
parraydef(pvarsym(p)^.definition)^.definition^.size,R_EDI)));
{$ifndef NOTARGETWIN32}
{ windows guards only a few pages for stack growing, }
{ so we have to access every page first }
if target_os.id=os_i386_win32 then
@ -2642,6 +2646,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
parraydef(pvarsym(p)^.definition)^.definition^.size,R_EDI)));
end
else
{$endif NOTARGETWIN32}
begin
exprasmlist^.concat(new(paicpu,
op_reg_reg(A_SUB,S_L,R_EDI,R_ESP)));
@ -3414,7 +3419,11 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end.
{
$Log$
Revision 1.53 1999-10-13 22:09:29 pierre
Revision 1.54 1999-10-21 14:29:32 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
Revision 1.53 1999/10/13 22:09:29 pierre
* fix for uggly bug of Marco
Revision 1.52 1999/10/08 15:40:47 pierre

157
compiler/dos_targ.pas
View File

@ -1,157 +0,0 @@
{
$Id$
Copyright (c) 1999 by Peter Vreman
This unit implements some support routines for the Dos targets
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 dos_targ;
interface
uses
link;
type
plinkergo32v2=^tlinkergo32v2;
tlinkergo32v2=object(tlinker)
procedure postprocessexecutable(const n : string);virtual;
end;
implementation
uses
strings,globtype,globals,cobjects,systems,verbose;
{****************************************************************************
Postprocess Executable
****************************************************************************}
procedure tlinkergo32v2.postprocessexecutable(const n : string);
begin
end;
{$ifdef dummy}
type
tcoffheader=packed record
mach : word;
nsects : word;
time : longint;
sympos : longint;
syms : longint;
opthdr : word;
flag : word;
end;
tcoffsechdr=packed record
name : array[0..7] of char;
vsize : longint;
rvaofs : longint;
datalen : longint;
datapos : longint;
relocpos : longint;
lineno1 : longint;
nrelocs : word;
lineno2 : word;
flags : longint;
end;
psecfill=^tsecfill;
tsecfill=record
fillpos,
fillsize : longint;
next : psecfill;
end;
var
f : file;
coffheader : tcoffheader;
firstsecpos,
maxfillsize,
l : longint;
coffsec : tcoffsechdr;
secroot,hsecroot : psecfill;
zerobuf : pointer;
begin
{ when -s is used quit, because there is no .exe }
if cs_link_extern in aktglobalswitches then
exit;
{ open file }
assign(f,n);
{$I-}
reset(f,1);
if ioresult<>0 then
Message1(execinfo_f_cant_open_executable,n);
{ read headers }
seek(f,2048);
blockread(f,coffheader,sizeof(tcoffheader));
{ read section info }
maxfillsize:=0;
firstsecpos:=0;
secroot:=nil;
for l:=1to coffheader.nSects do
begin
blockread(f,coffsec,sizeof(tcoffsechdr));
if coffsec.datapos>0 then
begin
if secroot=nil then
firstsecpos:=coffsec.datapos;
new(hsecroot);
hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
hsecroot^.next:=secroot;
secroot:=hsecroot;
if secroot^.fillsize>maxfillsize then
maxfillsize:=secroot^.fillsize;
end;
end;
if firstsecpos>0 then
begin
l:=firstsecpos-filepos(f);
if l>maxfillsize then
maxfillsize:=l;
end
else
l:=0;
{ get zero buffer }
getmem(zerobuf,maxfillsize);
fillchar(zerobuf^,maxfillsize,0);
{ zero from sectioninfo until first section }
blockwrite(f,zerobuf^,l);
{ zero section alignments }
while assigned(secroot) do
begin
seek(f,secroot^.fillpos);
blockwrite(f,zerobuf^,secroot^.fillsize);
hsecroot:=secroot;
secroot:=secroot^.next;
dispose(hsecroot);
end;
freemem(zerobuf,maxfillsize);
close(f);
{$I+}
end;
{$endif}
end.
{
$Log$
Revision 1.1 1999-08-11 17:26:32 peter
* tlinker object is now inherited for win32 and dos
* postprocessexecutable is now a method of tlinker
}

9
compiler/errore.msg
View File

@ -1311,16 +1311,15 @@ exec_w_error_while_assembling=W_Error while assembling exitcode $1
exec_w_cant_call_assembler=W_Can't call the assembler, error $1 switching to external assembling
exec_i_assembling=I_Assembling $1
exec_i_assembling_smart=I_Assembling smartlink $1
exec_w_linker_not_found=W_Linker $1 not found, switching to external linking
exec_t_using_linker=T_Using linker: $1
exec_w_objfile_not_found=W_Object $1 not found, Linking may fail !
exec_w_libfile_not_found=W_Library $1 not found, Linking may fail !
exec_w_error_while_linking=W_Error while linking
exec_w_cant_call_linker=W_Can't call the linker, switching to external linking
exec_i_linking=I_Linking $1
exec_w_binder_not_found=W_binder not found, switching to external binding
exec_w_ar_not_found=W_ar not found, switching to external ar
exec_e_dll_not_supported=E_Dynamic Libraries not supported
exec_w_util_not_found=W_Util $1 not found, switching to external linking
exec_t_using_util=T_Using util $1
exec_e_exe_not_supported=E_Creation of Executables not supported
exec_e_dll_not_supported=E_Creation of Dynamic/Shared Libraries not supported
exec_i_closing_script=I_Closing script $1
exec_w_res_not_found=W_resource compiler not found, switching to external mode
exec_i_compilingresource=I_Compiling resource $1

43
compiler/export.pas
View File

@ -39,6 +39,7 @@ type
index : longint;
name : pstring;
options : word;
is_var : boolean;
constructor init;
destructor done;virtual;
end;
@ -64,10 +65,34 @@ implementation
uses
systems,verbose,globals,files
{$ifdef i386}
,os2_targ
,win_targ
{$ifndef NOTARGETLINUX}
,t_linux
{$endif}
{$ifndef NOTARGETOS2}
,t_os2
{$endif}
{$ifndef NOTARGETWIN32}
,t_win32
{$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}
,lin_targ
;
{****************************************************************************
@ -81,6 +106,7 @@ begin
index:=-1;
name:=nil;
options:=0;
is_var:=false;
end;
@ -137,9 +163,8 @@ procedure InitExport;
begin
case target_info.target of
{$ifdef i386}
{ target_i386_Linux :
importlib:=new(pimportliblinux,Init);
}
target_i386_Linux :
exportlib:=new(pexportliblinux,Init);
target_i386_Win32 :
exportlib:=new(pexportlibwin32,Init);
{
@ -168,7 +193,11 @@ end;
end.
{
$Log$
Revision 1.6 1999-08-04 13:02:41 jonas
Revision 1.7 1999-10-21 14:29:34 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
Revision 1.6 1999/08/04 13:02:41 jonas
* all tokens now start with an underscore
* PowerPC compiles!!

69
compiler/globals.pas
View File

@ -235,13 +235,16 @@ unit globals;
Function ForceExtension(Const HStr,ext:String):String;
Function FixPath(s:string;allowdot:boolean):string;
function FixFileName(const s:string):string;
procedure SplitBinCmd(const s:string;var bstr,cstr:string);
procedure AddPathToList(var list:string;s:string;first:boolean);
function search(const f : string;path : string;var b : boolean) : string;
function getpathfromlist(var list:string):string;
function search(const f : string;path : string;var b : boolean) : string;
procedure SynchronizeFileTime(const fn1,fn2:string);
function FindExe(bin:string;var found:boolean):string;
Procedure Shell(const command:string);
procedure InitGlobals;
procedure DoneGlobals;
procedure InitGlobals;
procedure DoneGlobals;
procedure strdispose(var p : pchar);
@ -972,6 +975,24 @@ unit globals;
{$endif}
end;
procedure SplitBinCmd(const s:string;var bstr,cstr:string);
var
i : longint;
begin
i:=pos(' ',s);
if i>0 then
begin
bstr:=Copy(s,1,i-1);
cstr:=Copy(s,i+1,length(s)-i);
end
else
begin
bstr:='';
cstr:='';
end;
end;
procedure AddPathToList(var list:string;s:string;first:boolean);
var
@ -1039,6 +1060,26 @@ unit globals;
end;
function getpathfromlist(var list:string):string;
var
s : string;
i : longint;
begin
s:='';
while (list<>'') do
begin
i:=Pos(';',list);
If i=0 then
i:=255;
S:=Copy(list,1,i-1);
Delete (list,1,i);
if (S<>'') then
break;
end;
GetPathFromList:=s;
end;
function search(const f : string;path : string;var b : boolean) : string;
Var
singlepathstring : string;
@ -1158,6 +1199,22 @@ unit globals;
end;
Procedure Shell(const command:string);
{ This is already defined in the linux.ppu for linux, need for the *
expansion under linux }
{$ifdef linux}
begin
Linux.Shell(command);
end;
{$else}
var
comspec : string;
begin
comspec:=getenv('COMSPEC');
Exec(comspec,' /C '+command);
end;
{$endif}
{****************************************************************************
Init
****************************************************************************}
@ -1258,7 +1315,11 @@ begin
end.
{
$Log$
Revision 1.25 1999-09-10 18:48:02 florian
Revision 1.26 1999-10-21 14:29:34 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
Revision 1.25 1999/09/10 18:48:02 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* most things for stored properties fixed

36
compiler/import.pas
View File

@ -67,10 +67,34 @@ implementation
uses
systems,verbose,globals
{$ifdef i386}
,os2_targ
,win_targ
{$ifndef NOTARGETLINUX}
,t_linux
{$endif}
{$ifndef NOTARGETOS2}
,t_os2
{$endif}
{$ifndef NOTARGETWIN32}
,t_win32
{$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}
,lin_targ
;
{****************************************************************************
@ -203,7 +227,11 @@ end;
end.
{
$Log$
Revision 1.12 1999-08-04 13:02:44 jonas
Revision 1.13 1999-10-21 14:29:34 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
Revision 1.12 1999/08/04 13:02:44 jonas
* all tokens now start with an underscore
* PowerPC compiles!!

106
compiler/lin_targ.pas
View File

@ -1,106 +0,0 @@
{
$Id$
Copyright (c) 1998 by Florian Klaempfl
This unit implements some support routines for the linux target like
import/export handling
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 lin_targ;
interface
uses import;
type
pimportliblinux=^timportliblinux;
timportliblinux=object(timportlib)
procedure preparelib(const s:string);virtual;
procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
procedure importvariable(const varname,module:string;const name:string);virtual;
procedure generatelib;virtual;
end;
implementation
uses
verbose,strings,cobjects,systems,globtype,globals,
symconst,
files,aasm,symtable;
procedure timportliblinux.preparelib(const s : string);
begin
end;
procedure timportliblinux.importprocedure(const func,module : string;index : longint;const name : string);
begin
{ insert sharedlibrary }
current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
{ do nothing with the procedure, only set the mangledname }
if name<>'' then
aktprocsym^.definition^.setmangledname(name)
else
Message(parser_e_empty_import_name);
end;
procedure timportliblinux.importvariable(const varname,module:string;const name:string);
begin
{ insert sharedlibrary }
current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
{ reset the mangledname and turn off the dll_var option }
aktvarsym^.setmangledname(name);
{$ifdef INCLUDEOK}
exclude(aktvarsym^.varoptions,vo_is_dll_var);
{$else}
aktvarsym^.varoptions:=aktvarsym^.varoptions-[vo_is_dll_var];
{$endif}
end;
procedure timportliblinux.generatelib;
begin
end;
end.
{
$Log$
Revision 1.5 1999-08-03 22:02:54 peter
* moved bitmask constants to sets
* some other type/const renamings
Revision 1.4 1999/07/03 00:29:50 peter
* new link writing to the ppu, one .ppu is needed for all link types,
static (.o) is now always created also when smartlinking is used
Revision 1.3 1999/01/20 14:18:32 pierre
* bugs related to mangledname solved
- linux external without name
-external procs already used
(added count and is_used boolean fiels in tprocvar)
Revision 1.2 1998/11/28 16:20:51 peter
+ support for dll variables
Revision 1.1 1998/10/19 18:07:13 peter
+ external dll_name name func support for linux
}

546
compiler/link.pas
View File

@ -33,17 +33,21 @@ Interface
uses cobjects,files;
Type
TLinkerInfo=record
ExeCmd,
DllCmd : array[1..3] of string[80];
ResName : string[12];
ExtraOptions : string;
DynamicLinker : string[80];
end;
PLinker=^TLinker;
TLinker = Object
Glibc2,
Glibc21,
LinkToC, { Should we link to the C libs? }
Strip : Boolean; { Strip symbols ? }
public
Info : TLinkerInfo;
ObjectFiles,
SharedLibFiles,
StaticLibFiles : TStringContainer;
LinkOptions : string; { Additional options to the linker }
DynamicLinker : String[80]; { What Dynamic linker ? }
LinkResName : String[32]; { Name of response file }
StaticLibFiles : TStringContainer;
{ Methods }
Constructor Init;
Destructor Done;
@ -53,15 +57,14 @@ Type
Procedure AddObject(const S : String);
Procedure AddStaticLibrary(const S : String);
Procedure AddSharedLibrary(S : String);
Function FindLinker:String; { Find linker, sets Name }
Function DoExec(const command,para:string;info,useshell:boolean):boolean;
Function WriteResponseFile:Boolean;
Function MakeExecutable:boolean;
Procedure MakeStaticLibrary(filescnt:longint);
Procedure MakeSharedLibrary;
procedure postprocessexecutable(const n : string);virtual;
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(filescnt:longint):boolean;virtual;
end;
PLinker=^TLinker;
Var
Linker : PLinker;
@ -81,61 +84,61 @@ uses
globtype,systems,
script,globals,verbose,ppu
{$ifdef i386}
,win_targ
,dos_targ
{$ifndef NOTARGETLINUX}
,t_linux
{$endif}
{$ifndef NOTARGETOS2}
,t_os2
{$endif}
{$ifndef NOTARGETWIN32}
,t_win32
{$endif}
{$ifndef NOTARGETGO32V1}
,t_go32v1
{$endif}
{$ifndef NOTARGETGO32V2}
,t_go32v2
{$endif}
{$endif}
{$ifdef linux}
,linux
{$ifdef m68k}
{$ifndef NOTARGETLINUX}
,t_linux
{$endif}
{$endif}
{$ifdef powerpc}
{$ifndef NOTARGETLINUX}
,t_linux
{$endif}
{$endif}
{$ifdef alpha}
{$ifndef NOTARGETLINUX}
,t_linux
{$endif}
{$endif}
,gendef
;
{$ifndef linux}
Procedure Shell(const command:string);
{ This is already defined in the linux.ppu for linux, need for the *
expansion under linux }
var
comspec : string;
begin
comspec:=getenv('COMSPEC');
Exec(comspec,' /C '+command);
end;
{$endif}
{*****************************************************************************
TLINKER
*****************************************************************************}
Constructor TLinker.Init;
begin
ObjectFiles.Init_no_double;
{ libraries sometimes need to be loaded several times PM }
SharedLibFiles.Init{_no_double};
StaticLibFiles.Init{_no_double};
LinkToC:=(cs_link_toc in aktglobalswitches);
Strip:=(cs_link_strip in aktglobalswitches);
LinkOptions:=ParaLinkOptions;
DynamicLinker:=ParaDynamicLinker;
LinkResName:='link.res';
Glibc2:=false;
Glibc21:=false;
if target_info.target=target_i386_linux then
SharedLibFiles.Init_no_double;
StaticLibFiles.Init_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 DynamicLinker='' then
begin
{ first try glibc2 }
DynamicLinker:='/lib/ld-linux.so.2';
if FileExists(DynamicLinker) then
begin
Glibc2:=true;
{ also glibc 2.1 / 2.1.1 / 2.1.2 ? }
if FileExists('/lib/ld-2.1.so') or
FileExists('/lib/ld-2.1.1.so') or
FileExists('/lib/ld-2.1.2.so') then
Glibc21:=true;
end
else
DynamicLinker:='/lib/ld-linux.so.1';
end;
AddPathToList(LibrarySearchPath,'/lib;/usr/lib;/usr/X11R6/lib',true);
if ParaLinkOptions<>'' then
ExtraOptions:=ParaLinkOptions;
if ParaDynamicLinker<>'' then
DynamicLinker:=ParaDynamicLinker;
end;
end;
@ -148,6 +151,11 @@ begin
end;
Procedure TLinker.SetDefaultInfo;
begin
end;
procedure TLinker.AddModuleFiles(hp:pmodule);
var
mask : longint;
@ -229,28 +237,24 @@ begin
end;
var
LastLDBin : string;
Function TLinker.FindLinker:string;
Function TLinker.FindUtil(const s:string):string;
var
ldfound : boolean;
LastBin : string;
begin
if LastLDBin='' then
LastBin:='';
if utilsdirectory<>'' then
LastBin:=Search(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
if utilsdirectory<>'' then
LastLDBin:=Search(target_link.linkbin+source_os.exeext,utilsdirectory,ldfound)+
target_link.linkbin+source_os.exeext;
if LastLDBin='' then
LastLDBin:=FindExe(target_link.linkbin,ldfound);
if (not ldfound) and not(cs_link_extern in aktglobalswitches) then
begin
Message1(exec_w_linker_not_found,LastLDBin);
aktglobalswitches:=aktglobalswitches+[cs_link_extern];
end;
if ldfound then
Message1(exec_t_using_linker,LastLDBin);
Message1(exec_w_util_not_found,s);
aktglobalswitches:=aktglobalswitches+[cs_link_extern];
end;
FindLinker:=LastLDBin;
if ldfound then
Message1(exec_t_using_util,LastBin);
FindUtil:=LastBin;
end;
@ -349,7 +353,7 @@ begin
end;
Function TLinker.DoExec(const command,para:string;info,useshell:boolean):boolean;
Function TLinker.DoExec(const command,para:string;showinfo,useshell:boolean):boolean;
begin
DoExec:=true;
if not(cs_link_extern in aktglobalswitches) then
@ -381,7 +385,7 @@ begin
{ Update asmres when externmode is set }
if cs_link_extern in aktglobalswitches then
begin
if info then
if showinfo then
AsmRes.AddLinkCommand(Command,Para,current_module^.exefilename^)
else
AsmRes.AddLinkCommand(Command,Para,'');
@ -389,329 +393,43 @@ begin
end;
Function TLinker.WriteResponseFile : Boolean;
Var
LinkResponse : Text;
i : longint;
cprtobj,
gprtobj,
prtobj : string[80];
s,s2 : string;
found,linux_link_c,
linkdynamic,
linklibc : boolean;
procedure WriteRes(const s:string);
begin
if s<>'' then
WriteLn(Linkresponse,s);
end;
procedure WriteResFileName(const s:string);
begin
if s<>'' then
begin
if not(s[1] in ['a'..'z','A'..'Z','/','\','.']) then
Write(Linkresponse,'.',DirSep);
WriteLn(Linkresponse,s);
end;
end;
begin
WriteResponseFile:=False;
linux_link_c:=false;
{ set special options for some targets }
linkdynamic:=not(SharedLibFiles.empty);
linklibc:=SharedLibFiles.Find('c');
prtobj:='prt0';
cprtobj:='cprt0';
gprtobj:='gprt0';
if glibc21 then
begin
cprtobj:='cprt21';
gprtobj:='gprt21';
end;
case target_info.target of
target_m68k_Palmos,
target_i386_Win32 :
begin
if DLLsource then
prtobj:='wdllprt0'
else
prtobj:='wprt0';
end;
target_m68k_linux,
target_i386_linux :
begin
if cs_profile in aktmoduleswitches then
begin
prtobj:=gprtobj;
if not glibc2 then
AddSharedLibrary('gmon');
AddSharedLibrary('c');
linklibc:=true;
end
else
begin
if linklibc then
prtobj:=cprtobj;
end;
if linklibc then
linux_link_c:=true;
end;
end;
{ Fix command line options }
If (DynamicLinker<>'') and (not SharedLibFiles.Empty) then
LinkOptions:='-dynamic-linker='+DynamicLinker+' '+LinkOptions;
if Strip and not(cs_debuginfo in aktmoduleswitches) and
not (Target_Link.StripBind) then
LinkOptions:=LinkOptions+' '+target_link.stripopt;
{ Open linkresponse and write header }
assign(linkresponse,current_module^.outpath^+LinkResName);
{$I-}
rewrite(linkresponse);
{$I+}
if ioresult<>0 then
exit;
{ Write library searchpath }
if assigned(current_module^.locallibrarysearchpath) then
begin
S2:=current_module^.locallibrarysearchpath^;
Repeat
i:=Pos(';',S2);
If i=0 then
i:=255;
S:=Copy(S2,1,i-1);
If S<>'' then
WriteRes(target_link.libpathprefix+s+target_link.libpathsuffix);
Delete (S2,1,i);
until S2='';
end;
S2:=LibrarySearchPath;
Repeat
i:=Pos(';',S2);
If i=0 then
i:=255;
S:=Copy(S2,1,i-1);
If S<>'' then
WriteRes(target_link.libpathprefix+s+target_link.libpathsuffix);
Delete (S2,1,i);
until S2='';
WriteRes(target_link.inputstart);
{ add objectfiles, start with prt0 always }
if prtobj<>'' then
WriteResFileName(FindObjectFile(prtobj));
{ try to add crti and crtbegin, they are normally not required, but
adding can sometimes be usefull }
if linux_link_c then
begin
s:=search('crtbegin.o',librarysearchpath,found)+'crtbegin.o';
if found then
WriteResFileName(s);
s:=search('crti.o',librarysearchpath,found)+'crti.o';
if found then
WriteResFileName(s);
end;
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.Get;
if s<>'' then
WriteResFileName(s);
end;
if linux_link_c then
begin
s:=search('crtend.o',librarysearchpath,found)+'crtend.o';
if found then
WriteResFileName(s);
s:=search('crtn.o',librarysearchpath,found)+'crtn.o';
if found then
WriteResFileName(s);
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) }
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);
WriteRes(target_link.libprefix+s);
end
else
begin
{ Some times several references to libc are necessary !! PM }
WriteRes(target_link.libprefix+s);
linklibc:=true;
linkdynamic:=false; { C add's it automaticly }
end;
end;
{ be sure that libc is the last lib }
{ arghhhh this is wrong for DJGPP !!!
DJGPP need gcc after c lib (umod...) (PM) }
if linklibc then
WriteRes(target_link.libprefix+'c');
{ add libgcc after ! }
if linklibc and (target_info.target=target_i386_go32v2) then
WriteRes(target_link.libprefix+'gcc');
if linkdynamic and (DynamicLinker<>'') then
WriteResFileName(DynamicLinker);
WriteRes(target_link.inputend);
{ Write staticlibraries }
if not StaticLibFiles.Empty then
begin
WriteRes(target_link.GroupStart);
While not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.Get;
WriteResFileName(s)
end;
WriteRes(target_link.GroupEnd);
end;
{ Close response }
close(linkresponse);
WriteResponseFile:=True;
end;
function TLinker.MakeExecutable:boolean;
var
bindbin : string[80];
bindfound : boolean;
s : string;
success : boolean;
ii : longint;
begin
{ can be changed after InitLinker
for DLLs due to relocation problems PM }
Strip:=(cs_link_strip in aktglobalswitches);
{$ifdef linux}
if LinkToC then
begin
AddObject('/usr/lib/crt0.o');
AddObject('lprt');
AddStaticLibrary('libc.a');
AddStaticLibrary('libgcc.a');
end;
{$endif Linux}
{ Write used files and libraries }
WriteResponseFile;
{ Call linker }
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module^.exefilename^);
s:=target_link.linkcmd;
if DLLsource then
Replace(s,'$EXE',current_module^.sharedlibfilename^)
else
Replace(s,'$EXE',current_module^.exefilename^);
Replace(s,'$OPT',LinkOptions);
Replace(s,'$RES',current_module^.outpath^+LinkResName);
success:=DoExec(FindLinker,s,true,false);
{Bind}
if (target_link.bindbin[1]<>'') and
((target_info.target<>target_i386_win32) or
(RelocSection and not Deffile.empty)) then
for ii:=1 to target_link.binders do
begin
s:=target_link.bindcmd[ii];
Replace(s,'$OPT',LinkOptions);
Replace(s,'$RES',current_module^.outpath^+LinkResName);
if DLLsource then
Replace(s,'$EXE',current_module^.sharedlibfilename^)
else
Replace(s,'$EXE',current_module^.exefilename^);
{Size of the heap when an EMX program runs in OS/2.}
Replace(s,'$HEAPMB',tostr((maxheapsize+1048575) shr 20));
{Size of the stack when an EMX program runs in OS/2.}
Replace(s,'$STACKKB',tostr((stacksize+1023) shr 10));
{When an EMX program runs in DOS, the heap and stack share the
same memory pool. The heap grows upwards, the stack grows downwards.}
Replace(s,'$DOSHEAPKB',tostr((stacksize+maxheapsize+1023) shr 10));
if Strip and Target_Link.StripBind then
Replace (S, '$STRIP', Target_Link.StripOpt)
else
Replace (S, '$STRIP', '');
{This is a hack. But I don't think other platforms have a presenation
manager, so it should work. (DM)}
if usewindowapi then
replace (s, '$PM',' -p')
else
replace (s, '$PM','');
if utilsdirectory<>'' then
begin
bindbin:=Search(target_link.bindbin[ii]+source_os.exeext,
utilsdirectory,bindfound)+target_link.bindbin[ii]+source_os.exeext;
end
else
bindbin:=FindExe(target_link.bindbin[ii],bindfound);
if (not bindfound) and not (cs_link_extern in aktglobalswitches) then
begin
Message1(exec_w_binder_not_found,bindbin);
aktglobalswitches:=aktglobalswitches+[cs_link_extern];
end;
DoExec(bindbin,s,false,false);
end;
{ Post processor executable }
if success and
not(cs_link_extern in aktglobalswitches) then
begin
if DLLsource then
postprocessexecutable(current_module^.sharedlibfilename^)
else
postprocessexecutable(current_module^.exefilename^);
end;
{Remove ReponseFile}
if (success) and not(cs_link_extern in aktglobalswitches) then
RemoveFile(current_module^.outpath^+LinkResName);
MakeExecutable:=success; { otherwise a recursive call to link method }
MakeExecutable:=false;
Message(exec_e_exe_not_supported);
end;
Procedure TLinker.MakeStaticLibrary(filescnt:longint);
Function TLinker.MakeSharedLibrary:boolean;
begin
MakeSharedLibrary:=false;
Message(exec_e_dll_not_supported);
end;
Function TLinker.MakeStaticLibrary(filescnt:longint):boolean;
{
FilesCnt holds the amount of .o files created, if filescnt=0 then
no smartlinking is used
}
var
smartpath,
s,
arbin : string;
arfound : boolean;
cmdstr,
binstr : string;
success : boolean;
cnt : longint;
begin
MakeStaticLibrary:=false;
smartpath:=current_module^.path^+FixPath(FixFileName(current_module^.modulename^)+target_info.smartext,false);
{ find ar binary }
if utilsdirectory<>'' then
begin
arbin:=Search(target_ar.arbin+source_os.exeext,
utilsdirectory,arfound)+target_ar.arbin+source_os.exeext;
end
else
arbin:=FindExe(target_ar.arbin,arfound);
if (not arfound) and not(cs_link_extern in aktglobalswitches) then
begin
Message(exec_w_ar_not_found);
aktglobalswitches:=aktglobalswitches+[cs_link_extern];
end;
s:=target_ar.arcmd;
Replace(s,'$LIB',current_module^.staticlibfilename^);
SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
Replace(cmdstr,'$LIB',current_module^.staticlibfilename^);
if filescnt=0 then
Replace(s,'$FILES',current_module^.objfilename^)
Replace(cmdstr,'$FILES',current_module^.objfilename^)
else
Replace(s,'$FILES',FixFileName(smartpath+current_module^.asmprefix^+'*'+target_info.objext));
DoExec(arbin,s,false,true);
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
@ -736,45 +454,56 @@ begin
AsmRes.Add('rmdir '+smartpath);
end;
end;
MakeStaticLibrary:=success;
end;
Procedure TLinker.MakeSharedLibrary;
var
s : string;
begin
s:=' -shared -o $LIB $FILES';
Replace(s,'$LIB',current_module^.sharedlibfilename^);
Replace(s,'$FILES',current_module^.objfilename^);
if DoExec(FindLinker,s,false,false) then
RemoveFile(current_module^.objfilename^);
end;
procedure tlinker.postprocessexecutable(const n:string);
begin
end;
{*****************************************************************************
Init/Done
*****************************************************************************}
procedure InitLinker;
begin
case target_info.target of
{$ifdef i386}
{$ifndef NOTARGETLINUX}
target_i386_linux :
linker:=new(plinkerlinux,Init);
{$endif}
{$ifndef NOTARGETWIN32}
target_i386_Win32 :
linker:=new(plinkerwin32,Init);
{$endif}
{$ifndef NOTARGETGO32V1}
target_i386_Go32v1 :
linker:=new(plinkergo32v1,Init);
{$endif}
{$ifndef NOTARGETGO32V2}
target_i386_Go32v2 :
linker:=new(plinkergo32v2,Init);
{$endif}
{$endif i386}
{$ifdef m68k}
{$ifndef NOTARGETPALMOS}
target_m68k_palmos:
linker:=new(plinker,Init);
{$endif}
{$ifndef NOTARGETLINUX}
target_m68k_linux :
linker:=new(plinkerlinux,Init);
{$endif}
{$endif m68k}
{$ifdef alpha}
target_alpha_linux:
linker:=new(plinker,Init);
{$ifndef NOTARGETLINUX}
target_alpha_linux :
linker:=new(plinkerlinux,Init);
{$endif}
{$endif alpha}
{$ifdef powerpc}
target_powerpc_linux:
linker:=new(plinker,Init);
{$ifndef NOTARGETLINUX}
target_powerpc_linux :
linker:=new(plinkerlinux,Init);
{$endif}
{$endif powerpc}
else
linker:=new(plinker,Init);
@ -792,8 +521,9 @@ end;
end.
{
$Log$
Revision 1.73 1999-10-08 15:38:42 pierre
* library list keeps doubles
Revision 1.74 1999-10-21 14:29:34 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
Revision 1.72 1999/09/16 23:05:52 florian
* m68k compiler is again compilable (only gas writer, no assembler reader)

7
compiler/msgidx.inc
View File

@ -413,15 +413,14 @@ type tmsgconst=(
exec_w_cant_call_assembler,
exec_i_assembling,
exec_i_assembling_smart,
exec_w_linker_not_found,
exec_t_using_linker,
exec_w_objfile_not_found,
exec_w_libfile_not_found,
exec_w_error_while_linking,
exec_w_cant_call_linker,
exec_i_linking,
exec_w_binder_not_found,
exec_w_ar_not_found,
exec_w_util_not_found,
exec_t_using_util,
exec_e_exe_not_supported,
exec_e_dll_not_supported,
exec_i_closing_script,
exec_w_res_not_found,

146
compiler/msgtxt.inc
View File

@ -1,7 +1,7 @@
{$ifdef Delphi}
const msgtxt : array[0..000103] of string[240]=(
const msgtxt : array[0..000102] of string[240]=(
{$else Delphi}
const msgtxt : array[0..000103,1..240] of char=(
const msgtxt : array[0..000102,1..240] of char=(
{$endif Delphi}
'T_Compiler: $1'#000+
'D_Compiler OS: $1'#000+
@ -436,135 +436,134 @@ const msgtxt : array[0..000103,1..240] of char=(
'ing'#000+
'I_Assembling $1'#000+
'I_Assembling smartlink $1'#000+
'W_Linker $1 not found, sw','itching to external linking'#000+
'T_Using linker: $1'#000+
'W_Object $1 not found, Linking may fail !'#000+
'W_Object $1 not found, Li','nking may fail !'#000+
'W_Library $1 not found, Linking may fail !'#000+
'W_Error while linking'#000+
'W_Can'#039't call the linker, switching to external linking'#000+
'I_Linking $1'#000+
'W_binder not found',', switching to external binding'#000+
'W_ar not found, switching to external ar'#000+
'E_Dynamic Libraries not supported'#000+
'W_$1 not found: $2, switching to external linking'#000+
'T_Using $1: $2'#000+
'E_Creation of Executables',' not supported'#000+
'E_Creation of Dynamic/Shared Libraries not supported'#000+
'I_Closing script $1'#000+
'W_resource compiler not found, switching to external mode'#000+
'I_Compiling resource $1'#000+
'F_Can'#039't post process executable',' $1'#000+
'F_Can'#039't post process executable $1'#000+
'F_Can'#039't open executable $1'#000+
'X_Size of Code: $1 bytes'#000+
'X_Size o','f Code: $1 bytes'#000+
'X_Size of initialized data: $1 bytes'#000+
'X_Size of uninitialized data: $1 bytes'#000+
'X_Stack space reserved: $1 bytes'#000+
'X_Stack space commited: $1 bytes'#000+
'T_Unitsearch: $1'#000+
'T_PPU Loading $1'#000+
'U_PPU Na','me: $1'#000+
'U_PPU Name: $1'#000+
'U_PPU Flags: $1'#000+
'U_PPU Crc: $1'#000+
'U_PPU Time: $1'#000+
'U_','PPU Time: $1'#000+
'U_PPU File too short'#000+
'U_PPU Invalid Header (no PPU at the begin)'#000+
'U_PPU Invalid Version $1'#000+
'U_PPU is compiled for an other processor'#000+
'U_PPU is compiled for an other target'#000+
'U_PPU Source: $1'#000+
'U_W','riting $1'#000+
'U_Writing $1'#000+
'F_Can'#039't Write PPU-File'#000+
'F_reading PPU-File'#000+
'F_read','ing PPU-File'#000+
'F_unexpected end of PPU-File'#000+
'F_Invalid PPU-File entry: $1'#000+
'F_PPU Dbx count problem'#000+
'E_Illegal unit name: $1'#000+
'F_Too much units'#000+
'F_Circular unit reference between $1 and $2'#000+
'F_Can'#039't compile unit ','$1, no sources available'#000+
'F_Can'#039't find unit $1'#000+
'F_Can'#039't compile unit $1, no sources available'#000+
'F_Can'#039't find u','nit $1'#000+
'W_Unit $1 was not found but $2 exists'#000+
'F_Unit $1 searched but $2 found'#000+
'W_Compiling the system unit requires the -Us switch'#000+
'F_There were $1 errors compiling module, stopping'#000+
'U_Load from $1 ($2) un','it $3'#000+
'U_Recompiling $1, checksum changed for $2'#000+
'U_Load from $1 ($2) unit $3'#000+
'U_Recompiling $1, checksum change','d for $2'#000+
'U_Recompiling $1, source found only'#000+
'U_Recompiling unit, static lib is older than ppufile'#000+
'U_Recompiling unit, shared lib is older than ppufile'#000+
'U_Recompiling unit, obj and asm are older than ppu','file'#000+
'U_Recompiling unit, obj is older than asm'#000+
'U_Recompiling unit, obj and asm are older than ppufile'#000+
'U_Recompiling unit, obj is older t','han asm'#000+
'U_Parsing interface of $1'#000+
'U_Parsing implementation of $1'#000+
'U_Second load for unit $1'#000+
'U_PPU Check file $1 time $2'#000+
'$1 [options] <inputfile> [options]'#000+
'W_Only one source file supported'#000+
'W_DEF file can',' be created only for OS/2'#000+
'E_nested response files are not supported'#000+
'W_DEF file can be created only for OS/2'#000+
'E_nested resp','onse files are not supported'#000+
'F_No source file name in command line'#000+
'E_Illegal parameter: $1'#000+
'H_-? writes help pages'#000+
'F_Too many config files nested'#000+
'F_Unable to open file $1'#000+
'N_Reading further options from ','$1'#000+
'N_Reading further options from $1'#000+
'W_Target is already set to: $1'#000+
'W_Shared libs not supported on DOS platform, reverting to static'#000+
'W_Sha','red libs not supported on DOS platform, reverting to static'#000+
'F_too many IF(N)DEFs'#000+
'F_too many ENDIFs'#000+
'F_open conditional at the end of the file'#000+
'W_Debug information generation is not supported by this exec','utable'#000+
'W_Debug information generation is not supported by this executable'#000+
'H_Try recompiling with -dGDB'#000+
'E_You are using the obsolete switch $1'#000+
'E_Y','ou are using the obsolete switch $1'#000+
'E_You are using the obsolete switch $1, please use $2'#000+
'N_Switching assembler to default source writing assembler'#000+
'Free Pascal Compiler version $FPCVER [$FPCDATE] for $','FPCTARGET'#000+
'Copyright (c) 1993-1999 by Florian Klaempfl'#000+
'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
'Copyright (c) 1993-1999 by Fl','orian Klaempfl'#000+
'Free Pascal Compiler version $FPCVER'#000+
#000+
'Compiler Date : $FPCDATE'#000+
'Compiler Target: $FPCTARGET'#000+
#000+
'This program comes under the GNU General Public Licence'#000+
'For more information read COPYING.FPC',#000+
'For more information read COPYING.FPC'#000+
#000+
'Report bugs,suggestions etc to:'#000+
' fpc-devel@vekoll.saturnus.vein.hu'#000+
' ',' fpc-devel@vekoll.saturnus.vein.hu'#000+
'**0*_put + after a boolean switch option to enable it, - to disable it'+
#000+
'**1a_the compiler doesn'#039't delete the generated assembler file'#000+
'**2al_list sourcecode ','lines in assembler file'#000+
'**2ar_list register allocation/release info in assembler file'#000+
'**2al_list sourcecode lines in assembler file'#000+
'**2ar_list regi','ster allocation/release info in assembler file'#000+
'**2at_list temp allocation/release info in assembler file'#000+
'**1b_generate browser info'#000+
'**2bl_generate local symbol info'#000+
'**1B_build all modules'#000+
'**1C<x>_code ','generation options:'#000+
'3*2CD_create dynamic library'#000+
'**1C<x>_code generation options:'#000+
'3*2CD_create dynami','c library'#000+
'**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
'**2Ci_IO-checking'#000+
'**2Cn_omit linking stage'#000+
'**2Co_check overflow of integer operations'#000+
'**2Cr_range checking'#000+
'**2Cs<n>_set stack size to <n>'#000+
'*','*2Ct_stack checking'#000+
'**2CD_create also dynamic library (* doesn'#039't work yet *)'#000+
'**2Ct_stack checking'#000+
'**2CD_create also d','ynamic library (* doesn'#039't work yet *)'#000+
'**2CX_create also smartlinked library'#000+
'**1d<x>_defines the symbol <x>'#000+
'*O1D_generate a DEF file'#000+
'*O2Dd<x>_set description to <x>'#000+
'*O2Dw_PM application'#000+
'**1e<x>_set path',' to executable'#000+
'**1e<x>_set path to executable'#000+
'**1E_same as -Cn'#000+
'**1F<x>_set file names and paths:'#000+
'**1F<x>','_set file names and paths:'#000+
'**2FD<x>_sets the directory where to search for compiler utilities'#000+
'**2Fe<x>_redirect error output to <x>'#000+
'**2FE<x>_set exe/unit output path to <x>'#000+
'**2Fi<x>_adds <x> to include',' path'#000+
'**2Fl<x>_adds <x> to library path'#000+
'**2Fi<x>_adds <x> to include path'#000+
'**2Fl<x>_adds <x> to library path',#000+
'*L2FL<x>_uses <x> as dynamic linker'#000+
'**2Fo<x>_adds <x> to object path'#000+
'**2Fr<x>_load error message file <x>'#000+
'**2Fu<x>_adds <x> to unit path'#000+
'**2FU<x>_set unit output path to <x>, overrides -FE'#000+
'*g1g<x>_gen','erate debugger information:'#000+
'*g2gg_use gsym'#000+
'*g1g<x>_generate debugger information:'#000+
'*g2gg_use g','sym'#000+
'*g2gd_use dbx'#000+
'*g2gh_use heap trace unit'#000+
'*g2gc_generate checks for pointers'#000+
@ -572,97 +571,98 @@ const msgtxt : array[0..000103,1..240] of char=(
'**2iD_return compiler date'#000+
'**2iV_return compiler version'#000+
'**2iSO_return compiler OS'#000+
'**2iSP_return compiler',' processor'#000+
'**2iSP_return compiler processor'#000+
'**2iTO_return target OS'#000+
'**2iTP_return target processor'#000+
'**2i','TP_return target processor'#000+
'**1I<x>_adds <x> to include path'#000+
'**1k<x>_Pass <x> to the linker'#000+
'**1l_write logo'#000+
'**1n_don'#039't read the default config file'#000+
'**1o<x>_change the name of the executable produced to ','<x>'#000+
'**1pg_generate profile code for gprof (defines FPC_PROFILE)'#000+
'**1o<x>_change the name of the executable produced to <x>'#000+
'**1pg_generate profile code for gpr','of (defines FPC_PROFILE)'#000+
'*L1P_use pipes instead of creating temporary assembler files'#000+
'**1S<x>_syntax options:'#000+
'**2S2_switch some Delphi 2 extensions on'#000+
'**2Sc_supports operators like C (*=,+=,/= and -=)'#000,
'**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
'**2Sd_tries to be Delphi compatible'#000+
'**2Se<x>_compiler stops after the <x> errors (default is 1)'#000+
'**2','Se<x>_compiler stops after the <x> errors (default is 1)'#000+
'**2Sg_allow LABEL and GOTO'#000+
'**2Sh_Use ansistrings'#000+
'**2Si_support C++ styled INLINE'#000+
'**2Sm_support macros like C (global)'#000+
'**2So_tries to be TP/BP 7.','0 compatible'#000+
'**2Sp_tries to be gpc compatible'#000+
'**2So_tries to be TP/BP 7.0 compatible'#000+
'**2Sp_tries to be gpc comp','atible'#000+
'**2Ss_constructor name must be init (destructor must be done)'#000+
'**2St_allow static keyword in objects'#000+
'**1s_don'#039't call assembler and linker (only with -a)'#000+
'**1u<x>_undefines the symbol <x>'#000+
'**1U_unit',' options:'#000+
'**2Un_don'#039't check the unit name'#000+
'**1U_unit options:'#000+
'**2Un_don'#039't check the unit na','me'#000+
'**2Us_compile a system unit'#000+
'**1v<x>_Be verbose. <x> is a combination of the following letters:'#000+
'**2*_e : Show errors (default) d : Show debug info'#000+
'**2*_w : Show warnings u : Show ','unit info'#000+
'**2*_n : Show notes t : Show tried/used files'#000+
'**2*_w : Show warnings u : Show unit info'#000+
'**2*_n : Show notes ',' t : Show tried/used files'#000+
'**2*_h : Show hints m : Show defined macros'#000+
'**2*_i : Show general info p : Show compiled procedures'#000+
'**2*_l : Show linenumbers c :',' Show conditionals'#000+
'**2*_a : Show everything 0 : Show nothing (except errors)'#000+
'**2*_l : Show linenumbers c : Show conditionals'#000+
'**2*_a : Show everyt','hing 0 : Show nothing (except errors'+
')'#000+
'**2*_b : Show all procedure r : Rhide/GCC compatibility mode'#000+
'**2*_ declarations if an error x : Executable info (Win32 only)'#000+
'**2*_ oc','curs'#000+
'**2*_ occurs'#000+
'**1X_executable options:'#000+
'*L2Xc_link with the c library'#000+
'*L2Xc_lin','k with the c library'#000+
'**2Xs_strip all symbols from executable'#000+
'**2XD_try to link dynamic (defines FPC_LINK_DYNAMIC)'#000+
'**2XS_try to link static (default) (defines FPC_LINK_STATIC)'#000+
'**2XX_try to link',' smart (defines FPC_LINK_SMART)'#000+
'**2XX_try to link smart (defines FPC_LINK_SMA','RT)'#000+
'**0*_Processor specific options:'#000+
'3*1A<x>_output format:'#000+
'3*2Aas_assemble using GNU AS'#000+
'3*2Aasaout_assemble using GNU AS for aout (Go32v1)'#000+
'3*2Anasmcoff_coff (Go32v2) file using Nasm'#000+
'3*2Anasmelf_elf32 ','(Linux) file using Nasm'#000+
'3*2Anasmobj_obj file using Nasm'#000+
'3*2Anasmelf_elf32 (Linux) file using Nasm'#000+
'3*2Anasmobj_obj',' file using Nasm'#000+
'3*2Amasm_obj file using Masm (Microsoft)'#000+
'3*2Atasm_obj file using Tasm (Borland)'#000+
'3*2Acoff_coff (Go32v2) using internal writer'#000+
'3*2Apecoff_pecoff (Win32) using internal writer'#000+
'3*1R<x>_ass','embler reading style:'#000+
'3*2Ratt_read AT&T style assembler'#000+
'3*1R<x>_assembler reading style:'#000+
'3*2Ratt_read AT&T',' style assembler'#000+
'3*2Rintel_read Intel style assembler'#000+
'3*2Rdirect_copy assembler text directly to assembler file'#000+
'3*1O<x>_optimizations:'#000+
'3*2Og_generate smaller code'#000+
'3*2OG_generate faster code (default)'#000+
'3','*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
'3*2Or_keep certain variables in register','s (still BUGGY!!!)'#000+
'3*2Ou_enable uncertain optimizations (see docs)'#000+
'3*2O1_level 1 optimizations (quick optimizations)'#000+
'3*2O2_level 2 optimizations (-O1 + slower optimizations)'#000+
'3*2O3_level 3 optimizations',' (same as -O2u)'#000+
'3*2Op<x>_target processor:'#000+
'3*2O3_level 3 optimizations (same as -O2u)'#000+
'3*2Op<x>_target process','or:'#000+
'3*3Op1_set target processor to 386/486'#000+
'3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+
'3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+
'3*1T<x>_Target operating system:'#000+
'3*2TGO32V1_versi','on 1 of DJ Delorie DOS extender'#000+
'3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
'3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
'3*2TGO3','2V2_version 2 of DJ Delorie DOS extender'#000+
'3*2TLINUX_Linux'#000+
'3*2TOS2_OS/2 2.x'#000+
'3*2TWin32_Windows 32 Bit'#000+
'6*1A<x>_output format'#000+
'6*2Aas_Unix o-file using GNU AS'#000+
'6*2Agas_GNU Motorola assembler'#000+
'6*2Amit_MIT Synta','x (old GAS)'#000+
'6*2Amot_Standard Motorola assembler'#000+
'6*2Amit_MIT Syntax (old GAS)'#000+
'6*2Amot_Standard Motorola a','ssembler'#000+
'6*1O_optimizations:'#000+
'6*2Oa_turn on the optimizer'#000+
'6*2Og_generate smaller code'#000+
'6*2OG_generate faster code (default)'#000+
'6*2Ox_optimize maximum (still BUGGY!!!)'#000+
'6*2O2_set target processor to a MC68020','+'#000+
'6*2O2_set target processor to a MC68020+'#000+
'6*1R<x>_assembler reading style:'#000+
'6*2RMOT_read motorola style assembler'#000+
'6*2R','MOT_read motorola style assembler'#000+
'6*1T<x>_Target operating system:'#000+
'6*2TAMIGA_Commodore Amiga'#000+
'6*2TATARI_Atari ST/STe/TT'#000+
@ -670,5 +670,5 @@ const msgtxt : array[0..000103,1..240] of char=(
'6*2TLINUX_Linux-68k'#000+
'**1*_'#000+
'**1?_shows this help'#000+
'**1h_shows',' this help without waiting'#000
'**1h_shows this help without waiting'#000
);

40
compiler/pmodules.pas
View File

@ -274,33 +274,6 @@ unit pmodules;
datasegment^.concat(new(pai_symbol,initname_global('__stklen',4)));
datasegment^.concat(new(pai_const,init_32bit(stacksize)));
end;
target_i386_WIN32 :
begin
target_link.bindcmd[1]:=target_link.bindcmd[1]+' -d '+deffile.fname;
if DLLsource then
begin
target_link.binders:=2;
target_link.linkcmd:='--dll '+target_link.linkcmd;
target_link.bindcmd[2]:='--dll '+target_link.bindcmd[2];
if RelocSection then
begin
target_link.linkcmd:=target_link.linkcmd+' --base-file base.$$$';
target_link.bindcmd[1]:=target_link.bindcmd[1]+' --base-file base.$$$';
end;
if assigned(DLLImageBase) then
begin
target_link.linkcmd:=target_link.linkcmd+' --image-base=0x'+DLLImageBase^;
target_link.bindcmd[2]:=target_link.bindcmd[2]+' --image-base=0x'+DLLImageBase^;
end;
end;
if apptype=at_gui then
begin
target_link.linkcmd:='--subsystem windows '+target_link.linkcmd;
target_link.bindcmd[2]:='--subsystem windows '+target_link.bindcmd[2];
end;
if (cs_link_strip in aktglobalswitches) then
target_link.bindcmd[2]:='-s '+target_link.bindcmd[2];
end;
{$endif i386}
{$ifdef m68k}
target_m68k_Atari :
@ -1453,14 +1426,23 @@ unit pmodules;
deffile.writefile;
{ finally we can create a executable }
if (not current_module^.is_unit) then
Linker^.MakeExecutable;
begin
if DLLSource then
Linker^.MakeSharedLibrary
else
Linker^.MakeExecutable;
end;
end;
end;
end.
{
$Log$
Revision 1.159 1999-10-12 21:20:45 florian
Revision 1.160 1999-10-21 14:29:37 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
Revision 1.159 1999/10/12 21:20:45 florian
* new codegenerator compiles again
Revision 1.158 1999/10/03 19:44:42 peter

57
compiler/script.pas
View File

@ -31,7 +31,9 @@ type
TScript=object
fn : string[80];
data : TStringQueue;
executable : boolean;
constructor Init(const s:string);
constructor InitExec(const s:string);
destructor Done;
procedure AddStart(const s:string);
procedure Add(const s:string);
@ -39,18 +41,24 @@ type
procedure WriteToDisk;virtual;
end;
PAsmScript = ^TAsmScript;
TAsmScript = Object (TScript)
Constructor Init (Const ScriptName : String);
Procedure AddAsmCommand (Const Command, Options,FileName : String);
Procedure AddLinkCommand (Const Command, Options, FileName : String);
Procedure AddDeleteCommand (Const FileName : String);
Procedure WriteToDisk;virtual;
end;
PAsmScript = ^TAsmScript;
end;
PLinkRes = ^TLinkRes;
TLinkRes = Object (TScript)
procedure Add(const s:string);
procedure AddFileName(const s:string);
end;
{ Asm response file }
var
AsmRes : TAsmScript;
LinkRes : TLinkRes;
implementation
@ -67,8 +75,17 @@ uses
****************************************************************************}
constructor TScript.Init(const s:string);
begin
fn:=FixFileName(s);
executable:=false;
data.Init;
end;
constructor TScript.InitExec(const s:string);
begin
fn:=FixFileName(s)+source_os.scriptext;
executable:=true;
data.Init;
end;
@ -107,7 +124,8 @@ begin
Writeln(t,data.Get);
Close(t);
{$ifdef linux}
ChMod(fn,493);
if executable then
ChMod(fn,493);
{$endif}
end;
@ -118,7 +136,7 @@ end;
Constructor TAsmScript.Init (Const ScriptName : String);
begin
Inherited Init(ScriptName);
Inherited InitExec(ScriptName);
end;
@ -188,14 +206,39 @@ Begin
Add('echo An error occured while linking %THEFILE%');
Add(':end');
{$endif}
TScript.WriteToDisk;
inherited WriteToDisk;
end;
{****************************************************************************
Link Response
****************************************************************************}
procedure TLinkRes.Add(const s:string);
begin
if s<>'' then
inherited Add(s);
end;
procedure TLinkRes.AddFileName(const s:string);
begin
if s<>'' then
begin
if not(s[1] in ['a'..'z','A'..'Z','/','\','.']) then
inherited Add('.'+DirSep+s)
else
inherited Add(s);
end;
end;
end.
{
$Log$
Revision 1.2 1998-05-04 17:54:29 peter
Revision 1.3 1999-10-21 14:29:37 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
Revision 1.2 1998/05/04 17:54:29 peter
+ smartlinking works (only case jumptable left todo)
* redesign of systems.pas to support assemblers and linkers
+ Unitname is now also in the PPU-file, increased version to 14

233
compiler/systems.pas
View File

@ -96,20 +96,6 @@ unit systems;
as_i386_dbg,as_i386_coff,as_i386_pecoff
];
type
tlink = (link_none
,link_i386_ld,link_i386_ldgo32v1,
link_i386_ldgo32v2,link_i386_ldw,
link_i386_ldos2
,link_m68k_ld,link_alpha_ld,link_powerpc_ld
);
const
{$ifdef i386} i386linkcnt=5; {$else} i386linkcnt=0; {$endif}
{$ifdef m68k} m68klinkcnt=1; {$else} m68klinkcnt=0; {$endif}
{$ifdef alpha} alphalinkcnt=1; {$else} alphalinkcnt=0; {$endif}
{$ifdef powerpc} powerpclinkcnt=1; {$else} powerpclinkcnt=0; {$endif}
linkcnt=i386linkcnt+m68klinkcnt+alphalinkcnt+powerpclinkcnt+1;
type
tar = (ar_none
,ar_i386_ar,ar_i386_arw
@ -149,9 +135,9 @@ unit systems;
type
tosinfo = packed record
id : tos;
name : string[30];
shortname : string[8];
id : tos;
name : string[30];
shortname : string[8];
sharedlibext : string[10];
staticlibext,
sourceext,
@ -171,7 +157,7 @@ unit systems;
end;
tasminfo = packed record
id : tasm;
id : tasm;
idtxt : string[8];
asmbin : string[8];
asmcmd : string[50];
@ -183,24 +169,6 @@ unit systems;
secnames : array[tsection] of string[20];
end;
tlinkinfo = packed record
id : tlink;
linkbin : string[8];
linkcmd : string[127];
binders : word;
bindbin : array[1..2]of string[8];
bindcmd : array[1..2]of string[127];
stripopt : string[2];
stripbind : boolean; { Strip symbols in binder? }
libpathprefix : string[13];
libpathsuffix : string[2];
groupstart : string[8];
groupend : string[2];
inputstart : string[8];
inputend : string[2];
libprefix : string[2];
end;
tarinfo = packed record
id : tar;
arbin : string[8];
@ -229,7 +197,6 @@ unit systems;
resobjext,
exeext : string[4];
os : tos;
link : tlink;
assem : tasm;
assemsrc : tasm; { default source writing assembler }
ar : tar;
@ -249,7 +216,6 @@ unit systems;
target_info : ttargetinfo;
target_os : tosinfo;
target_asm : tasminfo;
target_link : tlinkinfo;
target_ar : tarinfo;
target_res : tresinfo;
target_path : string[12]; { for rtl/<X>/,fcl/<X>/, etc. }
@ -257,7 +223,6 @@ unit systems;
function set_target_os(t:tos):boolean;
function set_target_asm(t:tasm):boolean;
function set_target_link(t:tlink):boolean;
function set_target_ar(t:tar):boolean;
function set_target_res(t:tres):boolean;
function set_target_info(t:ttarget):boolean;
@ -828,162 +793,6 @@ implementation
);
{****************************************************************************
Linker Info
****************************************************************************}
link_infos : array[1..linkcnt] of tlinkinfo = (
(
id : link_none
)
{$ifdef i386}
,(
id : link_i386_ld;
linkbin : 'ld';
linkcmd : '$OPT -o $EXE $RES';
binders : 0;
bindbin : ('','');
bindcmd : ('','');
stripopt : '-s';
stripbind : false;
libpathprefix : 'SEARCH_DIR(';
libpathsuffix : ')';
groupstart : 'GROUP(';
groupend : ')';
inputstart : 'INPUT(';
inputend : ')';
libprefix : '-l'
)
,(
id : link_i386_ldgo32v1;
linkbin : 'ld';
linkcmd : '-oformat coff-go32 $OPT -o $EXE @$RES';
binders : 1;
bindbin : ('aout2exe','');
bindcmd : ('$EXE','');
stripopt : '-s';
stripbind : false;
libpathprefix : '-L';
libpathsuffix : '';
groupstart : '-(';
groupend : '-)';
inputstart : '';
inputend : '';
libprefix : '-l'
)
,(
id : link_i386_ldgo32v2;
linkbin : 'ld';
linkcmd : '-oformat coff-go32-exe $OPT -o $EXE @$RES';
binders:0;
bindbin : ('','');
bindcmd : ('','');
stripopt : '-s';
stripbind : false;
libpathprefix : '-L';
libpathsuffix : '';
groupstart : '-(';
groupend : '-)';
inputstart : '';
inputend : '';
libprefix : '-l'
)
,(
id : link_i386_ldw;
linkbin : 'ldw';
linkcmd : '$OPT -o $EXE $RES';
binders : 0;
bindbin : ('dlltool','ldw');
bindcmd : ('--as asw.exe --dllname $EXE --output-exp exp.$$$',
'$OPT -o $EXE $RES exp.$$$');
stripopt : '-s';
stripbind : false;
libpathprefix : 'SEARCH_DIR(';
libpathsuffix : ')';
groupstart : 'GROUP(';
groupend : ')';
inputstart : 'INPUT(';
inputend : ')';
libprefix : '-l'
)
,(
id : link_i386_ldos2;
linkbin : 'ld'; { Os/2 }
linkcmd : '-o $EXE @$RES';
binders : 1;
bindbin : ('emxbind','');
bindcmd : ('-b $STRIP$PM -k$STACKKB -h$HEAPMB -o $EXE.exe $EXE -aim -s$DOSHEAPKB',
'');
stripopt : '-s';
stripbind : true;
libpathprefix : '-L';
libpathsuffix : '';
groupstart : ''; {Linker is too primitive...}
groupend : '';
inputstart : '';
inputend : '';
libprefix : '-l'
)
{$endif i386}
{$ifdef m68k}
,(
id : link_m68k_ld;
linkbin : 'ld';
linkcmd : '$OPT -o $EXE $RES';
binders:0;
bindbin : ('','');
bindcmd : ('','');
stripopt : '-s';
stripbind : false;
libpathprefix : 'SEARCH_DIR(';
libpathsuffix : ')';
groupstart : 'GROUP(';
groupend : ')';
inputstart : 'INPUT(';
inputend : ')';
libprefix : '-l'
)
{$endif m68k}
{$ifdef alpha}
,(
id : link_alpha_ld;
linkbin : 'ld';
linkcmd : '$OPT -o $EXE $RES';
binders : 0;
bindbin : ('','');
bindcmd : ('','');
stripopt : '-s';
stripbind : false;
libpathprefix : 'SEARCH_DIR(';
libpathsuffix : ')';
groupstart : 'GROUP(';
groupend : ')';
inputstart : 'INPUT(';
inputend : ')';
libprefix : '-l'
)
{$endif}
{$ifdef powerpc}
,(
id : link_powerpc_ld;
linkbin : 'ld';
linkcmd : '$OPT -o $EXE $RES';
binders : 0;
bindbin : ('','');
bindcmd : ('','');
stripopt : '-s';
stripbind : false;
libpathprefix : 'SEARCH_DIR(';
libpathsuffix : ')';
groupstart : 'GROUP(';
groupend : ')';
inputstart : 'INPUT(';
inputend : ')';
libprefix : '-l'
)
{$endif}
);
{****************************************************************************
Ar Info
****************************************************************************}
@ -1071,7 +880,6 @@ implementation
resobjext : '.o1r';
exeext : ''; { The linker produces a.out }
os : os_i386_GO32V1;
link : link_i386_ldgo32v1;
assem : as_i386_as;
assemsrc : as_i386_as;
ar : ar_i386_ar;
@ -1096,7 +904,6 @@ implementation
resobjext : '.or';
exeext : '.exe';
os : os_i386_GO32V2;
link : link_i386_ldgo32v2;
assem : as_i386_coff;
assemsrc : as_i386_as;
ar : ar_i386_ar;
@ -1121,7 +928,6 @@ implementation
resobjext : '.or';
exeext : '';
os : os_i386_Linux;
link : link_i386_ld;
assem : as_i386_as;
assemsrc : as_i386_as;
ar : ar_i386_ar;
@ -1146,7 +952,6 @@ implementation
resobjext : '.oor';
exeext : ''; { The linker produces a.out }
os : os_i386_OS2;
link : link_i386_ldos2;
assem : as_i386_as_aout;
assemsrc : as_i386_as_aout;
ar : ar_i386_ar;
@ -1171,7 +976,6 @@ implementation
resobjext : '.owr';
exeext : '.exe';
os : os_i386_Win32;
link : link_i386_ldw;
assem : as_i386_pecoff;
assemsrc : as_i386_asw;
ar : ar_i386_arw;
@ -1198,7 +1002,6 @@ implementation
resobjext : '.or';
exeext : '';
os : os_m68k_Amiga;
link : link_m68k_ld;
assem : as_m68k_as;
assemsrc : as_m68k_as;
ar : ar_m68k_ar;
@ -1223,7 +1026,6 @@ implementation
resobjext : '.or';
exeext : '.ttp';
os : os_m68k_Atari;
link : link_m68k_ld;
assem : as_m68k_as;
assemsrc : as_m68k_as;
ar : ar_m68k_ar;
@ -1248,7 +1050,6 @@ implementation
resobjext : '.or';
exeext : '';
os : os_m68k_Mac;
link : link_m68k_ld;
assem : as_m68k_mpw;
assemsrc : as_m68k_mpw;
ar : ar_m68k_ar;
@ -1273,7 +1074,6 @@ implementation
resobjext : '.or';
exeext : '';
os : os_m68k_Linux;
link : link_m68k_ld;
assem : as_m68k_as;
assemsrc : as_m68k_as;
ar : ar_m68k_ar;
@ -1298,7 +1098,6 @@ implementation
resobjext : '.or';
exeext : '';
os : os_m68k_PalmOS;
link : link_m68k_ld;
assem : as_m68k_as;
assemsrc : as_m68k_as;
ar : ar_m68k_ar;
@ -1325,7 +1124,6 @@ implementation
resobjext : '.or';
exeext : '';
os : os_alpha_Linux;
link : link_alpha_ld;
assem : as_alpha_as;
assemsrc : as_alpha_as;
ar : ar_alpha_ar;
@ -1352,7 +1150,6 @@ implementation
resobjext : '.or';
exeext : '';
os : os_powerpc_Linux;
link : link_powerpc_ld;
assem : as_powerpc_as;
assemsrc : as_powerpc_as;
ar : ar_powerpc_ar;
@ -1482,21 +1279,6 @@ begin
end;
function set_target_link(t:tlink):boolean;
var
i : longint;
begin
set_target_link:=false;
for i:=1 to linkcnt do
if link_infos[i].id=t then
begin
target_link:=link_infos[i];
set_target_link:=true;
exit;
end;
end;
function set_target_ar(t:tar):boolean;
var
i : longint;
@ -1538,7 +1320,6 @@ begin
target_info:=target_infos[i];
set_target_os(target_info.os);
set_target_asm(target_info.assem);
set_target_link(target_info.link);
set_target_ar(target_info.ar);
set_target_res(target_info.res);
target_path:=lower(target_info.short_name);
@ -1734,7 +1515,11 @@ begin
end.
{
$Log$
Revision 1.94 1999-09-15 22:09:27 florian
Revision 1.95 1999-10-21 14:29:37 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
Revision 1.94 1999/09/15 22:09:27 florian
+ rtti is now automatically generated for published classes, i.e.
they are handled like an implicit property

194
compiler/t_go32v1.pas Normal file
View File

@ -0,0 +1,194 @@
{
$Id$
Copyright (c) 1999 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;
s,s2 : string;
linklibc : boolean;
begin
WriteResponseFile:=False;
{ Open link.res file }
LinkRes.Init(Info.ResName);
{ Write path to search libraries }
if assigned(current_module^.locallibrarysearchpath) then
begin
S:=current_module^.locallibrarysearchpath^;
while s<>'' do
begin
s2:=GetPathFromList(s);
LinkRes.Add('-L'+s2);
end;
end;
S:=LibrarySearchPath;
while s<>'' do
begin
s2:=GetPathFromList(s);
LinkRes.Add('-L'+s2);
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 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) }
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 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 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',current_module^.outpath^+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(current_module^.outpath^+Info.ResName);
MakeExecutable:=success; { otherwise a recursive call to link method }
end;
end.
{
$Log$
Revision 1.1 1999-10-21 14:29:38 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
}

296
compiler/t_go32v2.pas Normal file
View File

@ -0,0 +1,296 @@
{
$Id$
Copyright (c) 1999 by Peter Vreman
This unit implements support import,export,link routines
for the (i386) Go32v2 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_go32v2;
interface
uses
link;
type
plinkergo32v2=^tlinkergo32v2;
tlinkergo32v2=object(tlinker)
private
Function WriteResponseFile(isdll:boolean) : Boolean;
public
constructor Init;
procedure SetDefaultInfo;virtual;
function MakeExecutable:boolean;virtual;
end;
implementation
uses
strings,globtype,globals,cobjects,systems,verbose,script,files;
{****************************************************************************
TLinkerGo32v2
****************************************************************************}
Constructor TLinkerGo32v2.Init;
begin
Inherited Init;
{ allow duplicated libs (PM) }
SharedLibFiles.doubles:=true;
StaticLibFiles.doubles:=true;
end;
procedure TLinkerGo32v2.SetDefaultInfo;
begin
with Info do
begin
ExeCmd[1]:='ld -oformat coff-go32-exe $OPT $STRIP -o $EXE @$RES';
end;
end;
Function TLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
s,s2 : string;
linklibc : boolean;
begin
WriteResponseFile:=False;
{ Open link.res file }
LinkRes.Init(Info.ResName);
{ Write path to search libraries }
if assigned(current_module^.locallibrarysearchpath) then
begin
S:=current_module^.locallibrarysearchpath^;
while s<>'' do
begin
s2:=GetPathFromList(s);
LinkRes.Add('-L'+s2);
end;
end;
S:=LibrarySearchPath;
while s<>'' do
begin
s2:=GetPathFromList(s);
LinkRes.Add('-L'+s2);
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 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) }
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 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 and Close response }
linkres.writetodisk;
linkres.done;
WriteResponseFile:=True;
end;
function TLinkerGo32v2.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',current_module^.outpath^+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(current_module^.outpath^+Info.ResName);
MakeExecutable:=success; { otherwise a recursive call to link method }
end;
{$ifdef notnecessary}
procedure tlinkergo32v2.postprocessexecutable(const n : string);
type
tcoffheader=packed record
mach : word;
nsects : word;
time : longint;
sympos : longint;
syms : longint;
opthdr : word;
flag : word;
end;
tcoffsechdr=packed record
name : array[0..7] of char;
vsize : longint;
rvaofs : longint;
datalen : longint;
datapos : longint;
relocpos : longint;
lineno1 : longint;
nrelocs : word;
lineno2 : word;
flags : longint;
end;
psecfill=^tsecfill;
tsecfill=record
fillpos,
fillsize : longint;
next : psecfill;
end;
var
f : file;
coffheader : tcoffheader;
firstsecpos,
maxfillsize,
l : longint;
coffsec : tcoffsechdr;
secroot,hsecroot : psecfill;
zerobuf : pointer;
begin
{ when -s is used quit, because there is no .exe }
if cs_link_extern in aktglobalswitches then
exit;
{ open file }
assign(f,n);
{$I-}
reset(f,1);
if ioresult<>0 then
Message1(execinfo_f_cant_open_executable,n);
{ read headers }
seek(f,2048);
blockread(f,coffheader,sizeof(tcoffheader));
{ read section info }
maxfillsize:=0;
firstsecpos:=0;
secroot:=nil;
for l:=1to coffheader.nSects do
begin
blockread(f,coffsec,sizeof(tcoffsechdr));
if coffsec.datapos>0 then
begin
if secroot=nil then
firstsecpos:=coffsec.datapos;
new(hsecroot);
hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
hsecroot^.next:=secroot;
secroot:=hsecroot;
if secroot^.fillsize>maxfillsize then
maxfillsize:=secroot^.fillsize;
end;
end;
if firstsecpos>0 then
begin
l:=firstsecpos-filepos(f);
if l>maxfillsize then
maxfillsize:=l;
end
else
l:=0;
{ get zero buffer }
getmem(zerobuf,maxfillsize);
fillchar(zerobuf^,maxfillsize,0);
{ zero from sectioninfo until first section }
blockwrite(f,zerobuf^,l);
{ zero section alignments }
while assigned(secroot) do
begin
seek(f,secroot^.fillpos);
blockwrite(f,zerobuf^,secroot^.fillsize);
hsecroot:=secroot;
secroot:=secroot^.next;
dispose(hsecroot);
end;
freemem(zerobuf,maxfillsize);
close(f);
{$I+}
i:=ioresult;
postprocessexecutable:=true;
end;
{$endif}
end.
{
$Log$
Revision 1.1 1999-10-21 14:29:38 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
}

441
compiler/t_linux.pas Normal file
View File

@ -0,0 +1,441 @@
{
$Id$
Copyright (c) 1999 by Peter Vreman
This unit implements support import,export,link routines
for the (i386) Linux 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_linux;
interface
uses
import,export,link;
type
pimportliblinux=^timportliblinux;
timportliblinux=object(timportlib)
procedure preparelib(const s:string);virtual;
procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
procedure importvariable(const varname,module:string;const name:string);virtual;
procedure generatelib;virtual;
end;
pexportliblinux=^texportliblinux;
texportliblinux=object(texportlib)
procedure preparelib(const s : string);virtual;
procedure exportprocedure(hp : pexported_item);virtual;
procedure exportvar(hp : pexported_item);virtual;
procedure generatelib;virtual;
end;
plinkerlinux=^tlinkerlinux;
tlinkerlinux=object(tlinker)
private
Glibc2,
Glibc21 : boolean;
Function WriteResponseFile(isdll:boolean) : Boolean;
public
constructor Init;
procedure SetDefaultInfo;virtual;
function MakeExecutable:boolean;virtual;
function MakeSharedLibrary:boolean;virtual;
end;
implementation
uses
verbose,strings,cobjects,systems,globtype,globals,
symconst,script,
files,aasm,cpuasm,cpubase,symtable;
{*****************************************************************************
TIMPORTLIBLINUX
*****************************************************************************}
procedure timportliblinux.preparelib(const s : string);
begin
end;
procedure timportliblinux.importprocedure(const func,module : string;index : longint;const name : string);
begin
{ insert sharedlibrary }
current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
{ do nothing with the procedure, only set the mangledname }
if name<>'' then
aktprocsym^.definition^.setmangledname(name)
else
Message(parser_e_empty_import_name);
end;
procedure timportliblinux.importvariable(const varname,module:string;const name:string);
begin
{ insert sharedlibrary }
current_module^.linkothersharedlibs.insert(SplitName(module),link_allways);
{ reset the mangledname and turn off the dll_var option }
aktvarsym^.setmangledname(name);
{$ifdef INCLUDEOK}
exclude(aktvarsym^.varoptions,vo_is_dll_var);
{$else}
aktvarsym^.varoptions:=aktvarsym^.varoptions-[vo_is_dll_var];
{$endif}
end;
procedure timportliblinux.generatelib;
begin
end;
{*****************************************************************************
TEXPORTLIBLINUX
*****************************************************************************}
procedure texportliblinux.preparelib(const s:string);
begin
end;
procedure texportliblinux.exportprocedure(hp : pexported_item);
var
hp2 : pexported_item;
begin
{ first test the index value }
if (hp^.options and eo_index)<>0 then
begin
Comment(V_Error,'can''t export with index under linux');
exit;
end;
{ use pascal name is none specified }
if (hp^.options and eo_name)=0 then
begin
hp^.name:=stringdup(hp^.sym^.name);
hp^.options:=hp^.options or eo_name;
end;
{ now place in correct order }
hp2:=pexported_item(current_module^._exports^.first);
while assigned(hp2) and
(hp^.name^>hp2^.name^) do
hp2:=pexported_item(hp2^.next);
{ insert hp there !! }
if assigned(hp2) and (hp2^.name^=hp^.name^) then
begin
{ this is not allowed !! }
Message1(parser_e_export_name_double,hp^.name^);
exit;
end;
if hp2=pexported_item(current_module^._exports^.first) then
current_module^._exports^.insert(hp)
else if assigned(hp2) then
begin
hp^.next:=hp2;
hp^.previous:=hp2^.previous;
if assigned(hp2^.previous) then
hp2^.previous^.next:=hp;
hp2^.previous:=hp;
end
else
current_module^._exports^.concat(hp);
end;
procedure texportliblinux.exportvar(hp : pexported_item);
begin
hp^.is_var:=true;
exportprocedure(hp);
end;
procedure texportliblinux.generatelib;
var
hp2 : pexported_item;
begin
hp2:=pexported_item(current_module^._exports^.first);
while assigned(hp2) do
begin
if not hp2^.is_var then
begin
{ place jump in codesegment }
codesegment^.concat(new(pai_align,init_op(4,$90)));
codesegment^.concat(new(pai_symbol,initname_global(hp2^.name^,0)));
codesegment^.concat(new(paicpu,op_sym(A_JMP,S_NO,newasmsymbol(hp2^.sym^.mangledname))));
codesegment^.concat(new(pai_symbol_end,initname(hp2^.name^)));
end
else
Comment(V_Error,'Exporting of variables is not supported under linux');
hp2:=pexported_item(hp2^.next);
end;
end;
{*****************************************************************************
TLINKERLINUX
*****************************************************************************}
Constructor TLinkerLinux.Init;
begin
Inherited Init;
AddPathToList(LibrarySearchPath,'/lib;/usr/lib;/usr/X11R6/lib',true);
end;
procedure TLinkerLinux.SetDefaultInfo;
{
This will also detect which libc version will be used
}
begin
Glibc2:=false;
Glibc21:=false;
with Info do
begin
ExeCmd[1]:='ld $OPT $DYNLINK $STRIP -L. -o $EXE $RES';
DllCmd[1]:='ld $OPT -shared -L. -o $EXE $RES';
DllCmd[2]:='strip --strip-unneeded $EXE';
{ first try glibc2 }
DynamicLinker:='/lib/ld-linux.so.2';
if FileExists(DynamicLinker) then
begin
Glibc2:=true;
{ also glibc 2.1 / 2.1.1 / 2.1.2 ? }
if FileExists('/lib/ld-2.1.so') or
FileExists('/lib/ld-2.1.1.so') or
FileExists('/lib/ld-2.1.2.so') then
Glibc21:=true;
end
else
DynamicLinker:='/lib/ld-linux.so.1';
end;
end;
Function TLinkerLinux.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
cprtobj,
gprtobj,
prtobj : string[80];
s,s2 : string;
found,
linkdynamic,
linklibc : boolean;
begin
WriteResponseFile:=False;
{ set special options for some targets }
linkdynamic:=not(SharedLibFiles.empty);
linklibc:=SharedLibFiles.Find('c');
prtobj:='prt0';
cprtobj:='cprt0';
gprtobj:='gprt0';
if glibc21 then
begin
cprtobj:='cprt21';
gprtobj:='gprt21';
end;
if cs_profile in aktmoduleswitches then
begin
prtobj:=gprtobj;
if not glibc2 then
AddSharedLibrary('gmon');
AddSharedLibrary('c');
linklibc:=true;
end
else
begin
if linklibc then
prtobj:=cprtobj;
end;
{ Open link.res file }
LinkRes.Init(Info.ResName);
{ Write path to search libraries }
if assigned(current_module^.locallibrarysearchpath) then
begin
S:=current_module^.locallibrarysearchpath^;
while s<>'' do
begin
s2:=GetPathFromList(s);
LinkRes.Add('SEARCH_DIR('+s2+')');
end;
end;
S:=LibrarySearchPath;
while s<>'' do
begin
s2:=GetPathFromList(s);
LinkRes.Add('SEARCH_DIR('+s2+')');
end;
LinkRes.Add('INPUT(');
{ add objectfiles, start with prt0 always }
if prtobj<>'' then
LinkRes.AddFileName(FindObjectFile(prtobj));
{ try to add crti and crtbegin, they are normally not required, but
adding can sometimes be usefull }
s:=search('crtbegin.o',librarysearchpath,found)+'crtbegin.o';
if found then
LinkRes.AddFileName(s);
s:=search('crti.o',librarysearchpath,found)+'crti.o';
if found then
LinkRes.AddFileName(s);
{ main objectfiles }
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.Get;
if s<>'' then
LinkRes.AddFileName(s);
end;
{ objects which must be at the end }
s:=search('crtend.o',librarysearchpath,found)+'crtend.o';
if found then
LinkRes.AddFileName(s);
s:=search('crtn.o',librarysearchpath,found)+'crtn.o';
if found then
LinkRes.AddFileName(s);
{ 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) }
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
linklibc:=true;
linkdynamic:=false; { libc will include the ld-linux for us }
end;
end;
{ be sure that libc is the last lib }
if linklibc then
LinkRes.Add('-lc');
if linkdynamic and (Info.DynamicLinker<>'') then
LinkRes.AddFileName(Info.DynamicLinker);
LinkRes.Add(')');
{ Write staticlibraries }
if not StaticLibFiles.Empty then
begin
LinkRes.Add('GROUP(');
While not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.Get;
LinkRes.AddFileName(s)
end;
LinkRes.Add(')');
end;
{ Write and Close response }
linkres.writetodisk;
linkres.done;
WriteResponseFile:=True;
end;
function TLinkerLinux.MakeExecutable:boolean;
var
binstr,
cmdstr : string;
success : boolean;
DynLinkStr : string[60];
StripStr : string[40];
begin
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module^.exefilename^);
{ Create some replacements }
StripStr:='';
DynLinkStr:='';
if (cs_link_strip in aktglobalswitches) then
StripStr:='-s';
If (Info.DynamicLinker<>'') and (not SharedLibFiles.Empty) then
DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
{ 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',current_module^.outpath^+Info.ResName);
Replace(cmdstr,'$STRIP',StripStr);
Replace(cmdstr,'$DYNLINK',DynLinkStr);
success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
{ Remove ReponseFile }
if (success) and not(cs_link_extern in aktglobalswitches) then
RemoveFile(current_module^.outpath^+Info.ResName);
MakeExecutable:=success; { otherwise a recursive call to link method }
end;
Function TLinkerLinux.MakeSharedLibrary:boolean;
var
binstr,
cmdstr : string;
success : boolean;
begin
MakeSharedLibrary:=false;
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module^.sharedlibfilename^);
{ Write used files and libraries }
WriteResponseFile(true);
{ Call linker }
SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
Replace(cmdstr,'$EXE',current_module^.sharedlibfilename^);
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$RES',current_module^.outpath^+Info.ResName);
success:=DoExec(FindUtil(binstr),cmdstr,true,false);
{ Strip the library ? }
if success and (cs_link_strip in aktglobalswitches) then
begin
SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
Replace(cmdstr,'$EXE',current_module^.sharedlibfilename^);
success:=DoExec(FindUtil(binstr),cmdstr,true,false);
end;
{ Remove ReponseFile }
if (success) and not(cs_link_extern in aktglobalswitches) then
RemoveFile(current_module^.outpath^+Info.ResName);
MakeSharedLibrary:=success; { otherwise a recursive call to link method }
end;
end.
{
$Log$
Revision 1.1 1999-10-21 14:29:38 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
}

206
compiler/os2_targ.pas → compiler/t_os2.pas
View File

@ -28,10 +28,11 @@
port, please send questions to Daniel Mantione
<d.s.p.mantione@twi.tudelft.nl>.
}
unit os2_targ;
unit t_os2;
interface
uses import;
uses
import,link;
type
pimportlibos2=^timportlibos2;
@ -41,6 +42,17 @@ type
procedure generatelib;virtual;
end;
plinkeros2=^tlinkeros2;
tlinkeros2=object(tlinker)
private
Function WriteResponseFile(isdll:boolean) : Boolean;
public
constructor Init;
procedure SetDefaultInfo;virtual;
function MakeExecutable:boolean;virtual;
end;
{***************************************************************************}
{***************************************************************************}
@ -53,8 +65,8 @@ implementation
{$else Delphi}
dos,
{$endif Delphi}
globtype,strings,comphook,
globals,link,files;
globtype,strings,comphook,systems,
globals,verbose,files,script;
const profile_flag:boolean=false;
@ -331,49 +343,155 @@ begin
end;
{****************************************************************************
TLinkeros2
****************************************************************************}
Constructor TLinkeros2.Init;
begin
Inherited Init;
{ allow duplicated libs (PM) }
SharedLibFiles.doubles:=true;
StaticLibFiles.doubles:=true;
end;
procedure TLinkeros2.SetDefaultInfo;
begin
with Info do
begin
ExeCmd[1]:='ld -o $EXE @$RES';
ExeCmd[2]:='emxbind -b $STRIP$PM -k$STACKKB -h$HEAPMB -o $EXE.exe $EXE -aim -s$DOSHEAPKB';
end;
end;
Function TLinkeros2.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
s,s2 : string;
begin
WriteResponseFile:=False;
{ Open link.res file }
LinkRes.Init(Info.ResName);
{ Write path to search libraries }
if assigned(current_module^.locallibrarysearchpath) then
begin
S:=current_module^.locallibrarysearchpath^;
while s<>'' do
begin
s2:=GetPathFromList(s);
LinkRes.Add('-L'+s2);
end;
end;
S:=LibrarySearchPath;
while s<>'' do
begin
s2:=GetPathFromList(s);
LinkRes.Add('-L'+s2);
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 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) }
While not SharedLibFiles.Empty do
begin
S:=SharedLibFiles.Get;
i:=Pos(target_os.sharedlibext,S);
if i>0 then
Delete(S,i,255);
LinkRes.Add('-l'+s);
end;
{ Write staticlibraries }
if not StaticLibFiles.Empty then
begin
While not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.Get;
LinkRes.AddFileName(s)
end;
end;
{ Write and Close response }
linkres.writetodisk;
linkres.done;
WriteResponseFile:=True;
end;
function TLinkeros2.MakeExecutable:boolean;
var
binstr,
cmdstr : string;
success : boolean;
i : longint;
PMStr,
StripStr : string[40];
begin
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module^.exefilename^);
{ Create some replacements }
StripStr:='';
PMStr:='';
if (cs_link_strip in aktglobalswitches) then
StripStr:='-s';
if usewindowapi then
PMStr:='-p';
{ Write used files and libraries }
WriteResponseFile(false);
{ Call linker }
success:=false;
for i:=1to 2 do
begin
SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
if binstr<>'' then
begin
Replace(cmdstr,'$EXE',current_module^.exefilename^);
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$RES',current_module^.outpath^+Info.ResName);
Replace(cmdstr,'$STRIP',StripStr);
Replace(cmdstr,'$HEAPMB',tostr((maxheapsize+1048575) shr 20));
{Size of the stack when an EMX program runs in OS/2.}
Replace(cmdstr,'$STACKKB',tostr((stacksize+1023) shr 10));
{When an EMX program runs in DOS, the heap and stack share the
same memory pool. The heap grows upwards, the stack grows downwards.}
Replace(cmdstr,'$DOSHEAPKB',tostr((stacksize+maxheapsize+1023) shr 10));
Replace(cmdstr,'$PM',PMStr);
success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
if not success then
break;
end;
end;
{ Remove ReponseFile }
if (success) and not(cs_link_extern in aktglobalswitches) then
RemoveFile(current_module^.outpath^+Info.ResName);
MakeExecutable:=success; { otherwise a recursive call to link method }
end;
end.
{
$Log$
Revision 1.11 1999-09-20 16:38:59 peter
* cs_create_smart instead of cs_smartlink
* -CX is create smartlink
* -CD is create dynamic, but does nothing atm.
Revision 1.10 1999/09/07 15:05:19 pierre
* use do_halt instead of runerror
Revision 1.9 1999/07/18 10:19:58 florian
* made it compilable with Dlephi 4 again
+ fixed problem with large stack allocations on win32
Revision 1.8 1999/07/03 00:29:55 peter
* new link writing to the ppu, one .ppu is needed for all link types,
static (.o) is now always created also when smartlinking is used
Revision 1.7 1999/05/04 21:44:52 florian
* changes to compile it with Delphi 4.0
Revision 1.6 1998/12/11 00:03:25 peter
+ globtype,tokens,version unit splitted from globals
Revision 1.5 1998/10/16 14:20:53 daniel
* Faster keyword scanning.
* Import library and smartlink library in one file.
Revision 1.4 1998/06/17 14:10:14 peter
* small os2 fixes
* fixed interdependent units with newppu (remake3 under linux works now)
Revision 1.3 1998/06/04 23:51:48 peter
* m68k compiles
+ .def file creation moved to gendef.pas so it could also be used
for win32
Revision 1.2 1998/05/04 17:54:27 peter
+ smartlinking works (only case jumptable left todo)
* redesign of systems.pas to support assemblers and linkers
+ Unitname is now also in the PPU-file, increased version to 14
Revision 1.1 1999-10-21 14:29:38 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
}

784
compiler/win_targ.pas → compiler/t_win32.pas
View File

@ -1,9 +1,9 @@
{
$Id$
Copyright (c) 1998 by Florian Klaempfl
Copyright (c) 1999 by Peter Vreman
This unit implements some support routines for the win32 target like
import/export handling
This unit implements support import,export,link routines
for the (i386) Win32 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
@ -21,7 +21,7 @@
****************************************************************************
}
unit win_targ;
unit t_win32;
interface
@ -52,14 +52,21 @@ unit win_targ;
plinkerwin32=^tlinkerwin32;
tlinkerwin32=object(tlinker)
procedure postprocessexecutable(const n : string);virtual;
private
Function WriteResponseFile(isdll:boolean) : Boolean;
Function PostProcessExecutable(const fn:string;isdll:boolean) : Boolean;
public
Procedure SetDefaultInfo;virtual;
function MakeExecutable:boolean;virtual;
function MakeSharedLibrary:boolean;virtual;
end;
implementation
uses
aasm,files,strings,globtype,globals,cobjects,systems,verbose,
aasm,files,globtype,globals,cobjects,systems,verbose,
script,gendef,
cpubase,cpuasm
{$ifdef GDB}
,gdb
@ -75,21 +82,25 @@ unit win_targ;
else
DllName:=Name+target_os.sharedlibext;
end;
procedure timportlibwin32.preparelib(const s : string);
{*****************************************************************************
TIMPORTLIBWIN32
*****************************************************************************}
procedure timportlibwin32.preparelib(const s : string);
begin
if not(assigned(importssection)) then
importssection:=new(paasmoutput,init);
end;
procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
var
hp1 : pimportlist;
hp2 : pimported_item;
hs : string;
begin
{ that IS wrong for DRV files
hs:=SplitName(module); }
hs:=DllName(module);
{ search for the module }
hp1:=pimportlist(current_module^.imports^.first);
@ -366,8 +377,12 @@ unit win_targ;
end;
end;
procedure texportlibwin32.preparelib(const s:string);
{*****************************************************************************
TEXPORTLIBWIN32
*****************************************************************************}
procedure texportlibwin32.preparelib(const s:string);
begin
if not(assigned(exportssection)) then
exportssection:=new(paasmoutput,init);
@ -384,22 +399,27 @@ unit win_targ;
procedure texportlibwin32.exportprocedure(hp : pexported_item);
{ must be ordered at least for win32 !! }
var hp2 : pexported_item;
begin
hp2:=pexported_item(current_module^._exports^.first);
var
hp2 : pexported_item;
begin
{ first test the index value }
if (hp^.options and eo_index)<>0 then
begin
if (hp^.index<=0) or (hp^.index>$ffff) then
message1(parser_e_export_invalid_index,tostr(hp^.index))
else while assigned(hp2) do
begin
message1(parser_e_export_invalid_index,tostr(hp^.index));
exit;
end;
hp2:=pexported_item(current_module^._exports^.first);
while assigned(hp2) do
begin
if (hp^.index=hp2^.index) then
if ((hp2^.options and eo_index)<>0) then
message1(parser_e_export_ordinal_double,tostr(hp^.index))
begin
message1(parser_e_export_ordinal_double,tostr(hp^.index));
exit;
end
else
begin
inc(last_index);
@ -421,7 +441,6 @@ unit win_targ;
hp^.name:=stringdup(hp^.sym^.name);
hp^.options:=hp^.options or eo_name;
end;
{ now place in correct order }
hp2:=pexported_item(current_module^._exports^.first);
while assigned(hp2) and
@ -432,6 +451,7 @@ unit win_targ;
begin
{ this is not allowed !! }
message1(parser_e_export_name_double,hp^.name^);
exit;
end;
if hp2=pexported_item(current_module^._exports^.first) then
current_module^._exports^.insert(hp)
@ -445,11 +465,10 @@ unit win_targ;
end
else
current_module^._exports^.concat(hp);
end;
end;
procedure texportlibwin32.generatelib;
var
ordinal_base,ordinal_max,ordinal_min : longint;
current_index : longint;
@ -460,7 +479,6 @@ unit win_targ;
tempexport : plinkedlist;
address_table,name_table_pointers,
name_table,ordinal_table : paasmoutput;
begin
ordinal_max:=0;
ordinal_min:=$7FFFFFFF;
@ -579,8 +597,6 @@ unit win_targ;
hp:=pexported_item(current_module^._exports^.first);;
end;
{ write the export adress table }
current_index:=ordinal_base;
hp:=pexported_item(tempexport^.first);
@ -610,320 +626,430 @@ unit win_targ;
{****************************************************************************
Postprocess Executable
TLINKERWIN32
****************************************************************************}
procedure tlinkerwin32.postprocessexecutable(const n : string);
type
tdosheader = packed record
e_magic : word;
e_cblp : word;
e_cp : word;
e_crlc : word;
e_cparhdr : word;
e_minalloc : word;
e_maxalloc : word;
e_ss : word;
e_sp : word;
e_csum : word;
e_ip : word;
e_cs : word;
e_lfarlc : word;
e_ovno : word;
e_res : array[0..3] of word;
e_oemid : word;
e_oeminfo : word;
e_res2 : array[0..9] of word;
e_lfanew : longint;
end;
Procedure TLinkerWin32.SetDefaultInfo;
begin
with Info do
begin
ExeCmd[1]:='ldw $OPT $STRIP $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES';
DllCmd[1]:='ldw $OPT --dll $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES';
DllCmd[2]:='dlltool --as asw.exe --dllname $EXE --output-exp exp.$$$ $RELOC -d $DEF';
DllCmd[3]:='ldw $OPT $STRIP --dll $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$';
end;
end;
tpeheader = packed record
PEMagic : array[0..3] of char;
Machine : word;
NumberOfSections : word;
TimeDateStamp : longint;
PointerToSymbolTable : longint;
NumberOfSymbols : longint;
SizeOfOptionalHeader : word;
Characteristics : word;
Magic : word;
MajorLinkerVersion : byte;
MinorLinkerVersion : byte;
SizeOfCode : longint;
SizeOfInitializedData : longint;
SizeOfUninitializedData : longint;
AddressOfEntryPoint : longint;
BaseOfCode : longint;
BaseOfData : longint;
ImageBase : longint;
SectionAlignment : longint;
FileAlignment : longint;
MajorOperatingSystemVersion : word;
MinorOperatingSystemVersion : word;
MajorImageVersion : word;
MinorImageVersion : word;
MajorSubsystemVersion : word;
MinorSubsystemVersion : word;
Reserved1 : longint;
SizeOfImage : longint;
SizeOfHeaders : longint;
CheckSum : longint;
Subsystem : word;
DllCharacteristics : word;
SizeOfStackReserve : longint;
SizeOfStackCommit : longint;
SizeOfHeapReserve : longint;
SizeOfHeapCommit : longint;
LoaderFlags : longint;
NumberOfRvaAndSizes : longint;
DataDirectory : array[1..$80] of byte;
end;
tcoffsechdr=packed record
name : array[0..7] of char;
vsize : longint;
rvaofs : longint;
datalen : longint;
datapos : longint;
relocpos : longint;
lineno1 : longint;
nrelocs : word;
lineno2 : word;
flags : longint;
end;
psecfill=^tsecfill;
tsecfill=record
fillpos,
fillsize : longint;
next : psecfill;
end;
var
f : file;
dosheader : tdosheader;
peheader : tpeheader;
firstsecpos,
maxfillsize,
l,peheaderpos : longint;
coffsec : tcoffsechdr;
secroot,hsecroot : psecfill;
zerobuf : pointer;
Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
Var
linkres : TLinkRes;
i : longint;
s,s2 : string;
linklibc : boolean;
begin
WriteResponseFile:=False;
{ Open link.res file }
LinkRes.Init(Info.ResName);
{ Write path to search libraries }
if assigned(current_module^.locallibrarysearchpath) then
begin
S:=current_module^.locallibrarysearchpath^;
while s<>'' do
begin
{ when -s is used quit, because there is no .exe }
if cs_link_extern in aktglobalswitches then
exit;
{ open file }
assign(f,n);
{$I-}
reset(f,1);
if ioresult<>0 then
Message1(execinfo_f_cant_open_executable,n);
{ read headers }
blockread(f,dosheader,sizeof(tdosheader));
peheaderpos:=dosheader.e_lfanew;
seek(f,peheaderpos);
blockread(f,peheader,sizeof(tpeheader));
{ write info }
Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
{ change stack size (PM) }
{ I am not sure that the default value is adequate !! }
peheader.SizeOfStackReserve:=stacksize;
{ change the header }
{ sub system }
{ gui=2 }
{ cui=3 }
if apptype=at_gui then
peheader.Subsystem:=2
else if apptype=at_cui then
peheader.Subsystem:=3;
seek(f,peheaderpos);
blockwrite(f,peheader,sizeof(tpeheader));
if ioresult<>0 then
Message1(execinfo_f_cant_process_executable,n);
seek(f,peheaderpos);
blockread(f,peheader,sizeof(tpeheader));
{ write the value after the change }
Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
{ read section info }
maxfillsize:=0;
firstsecpos:=0;
secroot:=nil;
for l:=1to peheader.NumberOfSections do
begin
blockread(f,coffsec,sizeof(tcoffsechdr));
if coffsec.datapos>0 then
begin
if secroot=nil then
firstsecpos:=coffsec.datapos;
new(hsecroot);
hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
hsecroot^.next:=secroot;
secroot:=hsecroot;
if secroot^.fillsize>maxfillsize then
maxfillsize:=secroot^.fillsize;
end;
end;
if firstsecpos>0 then
begin
l:=firstsecpos-filepos(f);
if l>maxfillsize then
maxfillsize:=l;
end
else
l:=0;
{ get zero buffer }
getmem(zerobuf,maxfillsize);
fillchar(zerobuf^,maxfillsize,0);
{ zero from sectioninfo until first section }
blockwrite(f,zerobuf^,l);
{ zero section alignments }
while assigned(secroot) do
begin
seek(f,secroot^.fillpos);
blockwrite(f,zerobuf^,secroot^.fillsize);
hsecroot:=secroot;
secroot:=secroot^.next;
dispose(hsecroot);
end;
freemem(zerobuf,maxfillsize);
close(f);
{$I+}
s2:=GetPathFromList(s);
LinkRes.Add('SEARCH_DIR('+s2+')');
end;
end;
S:=LibrarySearchPath;
while s<>'' do
begin
s2:=GetPathFromList(s);
LinkRes.Add('SEARCH_DIR('+s2+')');
end;
{ add objectfiles, start with prt0 always }
LinkRes.Add('INPUT(');
if isdll then
LinkRes.AddFileName(FindObjectFile('wdllprt0'))
else
LinkRes.AddFileName(FindObjectFile('wprt0'));
while not ObjectFiles.Empty do
begin
s:=ObjectFiles.Get;
if s<>'' then
LinkRes.AddFileName(s);
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) }
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 is the last lib }
if linklibc then
LinkRes.Add('-lc');
LinkRes.Add(')');
{ Write staticlibraries }
if not StaticLibFiles.Empty then
begin
LinkRes.Add('GROUP(');
While not StaticLibFiles.Empty do
begin
S:=StaticLibFiles.Get;
LinkRes.AddFileName(s)
end;
LinkRes.Add(')');
end;
{ Write and Close response }
linkres.writetodisk;
linkres.done;
WriteResponseFile:=True;
end;
function TLinkerWin32.MakeExecutable:boolean;
var
binstr,
cmdstr : string;
success : boolean;
i : longint;
StripStr,
RelocStr,
AppTypeStr,
ImageBaseStr : string[40];
begin
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module^.exefilename^);
{ Create some replacements }
RelocStr:='';
AppTypeStr:='';
ImageBaseStr:='';
StripStr:='';
if RelocSection then
RelocStr:='--base-file base.$$$';
if apptype=at_gui then
AppTypeStr:='--subsystem windows';
if assigned(DLLImageBase) then
ImageBaseStr:='--image-base=0x'+DLLImageBase^;
if (cs_link_strip in aktglobalswitches) then
StripStr:='-s';
{ Write used files and libraries }
WriteResponseFile(false);
{ Call linker }
success:=false;
for i:=1to 1 do
begin
SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
if binstr<>'' then
begin
Replace(cmdstr,'$EXE',current_module^.exefilename^);
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$RES',current_module^.outpath^+Info.ResName);
Replace(cmdstr,'$APPTYPE',AppTypeStr);
Replace(cmdstr,'$RELOC',RelocStr);
Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
Replace(cmdstr,'$STRIP',StripStr);
success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
if not success then
break;
end;
end;
{ Post process }
if success then
success:=PostProcessExecutable(current_module^.exefilename^,false);
{ Remove ReponseFile }
if (success) and not(cs_link_extern in aktglobalswitches) then
begin
RemoveFile(current_module^.outpath^+Info.ResName);
RemoveFile('base.$$$');
RemoveFile('exp.$$$');
end;
MakeExecutable:=success; { otherwise a recursive call to link method }
end;
Function TLinkerWin32.MakeSharedLibrary:boolean;
var
binstr,
cmdstr : string;
success : boolean;
i : longint;
StripStr,
RelocStr,
AppTypeStr,
ImageBaseStr : string[40];
begin
MakeSharedLibrary:=false;
if not(cs_link_extern in aktglobalswitches) then
Message1(exec_i_linking,current_module^.sharedlibfilename^);
{ Create some replacements }
RelocStr:='';
AppTypeStr:='';
ImageBaseStr:='';
StripStr:='';
if RelocSection then
RelocStr:='--base-file base.$$$';
if apptype=at_gui then
AppTypeStr:='--subsystem windows';
if assigned(DLLImageBase) then
ImageBaseStr:='--image-base=0x'+DLLImageBase^;
if (cs_link_strip in aktglobalswitches) then
StripStr:='-s';
{ Write used files and libraries }
WriteResponseFile(true);
{ Call linker }
success:=false;
for i:=1to 3 do
begin
SplitBinCmd(Info.DllCmd[i],binstr,cmdstr);
if binstr<>'' then
begin
Replace(cmdstr,'$EXE',current_module^.sharedlibfilename^);
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$RES',current_module^.outpath^+Info.ResName);
Replace(cmdstr,'$APPTYPE',AppTypeStr);
Replace(cmdstr,'$RELOC',RelocStr);
Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
Replace(cmdstr,'$STRIP',StripStr);
Replace(cmdstr,'$DEF',deffile.fname);
success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
if not success then
break;
end;
end;
{ Post process }
if success then
success:=PostProcessExecutable(current_module^.sharedlibfilename^,true);
{ Remove ReponseFile }
if (success) and not(cs_link_extern in aktglobalswitches) then
begin
RemoveFile(current_module^.outpath^+Info.ResName);
RemoveFile('base.$$$');
RemoveFile('exp.$$$');
end;
MakeSharedLibrary:=success; { otherwise a recursive call to link method }
end;
function tlinkerwin32.postprocessexecutable(const fn : string;isdll:boolean):boolean;
type
tdosheader = packed record
e_magic : word;
e_cblp : word;
e_cp : word;
e_crlc : word;
e_cparhdr : word;
e_minalloc : word;
e_maxalloc : word;
e_ss : word;
e_sp : word;
e_csum : word;
e_ip : word;
e_cs : word;
e_lfarlc : word;
e_ovno : word;
e_res : array[0..3] of word;
e_oemid : word;
e_oeminfo : word;
e_res2 : array[0..9] of word;
e_lfanew : longint;
end;
tpeheader = packed record
PEMagic : array[0..3] of char;
Machine : word;
NumberOfSections : word;
TimeDateStamp : longint;
PointerToSymbolTable : longint;
NumberOfSymbols : longint;
SizeOfOptionalHeader : word;
Characteristics : word;
Magic : word;
MajorLinkerVersion : byte;
MinorLinkerVersion : byte;
SizeOfCode : longint;
SizeOfInitializedData : longint;
SizeOfUninitializedData : longint;
AddressOfEntryPoint : longint;
BaseOfCode : longint;
BaseOfData : longint;
ImageBase : longint;
SectionAlignment : longint;
FileAlignment : longint;
MajorOperatingSystemVersion : word;
MinorOperatingSystemVersion : word;
MajorImageVersion : word;
MinorImageVersion : word;
MajorSubsystemVersion : word;
MinorSubsystemVersion : word;
Reserved1 : longint;
SizeOfImage : longint;
SizeOfHeaders : longint;
CheckSum : longint;
Subsystem : word;
DllCharacteristics : word;
SizeOfStackReserve : longint;
SizeOfStackCommit : longint;
SizeOfHeapReserve : longint;
SizeOfHeapCommit : longint;
LoaderFlags : longint;
NumberOfRvaAndSizes : longint;
DataDirectory : array[1..$80] of byte;
end;
tcoffsechdr=packed record
name : array[0..7] of char;
vsize : longint;
rvaofs : longint;
datalen : longint;
datapos : longint;
relocpos : longint;
lineno1 : longint;
nrelocs : word;
lineno2 : word;
flags : longint;
end;
psecfill=^tsecfill;
tsecfill=record
fillpos,
fillsize : longint;
next : psecfill;
end;
var
f : file;
dosheader : tdosheader;
peheader : tpeheader;
firstsecpos,
maxfillsize,
i,l,peheaderpos : longint;
coffsec : tcoffsechdr;
secroot,hsecroot : psecfill;
zerobuf : pointer;
begin
postprocessexecutable:=false;
{ when -s is used or it's a dll then quit }
if (cs_link_extern in aktglobalswitches) then
begin
postprocessexecutable:=true;
exit;
end;
{ open file }
assign(f,fn);
{$I-}
reset(f,1);
if ioresult<>0 then
Message1(execinfo_f_cant_open_executable,fn);
{ read headers }
blockread(f,dosheader,sizeof(tdosheader));
peheaderpos:=dosheader.e_lfanew;
seek(f,peheaderpos);
blockread(f,peheader,sizeof(tpeheader));
{ write info }
Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
{ change stack size (PM) }
{ I am not sure that the default value is adequate !! }
peheader.SizeOfStackReserve:=stacksize;
{ change the header }
{ sub system }
{ gui=2 }
{ cui=3 }
if apptype=at_gui then
peheader.Subsystem:=2
else if apptype=at_cui then
peheader.Subsystem:=3;
seek(f,peheaderpos);
blockwrite(f,peheader,sizeof(tpeheader));
if ioresult<>0 then
Message1(execinfo_f_cant_process_executable,fn);
seek(f,peheaderpos);
blockread(f,peheader,sizeof(tpeheader));
{ write the value after the change }
Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
{ read section info }
maxfillsize:=0;
firstsecpos:=0;
secroot:=nil;
for l:=1to peheader.NumberOfSections do
begin
blockread(f,coffsec,sizeof(tcoffsechdr));
if coffsec.datapos>0 then
begin
if secroot=nil then
firstsecpos:=coffsec.datapos;
new(hsecroot);
hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
hsecroot^.next:=secroot;
secroot:=hsecroot;
if secroot^.fillsize>maxfillsize then
maxfillsize:=secroot^.fillsize;
end;
end;
if firstsecpos>0 then
begin
l:=firstsecpos-filepos(f);
if l>maxfillsize then
maxfillsize:=l;
end
else
l:=0;
{ get zero buffer }
getmem(zerobuf,maxfillsize);
fillchar(zerobuf^,maxfillsize,0);
{ zero from sectioninfo until first section }
blockwrite(f,zerobuf^,l);
{ zero section alignments }
while assigned(secroot) do
begin
seek(f,secroot^.fillpos);
blockwrite(f,zerobuf^,secroot^.fillsize);
hsecroot:=secroot;
secroot:=secroot^.next;
dispose(hsecroot);
end;
freemem(zerobuf,maxfillsize);
close(f);
{$I+}
i:=ioresult;
postprocessexecutable:=true;
end;
end.
{
$Log$
Revision 1.34 1999-09-20 16:39:04 peter
* cs_create_smart instead of cs_smartlink
* -CX is create smartlink
* -CD is create dynamic, but does nothing atm.
Revision 1.33 1999/08/25 12:00:07 jonas
* changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
Revision 1.32 1999/08/11 17:26:38 peter
* tlinker object is now inherited for win32 and dos
* postprocessexecutable is now a method of tlinker
Revision 1.31 1999/08/04 00:23:50 florian
* renamed i386asm and i386base to cpuasm and cpubase
Revision 1.30 1999/07/29 20:54:11 peter
* write .size also
Revision 1.29 1999/07/22 16:12:28 peter
* merged
Revision 1.28 1999/07/18 10:20:03 florian
* made it compilable with Dlephi 4 again
+ fixed problem with large stack allocations on win32
Revision 1.27.2.1 1999/07/22 16:09:30 peter
* reuse old import entries
Revision 1.27 1999/05/27 19:45:30 peter
* removed oldasm
* plabel -> pasmlabel
* -a switches to source writing automaticly
* assembler readers OOPed
* asmsymbol automaticly external
* jumptables and other label fixes for asm readers
Revision 1.26 1999/05/21 13:55:24 peter
* NEWLAB for label as symbol
Revision 1.25 1999/05/17 13:02:13 pierre
* -Csmmm works for win32 but default is set to 32Mb
Revision 1.24 1999/05/01 13:25:04 peter
* merged nasm compiler
* old asm moved to oldasm/
Revision 1.23 1999/04/07 14:18:32 pierre
* typo correction
Revision 1.22 1999/04/07 14:04:40 pierre
* adds .dll as library suffix only if
the name does not end with .dll .drv or .exe !
Revision 1.21 1999/02/25 21:02:59 peter
* ag386bin updates
+ coff writer
Revision 1.20 1999/02/22 02:44:14 peter
* ag386bin doesn't use i386.pas anymore
Revision 1.19 1998/12/11 00:04:06 peter
+ globtype,tokens,version unit splitted from globals
Revision 1.18 1998/12/02 10:26:13 pierre
* writing of .edata was wrong for indexes above number of exported items
* importing by index only did not work !
Revision 1.17 1998/12/01 23:35:43 pierre
* alignment fixes
Revision 1.16 1998/11/30 13:26:26 pierre
* the code for ordering the exported procs/vars was buggy
+ added -WB to force binding (Ozerski way of creating DLL)
this is off by default as direct writing of .edata section seems
OK
Revision 1.15 1998/11/30 09:43:25 pierre
* some range check bugs fixed (still not working !)
+ added DLL writing support for win32 (also accepts variables)
+ TempAnsi for code that could be used for Temporary ansi strings
handling
Revision 1.14 1998/11/28 16:21:00 peter
+ support for dll variables
Revision 1.13 1998/10/29 11:35:54 florian
* some dll support for win32
* fixed assembler writing for PalmOS
Revision 1.12 1998/10/27 10:22:35 florian
+ First things for win32 export sections
Revision 1.11 1998/10/22 17:54:09 florian
+ switch $APPTYPE for win32 added
Revision 1.10 1998/10/22 15:18:51 florian
+ switch -vx for win32 added
Revision 1.9 1998/10/19 15:41:03 peter
* better splitname to support glib-1.1.dll alike names
Revision 1.8 1998/09/07 18:33:35 peter
+ smartlinking for win95 imports
Revision 1.7 1998/09/03 17:39:06 florian
+ better code for type conversation longint/dword to real type
Revision 1.6 1998/08/10 14:50:38 peter
+ localswitches, moduleswitches, globalswitches splitting
Revision 1.5 1998/06/10 10:43:18 peter
* write also the .dll extension (needed for NT)
Revision 1.4 1998/06/08 22:59:56 peter
* smartlinking works for win32
* some defines to exclude some compiler parts
Revision 1.3 1998/06/04 23:52:06 peter
* m68k compiles
+ .def file creation moved to gendef.pas so it could also be used
for win32
Revision 1.2 1998/05/06 18:36:55 peter
* tai_section extended with code,data,bss sections and enumerated type
* ident 'compiled by FPC' moved to pmodules
* small fix for smartlink
Revision 1.1 1999-10-21 14:29:38 peter
* redesigned linker object
+ library support for linux (only procedures can be exported)
}