* merged generic m68k updates from fixes branch

compiler/catch.pas

@@ -96,7 +96,9 @@ begin
 {$ifndef nocatch}
   {$ifdef has_signal}
     NewSignal:=SignalHandler({$ifdef fpcprocvar}@{$endif}CatchSignal);
-    OldSigSegm:=Signal (SIGSEGV,NewSignal);
+    {$ifndef sunos}
+      OldSigSegm:=Signal (SIGSEGV,NewSignal);
+    {$endif} // lxrun on solaris hooks this for handling linux-calls!
     OldSigInt:=Signal (SIGINT,NewSignal);
     OldSigFPE:=Signal (SIGFPE,NewSignal);
   {$endif}
@@ -105,7 +107,10 @@ end.
 
 {
   $Log$
-  Revision 1.7  2001-02-05 20:47:00  peter
+  Revision 1.8  2001-02-26 19:44:52  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.7  2001/02/05 20:47:00  peter
     * support linux unit for ver1_0 compilers
 
   Revision 1.6  2001/01/21 20:32:45  marco

compiler/errore.msg

@@ -1354,7 +1354,7 @@ cg_e_control_flow_outside_finally=06040_E_Control flow statements aren't allowed
 #
 # Assembler reader
 #
-# 07085 is the last used one
+# 07097 is the last used one
 #
 asmr_d_start_reading=07000_D_Starting $1 styled assembler parsing
 % This informs you that an assembler block is being parsed
@@ -1490,6 +1490,15 @@ asmr_h_RESULT_is_reg=07085_H_RESULT is register $1
 asmr_w_adding_explicit_args_fXX=07086_W_"$1" without operand translated into "$1 %st,%st(1)"
 asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" translated into "$1 %st,%st(n)"
 asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"
+asmr_e_invalid_char_smaller=07089_E_Char < not allowed here
+asmr_e_invalid_char_greater=07090_E_Char > not allowed here
+asmr_w_xdef_not_supported=07091_W_XDEF not supported
+asmr_e_invalid_global_def=07092_E_Invalid XDEF syntax
+asmr_w_align_not_supported=07093_W_ALIGN not supported
+asmr_e_no_inc_and_dec_together=07094_E_Inc and Dec cannot be together
+asmr_e_invalid_reg_list_in_movem=07095_E_Invalid reglist for movem
+asmr_e_invalid_reg_list_for_opcode=07096_E_Reglist invalid for opcode
+asmr_e_68020_mode_required=07097_E_68020 mode required
 #
 # Assembler/binary writers
 #
@@ -1934,6 +1943,7 @@ option_help_pages=11025_[
 3*2TLINUX_Linux
 3*2Tnetware_Novell Netware Module (experimental)
 3*2TOS2_OS/2 2.x
+3*2TSUNOS_SunOS/Solaris
 3*2TWin32_Windows 32 Bit
 3*1W<x>_Win32 target options
 3*2WB<x>_Set Image base to Hexadecimal <x> value

compiler/export.pas

@@ -80,6 +80,9 @@ uses
   {$ifndef NOTARGETOS2}
     ,t_os2
   {$endif}
+  {$ifndef NOTARGETSUNOS}
+    ,t_sunos
+  {$endif}
   {$ifndef NOTARGETWIN32}
     ,t_win32
   {$endif}
@@ -198,10 +201,10 @@ begin
     target_i386_freebsd:
       exportlib:=Texportlibfreebsd.Create;
   {$endif NOTARGETFREEBSD}
-//  {$ifndef NOTARGETSOLARIS}
-//    target_i386_solaris:
-//      exportlib:=new(pexportlibsolaris,Init);
-//  {$endif NOTARGETSOLARIS}
+  {$ifndef NOTARGETSUNOS}
+    target_i386_SUNOS:
+      exportlib:=Texportlibsunos.Create;
+  {$endif NOTARGETSUNOS}
   {$ifndef NOTARGETWIN32}
     target_i386_Win32 :
       exportlib:=Texportlibwin32.Create;
@@ -236,7 +239,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.11  2001-02-03 00:09:02  peter
+  Revision 1.12  2001-02-26 19:44:52  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.11  2001/02/03 00:09:02  peter
     * fixed netware typo in previous commit
 
   Revision 1.10  2001/02/02 22:43:39  peter

compiler/import.pas

@@ -78,6 +78,9 @@ uses
   {$ifndef NOTARGETFREEBSD}
    ,t_fbsd
   {$endif}
+  {$ifndef NOTARGETSUNOS}
+   ,t_sunos
+  {$endif}
   {$ifndef NOTARGETOS2}
     ,t_os2
   {$endif}
@@ -236,10 +239,10 @@ begin
     target_i386_freebsd:
       importlib:=Timportlibfreebsd.Create;
   {$endif}
-//  {$ifndef NOTARGETSOLARIS}
-//    target_i386_solaris:
-//      importlib:=new(pimportlibsolaris,Init);
-//  {$endif}
+  {$ifndef NOTARGETSUNOS}
+    target_i386_sunos:
+      importlib:=Timportlibsunos.Create;
+  {$endif}
   {$ifndef NOTARGETWIN32}
     target_i386_Win32 :
       importlib:=Timportlibwin32.Create;
@@ -274,7 +277,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.9  2001-02-03 00:09:02  peter
+  Revision 1.10  2001-02-26 19:44:52  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.9  2001/02/03 00:09:02  peter
     * fixed netware typo in previous commit
 
   Revision 1.8  2001/02/02 22:43:39  peter

compiler/link.pas

@@ -33,6 +33,7 @@ unit link;
 interface
 uses
   cobjects,cclasses,
+  systems,
   fmodule;
 
 Type
@@ -68,8 +69,11 @@ Type
        Function  MakeStaticLibrary:boolean;virtual;
      end;
 
-Var
-  Linker : TLinker;
+     TLinkerClass = class of TLinker;
+
+var
+  CLinker : array[ttarget] of TLinkerClass;
+  Linker  : TLinker;
 
 procedure InitLinker;
 procedure DoneLinker;
@@ -83,7 +87,7 @@ uses
 {$else Delphi}
   dos,
 {$endif Delphi}
-  cutils,globtype,systems,
+  cutils,globtype,
   script,globals,verbose,ppu
 {$ifdef i386}
   {$ifndef NOTARGETLINUX}
@@ -92,6 +96,9 @@ uses
   {$ifndef NOTARGETFREEBSD}
     ,t_fbsd
   {$endif}
+  {$ifndef NOTARGETSUNOS}
+    ,t_sunos
+  {$endif}
   {$ifndef NOTARGETOS2}
     ,t_os2
   {$endif}
@@ -488,6 +495,10 @@ begin
     target_i386_FreeBSD :
       linker:=TlinkerFreeBSD.Create;
   {$endif}
+  {$ifndef NOTARGETSUNOS}
+    target_i386_sunos :
+      linker:=Tlinkersunos.Create;
+  {$endif}
   {$ifndef NOTARGETWIN32}
     target_i386_Win32 :
       linker:=Tlinkerwin32.Create;
@@ -543,11 +554,13 @@ begin
    Linker.Free;
 end;
 
-
 end.
 {
   $Log$
-  Revision 1.13  2001-02-20 21:41:17  peter
+  Revision 1.14  2001-02-26 19:44:52  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.13  2001/02/20 21:41:17  peter
     * new fixfilename, findfile for unix. Look first for lowercase, then
       NormalCase and last for UPPERCASE names.
 

compiler/msgidx.inc

@@ -456,6 +456,15 @@ const
   asmr_w_adding_explicit_args_fXX=07086;
   asmr_w_adding_explicit_first_arg_fXX=07087;
   asmr_w_adding_explicit_second_arg_fXX=07088;
+  asmr_e_invalid_char_smaller=07089;
+  asmr_e_invalid_char_greater=07090;
+  asmr_w_xdef_not_supported=07091;
+  asmr_e_invalid_global_def=07092;
+  asmr_w_align_not_supported=07093;
+  asmr_e_no_inc_and_dec_together=07094;
+  asmr_e_invalid_reg_list_in_movem=07095;
+  asmr_e_invalid_reg_list_for_opcode=07096;
+  asmr_e_68020_mode_required=07097;
   asmw_f_too_many_asm_files=08000;
   asmw_f_assembler_output_not_supported=08001;
   asmw_f_comp_not_supported=08002;
@@ -576,9 +585,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 32359;
+  MsgTxtSize = 32666;
 
   MsgIdxMax : array[1..20] of longint=(
-    17,59,174,37,41,41,89,14,35,41,
+    17,59,174,37,41,41,98,14,35,41,
     29,1,1,1,1,1,1,1,1,1
   );

compiler/msgtxt.inc

@@ -1,7 +1,7 @@
 {$ifdef Delphi}
-const msgtxt : array[0..000134] of string[240]=(
+const msgtxt : array[0..000136] of string[240]=(
 {$else Delphi}
-const msgtxt : array[0..000134,1..240] of char=(
+const msgtxt : array[0..000136,1..240] of char=(
 {$endif Delphi}
   '01000_T_Compiler: $1'#000+
   '01001_D_Compiler OS: $1'#000+
@@ -500,59 +500,68 @@ const msgtxt : array[0..000134,1..240] of char=(
   '07086_W_"$1" without operand translated into "$1 %st,%st(1)"'#000+
   '07087_W_"$1 %st(n)" transla','ted into "$1 %st,%st(n)"'#000+
   '07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"'#000+
+  '07089_E_Char < not allowed here'#000+
+  '07090_E_Char > not allowed here'#000+
+  '07091_W_XDEF not supported'#000+
+  '07092_E_Invalid XDEF syntax'#000+
+  '07093_W_ALIGN not supported'#000+
+  '07094_E_Inc and ','Dec cannot be together'#000+
+  '07095_E_Invalid reglist for movem'#000+
+  '07096_E_Reglist invalid for opcode'#000+
+  '07097_E_68020 mode required'#000+
   '08000_F_Too many assembler files'#000+
   '08001_F_Selected assembler output not supported'#000+
   '08002_F_Comp not supported'#000+
-  '08003_F_Direct not support for binary writers'#000+
-  '08004_E_A','llocating of data is only allowed in bss section'#000+
+  '08003_F_Dire','ct not support for binary writers'#000+
+  '08004_E_Allocating of data is only allowed in bss section'#000+
   '08005_F_No binary writer selected'#000+
   '08006_E_Asm: Opcode $1 not in table'#000+
   '08007_E_Asm: $1 invalid combination of opcode and operands'#000+
-  '08008_E_Asm: 16 Bit references not supported'#000+
-  '08009_E_Asm: Inva','lid effective address'#000+
+  '08008_E_Asm: 16 Bit',' references not supported'#000+
+  '08009_E_Asm: Invalid effective address'#000+
   '08010_E_Asm: Immediate or reference expected'#000+
   '08011_E_Asm: $1 value exceeds bounds $2'#000+
   '08012_E_Asm: Short jump is out of range $1'#000+
   '08013_E_Asm: Undefined label $1'#000+
-  '09000_W_Source operating system redefined'#000+
-  '09001_I_Assembli','ng (pipe) $1'#000+
+  '09000_W_Source ','operating system redefined'#000+
+  '09001_I_Assembling (pipe) $1'#000+
   '09002_E_Can'#039't create assember file: $1'#000+
   '09003_E_Can'#039't create object file: $1'#000+
   '09004_E_Can'#039't create archive file: $1'#000+
   '09005_W_Assembler $1 not found, switching to external assembling'#000+
-  '09006_T_Using assembler: $1'#000+
-  '09007_W_Error while ','assembling exitcode $1'#000+
+  '09006','_T_Using assembler: $1'#000+
+  '09007_W_Error while assembling exitcode $1'#000+
   '09008_W_Can'#039't call the assembler, error $1 switching to external a'+
   'ssembling'#000+
   '09009_I_Assembling $1'#000+
   '09010_I_Assembling smartlink $1'#000+
-  '09011_W_Object $1 not found, Linking may fail !'#000+
-  '09012_W_Library $1 not found, Linking m','ay fail !'#000+
+  '09011_W_Object $1 not found, Linking may fai','l !'#000+
+  '09012_W_Library $1 not found, Linking may fail !'#000+
   '09013_W_Error while linking'#000+
   '09014_W_Can'#039't call the linker, switching to external linking'#000+
   '09015_I_Linking $1'#000+
   '09016_W_Util $1 not found, switching to external linking'#000+
-  '09017_T_Using util $1'#000+
-  '09018_E_Creation of Executables not support','ed'#000+
+  '09017_T_Using util $1'#000,
+  '09018_E_Creation of Executables not supported'#000+
   '09019_E_Creation of Dynamic/Shared Libraries not supported'#000+
   '09020_I_Closing script $1'#000+
   '09021_W_resource compiler not found, switching to external mode'#000+
   '09022_I_Compiling resource $1'#000+
-  '09023_T_unit $1 can'#039't be static linked, switching to smart',' linki'+
+  '09023_T_unit $1',' can'#039't be static linked, switching to smart linki'+
   'ng'#000+
   '09024_T_unit $1 can'#039't be smart linked, switching to static linking'+
   #000+
   '09025_T_unit $1 can'#039't be shared linked, switching to static linkin'+
   'g'#000+
   '09026_E_unit $1 can'#039't be smart or static linked'#000+
-  '09027_E_unit $1 can'#039't be shared or static linked',#000+
+  '09027','_E_unit $1 can'#039't be shared or static linked'#000+
   '09028_F_Can'#039't post process executable $1'#000+
   '09029_F_Can'#039't open executable $1'#000+
   '09030_X_Size of Code: $1 bytes'#000+
   '09031_X_Size of initialized data: $1 bytes'#000+
   '09032_X_Size of uninitialized data: $1 bytes'#000+
-  '09033_X_Stack space reserved: $1 bytes'#000+
-  '09034_X','_Stack space commited: $1 bytes'#000+
+  '090','33_X_Stack space reserved: $1 bytes'#000+
+  '09034_X_Stack space commited: $1 bytes'#000+
   '10000_T_Unitsearch: $1'#000+
   '10001_T_PPU Loading $1'#000+
   '10002_U_PPU Name: $1'#000+
@@ -560,72 +569,72 @@ const msgtxt : array[0..000134,1..240] of char=(
   '10004_U_PPU Crc: $1'#000+
   '10005_U_PPU Time: $1'#000+
   '10006_U_PPU File too short'#000+
-  '10007_U_PPU Invalid Header (no PPU at the begin)'#000+
-  '10','008_U_PPU Invalid Version $1'#000+
+  '10007_U_','PPU Invalid Header (no PPU at the begin)'#000+
+  '10008_U_PPU Invalid Version $1'#000+
   '10009_U_PPU is compiled for an other processor'#000+
   '10010_U_PPU is compiled for an other target'#000+
   '10011_U_PPU Source: $1'#000+
   '10012_U_Writing $1'#000+
   '10013_F_Can'#039't Write PPU-File'#000+
-  '10014_F_Error reading PPU-File'#000+
-  '10015_F_unexpected',' end of PPU-File'#000+
+  '10014_','F_Error reading PPU-File'#000+
+  '10015_F_unexpected end of PPU-File'#000+
   '10016_F_Invalid PPU-File entry: $1'#000+
   '10017_F_PPU Dbx count problem'#000+
   '10018_E_Illegal unit name: $1'#000+
   '10019_F_Too much units'#000+
   '10020_F_Circular unit reference between $1 and $2'#000+
-  '10021_F_Can'#039't compile unit $1, no sources available'#000+
-  '100','22_F_Can'#039't find unit $1'#000+
+  '10021_F_Can'#039,'t compile unit $1, no sources available'#000+
+  '10022_F_Can'#039't find unit $1'#000+
   '10023_W_Unit $1 was not found but $2 exists'#000+
   '10024_F_Unit $1 searched but $2 found'#000+
   '10025_W_Compiling the system unit requires the -Us switch'#000+
-  '10026_F_There were $1 errors compiling module, stopping'#000+
-  '10027_U_Load from $1',' ($2) unit $3'#000+
+  '10026_F_There were $1 errors comp','iling module, stopping'#000+
+  '10027_U_Load from $1 ($2) unit $3'#000+
   '10028_U_Recompiling $1, checksum changed for $2'#000+
   '10029_U_Recompiling $1, source found only'#000+
   '10030_U_Recompiling unit, static lib is older than ppufile'#000+
-  '10031_U_Recompiling unit, shared lib is older than ppufile'#000+
-  '10032_U_Recompilin','g unit, obj and asm are older than ppufile'#000+
+  '10031_U_Recompiling unit, shared l','ib is older than ppufile'#000+
+  '10032_U_Recompiling unit, obj and asm are older than ppufile'#000+
   '10033_U_Recompiling unit, obj is older than asm'#000+
   '10034_U_Parsing interface of $1'#000+
   '10035_U_Parsing implementation of $1'#000+
   '10036_U_Second load for unit $1'#000+
-  '10037_U_PPU Check file $1 time $2'#000+
-  '10038_H_Condit','ional $1 was not set at startup in last compilation of'+
-  ' $2'#000+
+  '10037','_U_PPU Check file $1 time $2'#000+
+  '10038_H_Conditional $1 was not set at startup in last compilation of $'+
+  '2'#000+
   '10039_H_Conditional $1 was set at startup in last compilation of $2'#000+
   '10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+
-  '11000_$1 [options] <inputfile> [options]'#000+
-  '11001_W_','Only one source file supported'#000+
+  '11000_','$1 [options] <inputfile> [options]'#000+
+  '11001_W_Only one source file supported'#000+
   '11002_W_DEF file can be created only for OS/2'#000+
   '11003_E_nested response files are not supported'#000+
   '11004_F_No source file name in command line'#000+
-  '11005_N_No option inside $1 config file'#000+
+  '11005_N_No option inside $1 ','config file'#000+
   '11006_E_Illegal parameter: $1'#000+
-  '1','1007_H_-? writes help pages'#000+
+  '11007_H_-? writes help pages'#000+
   '11008_F_Too many config files nested'#000+
   '11009_F_Unable to open file $1'#000+
   '11010_N_Reading further options from $1'#000+
   '11011_W_Target is already set to: $1'#000+
-  '11012_W_Shared libs not supported on DOS platform, reverting to sta','t'+
+  '11012_W_Shared libs not ','supported on DOS platform, reverting to stat'+
   'ic'#000+
   '11013_F_too many IF(N)DEFs'#000+
   '11014_F_too many ENDIFs'#000+
   '11015_F_open conditional at the end of the file'#000+
   '11016_W_Debug information generation is not supported by this executab'+
   'le'#000+
-  '11017_H_Try recompiling with -dGDB'#000+
-  '11018_E_You are using the obs','olete switch $1'#000+
+  '11017_H_Try recompili','ng with -dGDB'#000+
+  '11018_E_You are using the obsolete switch $1'#000+
   '11019_E_You are using the obsolete switch $1, please use $2'#000+
   '11020_N_Switching assembler to default source writing assembler'#000+
-  '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
-  '11022_W_"$1" assembler use forced',#000+
+  '11021_W_Assembler output selected "$1" is not compatible ','with "$2"'#000+
+  '11022_W_"$1" assembler use forced'#000+
   '11026_T_Reading options from file $1'#000+
   '11027_T_Reading options from environment $1'#000+
   '11028_D_Handling option "$1"'#000+
   '11023_Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#010+
-  'Copyright (c) 1993-2000 by Florian Klaempfl'#000+
-  '11024_Free Pasca','l Compiler version $FPCVER'#010+
+  'Copyright (c) 199','3-2000 by Florian Klaempfl'#000+
+  '11024_Free Pascal Compiler version $FPCVER'#010+
   #010+
   'Compiler Date  : $FPCDATE'#010+
   'Compiler Target: $FPCTARGET'#010+
@@ -633,155 +642,157 @@ const msgtxt : array[0..000134,1..240] of char=(
   'This program comes under the GNU General Public Licence'#010+
   'For more information read COPYING.FPC'#010+
   #010+
-  'Report bugs,suggestions etc to:'#010+
-  '                 bugrep@freepa','scal.org'#000+
+  'Report bugs,suggest','ions etc to:'#010+
+  '                 [email protected]'#000+
   '11025_**0*_put + after a boolean switch option to enable it, - to disa'+
   'ble it'#010+
   '**1a_the compiler doesn'#039't delete the generated assembler file'#010+
   '**2al_list sourcecode lines in assembler file'#010+
-  '**2ar_list register allocation/release info in',' assembler file'#010+
+  '**2','ar_list register allocation/release info in assembler file'#010+
   '**2at_list temp allocation/release info in assembler file'#010+
   '**1b_generate browser info'#010+
   '**2bl_generate local symbol info'#010+
   '**1B_build all modules'#010+
   '**1C<x>_code generation options:'#010+
-  '**2CD_create also dynamic library (not supported)'#010,
+  '**2CD_c','reate also dynamic library (not supported)'#010+
   '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
   '**2Ci_IO-checking'#010+
   '**2Cn_omit linking stage'#010+
   '**2Co_check overflow of integer operations'#010+
   '**2Cr_range checking'#010+
   '**2Cs<n>_set stack size to <n>'#010+
-  '**2Ct_stack checking'#010+
-  '**2CX_create also smartlinked',' library'#010+
+  '**2Ct_s','tack checking'#010+
+  '**2CX_create also smartlinked library'#010+
   '**1d<x>_defines the symbol <x>'#010+
   '*O1D_generate a DEF file'#010+
   '*O2Dd<x>_set description to <x>'#010+
   '*O2Dw_PM application'#010+
   '**1e<x>_set path to executable'#010+
   '**1E_same as -Cn'#010+
-  '**1F<x>_set file names and paths:'#010+
-  '**2FD<x>_sets the directory where to sea','rch for compiler utilities'#010+
+  '**1F<x>_set file names and path','s:'#010+
+  '**2FD<x>_sets the directory where to search for compiler utilities'#010+
   '**2Fe<x>_redirect error output to <x>'#010+
   '**2FE<x>_set exe/unit output path to <x>'#010+
   '**2Fi<x>_adds <x> to include path'#010+
   '**2Fl<x>_adds <x> to library path'#010+
-  '*L2FL<x>_uses <x> as dynamic linker'#010+
-  '**2Fo<x>_adds <x> to object pa','th'#010+
+  '*L2FL<x>_uses <x> as dy','namic linker'#010+
+  '**2Fo<x>_adds <x> to object path'#010+
   '**2Fr<x>_load error message file <x>'#010+
   '**2Fu<x>_adds <x> to unit path'#010+
   '**2FU<x>_set unit output path to <x>, overrides -FE'#010+
   '*g1g_generate debugger information:'#010+
   '*g2gg_use gsym'#010+
   '*g2gd_use dbx'#010+
-  '*g2gh_use heap trace unit (for memory leak debugging',')'#010+
+  '*g2gh_use',' heap trace unit (for memory leak debugging)'#010+
   '*g2gl_use line info unit to show more info for backtraces'#010+
   '*g2gc_generate checks for pointers'#010+
   '**1i_information'#010+
   '**2iD_return compiler date'#010+
   '**2iV_return compiler version'#010+
   '**2iSO_return compiler OS'#010+
-  '**2iSP_return compiler processor'#010+
-  '**2iTO_retur','n target OS'#010+
+  '**','2iSP_return compiler processor'#010+
+  '**2iTO_return target OS'#010+
   '**2iTP_return target processor'#010+
   '**1I<x>_adds <x> to include path'#010+
   '**1k<x>_Pass <x> to the linker'#010+
   '**1l_write logo'#010+
   '**1n_don'#039't read the default config file'#010+
-  '**1o<x>_change the name of the executable produced to <x>'#010+
-  '**1pg_generate prof','ile code for gprof (defines FPC_PROFILE)'#010+
+  '**1o<x>_change the name of the exe','cutable produced to <x>'#010+
+  '**1pg_generate profile code for gprof (defines FPC_PROFILE)'#010+
   '*L1P_use pipes instead of creating temporary assembler files'#010+
   '**1S<x>_syntax options:'#010+
   '**2S2_switch some Delphi 2 extensions on'#010+
-  '**2Sc_supports operators like C (*=,+=,/= and -=)'#010+
-  '**2Sa_include assertion',' code.'#010+
+  '**2Sc_supports operators like ','C (*=,+=,/= and -=)'#010+
+  '**2Sa_include assertion code.'#010+
   '**2Sd_tries to be Delphi compatible'#010+
   '**2Se<x>_compiler stops after the <x> errors (default is 1)'#010+
   '**2Sg_allow LABEL and GOTO'#010+
   '**2Sh_Use ansistrings'#010+
   '**2Si_support C++ styled INLINE'#010+
-  '**2Sm_support macros like C (global)'#010+
-  '**2So_tries to be T','P/BP 7.0 compatible'#010+
+  '**2Sm_support',' macros like C (global)'#010+
+  '**2So_tries to be TP/BP 7.0 compatible'#010+
   '**2Sp_tries to be gpc compatible'#010+
   '**2Ss_constructor name must be init (destructor must be done)'#010+
   '**2St_allow static keyword in objects'#010+
-  '**1s_don'#039't call assembler and linker (only with -a)'#010+
+  '**1s_don'#039't call assembler and linker (only w','ith -a)'#010+
   '**1u<x>_undefines the symbol <x>'#010+
-  '**','1U_unit options:'#010+
+  '**1U_unit options:'#010+
   '**2Un_don'#039't check the unit name'#010+
   '**2Us_compile a system unit'#010+
   '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
-  '**2*_e : Show errors (default)       d : Show debug info'#010+
-  '**2*_w : Show warnings               u ',': Show unit info'#010+
+  '**2*_e : Show errors (default)       d : Show debug i','nfo'#010+
+  '**2*_w : Show warnings               u : Show unit info'#010+
   '**2*_n : Show notes                  t : Show tried/used files'#010+
   '**2*_h : Show hints                  m : Show defined macros'#010+
-  '**2*_i : Show general info           p : Show compiled procedures'#010+
-  '**2*_l : Show linenumbers        ','    c : Show conditionals'#010+
+  '**2*_i : Show general info           p : Show compiled p','rocedures'#010+
+  '**2*_l : Show linenumbers            c : Show conditionals'#010+
   '**2*_a : Show everything             0 : Show nothing (except errors)'#010+
   '**2*_b : Show all procedure          r : Rhide/GCC compatibility mode'#010+
-  '**2*_    declarations if an error    x : Executable info (Win32 only)'#010+
-  '**2*','_    occurs'#010+
+  '**2*_    declarations if an err','or    x : Executable info (Win32 only'+
+  ')'#010+
+  '**2*_    occurs'#010+
   '**1X_executable options:'#010+
   '*L2Xc_link with the c library'#010+
   '**2Xs_strip all symbols from executable'#010+
   '**2XD_try to link dynamic          (defines FPC_LINK_DYNAMIC)'#010+
-  '**2XS_try to link static (default) (defines FPC_LINK_STATIC)'#010+
-  '**2XX_try ','to link smart            (defines FPC_LINK_SMART)'#010+
+  '**2XS_try to link static (de','fault) (defines FPC_LINK_STATIC)'#010+
+  '**2XX_try to link smart            (defines FPC_LINK_SMART)'#010+
   '**0*_Processor specific options:'#010+
   '3*1A<x>_output format:'#010+
   '3*2Aas_assemble using GNU AS'#010+
   '3*2Aasaout_assemble using GNU AS for aout (Go32v1)'#010+
-  '3*2Anasmcoff_coff (Go32v2) file using Nasm'#010+
-  '3*2Anasmelf','_elf32 (Linux) file using Nasm'#010+
+  '3*2Anasmcof','f_coff (Go32v2) file using Nasm'#010+
+  '3*2Anasmelf_elf32 (Linux) file using Nasm'#010+
   '3*2Anasmobj_obj file using Nasm'#010+
   '3*2Amasm_obj file using Masm (Microsoft)'#010+
   '3*2Atasm_obj file using Tasm (Borland)'#010+
   '3*2Acoff_coff (Go32v2) using internal writer'#010+
-  '3*2Apecoff_pecoff (Win32) using internal writer'#010+
-  '3*1R','<x>_assembler reading style:'#010+
+  '3*2Apecof','f_pecoff (Win32) using internal writer'#010+
+  '3*1R<x>_assembler reading style:'#010+
   '3*2Ratt_read AT&T style assembler'#010+
   '3*2Rintel_read Intel style assembler'#010+
   '3*2Rdirect_copy assembler text directly to assembler file'#010+
   '3*1O<x>_optimizations:'#010+
-  '3*2Og_generate smaller code'#010+
-  '3*2OG_generate faster code (def','ault)'#010+
+  '3*2Og_generate s','maller code'#010+
+  '3*2OG_generate faster code (default)'#010+
   '3*2Or_keep certain variables in registers'#010+
   '3*2Ou_enable uncertain optimizations (see docs)'#010+
   '3*2O1_level 1 optimizations (quick optimizations)'#010+
-  '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#010+
-  '3*2O3_level 3 optimizations (-O2 repe','atedly, max 5 times)'#010+
+  '3*2O2_level 2 optimizations (-O1 + slower optimizat','ions)'#010+
+  '3*2O3_level 3 optimizations (-O2 repeatedly, max 5 times)'#010+
   '3*2Op<x>_target processor:'#010+
   '3*3Op1_set target processor to 386/486'#010+
   '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#010+
   '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#010+
-  '3*1T<x>_Target operating system:'#010+
-  '3*2TGO32V1_','version 1 of DJ Delorie DOS extender'#010+
+  '3','*1T<x>_Target operating system:'#010+
+  '3*2TGO32V1_version 1 of DJ Delorie DOS extender'#010+
   '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#010+
   '3*2TLINUX_Linux'#010+
   '3*2Tnetware_Novell Netware Module (experimental)'#010+
   '3*2TOS2_OS/2 2.x'#010+
-  '3*2TWin32_Windows 32 Bit'#010+
+  '3*2TSUNOS_SunOS/Solaris'#010+
+  '3*2TWi','n32_Windows 32 Bit'#010+
   '3*1W<x>_Win32 target options'#010+
-  '3*2WB<x>_Set Image ','base to Hexadecimal <x> value'#010+
+  '3*2WB<x>_Set Image base to Hexadecimal <x> value'#010+
   '3*2WC_Specify console type application'#010+
   '3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+
-  '3*2WF_Specify full-screen type application (OS/2 only)'#010+
+  '3*2WF_Specify full-screen type application (OS/2 onl','y)'#010+
   '3*2WG_Specify graphic type application'#010+
-  '3*2WN_Do not generate rel','ocation code (necessary for debugging)'#010+
+  '3*2WN_Do not generate relocation code (necessary for debugging)'#010+
   '3*2WR_Generate relocation code'#010+
   '6*1A<x>_output format'#010+
   '6*2Aas_Unix o-file using GNU AS'#010+
   '6*2Agas_GNU Motorola assembler'#010+
-  '6*2Amit_MIT Syntax (old GAS)'#010+
+  '6*2Amit_MIT Syntax',' (old GAS)'#010+
   '6*2Amot_Standard Motorola assembler'#010+
-  '6*1O_optimizations:'#010,
+  '6*1O_optimizations:'#010+
   '6*2Oa_turn on the optimizer'#010+
   '6*2Og_generate smaller code'#010+
   '6*2OG_generate faster code (default)'#010+
   '6*2Ox_optimize maximum (still BUGGY!!!)'#010+
-  '6*2O2_set target processor to a MC68020+'#010+
+  '6*2O2_set target processor to a MC68020+',#010+
   '6*1R<x>_assembler reading style:'#010+
-  '6*2RMOT_read motorola style assem','bler'#010+
+  '6*2RMOT_read motorola style assembler'#010+
   '6*1T<x>_Target operating system:'#010+
   '6*2TAMIGA_Commodore Amiga'#010+
   '6*2TATARI_Atari ST/STe/TT'#010+
@@ -789,5 +800,5 @@ const msgtxt : array[0..000134,1..240] of char=(
   '6*2TLINUX_Linux-68k'#010+
   '**1*_'#010+
   '**1?_shows this help'#010+
-  '**1h_shows this help without waiting'#000
+  '**1h_shows ','this help without waiting'#000
 );

compiler/ncal.pas

@@ -1497,7 +1497,7 @@ interface
       begin
          inherited create(procinlinen);
          inlineprocsym:=tcallnode(callp).symtableprocentry;
-         retoffset:=-4; { less dangerous as zero (PM) }
+         retoffset:=-target_os.size_of_pointer; { less dangerous as zero (PM) }
          para_offset:=0;
          para_size:=inlineprocsym^.definition^.para_size(target_os.stackalignment);
          if ret_in_param(inlineprocsym^.definition^.rettype.def) then
@@ -1568,7 +1568,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.22  2001-01-08 21:46:46  peter
+  Revision 1.23  2001-02-26 19:44:52  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.22  2001/01/08 21:46:46  peter
     * don't push high value for open array with cdecl;external;
 
   Revision 1.21  2000/12/31 11:14:10  jonas

compiler/nflw.pas

@@ -502,7 +502,9 @@ implementation
 
          { Check count var, record fields are also allowed in tp7 }
          hp:=t2;
-         while (hp.nodetype=subscriptn) do
+         while (hp.nodetype=subscriptn) or
+               ((hp.nodetype=vecn) and
+                is_constintnode(tvecnode(hp).right)) do
           hp:=tsubscriptnode(hp).left;
          { we need a simple loadn, but the load must be in a global symtable or
            in the same lexlevel }
@@ -1025,7 +1027,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2000-12-31 11:14:10  jonas
+  Revision 1.13  2001-02-26 19:44:53  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.12  2000/12/31 11:14:10  jonas
     + implemented/fixed docompare() mathods for all nodes (not tested)
     + nopt.pas, nadd.pas, i386/n386opt.pas: optimized nodes for adding strings
       and constant strings/chars together

compiler/ninl.pas

@@ -910,7 +910,13 @@ implementation
                             hp:=left;
                             while assigned(hp) do
                               begin
+{$ifdef i386}
                                 incrementregisterpushed($ff);
+{$endif}
+{$ifdef m68k}
+                                for regi:=R_D0 to R_A6 do
+                                  inc(reg_pushes[regi],t_times*2);
+{$endif}
                                 if (tcallparanode(hp).left.nodetype=typen) then
                                   CGMessage(type_e_cant_read_write_type);
                                 if assigned(tcallparanode(hp).left.resulttype) then
@@ -1529,7 +1535,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.27  2001-02-22 11:24:40  jonas
+  Revision 1.28  2001-02-26 19:44:53  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.27  2001/02/22 11:24:40  jonas
     * fixed bug in previous fix (hopped over revision 1.26 because that one
       also removed the fix for high(cardinal))
 

compiler/options.pas

@@ -1441,7 +1441,14 @@ begin
       begin
         def_symbol('UNIX');
       end;
-   end;
+    target_i386_sunos :
+      begin
+        def_symbol('UNIX');
+        def_symbol('SOLARIS');
+        def_symbol('LIBC');
+        def_symbol('SUNOS');
+      end;
+  end;
 
 { write logo if set }
   if option.DoWriteLogo then
@@ -1564,7 +1571,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.31  2001-02-26 12:47:46  jonas
+  Revision 1.32  2001-02-26 19:44:53  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.31  2001/02/26 12:47:46  jonas
     * fixed bug in type checking for compatibility of set elements (merged)
     * released fix in options.pas from Carl also for FPC (merged)
 

compiler/pp.pas

@@ -25,12 +25,12 @@ program pp;
 {
   possible compiler switches (* marks a currently required switch):
   -----------------------------------------------------------------
-  USE_RHIDE           generates errors and warning in an format recognized
-                      by rhide
   TP                  to compile the compiler with Turbo or Borland Pascal
   GDB*                support of the GNU Debugger
   I386                generate a compiler for the Intel i386+
   M68K                generate a compiler for the M68000
+  SPARC               generate a compiler for SPARC
+  POWERPC             generate a compiler for the PowerPC
   USEOVERLAY          compiles a TP version which uses overlays
   DEBUG               version with debug code is generated
   EXTDEBUG            some extra debug code is executed
@@ -42,9 +42,7 @@ program pp;
   NOAG386INT          no Intel Assembler output
   NOAG386NSM          no NASM output
   NOAG386BIN          leaves out the binary writer, default for TP
-  LOGMEMBLOCKS        adds memory manager which logs the size of
-                      each allocated memory block, the information
-                      is written to memuse.log after compiling
+  NORA386DIR          No direct i386 assembler reader
   -----------------------------------------------------------------
 
   Required switches for a i386 compiler be compiled by Free Pascal Compiler:
@@ -160,7 +158,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.6  2000-11-29 00:30:37  florian
+  Revision 1.7  2001-02-26 19:44:53  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.6  2000/11/29 00:30:37  florian
     * unused units removed from uses clause
     * some changes for widestrings
 

compiler/psub.pas

@@ -165,7 +165,7 @@ implementation
 {$ifdef m68k}
                    usedinproc:=usedinproc or ($800 shr word(R_D0));
 
-                   if is_64bitint(procinfo^.retdef) then
+                   if is_64bitint(procinfo^.returntype.def) then
                      usedinproc:=usedinproc or ($800 shr byte(R_D1))
 {$endif}
 {$endif newcg}
@@ -823,7 +823,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.24  2000-12-25 00:07:27  peter
+  Revision 1.25  2001-02-26 19:44:53  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.24  2000/12/25 00:07:27  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/rautils.pas

@@ -69,7 +69,8 @@ Function SearchLabel(const s: string; var hl: pasmlabel;emit:boolean): boolean;
 ---------------------------------------------------------------------}
 
 type
-  TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,OPR_REFERENCE,OPR_REGISTER);
+  TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,
+            OPR_REFERENCE,OPR_REGISTER,OPR_REGLIST);
 
   TOprRec = record
     case typ:TOprType of
@@ -78,6 +79,11 @@ type
       OPR_SYMBOL    : (symbol:PAsmSymbol;symofs:longint);
       OPR_REFERENCE : (ref:treference);
       OPR_REGISTER  : (reg:tregister);
+{$ifdef m68k}
+      OPR_REGLIST   : (reglist:pregisterlist);
+{$else not m68k}
+      OPR_REGLIST   : ();
+{$endif m68k}
   end;
 
   POperand = ^TOperand;
@@ -105,6 +111,7 @@ type
     opsize    : topsize;
     condition : tasmcond;
     ops       : byte;
+    labeled   : boolean;
     operands  : array[1..maxoperands] of POperand;
     constructor init;
     destructor  done;virtual;
@@ -841,7 +848,7 @@ Begin
                 end
               else
                 begin
-                  if (procinfo^.framepointer=R_ESP) and
+                  if (procinfo^.framepointer=stack_pointer) and
                      assigned(procinfo^.parent) and
                      (lexlevel=pvarsym(sym)^.owner^.symtablelevel+1) and
                      { same problem as above !!
@@ -881,7 +888,7 @@ Begin
                     opr.ref.base:=procinfo^.framepointer
                   else
                     begin
-                      if (procinfo^.framepointer=R_ESP) and
+                      if (procinfo^.framepointer=stack_pointer) and
                          assigned(procinfo^.parent) and
                          (lexlevel=pvarsym(sym)^.owner^.symtablelevel+1) and
                          {(procinfo^.parent^.sym^.definition^.localst=pvarsym(sym)^.owner) and}
@@ -1046,6 +1053,7 @@ Begin
   Condition:=C_NONE;
   Ops:=0;
   InitOperands;
+  Labeled:=false;
 end;
 
 
@@ -1548,7 +1556,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.14  2000-12-25 00:07:28  peter
+  Revision 1.15  2001-02-26 19:44:54  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.14  2000/12/25 00:07:28  peter
     + new tlinkedlist class (merge of old tstringqueue,tcontainer and
       tlinkedlist objects)
 

compiler/symconst.pas

@@ -111,6 +111,26 @@ type
     sp_protected,
     sp_static,
     sp_primary_typesym    { this is for typesym, to know who is the primary symbol of a def }
+{$ifdef tp}
+    ,sp_7
+    ,sp_8
+    ,sp_9
+    ,sp_10
+    ,sp_11
+    ,sp_12
+    ,sp_13
+    ,sp_14
+    ,sp_15
+    ,sp_16
+    ,sp_17
+    ,sp_18
+    ,sp_19
+    ,sp_20
+    ,sp_21
+    ,sp_22
+    ,sp_23
+    ,sp_24
+{$endif}
   );
   tsymoptions=set of tsymoption;
 
@@ -118,6 +138,30 @@ type
   tdefoption=(df_none,
     df_need_rtti,          { the definitions needs rtti }
     df_has_rtti            { the rtti is generated      }
+{$ifdef tp}
+    ,df_3
+    ,df_4
+    ,df_5
+    ,df_6
+    ,df_7
+    ,df_8
+    ,df_9
+    ,df_10
+    ,df_11
+    ,df_12
+    ,df_13
+    ,df_14
+    ,df_15
+    ,df_16
+    ,df_17
+    ,df_18
+    ,df_19
+    ,df_20
+    ,df_21
+    ,df_22
+    ,df_23
+    ,df_24
+{$endif}
   );
   tdefoptions=set of tdefoption;
 
@@ -161,6 +205,18 @@ type
     pocall_internproc,    { Procedure has compiler magic}
     pocall_internconst,   { procedure has constant evaluator intern }
     pocall_cppdecl        { C++ calling conventions }
+    ,pocall_13
+    ,pocall_14
+    ,pocall_15
+    ,pocall_16
+    ,pocall_17
+    ,pocall_18
+    ,pocall_19
+    ,pocall_20
+    ,pocall_21
+    ,pocall_22
+    ,pocall_23
+    ,pocall_24
   );
   tproccalloptions=set of tproccalloption;
 
@@ -172,6 +228,24 @@ type
     potype_constructor,  { Procedure is a constructor }
     potype_destructor,   { Procedure is a destructor }
     potype_operator      { Procedure defines an operator }
+    ,potype_7
+    ,potype_8
+    ,potype_9
+    ,potype_10
+    ,potype_11
+    ,potype_12
+    ,potype_13
+    ,potype_14
+    ,potype_15
+    ,potype_16
+    ,potype_17
+    ,potype_18
+    ,potype_19
+    ,potype_20
+    ,potype_21
+    ,potype_22
+    ,potype_23
+    ,potype_24
   );
   tproctypeoptions=set of tproctypeoption;
 
@@ -194,11 +268,18 @@ type
     po_savestdregs,       { save std regs cdecl and stdcall need that ! }
     po_saveregisters,     { save all registers }
     po_overload           { procedure is declared with overload directive }
+    ,po_18
+    ,po_19
+    ,po_20
+    ,po_21
+    ,po_22
+    ,po_23
+    ,po_24
   );
   tprocoptions=set of tprocoption;
 
   { options for objects and classes }
-  tobjectdeftype = (
+  tobjectdeftype = (odt_none,
     odt_class,
     odt_object,
     odt_interfacecom,
@@ -219,8 +300,20 @@ type
     oo_has_msgint,
     oo_has_abstract,       { the object/class has an abstract method => no instances can be created }
     oo_can_have_published { the class has rtti, i.e. you can publish properties }
+    ,oo_12
+    ,oo_13
+    ,oo_14
+    ,oo_15
+    ,oo_16
+    ,oo_17
+    ,oo_18
+    ,oo_19
+    ,oo_20
+    ,oo_21
+    ,oo_22
+    ,oo_23
+    ,oo_24
   );
-
   tobjectoptions=set of tobjectoption;
 
   { options for properties }
@@ -230,6 +323,25 @@ type
     ppo_stored,
     ppo_hasparameters,
     ppo_is_override
+    ,ppo_6
+    ,ppo_7
+    ,ppo_8
+    ,ppo_9
+    ,ppo_10
+    ,ppo_11
+    ,ppo_12
+    ,ppo_13
+    ,ppo_14
+    ,ppo_15
+    ,ppo_16
+    ,ppo_17
+    ,ppo_18
+    ,ppo_19
+    ,ppo_20
+    ,ppo_21
+    ,ppo_22
+    ,ppo_23
+    ,ppo_24
   );
   tpropertyoptions=set of tpropertyoption;
 
@@ -244,6 +356,21 @@ type
     vo_is_local_copy,
     vo_is_const,  { variable is declared as const (parameter) and can't be written to }
     vo_is_exported
+    ,vo_10
+    ,vo_11
+    ,vo_12
+    ,vo_13
+    ,vo_14
+    ,vo_15
+    ,vo_16
+    ,vo_17
+    ,vo_18
+    ,vo_19
+    ,vo_20
+    ,vo_21
+    ,vo_22
+    ,vo_23
+    ,vo_24
   );
   tvaroptions=set of tvaroption;
 
@@ -328,7 +455,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  2000-11-04 14:25:21  florian
+  Revision 1.13  2001-02-26 19:44:55  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.12  2000/11/04 14:25:21  florian
     + merged Attila's changes for interfaces, not tested yet
 
   Revision 1.11  2000/10/31 22:02:51  peter

compiler/systems.pas

@@ -61,9 +61,10 @@ interface
        ttarget = (target_none,
             target_i386_GO32V1,target_i386_GO32V2,target_i386_linux,
             target_i386_OS2,target_i386_Win32,target_i386_freebsd,
-            target_i386_Netware,
+            target_i386_Netware,target_i386_sunos,
             target_m68k_Amiga,target_m68k_Atari,target_m68k_Mac,
-            target_m68k_linux,target_m68k_PalmOS,target_alpha_linux,
+            target_m68k_linux,target_m68k_PalmOS,
+            target_alpha_linux,
             target_powerpc_linux,target_powerpc_macos
        );
 
@@ -75,7 +76,7 @@ interface
        { alias for supported_target field in tasminfo }
        target_any = target_none;
 
-       {$ifdef i386} i386targetcnt=7; {$else} i386targetcnt=0; {$endif}
+       {$ifdef i386} i386targetcnt=8; {$else} i386targetcnt=0; {$endif}
        {$ifdef m68k} m68ktargetcnt=5; {$else} m68ktargetcnt=0; {$endif}
        {$ifdef alpha} alphatargetcnt=1; {$else} alphatargetcnt=0; {$endif}
        {$ifdef powerpc} powerpctargetcnt=2; {$else} powerpctargetcnt=0; {$endif}
@@ -129,12 +130,12 @@ interface
      type
        tos = ( os_none,
             os_i386_GO32V1,os_i386_GO32V2,os_i386_Linux,os_i386_OS2,
-            os_i386_Win32,os_i386_freeBSD,os_i386_Netware,
+            os_i386_Win32,os_i386_freeBSD,os_i386_Netware,os_i386_sunos,
             os_m68k_Amiga,os_m68k_Atari,os_m68k_Mac,os_m68k_Linux,
             os_m68k_PalmOS,os_alpha_linux,os_powerpc_linux,os_powerpc_macos
        );
      const
-       i386oscnt=7;
+       i386oscnt=8;
        m68koscnt=5;
        alphaoscnt=1;
        powerpcoscnt=2;
@@ -413,6 +414,28 @@ implementation
             use_bound_instruction : false;
             use_function_relative_addresses : true
           ),
+          (
+            id     : os_i386_sunos;
+            name         : 'sunOS/ELF for i386';
+            shortname    : 'sunos';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            libprefix    : 'lib';
+            Cprefix      : '';
+            newline      : #10;
+            endian       : endian_little;
+            stackalignment : 4;
+            maxCrecordalignment : 4;
+            size_of_pointer : 4;
+            size_of_longint : 4;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          ),
           (
             id     : os_m68k_amiga;
             name         : 'Commodore Amiga';
@@ -1196,6 +1219,29 @@ implementation
             heapsize    : 256*1024;
             maxheapsize : 32768*1024;
             stacksize   : 8192
+          ),
+          (
+            target      : target_i386_sunos;
+            flags       : [];
+            cpu         : i386;
+            short_name  : 'SUNOS';
+            unit_env    : 'SUNOSUNITS';
+            smartext    : '.sl';
+            unitext     : '.ppu';
+            unitlibext  : '.ppl';
+            asmext      : '.s';
+            objext      : '.o';
+            resext      : '.res';
+            resobjext   : '.or';
+            exeext      : '';
+            os          : os_i386_sunos;
+            assem       : as_i386_as;
+            assemsrc    : as_i386_as;
+            ar          : ar_i386_ar;
+            res         : res_none;
+            heapsize    : 256*1024;
+            maxheapsize : 32768*1024;
+            stacksize   : 8192
           )
 {$endif i386}
 {$ifdef m68k}
@@ -1613,21 +1659,27 @@ begin
     {$else}
       {$ifdef OS2}
         set_source_os(os_i386_OS2);
-        if (OS_Mode = osDOS) or (OS_Mode = osDPMI)
-                                            then source_os.scriptext := '.bat';
-{OS/2 via EMX can be run under DOS as well}
+        if (OS_Mode = osDOS) or (OS_Mode = osDPMI) then
+         source_os.scriptext := '.bat';
+        { OS/2 via EMX can be run under DOS as well }
       {$else}
-        {$ifdef LINUX}
-           {$Ifdef BSD}
+        {$ifdef WIN32}
+          set_source_os(os_i386_WIN32);
+        {$else}
+          {$Ifdef BSD}
             set_source_os(os_i386_FreeBSD);
           {$else}
-            set_source_os(os_i386_LINUX);
-           {$endif}
-        {$else}
-          {$ifdef WIN32}
-            set_source_os(os_i386_WIN32);
-          {$endif win32}
-        {$endif linux}
+            {$ifdef sunos}
+              set_source_os(os_i386_sunos);
+            {$else}
+              { Must be the last as some freebsd also
+                defined linux }
+              {$ifdef Linux}
+                set_source_os(os_i386_LINUX);
+              {$endif linux}
+            {$endif sunos}
+          {$endif bsd}
+        {$endif win32}
       {$endif os2}
     {$endif go32v2}
   {$endif go32v1}
@@ -1711,7 +1763,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2001-02-20 21:36:40  peter
+  Revision 1.14  2001-02-26 19:44:55  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.13  2001/02/20 21:36:40  peter
     * tasm/masm fixes merged
 
   Revision 1.12  2001/01/06 20:15:43  peter

compiler/t_fbsd.pas

@@ -1,470 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 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_fbsd;
-
-{$i defines.inc}
-
-interface
-
-  uses
-    import,export,link;
-
-  type
-    timportlibfreebsd=class(timportlib)
-      procedure preparelib(const s:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
-      procedure importvariable(const varname,module:string;const name:string);override;
-      procedure generatelib;override;
-    end;
-
-    texportlibfreebsd=class(texportlib)
-      procedure preparelib(const s : string);override;
-      procedure exportprocedure(hp : texported_item);override;
-      procedure exportvar(hp : texported_item);override;
-      procedure generatelib;override;
-    end;
-
-    tlinkerfreebsd=class(tlinker)
-    private
-      Glibc2,
-      Glibc21 : boolean;
-      Function  WriteResponseFile(isdll:boolean) : Boolean;
-    public
-      constructor Create;
-      procedure SetDefaultInfo;override;
-      function  MakeExecutable:boolean;override;
-      function  MakeSharedLibrary:boolean;override;
-    end;
-
-
-implementation
-
-  uses
-    cutils,cclasses,
-    verbose,systems,globtype,globals,
-    symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symsym;
-
-{*****************************************************************************
-                               TIMPORTLIBLINUX
-*****************************************************************************}
-
-procedure timportlibfreebsd.preparelib(const s : string);
-begin
-end;
-
-
-procedure timportlibfreebsd.importprocedure(const func,module : string;index : longint;const name : string);
-begin
-  { insert sharedlibrary }
-  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
-  { do nothing with the procedure, only set the mangledname }
-  if name<>'' then
-    aktprocsym^.definition^.setmangledname(name)
-  else
-    message(parser_e_empty_import_name);
-end;
-
-
-procedure timportlibfreebsd.importvariable(const varname,module:string;const name:string);
-begin
-  { insert sharedlibrary }
-  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
-  { reset the mangledname and turn off the dll_var option }
-  aktvarsym^.setmangledname(name);
-  exclude(aktvarsym^.varoptions,vo_is_dll_var);
-end;
-
-
-procedure timportlibfreebsd.generatelib;
-begin
-end;
-
-
-{*****************************************************************************
-                               TEXPORTLIBLINUX
-*****************************************************************************}
-
-procedure texportlibfreebsd.preparelib(const s:string);
-begin
-end;
-
-
-procedure texportlibfreebsd.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,'freebsd');
-     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 texportlibfreebsd.exportvar(hp : texported_item);
-begin
-  hp.is_var:=true;
-  exportprocedure(hp);
-end;
-
-
-procedure texportlibfreebsd.generatelib;
-var
-  hp2 : texported_item;
-begin
-  hp2:=texported_item(current_module._exports.first);
-  while assigned(hp2) do
-   begin
-     if not hp2.is_var then
-      begin
-{$ifdef i386}
-        { place jump in codesegment }
-        codeSegment.concat(Tai_align.Create_op(4,$90));
-        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
-        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
-        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
-{$endif i386}
-      end
-     else
-      Message1(parser_e_no_export_of_variables_for_target,'freebsd');
-     hp2:=texported_item(hp2.next);
-   end;
-end;
-
-
-{*****************************************************************************
-                                  TLINKERLINUX
-*****************************************************************************}
-
-Constructor TLinkerFreeBSD.Create;
-begin
-  Inherited Create;
-  LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
-end;
-
-
-procedure TLinkerFreeBSD.SetDefaultInfo;
-{
-  This will also detect which libc version will be used
-}
-begin
-  Glibc2:=false;
-  Glibc21:=false;
-  with Info do
-   begin
-     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES';
-     DllCmd[1]:='ld $OPT -shared -L. -o $EXE $RES';
-     DllCmd[2]:='strip --strip-unneeded $EXE';
-     { first try glibc2 }
-     {$ifndef BSD} {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 TLinkerFreeBSD.WriteResponseFile(isdll:boolean) : Boolean;
-Var
-  linkres      : TLinkRes;
-  i            : longint;
-  cprtobj,
-  gprtobj,
-  prtobj       : string[80];
-  HPath        : TStringListItem;
-  s            : string;
-  found,
-  linkdynamic,
-  linklibc     : boolean;
-begin
-  WriteResponseFile:=False;
-{ set special options for some targets }
-  linkdynamic:=not(SharedLibFiles.empty);
-  linklibc:=(SharedLibFiles.Find('c')<>nil);
-  prtobj:='prt0';
-  cprtobj:='cprt0';
-  gprtobj:='gprt0';
-  if glibc21 then
-   begin
-     cprtobj:='cprt21';
-     gprtobj:='gprt21';
-   end;
-  if cs_profile in aktmoduleswitches then
-   begin
-     prtobj:=gprtobj;
-     if not glibc2 then
-      AddSharedLibrary('gmon');
-     AddSharedLibrary('c');
-     linklibc:=true;
-   end
-  else
-   begin
-     if linklibc then
-      prtobj:=cprtobj;
-   end;
-
-  { Open link.res file }
-  LinkRes.Init(outputexedir+Info.ResName);
-
-  { Write path to search libraries }
-  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
-  while assigned(HPath) do
-   begin
-     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
-     HPath:=TStringListItem(HPath.Next);
-   end;
-  HPath:=TStringListItem(LibrarySearchPath.First);
-  while assigned(HPath) do
-   begin
-     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
-     HPath:=TStringListItem(HPath.Next);
-   end;
-
-  LinkRes.Add('INPUT(');
-  { add objectfiles, start with prt0 always }
-  if prtobj<>'' then
-   LinkRes.AddFileName(FindObjectFile(prtobj,''));
-  { 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(s);
-   end;
-  { 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;
-  LinkRes.Add(')');
-
-  { Write staticlibraries }
-  if not StaticLibFiles.Empty then
-   begin
-     LinkRes.Add('GROUP(');
-     While not StaticLibFiles.Empty do
-      begin
-        S:=StaticLibFiles.GetFirst;
-        LinkRes.AddFileName(s)
-      end;
-     LinkRes.Add(')');
-   end;
-
-  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
-    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
-  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_os.sharedlibext,S);
-           if i>0 then
-            Delete(S,i,255);
-           LinkRes.Add('-l'+s);
-         end
-        else
-         begin
-           linklibc:=true;
-           linkdynamic:=false; { libc will include the ld-linux for us }
-         end;
-      end;
-     { be sure that libc is the last lib }
-     if linklibc then
-      LinkRes.Add('-lc');
-     { 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);
-     LinkRes.Add(')');
-   end;
-{ Write and Close response }
-  linkres.writetodisk;
-  linkres.done;
-
-  WriteResponseFile:=True;
-end;
-
-
-function TLinkerFreeBSD.MakeExecutable:boolean;
-var
-  binstr,
-  cmdstr  : string;
-  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
-   DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
-
-{ Write used files and libraries }
-  WriteResponseFile(false);
-
-{ Call linker }
-  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module.exefilename^);
-  Replace(cmdstr,'$OPT',Info.ExtraOptions);
-  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
-  Replace(cmdstr,'$STATIC',StaticStr);
-  Replace(cmdstr,'$STRIP',StripStr);
-  Replace(cmdstr,'$DYNLINK',DynLinkStr);
-  success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
-
-{ Remove ReponseFile }
-  if (success) and not(cs_link_extern in aktglobalswitches) then
-   RemoveFile(outputexedir+Info.ResName);
-
-  MakeExecutable:=success;   { otherwise a recursive call to link method }
-end;
-
-
-Function TLinkerFreeBSD.MakeSharedLibrary:boolean;
-var
-  binstr,
-  cmdstr  : string;
-  success : boolean;
-begin
-  MakeSharedLibrary:=false;
-  if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module.sharedlibfilename^);
-
-{ Write used files and libraries }
-  WriteResponseFile(true);
-
-{ Call linker }
-  SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
-  Replace(cmdstr,'$OPT',Info.ExtraOptions);
-  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
-  success:=DoExec(FindUtil(binstr),cmdstr,true,false);
-
-{ Strip the library ? }
-  if success and (cs_link_strip in aktglobalswitches) then
-   begin
-     SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
-     Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
-     success:=DoExec(FindUtil(binstr),cmdstr,true,false);
-   end;
-
-{ Remove ReponseFile }
-  if (success) and not(cs_link_extern in aktglobalswitches) then
-   RemoveFile(outputexedir+Info.ResName);
-
-  MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
-end;
-
-end.
-{
-  $Log$
-  Revision 1.7  2001-02-20 21:41:17  peter
-    * new fixfilename, findfile for unix. Look first for lowercase, then
-      NormalCase and last for UPPERCASE names.
-
-  Revision 1.6  2000/12/30 22:53:25  peter
-    * export with the case provided in the exports section
-
-  Revision 1.5  2000/12/25 00:07:30  peter
-    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
-      tlinkedlist objects)
-
-  Revision 1.4  2000/10/31 22:02:53  peter
-    * symtable splitted, no real code changes
-
-  Revision 1.3  2000/09/24 21:33:47  peter
-    * message updates merges
-
-  Revision 1.2  2000/09/24 15:12:12  peter
-    * renamed to be 8.3
-
-  Revision 1.2  2000/09/16 12:24:00  peter
-    * freebsd support routines
-}

compiler/t_go32v1.pas

@@ -1,206 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Peter Vreman
-
-    This unit implements support import,export,link routines
-    for the (i386) go32v1 target
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-unit t_go32v1;
-
-{$i defines.inc}
-
-interface
-
-  uses
-    link;
-
-  type
-    tlinkergo32v1=class(tlinker)
-    private
-       Function  WriteResponseFile(isdll:boolean) : Boolean;
-    public
-       constructor Create;
-       procedure SetDefaultInfo;override;
-       function  MakeExecutable:boolean;override;
-    end;
-
-
-  implementation
-
-    uses
-       cutils,cclasses,
-       globtype,globals,systems,verbose,script,fmodule;
-
-
-{****************************************************************************
-                               TLinkergo32v1
-****************************************************************************}
-
-Constructor TLinkergo32v1.Create;
-begin
-  Inherited Create;
-  { allow duplicated libs (PM) }
-  SharedLibFiles.doubles:=true;
-  StaticLibFiles.doubles:=true;
-end;
-
-
-procedure TLinkergo32v1.SetDefaultInfo;
-begin
-  with Info do
-   begin
-     ExeCmd[1]:='ld -oformat coff-go32 $OPT $STRIP -o $EXE @$RES';
-     ExeCmd[2]:='aout2exe $EXE';
-   end;
-end;
-
-
-Function TLinkergo32v1.WriteResponseFile(isdll:boolean) : Boolean;
-Var
-  linkres  : TLinkRes;
-  i        : longint;
-  HPath    : TStringListItem;
-  s        : string;
-  linklibc : boolean;
-begin
-  WriteResponseFile:=False;
-
-  { Open link.res file }
-  LinkRes.Init(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',''));
-  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;
-
-  { 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_os.sharedlibext,S);
-        if i>0 then
-         Delete(S,i,255);
-        LinkRes.Add('-l'+s);
-      end
-     else
-      begin
-        LinkRes.Add('-l'+s);
-        linklibc:=true;
-      end;
-   end;
-  { be sure that libc&libgcc is the last lib }
-  if linklibc then
-   begin
-     LinkRes.Add('-lc');
-     LinkRes.Add('-lgcc');
-   end;
-
-{ Write and Close response }
-  linkres.writetodisk;
-  linkres.done;
-
-  WriteResponseFile:=True;
-end;
-
-
-function TLinkergo32v1.MakeExecutable:boolean;
-var
-  binstr,
-  cmdstr  : string;
-  success : boolean;
-  StripStr : string[40];
-begin
-  if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module.exefilename^);
-
-{ Create some replacements }
-  StripStr:='';
-  if (cs_link_strip in aktglobalswitches) then
-   StripStr:='-s';
-
-{ Write used files and libraries }
-  WriteResponseFile(false);
-
-{ Call linker }
-  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module.exefilename^);
-  Replace(cmdstr,'$OPT',Info.ExtraOptions);
-  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
-  Replace(cmdstr,'$STRIP',StripStr);
-  success:=DoExec(FindUtil(BinStr),cmdstr,true,false);
-
-{ Remove ReponseFile }
-  if (success) and not(cs_link_extern in aktglobalswitches) then
-   RemoveFile(outputexedir+Info.ResName);
-
-  MakeExecutable:=success;   { otherwise a recursive call to link method }
-end;
-
-end.
-{
-  $Log$
-  Revision 1.5  2000-12-25 00:07:30  peter
-    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
-      tlinkedlist objects)
-
-  Revision 1.4  2000/09/24 15:06:30  peter
-    * use defines.inc
-
-  Revision 1.3  2000/08/27 16:11:54  peter
-    * moved some util functions from globals,cobjects to cutils
-    * splitted files into finput,fmodule
-
-  Revision 1.2  2000/07/13 11:32:50  michael
-  + removed logs
-
-}

compiler/t_go32v2.pas

@@ -1,442 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 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 defines.inc}
-
-interface
-
-  uses
-    link;
-
-  type
-    tlinkergo32v2=class(tlinker)
-    private
-       Function  WriteResponseFile(isdll:boolean) : Boolean;
-       Function  WriteScript(isdll:boolean) : Boolean;
-    public
-       constructor Create;
-       procedure SetDefaultInfo;override;
-       function  MakeExecutable:boolean;override;
-    end;
-
-
-  implementation
-
-    uses
-       cutils,cclasses,
-       globtype,globals,systems,verbose,script,fmodule;
-
-
-{****************************************************************************
-                               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
-      if cs_align in aktglobalswitches then
-        ExeCmd[1]:='ld $SCRIPT $OPT $STRIP -o $EXE'
-      else
-        ExeCmd[1]:='ld -oformat coff-go32-exe $OPT $STRIP -o $EXE @$RES'
-   end;
-end;
-
-
-Function TLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean;
-Var
-  linkres  : TLinkRes;
-  i        : longint;
-  HPath    : TStringListItem;
-  s        : string;
-  linklibc : boolean;
-begin
-  WriteResponseFile:=False;
-
-  { Open link.res file }
-  LinkRes.Init(outputexedir+Info.ResName);
-
-  { Write path to search libraries }
-  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
-  while assigned(HPath) do
-   begin
-     LinkRes.Add('-L'+GetShortName(HPath.Str));
-     HPath:=TStringListItem(HPath.Next);
-   end;
-  HPath:=TStringListItem(LibrarySearchPath.First);
-  while assigned(HPath) do
-   begin
-     LinkRes.Add('-L'+GetShortName(HPath.Str));
-     HPath:=TStringListItem(HPath.Next);
-   end;
-
-  { add objectfiles, start with prt0 always }
-  LinkRes.AddFileName(GetShortName(FindObjectFile('prt0','')));
-  while not ObjectFiles.Empty do
-   begin
-     s:=ObjectFiles.GetFirst;
-     if s<>'' then
-      LinkRes.AddFileName(GetShortName(s));
-   end;
-
-  { 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_os.sharedlibext,S);
-        if i>0 then
-         Delete(S,i,255);
-        LinkRes.Add('-l'+s);
-      end
-     else
-      begin
-        LinkRes.Add('-l'+s);
-        linklibc:=true;
-      end;
-   end;
-  { be sure that libc&libgcc is the last lib }
-  if linklibc then
-   begin
-     LinkRes.Add('-lc');
-     LinkRes.Add('-lgcc');
-   end;
-
-{ Write and Close response }
-  linkres.writetodisk;
-  linkres.done;
-
-  WriteResponseFile:=True;
-end;
-
-Function TLinkerGo32v2.WriteScript(isdll:boolean) : Boolean;
-Var
-  scriptres  : TLinkRes;
-  i        : longint;
-  s        : string;
-  linklibc : boolean;
-begin
-  WriteScript:=False;
-
-  { Open link.res file }
-  ScriptRes.Init(outputexedir+Info.ResName);
-  ScriptRes.Add('OUTPUT_FORMAT("coff-go32-exe")');
-  ScriptRes.Add('ENTRY(start)');
-
-{$ifdef dummy}
-  { Write path to search libraries }
-  HPath:=current_module.locallibrarysearchpath.First;
-  while assigned(HPath) do
-   begin
-     ScriptRes.Add('SEARCH_PATH("'+GetShortName(HPath^.Data^)+'")');
-     HPath:=HPath^.Next;
-   end;
-  HPath:=LibrarySearchPath.First;
-  while assigned(HPath) do
-   begin
-     ScriptRes.Add('SEARCH_PATH("'+GetShortName(HPath^.Data^)+'")');
-     HPath:=HPath^.Next;
-   end;
-{$endif dummy}
-
-  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',''))+'(.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 staticlibraries }
-  if not StaticLibFiles.Empty then
-   begin
-     ScriptRes.Add('-(');
-     While not StaticLibFiles.Empty do
-      begin
-        S:=StaticLibFiles.GetFirst;
-        ScriptRes.AddFileName(GetShortName(s))
-      end;
-     ScriptRes.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_os.sharedlibext,S);
-        if i>0 then
-         Delete(S,i,255);
-        ScriptRes.Add('-l'+s);
-      end
-     else
-      begin
-        ScriptRes.Add('-l'+s);
-        linklibc:=true;
-      end;
-   end;
-  { be sure that libc&libgcc is the last lib }
-  if linklibc then
-   begin
-     ScriptRes.Add('-lc');
-     ScriptRes.Add('-lgcc');
-   end;
-
-{ Write and Close response }
-  ScriptRes.WriteToDisk;
-  ScriptRes.done;
-
-  WriteScript:=True;
-end;
-
-function TLinkerGo32v2.MakeExecutable:boolean;
-var
-  binstr,
-  cmdstr  : string;
-  success : boolean;
-  StripStr : string[40];
-begin
-  if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module.exefilename^);
-
-{ Create some replacements }
-  StripStr:='';
-  if (cs_link_strip in aktglobalswitches) then
-   StripStr:='-s';
-
-  if cs_align in aktglobalswitches then
-    WriteScript(false)
-  else
-    { Write used files and libraries }
-    WriteResponseFile(false);
-
-{ Call linker }
-  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module.exefilename^);
-  Replace(cmdstr,'$OPT',Info.ExtraOptions);
-  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
-  Replace(cmdstr,'$STRIP',StripStr);
-  Replace(cmdstr,'$SCRIPT','--script='+outputexedir+Info.ResName);
-  success:=DoExec(FindUtil(BinStr),cmdstr,true,false);
-
-{ Remove ReponseFile }
-  if (success) and not(cs_link_extern in aktglobalswitches) then
-   RemoveFile(outputexedir+Info.ResName);
-
-  MakeExecutable:=success;   { otherwise a recursive call to link method }
-end;
-
-
-{$ifdef notnecessary}
-procedure tlinkergo32v2.postprocessexecutable(const n : string);
-type
-  tcoffheader=packed record
-    mach   : word;
-    nsects : word;
-    time   : longint;
-    sympos : longint;
-    syms   : longint;
-    opthdr : word;
-    flag   : word;
-  end;
-  tcoffsechdr=packed record
-    name     : array[0..7] of char;
-    vsize    : longint;
-    rvaofs   : longint;
-    datalen  : longint;
-    datapos  : longint;
-    relocpos : longint;
-    lineno1  : longint;
-    nrelocs  : word;
-    lineno2  : word;
-    flags    : longint;
-  end;
-  psecfill=^tsecfill;
-  tsecfill=record
-    fillpos,
-    fillsize : longint;
-    next : psecfill;
-  end;
-var
-  f : file;
-  coffheader : tcoffheader;
-  firstsecpos,
-  maxfillsize,
-  l : longint;
-  coffsec : tcoffsechdr;
-  secroot,hsecroot : psecfill;
-  zerobuf : pointer;
-begin
-  { when -s is used quit, because there is no .exe }
-  if cs_link_extern in aktglobalswitches then
-   exit;
-  { open file }
-  assign(f,n);
-  {$I-}
-   reset(f,1);
-  if ioresult<>0 then
-    Message1(execinfo_f_cant_open_executable,n);
-  { read headers }
-  seek(f,2048);
-  blockread(f,coffheader,sizeof(tcoffheader));
-  { read section info }
-  maxfillsize:=0;
-  firstsecpos:=0;
-  secroot:=nil;
-  for l:=1to coffheader.nSects do
-   begin
-     blockread(f,coffsec,sizeof(tcoffsechdr));
-     if coffsec.datapos>0 then
-      begin
-        if secroot=nil then
-         firstsecpos:=coffsec.datapos;
-        new(hsecroot);
-        hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
-        hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
-        hsecroot^.next:=secroot;
-        secroot:=hsecroot;
-        if secroot^.fillsize>maxfillsize then
-         maxfillsize:=secroot^.fillsize;
-      end;
-   end;
-  if firstsecpos>0 then
-   begin
-     l:=firstsecpos-filepos(f);
-     if l>maxfillsize then
-      maxfillsize:=l;
-   end
-  else
-   l:=0;
-  { get zero buffer }
-  getmem(zerobuf,maxfillsize);
-  fillchar(zerobuf^,maxfillsize,0);
-  { zero from sectioninfo until first section }
-  blockwrite(f,zerobuf^,l);
-  { zero section alignments }
-  while assigned(secroot) do
-   begin
-     seek(f,secroot^.fillpos);
-     blockwrite(f,zerobuf^,secroot^.fillsize);
-     hsecroot:=secroot;
-     secroot:=secroot^.next;
-     dispose(hsecroot);
-   end;
-  freemem(zerobuf,maxfillsize);
-  close(f);
-  {$I+}
-  i:=ioresult;
-  postprocessexecutable:=true;
-end;
-{$endif}
-
-end.
-{
-  $Log$
-  Revision 1.7  2001-01-27 21:29:35  florian
-     * behavior -Oa optimized
-
-  Revision 1.6  2000/12/25 00:07:30  peter
-    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
-      tlinkedlist objects)
-
-  Revision 1.5  2000/09/24 15:06:31  peter
-    * use defines.inc
-
-  Revision 1.4  2000/08/27 16:11:54  peter
-    * moved some util functions from globals,cobjects to cutils
-    * splitted files into finput,fmodule
-
-  Revision 1.3  2000/08/16 13:06:07  florian
-    + support of 64 bit integer constants
-
-  Revision 1.2  2000/07/13 11:32:50  michael
-  + removed logs
-
-}

compiler/t_linux.pas

@@ -1,479 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 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 defines.inc}
-
-interface
-
-  uses
-    import,export,link;
-
-  type
-    timportliblinux=class(timportlib)
-      procedure preparelib(const s:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
-      procedure importvariable(const varname,module:string;const name: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(tlinker)
-    private
-      Glibc2,
-      Glibc21 : boolean;
-      Function  WriteResponseFile(isdll:boolean) : Boolean;
-    public
-      constructor Create;
-      procedure SetDefaultInfo;override;
-      function  MakeExecutable:boolean;override;
-      function  MakeSharedLibrary:boolean;override;
-    end;
-
-
-implementation
-
-  uses
-    cutils,cclasses,
-    verbose,systems,globtype,globals,
-    symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symsym;
-
-{*****************************************************************************
-                               TIMPORTLIBLINUX
-*****************************************************************************}
-
-procedure timportliblinux.preparelib(const s : string);
-begin
-end;
-
-
-procedure timportliblinux.importprocedure(const func,module : string;index : longint;const name : string);
-begin
-  { insert sharedlibrary }
-  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
-  { do nothing with the procedure, only set the mangledname }
-  if name<>'' then
-    aktprocsym^.definition^.setmangledname(name)
-  else
-    message(parser_e_empty_import_name);
-end;
-
-
-procedure timportliblinux.importvariable(const varname,module:string;const name:string);
-begin
-  { insert sharedlibrary }
-  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
-  { reset the mangledname and turn off the dll_var option }
-  aktvarsym^.setmangledname(name);
-  exclude(aktvarsym^.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
-  hp2:=texported_item(current_module._exports.first);
-  while assigned(hp2) do
-   begin
-     if not hp2.is_var then
-      begin
-{$ifdef i386}
-        { place jump in codesegment }
-        codesegment.concat(Tai_align.Create_op(4,$90));
-        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
-        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
-        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
-{$endif i386}
-      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;
-  LibrarySearchPath.AddPath('/lib;/usr/lib;/usr/X11R6/lib',true);
-end;
-
-
-procedure TLinkerLinux.SetDefaultInfo;
-{
-  This will also detect which libc version will be used
-}
-begin
-  Glibc2:=false;
-  Glibc21:=false;
-  with Info do
-   begin
-     ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES';
-     DllCmd[1]:='ld $OPT -shared -L. -o $EXE $RES';
-     DllCmd[2]:='strip --strip-unneeded $EXE';
-     { first try glibc2 }
-     DynamicLinker:='/lib/ld-linux.so.2';
-     if FileExists(DynamicLinker) then
-      begin
-        Glibc2:=true;
-        { 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';
-     {$ifdef BSD}
-      DynamicLinker:='';
-     {$endif}
-   end;
-
-end;
-
-
-Function TLinkerLinux.WriteResponseFile(isdll:boolean) : Boolean;
-Var
-  linkres      : TLinkRes;
-  i            : longint;
-  cprtobj,
-  gprtobj,
-  prtobj       : string[80];
-  HPath        : TStringListItem;
-  s            : string;
-  found,
-  linkdynamic,
-  linklibc     : boolean;
-begin
-  WriteResponseFile:=False;
-{ set special options for some targets }
-  linkdynamic:=not(SharedLibFiles.empty);
-  linklibc:=(SharedLibFiles.Find('c')<>nil);
-  prtobj:='prt0';
-  cprtobj:='cprt0';
-  gprtobj:='gprt0';
-  if glibc21 then
-   begin
-     cprtobj:='cprt21';
-     gprtobj:='gprt21';
-   end;
-  if cs_profile in aktmoduleswitches then
-   begin
-     prtobj:=gprtobj;
-     if not glibc2 then
-      AddSharedLibrary('gmon');
-     AddSharedLibrary('c');
-     linklibc:=true;
-   end
-  else
-   begin
-     if linklibc then
-      prtobj:=cprtobj;
-   end;
-
-  { Open link.res file }
-  LinkRes.Init(outputexedir+Info.ResName);
-
-  { Write path to search libraries }
-  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
-  while assigned(HPath) do
-   begin
-     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
-     HPath:=TStringListItem(HPath.Next);
-   end;
-  HPath:=TStringListItem(LibrarySearchPath.First);
-  while assigned(HPath) do
-   begin
-     LinkRes.Add('SEARCH_DIR('+HPath.Str+')');
-     HPath:=TStringListItem(HPath.Next);
-   end;
-
-  LinkRes.Add('INPUT(');
-  { add objectfiles, start with prt0 always }
-  if prtobj<>'' then
-   LinkRes.AddFileName(FindObjectFile(prtobj,''));
-  { 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(s);
-   end;
-  { 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;
-  LinkRes.Add(')');
-
-  { Write staticlibraries }
-  if not StaticLibFiles.Empty then
-   begin
-     LinkRes.Add('GROUP(');
-     While not StaticLibFiles.Empty do
-      begin
-        S:=StaticLibFiles.GetFirst;
-        LinkRes.AddFileName(s)
-      end;
-     LinkRes.Add(')');
-   end;
-
-  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
-    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
-  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_os.sharedlibext,S);
-           if i>0 then
-            Delete(S,i,255);
-           LinkRes.Add('-l'+s);
-         end
-        else
-         begin
-           linklibc:=true;
-           linkdynamic:=false; { libc will include the ld-linux for us }
-         end;
-      end;
-     { be sure that libc is the last lib }
-     if linklibc then
-      LinkRes.Add('-lc');
-     { 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);
-     LinkRes.Add(')');
-   end;
-{ Write and Close response }
-  linkres.writetodisk;
-  linkres.done;
-
-  WriteResponseFile:=True;
-end;
-
-
-function TLinkerLinux.MakeExecutable:boolean;
-var
-  binstr,
-  cmdstr  : string;
-  success : boolean;
-  DynLinkStr : string[60];
-  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
-   DynLinkStr:='-dynamic-linker='+Info.DynamicLinker;
-
-{ Write used files and libraries }
-  WriteResponseFile(false);
-
-{ Call linker }
-  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module.exefilename^);
-  Replace(cmdstr,'$OPT',Info.ExtraOptions);
-  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
-  Replace(cmdstr,'$STATIC',StaticStr);
-  Replace(cmdstr,'$STRIP',StripStr);
-  Replace(cmdstr,'$DYNLINK',DynLinkStr);
-  success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
-
-{ Remove ReponseFile }
-  if (success) and not(cs_link_extern in aktglobalswitches) then
-   RemoveFile(outputexedir+Info.ResName);
-
-  MakeExecutable:=success;   { otherwise a recursive call to link method }
-end;
-
-
-Function TLinkerLinux.MakeSharedLibrary:boolean;
-var
-  binstr,
-  cmdstr  : string;
-  success : boolean;
-begin
-  MakeSharedLibrary:=false;
-  if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module.sharedlibfilename^);
-
-{ Write used files and libraries }
-  WriteResponseFile(true);
-
-{ Call linker }
-  SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
-  Replace(cmdstr,'$OPT',Info.ExtraOptions);
-  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
-  success:=DoExec(FindUtil(binstr),cmdstr,true,false);
-
-{ Strip the library ? }
-  if success and (cs_link_strip in aktglobalswitches) then
-   begin
-     SplitBinCmd(Info.DllCmd[2],binstr,cmdstr);
-     Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
-     success:=DoExec(FindUtil(binstr),cmdstr,true,false);
-   end;
-
-{ Remove ReponseFile }
-  if (success) and not(cs_link_extern in aktglobalswitches) then
-   RemoveFile(outputexedir+Info.ResName);
-
-  MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
-end;
-
-
-end.
-{
-  $Log$
-  Revision 1.11  2001-02-20 21:41:17  peter
-    * new fixfilename, findfile for unix. Look first for lowercase, then
-      NormalCase and last for UPPERCASE names.
-
-  Revision 1.10  2000/12/30 22:53:25  peter
-    * export with the case provided in the exports section
-
-  Revision 1.9  2000/12/25 00:07:30  peter
-    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
-      tlinkedlist objects)
-
-  Revision 1.8  2000/10/31 22:02:54  peter
-    * symtable splitted, no real code changes
-
-  Revision 1.7  2000/09/24 21:33:47  peter
-    * message updates merges
-
-  Revision 1.6  2000/09/24 15:06:31  peter
-    * use defines.inc
-
-  Revision 1.5  2000/09/10 20:26:55  peter
-    * bsd patches from marco
-
-  Revision 1.4  2000/08/27 16:11:54  peter
-    * moved some util functions from globals,cobjects to cutils
-    * splitted files into finput,fmodule
-
-  Revision 1.3  2000/07/13 12:08:28  michael
-  + patched to 1.1.0 with former 1.09patch from peter
-
-  Revision 1.2  2000/07/13 11:32:50  michael
-  + removed logs
-
-}

compiler/t_nwm.pas

@@ -1,447 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 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.
-
-    First Implementation 10 Sept 2000 Armin Diehl
-
-    Currently generating NetWare-NLM's only work under Linux. This is
-    because nlmconf from binutils does not work with i.e. win32 coff
-    object files. It works fine with ELF-Objects.
-
-    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
-    $VERSION x.x.x  : Sets Major, Minor and Revision
-
-    Sorry, Displaying copyright does not work with nlmconv from gnu bunutils.
-
-    Exports will be handled like in win32:
-    procedure bla;
-    begin
-    end;
-
-    exports bla name 'bla';
-
-    Without Name 'bla' this will be exported in upper-case.
-
-    The path to the import-Files (from netware-sdk, see developer.novell.com)
-    must be specified by the library-path. All external modules are defined
-    as autoload.
-
-    i.e. Procedure ConsolePrintf (p:pchar); cdecl; external 'clib.nlm';
-    sets IMPORT @clib.imp and MODULE clib.
-
-    If you dont have nlmconv, compile gnu-binutils with
-       ./configure --enable-targets=i386-linux,i386-netware
-       make all
-
-    Debugging is currently only possible at assembler level with nwdbg, written
-    by Jan Beulich. Nwdbg supports symbols but it's not a source-level
-    debugger. You can get nwdbg from developer.novell.com. To enter the
-    debugger from your program, define "EnterDebugger" as external cdecl and
-    call it. Int3 will not work with Netware 5.
-
-    A sample program:
-
-    Program Hello;
-    (*$DESCRIPTION HelloWorldNlm*)
-    (*$VERSION 1.2.2*)
-    (*$M 8192,8192*)
-    begin
-      writeLn ('hello world');
-    end.
-
-    compile with:
-    ppc386 -Tnetware hello
-
-    ToDo:
-      - No duplicate imports and autoloads
-      - Screen and Thread-Names
-
-****************************************************************************
-}
-unit t_nwm;
-
-{$i defines.inc}
-
-interface
-
-  uses
-    import,export,link;
-
-  type
-    timportlibnetware=class(timportlib)
-      procedure preparelib(const s:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
-      procedure importvariable(const varname,module:string;const name: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(tlinker)
-    private
-      Function  WriteResponseFile(isdll:boolean) : Boolean;
-    public
-      constructor Create;
-      procedure SetDefaultInfo;override;
-      function  MakeExecutable:boolean;override;
-    end;
-
-
-implementation
-
-  uses
-    cutils,
-    verbose,systems,globtype,globals,
-    symconst,script,
-    fmodule,aasm,cpuasm,cpubase,symsym;
-
-{*****************************************************************************
-                               TIMPORTLIBNETWARE
-*****************************************************************************}
-
-procedure timportlibnetware.preparelib(const s : string);
-begin
-end;
-
-
-procedure timportlibnetware.importprocedure(const func,module : string;index : longint;const name : string);
-begin
-  { insert sharedlibrary }
-  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
-  { do nothing with the procedure, only set the mangledname }
-  if name<>'' then
-    aktprocsym^.definition^.setmangledname(name)
-  else
-    message(parser_e_empty_import_name);
-end;
-
-
-procedure timportlibnetware.importvariable(const varname,module:string;const name:string);
-begin
-  { insert sharedlibrary }
-  current_module.linkothersharedlibs.add(SplitName(module),link_allways);
-  { reset the mangledname and turn off the dll_var option }
-  aktvarsym^.setmangledname(name);
-  exclude(aktvarsym^.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 then
-      begin
-{$ifdef i386}
-        { place jump in codesegment }
-        codeSegment.concat(Tai_align.Create_op(4,$90));
-        codeSegment.concat(Tai_symbol.Createname_global(hp2.name^,0));
-        codeSegment.concat(Taicpu.Op_sym(A_JMP,S_NO,newasmsymbol(hp2.sym^.mangledname)));
-        codeSegment.concat(Tai_symbol_end.Createname(hp2.name^));
-{$endif i386}
-      end
-     else
-      Comment(V_Error,'Exporting of variables is not supported under netware');
-     hp2:=texported_item(hp2.next);
-   end;
-end;
-
-
-{*****************************************************************************
-                                  TLINKERNETWARE
-*****************************************************************************}
-
-Constructor TLinkerNetware.Create;
-begin
-  Inherited Create;
-end;
-
-
-procedure TLinkerNetware.SetDefaultInfo;
-begin
-  with Info do
-   begin
-     ExeCmd[1]:='nlmconv -T$RES';
-     {DllCmd[1]:='ld $OPT -shared -L. -o $EXE $RES';}
-     DllCmd[2]:='strip --strip-unneeded $EXE';
-   end;
-end;
-
-
-Function TLinkerNetware.WriteResponseFile(isdll:boolean) : Boolean;
-Var
-  linkres      : TLinkRes;
-  i            : longint;
-  s,s2         : string;
-  found        : boolean;
-  ProgNam      : string [80];
-  NlmNam       : string [80];
-  hp2          : texported_item;  { for exports }
-begin
-  WriteResponseFile:=False;
-
-  ProgNam := current_module.exefilename^;
-  i:=Pos(target_os.exeext,ProgNam);
-  if i>0 then
-    Delete(ProgNam,i,255);
-  NlmNam := ProgNam + target_os.exeext;
-
-  { Open link.res file }
-  LinkRes.Init(outputexedir+Info.ResName);
-
-  if Description <> '' then
-    LinkRes.Add('DESCRIPTION "' + Description + '"');
-  LinkRes.Add('VERSION '+tostr(dllmajor)+','+tostr(dllminor)+','+tostr(dllrevision));
-  LinkRes.Add('SCREENNAME "' + ProgNam + '"');  { for that, we have }
-  LinkRes.Add('THREADNAME "' + ProgNam + '"');  { to add comiler directives }
-  if stacksize > 1024 then
-  begin
-    str (stacksize, s);
-    LinkRes.Add ('STACKSIZE '+s);
-  end;
-
-  { add objectfiles, start with nwpre always }
-  LinkRes.Add ('INPUT '+FindObjectFile('nwpre',''));
-
-  { main objectfiles }
-  while not ObjectFiles.Empty do
-   begin
-     s:=ObjectFiles.GetFirst;
-     if s<>'' then
-      LinkRes.Add ('INPUT ' + FindObjectFile (s,''));
-   end;
-
-  { output file (nlm) }
-  LinkRes.Add ('OUTPUT ' + NlmNam);
-
-  { start and stop-procedures }
-  LinkRes.Add ('START _Prelude');  { defined in rtl/netware/nwpre.pp }
-  LinkRes.Add ('EXIT _Stop');
-
-  //if not (cs_link_strip in aktglobalswitches) then
-  { ahhhggg: how do i detect if we have debug-symbols ? }
-  LinkRes.Add ('DEBUG');
-
-  { Write staticlibraries, is that correct ? }
-  if not StaticLibFiles.Empty then
-   begin
-     While not StaticLibFiles.Empty do
-      begin
-        S:=lower (StaticLibFiles.GetFirst);
-        if s<>'' then
-         begin
-           i:=Pos(target_os.staticlibext,S);
-           if i>0 then
-            Delete(S,i,255);
-           S := S + '.imp';
-           librarysearchpath.FindFile(S,s);
-           LinkRes.Add('IMPORT @'+s);
-         end
-      end;
-   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_os.sharedlibext,S);
-           if i>0 then
-            Delete(S,i,255);
-           S := S + '.imp';
-           librarysearchpath.FindFile(S,s);
-           LinkRes.Add('IMPORT @'+s);
-           LinkRes.Add('MODULE '+s2);
-         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
-          Warning: The Symbol is converted to upper-case if not explicitly
-          specified by >>Exports BlaBla NAME 'BlaBla';<< }
-        Comment(V_Debug,'Exporting '+hp2.name^);
-        LinkRes.Add ('EXPORT '+hp2.name^);
-      end
-     else
-      { really ? }
-      Comment(V_Error,'Exporting of variables is not supported under netware');
-     hp2:=texported_item(hp2.next);
-   end;
-
-{ Write and Close response }
-  linkres.writetodisk;
-  linkres.done;
-
-  WriteResponseFile:=True;
-end;
-
-
-function TLinkerNetware.MakeExecutable:boolean;
-var
-  binstr,
-  cmdstr  : string;
-  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:='';
-
-{ Write used files and libraries }
-  WriteResponseFile(false);
-
-{ Call linker }
-  SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
-  Replace(cmdstr,'$EXE',current_module.exefilename^);
-  Replace(cmdstr,'$OPT',Info.ExtraOptions);
-  Replace(cmdstr,'$RES',outputexedir+Info.ResName);
-  Replace(cmdstr,'$STATIC',StaticStr);
-  Replace(cmdstr,'$STRIP',StripStr);
-  Replace(cmdstr,'$DYNLINK',DynLinkStr);
-  success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
-
-  { Remove ReponseFile }
-  if (success) and not(cs_link_extern in aktglobalswitches) then
-    RemoveFile(outputexedir+Info.ResName);
-
-  MakeExecutable:=success;   { otherwise a recursive call to link method }
-end;
-
-end.
-{
-  $Log$
-  Revision 1.6  2001-02-20 21:41:16  peter
-    * new fixfilename, findfile for unix. Look first for lowercase, then
-      NormalCase and last for UPPERCASE names.
-
-  Revision 1.5  2000/12/25 00:07:30  peter
-    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
-      tlinkedlist objects)
-
-  Revision 1.4  2000/11/29 00:30:42  florian
-    * unused units removed from uses clause
-    * some changes for widestrings
-
-  Revision 1.3  2000/10/31 22:02:55  peter
-    * symtable splitted, no real code changes
-
-  Revision 1.2  2000/09/24 15:06:31  peter
-    * use defines.inc
-
-  Revision 1.1  2000/09/11 17:00:23  florian
-    + first implementation of Netware Module support, thanks to
-      Armin Diehl ([email protected]) for providing the patches
-
-}

compiler/t_os2.pas

@@ -1,526 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Daniel Mantione
-    Portions Copyright (c) 1998-2000 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
-   <[email protected]>.
-}
-unit t_os2;
-
-{$i defines.inc}
-
-interface
-uses
-  import,link,comprsrc;
-
-type
-  timportlibos2=class(timportlib)
-    procedure preparelib(const s:string);override;
-    procedure importprocedure(const func,module:string;index:longint;const name:string);override;
-    procedure generatelib;override;
-  end;
-
-    tlinkeros2=class(tlinker)
-    private
-       Function  WriteResponseFile(isdll:boolean) : Boolean;
-    public
-       constructor Create;
-       procedure SetDefaultInfo;override;
-       function  MakeExecutable:boolean;override;
-    end;
-
-
-{***************************************************************************}
-
-{***************************************************************************}
-
-implementation
-
-  uses
-{$ifdef Delphi}
-     sysutils,
-     dmisc,
-{$else Delphi}
-     strings,
-     dos,
-{$endif Delphi}
-     cutils,cclasses,
-     globtype,comphook,systems,
-     globals,verbose,fmodule,script;
-
-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
-        Do_halt($da);
-    if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then
-        Do_halt($da);
-    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
-        Do_halt($da);
-    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
-        Do_halt($da);
-    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+'.ao2');
-    seq_no:=1;
-    current_module.linkunitstaticlibs.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(const func,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;
-begin
-    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 $EXE @$RES';
-     ExeCmd[2]:='emxbind -b $STRIP $APPTYPE $RSRC -k$STACKKB -h$HEAPMB -o $EXE.exe $EXE -aim -s$DOSHEAPKB';
-   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.Init(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',''));
-  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_os.sharedlibext,S);
-     if i>0 then
-      Delete(S,i,255);
-     LinkRes.Add('-l'+s);
-   end;
-
-{ Write and Close response }
-  linkres.writetodisk;
-  linkres.done;
-
-  WriteResponseFile:=True;
-end;
-
-
-function TLinkeros2.MakeExecutable:boolean;
-var
-  binstr,
-  cmdstr  : string;
-  success : boolean;
-  i       : longint;
-  AppTypeStr,
-  StripStr: string[40];
-  RsrcStr : string;
-begin
-  if not(cs_link_extern in aktglobalswitches) then
-   Message1(exec_i_linking,current_module.exefilename^);
-
-{ Create some replacements }
-  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, however. *)
-  Current_module.ResourceFiles.Clear;
-{ Write used files and libraries }
-  WriteResponseFile(false);
-
-{ Call linker }
-  success:=false;
-  for i:=1 to 2 do
-   begin
-     SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
-     if binstr<>'' then
-      begin
-        Replace(cmdstr,'$HEAPMB',tostr((maxheapsize+1048575) shr 20));
-        {Size of the stack when an EMX program runs in OS/2.}
-        Replace(cmdstr,'$STACKKB',tostr((stacksize+1023) shr 10));
-        {When an EMX program runs in DOS, the heap and stack share the
-         same memory pool. The heap grows upwards, the stack grows downwards.}
-        Replace(cmdstr,'$DOSHEAPKB',tostr((stacksize+maxheapsize+1023) shr 10));
-        Replace(cmdstr,'$STRIP',StripStr);
-        Replace(cmdstr,'$APPTYPE',AppTypeStr);
-        Replace(cmdstr,'$RES',outputexedir+Info.ResName);
-        Replace(cmdstr,'$OPT',Info.ExtraOptions);
-        Replace(cmdstr,'$RSRC',RsrcStr);
-        Replace(cmdstr,'$EXE',current_module.exefilename^);
-        success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
-(* We still want to have the PPAS script complete, right?
-        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;
-
-
-end.
-{
-  $Log$
-  Revision 1.7  2001-01-20 18:32:52  hajny
-    + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
-
-  Revision 1.6  2000/12/25 00:07:30  peter
-    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
-      tlinkedlist objects)
-
-  Revision 1.5  2000/09/24 15:06:31  peter
-    * use defines.inc
-
-  Revision 1.4  2000/09/20 19:38:34  peter
-    * fixed staticlib filename and unitlink instead of otherlinky
-
-  Revision 1.3  2000/08/27 16:11:54  peter
-    * moved some util functions from globals,cobjects to cutils
-    * splitted files into finput,fmodule
-
-  Revision 1.2  2000/07/13 11:32:50  michael
-  + removed logs
-
-}

compiler/t_win32.pas

@@ -1,1288 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 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_win32;
-
-{$i defines.inc}
-
-interface
-
-  uses
-    import,export,link;
-
-  const
-     winstackpagesize = 4096;
-
-  type
-    timportlibwin32=class(timportlib)
-      procedure preparelib(const s:string);override;
-      procedure importprocedure(const func,module:string;index:longint;const name:string);override;
-      procedure importvariable(const varname,module:string;const name:string);override;
-      procedure generatelib;override;
-      procedure generatenasmlib;virtual;
-      procedure generatesmartlib;override;
-    end;
-
-    texportlibwin32=class(texportlib)
-      st : string;
-      last_index : longint;
-      procedure preparelib(const s:string);override;
-      procedure exportprocedure(hp : texported_item);override;
-      procedure exportvar(hp : texported_item);override;
-      procedure generatelib;override;
-      procedure generatenasmlib;virtual;
-    end;
-
-    tlinkerwin32=class(tlinker)
-    private
-       Function  WriteResponseFile(isdll:boolean) : Boolean;
-       Function  PostProcessExecutable(const fn:string;isdll:boolean) : Boolean;
-    public
-       Constructor Create;
-       Procedure SetDefaultInfo;override;
-       function  MakeExecutable:boolean;override;
-       function  MakeSharedLibrary:boolean;override;
-    end;
-
-
-implementation
-
-    uses
-{$ifdef Delphi}
-       dmisc,
-{$else Delphi}
-       dos,
-{$endif Delphi}
-       cutils,cclasses,
-       aasm,fmodule,globtype,globals,systems,verbose,
-       script,gendef,impdef,
-       cpubase,cpuasm
-{$ifdef GDB}
-       ,gdb
-{$endif}
-       ;
-
-    function DllName(Const Name : string) : string;
-      var n : string;
-      begin
-         n:=Upper(SplitExtension(Name));
-         if (n='.DLL') or (n='.DRV') or (n='.EXE') then
-           DllName:=Name
-         else
-           DllName:=Name+target_os.sharedlibext;
-      end;
-
-
-    function FindDLL(const s:string):string;
-      var
-        sysdir : string;
-        FoundDll : 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,'.'+DirSep,founddll);
-        if (not found) then
-         Found:=includesearchpath.FindFile(s,founddll);
-        if (not found) then
-         begin
-           sysdir:=FixPath(GetEnv('windir'),false);
-           Found:=FindFile(s,sysdir+';'+sysdir+'system'+DirSep+';'+sysdir+'system32'+DirSep,founddll);
-         end;
-        if (not found) then
-         begin
-           message1(exec_w_libfile_not_found,s);
-           FoundDll:=s;
-         end;
-        FindDll:=FoundDll;
-      end;
-
-
-{*****************************************************************************
-                             TIMPORTLIBWIN32
-*****************************************************************************}
-
-    procedure timportlibwin32.preparelib(const s : string);
-      begin
-         if not(assigned(importssection)) then
-           importssection:=TAAsmoutput.create;
-      end;
-
-
-    procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
-      var
-         hp1 : timportlist;
-         hp2 : timported_item;
-         hs  : string;
-      begin
-         hs:=DllName(module);
-         { 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 }
-         hp2:=timported_item(hp1.imported_items.first);
-         while assigned(hp2) do
-          begin
-            if hp2.func^=func then
-             break;
-            hp2:=timported_item(hp2.next);
-          end;
-         if not assigned(hp2) then
-          begin
-            hp2:=timported_item.create(func,name,index);
-            hp1.imported_items.concat(hp2);
-          end;
-      end;
-
-
-    procedure timportlibwin32.importvariable(const varname,module:string;const name:string);
-      var
-         hp1 : timportlist;
-         hp2 : timported_item;
-         hs  : string;
-      begin
-         hs:=DllName(module);
-         { 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:=timported_item.create_var(varname,name);
-         hp1.imported_items.concat(hp2);
-      end;
-
-    procedure timportlibwin32.generatenasmlib;
-      var
-         hp1 : timportlist;
-         hp2 : timported_item;
-         p : pchar;
-      begin
-         importssection.concat(tai_section.create(sec_code));
-         hp1:=timportlist(current_module.imports.first);
-         while assigned(hp1) do
-           begin
-             hp2:=timported_item(hp1.imported_items.first);
-             while assigned(hp2) do
-               begin
-                 if (aktoutputformat=as_i386_tasm) or
-                    (aktoutputformat=as_i386_masm) then
-                   p:=strpnew(#9+'EXTRN '+hp2.func^)
-                 else
-                   p:=strpnew(#9+'EXTERN '+hp2.func^);
-                 importssection.concat(tai_direct.create(p));
-                 p:=strpnew(#9+'import '+hp2.func^+' '+hp1.dllname^+' '+hp2.name^);
-                 importssection.concat(tai_direct.create(p));
-                 hp2:=timported_item(hp2.next);
-               end;
-             hp1:=timportlist(hp1.next);
-           end;
-      end;
-
-
-    procedure timportlibwin32.generatesmartlib;
-      var
-         hp1 : timportlist;
-         hp2 : timported_item;
-         lhead,lname,lcode,
-         lidata4,lidata5 : pasmlabel;
-         r : preference;
-      begin
-         if (aktoutputformat<>as_i386_asw) and
-            (aktoutputformat<>as_i386_pecoff) then
-          begin
-            generatenasmlib;
-            exit;
-          end;
-         hp1:=timportlist(current_module.imports.first);
-         while assigned(hp1) do
-           begin
-           { Get labels for the sections }
-             getdatalabel(lhead);
-             getdatalabel(lname);
-             getaddrlabel(lidata4);
-             getaddrlabel(lidata5);
-           { create header for this importmodule }
-             importsSection.concat(Tai_cut.Create_begin);
-             importsSection.concat(Tai_section.Create(sec_idata2));
-             importsSection.concat(Tai_label.Create(lhead));
-             { pointer to procedure names }
-             importsSection.concat(Tai_const_symbol.Create_rva(lidata4));
-             { two empty entries follow }
-             importsSection.concat(Tai_const.Create_32bit(0));
-             importsSection.concat(Tai_const.Create_32bit(0));
-             { pointer to dll name }
-             importsSection.concat(Tai_const_symbol.Create_rva(lname));
-             { pointer to fixups }
-             importsSection.concat(Tai_const_symbol.Create_rva(lidata5));
-             { first write the name references }
-             importsSection.concat(Tai_section.Create(sec_idata4));
-             importsSection.concat(Tai_const.Create_32bit(0));
-             importsSection.concat(Tai_label.Create(lidata4));
-             { then the addresses and create also the indirect jump }
-             importsSection.concat(Tai_section.Create(sec_idata5));
-             importsSection.concat(Tai_const.Create_32bit(0));
-             importsSection.concat(Tai_label.Create(lidata5));
-
-             { create procedures }
-             hp2:=timported_item(hp1.imported_items.first);
-             while assigned(hp2) do
-               begin
-                 { insert cuts }
-                 importsSection.concat(Tai_cut.Create);
-                 { create indirect jump }
-                 if not hp2.is_var then
-                  begin
-                    getlabel(lcode);
-                    new(r);
-                    reset_reference(r^);
-                    r^.symbol:=lcode;
-                    { place jump in codesegment, insert a code section in the
-                      importsection to reduce the amount of .s files (PFV) }
-                    importsSection.concat(Tai_section.Create(sec_code));
-{$IfDef GDB}
-                    if (cs_debuginfo in aktmoduleswitches) then
-                     importsSection.concat(Tai_stab_function_name.Create(nil));
-{$EndIf GDB}
-                    importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
-                    importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,r));
-                    importsSection.concat(Tai_align.Create_op(4,$90));
-                  end;
-                 { create head link }
-                 importsSection.concat(Tai_section.Create(sec_idata7));
-                 importsSection.concat(Tai_const_symbol.Create_rva(lhead));
-                 { fixup }
-                 getlabel(pasmlabel(hp2.lab));
-                 importsSection.concat(Tai_section.Create(sec_idata4));
-                 importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab));
-                 { add jump field to importsection }
-                 importsSection.concat(Tai_section.Create(sec_idata5));
-                 if hp2.is_var then
-                  importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0))
-                 else
-                  importsSection.concat(Tai_label.Create(lcode));
-                  if hp2.name^<>'' then
-                    importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab))
-                  else
-                    importsSection.concat(Tai_const.Create_32bit($80000000 or hp2.ordnr));
-                 { finally the import information }
-                 importsSection.concat(Tai_section.Create(sec_idata6));
-                 importsSection.concat(Tai_label.Create(hp2.lab));
-                 importsSection.concat(Tai_const.Create_16bit(hp2.ordnr));
-                 importsSection.concat(Tai_string.Create(hp2.name^+#0));
-                 importsSection.concat(Tai_align.Create_op(2,0));
-                 hp2:=timported_item(hp2.next);
-               end;
-
-              { write final section }
-              importsSection.concat(Tai_cut.Create_end);
-              { end of name references }
-              importsSection.concat(Tai_section.Create(sec_idata4));
-              importsSection.concat(Tai_const.Create_32bit(0));
-              { end if addresses }
-              importsSection.concat(Tai_section.Create(sec_idata5));
-              importsSection.concat(Tai_const.Create_32bit(0));
-              { dllname }
-              importsSection.concat(Tai_section.Create(sec_idata7));
-              importsSection.concat(Tai_label.Create(lname));
-              importsSection.concat(Tai_string.Create(hp1.dllname^+#0));
-
-              hp1:=timportlist(hp1.next);
-           end;
-       end;
-
-
-    procedure timportlibwin32.generatelib;
-      var
-         hp1 : timportlist;
-         hp2 : timported_item;
-         l1,l2,l3,l4 : pasmlabel;
-         r : preference;
-      begin
-         if (aktoutputformat<>as_i386_asw) and
-            (aktoutputformat<>as_i386_pecoff) then
-          begin
-            generatenasmlib;
-            exit;
-          end;
-         hp1:=timportlist(current_module.imports.first);
-         while assigned(hp1) do
-           begin
-              { align codesegment for the jumps }
-              importsSection.concat(Tai_section.Create(sec_code));
-              importsSection.concat(Tai_align.Create_op(4,$90));
-              { Get labels for the sections }
-              getlabel(l1);
-              getlabel(l2);
-              getlabel(l3);
-              importsSection.concat(Tai_section.Create(sec_idata2));
-              { pointer to procedure names }
-              importsSection.concat(Tai_const_symbol.Create_rva(l2));
-              { two empty entries follow }
-              importsSection.concat(Tai_const.Create_32bit(0));
-              importsSection.concat(Tai_const.Create_32bit(0));
-              { pointer to dll name }
-              importsSection.concat(Tai_const_symbol.Create_rva(l1));
-              { pointer to fixups }
-              importsSection.concat(Tai_const_symbol.Create_rva(l3));
-
-              { only create one section for each else it will
-                create a lot of idata* }
-
-              { first write the name references }
-              importsSection.concat(Tai_section.Create(sec_idata4));
-              importsSection.concat(Tai_label.Create(l2));
-
-              hp2:=timported_item(hp1.imported_items.first);
-              while assigned(hp2) do
-                begin
-                   getlabel(pasmlabel(hp2.lab));
-                   if hp2.name^<>'' then
-                     importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab))
-                   else
-                     importsSection.concat(Tai_const.Create_32bit($80000000 or hp2.ordnr));
-                   hp2:=timported_item(hp2.next);
-                end;
-              { finalize the names ... }
-              importsSection.concat(Tai_const.Create_32bit(0));
-
-              { then the addresses and create also the indirect jump }
-              importsSection.concat(Tai_section.Create(sec_idata5));
-              importsSection.concat(Tai_label.Create(l3));
-              hp2:=timported_item(hp1.imported_items.first);
-              while assigned(hp2) do
-                begin
-                   if not hp2.is_var then
-                    begin
-                      getlabel(l4);
-                      { create indirect jump }
-                      new(r);
-                      reset_reference(r^);
-                      r^.symbol:=l4;
-                      { place jump in codesegment }
-                      importsSection.concat(Tai_section.Create(sec_code));
-                      importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
-                      importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,r));
-                      importsSection.concat(Tai_align.Create_op(4,$90));
-                      { add jump field to importsection }
-                      importsSection.concat(Tai_section.Create(sec_idata5));
-                      importsSection.concat(Tai_label.Create(l4));
-                    end
-                   else
-                    begin
-                      importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
-                    end;
-                   importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab));
-                   hp2:=timported_item(hp2.next);
-                end;
-              { finalize the addresses }
-              importsSection.concat(Tai_const.Create_32bit(0));
-
-              { finally the import information }
-              importsSection.concat(Tai_section.Create(sec_idata6));
-              hp2:=timported_item(hp1.imported_items.first);
-              while assigned(hp2) do
-                begin
-                   importsSection.concat(Tai_label.Create(hp2.lab));
-                   { the ordinal number }
-                   importsSection.concat(Tai_const.Create_16bit(hp2.ordnr));
-                   importsSection.concat(Tai_string.Create(hp2.name^+#0));
-                   importsSection.concat(Tai_align.Create_op(2,0));
-                   hp2:=timported_item(hp2.next);
-                end;
-              { create import dll name }
-              importsSection.concat(Tai_section.Create(sec_idata7));
-              importsSection.concat(Tai_label.Create(l1));
-              importsSection.concat(Tai_string.Create(hp1.dllname^+#0));
-
-              hp1:=timportlist(hp1.next);
-           end;
-      end;
-
-
-{*****************************************************************************
-                             TEXPORTLIBWIN32
-*****************************************************************************}
-
-    procedure texportlibwin32.preparelib(const s:string);
-      begin
-         if not(assigned(exportssection)) then
-           exportssection:=TAAsmoutput.create;
-         last_index:=0;
-      end;
-
-
-
-    procedure texportlibwin32.exportvar(hp : texported_item);
-      begin
-         { same code used !! PM }
-         exportprocedure(hp);
-      end;
-
-
-    procedure texportlibwin32.exportprocedure(hp : texported_item);
-      { must be ordered at least for win32 !! }
-      var
-        hp2 : texported_item;
-      begin
-        { first test the index value }
-        if (hp.options and eo_index)<>0 then
-          begin
-             if (hp.index<=0) or (hp.index>$ffff) then
-               begin
-                 message1(parser_e_export_invalid_index,tostr(hp.index));
-                 exit;
-               end;
-             if (hp.index<=last_index) then
-               begin
-                 message1(parser_e_export_ordinal_double,tostr(hp.index));
-                 { disregard index value }
-                 inc(last_index);
-                 hp.index:=last_index;
-                 exit;
-               end
-             else
-               begin
-                 last_index:=hp.index;
-               end;
-          end
-        else
-          begin
-             inc(last_index);
-             hp.index:=last_index;
-          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 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 : pasmlabel;
-         export_name_table_pointers,export_ordinal_table : pasmlabel;
-         hp,hp2 : texported_item;
-         temtexport : TLinkedList;
-         address_table,name_table_pointers,
-         name_table,ordinal_table : TAAsmoutput;
-      begin
-        if (aktoutputformat<>as_i386_asw) and
-           (aktoutputformat<>as_i386_pecoff) 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;
-         getlabel(dll_name_label);
-         getlabel(export_address_table);
-         getlabel(export_name_table_pointers);
-         getlabel(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;
-
-         exportsSection.concat(Tai_section.Create(sec_edata));
-         { export flags }
-         exportsSection.concat(Tai_const.Create_32bit(0));
-         { date/time stamp }
-         exportsSection.concat(Tai_const.Create_32bit(0));
-         { major version }
-         exportsSection.concat(Tai_const.Create_16bit(0));
-         { minor version }
-         exportsSection.concat(Tai_const.Create_16bit(0));
-         { pointer to dll name }
-         exportsSection.concat(Tai_const_symbol.Create_rva(dll_name_label));
-         { ordinal base normally set to 1 }
-         exportsSection.concat(Tai_const.Create_32bit(ordinal_base));
-         { number of entries }
-         exportsSection.concat(Tai_const.Create_32bit(entries));
-         { number of named entries }
-         exportsSection.concat(Tai_const.Create_32bit(named_entries));
-         { address of export address table }
-         exportsSection.concat(Tai_const_symbol.Create_rva(export_address_table));
-         { address of name pointer pointers }
-         exportsSection.concat(Tai_const_symbol.Create_rva(export_name_table_pointers));
-         { address of ordinal number pointers }
-         exportsSection.concat(Tai_const_symbol.Create_rva(export_ordinal_table));
-         { the name }
-         exportsSection.concat(Tai_label.Create(dll_name_label));
-         if st='' then
-           exportsSection.concat(Tai_string.Create(current_module.modulename^+target_os.sharedlibext+#0))
-         else
-           exportsSection.concat(Tai_string.Create(st+target_os.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
-                   getlabel(name_label);
-                   name_table_pointers.concat(Tai_const_symbol.Create_rva(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
-                begin
-                   hp2:=texported_item(hp2.next);
-                end;
-              if hp2=texported_item(temtexport.first) then
-                 temtexport.insert(hp)
-              else
-                begin
-                   if assigned(hp2) then
-                     begin
-                        hp.next:=hp2;
-                        hp.previous:=hp2.previous;
-                        hp2.previous:=hp;
-                        if assigned(hp.previous) then
-                          hp.previous.next:=hp;
-                      end
-                    else
-                      temtexport.concat(hp);
-                end;
-              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;
-              address_table.concat(Tai_const_symbol.Createname_rva(hp.sym^.mangledname));
-              inc(current_index);
-              hp:=texported_item(hp.next);
-           end;
-
-         exportsSection.concatlist(address_table);
-         exportsSection.concatlist(name_table_pointers);
-         exportsSection.concatlist(ordinal_table);
-         exportsSection.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;
-      begin
-         exportssection.concat(tai_section.create(sec_code));
-         hp:=texported_item(current_module._exports.first);
-         while assigned(hp) do
-           begin
-             p:=strpnew(#9+'export '+hp.sym^.mangledname+' '+hp.name^+' '+tostr(hp.index));
-             exportssection.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;
-  If not ForceDeffileForExport then
-    UseDeffileForExport:=false;
-end;
-
-Procedure TLinkerWin32.SetDefaultInfo;
-begin
-  with Info do
-   begin
-     ExeCmd[1]:='ldw $OPT $STRIP $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES';
-     DllCmd[1]:='ldw $OPT $STRIP --dll $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES';
-     if RelocSection or UseDeffileForExport then
-       begin
-          { 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]:='ldw $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]:='ldw $OPT $STRIP --dll $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$';
-       end;
-   end;
-end;
-
-
-
-Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
-
-  function do_makedef(const DllName,LibName:string):boolean;
-  var
-    CmdLine : string;
-  begin
-    if (not do_build) and
-       FileExists(LibName) then
-     begin
-       if GetNamedFileTime(LibName)>GetNamedFileTime(DllName) then
-        begin
-          do_makedef:=true;
-          exit;
-        end;
-     end;
-    asw_name:=FindUtil('asw');
-    arw_name:=FindUtil('arw');
-    if cs_link_extern in aktglobalswitches then
-     begin
-       CmdLine:='-l '+LibName+' -i '+DLLName;
-       if asw_name<>'' then
-        CmdLine:=CmdLine+' -a '+asw_name;
-       if arw_name<>'' then
-        CmdLine:=CmdLine+' -r '+arw_name;
-       do_makedef:=DoExec(FindUtil('fpimpdef'),CmdLine,false,false);
-     end
-    else
-     do_makedef:=makedef(DLLName,LIbName);
-  end;
-
-Var
-  linkres  : TLinkRes;
-  i        : longint;
-  HPath    : TStringListItem;
-  s,s2     : string;
-  found,
-  linklibc : boolean;
-begin
-  WriteResponseFile:=False;
-
-  { Create static import libraries for DLL that are
-    included using the $linklib directive }
-  While not SharedLibFiles.Empty do
-   begin
-     s:=SharedLibFiles.GetFirst;
-     s2:=AddExtension(s,target_os.sharedlibext);
-     s:=target_os.libprefix+SplitName(s)+target_os.staticlibext;
-     if Do_makedef(FindDLL(s2),s) then
-      begin
-        if s<>''then
-         StaticLibFiles.insert(s);
-      end
-     else
-      begin
-        Message(exec_w_error_while_linking);
-        aktglobalswitches:=aktglobalswitches+[cs_link_extern];
-      end;
-   end;
-
-  { Open link.res file }
-  LinkRes.Init(outputexedir+Info.ResName);
-
-  { Write path to search libraries }
-  HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
-  while assigned(HPath) do
-   begin
-     LinkRes.Add('SEARCH_DIR('+GetShortName(HPath.Str)+')');
-     HPath:=TStringListItem(HPath.Next);
-   end;
-  HPath:=TStringListItem(LibrarySearchPath.First);
-  while assigned(HPath) do
-   begin
-     LinkRes.Add('SEARCH_DIR('+GetShortName(HPath.Str)+')');
-     HPath:=TStringListItem(HPath.Next);
-   end;
-
-  { add objectfiles, start with prt0 always }
-  LinkRes.Add('INPUT(');
-  if isdll then
-   LinkRes.AddFileName(GetShortName(FindObjectFile('wdllprt0','')))
-  else
-   LinkRes.AddFileName(GetShortName(FindObjectFile('wprt0','')));
-  while not ObjectFiles.Empty do
-   begin
-     s:=ObjectFiles.GetFirst;
-     if s<>'' then
-      LinkRes.AddFileName(GetShortName(s));
-   end;
-  LinkRes.Add(')');
-
-  { Write staticlibraries }
-  if not StaticLibFiles.Empty then
-   begin
-     LinkRes.Add('GROUP(');
-     While not StaticLibFiles.Empty do
-      begin
-        S:=StaticLibFiles.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) }
-  if not SharedLibFiles.Empty then
-   begin
-     linklibc:=false;
-     LinkRes.Add('INPUT(');
-     While not SharedLibFiles.Empty do
-      begin
-        S:=SharedLibFiles.GetFirst;
-        if pos('.',s)=0 then
-          { we never directly link a DLL
-            its allways through an import library PM }
-          { libraries created by C compilers have .a extensions }
-          s2:=s+'.a'{ target_os.sharedlibext }
-        else
-          s2:=s;
-        s2:=FindLibraryFile(s2,'',found);
-        if found then
-          begin
-            LinkRes.Add(s2);
-            continue;
-          end;
-        if pos(target_os.libprefix,s)=1 then
-          s:=copy(s,length(target_os.libprefix)+1,255);
-        if s<>'c' then
-         begin
-           i:=Pos(target_os.sharedlibext,S);
-           if i>0 then
-            Delete(S,i,255);
-           LinkRes.Add('-l'+s);
-         end
-        else
-         begin
-           LinkRes.Add('-l'+s);
-           linklibc:=true;
-         end;
-      end;
-     { be sure that libc is the last lib }
-     if linklibc then
-      LinkRes.Add('-lc');
-     LinkRes.Add(')');
-   end;
-{ Write and Close response }
-  linkres.writetodisk;
-  linkres.done;
-
-  WriteResponseFile:=True;
-end;
-
-
-function TLinkerWin32.MakeExecutable:boolean;
-var
-  binstr,
-  cmdstr  : string;
-  success : boolean;
-  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:='';
-  FindExe('asw',AsBinStr);
-  if RelocSection then
-   { Using short form to avoid problems with 128 char limitation under Dos. }
-   RelocStr:='-b 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(false);
-
-{ Call linker }
-  success:=false;
-  for i:=1 to 3 do
-   begin
-     SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
-     if binstr<>'' then
-      begin
-        Replace(cmdstr,'$EXE',current_module.exefilename^);
-        Replace(cmdstr,'$OPT',Info.ExtraOptions);
-        Replace(cmdstr,'$RES',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 {and UseDefFileForExport} then
-          begin
-            DefFile.WriteFile;
-            Replace(cmdstr,'$DEF','-d '+deffile.fname);
-          end
-        else
-          Replace(cmdstr,'$DEF','');
-        success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
-        if not success then
-         break;
-      end;
-   end;
-
-{ Post process }
-  if success then
-   success:=PostProcessExecutable(current_module.exefilename^,false);
-
-{ Remove ReponseFile }
-  if (success) and not(cs_link_extern in aktglobalswitches) then
-   begin
-     RemoveFile(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,
-  cmdstr  : string;
-  success : boolean;
-  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:='';
-  FindExe('asw',AsBinStr);
-  if RelocSection then
-   { Using short form to avoid problems with 128 char limitation under Dos. }
-   RelocStr:='-b 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;
-  for i:=1 to 3 do
-   begin
-     SplitBinCmd(Info.DllCmd[i],binstr,cmdstr);
-     if binstr<>'' then
-      begin
-        Replace(cmdstr,'$EXE',current_module.sharedlibfilename^);
-        Replace(cmdstr,'$OPT',Info.ExtraOptions);
-        Replace(cmdstr,'$RES',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 {and UseDefFileForExport} then
-          begin
-            DefFile.WriteFile;
-            Replace(cmdstr,'$DEF','-d '+deffile.fname);
-          end
-        else
-          Replace(cmdstr,'$DEF','');
-        success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
-        if not success then
-         break;
-      end;
-   end;
-
-{ Post process }
-  if success then
-   success:=PostProcessExecutable(current_module.sharedlibfilename^,true);
-
-{ Remove ReponseFile }
-  if (success) and not(cs_link_extern in aktglobalswitches) then
-   begin
-     RemoveFile(outputexedir+Info.ResName);
-     RemoveFile('base.$$$');
-     RemoveFile('exp.$$$');
-   end;
-  MakeSharedLibrary:=success;   { otherwise a recursive call to link method }
-end;
-
-
-function tlinkerwin32.postprocessexecutable(const fn : string;isdll:boolean):boolean;
-type
-  tdosheader = packed record
-     e_magic : word;
-     e_cblp : word;
-     e_cp : word;
-     e_crlc : word;
-     e_cparhdr : word;
-     e_minalloc : word;
-     e_maxalloc : word;
-     e_ss : word;
-     e_sp : word;
-     e_csum : word;
-     e_ip : word;
-     e_cs : word;
-     e_lfarlc : word;
-     e_ovno : word;
-     e_res : array[0..3] of word;
-     e_oemid : word;
-     e_oeminfo : word;
-     e_res2 : array[0..9] of word;
-     e_lfanew : longint;
-  end;
-  tpeheader = packed record
-     PEMagic : array[0..3] of char;
-     Machine : word;
-     NumberOfSections : word;
-     TimeDateStamp : longint;
-     PointerToSymbolTable : longint;
-     NumberOfSymbols : longint;
-     SizeOfOptionalHeader : word;
-     Characteristics : word;
-     Magic : word;
-     MajorLinkerVersion : byte;
-     MinorLinkerVersion : byte;
-     SizeOfCode : longint;
-     SizeOfInitializedData : longint;
-     SizeOfUninitializedData : longint;
-     AddressOfEntryPoint : longint;
-     BaseOfCode : longint;
-     BaseOfData : longint;
-     ImageBase : longint;
-     SectionAlignment : longint;
-     FileAlignment : longint;
-     MajorOperatingSystemVersion : word;
-     MinorOperatingSystemVersion : word;
-     MajorImageVersion : word;
-     MinorImageVersion : word;
-     MajorSubsystemVersion : word;
-     MinorSubsystemVersion : word;
-     Reserved1 : longint;
-     SizeOfImage : longint;
-     SizeOfHeaders : longint;
-     CheckSum : longint;
-     Subsystem : word;
-     DllCharacteristics : word;
-     SizeOfStackReserve : longint;
-     SizeOfStackCommit : longint;
-     SizeOfHeapReserve : longint;
-     SizeOfHeapCommit : longint;
-     LoaderFlags : longint;
-     NumberOfRvaAndSizes : longint;
-     DataDirectory : array[1..$80] of byte;
-  end;
-  tcoffsechdr=packed record
-    name     : array[0..7] of char;
-    vsize    : longint;
-    rvaofs   : longint;
-    datalen  : longint;
-    datapos  : longint;
-    relocpos : longint;
-    lineno1  : longint;
-    nrelocs  : word;
-    lineno2  : word;
-    flags    : longint;
-  end;
-  psecfill=^tsecfill;
-  tsecfill=record
-    fillpos,
-    fillsize : longint;
-    next : psecfill;
-  end;
-var
-  f : file;
-  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_gui :
-         cmdstr:='--subsystem gui';
-       app_cui :
-         cmdstr:='--subsystem console';
-     end;
-     if dllversion<>'' then
-       cmdstr:=cmdstr+' --version '+dllversion;
-     cmdstr:=cmdstr+' --input '+fn;
-     cmdstr:=cmdstr+' --stack '+tostr(stacksize);
-     DoExec(FindUtil('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 }
-  case apptype of
-    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;
-
-end.
-{
-  $Log$
-  Revision 1.10  2001-02-20 21:41:16  peter
-    * new fixfilename, findfile for unix. Look first for lowercase, then
-      NormalCase and last for UPPERCASE names.
-
-  Revision 1.9  2001/01/13 00:09:22  peter
-    * made Pavel O. happy ;)
-
-  Revision 1.8  2000/12/30 22:53:25  peter
-    * export with the case provided in the exports section
-
-  Revision 1.7  2000/12/25 00:07:30  peter
-    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
-      tlinkedlist objects)
-
-  Revision 1.6  2000/11/12 22:20:37  peter
-    * create generic toutputsection for binary writers
-
-  Revision 1.5  2000/09/24 15:06:31  peter
-    * use defines.inc
-
-  Revision 1.4  2000/08/27 16:11:54  peter
-    * moved some util functions from globals,cobjects to cutils
-    * splitted files into finput,fmodule
-
-  Revision 1.3  2000/07/21 15:14:02  jonas
-    + added is_addr field for labels, if they are only used for getting the address
-       (e.g. for io checks) and corresponding getaddrlabel() procedure
-
-  Revision 1.2  2000/07/13 11:32:50  michael
-  + removed logs
-
-}

compiler/types.pas

@@ -237,7 +237,7 @@ interface
 implementation
 
     uses
-       globtype,globals,tokens,verbose,
+       globtype,globals,systems,tokens,verbose,
        symconst,symtable,nld;
 
     var
@@ -744,9 +744,9 @@ implementation
              formaldef :
                push_addr_param:=true;
              recorddef :
-               push_addr_param:=(def^.size>4);
+               push_addr_param:=(def^.size>target_os.size_of_pointer);
              arraydef :
-               push_addr_param:=((Parraydef(def)^.highrange>=Parraydef(def)^.lowrange) and (def^.size>4)) or
+               push_addr_param:=((Parraydef(def)^.highrange>=Parraydef(def)^.lowrange) and (def^.size>target_os.size_of_pointer)) or
                                 is_open_array(def) or
                                 is_array_of_const(def) or
                                 is_array_constructor(def);
@@ -1741,7 +1741,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.33  2001-02-26 12:47:46  jonas
+  Revision 1.34  2001-02-26 19:44:55  peter
+    * merged generic m68k updates from fixes branch
+
+  Revision 1.33  2001/02/26 12:47:46  jonas
     * fixed bug in type checking for compatibility of set elements (merged)
     * released fix in options.pas from Carl also for FPC (merged)