diff options
Diffstat (limited to 'compiler/systems')
37 files changed, 11338 insertions, 0 deletions
diff --git a/compiler/systems/i_amiga.pas b/compiler/systems/i_amiga.pas new file mode 100644 index 0000000000..139eff7cfd --- /dev/null +++ b/compiler/systems/i_amiga.pas @@ -0,0 +1,169 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for AmigaOS + + 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. + **************************************************************************** +} +{ This unit implements support information structures for the AmigaOS. } +unit i_amiga; + + interface + + uses + systems; + + const + system_m68k_amiga_info : tsysteminfo = + ( + system : system_m68k_Amiga; + name : 'Commodore Amiga'; + shortname : 'amiga'; + flags : []; + cpu : cpu_m68k; + unit_env : ''; + extradefines : ''; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.library'; + staticlibext : '.a'; + staticlibprefix : 'lib'; + sharedlibprefix : ''; + sharedClibext : '.library'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_amiga; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_default; + ); + + system_powerpc_amiga_info : tsysteminfo = + ( + system : system_powerpc_Amiga; + name : 'AmigaOS for PowerPC'; + shortname : 'amigappc'; + flags : []; + cpu : cpu_powerpc; + unit_env : ''; + extradefines : ''; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.library'; + staticlibext : '.a'; + staticlibprefix : 'lib'; + sharedlibprefix : ''; + sharedClibext : '.library'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_amiga; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_powerpc_sysv; + ); + + implementation + +initialization +{$ifdef CPU68} + {$ifdef AMIGA} + set_source_info(system_m68k_Amiga_info); + {$endif AMIGA} +{$endif CPU68} +{$ifdef CPUPOWERPC} + {$ifdef AMIGA} +// set_source_info(system_powerpc_Amiga_info); + {$endif AMIGA} +{$endif CPUPOWERPC} +end. diff --git a/compiler/systems/i_atari.pas b/compiler/systems/i_atari.pas new file mode 100644 index 0000000000..9ecbcab126 --- /dev/null +++ b/compiler/systems/i_atari.pas @@ -0,0 +1,83 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for atari + + 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. + **************************************************************************** +} +{ This unit implements support information structures for atari. } +unit i_atari; + + interface + + uses + systems; + + const + system_m68k_atari_info : tsysteminfo = + ( + system : target_m68k_Atari; + name : 'Atari ST/STE'; + shortname : 'atari'; + flags : [tf_use_8_3]; + cpu : cpu_m68k; + short_name : 'ATARI'; + unit_env : ''; + extradefines : ''; + sharedlibext : '.dll'; + staticlibext : '.a'; + exeext : '.tpp'; + defext : ''; + scriptext : ''; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + staticlibprefix : ''; + sharedlibprefix : ''; + p_ext_support : false; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : ld_m68k_atari; + linkextern : ld_m68k_atari; + ar : ar_m68k_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + stackalignment : 2; + maxCrecordalignment : 4; + stacksize : 8192; + DllScanSupported:false; + use_function_relative_addresses : false + ); + + implementation + +initialization +{$ifdef cpu68} + {$ifdef atari} + set_source_info(system_m68k_atari_info); + {$endif atari} +{$endif cpu68} +end. diff --git a/compiler/systems/i_beos.pas b/compiler/systems/i_beos.pas new file mode 100644 index 0000000000..b10777a401 --- /dev/null +++ b/compiler/systems/i_beos.pas @@ -0,0 +1,100 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for BeOS + + 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. + **************************************************************************** +} +{ This unit implements support information structures for BeOS. } +unit i_beos; + + interface + + uses + systems; + + const + system_i386_beos_info : tsysteminfo = + ( + system : system_i386_BeOS; + name : 'Beos for i386'; + shortname : 'Beos'; + flags : [tf_under_development,tf_needs_symbol_size]; + cpu : cpu_i386; + unit_env : 'BEOSUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 8192; + DllScanSupported:false; + use_function_relative_addresses : true + ); + + implementation + +initialization +{$ifdef cpu86} + {$ifdef beos} + set_source_info(system_i386_beos_info); + {$endif beos} +{$endif cpu86} +end. diff --git a/compiler/systems/i_bsd.pas b/compiler/systems/i_bsd.pas new file mode 100644 index 0000000000..4ed3c183df --- /dev/null +++ b/compiler/systems/i_bsd.pas @@ -0,0 +1,572 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for FreeBSD/NetBSD + + 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. + **************************************************************************** +} +{ This unit implements support information structures for FreeBSD/NetBSD. + OpenBSD is only added for i386 for now, though it exists for most + other common CPU's too} + +unit i_bsd; + + interface + + uses + systems; + + const + system_i386_freebsd_info : tsysteminfo = + ( + system : system_i386_FreeBSD; + name : 'FreeBSD/ELF for i386'; + shortname : 'FreeBSD'; + flags : [tf_pic_uses_got]; + cpu : cpu_i386; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true + ); + + + system_x86_64_freebsd_info : tsysteminfo = + ( + system : system_x86_64_freebsd; + name : 'FreeBSD for x86-64'; + shortname : 'FreeBSD'; + flags : [tf_needs_symbol_size,tf_pic_uses_got{,tf_smartlink_sections}]; + cpu : cpu_x86_64; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 8; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 8 + ); + first_parm_offset : 16; + stacksize : 256*1024; + DllScanSupported:false; + use_function_relative_addresses : true + ); + + + system_i386_netbsd_info : tsysteminfo = + ( + system : system_i386_NetBSD; + name : 'NetBSD for i386'; + shortname : 'NetBSD'; + flags : [tf_under_development]; + cpu : cpu_i386; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 1; + varalignmin : 0; + varalignmax : 1; + localalignmin : 0; + localalignmax : 1; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true + ); + + system_i386_openbsd_info : tsysteminfo = + ( + system : system_i386_OpenBSD; + name : 'OpenBSD for i386'; + shortname : 'OpenBSD'; + flags : [tf_under_development]; + cpu : cpu_i386; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 1; + varalignmin : 0; + varalignmax : 1; + localalignmin : 0; + localalignmax : 1; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true + ); + + system_m68k_netbsd_info : tsysteminfo = + ( + system : system_m68k_NetBSD; + name : 'NetBSD for m68k'; + shortname : 'NetBSD'; + flags : [tf_under_development]; + cpu : cpu_m68k; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 1; + varalignmin : 0; + varalignmax : 1; + localalignmin : 0; + localalignmax : 1; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true + ); + + system_powerpc_netbsd_info : tsysteminfo = + ( + system : system_powerpc_netbsd; + name : 'NetBSD for PowerPC'; + shortname : 'NetBSD'; + flags : [tf_under_development]; + cpu : cpu_powerpc; + unit_env : ''; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.s'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 // should be 8 probably + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + DllScanSupported:false; + use_function_relative_addresses : true; + { abi_powerpc_sysv doesn't work yet } + abi : abi_powerpc_aix; + ); + + + system_powerpc_darwin_info : tsysteminfo = + ( + system : system_powerpc_darwin; + name : 'Darwin for PowerPC'; + shortname : 'Darwin'; + flags : []; + cpu : cpu_powerpc; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dylib'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.dylib'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : true; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_darwin; + assemextern : as_darwin; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 24; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : false; + abi : abi_powerpc_aix; + ); + + + + system_i386_darwin_info : tsysteminfo = + ( + system : system_i386_darwin; + name : 'Darwin for i386'; + shortname : 'Darwin'; + flags : []; + cpu : cpu_i386; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dylib'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.dylib'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : true; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_darwin; + assemextern : as_darwin; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true; + ); + + implementation + +initialization +{$ifdef cpu86} + {$ifdef FreeBSD} + set_source_info(system_i386_FreeBSD_info); + {$endif} + {$ifdef NetBSD} + set_source_info(system_i386_NetBSD_info); + {$endif} + {$ifdef OpenBSD} + set_source_info(system_i386_NetBSD_info); + {$endif} + {$ifdef Darwin} + set_source_info(system_i386_Darwin_info); + {$endif Darwin} +{$endif cpu86} +{$ifdef cpux86_64} + {$ifdef FreeBSD} + set_source_info(system_x86_64_FreeBSD_info); + {$endif} +{$endif} +{$ifdef cpu68} + {$ifdef NetBSD} + set_source_info(system_m68k_NetBSD_info); + {$endif NetBSD} +{$endif cpu68} +{$ifdef cpupowerpc} + {$ifdef Darwin} + set_source_info(system_powerpc_darwin_info); + {$endif Darwin} + {$ifdef NetBSD} + set_source_info(system_powerpc_netbsd_info); + {$endif} +{$endif cpu68} +end. diff --git a/compiler/systems/i_emx.pas b/compiler/systems/i_emx.pas new file mode 100644 index 0000000000..48d8769c64 --- /dev/null +++ b/compiler/systems/i_emx.pas @@ -0,0 +1,114 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for OS/2 via EMX + + 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. + **************************************************************************** +} +{ This unit implements support information structures for OS/2 via EMX. } +unit i_emx; + + interface + + uses + systems; + + const + res_emxbind_info : tresinfo = + ( + id : res_emxbind; + resbin : 'emxbind'; + rescmd : '-b -r $RES $OBJ' + (* Not really used - see TLinkerEMX.SetDefaultInfo in t_emx.pas. *) + ); + + system_i386_emx_info : tsysteminfo = + ( + system : system_i386_EMX; + name : 'OS/2 via EMX'; + shortname : 'EMX'; + flags : [tf_need_export,tf_use_8_3]; + cpu : cpu_i386; + unit_env : 'EMXUNITS'; + extradefines : 'OS2'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.cmd'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : ''; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + files_case_relevent : false; + assem : as_i386_as_aout; + assemextern : as_i386_as_aout; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_emxbind; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 256*1024; + DllScanSupported: false; + use_function_relative_addresses : false + ); + + + implementation + +initialization +{$ifdef CPU86} + {$ifdef EMX} + {$IFNDEF VER1_0} + set_source_info(system_i386_emx_info); + { OS/2 via EMX can be run under DOS as well } + if (OS_Mode=osDOS) or (OS_Mode=osDPMI) then + source_info.scriptext := '.bat'; + {$ENDIF VER1_0} + {$endif EMX} +{$endif CPU86} +end. diff --git a/compiler/systems/i_gba.pas b/compiler/systems/i_gba.pas new file mode 100644 index 0000000000..ef5c1e2013 --- /dev/null +++ b/compiler/systems/i_gba.pas @@ -0,0 +1,101 @@ +{ + This unit implements support information structures for GameBoy Advance + + Copyright (c) 1998-2002 by Peter Vreman + + 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. + **************************************************************************** +} +{ This unit implements support information structures for gba. } +unit i_gba; + + interface + + uses + systems; + + const + system_arm_gba_info : tsysteminfo = + ( + system : system_arm_gba; + name : 'GameBoy Advance'; + shortname : 'gba'; + flags : [tf_needs_symbol_size]; + cpu : cpu_arm; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : '.gba'; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_default + ); + + implementation + +initialization +{$ifdef arm} + {$ifdef gba} + set_source_info(system_arm_gba_info); + {$endif gba} +{$endif arm} +end. diff --git a/compiler/systems/i_go32v2.pas b/compiler/systems/i_go32v2.pas new file mode 100644 index 0000000000..d4989355f4 --- /dev/null +++ b/compiler/systems/i_go32v2.pas @@ -0,0 +1,100 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for go32v2 + + 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. + **************************************************************************** +} +{ This unit implements support information structures for go32v2. } +unit i_go32v2; + + interface + + uses + systems; + + const + system_i386_go32v2_info : tsysteminfo = + ( + system : system_i386_GO32V2; + name : 'GO32 V2 DOS extender'; + shortname : 'Go32v2'; + flags : [tf_use_8_3]; + cpu : cpu_i386; + unit_env : 'GO32V2UNITS'; + extradefines : 'DPMI'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : ''; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + files_case_relevent : false; + assem : as_i386_coff; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported : false; + use_function_relative_addresses : true + ); + + implementation + +initialization +{$ifdef cpu86} + {$ifdef go32v2} + set_source_info(system_i386_go32v2_info); + {$endif go32v2} +{$endif cpu86} +end. diff --git a/compiler/systems/i_linux.pas b/compiler/systems/i_linux.pas new file mode 100644 index 0000000000..b1a7b87da5 --- /dev/null +++ b/compiler/systems/i_linux.pas @@ -0,0 +1,658 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for linux + + 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. + **************************************************************************** +} +{ This unit implements support information structures for linux. } +unit i_linux; + + interface + + uses + systems; + + const + res_elf32_info : tresinfo = + ( + id : res_elf; + resbin : 'fpcres'; + rescmd : '-o $OBJ -i $RES' + ); + + res_elf64_info : tresinfo = + ( + id : res_elf; + resbin : 'fpcres'; + rescmd : '-o $OBJ -i $RES' + ); + + system_i386_linux_info : tsysteminfo = + ( + system : system_i386_LINUX; + name : 'Linux for i386'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_pic_uses_got{,tf_smartlink_sections},tf_needs_symbol_type]; + cpu : cpu_i386; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_default + ); + + system_x86_6432_linux_info : tsysteminfo = + ( + system : system_x86_6432_LINUX; + name : 'Linux for x64_6432'; + shortname : 'Linux6432'; + flags : [tf_needs_symbol_size,tf_pic_uses_got{,tf_smartlink_sections}]; + cpu : cpu_x86_64; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_default + ); + + system_m68k_linux_info : tsysteminfo = + ( + system : system_m68k_linux; + name : 'Linux for m68k'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type]; + cpu : cpu_m68k; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : ''; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_default + ); + + system_powerpc_linux_info : tsysteminfo = + ( + system : system_powerpc_LINUX; + name : 'Linux for PowerPC'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type]; + cpu : cpu_powerpc; + unit_env : ''; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 8 + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_powerpc_sysv; + ); + + system_powerpc64_linux_info : tsysteminfo = + ( + system : system_powerpc64_LINUX; + name : 'Linux for PowerPC64'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type]; + cpu : cpu_powerpc64; + unit_env : ''; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 8; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 8 + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_default + ); + + system_alpha_linux_info : tsysteminfo = + ( + system : system_alpha_LINUX; + name : 'Linux for Alpha'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type]; + cpu : cpu_alpha; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_default + ); + + system_x86_64_linux_info : tsysteminfo = + ( + system : system_x86_64_LINUX; + name : 'Linux for x86-64'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_dwarf_cfi, + tf_library_needs_pic,tf_needs_symbol_type]; + cpu : cpu_x86_64; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 8; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 8 + ); + first_parm_offset : 16; + stacksize : 256*1024; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_default + ); + + system_sparc_linux_info : tsysteminfo = + ( + system : system_SPARC_Linux; + name : 'Linux for SPARC'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_library_needs_pic,tf_needs_symbol_type]; + cpu : cpu_SPARC; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 8 + ); + first_parm_offset : 92; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_default + ); + + system_arm_linux_info : tsysteminfo = + ( + system : system_arm_Linux; + name : 'Linux for ARM'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type]; + cpu : cpu_arm; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_default + ); + + implementation + +initialization +{$ifdef CPU86} + {$ifdef linux} + { some FreeBSD versions define linux as well } + {$ifndef FreeBSD} + set_source_info(system_i386_linux_info); + {$endif FreeBSD} + {$endif} +{$endif CPU86} +{$ifdef CPU68} + {$ifdef linux} + set_source_info(system_m68k_linux_info); + {$endif linux} +{$endif CPU68} +{$ifdef CPUX86_64} + {$ifdef linux} + set_source_info(system_x86_64_linux_info); + {$endif linux} +{$endif CPUX86_64} +{$ifdef CPUALPHA} + {$ifdef linux} + set_source_info(system_alpha_linux_info); + {$endif linux} +{$endif CPUALPHA} +{$ifdef CPUSPARC} + {$ifdef linux} + set_source_info(system_sparc_linux_info); + {$endif linux} +{$endif CPUSPARC} +{$ifdef CPUPOWERPC32} + {$ifdef linux} + set_source_info(system_powerpc_linux_info); + {$endif linux} +{$endif CPUPOWERPC32} +{$ifdef CPUPOWERPC64} + {$ifdef linux} + set_source_info(system_powerpc64_linux_info); + {$endif linux} +{$endif CPUPOWERPC64} +{$ifdef CPUARM} + {$ifdef linux} + set_source_info(system_arm_linux_info); + {$endif linux} +{$endif CPUARM} +end. diff --git a/compiler/systems/i_macos.pas b/compiler/systems/i_macos.pas new file mode 100644 index 0000000000..cdc387a841 --- /dev/null +++ b/compiler/systems/i_macos.pas @@ -0,0 +1,100 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for MacOS + + 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. + **************************************************************************** +} +{ This unit implements support information structures for MacOS. } +unit i_macos; + + interface + + uses + systems; + const + system_powerpc_macos_info : tsysteminfo = + ( + system : system_powerpc_MACOS; + name : 'Mac OS for PowerPC'; + shortname : 'MacOS'; + flags : []; + cpu : cpu_powerpc; + unit_env : ''; + extradefines : ''; + exeext : ''; + defext : ''; + scriptext : ''; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : 'Lib'; + staticlibext : 'Lib'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : 'Lib'; + staticClibext : 'Lib'; + staticClibprefix : ''; + sharedClibprefix : ''; + p_ext_support : true; + Cprefix : ''; + newline : #13; + dirsep : ':'; + files_case_relevent : false; + assem : as_powerpc_mpw; + assemextern : as_powerpc_mpw; + link : nil; + linkextern : nil; + ar : ar_mpw_ar; + res : res_powerpc_mpw; + dbg : dbg_stabs; + script : script_mpw; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 8; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_powerpc_aix; + ); + + implementation + +initialization +{$ifdef cpupowerpc} + {$ifdef macos} + set_source_info(system_powerpc_macos_info); + {$endif macos} +{$endif cpupowerpc} +end. diff --git a/compiler/systems/i_morph.pas b/compiler/systems/i_morph.pas new file mode 100644 index 0000000000..a5d7bb1cdb --- /dev/null +++ b/compiler/systems/i_morph.pas @@ -0,0 +1,101 @@ +{ + Copyright (c) 2004 by Free Pascal Development Team + + This unit implements support information structures for MorphOS + + 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. + **************************************************************************** +} +{ This unit implements support information structures for the MorphOS. } +unit i_morph; + + interface + + uses + systems; + + const + system_powerpc_MorphOS_info : tsysteminfo = + ( + system : system_powerpc_MorphOS; + name : 'MorphOS'; + shortname : 'MorphOS'; + flags : []; + cpu : cpu_powerpc; + unit_env : ''; + extradefines : ''; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.library'; + staticlibext : '.a'; + staticlibprefix : 'lib'; + sharedlibprefix : ''; + sharedClibext : '.library'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_amiga; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true; + abi : abi_powerpc_sysv; + ); + + implementation + +initialization +{$ifdef CPUPOWERPC} + {$ifdef MORPHOS} + set_source_info(system_powerpc_MorphOS_info); + {$endif MORPHOS} +{$endif CPUPOWERPC} +end. diff --git a/compiler/systems/i_nwl.pas b/compiler/systems/i_nwl.pas new file mode 100644 index 0000000000..a1abad2f51 --- /dev/null +++ b/compiler/systems/i_nwl.pas @@ -0,0 +1,100 @@ +{ + Copyright (c) 1998-2004 by Peter Vreman + + This unit implements support information structures for Netware (libc) modules + + 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. + ****************************************************************************} + +{ This unit implements support information structures for Netware libc modules. } +unit i_nwl; + + interface + + uses + systems; + + const + system_i386_netwlibc_info : tsysteminfo = + ( + system : system_i386_netwlibc; + name : 'Netware for i386(libc)'; + shortname : 'Netwlibc'; + flags : []; + cpu : cpu_i386; + unit_env : 'NETWLIBCUNITS'; + extradefines : 'NETWARE;NETWARE_LIBC'; + exeext : '.nlm'; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.nlm'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.nlm'; + staticClibext : '.a'; + staticClibprefix : ''; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : ''; + newline : #13#10; + dirsep : '/'; + files_case_relevent : false; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 16384; + DllScanSupported:false; + use_function_relative_addresses : true + ); + + implementation + +initialization +{$ifdef CPU86} + {$ifdef netwlibc} + set_source_info(system_i386_netwlibc_info); + {$endif netwlibc} +{$endif CPU86} +end. diff --git a/compiler/systems/i_nwm.pas b/compiler/systems/i_nwm.pas new file mode 100644 index 0000000000..8880accfed --- /dev/null +++ b/compiler/systems/i_nwm.pas @@ -0,0 +1,100 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for Netware modules + + 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. + **************************************************************************** +} +{ This unit implements support information structures for Netware modules. } +unit i_nwm; + + interface + + uses + systems; + + const + system_i386_netware_info : tsysteminfo = + ( + system : system_i386_netware; + name : 'Netware for i386(clib)'; + shortname : 'Netware'; + flags : []; + cpu : cpu_i386; + unit_env : 'NETWAREUNITS'; + extradefines : 'NETWARE_CLIB'; + exeext : '.nlm'; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.nlm'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.nlm'; + staticClibext : '.a'; + staticClibprefix : ''; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : ''; + newline : #13#10; + dirsep : '/'; + files_case_relevent : false; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 16384; + DllScanSupported:false; + use_function_relative_addresses : true + ); + + implementation + +initialization +{$ifdef CPU86} + {$ifdef netware} + set_source_info(system_i386_netware_info); + {$endif netware} +{$endif CPU86} +end. diff --git a/compiler/systems/i_os2.pas b/compiler/systems/i_os2.pas new file mode 100644 index 0000000000..adb306689e --- /dev/null +++ b/compiler/systems/i_os2.pas @@ -0,0 +1,114 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for OS/2 + + 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. + **************************************************************************** +} +{ This unit implements support information structures for OS/2. } +unit i_os2; + + interface + + uses + systems; + + const + res_emxbind_info : tresinfo = + ( + id : res_emxbind; + resbin : 'emxbind'; + rescmd : '-b -r $RES $OBJ' + (* Not really used - see TLinkeros2.SetDefaultInfo in t_os2.pas. *) + ); + + system_i386_os2_info : tsysteminfo = + ( + system : system_i386_OS2; + name : 'OS/2'; + shortname : 'OS2'; + flags : [tf_need_export,tf_use_8_3]; + cpu : cpu_i386; + unit_env : 'OS2UNITS'; + extradefines : ''; + exeext : '.exe'; + defext : '.def'; + scriptext : '.cmd'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : ''; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + files_case_relevent : false; + assem : as_i386_as_aout; + assemextern : as_i386_as_aout; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_emxbind; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 256*1024; + DllScanSupported: false; + use_function_relative_addresses : false + ); + + + implementation + +initialization +{$ifdef CPU86} + {$ifdef os2} + {$IFNDEF EMX} + set_source_info(system_i386_os2_info); + {$ENDIF EMX} + {$IFDEF VER1_0} + set_source_info(system_i386_os2_info); + {$ENDIF VER1_0} + {$endif os2} +{$endif CPU86} +end. diff --git a/compiler/systems/i_palmos.pas b/compiler/systems/i_palmos.pas new file mode 100644 index 0000000000..fda9a52eb3 --- /dev/null +++ b/compiler/systems/i_palmos.pas @@ -0,0 +1,90 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for PalmOS + + 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. + **************************************************************************** +} +{ This unit implements support information structures for PalmOS. } +unit i_palmos; + + interface + + uses + systems; + + const + system_m68k_palmos_info : tsysteminfo = + ( + system : system_m68k_PalmOS; + name : 'PalmOS'; + shortname : 'PalmOS'; + flags : [tf_code_small,tf_static_a5_based]; + cpu : cpu_m68k; + short_name : 'PALMOS'; + unit_env : 'PALMUNITS'; + extradefines : ''; + sharedlibext : '.so'; + staticlibext : '.a'; + exeext : ''; + defext : ''; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + p_ext_support : false; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : ld_m68k_palmos; + linkextern : ld_m68k_palmos; + ar : ar_m68k_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + stackalignment : 2; + maxCrecordalignment : 4; + stacksize : 8192; + DllScanSupported:false; + use_function_relative_addresses : false + ); + + res_m68k_palmos_info : tresinfo = + ( + id : res_m68k_palmos; + resbin : 'pilrc'; + rescmd : '-I $INC $RES' + ); + +implementation + +initialization +{$ifdef cpu68} + {$ifdef palmos} + set_source_info(system_m68k_palmos_info); + {$endif palmos} +{$endif cpu68} +end. diff --git a/compiler/systems/i_sunos.pas b/compiler/systems/i_sunos.pas new file mode 100644 index 0000000000..073a3e4bfa --- /dev/null +++ b/compiler/systems/i_sunos.pas @@ -0,0 +1,168 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for solaris + + 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. + **************************************************************************** +} +{ This unit implements support information structures for solaris. } +unit i_sunos; + + interface + + uses + systems; + + const + system_i386_solaris_info : tsysteminfo = + ( + system : system_i386_solaris; + name : 'Solaris for i386'; + shortname : 'solaris'; + flags : [tf_under_development]; + cpu : cpu_i386; + unit_env : 'SOLARISUNITS'; + extradefines : 'UNIX;LIBC'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 1; + varalignmin : 0; + varalignmax : 1; + localalignmin : 0; + localalignmax : 1; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true + ); + + system_sparc_solaris_info : tsysteminfo = + ( + system : system_sparc_solaris; + name : 'Solaris for SPARC'; + shortname : 'solaris'; + flags : [tf_needs_symbol_size]; + cpu : cpu_SPARC; + unit_env : 'SOLARISUNITS'; + extradefines : 'UNIX;LIBC;'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 8 + ); + first_parm_offset : 92; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true + ); + + implementation + +initialization +{$ifdef CPU86} + {$ifdef solaris} + set_source_info(system_i386_solaris_info); + {$endif solaris} +{$endif CPU86} +{$ifdef CPUSparc} + {$ifdef solaris} + set_source_info(system_sparc_solaris_info); + {$endif solaris} +{$endif CPUSparc} + +end. diff --git a/compiler/systems/i_watcom.pas b/compiler/systems/i_watcom.pas new file mode 100644 index 0000000000..751357102b --- /dev/null +++ b/compiler/systems/i_watcom.pas @@ -0,0 +1,102 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for Watcom + + 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. + **************************************************************************** +} +{ This unit implements support information structures for Watcom. } +unit i_watcom; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_watcom_info : tsysteminfo = + ( + system : system_i386_Watcom; + name : 'Watcom compatible DOS extenders'; + shortname : 'WATCOM'; + flags : [tf_use_8_3]; + cpu : cpu_i386; + unit_env : 'WATCOMUNITS'; + extradefines : 'DPMI'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.asm'; + objext : '.obj'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : ''; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + files_case_relevent : false; + assem : as_i386_wasm; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 16384; + DllScanSupported : false; + use_function_relative_addresses : true + ); + + implementation + +initialization +{$ifdef cpu86} + {$ifdef watcom} + set_source_info(system_i386_watcom_info); + {$endif watcom} +{$endif cpu86} +end. diff --git a/compiler/systems/i_wdosx.pas b/compiler/systems/i_wdosx.pas new file mode 100644 index 0000000000..75091db330 --- /dev/null +++ b/compiler/systems/i_wdosx.pas @@ -0,0 +1,102 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for win32 + + 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. + **************************************************************************** +} +{ This unit implements support information structures for wdosx. } +unit i_wdosx; + + interface + + uses + systems; + + const + system_i386_wdosx_info : tsysteminfo = + ( + system : system_i386_wdosx; + name : 'WDOSX DOS extender'; + shortname : 'WDOSX'; + flags : [tf_use_8_3]; + cpu : cpu_i386; + unit_env : 'WDOSXUNITS'; + extradefines : 'MSWINDOWS'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.rc'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + files_case_relevent : false; + assem : as_i386_pecoffwdosx; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_gnu_windres; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + DllScanSupported:true; + use_function_relative_addresses : true + ); + + implementation + +initialization +{$ifdef CPU86} + {$ifdef WIN32} + {$ifdef WDOSX} + set_source_info(system_i386_wdosx_info); + {$endif WDOSX} + {$endif WIN32} +{$endif CPU86} +end. diff --git a/compiler/systems/i_win.pas b/compiler/systems/i_win.pas new file mode 100644 index 0000000000..b5a7192a5a --- /dev/null +++ b/compiler/systems/i_win.pas @@ -0,0 +1,306 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for win32 + + 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. + **************************************************************************** +} +{ This unit implements support information structures for win32. } +unit i_win; + + interface + + uses + systems; + + const + system_i386_win32_info : tsysteminfo = + ( + system : system_i386_WIN32; + name : 'Win32 for i386'; + shortname : 'Win32'; + flags : []; + cpu : cpu_i386; + unit_env : 'WIN32UNITS'; + extradefines : 'MSWINDOWS'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.rc'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + files_case_relevent : true; + assem : as_i386_pecoff; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_gnu_windres; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:true; + use_function_relative_addresses : true + ); + + system_x64_win64_info : tsysteminfo = + ( + system : system_x86_64_win64; + name : 'Win64 for x64'; + shortname : 'Win64'; + flags : []; + cpu : cpu_x86_64; + unit_env : 'WIN64UNITS'; + extradefines : 'MSWINDOWS'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.rc'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + files_case_relevent : true; + assem : as_x86_64_pecoff; + assemextern : as_x86_64_masm; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_gnu_windres; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 8; + loopalign : 8; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 8; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 16 + ); + first_parm_offset : 16; + stacksize : 262144; + DllScanSupported:true; + use_function_relative_addresses : true + ); + + system_arm_wince_info : tsysteminfo = + ( + system : system_arm_wince; + name : 'WinCE for ARM'; + shortname : 'WinCE'; + flags : []; + cpu : cpu_arm; + unit_env : ''; + extradefines : 'UNDER_CE'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.rc'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_gnu_wince_windres; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:false; + use_function_relative_addresses : true + ); + + system_i386_wince_info : tsysteminfo = + ( + system : system_i386_wince; + name : 'WinCE for i386'; + shortname : 'WinCE'; + flags : []; + cpu : cpu_i386; + unit_env : ''; + extradefines : 'UNDER_CE'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.rc'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + p_ext_support : false; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + files_case_relevent : true; + assem : as_i386_pecoffwince; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_gnu_windres; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 262144; + DllScanSupported:true; + use_function_relative_addresses : true + ); + + + implementation + +initialization +{$ifdef CPU86} + {$ifdef WIN32} + {$ifndef WDOSX} + set_source_info(system_i386_win32_info); + {$endif WDOSX} + {$endif WIN32} + {$ifdef WINCE} + set_source_info(system_i386_wince_info); + {$endif WINCE} +{$endif CPU86} + +{$ifdef CPUX86_64} + {$ifdef WIN64} + {$ifndef WDOSX} + set_source_info(system_x64_win64_info); + {$endif WDOSX} + {$endif WIN64} +{$endif CPUX86_64} + +{$ifdef CPUARM} + {$ifdef WINCE} + set_source_info(system_arm_wince_info); + {$endif WINCE} +{$endif CPUARM} +end. diff --git a/compiler/systems/mac_crea.txt b/compiler/systems/mac_crea.txt new file mode 100644 index 0000000000..5372652cbc --- /dev/null +++ b/compiler/systems/mac_crea.txt @@ -0,0 +1,71 @@ +FrŒn: devprograms@apple.com +Till: <olle.raab@freepascal.org> +Datum: mŒndag 10 januari 2005 22.33 +€mne: Re: Creator Registration Request + +Please include the line below in follow-up emails for this request. + +Follow-up: 6855616 + +Re: Creator Registration Request + +Dear Olle Raab, + +Thank you for registering your application creator information. We appreciate your continued product development and support of Apple Computer! The following product information has been registered: + +Company: Free Pascal Team +Contact: Olle Raab +Address: VikingavŠgen 28 A +S-224 77 Lund +Sweden + + +Application: Free Pascal Compiler +Phone: +46-46-120053 +EMail Address: olle.raab@freepascal.org + +Application Signatures: +FPas (Hex) 46506173 + +This letter serves as your confirmation. Please keep it on file. Additionally, you should review the information for accuracy. If you locate discrepancies, please contact Developer Support at devprograms@apple.com with your corrections. + +Thanks for supporting Apple! + +Best regards, + +Elisa Molson +Apple Developer Connection +----------------------------------- +Spotlight, 64-bit Support, Dashboard, Automator, and more. +Start developing today with the powerful new technologies in Mac OS X Tiger. + +REQUEST ------------------------------------------------------------------------ + +WEB CREATOR/FILE TYPE Registration Request +========================================== +%UNIQUE REGISTRATION%: +%NAME%: Olle Raab +%COMPANY%: Free Pascal Team +%ADDRESS%: VikingavŠgen 28 A +S-224 77 Lund +Sweden +%TELEPHONE%: +46-46-120053 +%E-MAIL%: olle.raab@freepascal.org +%PRODUCT NAME%: Free Pascal Compiler +%DEVICE DRIVER%: +%SIGNATURE (HEX)%: 46506173 +%END + + +DB REFERENCE ------------------------------------------------------------------- + +TIME IN: 10-Jan-2005 10:45 PST +TIME OUT: 10-Jan-2005 13:16 PST + +Copyright 2005, Apple Computer, Inc. + +SECURITY: NON-DISCLOSURE USE ONLY + + + + diff --git a/compiler/systems/t_amiga.pas b/compiler/systems/t_amiga.pas new file mode 100644 index 0000000000..95e9d340b9 --- /dev/null +++ b/compiler/systems/t_amiga.pas @@ -0,0 +1,43 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + This unit implements support import,export,link routines + for the (m68k/powerpc) Amiga 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_amiga; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + link, + cutils,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_amiga; + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterTarget(system_m68k_amiga_info); +end. diff --git a/compiler/systems/t_atari.pas b/compiler/systems/t_atari.pas new file mode 100644 index 0000000000..5833ac8129 --- /dev/null +++ b/compiler/systems/t_atari.pas @@ -0,0 +1,43 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) Amiga 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_atari; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + link, + cutils,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_atari; + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterTarget(system_m68k_atari_info); +end. diff --git a/compiler/systems/t_beos.pas b/compiler/systems/t_beos.pas new file mode 100644 index 0000000000..5e9ea9f54e --- /dev/null +++ b/compiler/systems/t_beos.pas @@ -0,0 +1,495 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) BeOS 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_beos; + +{$i fpcdefs.inc} + +interface + + uses + symsym,symdef, + import,export,link; + + type + timportlibbeos=class(timportlib) + procedure preparelib(const s:string);override; + procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; + procedure importvariable(vs:tglobalvarsym;const name,module:string);override; + procedure generatelib;override; + end; + + texportlibbeos=class(texportlib) + procedure preparelib(const s : string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure generatelib;override; + end; + + tlinkerbeos=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean;makelib:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + end; + + +implementation + + uses + dos, + cutils,cclasses, + verbose,systems,globtype,globals, + symconst,script, + fmodule,aasmbase,aasmtai,aasmcpu,cpubase,i_beos; + +{***************************************************************************** + TIMPORTLIBBEOS +*****************************************************************************} + +procedure timportlibbeos.preparelib(const s : string); +begin +end; + + +procedure timportlibbeos.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); +end; + + +procedure timportlibbeos.importvariable(vs:tglobalvarsym;const name,module:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); + { reset the mangledname and turn off the dll_var option } + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); +end; + + +procedure timportlibbeos.generatelib; +begin +end; + + +{***************************************************************************** + TEXPORTLIBBEOS +*****************************************************************************} + +procedure texportlibbeos.preparelib(const s:string); +begin +end; + + +procedure texportlibbeos.exportprocedure(hp : texported_item); +var + hp2 : texported_item; +begin + { first test the index value } + if (hp.options and eo_index)<>0 then + begin + Message1(parser_e_no_export_with_index_for_target,'beos'); + exit; + end; + { now place in correct order } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_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=texported_item(current_module._exports.first) then + current_module._exports.concat(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 texportlibbeos.exportvar(hp : texported_item); +begin + hp.is_var:=true; + exportprocedure(hp); +end; + + +procedure texportlibbeos.generatelib; +var + hp2 : texported_item; +begin + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if (not hp2.is_var) and + (hp2.sym.typ=procsym) then + begin + { the manglednames can already be the same when the procedure + is declared with cdecl } + if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then + begin +{$ifdef i386} + { place jump in al_procedures } + asmlist[al_procedures].concat(Tai_align.Create_op(4,$90)); + asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + asmlist[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); + asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); +{$endif i386} + end; + end + else + Message1(parser_e_no_export_of_variables_for_target,'beos'); + hp2:=texported_item(hp2.next); + end; +end; + + +{***************************************************************************** + TLINKERBEOS +*****************************************************************************} + +Constructor TLinkerBeos.Create; +var + s : string; + i : integer; +begin + Inherited Create; + s:=GetEnv('BELIBRARIES'); + { convert to correct format in case under unix system } + for i:=1 to length(s) do + if s[i] = ':' then + s[i] := ';'; + { just in case we have a single path : add the ending ; } + { since that is what the compiler expects. } + if pos(';',s) = 0 then + s:=s+';'; + LibrarySearchPath.AddPath(s,true); {format:'path1;path2;...'} +end; + + +procedure TLinkerBeOS.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE `cat $RES`'; + DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE `cat $RES`'; + DllCmd[2]:='strip --strip-unneeded $EXE'; +(* + ExeCmd[1]:='sh $RES $EXE $OPT $STATIC $STRIP -L.'; +{ ExeCmd[1]:='sh $RES $EXE $OPT $DYNLINK $STATIC $STRIP -L.';} + DllCmd[1]:='sh $RES $EXE $OPT -L.'; + +{ DllCmd[1]:='sh $RES $EXE $OPT -L. -g -nostart -soname=$EXE'; + } DllCmd[2]:='strip --strip-unneeded $EXE'; +{ DynamicLinker:='/lib/ld-beos.so.2';} +*) + end; +end; + + +function TLinkerBeOS.WriteResponseFile(isdll:boolean;makelib:boolean) : Boolean; +Var + linkres : TLinkRes; + i : integer; + cprtobj, + prtobj : string[80]; + HPath : TStringListItem; + s : string; + linklibc : boolean; +begin + WriteResponseFile:=False; +{ set special options for some targets } + linklibc:=(SharedLibFiles.Find('root')<>nil); + + prtobj:='prt0'; + cprtobj:='cprt0'; + if (cs_profile in aktmoduleswitches) or + (not SharedLibFiles.Empty) then + begin + AddSharedLibrary('root'); + linklibc:=true; + end; + + if (not linklibc) and makelib then + begin + linklibc:=true; + cprtobj:='dllprt.o'; + end; + + if linklibc then + prtobj:=cprtobj; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + { + if not isdll then + LinkRes.Add('ld -o $1 $2 $3 $4 $5 $6 $7 $8 $9 \') + else + LinkRes.Add('ld -o $1 -e 0 $2 $3 $4 $5 $6 $7 $8 $9\'); + } + LinkRes.Add('-m elf_i386_be -shared -Bsymbolic'); + + { Write path to search libraries } + HPath:=TStringListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add(maybequoted('-L'+HPath.Str)); + HPath:=TStringListItem(HPath.Next); + end; + HPath:=TStringListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add(maybequoted('-L'+HPath.Str)); + HPath:=TStringListItem(HPath.Next); + end; + + { try to add crti and crtbegin if linking to C } + if linklibc then + begin + if librarysearchpath.FindFile('crti.o',s) then + LinkRes.AddFileName(s); + if librarysearchpath.FindFile('crtbegin.o',s) then + LinkRes.AddFileName(s); +{ s:=librarysearchpath.FindFile('start_dyn.o',found)+'start_dyn.o'; + if found then LinkRes.AddFileName(s+' \');} + + if prtobj<>'' then + LinkRes.AddFileName(FindObjectFile(prtobj,'',false)); + + if isdll then + LinkRes.AddFileName(FindObjectFile('func.o','',false)); + + if librarysearchpath.FindFile('init_term_dyn.o',s) then + LinkRes.AddFileName(s); + end + else + begin + if prtobj<>'' then + LinkRes.AddFileName(FindObjectFile(prtobj,'',false)); + end; + + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(maybequoted(s)); + end; + +{ LinkRes.Add('-lroot \'); + LinkRes.Add('/boot/develop/tools/gnupro/lib/gcc-lib/i586-beos/2.9-beos-991026/crtend.o \'); + LinkRes.Add('/boot/develop/lib/x86/crtn.o \');} + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(maybequoted(s)) + end; + end; + + { Write sharedlibraries like -l<lib> } + if not SharedLibFiles.Empty then + begin + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + linklibc:=true; + end; + end; + { be sure that libc is the last lib } +{ if linklibc then + LinkRes.Add('-lroot');} +{ if linkdynamic and (Info.DynamicLinker<>'') then + LinkRes.AddFileName(Info.DynamicLinker);} + end; + if isdll then + LinkRes.Add('-lroot'); + + { objects which must be at the end } + if linklibc then + begin + if librarysearchpath.FindFile('crtend.o',s) then + LinkRes.AddFileName(s); + if librarysearchpath.FindFile('crtn.o',s) then + LinkRes.AddFileName(s); + end; + +{ Write and Close response } + linkres.Add(' '); + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; +end; + + +function TLinkerBeOS.MakeExecutable:boolean; +var + binstr : String; + cmdstr : TcmdStr; + success : boolean; + DynLinkStr : string[60]; + StaticStr, + StripStr : string[40]; +begin + if not(cs_link_extern in aktglobalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + if (cs_link_staticflag in aktglobalswitches) then + StaticStr:='-static'; + if (cs_link_strip in aktglobalswitches) then + StripStr:='-s'; + If (cs_profile in aktmoduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + begin + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + if cshared Then + DynLinkStr:='--shared ' + DynLinkStr; + if rlinkpath<>'' Then + DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr; + End; + +{ Write used files and libraries } + WriteResponseFile(false,false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,true); + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +Function TLinkerBeOS.MakeSharedLibrary:boolean; +var + binstr : String; + cmdstr : TCmdStr; + success : boolean; + DynLinkStr : string[60]; + StaticStr, + StripStr : string[40]; + + begin + MakeSharedLibrary:=false; + if not(cs_link_extern in aktglobalswitches) then + Message1(exec_i_linking,current_module.sharedlibfilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + if (cs_link_staticflag in aktglobalswitches) then + StaticStr:='-static'; + if (cs_link_strip in aktglobalswitches) then + StripStr:='-s'; + If (cs_profile in aktmoduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + begin + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + if cshared Then + DynLinkStr:='--shared ' + DynLinkStr; + if rlinkpath<>'' Then + DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr; + End; +{ Write used files and libraries } + WriteResponseFile(true,true); + +{ Call linker } + SplitBinCmd(Info.DllCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,true); + +{ Strip the library ? } + if success and (cs_link_strip in aktglobalswitches) then + begin + SplitBinCmd(Info.DllCmd[2],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,false); + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + MakeSharedLibrary:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef i386} + RegisterExternalLinker(system_i386_beos_info,TLinkerbeos); + RegisterImport(system_i386_beos,timportlibbeos); + RegisterExport(system_i386_beos,texportlibbeos); + RegisterTarget(system_i386_beos_info); +{$endif i386} +end. diff --git a/compiler/systems/t_bsd.pas b/compiler/systems/t_bsd.pas new file mode 100644 index 0000000000..1d59a6d4ea --- /dev/null +++ b/compiler/systems/t_bsd.pas @@ -0,0 +1,655 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman (original Linux) + (c) 2000 by Marco van de Voort (FreeBSD mods) + + This unit implements support import,export,link routines + for the (i386)FreeBSD 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_bsd; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + cutils,cclasses, + verbose,systems,globtype,globals, + symconst,script, + fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,symdef, + import,export,link,i_bsd, + cgutils,cgbase,cgobj,cpuinfo; + + type + tdarwinimported_item = class(timported_item) + procdef : tprocdef; + end; + + timportlibdarwin=class(timportlib) + procedure preparelib(const s:string);override; + procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; + procedure importvariable(vs:tglobalvarsym;const name,module:string);override; + procedure generatelib;override; + procedure generatesmartlib;override; + end; + + timportlibbsd=class(timportlib) + procedure preparelib(const s:string);override; + procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; + procedure importvariable(vs:tglobalvarsym;const name,module:string);override; + procedure generatelib;override; + end; + + texportlibbsd=class(texportlib) + procedure preparelib(const s : string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure generatelib;override; + end; + + tlinkerbsd=class(texternallinker) + private + LdSupportsNoResponseFile : boolean; + LibrarySuffix : Char; + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + end; + + + +{***************************************************************************** + TIMPORTLIBDARWIN +*****************************************************************************} + + procedure timportlibdarwin.preparelib(const s : string); + begin + if asmlist[al_imports]=nil then + asmlist[al_imports]:=TAAsmoutput.create; + end; + + + procedure timportlibdarwin.importprocedure(aprocdef:tprocdef;const module : string;index : longint;const name : string); + begin + { insert sharedlibrary } +{ current_module.linkothersharedlibs.add(SplitName(module),link_allways); } + end; + + + procedure timportlibdarwin.importvariable(vs:tglobalvarsym;const name,module:string); + begin + { insert sharedlibrary } +{ current_module.linkothersharedlibs.add(SplitName(module),link_allways); } + { the rest is handled in the nppcld.pas tppcloadnode } + vs.set_mangledname(name); + end; + + + procedure timportlibdarwin.generatesmartlib; + begin + generatelib; + end; + + + procedure timportlibdarwin.generatelib; + begin + end; + + +{***************************************************************************** + TIMPORTLIBBSD +*****************************************************************************} + +procedure timportlibbsd.preparelib(const s : string); +begin +end; + + +procedure timportlibbsd.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); +end; + + +procedure timportlibbsd.importvariable(vs:tglobalvarsym;const name,module:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); + { reset the mangledname and turn off the dll_var option } + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); +end; + + +procedure timportlibbsd.generatelib; +begin +end; + + +{***************************************************************************** + TEXPORTLIBBSD +*****************************************************************************} + +procedure texportlibbsd.preparelib(const s:string); +begin +end; + + +procedure texportlibbsd.exportprocedure(hp : texported_item); +var + hp2 : texported_item; +begin + { first test the index value } + if (hp.options and eo_index)<>0 then + begin + Message1(parser_e_no_export_with_index_for_target,'*bsd/darwin'); + exit; + end; + { now place in correct order } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_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=texported_item(current_module._exports.first) then + current_module._exports.concat(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 texportlibbsd.exportvar(hp : texported_item); +begin + hp.is_var:=true; + exportprocedure(hp); +end; + + +procedure texportlibbsd.generatelib; +var + hp2 : texported_item; +begin + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if (not hp2.is_var) and + (hp2.sym.typ=procsym) then + begin + { the manglednames can already be the same when the procedure + is declared with cdecl } + if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then + begin +{$ifdef i386} + { place jump in al_procedures } + asmlist[al_procedures].concat(Tai_align.Create_op(4,$90)); + asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + asmlist[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); + asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); +{$endif i386} +{$ifdef powerpc} + asmlist[al_procedures].concat(Tai_align.create(16)); + asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + asmlist[al_procedures].concat(Taicpu.Op_sym(A_B,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); + asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); +{$endif powerpc} + end; + end + else + Message1(parser_e_no_export_of_variables_for_target,'*bsd/darwin'); + hp2:=texported_item(hp2.next); + end; +end; + + +{***************************************************************************** + TLINKERLINUX +*****************************************************************************} + +Constructor TLinkerBSD.Create; +begin + Inherited Create; + if not Dontlinkstdlibpath Then + if (target_info.system <> system_powerpc_darwin) then + LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true) + else + { Mac OS X doesn't have a /lib } + LibrarySearchPath.AddPath('/usr/lib',true) +end; + + +procedure TLinkerBSD.SetDefaultInfo; +{ + This will also detect which libc version will be used +} +begin + LibrarySuffix:=' '; + LdSupportsNoResponseFile := (target_info.system in [system_m68k_netbsd,system_powerpc_darwin]); + with Info do + begin + if LdSupportsNoResponseFile then + begin + if (target_info.system <> system_powerpc_darwin) then + begin + ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE `cat $RES`'; + DllCmd[1]:='ld $OPT -shared -L. -o $EXE `cat $RES`' + end + else + begin + ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -multiply_defined suppress -L. -o $EXE `cat $RES`'; + DllCmd[1]:='libtool $OPT -dynamic -init PASCALMAIN -multiply_defined suppress -L. -o $EXE `cat $RES`' + end + end + else + begin + ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $RES'; + DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES'; + end; + if (target_info.system <> system_powerpc_darwin) then + DllCmd[2]:='strip --strip-unneeded $EXE' + else + DllCmd[2]:='strip -x $EXE'; + { first try glibc2 } +{$ifdef GLIBC2} {Keep linux code in place. FBSD might go to a different + glibc too once} + DynamicLinker:='/lib/ld-linux.so.2'; + if FileExists(DynamicLinker) then + begin + Glibc2:=true; + { Check for 2.0 files, else use the glibc 2.1 stub } + if FileExists('/lib/ld-2.0.*') then + Glibc21:=false + else + Glibc21:=true; + end + else + DynamicLinker:='/lib/ld-linux.so.1'; +{$else} + DynamicLinker:=''; +{$endif} + end; +end; + + +Function TLinkerBSD.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + cprtobj, + gprtobj, + prtobj : string[80]; + HPath : TStringListItem; + s,s1,s2 : string; + linkpthread, + linkdynamic, + linklibc : boolean; + Fl1,Fl2 : Boolean; + +begin + WriteResponseFile:=False; +{ set special options for some targets } + if target_info.system <> system_powerpc_darwin then + begin + linkdynamic:=not(SharedLibFiles.empty); + linklibc:=(SharedLibFiles.Find('c')<>nil); + linkpthread:=(SharedLibFiles.Find('pthread')<>nil); + if (target_info.system =system_i386_freebsd) and linkpthread Then + Begin + if not (cs_link_pthread in aktglobalswitches) Then + begin + {delete pthreads from list, in this case it is in libc_r} + SharedLibFiles.Remove(SharedLibFiles.Find('pthread').str); + LibrarySuffix:='r'; + end; + End; + prtobj:='prt0'; + cprtobj:='cprt0'; + gprtobj:='gprt0'; + if cs_profile in aktmoduleswitches then + begin + prtobj:=gprtobj; + AddSharedLibrary('c'); + LibrarySuffix:='p'; + linklibc:=true; + end + else + begin + if linklibc then + prtobj:=cprtobj; + end; + end + else + begin + { for darwin: always link dynamically against libc } + linklibc := true; + if not(isdll) then + if not(cs_profile in aktmoduleswitches) then + prtobj:='/usr/lib/crt1.o' + else + prtobj:='/usr/lib/gcrt1.o' + else + prtobj:=''; + end; + + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TStringListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + if LdSupportsNoResponseFile then + LinkRes.Add(maybequoted('-L'+HPath.Str)) + else + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TStringListItem(HPath.Next); + end; + HPath:=TStringListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + if LdSupportsNoResponseFile then + LinkRes.Add(maybequoted('-L'+HPath.Str)) + else + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TStringListItem(HPath.Next); + end; + + if not LdSupportsNoResponseFile then + LinkRes.Add('INPUT('); + { add objectfiles, start with prt0 always } + if prtobj<>'' then + LinkRes.AddFileName(FindObjectFile(prtobj,'',false)); + { try to add crti and crtbegin if linking to C } + if linklibc and + (target_info.system <> system_powerpc_darwin) then + begin + if librarysearchpath.FindFile('crtbegin.o',s) then + LinkRes.AddFileName(s); + if librarysearchpath.FindFile('crti.o',s) then + LinkRes.AddFileName(s); + end; + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(maybequoted(s)); + end; + if not LdSupportsNoResponseFile then + LinkRes.Add(')'); + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + if not LdSupportsNoResponseFile then + LinkRes.Add('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(maybequoted(s)) + end; + if not LdSupportsNoResponseFile then + LinkRes.Add(')'); + end; + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + if not SharedLibFiles.Empty then + begin + if not LdSupportsNoResponseFile then + LinkRes.Add('INPUT('); + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.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 + Begin + If LibrarySuffix=' ' Then + LinkRes.Add('-lc') + else + LinkRes.Add('-lc_'+LibrarySuffix); + If LibrarySuffix='r' Then + LinkRes.Add('-lc'); + end; + { when we have -static for the linker the we also need libgcc } + if (cs_link_staticflag in aktglobalswitches) then + LinkRes.Add('-lgcc'); + if linkdynamic and (Info.DynamicLinker<>'') then + LinkRes.AddFileName(Info.DynamicLinker); + if not LdSupportsNoResponseFile then + LinkRes.Add(')'); + end; + { objects which must be at the end } + if linklibc and + (target_info.system <> system_powerpc_darwin) then + begin + Fl1:=librarysearchpath.FindFile('crtend.o',s1); + Fl2:=librarysearchpath.FindFile('crtn.o',s2); + if Fl1 or Fl2 then + begin + LinkRes.Add('INPUT('); + If Fl1 Then + LinkRes.AddFileName(s1); + If Fl2 Then + LinkRes.AddFileName(s2); + LinkRes.Add(')'); + end; + end; + { ignore the fact that our relocations are in non-writable sections, } + { will be fixed once we have pic support } + if isdll and + (target_info.system = system_powerpc_darwin) then + LinkRes.Add('-read_only_relocs suppress'); +{ Write and Close response } + linkres.writetodisk; + linkres.Free; + + WriteResponseFile:=True; +end; + + +function TLinkerBSD.MakeExecutable:boolean; +var + binstr : String; + cmdstr : TCmdStr; + success : boolean; + DynLinkStr : string[60]; + GCSectionsStr, + StaticStr, + StripStr : string[40]; +begin + if not(cs_link_extern in aktglobalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + GCSectionsStr:=''; + if (cs_link_staticflag in aktglobalswitches) then + begin + if (target_info.system=system_m68k_netbsd) and + ((cs_link_on_target in aktglobalswitches) or + (target_info.system=source_info.system)) then + StaticStr:='-Bstatic' + else + StaticStr:='-static'; + end; + if (cs_link_strip in aktglobalswitches) then + if (target_info.system <> system_powerpc_darwin) then + StripStr:='-s' + else + StripStr:='-x'; + + if (cs_link_smart in aktglobalswitches) and + (tf_smartlink_sections in target_info.flags) then + GCSectionsStr:='--gc-sections'; + + If (cs_profile in aktmoduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + + if CShared Then + DynLinKStr:=DynLinkStr+' --shared'; +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,LdSupportsNoResponseFile); + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +Function TLinkerBSD.MakeSharedLibrary:boolean; +var + InitStr, + FiniStr, + SoNameStr : string[80]; + binstr : String; + cmdstr : TCmdStr; + 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); + + InitStr:='-init FPC_LIB_START'; + FiniStr:='-fini FPC_LIB_EXIT'; + SoNameStr:='-soname '+SplitFileName(current_module.sharedlibfilename^); + +{ Call linker } + SplitBinCmd(Info.DllCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$INIT',InitStr); + Replace(cmdstr,'$FINI',FiniStr); + Replace(cmdstr,'$SONAME',SoNameStr); + + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,LdSupportsNoResponseFile); + +{ Strip the library ? } + if success and (cs_link_strip in aktglobalswitches) then + begin + SplitBinCmd(Info.DllCmd[2],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,false); + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + MakeSharedLibrary:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef x86_64} + RegisterExternalLinker(system_x86_64_FreeBSD_info,TLinkerBSD); + RegisterImport(system_x86_64_freebsd,timportlibbsd); + RegisterExport(system_x86_64_freebsd,texportlibbsd); + RegisterTarget(system_x86_64_freebsd_info); +{$endif} +{$ifdef i386} + RegisterExternalLinker(system_i386_FreeBSD_info,TLinkerBSD); + RegisterExternalLinker(system_i386_NetBSD_info,TLinkerBSD); + RegisterExternalLinker(system_i386_OpenBSD_info,TLinkerBSD); + RegisterImport(system_i386_freebsd,timportlibbsd); + RegisterExport(system_i386_freebsd,texportlibbsd); + RegisterTarget(system_i386_freebsd_info); + RegisterImport(system_i386_netbsd,timportlibbsd); + RegisterExport(system_i386_netbsd,texportlibbsd); + RegisterTarget(system_i386_netbsd_info); + RegisterImport(system_i386_openbsd,timportlibbsd); + RegisterExport(system_i386_openbsd,texportlibbsd); + RegisterTarget(system_i386_openbsd_info); +{$endif i386} +{$ifdef m68k} +// RegisterExternalLinker(system_m68k_FreeBSD_info,TLinkerBSD); + RegisterExternalLinker(system_m68k_NetBSD_info,TLinkerBSD); + RegisterImport(system_m68k_netbsd,timportlibbsd); + RegisterExport(system_m68k_netbsd,texportlibbsd); + RegisterTarget(system_m68k_netbsd_info); +{$endif m68k} +{$ifdef powerpc} +// RegisterExternalLinker(system_m68k_FreeBSD_info,TLinkerBSD); + RegisterExternalLinker(system_powerpc_darwin_info,TLinkerBSD); + RegisterImport(system_powerpc_darwin,timportlibdarwin); + RegisterExport(system_powerpc_darwin,texportlibbsd); + RegisterTarget(system_powerpc_darwin_info); + RegisterExternalLinker(system_powerpc_netbsd_info,TLinkerBSD); + RegisterImport(system_powerpc_netbsd,timportlibbsd); + RegisterExport(system_powerpc_netbsd,texportlibbsd); + RegisterTarget(system_powerpc_netbsd_info); +{$endif powerpc} +end. diff --git a/compiler/systems/t_emx.pas b/compiler/systems/t_emx.pas new file mode 100644 index 0000000000..44427e627f --- /dev/null +++ b/compiler/systems/t_emx.pas @@ -0,0 +1,516 @@ +{ + Copyright (c) 1998-2002 by Daniel Mantione + Portions Copyright (c) 1998-2002 Eberhard Mattes + + Unit to write out import libraries and def files for OS/2 via EMX + + 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. + + **************************************************************************** +} +{ + A lot of code in this unit has been ported from C to Pascal from the + emximp utility, part of the EMX development system. Emximp is copyrighted + by Eberhard Mattes. Note: Eberhard doesn't know much about the Pascal + port, please send questions to Daniel Mantione + <d.s.p.mantione@twi.tudelft.nl>. +} +unit t_emx; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + strings, + dos, + cutils,cclasses, + globtype,comphook,systems,symconst,symsym,symdef, + globals,verbose,fmodule,script, + import,link,i_emx,ppu; + + type + TImportLibEMX=class(timportlib) + procedure preparelib(const s:string);override; + procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; + procedure generatelib;override; + end; + + TLinkerEMX=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + + +const profile_flag:boolean=false; + +const n_ext = 1; + n_abs = 2; + n_text = 4; + n_data = 6; + n_bss = 8; + n_imp1 = $68; + n_imp2 = $6a; + +type reloc=packed record {This is the layout of a relocation table + entry.} + address:longint; {Fixup location} + remaining:longint; + {Meaning of bits for remaining: + 0..23: Symbol number or segment + 24: Self-relative fixup if non-zero + 25..26: Fixup size (0: 1 byte, 1: 2, 2: 4 bytes) + 27: Reference to symbol or segment + 28..31 Not used} + end; + + nlist=packed record {This is the layout of a symbol table entry.} + strofs:longint; {Offset in string table} + typ:byte; {Type of the symbol} + other:byte; {Other information} + desc:word; {More information} + value:longint; {Value (address)} + end; + + a_out_header=packed record + magic:word; {Magic word, must be $0107} + machtype:byte; {Machine type} + flags:byte; {Flags} + text_size:longint; {Length of text, in bytes} + data_size:longint; {Length of initialized data, in bytes} + bss_size:longint; {Length of uninitialized data, in bytes} + sym_size:longint; {Length of symbol table, in bytes} + entry:longint; {Start address (entry point)} + trsize:longint; {Length of relocation info for text, bytes} + drsize:longint; {Length of relocation info for data, bytes} + end; + + ar_hdr=packed record + ar_name:array[0..15] of char; + ar_date:array[0..11] of char; + ar_uid:array[0..5] of char; + ar_gid:array[0..5] of char; + ar_mode:array[0..7] of char; + ar_size:array[0..9] of char; + ar_fmag:array[0..1] of char; + end; + +var aout_str_size:longint; + aout_str_tab:array[0..2047] of byte; + aout_sym_count:longint; + aout_sym_tab:array[0..5] of nlist; + + aout_text:array[0..63] of byte; + aout_text_size:longint; + + aout_treloc_tab:array[0..1] of reloc; + aout_treloc_count:longint; + + aout_size:longint; + seq_no:longint; + + ar_member_size:longint; + + out_file:file; + +procedure write_ar(const name:string;size:longint); + +var ar:ar_hdr; + time:datetime; + dummy:word; + numtime:longint; + tmp:string[19]; + + +begin + ar_member_size:=size; + fillchar(ar.ar_name,sizeof(ar.ar_name),' '); + move(name[1],ar.ar_name,length(name)); + getdate(time.year,time.month,time.day,dummy); + gettime(time.hour,time.min,time.sec,dummy); + packtime(time,numtime); + str(numtime,tmp); + fillchar(ar.ar_date,sizeof(ar.ar_date),' '); + move(tmp[1],ar.ar_date,length(tmp)); + ar.ar_uid:='0 '; + ar.ar_gid:='0 '; + ar.ar_mode:='100666'#0#0; + str(size,tmp); + fillchar(ar.ar_size,sizeof(ar.ar_size),' '); + move(tmp[1],ar.ar_size,length(tmp)); + ar.ar_fmag:='`'#10; + blockwrite(out_file,ar,sizeof(ar)); +end; + +procedure finish_ar; + +var a:byte; + +begin + a:=0; + if odd(ar_member_size) then + blockwrite(out_file,a,1); +end; + +procedure aout_init; + +begin + aout_str_size:=sizeof(longint); + aout_sym_count:=0; + aout_text_size:=0; + aout_treloc_count:=0; +end; + +function aout_sym(const name:string;typ,other:byte;desc:word; + value:longint):longint; + +begin + if aout_str_size+length(name)+1>sizeof(aout_str_tab) then + internalerror(200504241); + if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then + internalerror(200504242); + aout_sym_tab[aout_sym_count].strofs:=aout_str_size; + aout_sym_tab[aout_sym_count].typ:=typ; + aout_sym_tab[aout_sym_count].other:=other; + aout_sym_tab[aout_sym_count].desc:=desc; + aout_sym_tab[aout_sym_count].value:=value; + strPcopy(@aout_str_tab[aout_str_size],name); + aout_str_size:=aout_str_size+length(name)+1; + aout_sym:=aout_sym_count; + inc(aout_sym_count); +end; + +procedure aout_text_byte(b:byte); + +begin + if aout_text_size>=sizeof(aout_text) then + internalerror(200504243); + aout_text[aout_text_size]:=b; + inc(aout_text_size); +end; + +procedure aout_text_dword(d:longint); + +type li_ar=array[0..3] of byte; + +begin + aout_text_byte(li_ar(d)[0]); + aout_text_byte(li_ar(d)[1]); + aout_text_byte(li_ar(d)[2]); + aout_text_byte(li_ar(d)[3]); +end; + +procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint); + +begin + if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then + internalerror(200504244); + aout_treloc_tab[aout_treloc_count].address:=address; + aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+ + len shl 25+ext shl 27; + inc(aout_treloc_count); +end; + +procedure aout_finish; + +begin + while (aout_text_size and 3)<>0 do + aout_text_byte ($90); + aout_size:=sizeof(a_out_header)+aout_text_size+aout_treloc_count* + sizeof(reloc)+aout_sym_count*sizeof(aout_sym_tab[0])+aout_str_size; +end; + +procedure aout_write; + +var ao:a_out_header; + +begin + ao.magic:=$0107; + ao.machtype:=0; + ao.flags:=0; + ao.text_size:=aout_text_size; + ao.data_size:=0; + ao.bss_size:=0; + ao.sym_size:=aout_sym_count*sizeof(aout_sym_tab[0]); + ao.entry:=0; + ao.trsize:=aout_treloc_count*sizeof(reloc); + ao.drsize:=0; + blockwrite(out_file,ao,sizeof(ao)); + blockwrite(out_file,aout_text,aout_text_size); + blockwrite(out_file,aout_treloc_tab,sizeof(reloc)*aout_treloc_count); + blockwrite(out_file,aout_sym_tab,sizeof(aout_sym_tab[0])*aout_sym_count); + longint((@aout_str_tab)^):=aout_str_size; + blockwrite(out_file,aout_str_tab,aout_str_size); +end; + +procedure TImportLibEMX.preparelib(const s:string); + +{This code triggers a lot of bugs in the compiler. +const armag='!<arch>'#10; + ar_magic:array[1..length(armag)] of char=armag;} +const ar_magic:array[1..8] of char='!<arch>'#10; +var + libname : string; +begin + LibName:=FixFileName(S + Target_Info.StaticCLibExt); + seq_no:=1; + current_module.linkotherstaticlibs.add(libname,link_allways); + assign(out_file,current_module.outputpath^+libname); + rewrite(out_file,1); + blockwrite(out_file,ar_magic,sizeof(ar_magic)); +end; + +procedure TImportLibEMX.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string); +{func = Name of function to import. + module = Name of DLL to import from. + index = Index of function in DLL. Use 0 to import by name. + name = Name of function in DLL. Ignored when index=0;} +var tmp1,tmp2,tmp3:string; + sym_mcount,sym_import:longint; + fixup_mcount,fixup_import:longint; + func : string; +begin + { force the current mangledname } + include(aprocdef.procoptions,po_has_mangledname); + func:=aprocdef.mangledname; + + aout_init; + tmp2:=func; + if profile_flag and not (copy(func,1,4)='_16_') then + begin + {sym_entry:=aout_sym(func,n_text+n_ext,0,0,aout_text_size);} + sym_mcount:=aout_sym('__mcount',n_ext,0,0,0); + {Use, say, "_$U_DosRead" for "DosRead" to import the + non-profiled function.} + tmp2:='__$U_'+func; + sym_import:=aout_sym(tmp2,n_ext,0,0,0); + aout_text_byte($55); {push ebp} + aout_text_byte($89); {mov ebp, esp} + aout_text_byte($e5); + aout_text_byte($e8); {call _mcount} + fixup_mcount:=aout_text_size; + aout_text_dword(0-(aout_text_size+4)); + aout_text_byte($5d); {pop ebp} + aout_text_byte($e9); {jmp _$U_DosRead} + fixup_import:=aout_text_size; + aout_text_dword(0-(aout_text_size+4)); + + aout_treloc(fixup_mcount,sym_mcount,1,2,1); + aout_treloc (fixup_import, sym_import,1,2,1); + end; + str(seq_no,tmp1); + tmp1:='IMPORT#'+tmp1; + if name='' then + begin + str(index,tmp3); + tmp3:=func+'='+module+'.'+tmp3; + end + else + tmp3:=func+'='+module+'.'+name; + aout_sym(tmp2,n_imp1+n_ext,0,0,0); + aout_sym(tmp3,n_imp2+n_ext,0,0,0); + aout_finish; + write_ar(tmp1,aout_size); + aout_write; + finish_ar; + inc(seq_no); +end; + +procedure TImportLibEMX.GenerateLib; + +begin + close(out_file); +end; + + +{**************************************************************************** + TLinkerEMX +****************************************************************************} + +Constructor TLinkerEMX.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkerEMX.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld $OPT -o $OUT @$RES'; + ExeCmd[2]:='emxbind -b $STRIP $APPTYPE $RSRC -k$STACKKB -h$HEAPMB -o $EXE $OUT -aim -s$DOSHEAPKB'; + if source_info.script = script_dos then + ExeCmd[3]:='del $OUT'; + end; +end; + + +Function TLinkerEMX.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TStringListItem; + s : string; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TStringListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TStringListItem(HPath.Next); + end; + HPath:=TStringListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TStringListItem(HPath.Next); + end; + + { add objectfiles, start with prt0 always } + LinkRes.AddFileName(FindObjectFile('prt0','',false)); + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(s); + end; + + { Write staticlibraries } + { No group !! This will not work correctly PM } + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + 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.GetFirst; + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end; + +{ Write and Close response } + linkres.writetodisk; + LinkRes.Free; + + WriteResponseFile:=True; +end; + + +function TLinkerEMX.MakeExecutable:boolean; +var + binstr : String; + cmdstr : TCmdStr; + success : boolean; + i : longint; + AppTypeStr, + StripStr: string[40]; + RsrcStr : string; + DS: DirStr; + NS: NameStr; + ES: ExtStr; + OutName: PathStr; +begin + if not(cs_link_extern in aktglobalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + FSplit (current_module.exefilename^, DS, NS, ES); + OutName := DS + NS + '.out'; + if (cs_link_strip in aktglobalswitches) then + StripStr := '-s' + else + StripStr := ''; + if (usewindowapi) or (AppType = app_gui) then + AppTypeStr := '-p' + else if AppType = app_fs then + AppTypeStr := '-f' + else AppTypeStr := '-w'; + if not (Current_module.ResourceFiles.Empty) then + RsrcStr := '-r ' + Current_module.ResourceFiles.GetFirst + else + RsrcStr := ''; +(* Only one resource file supported, discard everything else + (should be already empty anyway, though). *) + Current_module.ResourceFiles.Clear; +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + success:=false; + for i:=1 to 3 do + begin + SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr); + if binstr<>'' then + begin + { Is this really required? Not anymore according to my EMX docs } + Replace(cmdstr,'$HEAPMB',tostr((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+1023) shr 10)); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$APPTYPE',AppTypeStr); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RSRC',RsrcStr); + Replace(cmdstr,'$OUT',maybequoted(OutName)); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + if i<>3 then + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false) + else + success:=DoExec(binstr,cmdstr,(i=1),true); + end; + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_i386_emx_info,TLinkerEMX); + RegisterImport(system_i386_emx,TImportLibEMX); + RegisterRes(res_emxbind_info); + RegisterTarget(system_i386_emx_info); +end. diff --git a/compiler/systems/t_gba.pas b/compiler/systems/t_gba.pas new file mode 100644 index 0000000000..c937ca2a6d --- /dev/null +++ b/compiler/systems/t_gba.pas @@ -0,0 +1,300 @@ +{ + This unit implements support import,export,link routines + for the (arm) GameBoy Advance target + + Copyright (c) 2001-2002 by Peter Vreman + + 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_gba; + +{$i fpcdefs.inc} + + +interface + + uses + symsym,symdef, + import,export,link; + + type + tlinkergba=class(texternallinker) + private + libctype:(libc5,glibc2,glibc21,uclibc); + Function WriteResponseFile : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + + +implementation + + + uses + cutils,cclasses,verbose,systems,globtype,globals, + symconst,script,fmodule,dos,aasmbase,aasmtai,aasmcpu, + cpubase,cgobj,i_gba; + + + +{***************************************************************************** + TLINKERLINUX +*****************************************************************************} + +Constructor TLinkerGba.Create; +begin + Inherited Create; + if not Dontlinkstdlibpath Then + LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true); +end; + + +procedure TLinkerGba.SetDefaultInfo; +{ + This will also detect which libc version will be used +} +begin + with Info do + begin + //ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $RES'; + // Here we call ld with right options for GBA + ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -Ttext 0x08000000 -Tbss 0x03000000 -L. -o $EXE $RES'; + DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES'; + DllCmd[2]:='strip --strip-unneeded $EXE'; + DynamicLinker:='/lib/ld-linux.so.2'; + libctype:=glibc2; + end; +end; + + +Function TLinkerGba.WriteResponseFile: Boolean; +Var + linkres : TLinkRes; + i : longint; + cprtobj, + gprtobj, + prtobj : string[80]; + HPath : TStringListItem; + s,s1,s2 : string; + found1, + found2, + linklibc : boolean; +begin + WriteResponseFile:=False; +{ set special options for some targets } + linklibc:=(SharedLibFiles.Find('c')<>nil); + prtobj:='prt0'; + case libctype of + glibc21: + begin + cprtobj:='cprt21'; + gprtobj:='gprt21'; + end; + uclibc: + begin + cprtobj:='ucprt0'; + gprtobj:='ugprt0'; + end + else + cprtobj:='cprt0'; + gprtobj:='gprt0'; + end; + + if cs_profile in aktmoduleswitches then + begin + prtobj:=gprtobj; + if not(libctype in [glibc2,glibc21]) then + AddSharedLibrary('gmon'); + AddSharedLibrary('c'); + linklibc:=true; + end + else + begin + if linklibc then + prtobj:=cprtobj; + end; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TStringListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TStringListItem(HPath.Next); + end; + HPath:=TStringListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TStringListItem(HPath.Next); + end; + + LinkRes.Add('INPUT('); + { add objectfiles, start with prt0 always } + if prtobj<>'' then + LinkRes.AddFileName(maybequoted(FindObjectFile(prtobj,'',false))); + { try to add crti and crtbegin if linking to C } + if linklibc then + begin + if librarysearchpath.FindFile('crtbegin.o',s) then + LinkRes.AddFileName(s); + if librarysearchpath.FindFile('crti.o',s) then + LinkRes.AddFileName(s); + end; + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(maybequoted(s)); + end; + LinkRes.Add(')'); + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(maybequoted(s)) + end; + LinkRes.Add(')'); + end; + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + if not SharedLibFiles.Empty then + begin + LinkRes.Add('INPUT('); + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + linklibc:=true; + end; + end; + { be sure that libc is the last lib } + if linklibc then + LinkRes.Add('-lc'); + { when we have -static for the linker the we also need libgcc } + if (cs_link_staticflag in aktglobalswitches) then + LinkRes.Add('-lgcc'); + LinkRes.Add(')'); + end; + + { objects which must be at the end } + if linklibc and (libctype<>uclibc) then + begin + found1:=librarysearchpath.FindFile('crtend.o',s1); + found2:=librarysearchpath.FindFile('crtn.o',s2); + if found1 or found2 then + begin + LinkRes.Add('INPUT('); + if found1 then + LinkRes.AddFileName(s1); + if found2 then + LinkRes.AddFileName(s2); + LinkRes.Add(')'); + end; + end; +{ Write and Close response } + linkres.writetodisk; + linkres.Free; + + WriteResponseFile:=True; +end; + + +function TLinkerGba.MakeExecutable:boolean; +var + binstr : String; + cmdstr : TCmdStr; + success : boolean; + DynLinkStr : string[60]; + GCSectionsStr, + StaticStr, + StripStr : string[40]; +begin + if not(cs_link_extern in aktglobalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + GCSectionsStr:=''; + DynLinkStr:=''; + if (cs_link_staticflag in aktglobalswitches) then + StaticStr:='-static'; + if (cs_link_strip in aktglobalswitches) then + StripStr:='-s'; + if (cs_link_smart in aktglobalswitches) and + (tf_smartlink_sections in target_info.flags) then + GCSectionsStr:='--gc-sections'; + If (cs_profile in aktmoduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + begin + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + if cshared Then + DynLinkStr:='--shared ' + DynLinkStr; + if rlinkpath<>'' Then + DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr; + End; + +{ Write used files and libraries } + WriteResponseFile; + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false); + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_arm_gba_info,TLinkerGba); + RegisterTarget(system_arm_gba_info); +end. diff --git a/compiler/systems/t_go32v2.pas b/compiler/systems/t_go32v2.pas new file mode 100644 index 0000000000..c627d5cb82 --- /dev/null +++ b/compiler/systems/t_go32v2.pas @@ -0,0 +1,364 @@ +{ + Copyright (c) 1998-2002 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; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + link, + cutils,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_go32v2,ogcoff; + + type + tlinkergo32v2=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + Function WriteScript(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + + +{**************************************************************************** + TLinkerGo32v2 +****************************************************************************} + +Constructor TLinkerGo32v2.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkerGo32v2.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld $SCRIPT $OPT $STRIP -o $EXE $RES'; + end; +end; + + +Function TLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + s : string; + linklibc : boolean; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add('-('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(GetShortName(s)) + end; + LinkRes.Add('-)'); + end; + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + LinkRes.Add('-l'+s); + linklibc:=true; + end; + end; + { be sure that libc&libgcc is the last lib } + if linklibc then + begin + LinkRes.Add('-lc'); + LinkRes.Add('-lgcc'); + end; + +{ Write and Close response } + linkres.writetodisk; + LinkRes.Free; + + WriteResponseFile:=True; +end; + + +Function TLinkerGo32v2.WriteScript(isdll:boolean) : Boolean; +Var + scriptres : TLinkRes; + HPath : TStringListItem; + s : string; +begin + WriteScript:=False; + + { Open link.res file } + ScriptRes:=TLinkRes.Create(outputexedir+Info.ScriptName); + ScriptRes.Add('OUTPUT_FORMAT("coff-go32-exe")'); + ScriptRes.Add('ENTRY(start)'); + + ScriptRes.Add('SECTIONS'); + ScriptRes.Add('{'); + ScriptRes.Add(' .text 0x1000+SIZEOF_HEADERS : {'); + ScriptRes.Add(' . = ALIGN(16);'); + { add objectfiles, start with prt0 always } + ScriptRes.Add(' '+GetShortName(FindObjectFile('prt0','',false))+'(.text)'); + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + ScriptRes.Add(' . = ALIGN(16);'); + ScriptRes.Add(' '+GetShortName(s)+'(.text)'); + end; + end; + ScriptRes.Add(' *(.text)'); + ScriptRes.Add(' etext = . ; _etext = .;'); + ScriptRes.Add(' . = ALIGN(0x200);'); + ScriptRes.Add(' }'); + ScriptRes.Add(' .data ALIGN(0x200) : {'); + ScriptRes.Add(' djgpp_first_ctor = . ;'); + ScriptRes.Add(' *(.ctor)'); + ScriptRes.Add(' djgpp_last_ctor = . ;'); + ScriptRes.Add(' djgpp_first_dtor = . ;'); + ScriptRes.Add(' *(.dtor)'); + ScriptRes.Add(' djgpp_last_dtor = . ;'); + ScriptRes.Add(' *(.data)'); + ScriptRes.Add(' *(.gcc_exc)'); + ScriptRes.Add(' ___EH_FRAME_BEGIN__ = . ;'); + ScriptRes.Add(' *(.eh_fram)'); + ScriptRes.Add(' ___EH_FRAME_END__ = . ;'); + ScriptRes.Add(' LONG(0)'); + ScriptRes.Add(' edata = . ; _edata = .;'); + ScriptRes.Add(' . = ALIGN(0x200);'); + ScriptRes.Add(' }'); + ScriptRes.Add(' .bss SIZEOF(.data) + ADDR(.data) :'); + ScriptRes.Add(' {'); + ScriptRes.Add(' _object.2 = . ;'); + ScriptRes.Add(' . += 24 ;'); + ScriptRes.Add(' *(.bss)'); + ScriptRes.Add(' *(COMMON)'); + ScriptRes.Add(' end = . ; _end = .;'); + ScriptRes.Add(' . = ALIGN(0x200);'); + ScriptRes.Add(' }'); + ScriptRes.Add(' }'); + + { Write path to search libraries } + HPath:=TStringListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + ScriptRes.Add('SEARCH_DIR("'+GetShortName(HPath.Str)+'")'); + HPath:=TStringListItem(HPath.Next); + end; + HPath:=TStringListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + ScriptRes.Add('SEARCH_DIR("'+GetShortName(HPath.Str)+'")'); + HPath:=TStringListItem(HPath.Next); + end; + +{ Write and Close response } + ScriptRes.WriteToDisk; + ScriptRes.Free; + + WriteScript:=True; +end; + + + +function TLinkerGo32v2.MakeExecutable:boolean; +var + binstr : String; + cmdstr : TCmdStr; + 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 and our own ld script } + WriteScript(false); + WriteResponsefile(false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + if source_info.system=system_i386_go32v2 then + Replace(cmdstr,'$RES','@'+maybequoted(outputexedir+Info.ResName)) + else + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$SCRIPT','--script='+maybequoted(outputexedir+Info.ScriptName)); + success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false); + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + begin + RemoveFile(outputexedir+Info.ResName); + RemoveFile(outputexedir+Info.ScriptName); + end; + + 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} + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_i386_go32v2_info,TLinkerGo32v2); + RegisterInternalLinker(system_i386_go32v2_info,TCoffLinker); + RegisterTarget(system_i386_go32v2_info); +end. diff --git a/compiler/systems/t_linux.pas b/compiler/systems/t_linux.pas new file mode 100644 index 0000000000..ba47cd141e --- /dev/null +++ b/compiler/systems/t_linux.pas @@ -0,0 +1,755 @@ +{ + Copyright (c) 1998-2002 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; + +{$i fpcdefs.inc} + +interface + + uses + symsym,symdef,ppu, + import,export,link; + + type + timportliblinux=class(timportlib) + procedure preparelib(const s:string);override; + procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; + procedure importvariable(vs:tglobalvarsym;const name,module:string);override; + procedure generatelib;override; + end; + + texportliblinux=class(texportlib) + procedure preparelib(const s : string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure generatelib;override; + end; + + tlinkerlinux=class(texternallinker) + private + libctype:(libc5,glibc2,glibc21,uclibc); + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + function postprocessexecutable(const fn : string;isdll:boolean):boolean; + end; + + +implementation + + uses + cutils,cclasses, + verbose,systems,globtype,globals, + symconst,script, + fmodule,dos + ,aasmbase,aasmtai,aasmcpu,cpubase,cgobj + ,i_linux + ; + +{***************************************************************************** + TIMPORTLIBLINUX +*****************************************************************************} + +procedure timportliblinux.preparelib(const s : string); +begin +end; + + +procedure timportliblinux.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); +end; + + +procedure timportliblinux.importvariable(vs:tglobalvarsym;const name,module:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); + { reset the mangledname and turn off the dll_var option } + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); +end; + + +procedure timportliblinux.generatelib; +begin +end; + + +{***************************************************************************** + TEXPORTLIBLINUX +*****************************************************************************} + +procedure texportliblinux.preparelib(const s:string); +begin +end; + + +procedure texportliblinux.exportprocedure(hp : texported_item); +var + hp2 : texported_item; +begin + { first test the index value } + if (hp.options and eo_index)<>0 then + begin + Message1(parser_e_no_export_with_index_for_target,'linux'); + exit; + end; + { now place in correct order } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_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=texported_item(current_module._exports.first) then + current_module._exports.concat(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 : texported_item); +begin + hp.is_var:=true; + exportprocedure(hp); +end; + + +procedure texportliblinux.generatelib; +var + hp2 : texported_item; +begin + new_section(asmlist[al_procedures],sec_code,'',0); + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if (not hp2.is_var) and + (hp2.sym.typ=procsym) then + begin + { the manglednames can already be the same when the procedure + is declared with cdecl } + if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then + begin + { place jump in al_procedures } + asmlist[al_procedures].concat(tai_align.create(target_info.alignment.procalign)); + asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + cg.a_jmp_name(asmlist[al_procedures],tprocsym(hp2.sym).first_procdef.mangledname); + asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); + end; + end + else + message1(parser_e_no_export_of_variables_for_target,'linux'); + hp2:=texported_item(hp2.next); + end; +end; + + +{***************************************************************************** + TLINKERLINUX +*****************************************************************************} + +Constructor TLinkerLinux.Create; +begin + Inherited Create; + if not Dontlinkstdlibpath Then +{$ifdef x86_64} + LibrarySearchPath.AddPath('/lib64;/usr/lib64;/usr/X11R6/lib64',true); +{$else} +{$ifdef powerpc64} + LibrarySearchPath.AddPath('/lib64;/usr/lib64;/usr/X11R6/lib64',true); +{$else powerpc64} + LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true); +{$endif powerpc64} +{$endif x86_64} +end; + + +procedure TLinkerLinux.SetDefaultInfo; +{ + This will also detect which libc version will be used +} + +const +{$ifdef i386} platform_select='-b elf32-i386 -m elf_i386';{$endif} +{$ifdef x86_64} platform_select='-b elf64-x86-64 -m elf_x86_64';{$endif} +{$ifdef powerpc}platform_select='-b elf32-powerpc -m elf32ppclinux';{$endif} +{$ifdef POWERPC64} platform_select='-b elf64-powerpc -m elf64ppc';{$endif} +{$ifdef sparc} platform_select='-b elf32-sparc -m elf32_sparc';{$endif} +{$ifdef arm} platform_select='';{$endif} {unknown :( } +{$ifdef m68k} platform_select='';{$endif} {unknown :( } + +{$ifdef m68k} +var + St : SearchRec; +{$endif m68k} +begin + with Info do + begin + ExeCmd[1]:='ld '+platform_select+' $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $RES'; + DllCmd[1]:='ld '+platform_select+' $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES'; + DllCmd[2]:='strip --strip-unneeded $EXE'; +{$ifdef m68k} + libctype:=glibc2; + FindFirst('/lib/ld*',AnyFile,st); + while DosError=0 do + begin + if copy(st.name,1,5)='ld-2.' then + begin + DynamicLinker:='/lib/'+St.name; + if st.name[6]<>'0' then + libctype:=glibc21; + break; + end; + FindNext(St); + end; + FindClose(St); +{$endif m68k} + +{$ifdef i386} + { first try glibc2 } + DynamicLinker:='/lib/ld-linux.so.2'; + if FileExists(DynamicLinker) then + { Check for 2.0 files, else use the glibc 2.1 stub } + if FileExists('/lib/ld-2.0.*') then + libctype:=glibc2 + else + libctype:=glibc21 + else + if fileexists('/lib/ld-uClibc.so.0') then + begin + libctype:=uclibc; + dynamiclinker:='/lib/ld-uClibc.so.0'; + end + else if fileexists('/lib/ld-linux.so.1') then + DynamicLinker:='/lib/ld-linux.so.1' + else + libctype:=glibc21; +{$endif i386} + +{$ifdef x86_64} + DynamicLinker:='/lib64/ld-linux-x86-64.so.2'; + libctype:=glibc2; +{$endif x86_64} + +{$ifdef sparc} + DynamicLinker:='/lib/ld-linux.so.2'; + libctype:=glibc2; +{$endif sparc} + +{$ifdef powerpc} + DynamicLinker:='/lib/ld.so.1'; + libctype:=glibc2; +{$endif powerpc} + +{$ifdef powerpc64} + DynamicLinker:='/lib64/ld64.so.1'; + libctype:=glibc2; +{$endif powerpc64} + +{$ifdef arm} + DynamicLinker:='/lib/ld-linux.so.2'; + libctype:=glibc2; +{$endif arm} + end; +end; + + +Function TLinkerLinux.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + cprtobj, + gprtobj, + prtobj : string[80]; + HPath : TStringListItem; + s,s1,s2 : string; + found1, + found2, + linklibc : boolean; +begin + WriteResponseFile:=False; +{ set special options for some targets } + linklibc:=(SharedLibFiles.Find('c')<>nil); + if isdll then + begin + prtobj:='dllprt0'; + cprtobj:='dllprt0'; + gprtobj:='dllprt0'; + end + else + begin + prtobj:='prt0'; + case libctype of + glibc21: + begin + cprtobj:='cprt21'; + gprtobj:='gprt21'; + end; + uclibc: + begin + cprtobj:='ucprt0'; + gprtobj:='ugprt0'; + end + else + cprtobj:='cprt0'; + gprtobj:='gprt0'; + end; + end; + if cs_profile in aktmoduleswitches then + begin + prtobj:=gprtobj; + if not(libctype in [glibc2,glibc21]) then + AddSharedLibrary('gmon'); + AddSharedLibrary('c'); + linklibc:=true; + end + else + begin + if linklibc then + prtobj:=cprtobj; + end; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TStringListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TStringListItem(HPath.Next); + end; + HPath:=TStringListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TStringListItem(HPath.Next); + end; + + LinkRes.Add('INPUT('); + { add objectfiles, start with prt0 always } + if prtobj<>'' then + LinkRes.AddFileName(maybequoted(FindObjectFile(prtobj,'',false))); + { try to add crti and crtbegin if linking to C } + if linklibc then + begin + if librarysearchpath.FindFile('crtbegin.o',s) then + LinkRes.AddFileName(s); + if librarysearchpath.FindFile('crti.o',s) then + LinkRes.AddFileName(s); + end; + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(maybequoted(s)); + end; + LinkRes.Add(')'); + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(maybequoted(s)) + end; + LinkRes.Add(')'); + end; + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + if not SharedLibFiles.Empty then + begin + LinkRes.Add('INPUT('); + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + linklibc:=true; + end; + end; + { be sure that libc is the last lib } + if linklibc then + LinkRes.Add('-lc'); + { when we have -static for the linker the we also need libgcc } + if (cs_link_staticflag in aktglobalswitches) then + LinkRes.Add('-lgcc'); + LinkRes.Add(')'); + end; + + { objects which must be at the end } + if linklibc and (libctype<>uclibc) then + begin + found1:=librarysearchpath.FindFile('crtend.o',s1); + found2:=librarysearchpath.FindFile('crtn.o',s2); + if found1 or found2 then + begin + LinkRes.Add('INPUT('); + if found1 then + LinkRes.AddFileName(s1); + if found2 then + LinkRes.AddFileName(s2); + LinkRes.Add(')'); + end; + end; + {Entry point.} + linkres.add('ENTRY(_start)'); + + {Sections.} +{ + commented out because it cause problems on several machines with different ld versions (FK) + linkres.add('SECTIONS'); + linkres.add('{'); + {Read-only sections, merged into text segment:} + linkres.add(' PROVIDE (__executable_start = 0x010000); . = 0x010000 +0x100;'); + linkres.add(' .interp : { *(.interp) }'); + linkres.add(' .hash : { *(.hash) }'); + linkres.add(' .dynsym : { *(.dynsym) }'); + linkres.add(' .dynstr : { *(.dynstr) }'); + linkres.add(' .gnu.version : { *(.gnu.version) }'); + linkres.add(' .gnu.version_d : { *(.gnu.version_d) }'); + linkres.add(' .gnu.version_r : { *(.gnu.version_r) }'); + linkres.add(' .rel.dyn :'); + linkres.add(' {'); + linkres.add(' *(.rel.init)'); + linkres.add(' *(.rel.text .rel.text.* .rel.gnu.linkonce.t.*)'); + linkres.add(' *(.rel.fini)'); + linkres.add(' *(.rel.rodata .rel.rodata.* .rel.gnu.linkonce.r.*)'); + linkres.add(' *(.rel.data.rel.ro*)'); + linkres.add(' *(.rel.data .rel.data.* .rel.gnu.linkonce.d.*)'); + linkres.add(' *(.rel.tdata .rel.tdata.* .rel.gnu.linkonce.td.*)'); + linkres.add(' *(.rel.tbss .rel.tbss.* .rel.gnu.linkonce.tb.*)'); + linkres.add(' *(.rel.got)'); + linkres.add(' *(.rel.bss .rel.bss.* .rel.gnu.linkonce.b.*)'); + linkres.add(' }'); + linkres.add(' .rela.dyn :'); + linkres.add(' {'); + linkres.add(' *(.rela.init)'); + linkres.add(' *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*)'); + linkres.add(' *(.rela.fini)'); + linkres.add(' *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*)'); + linkres.add(' *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*)'); + linkres.add(' *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*)'); + linkres.add(' *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*)'); + linkres.add(' *(.rela.got)'); + linkres.add(' *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*)'); + linkres.add(' }'); + linkres.add(' .rel.plt : { *(.rel.plt) }'); + linkres.add(' .rela.plt : { *(.rela.plt) }'); + linkres.add(' .init :'); + linkres.add(' {'); + linkres.add(' KEEP (*(.init))'); + linkres.add(' } =0x90909090'); + linkres.add(' .plt : { *(.plt) }'); + linkres.add(' .text :'); + linkres.add(' {'); + linkres.add(' *(.text .stub .text.* .gnu.linkonce.t.*)'); + linkres.add(' KEEP (*(.text.*personality*))'); + {.gnu.warning sections are handled specially by elf32.em.} + linkres.add(' *(.gnu.warning)'); + linkres.add(' } =0x90909090'); + linkres.add(' .fini :'); + linkres.add(' {'); + linkres.add(' KEEP (*(.fini))'); + linkres.add(' } =0x90909090'); + linkres.add(' PROVIDE (_etext = .);'); + linkres.add(' .rodata : { *(.rodata .rodata.* .gnu.linkonce.r.*) }'); + {Adjust the address for the data segment. We want to adjust up to + the same address within the page on the next page up.} + linkres.add(' . = ALIGN (0x1000) - ((0x1000 - .) & (0x1000 - 1)); . = DATA_SEGMENT_ALIGN (0x1000, 0x1000);'); + linkres.add(' .dynamic : { *(.dynamic) }'); + linkres.add(' .got : { *(.got) }'); + linkres.add(' .got.plt : { *(.got.plt) }'); + linkres.add(' .data :'); + linkres.add(' {'); + linkres.add(' *(.data .data.* .gnu.linkonce.d.*)'); + linkres.add(' KEEP (*(.gnu.linkonce.d.*personality*))'); + linkres.add(' }'); + linkres.add(' _edata = .;'); + linkres.add(' PROVIDE (edata = .);'); +{$ifdef zsegment_threadvars} + linkres.add(' _z = .;'); + linkres.add(' .threadvar 0 : AT (_z) { *(.threadvar .threadvar.* .gnu.linkonce.tv.*) }'); + linkres.add(' PROVIDE (_threadvar_size = SIZEOF(.threadvar));'); + linkres.add(' . = _z + SIZEOF (.threadvar);'); +{$else} + linkres.add(' .threadvar : { *(.threadvar .threadvar.* .gnu.linkonce.tv.*) }'); +{$endif} + linkres.add(' __bss_start = .;'); + linkres.add(' .bss :'); + linkres.add(' {'); + linkres.add(' *(.dynbss)'); + linkres.add(' *(.bss .bss.* .gnu.linkonce.b.*)'); + linkres.add(' *(COMMON)'); + {Align here to ensure that the .bss section occupies space up to + _end. Align after .bss to ensure correct alignment even if the + .bss section disappears because there are no input sections.} + linkres.add(' . = ALIGN(32 / 8);'); + linkres.add(' }'); + linkres.add(' . = ALIGN(32 / 8);'); + linkres.add(' _end = .;'); + linkres.add(' PROVIDE (end = .);'); + linkres.add(' . = DATA_SEGMENT_END (.);'); + {Stabs debugging sections.} + linkres.add(' .stab 0 : { *(.stab) }'); + linkres.add(' .stabstr 0 : { *(.stabstr) }'); + linkres.add('}'); +} + +{ Write and Close response } + LinkRes.writetodisk; + LinkRes.Free; + + WriteResponseFile:=True; +end; + + +function TLinkerLinux.MakeExecutable:boolean; +var + binstr : String; + cmdstr : TCmdStr; + success : boolean; + DynLinkStr : string[60]; + GCSectionsStr, + StaticStr, + StripStr : string[40]; +begin + if not(cs_link_extern in aktglobalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + GCSectionsStr:=''; + DynLinkStr:=''; + if (cs_link_staticflag in aktglobalswitches) then + StaticStr:='-static'; + if (cs_link_strip in aktglobalswitches) then + StripStr:='-s'; + if (af_smartlink_sections in target_asm.flags) and + (tf_smartlink_sections in target_info.flags) then + GCSectionsStr:='--gc-sections'; + If (cs_profile in aktmoduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + begin + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + if cshared Then + DynLinkStr:='--shared ' + DynLinkStr; + if rlinkpath<>'' Then + DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr; + End; + +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false); + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + if (success) then + success:=PostProcessExecutable(current_module.exefilename^,false); + + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +Function TLinkerLinux.MakeSharedLibrary:boolean; +var + InitStr, + FiniStr, + SoNameStr : string[80]; + binstr : String; + cmdstr : TCmdStr; + 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); + + { Create some replacements } + InitStr:='-init FPC_LIB_START'; + FiniStr:='-fini FPC_LIB_EXIT'; + SoNameStr:='-soname '+SplitFileName(current_module.sharedlibfilename^); + +{ Call linker } + SplitBinCmd(Info.DllCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$INIT',InitStr); + Replace(cmdstr,'$FINI',FiniStr); + Replace(cmdstr,'$SONAME',SoNameStr); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,false); + +{ Strip the library ? } + if success and (cs_link_strip in aktglobalswitches) then + begin + { only remove non global symbols and debugging info for a library } + Info.DllCmd[2]:='strip --discard-all --strip-debug $EXE'; + SplitBinCmd(Info.DllCmd[2],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,false); + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + MakeSharedLibrary:=success; { otherwise a recursive call to link method } +end; + +function tlinkerLinux.postprocessexecutable(const fn : string;isdll:boolean):boolean; + +Var + cmdstr: string; + found : boolean; + hp : tused_unit; + +begin + postprocessexecutable:=True; + if target_res.id=res_elf then + begin + found:=((current_module.flags and uf_has_resourcefiles)=uf_has_resourcefiles); + if not found then + begin + hp:=tused_unit(usedunits.first); + While Assigned(hp) and not Found do + begin + Found:=((hp.u.flags and uf_has_resourcefiles)=uf_has_resourcefiles); + hp:=tused_unit(hp.next); + end; + end; + if found then + begin + cmdstr:=' -f -i '+maybequoted(fn); + postprocessexecutable:=DoExec(FindUtil(utilsprefix+'fpcres'),cmdstr,false,false); + end; + end; +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef i386} + RegisterExternalLinker(system_i386_linux_info,TLinkerLinux); + RegisterImport(system_i386_linux,timportliblinux); + RegisterExport(system_i386_linux,texportliblinux); + RegisterTarget(system_i386_linux_info); + RegisterRes(res_elf32_info); + + RegisterExternalLinker(system_x86_6432_linux_info,TLinkerLinux); + RegisterImport(system_x86_6432_linux,timportliblinux); + RegisterExport(system_x86_6432_linux,texportliblinux); + RegisterTarget(system_x86_6432_linux_info); +{$endif i386} +{$ifdef m68k} + RegisterExternalLinker(system_m68k_linux_info,TLinkerLinux); + RegisterImport(system_m68k_linux,timportliblinux); + RegisterExport(system_m68k_linux,texportliblinux); + RegisterTarget(system_m68k_linux_info); +{$endif m68k} +{$ifdef powerpc} + RegisterExternalLinker(system_powerpc_linux_info,TLinkerLinux); + RegisterImport(system_powerpc_linux,timportliblinux); + RegisterExport(system_powerpc_linux,texportliblinux); + RegisterTarget(system_powerpc_linux_info); +{$endif powerpc} +{$ifdef powerpc64} + RegisterExternalLinker(system_powerpc64_linux_info,TLinkerLinux); + RegisterImport(system_powerpc64_linux,timportliblinux); + RegisterExport(system_powerpc64_linux,texportliblinux); + RegisterTarget(system_powerpc64_linux_info); +{$endif powerpc64} +{$ifdef alpha} + RegisterExternalLinker(system_alpha_linux_info,TLinkerLinux); + RegisterImport(system_alpha_linux,timportliblinux); + RegisterExport(system_alpha_linux,texportliblinux); + RegisterTarget(system_alpha_linux_info); +{$endif alpha} +{$ifdef x86_64} + RegisterExternalLinker(system_x86_64_linux_info,TLinkerLinux); + RegisterImport(system_x86_64_linux,timportliblinux); + RegisterExport(system_x86_64_linux,texportliblinux); + RegisterTarget(system_x86_64_linux_info); + RegisterRes(res_elf64_info); +{$endif x86_64} +{$ifdef SPARC} + RegisterExternalLinker(system_sparc_linux_info,TLinkerLinux); + RegisterImport(system_SPARC_linux,timportliblinux); + RegisterExport(system_SPARC_linux,texportliblinux); + RegisterTarget(system_SPARC_linux_info); +{$endif SPARC} +{$ifdef ARM} + RegisterExternalLinker(system_arm_linux_info,TLinkerLinux); + RegisterImport(system_arm_linux,timportliblinux); + RegisterExport(system_arm_linux,texportliblinux); + RegisterTarget(system_arm_linux_info); +{$endif ARM} +end. diff --git a/compiler/systems/t_macos.pas b/compiler/systems/t_macos.pas new file mode 100644 index 0000000000..115fbbc330 --- /dev/null +++ b/compiler/systems/t_macos.pas @@ -0,0 +1,273 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + This unit implements support import,export,link routines for MacOS. + + 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_macos; + +{$i fpcdefs.inc} + +interface + + uses + import,symsym,symdef,link; + + type + timportlibmacos=class(timportlib) + procedure preparelib(const s:string);override; + procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; + procedure importvariable(vs:tglobalvarsym;const name,module:string);override; + procedure generatelib;override; + end; + + tlinkermpw=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + +implementation + + uses + cutils,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_macos, + symconst; + +{***************************************************************************** + TIMPORTLIBMACOS +*****************************************************************************} + +procedure timportlibmacos.preparelib(const s : string); +begin +end; + + +procedure timportlibmacos.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); +end; + + +procedure timportlibmacos.importvariable(vs:tglobalvarsym;const name,module:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); + { reset the mangledname and turn off the dll_var option } + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); +end; + + +procedure timportlibmacos.generatelib; +begin +end; + +{***************************************************************************** + TLINKERMPW +*****************************************************************************} + +Constructor TLinkerMPW.Create; +begin + Inherited Create; + //LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true); +end; + + +procedure TLinkerMPW.SetDefaultInfo; + +begin + with Info do + begin + ExeCmd[1]:='Execute $RES'; {The link.res file contains the whole link command.} + //ExeCmd[1]:='PPCLink $OPT $DYNLINK $STATIC $STRIP -tocdataref off -dead on -o $EXE -@filelist $RES'; + //DllCmd[1]:='PPCLink $OPT $INIT $FINI $SONAME -shared -o $EXE -@filelist $RES'; + end; +end; + + +Function TLinkerMPW.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + s,heapsizestr: string; + +begin + WriteResponseFile:=False; + { Open link.res file } + linkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + with linkRes do + begin + {#182 is escape char in MPW (analog to backslash in unix). The space} + {ensures there is whitespace separating items.} + Add('PPCLink '#182); + + { Add MPW standard libraries} + if apptype = app_cui then + Add('"{PPCLibraries}PPCSIOW.o" '#182); + + {Even GUI apps must link to PPCToolLibs, because of the System unit + which can be used by MPW tools as well as by GUI apps.} + Add('"{PPCLibraries}PPCToolLibs.o" '#182); + Add('"{SharedLibraries}InterfaceLib" '#182); + Add('"{SharedLibraries}StdCLib" '#182); + Add('"{SharedLibraries}MathLib" '#182); + Add('"{PPCLibraries}StdCRuntime.o" '#182); + Add('"{PPCLibraries}PPCCRuntime.o" '#182); + + {Add main objectfiles} + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + Add(s+' '#182); + end; + + {Add last lines of the link command} + if apptype = app_tool then + Add('-t "MPST" -c "MPS " '#182); + + if apptype = app_cui then {If SIOW, to avoid some warnings.} + Add('-ignoredups __start -ignoredups .__start -ignoredups main -ignoredups .main -ignoredups qd '#182); + + Add('-tocdataref off -sym on -dead on -o '+ ScriptFixFileName(current_module.exefilename^)); + + Add('Exit If "{Status}" != 0'); + + if heapsize = 0 then + heapsizestr:= HexStr(384000, 8) + else + heapsizestr:= HexStr(heapsize, 8); + + {Add a SIZE resource on the fly. It controls: + * backgrounding is enabled, to facilitate debuging with Power Mac Debugger + * it is signaled it is a 32 bit app. (perhaps not nessecary on PowerPC) + * heapsize } + if apptype <> app_tool then + begin + Add('Echo "data ''SIZE'' (-1) '#182'{ $'#182'"1080 ' + heapsizestr + ' ' + heapsizestr + + #182'" '#182'};" | Rez -a -o ' + ScriptFixFileName(current_module.exefilename^)); + Add('Exit If "{Status}" != 0'); + end; + + {Add mac resources} + if apptype = app_cui then + begin + Add('Rez -a "{RIncludes}"SIOW.r -o ' + ScriptFixFileName(current_module.exefilename^)); + Add('Exit If "{Status}" != 0'); + end; + + while not (current_module.ResourceFiles.Empty) do + begin + s := Current_module.ResourceFiles.GetFirst; + if Copy(s,Length(s)-1,Length(s)) = '.r' then + Add('Rez -a ' + s + ' -o ' + ScriptFixFileName(current_module.exefilename^)) + else + Add('DeRez ' + s + ' | Rez -a -o ' + ScriptFixFileName(current_module.exefilename^)); + Add('Exit If "{Status}" != 0'); + end; + + end; + + { Write and Close response } + linkres.writetodisk; + linkres.Free; + + WriteResponseFile:=True; +end; + + +function TLinkerMPW.MakeExecutable:boolean; +var + binstr : string; + cmdstr : TCmdStr; + success : boolean; + DynLinkStr : string[60]; + StaticStr, + StripStr : string[40]; + + s: string; + +begin + //TODO Only external link in MPW is possible, otherwise yell. + + if not(cs_link_extern in aktglobalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StripStr:=''; +(* + StaticStr:=''; + DynLinkStr:=''; + if (cs_link_staticflag in aktglobalswitches) then + StaticStr:='-static'; + if (cs_link_strip in aktglobalswitches) then + StripStr:='-s'; + If (cs_profile in aktmoduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; +*) + +{ Prepare linking } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(ScriptFixFileName(current_module.exefilename^))); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(ScriptFixFileName(outputexedir+Info.ResName))); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + + WriteResponseFile(false); + + success:= true; + if cs_link_on_target in aktglobalswitches then + success:=DoExec('SetFile', ' -c ''MPS '' -t ''TEXT'' ' + + ScriptFixFileName(outputexedir+Info.ResName),true,false); + +{ Call linker } + if success then + success:=DoExec('Execute',CmdStr,true,false); + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef m68k} + RegisterTarget(system_m68k_macos_info); + RegisterImport(system_m68k_macos,timportlibmacos); +{$endif m68k} +{$ifdef powerpc} + RegisterExternalLinker(system_powerpc_macos_info,TLinkerMPW); + RegisterTarget(system_powerpc_macos_info); + RegisterImport(system_powerpc_macos,timportlibmacos); +{$endif powerpc} +end. diff --git a/compiler/systems/t_morph.pas b/compiler/systems/t_morph.pas new file mode 100644 index 0000000000..0657f808ab --- /dev/null +++ b/compiler/systems/t_morph.pas @@ -0,0 +1,269 @@ +{ + Copyright (c) 2004 by Free Pascal Development Team + + This unit implements support import, export, link routines + for the MorphOS (PowerPC) 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_morph; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + link, + cutils,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_morph; + + type + PlinkerMorphOS=^TlinkerMorphOS; + TlinkerMorphOS=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create; override; + procedure SetDefaultInfo; override; + function MakeExecutable:boolean; override; + end; + +{$IFDEF MORPHOS} +{ * PathConv is implemented in the system unit! * } +function PathConv(path: string): string; external name 'PATHCONV'; +{$ELSE} +function PathConv(path: string): string; +begin + PathConv:=path; +end; +{$ENDIF} + +{**************************************************************************** + TLinkerMorphOS +****************************************************************************} + +Constructor TLinkerMorphOS.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkerMorphOS.SetDefaultInfo; +begin + with Info do + begin + if (cs_link_on_target in aktglobalswitches) then + begin + ExeCmd[1]:='ld $OPT -o $EXE $RES'; + ExeCmd[2]:='strip --strip-unneeded --remove-section .comment $EXE'; + end + else + begin + ExeCmd[1]:='fpcvlink -b elf32amiga $OPT $STRIP -o $EXE -T $RES'; + end; + end; +end; + + +Function TLinkerMorphOS.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TStringListItem; + s : string; + linklibc : boolean; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TStringListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if (cs_link_on_target in aktglobalswitches) then + s:=ScriptFixFileName(s); + LinkRes.Add('-L'+s); + HPath:=TStringListItem(HPath.Next); + end; + HPath:=TStringListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if s<>'' then + LinkRes.Add('SEARCH_DIR('+PathConv(maybequoted(s))+')'); + HPath:=TStringListItem(HPath.Next); + end; + + LinkRes.Add('INPUT ('); + { add objectfiles, start with prt0 always } + s:=FindObjectFile('prt0','',false); + LinkRes.AddFileName(s); + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + { vlink doesn't use SEARCH_DIR for object files } + if not(cs_link_on_target in aktglobalswitches) then + s:=FindObjectFile(s,'',false); + LinkRes.AddFileName(PathConv(maybequoted(s))); + end; + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + { vlink doesn't need, and doesn't support GROUP } + if (cs_link_on_target in aktglobalswitches) then + begin + LinkRes.Add(')'); + LinkRes.Add('GROUP('); + end; + while not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(PathConv(maybequoted(s))); + end; + end; + + if (cs_link_on_target in aktglobalswitches) then + begin + LinkRes.Add(')'); + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.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; + end + else + begin + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + LinkRes.Add('lib'+s+target_info.staticlibext); + end; + LinkRes.Add(')'); + end; + + +{ Write and Close response } + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; + +end; + + +function TLinkerMorphOS.MakeExecutable:boolean; +var + binstr : string; + cmdstr : TCmdStr; + success : boolean; + StripStr: string[40]; +begin + + if not(cs_link_extern in aktglobalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + + if not (cs_link_on_target in aktglobalswitches) then + begin + StripStr:=''; + if (cs_link_strip in aktglobalswitches) then + StripStr:='-s -P __abox__'; + end; + +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + if not(cs_link_on_target in aktglobalswitches) then + begin + Replace(cmdstr,'$EXE',PathConv(maybequoted(ScriptFixFileName(current_module.exefilename^)))); + Replace(cmdstr,'$RES',PathConv(maybequoted(ScriptFixFileName(outputexedir+Info.ResName)))); + Replace(cmdstr,'$STRIP',StripStr); + end + else + begin + Replace(cmdstr,'$EXE',maybequoted(ScriptFixFileName(current_module.exefilename^))); + Replace(cmdstr,'$RES',maybequoted(ScriptFixFileName(outputexedir+Info.ResName))); + end; + success:=DoExec(FindUtil(BinStr),cmdstr,true,false); + +{ Stripping Enabled? } + { For MorphOS a separate strip command is needed, to avoid stripping } + { __abox__ symbol, which is required to be present in current MorphOS } + { executables. } + if (cs_link_on_target in aktglobalswitches) then + begin + if success and (cs_link_strip in aktglobalswitches) then + begin + SplitBinCmd(Info.ExeCmd[2],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,false); + end; + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } + +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_powerpc_morphos_info,TLinkerMorphOS); + RegisterTarget(system_powerpc_morphos_info); +end. diff --git a/compiler/systems/t_nwl.pas b/compiler/systems/t_nwl.pas new file mode 100644 index 0000000000..78e1ba0d93 --- /dev/null +++ b/compiler/systems/t_nwl.pas @@ -0,0 +1,645 @@ +{ + Copyright (c) 1998-2004 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) Netware libc 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. + + Currently generating NetWare-NLM's only work under Linux and win32. + (see http://home.arcor.de/armin.diehl/fpcnw for binutils working + with win32) while not included in fpc-releases. + + The following compiler-swiches are supported for NetWare: + $DESCRIPTION : NLM-Description, will be displayed at load-time + $M : For Stack-Size, Heap-Size will be ignored + 32K is the accepted minimum + $VERSION x.x.x : Sets Major, Minor and Revision + $SCREENNAME : Sets the ScreenName + $THREADNAME : Sets current threadname + + Additional parameters for the nlmvonv-inputfile can be passed with + -k, i.e. -kREENTRANT will add the option REENTRANT to the nlmconv + inputfile. A ; will be converted into a newline + + Exports will be handled like in win32: + procedure bla; cdecl; + begin + end; + + exports foo name 'Bar'; + + The path to the import-Files must be specified by the library-path. + All external modules are defined as autoload. (Note: the import-files have + to be in unix-format for exe2nlm) + By default, the most import files are included in freepascal. + + e.g. function getgrnam(name:Pchar):Pgroup;cdecl;external 'libc' 'getgrnam'; + sets IMPORT @libc.imp and MODULE libc. + To avoid setting the autoload, use ! in the name, e.g. + procedure EnterDebugger;cdecl;external '!netware' name 'EnterDebugger'; + + Function simply defined as external work without generating autoload and + IMPORT but you will get a warning from nlmconv. + + If you dont have nlmconv, compile gnu-binutils with + ./configure --enable-targets=i386-netware + make all + + Debugging is possible with gdb and a converter from gdb to ndi available + at http://home.arcor.de/armin.diehl/gdbnw + + A sample program: + + Program Hello; + (*$DESCRIPTION HelloWorldNlm*) + (*$VERSION 1.2.3*) + (*$ScreenName Hello*) + (*$M 60000,60000*) + begin + writeLn ('hello world'); + end. + + compile with: + ppc386 -Tnetwlibc hello + + Libraries are supported but this needs at least netware 5.1 sp6, + 6.0 sp3 or netware 6.5 + + In case there is a xdc file with the same name as the nlm name, + this file will be used for nlmconv. Otherwise a temp xdc will + be created and used. + +**************************************************************************** +} +unit t_nwl; + +{$i fpcdefs.inc} + +interface + + +implementation + +{$ifdef netwlibc} +{$define netware} +{$endif} + + uses + cutils, + verbose,systems,globtype,globals, + symconst,script, + fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,symdef, + import,export,link,i_nwl + {$ifdef netware} ,dos {$endif} + ; + + type + timportlibnetwlibc=class(timportlib) + procedure preparelib(const s:string);override; + procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; + procedure importvariable(vs:tglobalvarsym;const name,module:string);override; + procedure generatelib;override; + end; + + texportlibnetwlibc=class(texportlib) + procedure preparelib(const s : string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure generatelib;override; + end; + + tlinkernetwlibc=class(texternallinker) + private + NLMConvLinkFile: TLinkRes; {for second pass, fist pass is ld} + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeNetwareLoadableModule (isLib : boolean):boolean; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + end; + +Const tmpLinkFileName = '~link~tmp.o'; + minStackSize = 32768; + +{***************************************************************************** + TIMPORTLIBNETWARE +*****************************************************************************} + +procedure timportlibnetwlibc.preparelib(const s : string); +begin +end; + + +procedure timportlibnetwlibc.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); +end; + + +procedure timportlibnetwlibc.importvariable(vs:tglobalvarsym;const name,module:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); + { reset the mangledname and turn off the dll_var option } + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); +end; + + +procedure timportlibnetwlibc.generatelib; +begin +end; + + +{***************************************************************************** + TEXPORTLIBNETWARE +*****************************************************************************} + +procedure texportlibnetwlibc.preparelib(const s:string); +begin +end; + + +procedure texportlibnetwlibc.exportprocedure(hp : texported_item); +var + hp2 : texported_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 netware'); + 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:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_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=texported_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 texportlibnetwlibc.exportvar(hp : texported_item); +begin + hp.is_var:=true; + exportprocedure(hp); +end; + + +procedure texportlibnetwlibc.generatelib; +var + hp2 : texported_item; +begin + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if (not hp2.is_var) and + (hp2.sym.typ=procsym) then + begin + { the manglednames can already be the same when the procedure + is declared with cdecl } + if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then + begin +{$ifdef i386} + { place jump in al_procedures } + asmlist[al_procedures].concat(Tai_align.Create_op(4,$90)); + asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + asmlist[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); + asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); +{$endif i386} + end; + end + else + //Comment(V_Error,'Exporting of variables is not supported under netware'); + Message1(parser_e_no_export_of_variables_for_target,'netware'); + hp2:=texported_item(hp2.next); + end; +end; + + +{***************************************************************************** + TLINKERNETWARE +*****************************************************************************} + +Constructor TLinkerNetwlibc.Create; +begin + Inherited Create; +end; + + +procedure TLinkerNetwlibc.SetDefaultInfo; +begin + with Info do + begin + {$ifndef netware} + ExeCmd[1]:= FindUtil(utilsprefix+'ld') + ' -Ur -T $RES $STRIP -o $TMPOBJ'; + ExeCmd[2]:= FindUtil(utilsprefix+'nlmconv') + ' -T$RES'; + {$else} + {for running on netware we need absolute pathes since ld has another working directory} + ExeCmd[1]:= FindUtil(utilsprefix+'ld') + ' -Ur -T '+FExpand(outputexedir+Info.ResName)+' $STRIP -o '+Fexpand(outputexedir+tmpLinkFileName); + ExeCmd[2]:= FindUtil(utilsprefix+'nlmconv') + ' -T'+FExpand(outputexedir+'n'+Info.ResName); + {$endif} + end; +end; + + +Function TLinkerNetwlibc.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + s,s2,s3 : string; + ProgNam : string [80]; + NlmNam : string [80]; + hp2 : texported_item; { for exports } + p : byte; +begin + WriteResponseFile:=False; + + ProgNam := current_module.exefilename^; + i:=Pos(target_info.exeext,ProgNam); + if i>0 then + Delete(ProgNam,i,255); + NlmNam := ProgNam + target_info.exeext; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); {for ld} + NLMConvLinkFile:=TLinkRes.Create(outputexedir+'n'+Info.ResName); {for nlmconv, written in CreateExeFile} + + p := Pos ('"', Description); + while (p > 0) do + begin + delete (Description,p,1); + p := Pos ('"', Description); + end; + if Description <> '' then + NLMConvLinkFile.Add('DESCRIPTION "' + Description + '"'); + NLMConvLinkFile.Add('VERSION '+tostr(dllmajor)+','+tostr(dllminor)+','+tostr(dllrevision)); + + p := Pos ('"', nwscreenname); + while (p > 0) do + begin + delete (nwscreenname,p,1); + p := Pos ('"', nwscreenname); + end; + p := Pos ('"', nwthreadname); + while (p > 0) do + begin + delete (nwthreadname,p,1); + p := Pos ('"', nwthreadname); + end; + p := Pos ('"', nwcopyright); + while (p > 0) do + begin + delete (nwcopyright,p,1); + p := Pos ('"', nwcopyright); + end; + + if nwscreenname <> '' then + NLMConvLinkFile.Add('SCREENNAME "' + nwscreenname + '"'); + if nwthreadname <> '' then + NLMConvLinkFile.Add('THREADNAME "' + nwthreadname + '"'); + if nwcopyright <> '' then + NLMConvLinkFile.Add('COPYRIGHT "' + nwcopyright + '"'); + + if stacksize < minStackSize then stacksize := minStackSize; + str (stacksize, s); + NLMConvLinkFile.Add ('STACKSIZE '+s); + {$ifndef netware} + NLMConvLinkFile.Add ('INPUT '+outputexedir+tmpLinkFileName); + {$else} + NLMConvLinkFile.Add ('INPUT '+FExpand(outputexedir+tmpLinkFileName)); + {$endif} + + { add objectfiles, start with nwpre always } + LinkRes.Add ('INPUT('); + s2 := FindObjectFile('nwplibc','',false); + if s2 = '' then + s2 := FindObjectFile('libcpre.gcc','',false); + Comment (V_Debug,'adding Object File '+s2); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + + if isDll then {needed to provide main} + s2 := FindObjectFile('nwl_dlle','',false) + else + s2 := FindObjectFile('nwl_main','',false); + Comment (V_Debug,'adding Object File '+s2); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + + { main objectfiles, add to linker input } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + s2 := FindObjectFile (s,'',false); + Comment (V_Debug,'adding Object File '+s2); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + end; + end; + LinkRes.Add (')'); + + { output file (nlm), add to nlmconv } + {$ifndef netware} + NLMConvLinkFile.Add ('OUTPUT ' + NlmNam); + {$else} + NLMConvLinkFile.Add ('OUTPUT ' + FExpand(NlmNam)); + {$endif} + + { start and stop-procedures } + NLMConvLinkFile.Add ('START _LibCPrelude'); + NLMConvLinkFile.Add ('EXIT _LibCPostlude'); + NLMConvLinkFile.Add ('CHECK _LibCCheckUnload'); + NLMConvLinkFile.Add ('REENTRANT'); { needed by older libc versions } + + if not (cs_link_strip in aktglobalswitches) then + begin + NLMConvLinkFile.Add ('DEBUG'); + Comment(V_Debug,'DEBUG'); + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add ('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=lower (StaticLibFiles.GetFirst); + if s<>'' then + begin + {ad: that's a hack ! + whith -XX we get the .a files as static libs (in addition to the + imported libraries} + if (pos ('.a',s) <> 0) OR (pos ('.A', s) <> 0) then + begin + S2 := FindObjectFile(s,'',false); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + Comment(V_Debug,'adding Object File (StaticLibFiles) '+S2); + end else + begin + i:=Pos(target_info.staticlibext,S); + if i>0 then + Delete(S,i,255); + S := S + '.imp'; S2 := ''; + librarysearchpath.FindFile(S,S2); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+s2); + s2 := FExpand (S2); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S2); + Comment(V_Debug,'IMPORT @'+s2); + end; + end + end; + LinkRes.Add (')'); + end; + + if not SharedLibFiles.Empty then + begin + While not SharedLibFiles.Empty do + begin + {becuase of upper/lower case mix, we may get duplicate + names but nlmconv ignores that. + Here we are setting the import-files for nlmconv. I.e. for + the module libc or libc.nlm we add IMPORT @libc.imp and also + the module libc.nlm (autoload) + If a lib name begins with !, only the IMPORT will be generated + ? may it be better to set autoload's via StaticLibFiles ? } + S:=lower (SharedLibFiles.GetFirst); + if s<>'' then + begin + s2:=s; + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + if s[1] = '!' then + begin // special, with ! only the imp will be included but no module is autoloaded, needed i.e. for netware.imp inlcuded in libc ndk + delete (s,1,1); + S := S + '.imp'; + librarysearchpath.FindFile(S,S3); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+S3); + S3 := FExpand (S3); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S3); + Comment(V_Debug,'IMPORT @'+S3); + end else + begin + S := S + '.imp'; + librarysearchpath.FindFile(S,S3); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+S3); + S3 := FExpand (S3); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S3); + NLMConvLinkFile.Add('MODULE '+s2); + Comment(V_Debug,'MODULE '+S2); + Comment(V_Debug,'IMPORT @'+S3); + end; + end + end; + end; + + { write exports } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if not hp2.is_var then + begin + { Export the Symbol } + Comment(V_Debug,'EXPORT '+hp2.name^); + NLMConvLinkFile.Add ('EXPORT '+hp2.name^); + end + else + { really, i think it is possible } + {Comment(V_Error,'Exporting of variables is not supported under netware');} + Message1(parser_e_no_export_of_variables_for_target,'netware'); + hp2:=texported_item(hp2.next); + end; + +{ Write and Close response for ld, response for nlmconv is in NLMConvLinkFile(not written) } + linkres.writetodisk; + LinkRes.Free; + +{ pass options from -k to nlmconv, ; is interpreted as newline } + s := ParaLinkOptions; + while(Length(s) > 0) and (s[1] = ' ') do + delete (s,1,1); + p := pos ('"',s); + while p > 0 do + begin + delete (s,p,1); + p := pos ('"',s); + end; + + p := pos (';',s); + while p > 0 do + begin + s2 := copy(s,1,p-1); + comment (V_Debug,'adding "'+s2+'" to nlmvonv input'); + NLMConvLinkFile.Add(s2); + delete (s,1,p); + p := pos (';',s); + end; + if s <> '' then + begin + comment (V_Debug,'adding "'+s+'" to nlmvonv input'); + NLMConvLinkFile.Add(s); + end; + + WriteResponseFile:=True; +end; + +Const + xdc : Array[0..127] of char = ( + 'B','A','G','F',#2,#0,#0,#0,#1,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0, + #0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#2,#0,#0,#0,#0,#0,#0,#0,#16,#0,#0, + #0,#7,'M','P','K','_','B','a','g',#0,#0,#0,#0,#0,#0,#0,#0,#11,'M','T', + ' ','S','a','f','e',' ','N','L','M',#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0, + #0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0, + #0,#0,#0,#0,#0,#0,#1,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0); + + +function TLinkerNetwlibc.MakeNetwareLoadableModule (isLib : boolean):boolean; +var + binstr : String; + cmdstr : TcmdStr; + xdcname : string; + success : boolean; + StripStr : string[2]; + xdcpresent,usexdc : boolean; + f : file; +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 and create Headerfile for + nlmconv in NLMConvLinkFile } + WriteResponseFile(isLib); + if isLib then + NLMConvLinkFile.Add('FLAG_ON 1024'); {0x400 Specifies whether the NLM is a shared library.} + +{ if we have a xdc file, dont touch it, otherwise create a new + one and remove it after nlmconv } + xdcname := ForceExtension(current_module.exefilename^,'.xdc'); + xdcpresent := FileExists (xdcname); + if not xdcpresent then + begin + assign (f,xdcname); + rewrite(f,1); + if ioresult = 0 then + begin + blockwrite (f,xdc,sizeof(xdc)); + close(f); + usexdc := (IOResult = 0); + end else + usexdc := false; + end else + usexdc := true; + + if usexdc then + NLMConvLinkFile.Add('XDCDATA '+xdcname); + +{ Call linker, this will generate a new object file that will be passed + to nlmconv. Otherwise we could not create nlms without debug info } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$TMPOBJ',maybequoted(outputexedir+tmpLinkFileName)); + Comment (v_debug,'Executing '+BinStr+' '+cmdstr); + success:=DoExec(FindUtil(BinStr),CmdStr,true,false); + + { Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + +{ Call nlmconv } + if success then + begin + NLMConvLinkFile.writetodisk; + NLMConvLinkFile.Free; + SplitBinCmd(Info.ExeCmd[2],binstr,cmdstr); + Replace(cmdstr,'$RES',maybequoted(outputexedir+'n'+Info.ResName)); + Comment (v_debug,'Executing '+BinStr+' '+cmdstr); + success:=DoExec(FindUtil(BinStr),CmdStr,true,false); + if (success) and not(cs_link_extern in aktglobalswitches) then + begin + RemoveFile(outputexedir+'n'+Info.ResName); + RemoveFile(outputexedir+tmpLinkFileName); + if not xdcpresent then + if usexdc then + RemoveFile (xdcname); + end; + end; + + MakeNetwareLoadableModule:=success; { otherwise a recursive call to link method } +end; + +function TLinkerNetwlibc.MakeExecutable:boolean; +begin + MakeExecutable := MakeNetwareLoadableModule (false); +end; + + +function TLinkerNetwlibc.MakeSharedLibrary:boolean; +begin + MakeSharedLibrary := MakeNetwareLoadableModule (true); +end; + +{***************************************************************************** + Initialize +*****************************************************************************} + + +initialization + RegisterExternalLinker(system_i386_netwlibc_info,TLinkerNetwlibc); + RegisterImport(system_i386_netwlibc,TImportLibNetwlibc); + RegisterExport(system_i386_netwlibc,TExportLibNetwlibc); + RegisterTarget(system_i386_netwlibc_info); +end. diff --git a/compiler/systems/t_nwm.pas b/compiler/systems/t_nwm.pas new file mode 100644 index 0000000000..d231a67c98 --- /dev/null +++ b/compiler/systems/t_nwm.pas @@ -0,0 +1,576 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) Netware 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. + + Currently generating NetWare-NLM's only work under Linux and win32. + (see http://home.arcor.de/armin.diehl/fpcnw for binutils working + with win32) while not included in fpc-releases. + + The following compiler-swiches are supported for NetWare: + $DESCRIPTION : NLM-Description, will be displayed at load-time + $M : For Stack-Size, Heap-Size will be ignored + 32K is the accepted minimum + $VERSION x.x.x : Sets Major, Minor and Revision + $SCREENNAME : Sets the ScreenName + $THREADNAME : Sets current threadname + + Displaying copyright does not work with nlmconv from gnu bunutils + version less that 2.13 + + Additional parameters for the nlmvonv-inputfile can be passed with + -k, i.e. -kREENTRANT will add the option REENTRANT to the nlmconv + inputfile. A ; will be converted into a newline + + Exports will be handled like in win32: + procedure bla; + begin + end; + + exports foo name 'Bar'; + + The path to the import-Files must be specified by the library-path. + All external modules are defined as autoload. (Note: the import-files have + to be in unix-format for exe2nlm) + By default, the most import files are included in freepascal. + + i.e. Procedure ConsolePrintf (p:pchar); cdecl; external 'clib.nlm'; + sets IMPORT @clib.imp and MODULE clib. + + Function simply defined as external work without generating autoload but + you will get a warnung from nlmconv. + + If you dont have nlmconv, compile gnu-binutils with + ./configure --enable-targets=i386-linux,i386-netware + make all + + Debugging is possible with gdb and a converter from gdb to ndi available + at http://home.arcor.de/armin.diehl/gdbnw + + A sample program: + + Program Hello; + (*$DESCRIPTION HelloWorldNlm*) + (*$VERSION 1.2.3*) + (*$ScreenName Hello*) + (*$M 60000,60000*) + begin + writeLn ('hello world'); + end. + + compile with: + ppc386 -Tnetware hello + + ToDo: + - No duplicate imports and autoloads + - libc support (needs new target) + +**************************************************************************** +} +unit t_nwm; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + cutils, + verbose,systems,globtype,globals, + symconst,script, + fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,symdef, + import,export,link,i_nwm + {$ifdef netware} ,dos {$endif} + ; + + type + timportlibnetware=class(timportlib) + procedure preparelib(const s:string);override; + procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; + procedure importvariable(vs:tglobalvarsym;const name,module:string);override; + procedure generatelib;override; + end; + + texportlibnetware=class(texportlib) + procedure preparelib(const s : string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure generatelib;override; + end; + + tlinkernetware=class(texternallinker) + private + NLMConvLinkFile: TLinkRes; {for second pass, fist pass is ld} + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + +Const tmpLinkFileName = 'link~tmp._o_'; + minStackSize = 32768; + +{***************************************************************************** + TIMPORTLIBNETWARE +*****************************************************************************} + +procedure timportlibnetware.preparelib(const s : string); +begin +end; + + +procedure timportlibnetware.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); +end; + + +procedure timportlibnetware.importvariable(vs:tglobalvarsym;const name,module:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); + { reset the mangledname and turn off the dll_var option } + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); +end; + + +procedure timportlibnetware.generatelib; +begin +end; + + +{***************************************************************************** + TEXPORTLIBNETWARE +*****************************************************************************} + +procedure texportlibnetware.preparelib(const s:string); +begin +end; + + +procedure texportlibnetware.exportprocedure(hp : texported_item); +var + hp2 : texported_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 netware'); + 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:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_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=texported_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 texportlibnetware.exportvar(hp : texported_item); +begin + hp.is_var:=true; + exportprocedure(hp); +end; + + +procedure texportlibnetware.generatelib; +var + hp2 : texported_item; +begin + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if (not hp2.is_var) and + (hp2.sym.typ=procsym) then + begin + { the manglednames can already be the same when the procedure + is declared with cdecl } + if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then + begin +{$ifdef i386} + { place jump in al_procedures } + asmlist[al_procedures].concat(Tai_align.Create_op(4,$90)); + asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + asmlist[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,objectlibrary.newasmsymbol(tprocsym(hp2.sym).first_procdef.mangledname,AB_EXTERNAL,AT_FUNCTION))); + asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); +{$endif i386} + end; + end + else + //Comment(V_Error,'Exporting of variables is not supported under netware'); + Message1(parser_e_no_export_of_variables_for_target,'netware'); + hp2:=texported_item(hp2.next); + end; +end; + + +{***************************************************************************** + TLINKERNETWARE +*****************************************************************************} + +Constructor TLinkerNetware.Create; +begin + Inherited Create; +end; + + +procedure TLinkerNetware.SetDefaultInfo; +begin + with Info do + begin + {$ifndef netware} + ExeCmd[1]:= FindUtil(utilsprefix+'ld') + ' -Ur -T $RES $STRIP -o $TMPOBJ'; + ExeCmd[2]:= FindUtil(utilsprefix+'nlmconv') + ' -T$RES'; + {$else} + {for running on netware we need absolute pathes since ld has another working directory} + ExeCmd[1]:= FindUtil(utilsprefix+'ld') + ' -Ur -T '+FExpand(outputexedir+Info.ResName)+' $STRIP -o '+Fexpand(outputexedir+tmpLinkFileName); + ExeCmd[2]:= FindUtil(utilsprefix+'nlmconv') + ' -T'+FExpand(outputexedir+'n'+Info.ResName); + {$endif} + end; +end; + + +Function TLinkerNetware.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + s,s2,s3 : string; + ProgNam : string [80]; + NlmNam : string [80]; + hp2 : texported_item; { for exports } + p : byte; +begin + WriteResponseFile:=False; + + ProgNam := current_module.exefilename^; + i:=Pos(target_info.exeext,ProgNam); + if i>0 then + Delete(ProgNam,i,255); + NlmNam := ProgNam + target_info.exeext; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); {for ld} + NLMConvLinkFile:=TLinkRes.Create(outputexedir+'n'+Info.ResName); {for nlmconv, written in CreateExeFile} + + p := Pos ('"', Description); + while (p > 0) do + begin + delete (Description,p,1); + p := Pos ('"', Description); + end; + if Description <> '' then + NLMConvLinkFile.Add('DESCRIPTION "' + Description + '"'); + NLMConvLinkFile.Add('VERSION '+tostr(dllmajor)+','+tostr(dllminor)+','+tostr(dllrevision)); + + p := Pos ('"', nwscreenname); + while (p > 0) do + begin + delete (nwscreenname,p,1); + p := Pos ('"', nwscreenname); + end; + p := Pos ('"', nwthreadname); + while (p > 0) do + begin + delete (nwthreadname,p,1); + p := Pos ('"', nwthreadname); + end; + p := Pos ('"', nwcopyright); + while (p > 0) do + begin + delete (nwcopyright,p,1); + p := Pos ('"', nwcopyright); + end; + + if nwscreenname <> '' then + NLMConvLinkFile.Add('SCREENNAME "' + nwscreenname + '"'); + if nwthreadname <> '' then + NLMConvLinkFile.Add('THREADNAME "' + nwthreadname + '"'); + if nwcopyright <> '' then + NLMConvLinkFile.Add('COPYRIGHT "' + nwcopyright + '"'); + + if stacksize < minStackSize then stacksize := minStackSize; + str (stacksize, s); + NLMConvLinkFile.Add ('STACKSIZE '+s); + {$ifndef netware} + NLMConvLinkFile.Add ('INPUT '+outputexedir+tmpLinkFileName); + {$else} + NLMConvLinkFile.Add ('INPUT '+FExpand(outputexedir+tmpLinkFileName)); + {$endif} + + { add objectfiles, start with nwpre always } + LinkRes.Add ('INPUT('); + s2 := FindObjectFile('nwpre','',false); + Comment (V_Debug,'adding Object File '+s2); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + + { main objectfiles, add to linker input } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + s2 := FindObjectFile (s,'',false); + Comment (V_Debug,'adding Object File '+s2); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + end; + end; + LinkRes.Add (')'); + + { output file (nlm), add to nlmconv } + {$ifndef netware} + NLMConvLinkFile.Add ('OUTPUT ' + NlmNam); + {$else} + NLMConvLinkFile.Add ('OUTPUT ' + FExpand(NlmNam)); + {$endif} + + { start and stop-procedures } + NLMConvLinkFile.Add ('START _Prelude'); { defined in rtl/netware/nwpre.as } + NLMConvLinkFile.Add ('EXIT _Stop'); { nwpre.as } + NLMConvLinkFile.Add ('CHECK FPC_NW_CHECKFUNCTION'); { system.pp } + + if not (cs_link_strip in aktglobalswitches) then + begin + NLMConvLinkFile.Add ('DEBUG'); + Comment(V_Debug,'DEBUG'); + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add ('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=lower (StaticLibFiles.GetFirst); + if s<>'' then + begin + {ad: that's a hack ! + whith -XX we get the .a files as static libs (in addition to the + imported libraries} + if (pos ('.a',s) <> 0) OR (pos ('.A', s) <> 0) then + begin + S2 := FindObjectFile(s,'',false); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + Comment(V_Debug,'adding Object File (StaticLibFiles) '+S2); + end else + begin + i:=Pos(target_info.staticlibext,S); + if i>0 then + Delete(S,i,255); + S := S + '.imp'; S2 := ''; + librarysearchpath.FindFile(S,S2); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+s2); + s2 := FExpand (S2); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S2); + Comment(V_Debug,'IMPORT @'+s2); + end; + end + end; + LinkRes.Add (')'); + end; + + if not SharedLibFiles.Empty then + begin + While not SharedLibFiles.Empty do + begin + {becuase of upper/lower case mix, we may get duplicate + names but nlmconv ignores that. + Here we are setting the import-files for nlmconv. I.e. for + the module clib or clib.nlm we add IMPORT @clib.imp and also + the module clib.nlm (autoload) + ? may it be better to set autoload's via StaticLibFiles ? } + S:=lower (SharedLibFiles.GetFirst); + if s<>'' then + begin + s2:=s; + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + if s[1] = '!' then + begin // special, with ! only the imp will be included but no module is autoloaded, needed i.e. for netware.imp + S := copy(S,2,255) + '.imp'; + librarysearchpath.FindFile(S,S3); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+S3); + S3 := FExpand (S3); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S3); + Comment(V_Debug,'IMPORT @'+S3); + end else + begin + S := S + '.imp'; + librarysearchpath.FindFile(S,S3); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+S3); + S3 := FExpand (S3); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S3); + NLMConvLinkFile.Add('MODULE '+s2); + Comment(V_Debug,'MODULE '+S2); + Comment(V_Debug,'IMPORT @'+S3); + end; + end; + end; + end; + + { write exports } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if not hp2.is_var then + begin + { Export the Symbol } + Comment(V_Debug,'EXPORT '+hp2.name^); + NLMConvLinkFile.Add ('EXPORT '+hp2.name^); + end + else + { really, i think it is possible } + Message1(parser_e_no_export_of_variables_for_target,'netware'); + hp2:=texported_item(hp2.next); + end; + +{ Write and Close response for ld, response for nlmconv is in NLMConvLinkFile(not written) } + linkres.writetodisk; + LinkRes.Free; + +{ pass options from -k to nlmconv, ; is interpreted as newline } + s := ParaLinkOptions; + while(Length(s) > 0) and (s[1] = ' ') do + delete (s,1,1); + p := pos ('"',s); + while p > 0 do + begin + delete (s,p,1); + p := pos ('"',s); + end; + + p := pos (';',s); + while p > 0 do + begin + s2 := copy(s,1,p-1); + comment (V_Debug,'adding "'+s2+'" to nlmvonv input'); + NLMConvLinkFile.Add(s2); + delete (s,1,p); + p := pos (';',s); + end; + if s <> '' then + begin + comment (V_Debug,'adding "'+s+'" to nlmvonv input'); + NLMConvLinkFile.Add(s); + end; + + WriteResponseFile:=True; +end; + + +function TLinkerNetware.MakeExecutable:boolean; +var + binstr : String; + cmdstr : TCmdStr; + success : boolean; + StripStr : string[2]; +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 and create Headerfile for + nlmconv in NLMConvLinkFile } + WriteResponseFile(false); + +{ Call linker, this will generate a new object file that will be passed + to nlmconv. Otherwise we could not create nlms without debug info } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$TMPOBJ',maybequoted(outputexedir+tmpLinkFileName)); + Comment (v_debug,'Executing '+BinStr+' '+cmdstr); + success:=DoExec(FindUtil(BinStr),CmdStr,true,false); + + { Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + +{ Call nlmconv } + if success then + begin + NLMConvLinkFile.writetodisk; + NLMConvLinkFile.Free; + SplitBinCmd(Info.ExeCmd[2],binstr,cmdstr); + Replace(cmdstr,'$RES',maybequoted(outputexedir+'n'+Info.ResName)); + Comment (v_debug,'Executing '+BinStr+' '+cmdstr); + success:=DoExec(FindUtil(BinStr),CmdStr,true,false); + if (success) and not(cs_link_extern in aktglobalswitches) then + begin + RemoveFile(outputexedir+'n'+Info.ResName); + RemoveFile(outputexedir+tmpLinkFileName); + end; + end; + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + + +initialization + RegisterExternalLinker(system_i386_netware_info,TLinkerNetware); + RegisterImport(system_i386_netware,TImportLibNetware); + RegisterExport(system_i386_netware,TExportLibNetware); + RegisterTarget(system_i386_netware_info); +end. diff --git a/compiler/systems/t_os2.pas b/compiler/systems/t_os2.pas new file mode 100644 index 0000000000..ed86fe5e21 --- /dev/null +++ b/compiler/systems/t_os2.pas @@ -0,0 +1,516 @@ +{ + Copyright (c) 1998-2002 by Daniel Mantione + Portions Copyright (c) 1998-2002 Eberhard Mattes + + Unit to write out import libraries and def files for OS/2 + + 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. + + **************************************************************************** +} +{ + A lot of code in this unit has been ported from C to Pascal from the + emximp utility, part of the EMX development system. Emximp is copyrighted + by Eberhard Mattes. Note: Eberhard doesn't know much about the Pascal + port, please send questions to Daniel Mantione + <d.s.p.mantione@twi.tudelft.nl>. +} +unit t_os2; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + strings, + dos, + cutils,cclasses, + globtype,systems,symconst,symdef, + globals,verbose,fmodule,script, + import,link,i_os2; + + type + timportlibos2=class(timportlib) + procedure preparelib(const s:string);override; + procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; + procedure generatelib;override; + end; + + tlinkeros2=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + + +const profile_flag:boolean=false; + +const n_ext = 1; + n_abs = 2; + n_text = 4; + n_data = 6; + n_bss = 8; + n_imp1 = $68; + n_imp2 = $6a; + +type reloc=packed record {This is the layout of a relocation table + entry.} + address:longint; {Fixup location} + remaining:longint; + {Meaning of bits for remaining: + 0..23: Symbol number or segment + 24: Self-relative fixup if non-zero + 25..26: Fixup size (0: 1 byte, 1: 2, 2: 4 bytes) + 27: Reference to symbol or segment + 28..31 Not used} + end; + + nlist=packed record {This is the layout of a symbol table entry.} + strofs:longint; {Offset in string table} + typ:byte; {Type of the symbol} + other:byte; {Other information} + desc:word; {More information} + value:longint; {Value (address)} + end; + + a_out_header=packed record + magic:word; {Magic word, must be $0107} + machtype:byte; {Machine type} + flags:byte; {Flags} + text_size:longint; {Length of text, in bytes} + data_size:longint; {Length of initialized data, in bytes} + bss_size:longint; {Length of uninitialized data, in bytes} + sym_size:longint; {Length of symbol table, in bytes} + entry:longint; {Start address (entry point)} + trsize:longint; {Length of relocation info for text, bytes} + drsize:longint; {Length of relocation info for data, bytes} + end; + + ar_hdr=packed record + ar_name:array[0..15] of char; + ar_date:array[0..11] of char; + ar_uid:array[0..5] of char; + ar_gid:array[0..5] of char; + ar_mode:array[0..7] of char; + ar_size:array[0..9] of char; + ar_fmag:array[0..1] of char; + end; + +var aout_str_size:longint; + aout_str_tab:array[0..2047] of byte; + aout_sym_count:longint; + aout_sym_tab:array[0..5] of nlist; + + aout_text:array[0..63] of byte; + aout_text_size:longint; + + aout_treloc_tab:array[0..1] of reloc; + aout_treloc_count:longint; + + aout_size:longint; + seq_no:longint; + + ar_member_size:longint; + + out_file:file; + +procedure write_ar(const name:string;size:longint); + +var ar:ar_hdr; + time:datetime; + dummy:word; + numtime:longint; + tmp:string[19]; + + +begin + ar_member_size:=size; + fillchar(ar.ar_name,sizeof(ar.ar_name),' '); + move(name[1],ar.ar_name,length(name)); + getdate(time.year,time.month,time.day,dummy); + gettime(time.hour,time.min,time.sec,dummy); + packtime(time,numtime); + str(numtime,tmp); + fillchar(ar.ar_date,sizeof(ar.ar_date),' '); + move(tmp[1],ar.ar_date,length(tmp)); + ar.ar_uid:='0 '; + ar.ar_gid:='0 '; + ar.ar_mode:='100666'#0#0; + str(size,tmp); + fillchar(ar.ar_size,sizeof(ar.ar_size),' '); + move(tmp[1],ar.ar_size,length(tmp)); + ar.ar_fmag:='`'#10; + blockwrite(out_file,ar,sizeof(ar)); +end; + +procedure finish_ar; + +var a:byte; + +begin + a:=0; + if odd(ar_member_size) then + blockwrite(out_file,a,1); +end; + +procedure aout_init; + +begin + aout_str_size:=sizeof(longint); + aout_sym_count:=0; + aout_text_size:=0; + aout_treloc_count:=0; +end; + +function aout_sym(const name:string;typ,other:byte;desc:word; + value:longint):longint; + +begin + if aout_str_size+length(name)+1>sizeof(aout_str_tab) then + internalerror(200504245); + if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then + internalerror(200504246); + aout_sym_tab[aout_sym_count].strofs:=aout_str_size; + aout_sym_tab[aout_sym_count].typ:=typ; + aout_sym_tab[aout_sym_count].other:=other; + aout_sym_tab[aout_sym_count].desc:=desc; + aout_sym_tab[aout_sym_count].value:=value; + strPcopy(@aout_str_tab[aout_str_size],name); + aout_str_size:=aout_str_size+length(name)+1; + aout_sym:=aout_sym_count; + inc(aout_sym_count); +end; + +procedure aout_text_byte(b:byte); + +begin + if aout_text_size>=sizeof(aout_text) then + internalerror(200504247); + aout_text[aout_text_size]:=b; + inc(aout_text_size); +end; + +procedure aout_text_dword(d:longint); + +type li_ar=array[0..3] of byte; + +begin + aout_text_byte(li_ar(d)[0]); + aout_text_byte(li_ar(d)[1]); + aout_text_byte(li_ar(d)[2]); + aout_text_byte(li_ar(d)[3]); +end; + +procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint); + +begin + if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then + internalerror(200504248); + aout_treloc_tab[aout_treloc_count].address:=address; + aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+ + len shl 25+ext shl 27; + inc(aout_treloc_count); +end; + +procedure aout_finish; + +begin + while (aout_text_size and 3)<>0 do + aout_text_byte ($90); + aout_size:=sizeof(a_out_header)+aout_text_size+aout_treloc_count* + sizeof(reloc)+aout_sym_count*sizeof(aout_sym_tab[0])+aout_str_size; +end; + +procedure aout_write; + +var ao:a_out_header; + +begin + ao.magic:=$0107; + ao.machtype:=0; + ao.flags:=0; + ao.text_size:=aout_text_size; + ao.data_size:=0; + ao.bss_size:=0; + ao.sym_size:=aout_sym_count*sizeof(aout_sym_tab[0]); + ao.entry:=0; + ao.trsize:=aout_treloc_count*sizeof(reloc); + ao.drsize:=0; + blockwrite(out_file,ao,sizeof(ao)); + blockwrite(out_file,aout_text,aout_text_size); + blockwrite(out_file,aout_treloc_tab,sizeof(reloc)*aout_treloc_count); + blockwrite(out_file,aout_sym_tab,sizeof(aout_sym_tab[0])*aout_sym_count); + longint((@aout_str_tab)^):=aout_str_size; + blockwrite(out_file,aout_str_tab,aout_str_size); +end; + +procedure timportlibos2.preparelib(const s:string); + +{This code triggers a lot of bugs in the compiler. +const armag='!<arch>'#10; + ar_magic:array[1..length(armag)] of char=armag;} +const ar_magic:array[1..8] of char='!<arch>'#10; +var + libname : string; +begin + libname:=FixFileName(S + Target_Info.StaticCLibExt); + seq_no:=1; + current_module.linkotherstaticlibs.add(libname,link_allways); + assign(out_file,current_module.outputpath^+libname); + rewrite(out_file,1); + blockwrite(out_file,ar_magic,sizeof(ar_magic)); +end; + +procedure timportlibos2.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string); +{func = Name of function to import. + module = Name of DLL to import from. + index = Index of function in DLL. Use 0 to import by name. + name = Name of function in DLL. Ignored when index=0;} +var tmp1,tmp2,tmp3:string; + sym_mcount,sym_import:longint; + fixup_mcount,fixup_import:longint; + func : string; +begin + { force the current mangledname } + include(aprocdef.procoptions,po_has_mangledname); + func:=aprocdef.mangledname; + + aout_init; + tmp2:=func; + if profile_flag and not (copy(func,1,4)='_16_') then + begin + {sym_entry:=aout_sym(func,n_text+n_ext,0,0,aout_text_size);} + sym_mcount:=aout_sym('__mcount',n_ext,0,0,0); + {Use, say, "_$U_DosRead" for "DosRead" to import the + non-profiled function.} + tmp2:='__$U_'+func; + sym_import:=aout_sym(tmp2,n_ext,0,0,0); + aout_text_byte($55); {push ebp} + aout_text_byte($89); {mov ebp, esp} + aout_text_byte($e5); + aout_text_byte($e8); {call _mcount} + fixup_mcount:=aout_text_size; + aout_text_dword(0-(aout_text_size+4)); + aout_text_byte($5d); {pop ebp} + aout_text_byte($e9); {jmp _$U_DosRead} + fixup_import:=aout_text_size; + aout_text_dword(0-(aout_text_size+4)); + + aout_treloc(fixup_mcount,sym_mcount,1,2,1); + aout_treloc (fixup_import, sym_import,1,2,1); + end; + str(seq_no,tmp1); + tmp1:='IMPORT#'+tmp1; + if name='' then + begin + str(index,tmp3); + tmp3:=func+'='+module+'.'+tmp3; + end + else + tmp3:=func+'='+module+'.'+name; + aout_sym(tmp2,n_imp1+n_ext,0,0,0); + aout_sym(tmp3,n_imp2+n_ext,0,0,0); + aout_finish; + write_ar(tmp1,aout_size); + aout_write; + finish_ar; + inc(seq_no); +end; + +procedure timportlibos2.generatelib; + +begin + close(out_file); +end; + + +{**************************************************************************** + TLinkeros2 +****************************************************************************} + +Constructor TLinkeros2.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkeros2.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld $OPT -o $OUT @$RES'; + ExeCmd[2]:='emxbind -b $STRIP $APPTYPE $RSRC -k$STACKKB -h1 -o $EXE $OUT -ai -s8'; + if Source_Info.Script = script_dos then + ExeCmd[3]:='del $OUT'; + end; +end; + + +Function TLinkeros2.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TStringListItem; + s : string; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TStringListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TStringListItem(HPath.Next); + end; + HPath:=TStringListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TStringListItem(HPath.Next); + end; + + { add objectfiles, start with prt0 always } + LinkRes.AddFileName(FindObjectFile('prt0','',false)); + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(s); + end; + + { Write staticlibraries } + { No group !! This will not work correctly PM } + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + 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.GetFirst; + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end; + +{ Write and Close response } + linkres.writetodisk; + LinkRes.Free; + + WriteResponseFile:=True; +end; + + +function TLinkeros2.MakeExecutable:boolean; +var + binstr : String; + cmdstr : TCmdStr; + success : boolean; + i : longint; + AppTypeStr, + StripStr: string[40]; + RsrcStr : string; + DS: DirStr; + NS: NameStr; + ES: ExtStr; + OutName: PathStr; +begin + if not(cs_link_extern in aktglobalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + FSplit (current_module.exefilename^, DS, NS, ES); + OutName := DS + NS + '.out'; + if (cs_link_strip in aktglobalswitches) then + StripStr := '-s' + else + StripStr := ''; + if (usewindowapi) or (AppType = app_gui) then + AppTypeStr := '-p' + else if AppType = app_fs then + AppTypeStr := '-f' + else AppTypeStr := '-w'; + if not (Current_module.ResourceFiles.Empty) then + RsrcStr := '-r ' + Current_module.ResourceFiles.GetFirst + else + RsrcStr := ''; +(* Only one resource file supported, discard everything else + (should be already empty anyway, though). *) + Current_module.ResourceFiles.Clear; +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + success:=false; + for i:=1 to 3 do + begin + SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr); + if binstr<>'' then + begin + { Is this really required? Not anymore according to my EMX docs } + Replace(cmdstr,'$HEAPMB',tostr((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+1023) shr 10)); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$APPTYPE',AppTypeStr); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RSRC',RsrcStr); + Replace(cmdstr,'$OUT',maybequoted(OutName)); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + if i<>3 then + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false) + else + success:=DoExec(binstr,cmdstr,(i=1),true); + end; + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_i386_os2_info,TLinkerOS2); + RegisterImport(system_i386_os2,TImportLibOS2); +{ RegisterRes(res_emxbind_info);} + RegisterTarget(system_i386_os2_info); +end. diff --git a/compiler/systems/t_palmos.pas b/compiler/systems/t_palmos.pas new file mode 100644 index 0000000000..b2e4a6e2eb --- /dev/null +++ b/compiler/systems/t_palmos.pas @@ -0,0 +1,212 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) Amiga 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_palmos; + +{$i fpcdefs.inc} + +interface + + uses + link; + + type + tlinkerPalmOS=class(texternallinker) + private + Function WriteResponseFile : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + + +implementation + + uses + cutils,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_palmos; + +{**************************************************************************** + TLinkerPalmOS +****************************************************************************} + +Constructor TLinkerPalmOS.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkerPalmOS.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ldpalm $OPT $STRIP -N -dy -T $SCRIPT -o $EXE @$RES'; + ExeCmd[2]:='build-prc $EXE.prc "$APPNAME" $APPID $EXE *.bin'; + end; +end; + + +Function TLinkerPalmOS.WriteResponseFile : Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : PStringQueueItem; + s : string; + linklibc : boolean; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TStringListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TStringListItem(HPath.Next); + end; + HPath:=TStringListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TStringListItem(HPath.Next); + end; + + { add objectfiles, start with crt0 always } + { using crt0, we should stick C compatible } + LinkRes.AddFileName(FindObjectFile('crt0','')); + + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(s); + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add('-('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(s) + end; + LinkRes.Add('-)'); + end; + + { currently the PalmOS target must be linked always against the C lib } + LinkRes.Add('-lcrt'); + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + linklibc:=true; + end; + { be sure that libc is the last lib } + if linklibc then + begin + LinkRes.Add('-lc'); + LinkRes.Add('-lgcc'); + end; + +{ Write and Close response } + linkres.writetodisk; + linkres.Free; + + WriteResponseFile:=True; +end; + + +function TLinkerPalmOS.MakeExecutable:boolean; +var + binstr, + cmdstr : string; + success : boolean; + StripStr : string[40]; + i : longint; +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; + +{ Call linker } + success:=false; + for i:=1 to 2 do + begin + SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr); + if binstr<>'' then + begin + Replace(cmdstr,'$EXE',MaybeQuote(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$SCRIPT',FindUtil('palm.ld')); + Replace(cmdstr,'$APPNAME',palmos_applicationname); + Replace(cmdstr,'$APPID',palmos_applicationid); + 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(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef m68k} + RegisterTarget(target_m68k_palmos_info); + RegisterRes(res_m68k_palmos_info); +{$endif m68k} +end. diff --git a/compiler/systems/t_sunos.pas b/compiler/systems/t_sunos.pas new file mode 100644 index 0000000000..d600f5d9a0 --- /dev/null +++ b/compiler/systems/t_sunos.pas @@ -0,0 +1,490 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) solaris 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_sunos; + +{$i fpcdefs.inc} + +interface + +{ copy from t_linux +// Up to now we use gld since the solaris ld seems not support .res-files} +{-$DEFINE LinkTest} { DON't del link.res and write Info } +{$DEFINE GnuLd} {The other is not implemented } + +implementation + + uses + cutils,cclasses, + verbose,systems,globtype,globals, + symconst,script, + fmodule,aasmbase,aasmtai,aasmcpu,cpubase,symsym,symdef, + cgobj, + import,export,link,i_sunos; + + type + timportlibsolaris=class(timportlib) + procedure preparelib(const s:string);override; + procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; + procedure importvariable(vs:tglobalvarsym;const name,module:string);override; + procedure generatelib;override; + end; + + texportlibsolaris=class(texportlib) + procedure preparelib(const s : string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure generatelib;override; + end; + + tlinkersolaris=class(texternallinker) + private + Glibc2, + Glibc21 : boolean; + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + end; + + +{***************************************************************************** + TIMPORTLIBsolaris +*****************************************************************************} + +procedure timportlibsolaris.preparelib(const s : string); +begin +{$ifDef LinkTest} + WriteLN('Prepare import: ',s); +{$EndIf} +end; + + +procedure timportlibsolaris.importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string); +begin + { insert sharedlibrary } +{$ifDef LinkTest} + WriteLN('Import: f:',func,' m:',module,' n:',name); +{$EndIf} + current_module.linkothersharedlibs.add(SplitName(module),link_allways); +end; + + +procedure timportlibsolaris.importvariable(vs:tglobalvarsym;const name,module:string); +begin + { insert sharedlibrary } + current_module.linkothersharedlibs.add(SplitName(module),link_allways); + { reset the mangledname and turn off the dll_var option } + vs.set_mangledname(name); + exclude(vs.varoptions,vo_is_dll_var); +end; + + +procedure timportlibsolaris.generatelib; +begin +end; + + +{***************************************************************************** + TEXPORTLIBsolaris +*****************************************************************************} + +procedure texportlibsolaris.preparelib(const s:string); +begin +end; + + +procedure texportlibsolaris.exportprocedure(hp : texported_item); +var + hp2 : texported_item; +begin + { first test the index value } + if (hp.options and eo_index)<>0 then + begin + Message1(parser_e_no_export_with_index_for_target,'solaris'); + 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:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_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=texported_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 texportlibsolaris.exportvar(hp : texported_item); +begin + hp.is_var:=true; + exportprocedure(hp); +end; + + +procedure texportlibsolaris.generatelib; +var + hp2 : texported_item; +begin + new_section(asmlist[al_procedures],sec_code,'',0); + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if (not hp2.is_var) and + (hp2.sym.typ=procsym) then + begin + { the manglednames can already be the same when the procedure + is declared with cdecl } + if tprocsym(hp2.sym).first_procdef.mangledname<>hp2.name^ then + begin + { place jump in al_procedures } + asmlist[al_procedures].concat(tai_align.create(target_info.alignment.procalign)); + asmlist[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + cg.a_jmp_name(asmlist[al_procedures],tprocsym(hp2.sym).first_procdef.mangledname); + asmlist[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); + end; + end + else + Message1(parser_e_no_export_of_variables_for_target,'linux'); + hp2:=texported_item(hp2.next); + end; +end; + + +{***************************************************************************** + TLINKERsolaris +*****************************************************************************} + +Constructor TLinkersolaris.Create; +begin + Inherited Create; + if NOT Dontlinkstdlibpath Then + LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib;/opt/sfw/lib',true); +{$ifdef LinkTest} + if (cs_link_staticflag in aktglobalswitches) then WriteLN('ForceLinkStaticFlag'); + if (cs_link_static in aktglobalswitches) then WriteLN('LinkStatic-Flag'); + if (cs_link_shared in aktglobalswitches) then WriteLN('LinkSynamicFlag'); +{$EndIf} +end; + + +procedure TLinkersolaris.SetDefaultInfo; +{ + This will also detect which libc version will be used +} +begin + Glibc2:=false; + Glibc21:=false; + with Info do + begin +{$IFDEF GnuLd} + ExeCmd[1]:='gld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES'; + DllCmd[1]:='gld $OPT -shared -L. -o $EXE $RES'; + DllCmd[2]:='strip --strip-unneeded $EXE'; + DynamicLinker:=''; { Gnu uses the default } + Glibc21:=false; +{$ELSE} + Not Implememted +{$ENDIF} +(* Linux Stuff not needed? + { first try glibc2 } // muss noch gendert werden + if FileExists(DynamicLinker) then + begin + Glibc2:=true; + { Check for 2.0 files, else use the glibc 2.1 stub } + if FileExists('/lib/ld-2.0.*') then + Glibc21:=false + else + Glibc21:=true; + end + else + DynamicLinker:='/lib/ld-linux.so.1'; +*) + end; + +end; + + +Function TLinkersolaris.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + cprtobj, + gprtobj, + prtobj : string[80]; + HPath : TStringListItem; + s,s2 : string; + linkdynamic, + linklibc : boolean; +begin + WriteResponseFile:=False; +{ set special options for some targets } + linkdynamic:=not(SharedLibFiles.empty); +{ linkdynamic:=false; // da nicht getestet } + linklibc:=(SharedLibFiles.Find('c')<>nil); + prtobj:='prt0'; + cprtobj:='cprt0'; + gprtobj:='gprt0'; + 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 + else + AddSharedLibrary('c'); { quick hack: this solaris implementation needs alwys libc } + end; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TStringListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TStringListItem(HPath.Next); + end; + HPath:=TStringListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TStringListItem(HPath.Next); + end; + + LinkRes.Add('INPUT('); + { add objectfiles, start with prt0 always } + if prtobj<>'' then + LinkRes.AddFileName(FindObjectFile(prtobj,'',false)); + { try to add crti and crtbegin if linking to C } + if linklibc then { Needed in solaris? } + begin +{ if librarysearchpath.FindFile('crtbegin.o',s) then + LinkRes.AddFileName(s);} + if librarysearchpath.FindFile('crti.o',s) then + LinkRes.AddFileName(s); + end; + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(maybequoted(s)); + end; + LinkRes.Add(')'); + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(maybequoted(s)) + end; + LinkRes.Add(')'); + end; + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + if not SharedLibFiles.Empty then + begin + LinkRes.Add('INPUT('); + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.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-solaris (war ld-linux) for us } + end; + end; + { be sure that libc is the last lib } + if linklibc then + LinkRes.Add('-lc'); + { when we have -static for the linker the we also need libgcc } + if (cs_link_staticflag in aktglobalswitches) then begin + LinkRes.Add('-lgcc'); + end; + if linkdynamic and (Info.DynamicLinker<>'') then { gld has a default, DynamicLinker is not set in solaris } + LinkRes.AddFileName(Info.DynamicLinker); + LinkRes.Add(')'); + end; + { objects which must be at the end } + if linklibc then {needed in solaris ? } + begin + if {librarysearchpath.FindFile('crtend.o',s1) or} + librarysearchpath.FindFile('crtn.o',s2) then + begin + LinkRes.Add('INPUT('); +{ LinkRes.AddFileName(s1);} + LinkRes.AddFileName(s2); + LinkRes.Add(')'); + end; + end; +{ Write and Close response } + linkres.writetodisk; + LinkRes.Free; + + WriteResponseFile:=True; +end; + + +function TLinkersolaris.MakeExecutable:boolean; +var + binstr : String; + cmdstr : TCmdStr; + success : boolean; + DynLinkStr : string[60]; + StaticStr, + StripStr : string[40]; +begin + if not(cs_link_extern in aktglobalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + if (cs_link_staticflag in aktglobalswitches) then + StaticStr:='-Bstatic'; + if (cs_link_strip in aktglobalswitches) then + StripStr:='-s'; + If (cs_profile in aktmoduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + { solaris sets DynamicLinker, but gld will (hopefully) defaults to -Bdynamic and add the default-linker } +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false); + +{ Remove ReponseFile } +{$IFNDEF LinkTest} + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); +{$ENDIF} + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +Function TLinkersolaris.MakeSharedLibrary:boolean; +var + binstr : String; + cmdstr : TCmdStr; + 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',maybequoted(current_module.sharedlibfilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + success:=DoExec(FindUtil(utilsprefix+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',maybequoted(current_module.sharedlibfilename^)); + success:=DoExec(utilsprefix+FindUtil(binstr),cmdstr,true,false); + end; + +{ Remove ReponseFile } +{$IFNDEF LinkTest} + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); +{$ENDIF} + MakeSharedLibrary:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef i386} + RegisterExternalLinker(system_i386_solaris_info,TLinkersolaris); + RegisterImport(system_i386_solaris,TImportLibsolaris); + RegisterExport(system_i386_solaris,TExportLibsolaris); + RegisterTarget(system_i386_solaris_info); +{$endif i386} + +{$ifdef sparc} + RegisterExternalLinker(system_sparc_solaris_info,TLinkersolaris); + RegisterImport(system_sparc_solaris,TImportLibsolaris); + RegisterExport(system_sparc_solaris,TExportLibsolaris); + RegisterTarget(system_sparc_solaris_info); +{$endif sparc} +end. diff --git a/compiler/systems/t_watcom.pas b/compiler/systems/t_watcom.pas new file mode 100644 index 0000000000..ba9886e6bf --- /dev/null +++ b/compiler/systems/t_watcom.pas @@ -0,0 +1,178 @@ +{ + Copyright (c) 2003 by Wiktor Sywula + + This unit implements support import, export, link routines + for the (i386) Watcom 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_watcom; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + link, + cclasses,cutils,strings,globtype,globals, + systems,verbose,script,fmodule,i_watcom; + + + type + tlinkerwatcom=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; +{ function MakeSharedLibrary:boolean;override;} + end; + + +{**************************************************************************** + TLinkerWatcom +****************************************************************************} + +Constructor TLinkerWatcom.Create; +begin + Inherited Create; + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkerWatcom.SetDefaultInfo; +begin + with Info do + ExeCmd[1]:='wlink system causeway option quiet option nocaseexact $OPT $STRIP name $EXE @$RES'; +end; + +Function TLinkerWatcom.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + s : string; + linklibc : boolean; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write object files, start with prt0 } + LinkRes.Add('file '+GetShortName(FindObjectFile('prt0','',false))); + if not ObjectFiles.Empty then + While not ObjectFiles.Empty do + begin + S:=ObjectFiles.GetFirst; + LinkRes.AddFileName('file '+GetShortName(s)); + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName('file '+GetShortName(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) } + linklibc:=false; + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.Get; + if s<>'c' then + begin + i:=Pos(target_os.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + LinkRes.Add('-l'+s); + linklibc:=true; + end; + end; + { be sure that libc&libgcc is the last lib } + if linklibc then + begin + LinkRes.Add('-lc'); + LinkRes.Add('-lgcc'); + end; +*) +{ Write and Close response } + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; +end; + + +function TLinkerWatcom.MakeExecutable:boolean; +var + binstr : String; + cmdstr : TCmdStr; + 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:='debug dwarf all'; + if (cs_link_strip in aktglobalswitches) then + StripStr:=''; + +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STRIP',StripStr); + success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false); + +{ Remove ReponseFile } + if (success) and not(cs_link_extern in aktglobalswitches) then + RemoveFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + +{function TLinkerWatcom.MakeSharedLibrary:boolean; +begin + MakeSharedLibrary:=false; +end;} + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_i386_watcom_info,TLinkerWatcom); + RegisterTarget(system_i386_watcom_info); +end. diff --git a/compiler/systems/t_wdosx.pas b/compiler/systems/t_wdosx.pas new file mode 100644 index 0000000000..4eaa9eaf68 --- /dev/null +++ b/compiler/systems/t_wdosx.pas @@ -0,0 +1,84 @@ +{ + Copyright (c) 2001-2002 Pavel ?????? + + This unit implements support import,export,link routines + for the (i386) WDOSX 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_wdosx; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + cutils, + fmodule,globals,systems, + import,export,link,t_win,i_wdosx; + + type + timportlibwdosx=class(timportlibwin32) + end; + + texportlibwdosx=texportlibwin32; + + tlinkerwdosx=class(tlinkerwin32) + public + function MakeExecutable:boolean;override; + end; + + tDLLScannerWdosx=class(tDLLScannerWin32) + end; + + +{***************************************************************************** + TIMPORTLIBWDOSX +*****************************************************************************} + +{***************************************************************************** + TLINKERWDOSX +*****************************************************************************} +function TLinkerWdosx.MakeExecutable:boolean; +var + b: boolean; +begin + b := Inherited MakeExecutable; + if b then + DoExec(FindUtil('stubit'),current_module.exefilename^,false,false); + Result := b; +end; + +{**************************************************************************** + TDLLScannerWdosx +****************************************************************************} + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_i386_wdosx_info,TLinkerWdosx); + RegisterImport(system_i386_wdosx,TImportLibWdosx); + RegisterExport(system_i386_wdosx,TExportLibWdosx); + RegisterDLLScanner(system_i386_wdosx,TDLLScannerWdosx); + {RegisterAr(ar_gnu_arw_info);} + {RegisterRes(res_gnu_windres_info);} + RegisterTarget(system_i386_wdosx_info); +end. diff --git a/compiler/systems/t_win.pas b/compiler/systems/t_win.pas new file mode 100644 index 0000000000..3d6e435ae7 --- /dev/null +++ b/compiler/systems/t_win.pas @@ -0,0 +1,1673 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + 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 + 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_win; + +{$i fpcdefs.inc} + +interface + uses + dos, + cutils,cclasses, + aasmbase,aasmtai,aasmcpu,fmodule,globtype,globals,systems,verbose, + symconst,symdef,symsym, + script,gendef, + cpubase, + import,export,link,cgobj,i_win; + + + const + MAX_DEFAULT_EXTENSIONS = 3; + + type + tStr4=array[1..MAX_DEFAULT_EXTENSIONS] of string[4]; + pStr4=^tStr4; + + twin32imported_item = class(timported_item) + procdef : tprocdef; + end; + + timportlibwin32=class(timportlib) + private + procedure win32importproc(aprocdef:tprocdef;const func,module : string;index : longint;const name : string); + procedure importvariable_str(const s:string;const name,module:string); + procedure importprocedure_str(const func,module:string;index:longint;const name:string); + public + procedure preparelib(const s:string);override; + procedure importprocedure(aprocdef:tprocdef;const module:string;index:longint;const name:string);override; + procedure importvariable(vs:tglobalvarsym;const name,module:string);override; + procedure generatelib;override; + procedure generatenasmlib;virtual; + procedure generatesmartlib;override; + end; + + texportlibwin32=class(texportlib) + st : string; + EList_indexed:tList; + EList_nonindexed:tList; + procedure preparelib(const s:string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure exportfromlist(hp : texported_item); + procedure generatelib;override; + procedure generatenasmlib;virtual; + end; + + tlinkerwin32=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + Function PostProcessExecutable(const fn:string;isdll:boolean) : Boolean; + public + Constructor Create;override; + Procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + end; + + tDLLScannerWin32=class(tDLLScanner) + private + cstring : array[0..127]of char; + function DOSstubOK(var x:cardinal):boolean; + function FindDLL(const s:string;var founddll:string):boolean; + function ExtractDllName(Const Name : string) : string; + public + function isSuitableFileType(x:cardinal):longbool;override; + function GetEdata(HeaderEntry:cardinal):longbool;override; + function Scan(const binname:string):longbool;override; + end; + +implementation + + uses + cpuinfo,cgutils,dbgbase; + + + const + res_gnu_windres_info : tresinfo = + ( + id : res_gnu_windres; + resbin : 'windres'; + rescmd : '--include $INC -O coff -o $OBJ $RES' + ); + + res_gnu_wince_windres_info : tresinfo = + ( + id : res_gnu_wince_windres; + resbin : 'windres'; + rescmd : '--include $INC -O coff -o $OBJ $RES' + ); + +{***************************************************************************** + TIMPORTLIBWIN32 +*****************************************************************************} + + procedure timportlibwin32.preparelib(const s : string); + begin + if asmlist[al_imports]=nil then + asmlist[al_imports]:=TAAsmoutput.create; + end; + + + procedure timportlibwin32.win32importproc(aprocdef:tprocdef;const func,module : string;index : longint;const name : string); + var + hp1 : timportlist; + hp2 : twin32imported_item; + hs : string; + begin + { procdef or funcname must be give, not both } + if assigned(aprocdef) and (func<>'') then + internalerror(200411161); + { append extension if required } + hs:=AddExtension(module,target_info.sharedlibext); + { search for the module } + hp1:=timportlist(current_module.imports.first); + while assigned(hp1) do + begin + if hs=hp1.dllname^ then + break; + hp1:=timportlist(hp1.next); + end; + { generate a new item ? } + if not(assigned(hp1)) then + begin + hp1:=timportlist.create(hs); + current_module.imports.concat(hp1); + end; + { search for reuse of old import item } + if assigned(aprocdef) then + begin + hp2:=twin32imported_item(hp1.imported_items.first); + while assigned(hp2) do + begin + if (hp2.procdef=aprocdef) then + break; + hp2:=twin32imported_item(hp2.next); + end; + end + else + begin + hp2:=twin32imported_item(hp1.imported_items.first); + while assigned(hp2) do + begin + if (hp2.func^=func) then + break; + hp2:=twin32imported_item(hp2.next); + end; + end; + if not assigned(hp2) then + begin + hp2:=twin32imported_item.create(func,name,index); + hp2.procdef:=aprocdef; + hp1.imported_items.concat(hp2); + end; + end; + + + procedure timportlibwin32.importprocedure(aprocdef:tprocdef;const module : string;index : longint;const name : string); + begin + win32importproc(aprocdef,'',module,index,name); + end; + + + procedure timportlibwin32.importprocedure_str(const func,module : string;index : longint;const name : string); + begin + win32importproc(nil,func,module,index,name); + end; + + + procedure timportlibwin32.importvariable(vs:tglobalvarsym;const name,module:string); + begin + importvariable_str(vs.mangledname,name,module); + end; + + + procedure timportlibwin32.importvariable_str(const s:string;const name,module:string); + var + hp1 : timportlist; + hp2 : twin32imported_item; + hs : string; + begin + hs:=AddExtension(module,target_info.sharedlibext); + { search for the module } + hp1:=timportlist(current_module.imports.first); + while assigned(hp1) do + begin + if hs=hp1.dllname^ then + break; + hp1:=timportlist(hp1.next); + end; + { generate a new item ? } + if not(assigned(hp1)) then + begin + hp1:=timportlist.create(hs); + current_module.imports.concat(hp1); + end; + hp2:=twin32imported_item.create_var(s,name); + hp2.procdef:=nil; + hp1.imported_items.concat(hp2); + end; + + procedure timportlibwin32.generatenasmlib; + var + hp1 : timportlist; + hp2 : twin32imported_item; + begin + new_section(asmlist[al_imports],sec_code,'',0); + hp1:=timportlist(current_module.imports.first); + while assigned(hp1) do + begin + hp2:=twin32imported_item(hp1.imported_items.first); + while assigned(hp2) do + begin + asmlist[al_imports].concat(tai_directive.create(asd_extern,hp2.func^)); + asmlist[al_imports].concat(tai_directive.create(asd_nasm_import,hp2.func^+' '+hp1.dllname^+' '+hp2.name^)); + hp2:=twin32imported_item(hp2.next); + end; + hp1:=timportlist(hp1.next); + end; + end; + + + procedure timportlibwin32.generatesmartlib; + var + hp1 : timportlist; + mangledstring : string; + importname : string; + suffix : integer; + hp2 : twin32imported_item; + lhead,lname,lcode, {$ifdef ARM} lpcode, {$endif ARM} + lidata4,lidata5 : tasmlabel; + href : treference; + begin + if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then + begin + generatenasmlib; + exit; + end; + hp1:=timportlist(current_module.imports.first); + while assigned(hp1) do + begin + { Get labels for the sections } + objectlibrary.getdatalabel(lhead); + objectlibrary.getdatalabel(lname); + objectlibrary.getaddrlabel(lidata4); + objectlibrary.getaddrlabel(lidata5); + { create header for this importmodule } + asmlist[al_imports].concat(Tai_cutobject.Create_begin); + new_section(asmlist[al_imports],sec_idata2,'',0); + asmlist[al_imports].concat(Tai_label.Create(lhead)); + { pointer to procedure names } + asmlist[al_imports].concat(Tai_const.Create_rva_sym(lidata4)); + { two empty entries follow } + asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + { pointer to dll name } + asmlist[al_imports].concat(Tai_const.Create_rva_sym(lname)); + { pointer to fixups } + asmlist[al_imports].concat(Tai_const.Create_rva_sym(lidata5)); + { first write the name references } + new_section(asmlist[al_imports],sec_idata4,'',0); + asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + asmlist[al_imports].concat(Tai_label.Create(lidata4)); + { then the addresses and create also the indirect jump } + new_section(asmlist[al_imports],sec_idata5,'',0); + asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + asmlist[al_imports].concat(Tai_label.Create(lidata5)); + + { create procedures } + hp2:=twin32imported_item(hp1.imported_items.first); + while assigned(hp2) do + begin + { insert cuts } + asmlist[al_imports].concat(Tai_cutobject.Create); + { create indirect jump } + if not hp2.is_var then + begin + objectlibrary.getjumplabel(lcode); + {$ifdef ARM} + objectlibrary.getjumplabel(lpcode); + {$endif ARM} + { place jump in al_procedures, insert a code section in the + al_imports to reduce the amount of .s files (PFV) } + new_section(asmlist[al_imports],sec_code,'',0); + if assigned(hp2.procdef) then + mangledstring:=hp2.procdef.mangledname + else + mangledstring:=hp2.func^; + asmlist[al_imports].concat(Tai_symbol.Createname_global(mangledstring,AT_FUNCTION,0)); + asmlist[al_imports].concat(Tai_function_name.Create('')); + {$ifdef ARM} + reference_reset_symbol(href,lpcode,0); + asmlist[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R12,href)); + reference_reset_base(href,NR_R12,0); + asmlist[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R15,href)); + asmlist[al_imports].concat(Tai_label.Create(lpcode)); + reference_reset_symbol(href,lcode,0); + asmlist[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset)); + {$else ARM} + reference_reset_symbol(href,lcode,0); + asmlist[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href)); + asmlist[al_imports].concat(Tai_align.Create_op(4,$90)); + {$endif ARM} + end; + { create head link } + new_section(asmlist[al_imports],sec_idata7,'',0); + asmlist[al_imports].concat(Tai_const.Create_rva_sym(lhead)); + { fixup } + objectlibrary.getjumplabel(tasmlabel(hp2.lab)); + new_section(asmlist[al_imports],sec_idata4,'',0); + asmlist[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab)); + { add jump field to al_imports } + new_section(asmlist[al_imports],sec_idata5,'',0); + if hp2.is_var then + asmlist[al_imports].concat(Tai_symbol.Createname_global(hp2.func^,AT_FUNCTION,0)) + else + asmlist[al_imports].concat(Tai_label.Create(lcode)); + if (cs_debuginfo in aktmoduleswitches) then + begin + if assigned(hp2.name) then + begin + importname:='__imp_'+hp2.name^; + suffix:=0; + while assigned(objectlibrary.getasmsymbol(importname)) do + begin + inc(suffix); + importname:='__imp_'+hp2.name^+'_'+tostr(suffix); + end; + asmlist[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4)); + end + else + begin + importname:='__imp_by_ordinal'+tostr(hp2.ordnr); + suffix:=0; + while assigned(objectlibrary.getasmsymbol(importname)) do + begin + inc(suffix); + importname:='__imp_by_ordinal'+tostr(hp2.ordnr)+'_'+tostr(suffix); + end; + asmlist[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4)); + end; + end; + if hp2.name^<>'' then + asmlist[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab)) + else + asmlist[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or longint(hp2.ordnr))); + { finally the import information } + new_section(asmlist[al_imports],sec_idata6,'',0); + asmlist[al_imports].concat(Tai_label.Create(hp2.lab)); + asmlist[al_imports].concat(Tai_const.Create_16bit(hp2.ordnr)); + asmlist[al_imports].concat(Tai_string.Create(hp2.name^+#0)); + asmlist[al_imports].concat(Tai_align.Create_op(2,0)); + hp2:=twin32imported_item(hp2.next); + end; + + { write final section } + asmlist[al_imports].concat(Tai_cutobject.Create_end); + { end of name references } + new_section(asmlist[al_imports],sec_idata4,'',0); + asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + { end if addresses } + new_section(asmlist[al_imports],sec_idata5,'',0); + asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + { dllname } + new_section(asmlist[al_imports],sec_idata7,'',0); + asmlist[al_imports].concat(Tai_label.Create(lname)); + asmlist[al_imports].concat(Tai_string.Create(hp1.dllname^+#0)); + + hp1:=timportlist(hp1.next); + end; + end; + + + procedure timportlibwin32.generatelib; + var + hp1 : timportlist; + hp2 : twin32imported_item; + l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel; + mangledstring : string; + importname : string; + suffix : integer; + href : treference; + begin + if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then + begin + generatenasmlib; + exit; + end; + hp1:=timportlist(current_module.imports.first); + while assigned(hp1) do + begin + { align al_procedures for the jumps } + new_section(asmlist[al_imports],sec_code,'',sizeof(aint)); + { Get labels for the sections } + objectlibrary.getjumplabel(l1); + objectlibrary.getjumplabel(l2); + objectlibrary.getjumplabel(l3); + new_section(asmlist[al_imports],sec_idata2,'',0); + { pointer to procedure names } + asmlist[al_imports].concat(Tai_const.Create_rva_sym(l2)); + { two empty entries follow } + asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + { pointer to dll name } + asmlist[al_imports].concat(Tai_const.Create_rva_sym(l1)); + { pointer to fixups } + asmlist[al_imports].concat(Tai_const.Create_rva_sym(l3)); + + { only create one section for each else it will + create a lot of idata* } + + { first write the name references } + new_section(asmlist[al_imports],sec_idata4,'',0); + asmlist[al_imports].concat(Tai_label.Create(l2)); + + hp2:=twin32imported_item(hp1.imported_items.first); + while assigned(hp2) do + begin + objectlibrary.getjumplabel(tasmlabel(hp2.lab)); + if hp2.name^<>'' then + asmlist[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab)) + else + asmlist[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or hp2.ordnr)); + hp2:=twin32imported_item(hp2.next); + end; + { finalize the names ... } + asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + + { then the addresses and create also the indirect jump } + new_section(asmlist[al_imports],sec_idata5,'',0); + asmlist[al_imports].concat(Tai_label.Create(l3)); + hp2:=twin32imported_item(hp1.imported_items.first); + while assigned(hp2) do + begin + if not hp2.is_var then + begin + objectlibrary.getjumplabel(l4); + {$ifdef ARM} + objectlibrary.getjumplabel(l5); + {$endif ARM} + { create indirect jump and } + { place jump in al_procedures } + new_section(asmlist[al_imports],sec_code,'',0); + if assigned(hp2.procdef) then + mangledstring:=hp2.procdef.mangledname + else + mangledstring:=hp2.func^; + asmlist[al_imports].concat(Tai_symbol.Createname_global(mangledstring,AT_FUNCTION,0)); + asmlist[al_imports].concat(tai_function_name.create('')); + {$ifdef ARM} + reference_reset_symbol(href,l5,0); + asmlist[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R12,href)); + reference_reset_base(href,NR_R12,0); + asmlist[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R15,href)); + asmlist[al_imports].concat(Tai_label.Create(l5)); + reference_reset_symbol(href,l4,0); + asmlist[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset)); + {$else ARM} + reference_reset_symbol(href,l4,0); + asmlist[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href)); + asmlist[al_imports].concat(Tai_align.Create_op(4,$90)); + {$endif ARM} + { add jump field to al_imports } + new_section(asmlist[al_imports],sec_idata5,'',0); + if (cs_debuginfo in aktmoduleswitches) then + begin + if assigned(hp2.name) then + begin + importname:='__imp_'+hp2.name^; + suffix:=0; + while assigned(objectlibrary.getasmsymbol(importname)) do + begin + inc(suffix); + importname:='__imp_'+hp2.name^+'_'+tostr(suffix); + end; + asmlist[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4)); + end + else + begin + importname:='__imp_by_ordinal'+tostr(hp2.ordnr); + suffix:=0; + while assigned(objectlibrary.getasmsymbol(importname)) do + begin + inc(suffix); + importname:='__imp_by_ordinal'+tostr(hp2.ordnr)+'_'+tostr(suffix); + end; + asmlist[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4)); + end; + end; + asmlist[al_imports].concat(Tai_label.Create(l4)); + end + else + begin + asmlist[al_imports].concat(Tai_symbol.Createname_global(hp2.func^,AT_DATA,0)); + end; + asmlist[al_imports].concat(Tai_const.Create_rva_sym(hp2.lab)); + hp2:=twin32imported_item(hp2.next); + end; + { finalize the addresses } + asmlist[al_imports].concat(Tai_const.Create_32bit(0)); + + { finally the import information } + new_section(asmlist[al_imports],sec_idata6,'',0); + hp2:=twin32imported_item(hp1.imported_items.first); + while assigned(hp2) do + begin + asmlist[al_imports].concat(Tai_label.Create(hp2.lab)); + { the ordinal number } + asmlist[al_imports].concat(Tai_const.Create_16bit(hp2.ordnr)); + asmlist[al_imports].concat(Tai_string.Create(hp2.name^+#0)); + asmlist[al_imports].concat(Tai_align.Create_op(2,0)); + hp2:=twin32imported_item(hp2.next); + end; + { create import dll name } + new_section(asmlist[al_imports],sec_idata7,'',0); + asmlist[al_imports].concat(Tai_label.Create(l1)); + asmlist[al_imports].concat(Tai_string.Create(hp1.dllname^+#0)); + + hp1:=timportlist(hp1.next); + end; + end; + + +{***************************************************************************** + TEXPORTLIBWIN32 +*****************************************************************************} + + procedure texportlibwin32.preparelib(const s:string); + begin + if asmlist[al_exports]=nil then + asmlist[al_exports]:=TAAsmoutput.create; + EList_indexed:=tList.Create; + EList_nonindexed:=tList.Create; + objectlibrary.getdatalabel(edatalabel); + end; + + + procedure texportlibwin32.exportvar(hp : texported_item); + begin + { same code used !! PM } + exportprocedure(hp); + end; + + var + Gl_DoubleIndex:boolean; + Gl_DoubleIndexValue:longint; + + function IdxCompare(Item1, Item2: Pointer): Integer; + var + I1:texported_item absolute Item1; + I2:texported_item absolute Item2; + begin + Result:=I1.index-I2.index; + if(Result=0)and(Item1<>Item2)then + begin + Gl_DoubleIndex:=true; + Gl_DoubleIndexValue:=I1.index; + end; + end; + + + procedure texportlibwin32.exportprocedure(hp : texported_item); + begin + if ((hp.options and eo_index)<>0)and((hp.index<=0) or (hp.index>$ffff)) then + begin + message1(parser_e_export_invalid_index,tostr(hp.index)); + exit; + end; + if hp.options and eo_index=eo_index then + EList_indexed.Add(hp) + else + EList_nonindexed.Add(hp); + end; + + + procedure texportlibwin32.exportfromlist(hp : texported_item); + //formerly texportlibwin32.exportprocedure + { must be ordered at least for win32 !! } + var + hp2 : texported_item; + begin + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_item(hp2.next); + { insert hp there !! } + if hp2=nil then + current_module._exports.concat(hp) + else + begin + if hp2.name^=hp.name^ then + begin + { this is not allowed !! } + message1(parser_e_export_name_double,hp.name^); + exit; + end; + current_module._exports.insertbefore(hp,hp2); + end; + end; + + + procedure texportlibwin32.generatelib; + var + ordinal_base,ordinal_max,ordinal_min : longint; + current_index : longint; + entries,named_entries : longint; + name_label,dll_name_label,export_address_table : tasmlabel; + export_name_table_pointers,export_ordinal_table : tasmlabel; + hp,hp2 : texported_item; + temtexport : TLinkedList; + address_table,name_table_pointers, + name_table,ordinal_table : TAAsmoutput; + i,autoindex,ni_high : longint; + hole : boolean; + + begin + Gl_DoubleIndex:=false; + ELIst_indexed.Sort(@IdxCompare); + + if Gl_DoubleIndex then + begin + message1(parser_e_export_ordinal_double,tostr(Gl_DoubleIndexValue)); + EList_indexed.Free; + EList_nonindexed.Free; + exit; + end; + + autoindex:=1; + while EList_nonindexed.Count>0 do + begin + hole:=(EList_indexed.Count>0)and(texported_item(EList_indexed.Items[0]).index>1); + if not hole then + for i:=autoindex to pred(EList_indexed.Count)do + if texported_item(EList_indexed.Items[i]).index-texported_item(EList_indexed.Items[pred(i)]).index>1 then + begin + autoindex:=succ(texported_item(EList_indexed.Items[pred(i)]).index); + hole:=true; + break; + end; + ni_high:=pred(EList_nonindexed.Count); + if not hole then + begin + autoindex:=succ(EList_indexed.Count); + EList_indexed.Add(EList_nonindexed.Items[ni_high]); + end + else + EList_indexed.Insert(pred(AutoIndex),EList_nonindexed.Items[ni_high]); + EList_nonindexed.Delete(ni_high); + texported_item(EList_indexed.Items[pred(AutoIndex)]).index:=autoindex; + end; + EList_nonindexed.Free; + for i:=0 to pred(EList_indexed.Count)do + exportfromlist(texported_item(EList_indexed.Items[i])); + EList_indexed.Free; + + if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then + begin + generatenasmlib; + exit; + end; + + hp:=texported_item(current_module._exports.first); + if not assigned(hp) then + exit; + + ordinal_max:=0; + ordinal_min:=$7FFFFFFF; + entries:=0; + named_entries:=0; + objectlibrary.getjumplabel(dll_name_label); + objectlibrary.getjumplabel(export_address_table); + objectlibrary.getjumplabel(export_name_table_pointers); + objectlibrary.getjumplabel(export_ordinal_table); + + { count entries } + while assigned(hp) do + begin + inc(entries); + if (hp.index>ordinal_max) then + ordinal_max:=hp.index; + if (hp.index>0) and (hp.index<ordinal_min) then + ordinal_min:=hp.index; + if assigned(hp.name) then + inc(named_entries); + hp:=texported_item(hp.next); + end; + + { no support for higher ordinal base yet !! } + ordinal_base:=1; + current_index:=ordinal_base; + { we must also count the holes !! } + entries:=ordinal_max-ordinal_base+1; + + new_section(asmlist[al_exports],sec_edata,'',0); + { create label to reference from main so smartlink will include + the .edata section } + asmlist[al_exports].concat(Tai_symbol.Create_global(edatalabel,0)); + { export flags } + asmlist[al_exports].concat(Tai_const.Create_32bit(0)); + { date/time stamp } + asmlist[al_exports].concat(Tai_const.Create_32bit(0)); + { major version } + asmlist[al_exports].concat(Tai_const.Create_16bit(0)); + { minor version } + asmlist[al_exports].concat(Tai_const.Create_16bit(0)); + { pointer to dll name } + asmlist[al_exports].concat(Tai_const.Create_rva_sym(dll_name_label)); + { ordinal base normally set to 1 } + asmlist[al_exports].concat(Tai_const.Create_32bit(ordinal_base)); + { number of entries } + asmlist[al_exports].concat(Tai_const.Create_32bit(entries)); + { number of named entries } + asmlist[al_exports].concat(Tai_const.Create_32bit(named_entries)); + { address of export address table } + asmlist[al_exports].concat(Tai_const.Create_rva_sym(export_address_table)); + { address of name pointer pointers } + asmlist[al_exports].concat(Tai_const.Create_rva_sym(export_name_table_pointers)); + { address of ordinal number pointers } + asmlist[al_exports].concat(Tai_const.Create_rva_sym(export_ordinal_table)); + { the name } + asmlist[al_exports].concat(Tai_label.Create(dll_name_label)); + if st='' then + asmlist[al_exports].concat(Tai_string.Create(current_module.modulename^+target_info.sharedlibext+#0)) + else + asmlist[al_exports].concat(Tai_string.Create(st+target_info.sharedlibext+#0)); + + { export address table } + address_table:=TAAsmoutput.create; + address_table.concat(Tai_align.Create_op(4,0)); + address_table.concat(Tai_label.Create(export_address_table)); + name_table_pointers:=TAAsmoutput.create; + name_table_pointers.concat(Tai_align.Create_op(4,0)); + name_table_pointers.concat(Tai_label.Create(export_name_table_pointers)); + ordinal_table:=TAAsmoutput.create; + ordinal_table.concat(Tai_align.Create_op(4,0)); + ordinal_table.concat(Tai_label.Create(export_ordinal_table)); + name_table:=TAAsmoutput.Create; + name_table.concat(Tai_align.Create_op(4,0)); + { write each address } + hp:=texported_item(current_module._exports.first); + while assigned(hp) do + begin + if (hp.options and eo_name)<>0 then + begin + objectlibrary.getjumplabel(name_label); + name_table_pointers.concat(Tai_const.Create_rva_sym(name_label)); + ordinal_table.concat(Tai_const.Create_16bit(hp.index-ordinal_base)); + name_table.concat(Tai_align.Create_op(2,0)); + name_table.concat(Tai_label.Create(name_label)); + name_table.concat(Tai_string.Create(hp.name^+#0)); + end; + hp:=texported_item(hp.next); + end; + { order in increasing ordinal values } + { into temtexport list } + temtexport:=TLinkedList.Create; + hp:=texported_item(current_module._exports.first); + while assigned(hp) do + begin + current_module._exports.remove(hp); + hp2:=texported_item(temtexport.first); + while assigned(hp2) and (hp.index>hp2.index) do + hp2:=texported_item(hp2.next); + if hp2=nil then + temtexport.concat(hp) + else + temtexport.insertbefore(hp,hp2); + hp:=texported_item(current_module._exports.first);; + end; + + { write the export adress table } + current_index:=ordinal_base; + hp:=texported_item(temtexport.first); + while assigned(hp) do + begin + { fill missing values } + while current_index<hp.index do + begin + address_table.concat(Tai_const.Create_32bit(0)); + inc(current_index); + end; + case hp.sym.typ of + globalvarsym : + address_table.concat(Tai_const.Createname_rva(tglobalvarsym(hp.sym).mangledname)); + typedconstsym : + address_table.concat(Tai_const.Createname_rva(ttypedconstsym(hp.sym).mangledname)); + procsym : + address_table.concat(Tai_const.Createname_rva(tprocsym(hp.sym).first_procdef.mangledname)); + end; + inc(current_index); + hp:=texported_item(hp.next); + end; + + asmlist[al_exports].concatlist(address_table); + asmlist[al_exports].concatlist(name_table_pointers); + asmlist[al_exports].concatlist(ordinal_table); + asmlist[al_exports].concatlist(name_table); + address_table.Free; + name_table_pointers.free; + ordinal_table.free; + name_table.free; + temtexport.free; + end; + + procedure texportlibwin32.generatenasmlib; + var + hp : texported_item; + p : pchar; + s : string; + begin + new_section(asmlist[al_exports],sec_code,'',0); + hp:=texported_item(current_module._exports.first); + while assigned(hp) do + begin + case hp.sym.typ of + globalvarsym : + s:=tglobalvarsym(hp.sym).mangledname; + typedconstsym : + s:=ttypedconstsym(hp.sym).mangledname; + procsym : + s:=tprocsym(hp.sym).first_procdef.mangledname; + else + s:=''; + end; + p:=strpnew(#9+'export '+s+' '+hp.name^+' '+tostr(hp.index)); + {asmlist[al_exports].concat(tai_direct.create(p));} + hp:=texported_item(hp.next); + end; + end; + + +{**************************************************************************** + TLINKERWIN32 +****************************************************************************} + + +Constructor TLinkerWin32.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +Procedure TLinkerWin32.SetDefaultInfo; +var + targetopts: string; +begin + with Info do + begin + {$ifdef ARM} + targetopts:='-m armpe'; + {$else ARM} + targetopts:='-b pe-i386 -m i386pe'; + {$endif ARM} + ExeCmd[1]:='ld '+targetopts+' $OPT $STRIP $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES'; + DllCmd[1]:='ld '+targetopts+' $OPT $STRIP --dll $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES'; + { ExeCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; + use short forms to avoid 128 char limitation problem } + ExeCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF'; + ExeCmd[3]:='ld '+targetopts+' $OPT $STRIP $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$'; + { DllCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; } + DllCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF'; + DllCmd[3]:='ld '+targetopts+' $OPT $STRIP --dll $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$'; + end; +end; + + + +Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + HPath : TStringListItem; + s,s2 : string; + i : integer; + linklibcygwin : boolean; +begin + WriteResponseFile:=False; + linklibcygwin:=(SharedLibFiles.Find('cygwin')<>nil); + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TStringListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+MaybeQuoted(HPath.Str)+')'); + HPath:=TStringListItem(HPath.Next); + end; + HPath:=TStringListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+MaybeQuoted(HPath.Str)+')'); + HPath:=TStringListItem(HPath.Next); + end; + + { add objectfiles, start with prt0 always } + { profiling of shared libraries is currently not supported } + LinkRes.Add('INPUT('); + if isdll then + LinkRes.AddFileName(MaybeQuoted(FindObjectFile('wdllprt0','',false))) + else + if (cs_profile in aktmoduleswitches) then + LinkRes.AddFileName(MaybeQuoted(FindObjectFile('gprt0','',false))) + else + begin + if linklibcygwin then + LinkRes.AddFileName(MaybeQuoted(FindObjectFile('wcygprt0','',false))) + else + LinkRes.AddFileName(MaybeQuoted(FindObjectFile('wprt0','',false))); + end; + + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(MaybeQuoted(s)); + end; + LinkRes.Add(')'); + + + { Write staticlibraries } + if (not StaticLibFiles.Empty) or (cs_profile in aktmoduleswitches) then + begin + LinkRes.Add('GROUP('); + if (cs_profile in aktmoduleswitches) then + begin + LinkRes.Add('-lc'); + LinkRes.Add('-lgcc'); + LinkRes.Add('-lgmon'); + LinkRes.Add('-lkernel32'); + end; + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(MaybeQuoted(s)); + end; + LinkRes.Add(')'); + end; + + { Write sharedlibraries } + if not SharedLibFiles.Empty then + begin + LinkRes.Add('INPUT(') ; + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then + begin + LinkRes.Add(MaybeQuoted(s2)); + continue; + end; + if pos(target_info.sharedlibprefix,s)=1 then + s:=copy(s,length(target_info.sharedlibprefix)+1,255); + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end; + LinkRes.Add(')'); + end; + +{ Write and Close response } + linkres.writetodisk; + LinkRes.Free; + + WriteResponseFile:=True; +end; + + +function TLinkerWin32.MakeExecutable:boolean; +var + binstr : String; + cmdstr : TCmdStr; + success : boolean; + cmds,i : longint; + AsBinStr : string[80]; + 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:=''; + AsBinStr:=FindUtil(utilsprefix+'as'); + if RelocSection then + RelocStr:='--base-file base.$$$'; + if target_info.system in [system_arm_wince,system_i386_wince] then + begin + AppTypeStr:='--subsystem wince'; + if apptype <> app_gui then + AppTypeStr:=AppTypeStr + ' --entry=mainCRTStartup'; + end + else + if apptype=app_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; + if RelocSection or (not Deffile.empty) then + cmds:=3 + else + cmds:=1; + for i:=1 to cmds do + begin + SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr); + if binstr<>'' then + begin + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$APPTYPE',AppTypeStr); + Replace(cmdstr,'$ASBIN',AsbinStr); + Replace(cmdstr,'$RELOC',RelocStr); + Replace(cmdstr,'$IMAGEBASE',ImageBaseStr); + Replace(cmdstr,'$STRIP',StripStr); + if not DefFile.Empty then + begin + DefFile.WriteFile; + Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname)); + end + else + Replace(cmdstr,'$DEF',''); + success:=DoExec(FindUtil(utilsprefix+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(outputexedir+Info.ResName); + RemoveFile('base.$$$'); + RemoveFile('exp.$$$'); + RemoveFile('deffile.$$$'); + end; + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +Function TLinkerWin32.MakeSharedLibrary:boolean; +var + binstr : String; + cmdstr : TCmdStr; + success : boolean; + cmds, + i : longint; + AsBinStr : string[80]; + 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:=''; + AsBinStr:=FindUtil(utilsprefix+'as'); + if RelocSection then + RelocStr:='--base-file base.$$$'; + if apptype=app_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; + if RelocSection or (not Deffile.empty) then + cmds:=3 + else + cmds:=1; + for i:=1 to cmds do + begin + SplitBinCmd(Info.DllCmd[i],binstr,cmdstr); + if binstr<>'' then + begin + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$APPTYPE',AppTypeStr); + Replace(cmdstr,'$ASBIN',AsbinStr); + Replace(cmdstr,'$RELOC',RelocStr); + Replace(cmdstr,'$IMAGEBASE',ImageBaseStr); + Replace(cmdstr,'$STRIP',StripStr); + if not DefFile.Empty then + begin + DefFile.WriteFile; + Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname)); + end + else + Replace(cmdstr,'$DEF',''); + success:=DoExec(FindUtil(utilsprefix+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(outputexedir+Info.ResName); + RemoveFile('base.$$$'); + RemoveFile('exp.$$$'); + RemoveFile('deffile.$$$'); + 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; + cmdstr : string; + dosheader : tdosheader; + peheader : tpeheader; + firstsecpos, + maxfillsize, + 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 + case apptype of + app_native : + cmdstr:='--subsystem native'; + app_gui : + cmdstr:='--subsystem gui'; + app_cui : + cmdstr:='--subsystem console'; + end; + if dllversion<>'' then + cmdstr:=cmdstr+' --version '+dllversion; + cmdstr:=cmdstr+' --input '+maybequoted(fn); + cmdstr:=cmdstr+' --stack '+tostr(stacksize); + DoExec(FindUtil(utilsprefix+'postw32'),cmdstr,false,false); + 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 } + { wincegui=9 } + if target_info.system in [system_arm_wince,system_i386_wince] then + peheader.Subsystem:=9 + else + case apptype of + app_native : + peheader.Subsystem:=1; + app_gui : + peheader.Subsystem:=2; + app_cui : + peheader.Subsystem:=3; + end; + if dllversion<>'' then + begin + peheader.MajorImageVersion:=dllmajor; + peheader.MinorImageVersion:=dllminor; + end; + { reset timestamp } + peheader.TimeDateStamp:=0; + { write header back } + 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:=1 to 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+} + if ioresult<>0 then; + postprocessexecutable:=true; +end; + + +{**************************************************************************** + TDLLScannerWin32 +****************************************************************************} + + function tDLLScannerWin32.DOSstubOK(var x:cardinal):boolean; + begin + blockread(f,TheWord,2,loaded); + if loaded<>2 then + DOSstubOK:=false + else + begin + DOSstubOK:=(TheWord='MZ'); + seek(f,$3C); + blockread(f,x,4,loaded); + if(loaded<>4)or(longint(x)>filesize(f))then + DOSstubOK:=false; + end; + end; + + function TDLLScannerWin32.FindDLL(const s:string;var founddll:string):boolean; + var + sysdir : string; + Found : boolean; + begin + Found:=false; + { Look for DLL in: + 1. Current dir + 2. Library Path + 3. windir,windir/system,windir/system32 } + Found:=FindFile(s,'.'+source_info.DirSep,founddll); + if (not found) then + Found:=librarysearchpath.FindFile(s,founddll); + if (not found) then + begin + sysdir:=FixPath(GetEnv('windir'),false); + Found:=FindFile(s,sysdir+';'+sysdir+'system'+source_info.DirSep+';'+sysdir+'system32'+source_info.DirSep,founddll); + end; + if (not found) then + begin + message1(exec_w_libfile_not_found,s); + FoundDll:=s; + end; + FindDll:=Found; + end; + + + function tDLLScannerWin32.ExtractDllName(Const Name : string) : string; + var n : string; + begin + n:=Upper(SplitExtension(Name)); + if (n='.DLL') or (n='.DRV') or (n='.EXE') then + ExtractDllName:=Name + else + ExtractDllName:=Name+target_info.sharedlibext; + end; + + + +function tDLLScannerWin32.isSuitableFileType(x:cardinal):longbool; + begin + seek(f,x); + blockread(f,TheWord,2,loaded); + isSuitableFileType:=(loaded=2)and(TheWord='PE'); + end; + + +function tDLLScannerWin32.GetEdata(HeaderEntry:cardinal):longbool; + type + TObjInfo=packed record + ObjName:array[0..7]of char; + VirtSize, + VirtAddr, + RawSize, + RawOffset, + Reloc, + LineNum:cardinal; + RelCount, + LineCount:word; + flags:cardinal; + end; + var + i:cardinal; + ObjOfs:cardinal; + Obj:TObjInfo; + APE_obj,APE_Optsize:word; + ExportRVA:cardinal; + delta:cardinal; + const + IMAGE_SCN_CNT_CODE=$00000020; + var + _d:dirstr; + _n:namestr; + _e:extstr; + function isUsedFunction(name:pchar):longbool; + var + hp:tExternalsItem; + begin + isUsedFunction:=false; + hp:=tExternalsItem(current_module.Externals.first); + while assigned(hp)do + begin + if(assigned(hp.data))and(not hp.found)then + if hp.data^=StrPas(name)then + begin + isUsedFunction:=true; + hp.found:=true; + exit; + end; + hp:=tExternalsItem(hp.next); + end; + end; + + procedure Store(index:cardinal;name:pchar;isData:longbool); + begin + if not isUsedFunction(name)then + exit; + if not(current_module.uses_imports) then + begin + current_module.uses_imports:=true; + importlib.preparelib(current_module.modulename^); + end; + if IsData then + timportlibwin32(importlib).importvariable_str(name,_n,name) + else + timportlibwin32(importlib).importprocedure_str(name,_n,index,name); + end; + + procedure ProcessEdata; + type + a8=array[0..7]of char; + function GetSectionName(rva:cardinal;var Flags:cardinal):a8; + var + i:cardinal; + LocObjOfs:cardinal; + LocObj:TObjInfo; + begin + GetSectionName:=''; + Flags:=0; + LocObjOfs:=APE_OptSize+HeaderOffset+24; + for i:=1 to APE_obj do + begin + seek(f,LocObjOfs); + blockread(f,LocObj,sizeof(LocObj)); + if(rva>=LocObj.VirtAddr)and(rva<=LocObj.VirtAddr+LocObj.RawSize)then + begin + GetSectionName:=a8(LocObj.ObjName); + Flags:=LocObj.flags; + end; + end; + end; + var + j,Fl:cardinal; + ulongval,procEntry:cardinal; + Ordinal:word; + isData:longbool; + ExpDir:packed record + flag, + stamp:cardinal; + Major, + Minor:word; + Name, + Base, + NumFuncs, + NumNames, + AddrFuncs, + AddrNames, + AddrOrds:cardinal; + end; + begin + with Obj do + begin + seek(f,RawOffset+delta); + blockread(f,ExpDir,sizeof(ExpDir)); + fsplit(impname,_d,_n,_e); + for j:=0 to pred(ExpDir.NumNames)do + begin +{ Don't know why but this gives serious problems with overflow checking on } +{$IFOPT Q+} +{$DEFINE OVERFLOW_CHECK_WAS_ON} +{$ENDIF} +{$Q-} + seek(f,RawOffset-VirtAddr+ExpDir.AddrOrds+j*2); + blockread(f,Ordinal,2); + seek(f,RawOffset-VirtAddr+ExpDir.AddrFuncs+cardinal(Ordinal)*4); + blockread(f,ProcEntry,4); + seek(f,RawOffset-VirtAddr+ExpDir.AddrNames+j*4); + blockread(f,ulongval,4); + seek(f,RawOffset-VirtAddr+ulongval); + blockread(f,cstring,sizeof(cstring)); + isData:=GetSectionName(procentry,Fl)=''; +{$IFDEF OVERFLOW_CHECK_WAS_ON} +{$Q+} +{$ENDIF} + if not isData then + isData:=Fl and IMAGE_SCN_CNT_CODE<>IMAGE_SCN_CNT_CODE; + Store(succ(Ordinal),cstring,isData); + end; + end; + end; + begin + GetEdata:=false; + seek(f,HeaderEntry+120); + blockread(f,ExportRVA,4); + seek(f,HeaderEntry+6); + blockread(f,APE_Obj,2); + seek(f,HeaderEntry+20); + blockread(f,APE_OptSize,2); + ObjOfs:=APE_OptSize+HeaderOffset+24; + for i:=1 to APE_obj do + begin + seek(f,ObjOfs); + blockread(f,Obj,sizeof(Obj)); + inc(ObjOfs,sizeof(Obj)); + with Obj do + if(VirtAddr<=ExportRva)and(ExportRva<VirtAddr+VirtSize)then + begin + delta:=ExportRva-VirtAddr; + ProcessEdata; + GetEdata:=true; + end; + end; + end; + +function tDLLScannerWin32.scan(const binname:string):longbool; + var + OldFileMode:longint; + hs, + foundimp : string; + begin + Scan:=false; + { is there already an import library the we will use that one } + if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,foundimp) then + exit; + { check if we can find the dll } + hs:=AddExtension(binname,target_info.sharedlibext); + if not FindDll(hs,impname) then + exit; + { read the dll file } + assign(f,impname); + OldFileMode:=filemode; + filemode:=0; + reset(f,1); + filemode:=OldFileMode; + if not DOSstubOK(HeaderOffset)then + scan:=false + else if not isSuitableFileType(HeaderOffset)then + scan:=false + else + scan:=GetEdata(HeaderOffset); + close(f); + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef i386} + RegisterExternalLinker(system_i386_win32_info,TLinkerWin32); + RegisterImport(system_i386_win32,TImportLibWin32); + RegisterExport(system_i386_win32,TExportLibWin32); + RegisterDLLScanner(system_i386_win32,TDLLScannerWin32); + RegisterRes(res_gnu_windres_info); + RegisterTarget(system_i386_win32_info); + + RegisterExternalLinker(system_i386_wince_info,TLinkerWin32); + RegisterImport(system_i386_wince,TImportLibWin32); + RegisterExport(system_i386_wince,TExportLibWin32); + RegisterDLLScanner(system_i386_wince,TDLLScannerWin32); + RegisterTarget(system_i386_wince_info); +{$endif i386} +{$ifdef x86_64} + RegisterExternalLinker(system_x64_win64_info,TLinkerWin32); + RegisterImport(system_x86_64_win64,TImportLibWin32); + RegisterExport(system_x86_64_win64,TExportLibWin32); + RegisterDLLScanner(system_x86_64_win64,TDLLScannerWin32); + RegisterRes(res_gnu_windres_info); + RegisterTarget(system_x64_win64_info); +{$endif x86_64} +{$ifdef arm} + RegisterExternalLinker(system_arm_wince_info,TLinkerWin32); + RegisterImport(system_arm_wince,TImportLibWin32); + RegisterExport(system_arm_wince,TExportLibWin32); + RegisterRes(res_gnu_wince_windres_info); + RegisterTarget(system_arm_wince_info); +{$endif arm} +end. |