* system unit rename for 1.1 branch

rtl/freebsd/Makefile

@@ -122,13 +122,16 @@ PROCINC=$(RTL)/$(CPU_TARGET)
 UNIXINC=$(RTL)/unix
 UNITPREFIX=rtl
 
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=sysbsd
+endif
+
 # Paths
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 
-# Define Go32v2 Units
-SYSTEMUNIT=sysbsd
-
 # Use new graph unit ?
 # NEWGRAPH=YES
 # Use LibGGI ?
@@ -232,8 +235,6 @@ INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall
 # Post Settings
 #####################################################################
 
-SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
-
 # Get the system independent include file names.
 # This will set the following variables :
 # SYSINCNAMES
@@ -1289,22 +1290,22 @@ cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
 # System Units (System, Objpas, Strings)
 #
 
-$(SYSTEMPPU) : sysbsd.pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
-	$(COMPILER) -Us -Sg sysbsd.pp $(REDIR)
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
+	$(COMPILER) -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMPPU)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
 		   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
-		   $(SYSTEMPPU)
+		   $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # System Dependent Units
 #
 
 linux$(PPUEXT) : $(UNIXINC)/linux.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
-		 syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMPPU) \
+		 syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \
 		 $(UNIXINC)/linsysca.inc
 
 
@@ -1313,13 +1314,13 @@ linux$(PPUEXT) : $(UNIXINC)/linux.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/
 #
 
 dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-	       linux$(PPUEXT) $(SYSTEMPPU)
+	       linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-crt$(PPUEXT) : $(UNIXINC)/crt.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
+crt$(PPUEXT) : $(UNIXINC)/crt.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp $(UNIXINC)/objinc.inc $(SYSTEMPPU)
+objects$(PPUEXT) : $(INC)/objects.pp $(UNIXINC)/objinc.inc $(SYSTEMUNIT)$(PPUEXT)
 
-printer$(PPUEXT) : $(UNIXINC)/printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
+printer$(PPUEXT) : $(UNIXINC)/printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Graph
@@ -1346,24 +1347,24 @@ gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
 # Other system-independent RTL Units
 #
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
 
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMPPU)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Other system-dependent RTL Units
 #
 
 sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
-		   linux$(PPUEXT) $(SYSTEMPPU)
+		   linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMPPU)
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-ipc$(PPUEXT) : $(UNIXINC)/ipc.pp linux$(PPUEXT) $(SYSTEMPPU)
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

rtl/freebsd/Makefile.fpc

@@ -45,13 +45,16 @@ PROCINC=$(RTL)/$(CPU_TARGET)
 UNIXINC=$(RTL)/unix
 UNITPREFIX=rtl
 
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=sysbsd
+endif
+
 # Paths
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 
-# Define Go32v2 Units
-SYSTEMUNIT=sysbsd
-
 # Use new graph unit ?
 # NEWGRAPH=YES
 # Use LibGGI ?
@@ -63,8 +66,6 @@ endif
 
 
 [postsettings]
-SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
-
 # Get the system independent include file names.
 # This will set the following variables :
 # SYSINCNAMES
@@ -101,22 +102,22 @@ cprt0$(OEXT) : $(CPU_TARGET)/cprt0.as
 # System Units (System, Objpas, Strings)
 #
 
-$(SYSTEMPPU) : sysbsd.pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
-        $(COMPILER) -Us -Sg sysbsd.pp $(REDIR)
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
+        $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMPPU)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
                    $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
-                   $(SYSTEMPPU)
+                   $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # System Dependent Units
 #
 
 linux$(PPUEXT) : $(UNIXINC)/linux.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
-                 syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMPPU) \
+                 syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \
                  $(UNIXINC)/linsysca.inc
 
 
@@ -125,13 +126,13 @@ linux$(PPUEXT) : $(UNIXINC)/linux.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/
 #
 
 dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-               linux$(PPUEXT) $(SYSTEMPPU)
+               linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-crt$(PPUEXT) : $(UNIXINC)/crt.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
+crt$(PPUEXT) : $(UNIXINC)/crt.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp $(UNIXINC)/objinc.inc $(SYSTEMPPU)
+objects$(PPUEXT) : $(INC)/objects.pp $(UNIXINC)/objinc.inc $(SYSTEMUNIT)$(PPUEXT)
 
-printer$(PPUEXT) : $(UNIXINC)/printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
+printer$(PPUEXT) : $(UNIXINC)/printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Graph
@@ -158,24 +159,24 @@ gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
 # Other system-independent RTL Units
 #
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
 
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMPPU)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Other system-dependent RTL Units
 #
 
 sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
-                   linux$(PPUEXT) $(SYSTEMPPU)
+                   linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMPPU)
+errors$(PPUEXT) : $(UNIXINC)/errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-ipc$(PPUEXT) : $(UNIXINC)/ipc.pp linux$(PPUEXT) $(SYSTEMPPU)
+ipc$(PPUEXT) : $(UNIXINC)/ipc.pp linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

rtl/freebsd/sysbsd.pp

@@ -1,137 +1 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time librar~y.
-    Copyright (c) 2000 by Marco van de Voort
-    member of the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{ These things are set in the makefile, }
-{ But you can override them here.}
-
-{ If you use an aout system, set the conditional AOUT}
-{ $Define AOUT}
-
-Unit SysBSD;
-Interface
-
-{$I sysunixh.inc}
-
-Implementation
-
-{$I sysunix.inc}
-
-{
-  $Log$
-  Revision 1.2  2000-09-18 13:42:35  marco
-   * FreeBSD support into 1.1
-
-  Revision 1.1.2.1  2000/09/16 11:19:08  marco
-   * Moved files from BSD to FreeBSD directory, with some small changes
-
-  Revision 1.1.2.4  2000/09/16 11:10:43  marco
-   * Introduced using sysunix and sysunixh
-
-  Revision 1.1.2.3  2000/09/10 16:12:40  marco
-  The rearrangement to linux for
-
-  Revision 1.1.2.2  2000/08/05 18:33:29  peter
-    * paramstr(0) fix for linux 2.0 kernels
-
-  Revision 1.1.2.1  2000/07/14 07:33:15  michael
-  + Fixed do_open call. Directory checking must not be performed
-
-  Revision 1.1  2000/07/13 06:30:54  michael
-  + Initial import
-
-  Revision 1.49  2000/07/08 18:02:39  peter
-    * do_open checks for directory, if directory then ioerror 2
-
-  Revision 1.48  2000/06/30 22:14:03  peter
-    * removed obsolete crtlib code
-    * support EINTR for read/write to restart the syscall
-
-  Revision 1.47  2000/05/11 17:55:13  peter
-    * changed order of fpustate checking to first check the more
-      specific states
-
-  Revision 1.46  2000/05/08 14:27:36  peter
-    * released newsignal
-    * newsignal gives now better backtraces using the sigcontext eip/ebp
-      fields
-
-  Revision 1.45  2000/04/16 16:07:58  marco
-   * BSD fixes
-
-  Revision 1.44  2000/04/14 13:04:53  marco
-   * Merged bsd/syslinux.pp and 1.43 linux/syslinux.pp to this file with ifdefs
-
-  Revision 1.43  2000/04/07 14:56:36  peter
-    * switch to direct asm if not correctfldcw defined
-
-  Revision 1.42  2000/03/31 23:26:32  pierre
-   * FPU needs reset for all SIGFPE even from integer division by zero
-
-  Revision 1.41  2000/03/31 23:21:19  pierre
-    * multiple exception handling works
-      (for linux only if syslinux is compiled with -dnewsignal)
-
-  Revision 1.40  2000/03/31 13:24:28  jonas
-    * signal handling using sigaction when compiled with -dnewsignal
-      (allows multiple signals to be received in one run)
-
-  Revision 1.39  2000/03/25 12:28:37  peter
-    * patch for getdir from Pierre
-
-  Revision 1.38  2000/03/23 15:24:18  peter
-    * remove handle check for do_close
-
-  Revision 1.37  2000/02/09 16:59:32  peter
-    * truncated log
-
-  Revision 1.36  2000/02/09 12:17:51  peter
-    * moved halt to system.inc
-    * syslinux doesn't use direct asm anymore
-
-  Revision 1.35  2000/02/08 11:47:09  peter
-    * paramstr(0) support
-
-  Revision 1.34  2000/01/20 23:38:02  peter
-    * support fm_inout as stdoutput for assign(f,'');rewrite(f,1); becuase
-      rewrite opens always with filemode 2
-
-  Revision 1.33  2000/01/16 22:25:38  peter
-    * check handle for file closing
-
-  Revision 1.32  2000/01/07 16:41:41  daniel
-    * copyright 2000
-
-  Revision 1.31  2000/01/07 16:32:28  daniel
-    * copyright 2000 added
-
-  Revision 1.30  1999/12/01 22:57:31  peter
-    * cmdline support
-
-  Revision 1.29  1999/11/06 14:39:12  peter
-    * truncated log
-
-  Revision 1.28  1999/10/28 09:50:06  peter
-    * use mmap instead of brk
-
-  Revision 1.27  1999/09/10 15:40:35  peter
-    * fixed do_open flags to be > $100, becuase filemode can be upto 255
-
-  Revision 1.26  1999/09/08 16:14:43  peter
-    * pointer fixes
-
-  Revision 1.25  1999/07/28 23:18:36  peter
-    * closedir fixes, which now disposes the pdir itself
-
-}
+{$i system}

rtl/freebsd/system.pp

@@ -0,0 +1,140 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time librar~y.
+    Copyright (c) 2000 by Marco van de Voort
+    member of the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+{ These things are set in the makefile, }
+{ But you can override them here.}
+
+{ If you use an aout system, set the conditional AOUT}
+{ $Define AOUT}
+
+Unit {$ifdef VER1_0}SysBSD{$else}System{$endif};
+Interface
+
+{$I sysunixh.inc}
+
+Implementation
+
+{$I sysunix.inc}
+
+{
+  $Log$
+  Revision 1.1  2000-10-15 08:19:48  peter
+    * system unit rename for 1.1 branch
+
+  Revision 1.2  2000/09/18 13:42:35  marco
+   * FreeBSD support into 1.1
+
+  Revision 1.1.2.1  2000/09/16 11:19:08  marco
+   * Moved files from BSD to FreeBSD directory, with some small changes
+
+  Revision 1.1.2.4  2000/09/16 11:10:43  marco
+   * Introduced using sysunix and sysunixh
+
+  Revision 1.1.2.3  2000/09/10 16:12:40  marco
+  The rearrangement to linux for
+
+  Revision 1.1.2.2  2000/08/05 18:33:29  peter
+    * paramstr(0) fix for linux 2.0 kernels
+
+  Revision 1.1.2.1  2000/07/14 07:33:15  michael
+  + Fixed do_open call. Directory checking must not be performed
+
+  Revision 1.1  2000/07/13 06:30:54  michael
+  + Initial import
+
+  Revision 1.49  2000/07/08 18:02:39  peter
+    * do_open checks for directory, if directory then ioerror 2
+
+  Revision 1.48  2000/06/30 22:14:03  peter
+    * removed obsolete crtlib code
+    * support EINTR for read/write to restart the syscall
+
+  Revision 1.47  2000/05/11 17:55:13  peter
+    * changed order of fpustate checking to first check the more
+      specific states
+
+  Revision 1.46  2000/05/08 14:27:36  peter
+    * released newsignal
+    * newsignal gives now better backtraces using the sigcontext eip/ebp
+      fields
+
+  Revision 1.45  2000/04/16 16:07:58  marco
+   * BSD fixes
+
+  Revision 1.44  2000/04/14 13:04:53  marco
+   * Merged bsd/syslinux.pp and 1.43 linux/syslinux.pp to this file with ifdefs
+
+  Revision 1.43  2000/04/07 14:56:36  peter
+    * switch to direct asm if not correctfldcw defined
+
+  Revision 1.42  2000/03/31 23:26:32  pierre
+   * FPU needs reset for all SIGFPE even from integer division by zero
+
+  Revision 1.41  2000/03/31 23:21:19  pierre
+    * multiple exception handling works
+      (for linux only if syslinux is compiled with -dnewsignal)
+
+  Revision 1.40  2000/03/31 13:24:28  jonas
+    * signal handling using sigaction when compiled with -dnewsignal
+      (allows multiple signals to be received in one run)
+
+  Revision 1.39  2000/03/25 12:28:37  peter
+    * patch for getdir from Pierre
+
+  Revision 1.38  2000/03/23 15:24:18  peter
+    * remove handle check for do_close
+
+  Revision 1.37  2000/02/09 16:59:32  peter
+    * truncated log
+
+  Revision 1.36  2000/02/09 12:17:51  peter
+    * moved halt to system.inc
+    * syslinux doesn't use direct asm anymore
+
+  Revision 1.35  2000/02/08 11:47:09  peter
+    * paramstr(0) support
+
+  Revision 1.34  2000/01/20 23:38:02  peter
+    * support fm_inout as stdoutput for assign(f,'');rewrite(f,1); becuase
+      rewrite opens always with filemode 2
+
+  Revision 1.33  2000/01/16 22:25:38  peter
+    * check handle for file closing
+
+  Revision 1.32  2000/01/07 16:41:41  daniel
+    * copyright 2000
+
+  Revision 1.31  2000/01/07 16:32:28  daniel
+    * copyright 2000 added
+
+  Revision 1.30  1999/12/01 22:57:31  peter
+    * cmdline support
+
+  Revision 1.29  1999/11/06 14:39:12  peter
+    * truncated log
+
+  Revision 1.28  1999/10/28 09:50:06  peter
+    * use mmap instead of brk
+
+  Revision 1.27  1999/09/10 15:40:35  peter
+    * fixed do_open flags to be > $100, becuase filemode can be upto 255
+
+  Revision 1.26  1999/09/08 16:14:43  peter
+    * pointer fixes
+
+  Revision 1.25  1999/07/28 23:18:36  peter
+    * closedir fixes, which now disposes the pdir itself
+
+}

rtl/go32v1/Makefile.fpc

@@ -75,34 +75,34 @@ prt0$(OEXT) : prt0.as
 # Base Units (System, strings, os-dependent-base-unit)
 #
 
-$(SYSTEMPPU) : system.pp $(SYSDEPS)
+system$(PPUEXT) : system.pp $(SYSDEPS)
         $(COMPILER) -Us -Sg system.pp $(REDIR)
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMPPU)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
                    $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
-                   $(SYSTEMPPU)
+                   system$(PPUEXT)
 
 #
 # System Dependent Units
 #
 
-go32$(PPUEXT) : go32.pp objpas$(PPUEXT) $(SYSTEMPPU)
+go32$(PPUEXT) : go32.pp objpas$(PPUEXT) system$(PPUEXT)
 
 #
 # TP7 Compatible RTL Units
 #
 
 dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
-               go32$(PPUEXT) strings$(PPUEXT) $(SYSTEMPPU)
+               go32$(PPUEXT) strings$(PPUEXT) system$(PPUEXT)
 
-crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) system$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
+objects$(PPUEXT) : $(INC)/objects.pp objinc.inc system$(PPUEXT)
 
-printer$(PPUEXT) : printer.pp $(SYSTEMPPU)
+printer$(PPUEXT) : printer.pp system$(PPUEXT)
 
 #
 # Delphi Compatible Units
@@ -122,17 +122,17 @@ math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
 # Other system-independent RTL Units
 #
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
 
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
 
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
 
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
 
 #
 # Other system-dependent RTL Units
 #
 
-msmouse$(PPUEXT) : msmouse.pp $(SYSTEMPPU)
+msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT)

rtl/go32v2/Makefile

@@ -126,9 +126,6 @@ UNITPREFIX=rtl
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 
-# Define Go32v2 Units
-SYSTEMUNIT=system
-
 # Insert exception handler in system unit
 ifdef EXCEPTIONS_IN_SYSTEM
 override FPCOPT+=-dEXCEPTIONS_IN_SYSTEM
@@ -195,7 +192,7 @@ endif
 # Targets
 
 override LOADEROBJECTS+=prt0 exceptn fpu
-override UNITOBJECTS+=$(SYSTEMUNIT) objpas strings go32 dpmiexcp initc ports profile dxeload emu387 dos crt objects printer graph sysutils math typinfo cpu mmx getopts heaptrc lineinfo msmouse charset varutils
+override UNITOBJECTS+=system objpas strings go32 dpmiexcp initc ports profile dxeload emu387 dos crt objects printer graph sysutils math typinfo cpu mmx getopts heaptrc lineinfo msmouse charset varutils
 override RSTOBJECTS+=math varutils
 
 # Clean
@@ -230,8 +227,6 @@ INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall
 # Post Settings
 #####################################################################
 
-SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
-
 # Get the system independent include file names.
 # This will set the following variables :
 # SYSINCNAMES
@@ -1281,48 +1276,48 @@ prt0$(OEXT) : v2prt0.as
 # System Units (System, Objpas, Strings)
 #
 
-$(SYSTEMPPU) : system.pp $(SYSDEPS)
+system$(PPUEXT) : system.pp $(SYSDEPS)
 	$(COMPILER) -Us -Sg system.pp $(REDIR)
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMPPU)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
 	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
 		   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
-		   $(SYSTEMPPU)
+		   system$(PPUEXT)
 
 #
 # System Dependent Units
 #
 
-go32$(PPUEXT) : go32.pp $(SYSTEMPPU)
+go32$(PPUEXT) : go32.pp system$(PPUEXT)
 
-dpmiexcp$(PPUEXT) : dpmiexcp.pp exceptn$(OEXT) $(SYSTEMPPU)
+dpmiexcp$(PPUEXT) : dpmiexcp.pp exceptn$(OEXT) system$(PPUEXT)
 	$(COMPILER) -Sg dpmiexcp.pp $(REDIR)
 
-initc$(PPUEXT) : initc.pp $(SYSTEMPPU)
+initc$(PPUEXT) : initc.pp system$(PPUEXT)
 
 profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) go32$(PPUEXT)
 
-dxeload$(PPUEXT) : dxeload.pp $(SYSTEMPPU)
+dxeload$(PPUEXT) : dxeload.pp system$(PPUEXT)
 
 emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \
 		  dpmiexcp$(PPUEXT)
 
-ports$(PPUEXT) : ports.pp objpas$(PPUEXT) $(SYSTEMPPU)
+ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT)
 
 #
 # TP7 Compatible RTL Units
 #
 
 dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
-	       go32$(PPUEXT) strings$(PPUEXT) $(SYSTEMPPU)
+	       go32$(PPUEXT) strings$(PPUEXT) system$(PPUEXT)
 
-crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) system$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
+objects$(PPUEXT) : $(INC)/objects.pp objinc.inc system$(PPUEXT)
 
-printer$(PPUEXT) : printer.pp $(SYSTEMPPU)
+printer$(PPUEXT) : printer.pp system$(PPUEXT)
 
 #
 # Graph
@@ -1331,7 +1326,7 @@ printer$(PPUEXT) : printer.pp $(SYSTEMPPU)
 include $(GRAPHDIR)/makefile.inc
 GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
 
-graph$(PPUEXT) : graph.pp go32$(PPUEXT) ports$(PPUEXT) $(SYSTEMPPU) \
+graph$(PPUEXT) : graph.pp go32$(PPUEXT) ports$(PPUEXT) system$(PPUEXT) \
 		 $(GRAPHINCDEPS) vesa.inc vesah.inc dpmi.inc
 	$(COMPILER) -I$(GRAPHDIR) graph.pp $(REDIR)
 
@@ -1357,21 +1352,21 @@ varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
 # Other system-independent RTL Units
 #
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
 
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
 
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
 
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMPPU)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
 
-charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMPPU)
+charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
 
 #
 # Other system-dependent RTL Units
 #
 
-msmouse$(PPUEXT) : msmouse.pp $(SYSTEMPPU)
+msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT)

rtl/go32v2/Makefile.fpc

@@ -4,7 +4,7 @@
 
 [targets]
 loaders=prt0 exceptn fpu
-units=$(SYSTEMUNIT) objpas strings \
+units=system objpas strings \
       go32 dpmiexcp initc ports profile dxeload emu387 \
       dos crt objects printer graph \
       sysutils math typinfo \
@@ -39,9 +39,6 @@ UNITPREFIX=rtl
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 
-# Define Go32v2 Units
-SYSTEMUNIT=system
-
 # Insert exception handler in system unit
 ifdef EXCEPTIONS_IN_SYSTEM
 override FPCOPT+=-dEXCEPTIONS_IN_SYSTEM
@@ -53,8 +50,6 @@ override FPCOPT+=-dNO_EXCEPTIONS_IN_SYSTEM
 endif
 
 [postsettings]
-SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
-
 # Get the system independent include file names.
 # This will set the following variables :
 # SYSINCNAMES
@@ -85,48 +80,48 @@ prt0$(OEXT) : v2prt0.as
 # System Units (System, Objpas, Strings)
 #
 
-$(SYSTEMPPU) : system.pp $(SYSDEPS)
+system$(PPUEXT) : system.pp $(SYSDEPS)
         $(COMPILER) -Us -Sg system.pp $(REDIR)
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMPPU)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
                    $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
-                   $(SYSTEMPPU)
+                   system$(PPUEXT)
 
 #
 # System Dependent Units
 #
 
-go32$(PPUEXT) : go32.pp $(SYSTEMPPU)
+go32$(PPUEXT) : go32.pp system$(PPUEXT)
 
-dpmiexcp$(PPUEXT) : dpmiexcp.pp exceptn$(OEXT) $(SYSTEMPPU)
+dpmiexcp$(PPUEXT) : dpmiexcp.pp exceptn$(OEXT) system$(PPUEXT)
         $(COMPILER) -Sg dpmiexcp.pp $(REDIR)
 
-initc$(PPUEXT) : initc.pp $(SYSTEMPPU)
+initc$(PPUEXT) : initc.pp system$(PPUEXT)
 
 profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) go32$(PPUEXT)
 
-dxeload$(PPUEXT) : dxeload.pp $(SYSTEMPPU)
+dxeload$(PPUEXT) : dxeload.pp system$(PPUEXT)
 
 emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \
                   dpmiexcp$(PPUEXT)
 
-ports$(PPUEXT) : ports.pp objpas$(PPUEXT) $(SYSTEMPPU)
+ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT)
 
 #
 # TP7 Compatible RTL Units
 #
 
 dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
-               go32$(PPUEXT) strings$(PPUEXT) $(SYSTEMPPU)
+               go32$(PPUEXT) strings$(PPUEXT) system$(PPUEXT)
 
-crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) $(SYSTEMPPU)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) system$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
+objects$(PPUEXT) : $(INC)/objects.pp objinc.inc system$(PPUEXT)
 
-printer$(PPUEXT) : printer.pp $(SYSTEMPPU)
+printer$(PPUEXT) : printer.pp system$(PPUEXT)
 
 #
 # Graph
@@ -135,7 +130,7 @@ printer$(PPUEXT) : printer.pp $(SYSTEMPPU)
 include $(GRAPHDIR)/makefile.inc
 GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
 
-graph$(PPUEXT) : graph.pp go32$(PPUEXT) ports$(PPUEXT) $(SYSTEMPPU) \
+graph$(PPUEXT) : graph.pp go32$(PPUEXT) ports$(PPUEXT) system$(PPUEXT) \
                  $(GRAPHINCDEPS) vesa.inc vesah.inc dpmi.inc
         $(COMPILER) -I$(GRAPHDIR) graph.pp $(REDIR)
 
@@ -161,21 +156,21 @@ varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
 # Other system-independent RTL Units
 #
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
 
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
 
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
 
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMPPU)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
 
-charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMPPU)
+charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
 
 #
 # Other system-dependent RTL Units
 #
 
-msmouse$(PPUEXT) : msmouse.pp $(SYSTEMPPU)
+msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT)

rtl/linux/Makefile

@@ -123,13 +123,16 @@ UNIXINC=$(RTL)/unix
 
 UNITPREFIX=rtl
 
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=syslinux
+endif
+
 # Paths
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 
-# Define Go32v2 Units
-SYSTEMUNIT=syslinux
-
 # Use new graph unit ?
 # NEWGRAPH=YES
 # Use LibGGI ?
@@ -233,9 +236,7 @@ INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall
 # Post Settings
 #####################################################################
 
-SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
-
-# Get the system independent include file names.
+# Get the $(SYSTEMUNIT) independent include file names.
 # This will set the following variables :
 # SYSINCNAMES
 include $(INC)/makefile.inc
@@ -247,7 +248,7 @@ SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
 include $(PROCINC)/makefile.cpu
 SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 
-# Put system unit dependencies together.
+# Put $(SYSTEMUNIT) unit dependencies together.
 SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
 
 #####################################################################
@@ -1295,25 +1296,25 @@ gprt21$(OEXT) : $(CPU_TARGET)/gprt0.as
 
 
 #
-# System Units (System, Objpas, Strings)
+# $(SYSTEMUNIT) Units ($(SYSTEMUNIT), Objpas, Strings)
 #
 
-$(SYSTEMPPU) : syslinux.pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
-	$(COMPILER) -Us -Sg syslinux.pp $(REDIR)
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
+	$(COMPILER) -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMPPU)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
 		   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
-		   $(SYSTEMPPU)
+		   $(SYSTEMUNIT)$(PPUEXT)
 
 #
-# System Dependent Units
+# $(SYSTEMUNIT) Dependent Units
 #
 
 linux$(PPUEXT) : linux.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
-		 syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMPPU) \
+		 syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \
 		 $(UNIXINC)/linsysca.inc
 
 ports$(PPUEXT) : ports.pp linux$(PPUEXT) objpas$(PPUEXT)
@@ -1328,13 +1329,13 @@ dynlibs$(PPUEXT) : $(INC)/dynlibs.pp $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(
 #
 
 dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-	       linux$(PPUEXT) $(SYSTEMPPU)
+	       linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-crt$(PPUEXT) : crt.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp $(UNIXINC)/objinc.inc $(SYSTEMPPU)
+objects$(PPUEXT) : $(INC)/objects.pp $(UNIXINC)/objinc.inc $(SYSTEMUNIT)$(PPUEXT)
 
-printer$(PPUEXT) : printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
+printer$(PPUEXT) : printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Graph
@@ -1342,11 +1343,11 @@ printer$(PPUEXT) : printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
 include $(GRAPHDIR)/makefile.inc
 GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
 
-graph$(PPUEXT) : graph.pp linux$(PPUEXT) $(SYSTEMPPU) \
+graph$(PPUEXT) : graph.pp linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
 		 $(GRAPHINCDEPS) $(UNIXINC)/graph16.inc
 	$(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/graph.pp $(REDIR)
 
-ggigraph$(PPUEXT) : $(UNIXINC)/ggigraph.pp linux$(PPUEXT) $(SYSTEMPPU) \
+ggigraph$(PPUEXT) : $(UNIXINC)/ggigraph.pp linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
 		 $(GRAPHINCDEPS)
 	$(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/ggigraph.pp $(REDIR)
 
@@ -1372,27 +1373,27 @@ varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
 	$(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp $(REDIR)
 
 #
-# Other system-independent RTL Units
+# Other $(SYSTEMUNIT)-independent RTL Units
 #
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
 
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMPPU)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
 
 #
-# Other system-dependent RTL Units
+# Other $(SYSTEMUNIT)-dependent RTL Units
 #
 
 sockets$(PPUEXT) : sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
-		   linux$(PPUEXT) $(SYSTEMPPU)
+		   linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMPPU)
+errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-ipc$(PPUEXT) : ipc.pp linux$(PPUEXT) $(SYSTEMPPU)
+ipc$(PPUEXT) : ipc.pp linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

rtl/linux/Makefile.fpc

@@ -45,13 +45,16 @@ UNIXINC=$(RTL)/unix
 
 UNITPREFIX=rtl
 
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=syslinux
+endif
+
 # Paths
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 
-# Define Go32v2 Units
-SYSTEMUNIT=syslinux
-
 # Use new graph unit ?
 # NEWGRAPH=YES
 # Use LibGGI ?
@@ -62,9 +65,7 @@ USELIBGGI=NO
 endif
 
 [postsettings]
-SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
-
-# Get the system independent include file names.
+# Get the $(SYSTEMUNIT) independent include file names.
 # This will set the following variables :
 # SYSINCNAMES
 include $(INC)/makefile.inc
@@ -76,7 +77,7 @@ SYSINCDEPS=$(addprefix $(INC)/,$(SYSINCNAMES))
 include $(PROCINC)/makefile.cpu
 SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 
-# Put system unit dependencies together.
+# Put $(SYSTEMUNIT) unit dependencies together.
 SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
 
 
@@ -105,25 +106,25 @@ gprt21$(OEXT) : $(CPU_TARGET)/gprt0.as
 
 
 #
-# System Units (System, Objpas, Strings)
+# $(SYSTEMUNIT) Units ($(SYSTEMUNIT), Objpas, Strings)
 #
 
-$(SYSTEMPPU) : syslinux.pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
-        $(COMPILER) -Us -Sg syslinux.pp $(REDIR)
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp sysconst.inc systypes.inc syscalls.inc $(SYSDEPS)
+        $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMPPU)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
                    $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
-                   $(SYSTEMPPU)
+                   $(SYSTEMUNIT)$(PPUEXT)
 
 #
-# System Dependent Units
+# $(SYSTEMUNIT) Dependent Units
 #
 
 linux$(PPUEXT) : linux.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
-                 syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMPPU) \
+                 syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \
                  $(UNIXINC)/linsysca.inc
 
 ports$(PPUEXT) : ports.pp linux$(PPUEXT) objpas$(PPUEXT)
@@ -138,13 +139,13 @@ dynlibs$(PPUEXT) : $(INC)/dynlibs.pp $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(
 #
 
 dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-               linux$(PPUEXT) $(SYSTEMPPU)
+               linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-crt$(PPUEXT) : crt.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp $(UNIXINC)/objinc.inc $(SYSTEMPPU)
+objects$(PPUEXT) : $(INC)/objects.pp $(UNIXINC)/objinc.inc $(SYSTEMUNIT)$(PPUEXT)
 
-printer$(PPUEXT) : printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
+printer$(PPUEXT) : printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Graph
@@ -152,11 +153,11 @@ printer$(PPUEXT) : printer.pp $(INC)/textrec.inc linux$(PPUEXT) $(SYSTEMPPU)
 include $(GRAPHDIR)/makefile.inc
 GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
 
-graph$(PPUEXT) : graph.pp linux$(PPUEXT) $(SYSTEMPPU) \
+graph$(PPUEXT) : graph.pp linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
                  $(GRAPHINCDEPS) $(UNIXINC)/graph16.inc
         $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/graph.pp $(REDIR)
 
-ggigraph$(PPUEXT) : $(UNIXINC)/ggigraph.pp linux$(PPUEXT) $(SYSTEMPPU) \
+ggigraph$(PPUEXT) : $(UNIXINC)/ggigraph.pp linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
                  $(GRAPHINCDEPS)
         $(COMPILER) -I$(GRAPHDIR) $(UNIXINC)/ggigraph.pp $(REDIR)
 
@@ -182,27 +183,27 @@ varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
         $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp $(REDIR)
 
 #
-# Other system-independent RTL Units
+# Other $(SYSTEMUNIT)-independent RTL Units
 #
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
 
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMPPU)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
 
 #
-# Other system-dependent RTL Units
+# Other $(SYSTEMUNIT)-dependent RTL Units
 #
 
 sockets$(PPUEXT) : sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
-                   linux$(PPUEXT) $(SYSTEMPPU)
+                   linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMPPU)
+errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-ipc$(PPUEXT) : ipc.pp linux$(PPUEXT) $(SYSTEMPPU)
+ipc$(PPUEXT) : ipc.pp linux$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

rtl/linux/syslinux.pp

@@ -1,51 +1 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Michael Van Canneyt,
-    member of the Free Pascal development team.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{ These things are set in the makefile, }
-{ But you can override them here.}
-
-{ If you use an aout system, set the conditional AOUT}
-{ $Define AOUT}
-
-Unit SysLinux;
-Interface
-
-{$I sysunixh.inc}
-
-Implementation
-
-{$I sysunix.inc}
-
-{
-  $Log$
-  Revision 1.7  2000-09-18 13:14:50  marco
-   * Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
-
-  Revision 1.6  2000/09/11 13:48:08  marco
-   * FreeBSD support and removal of old sighandler
-
-  Revision 1.5  2000/08/13 08:43:45  peter
-    * don't check for directory in do_open (merged)
-
-  Revision 1.4  2000/08/05 18:33:51  peter
-    * paramstr(0) fix for linux 2.0 kernels (merged)
-
-  Revision 1.3  2000/07/14 10:33:10  michael
-  + Conditionals fixed
-
-  Revision 1.2  2000/07/13 11:33:49  michael
-  + removed logs
-
-}
+{$i system.pp}

rtl/linux/system.pp

@@ -0,0 +1,54 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Michael Van Canneyt,
+    member of the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+
+{ These things are set in the makefile, }
+{ But you can override them here.}
+
+{ If you use an aout system, set the conditional AOUT}
+{ $Define AOUT}
+
+Unit {$ifdef VER1_0}Syslinux{$else}System{$endif};
+Interface
+
+{$I sysunixh.inc}
+
+Implementation
+
+{$I sysunix.inc}
+
+{
+  $Log$
+  Revision 1.1  2000-10-15 08:19:49  peter
+    * system unit rename for 1.1 branch
+
+  Revision 1.7  2000/09/18 13:14:50  marco
+   * Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
+
+  Revision 1.6  2000/09/11 13:48:08  marco
+   * FreeBSD support and removal of old sighandler
+
+  Revision 1.5  2000/08/13 08:43:45  peter
+    * don't check for directory in do_open (merged)
+
+  Revision 1.4  2000/08/05 18:33:51  peter
+    * paramstr(0) fix for linux 2.0 kernels (merged)
+
+  Revision 1.3  2000/07/14 10:33:10  michael
+  + Conditionals fixed
+
+  Revision 1.2  2000/07/13 11:33:49  michael
+  + removed logs
+
+}

rtl/os2/Makefile

@@ -122,12 +122,15 @@ PROCINC=$(RTL)/$(CPU_TARGET)
 
 UNITPREFIX=rtl
 
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=syslinux
+endif
+
 # Paths
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
-
-# Define Go32v2 Units
-SYSTEMUNIT=sysos2
 #####################################################################
 # FPCDIR Setting
 #####################################################################
@@ -220,8 +223,6 @@ INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall
 # Post Settings
 #####################################################################
 
-SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
-
 # Get the system independent include file names.
 # This will set the following variables :
 # SYSINCNAMES
@@ -1273,54 +1274,54 @@ vpath %.pp $(INC) $(PROCINC)
 # Base Units (System, strings, os-dependent-base-unit)
 #
 
-$(SYSTEMPPU) : sysos2.pas $(SYSDEPS)
-	$(COMPILER) -Us -Sg sysos2.pas $(REDIR)
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pas $(SYSDEPS)
+	$(COMPILER) -Us -Sg $(SYSTEMUNIT).pas $(REDIR)
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMPPU)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
 		   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
-		   $(SYSTEMPPU)
+		   $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # System Dependent Units
 #
 
-ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMPPU)
+ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) objects$(PPUEXT) $(SYSTEMPPU)
+doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) objects$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-kbdcalls$(PPUEXT) : kbdcalls.pas $(SYSTEMPPU)
+kbdcalls$(PPUEXT) : kbdcalls.pas $(SYSTEMUNIT)$(PPUEXT)
 
-moucalls$(PPUEXT) : moucalls.pas $(SYSTEMPPU)
+moucalls$(PPUEXT) : moucalls.pas $(SYSTEMUNIT)$(PPUEXT)
 
-moncalls$(PPUEXT) : moncalls.pas strings$(PPUEXT) $(SYSTEMPPU)
+moncalls$(PPUEXT) : moncalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-os2def$(PPUEXT) : os2def.pas $(SYSTEMPPU)
+os2def$(PPUEXT) : os2def.pas $(SYSTEMUNIT)$(PPUEXT)
 
-pmwin$(PPUEXT) : pmwin.pas os2def$(PPUEXT) $(SYSTEMPPU)
+pmwin$(PPUEXT) : pmwin.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-pmbitmap$(PPUEXT) : pmbitmap.pas $(SYSTEMPPU)
+pmbitmap$(PPUEXT) : pmbitmap.pas $(SYSTEMUNIT)$(PPUEXT)
 
-pmgpi$(PPUEXT) : pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMPPU)
+pmgpi$(PPUEXT) : pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-dive$(PPUEXT) : dive.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMPPU)
+dive$(PPUEXT) : dive.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-dynlibs$(PPUEXT) : $(INC)/dynlibs.pp doscalls$(PPUEXT) $(SYSTEMPPU)
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # TP7 Compatible RTL Units
 #
 
 dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-	       doscalls$(PPUEXT) $(SYSTEMPPU)
+	       doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMPPU)
+crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
+objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMUNIT)$(PPUEXT)
 
-printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMPPU)
+printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
 
 #graph$(PPUEXT) : graph.pp
 
@@ -1346,18 +1347,18 @@ varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
 # Other system-independent RTL Units
 #
 
-ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMPPU)
+ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
 
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMPPU)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Other system-dependent RTL Units

rtl/os2/Makefile.fpc

@@ -35,17 +35,17 @@ PROCINC=$(RTL)/$(CPU_TARGET)
 
 UNITPREFIX=rtl
 
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=syslinux
+endif
+
 # Paths
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 
-# Define Go32v2 Units
-SYSTEMUNIT=sysos2
-
-
 [postsettings]
-SYSTEMPPU=$(addsuffix $(PPUEXT),$(SYSTEMUNIT))
-
 # Get the system independent include file names.
 # This will set the following variables :
 # SYSINCNAMES
@@ -78,54 +78,54 @@ vpath %.pp $(INC) $(PROCINC)
 # Base Units (System, strings, os-dependent-base-unit)
 #
 
-$(SYSTEMPPU) : sysos2.pas $(SYSDEPS)
-        $(COMPILER) -Us -Sg sysos2.pas $(REDIR)
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pas $(SYSDEPS)
+        $(COMPILER) -Us -Sg $(SYSTEMUNIT).pas $(REDIR)
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMPPU)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
                    $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
-                   $(SYSTEMPPU)
+                   $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # System Dependent Units
 #
 
-ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMPPU)
+ports$(PPUEXT) : ports.pas objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) objects$(PPUEXT) $(SYSTEMPPU)
+doscalls$(PPUEXT) : doscalls.pas strings$(PPUEXT) objects$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-kbdcalls$(PPUEXT) : kbdcalls.pas $(SYSTEMPPU)
+kbdcalls$(PPUEXT) : kbdcalls.pas $(SYSTEMUNIT)$(PPUEXT)
 
-moucalls$(PPUEXT) : moucalls.pas $(SYSTEMPPU)
+moucalls$(PPUEXT) : moucalls.pas $(SYSTEMUNIT)$(PPUEXT)
 
-moncalls$(PPUEXT) : moncalls.pas strings$(PPUEXT) $(SYSTEMPPU)
+moncalls$(PPUEXT) : moncalls.pas strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-os2def$(PPUEXT) : os2def.pas $(SYSTEMPPU)
+os2def$(PPUEXT) : os2def.pas $(SYSTEMUNIT)$(PPUEXT)
 
-pmwin$(PPUEXT) : pmwin.pas os2def$(PPUEXT) $(SYSTEMPPU)
+pmwin$(PPUEXT) : pmwin.pas os2def$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-pmbitmap$(PPUEXT) : pmbitmap.pas $(SYSTEMPPU)
+pmbitmap$(PPUEXT) : pmbitmap.pas $(SYSTEMUNIT)$(PPUEXT)
 
-pmgpi$(PPUEXT) : pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMPPU)
+pmgpi$(PPUEXT) : pmgpi.pas pmbitmap$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-dive$(PPUEXT) : dive.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMPPU)
+dive$(PPUEXT) : dive.pas os2def$(PPUEXT) pmwin$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-dynlibs$(PPUEXT) : $(INC)/dynlibs.pp doscalls$(PPUEXT) $(SYSTEMPPU)
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pp doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # TP7 Compatible RTL Units
 #
 
 dos$(PPUEXT) : dos.pas $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-               doscalls$(PPUEXT) $(SYSTEMPPU)
+               doscalls$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMPPU)
+crt$(PPUEXT) : crt.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
+objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMUNIT)$(PPUEXT)
 
-printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMPPU)
+printer$(PPUEXT) : printer.pas $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT)
 
 #graph$(PPUEXT) : graph.pp
 
@@ -151,18 +151,18 @@ varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
 # Other system-independent RTL Units
 #
 
-ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMPPU)
+ucomplex$(PPUEXT): $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
 
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMPPU)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Other system-dependent RTL Units

rtl/os2/sysos2.pas

@@ -1,820 +1 @@
-{****************************************************************************
-
-                     Free Pascal -- OS/2 runtime library
-
-                  Copyright (c) 1999-2000 by Florian Klaempfl
-                   Copyright (c) 1999-2000 by Daniel Mantione
-
- Free Pascal is distributed under the GNU Public License v2. So is this unit.
- The GNU Public License requires you to distribute the source code of this
- unit with any product that uses it. We grant you an exception to this, and
- that is, when you compile a program with the Free Pascal Compiler, you do not
- need to ship source code with that program, AS LONG AS YOU ARE USING
- UNMODIFIED CODE! If you modify this code, you MUST change the next line:
-
- <This an official, unmodified Free Pascal source code file.>
-
- Send us your modified files, we can work together if you want!
-
- Free Pascal 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
- Library GNU General Public License for more details.
-
- You should have received a copy of the Library GNU General Public License
- along with Free Pascal; see the file COPYING.LIB.  If not, write to
- the Free Software Foundation, 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA.
-
-****************************************************************************}
-
-unit sysos2;
-
-{Changelog:
-
-    People:
-
-        DM - Daniel Mantione
-
-    Date:           Description of change:              Changed by:
-
-     -              First released version 0.1.         DM
-
-Coding style:
-
-    My coding style is a bit unusual for Pascal. Nevertheless I friendly ask
-    you to try to make your changes not look all to different. In general,
-    set your IDE to use tab characters, optimal fill on and a tabsize of 4.}
-
-interface
-
-{Link the startup code.}
-{$l prt1.oo2}
-
-{$I SYSTEMH.INC}
-{$I heaph.inc}
-
-type    Tos=(osDOS,osOS2,osDPMI);
-
-var     os_mode:Tos;
-        first_meg:pointer;
-
-type    Psysthreadib=^Tsysthreadib;
-        Pthreadinfoblock=^Tthreadinfoblock;
-        Pprocessinfoblock=^Tprocessinfoblock;
-
-        Tbytearray=array[0..$ffff] of byte;
-        Pbytearray=^Tbytearray;
-
-        Tsysthreadib=record
-            tid,
-            priority,
-            version:longint;
-            MCcount,
-            MCforceflag:word;
-        end;
-
-        Tthreadinfoblock=record
-            pexchain,
-            stack,
-            stacklimit:pointer;
-            tib2:Psysthreadib;
-            version,
-            ordinal:longint;
-        end;
-
-        Tprocessinfoblock=record
-            pid,
-            parentpid,
-            hmte:longint;
-            cmd,
-            env:Pbytearray;
-            flstatus,
-            ttype:longint;
-        end;
-
-const   UnusedHandle=$ffff;
-        StdInputHandle=0;
-        StdOutputHandle=1;
-        StdErrorHandle=2;
-
-        FileNameCaseSensitive : boolean = false;
-
-var
-{ C-compatible arguments and environment }
-  argc  : longint;external name '_argc';
-  argv  : ppchar;external name '_argv';
-  envp  : ppchar;external name '_environ';
-
-
-implementation
-
-{$I SYSTEM.INC}
-
-procedure DosGetInfoBlocks (var Atib: PThreadInfoBlock;
-                            var Apib: PProcessInfoBlock); cdecl;
-                            external 'DOSCALLS' index 312;
-
-function DosSetRelMaxFH (var ReqCount, CurMaxFH: longint): longint; cdecl;
-external 'DOSCALLS' index 382;
-
-{This is the correct way to call external assembler procedures.}
-procedure syscall; external name '___SYSCALL';
-
-{***************************************************************************
-
-                Runtime error checking related routines.
-
-***************************************************************************}
-
-{$S-}
-procedure st1(stack_size:longint);[public,alias: 'STACKCHECK'];
-
-begin
-    { called when trying to get local stack }
-    { if the compiler directive $S is set   }
-    {$ASMMODE DIRECT}
-    asm
-        movl stack_size,%ebx
-        movl %esp,%eax
-        subl %ebx,%eax
-{$ifdef SYSTEMDEBUG}
-        movl U_SYSOS2_LOWESTSTACK,%ebx
-        cmpl %eax,%ebx
-        jb   Lis_not_lowest
-        movl %eax,U_SYSOS2_LOWESTSTACK
-    Lis_not_lowest:
-{$endif SYSTEMDEBUG}
-        cmpb $2,U_SYSOS2_OS_MODE
-        jne Lrunning_in_dos
-        movl U_SYSOS2_STACKBOTTOM,%ebx
-        jmp Lrunning_in_os2
-    Lrunning_in_dos:
-        movl __heap_brk,%ebx
-    Lrunning_in_os2:
-        cmpl %eax,%ebx
-        jae  Lshort_on_stack
-        leave
-        ret  $4
-    Lshort_on_stack:
-    end ['EAX','EBX'];
-    {$ASMMODE ATT}
-    { this needs a local variable }
-    { so the function called itself !! }
-    { Writeln('low in stack ');}
-    HandleError(202);
-end;
-{no stack check in system }
-
-{****************************************************************************
-
-                    Miscellaneous related routines.
-
-****************************************************************************}
-
-{$asmmode intel}
-procedure system_exit; assembler;
-asm
-    mov  ah, 04ch
-    mov  al, byte ptr exitcode
-    call syscall
-end;
-
-{$asmmode att}
-
-{$asmmode direct}
-function paramcount:longint;assembler;
-
-asm
-    movl _argc,%eax
-    decl %eax
-end ['EAX'];
-
-function paramstr(l:longint):string;
-
-    function args:pointer;assembler;
-
-    asm
-        movl _argv,%eax
-    end ['EAX'];
-
-var p:^Pchar;
-
-begin
-     if (l>=0) and (l<=paramcount) then
-        begin
-            p:=args;
-            paramstr:=strpas(p[l]);
-        end
-     else paramstr:='';
-end;
-
-{$asmmode att}
-
-procedure randomize;
-
-var hl:longint;
-
-begin
-    asm
-        movb $0x2c,%ah
-        call syscall
-        movw %cx,-4(%ebp)
-        movw %dx,-2(%ebp)
-    end;
-    randseed:=hl;
-end;
-
-{****************************************************************************
-
-                    Heap management releated routines.
-
-****************************************************************************}
-
-
-{ this function allows to extend the heap by calling
-syscall $7f00 resizes the brk area}
-
-function sbrk(size:longint):longint; assembler;
-asm
-    movl size,%edx
-    movw $0x7f00,%ax
-    call syscall
-end;
-
-{$ASMMODE direct}
-function getheapstart:pointer;assembler;
-
-asm
-    movl __heap_base,%eax
-end ['EAX'];
-
-function getheapsize:longint;assembler;
-asm
-    movl    HEAPSIZE,%eax
-end ['EAX'];
-{$ASMMODE ATT}
-
-{$i heap.inc}
-
-{****************************************************************************
-
-                          Low Level File Routines
-
-****************************************************************************}
-
-procedure allowslash(p:Pchar);
-
-{Allow slash as backslash.}
-
-var i:longint;
-
-begin
-    for i:=0 to strlen(p) do
-        if p[i]='/' then p[i]:='\';
-end;
-
-procedure do_close(h:longint);
-
-begin
-{ Only three standard handles under real OS/2 }
-  if (h > 4) or
-     (os_MODE = osOS2) and (h > 2) then
-   begin
-     asm
-        movb $0x3e,%ah
-        movl h,%ebx
-        call syscall
-     end;
-   end;
-end;
-
-procedure do_erase(p:Pchar);
-
-begin
-    allowslash(p);
-    asm
-        movl P,%edx
-        movb $0x41,%ah
-        call syscall
-        jnc .LERASE1
-        movw %ax,inoutres;
-    .LERASE1:
-    end;
-end;
-
-procedure do_rename(p1,p2:Pchar);
-
-begin
-    allowslash(p1);
-    allowslash(p2);
-    asm
-        movl P1, %edx
-        movl P2, %edi
-        movb $0x56,%ah
-        call syscall
-        jnc .LRENAME1
-        movw %ax,inoutres;
-    .LRENAME1:
-    end;
-end;
-
-function do_read(h,addr,len:longint):longint; assembler;
-asm
-    movl len,%ecx
-    movl addr,%edx
-    movl h,%ebx
-    movb $0x3f,%ah
-    call syscall
-    jnc .LDOSREAD1
-    movw %ax,inoutres;
-    xorl %eax,%eax
-.LDOSREAD1:
-end;
-
-function do_write(h,addr,len:longint) : longint; assembler;
-asm
-    movl len,%ecx
-    movl addr,%edx
-    movl h,%ebx
-    movb $0x40,%ah
-    call syscall
-    jnc .LDOSWRITE1
-    movw %ax,inoutres;
-.LDOSWRITE1:
-end;
-
-function do_filepos(handle:longint): longint; assembler;
-asm
-    movw $0x4201,%ax
-    movl handle,%ebx
-    xorl %edx,%edx
-    call syscall
-    jnc .LDOSFILEPOS
-    movw %ax,inoutres;
-    xorl %eax,%eax
-.LDOSFILEPOS:
-end;
-
-procedure do_seek(handle,pos:longint); assembler;
-asm
-    movw $0x4200,%ax
-    movl handle,%ebx
-    movl pos,%edx
-    call syscall
-    jnc .LDOSSEEK1
-    movw %ax,inoutres;
-.LDOSSEEK1:
-end;
-
-function do_seekend(handle:longint):longint; assembler;
-asm
-    movw $0x4202,%ax
-    movl handle,%ebx
-    xorl %edx,%edx
-    call syscall
-    jnc .Lset_at_end1
-    movw %ax,inoutres;
-    xorl %eax,%eax
-.Lset_at_end1:
-end;
-
-function do_filesize(handle:longint):longint;
-
-var aktfilepos:longint;
-
-begin
-    aktfilepos:=do_filepos(handle);
-    do_filesize:=do_seekend(handle);
-    do_seek(handle,aktfilepos);
-end;
-
-procedure do_truncate(handle,pos:longint); assembler;
-asm
-(* DOS function 40h isn't safe for this according to EMX documentation
-        movl $0x4200,%eax
-        movl 8(%ebp),%ebx
-        movl 12(%ebp),%edx
-        call syscall
-        jc .LTruncate1
-        movl 8(%ebp),%ebx
-        movl 12(%ebp),%edx
-        movl %ebp,%edx
-        xorl %ecx,%ecx
-        movb $0x40,%ah
-        call syscall
-*)
-    movl $0x7F25,%eax
-    movl Handle,%ebx
-    movl Pos,%edx
-    call syscall
-    inc %eax
-    movl %ecx, %eax
-    jnz .LTruncate1
-(* File position is undefined after truncation, move to the end. *)
-    movl $0x4202,%eax
-    movl Handle,%ebx
-    movl $0,%edx
-    call syscall
-    jnc .LTruncate2
-.LTruncate1:
-    movw %ax,inoutres;
-.LTruncate2:
-end;
-
-const
-    FileHandleCount: longint = 20;
-
-function Increase_File_Handle_Count: boolean;
-var Err: word;
-    L1, L2: longint;
-begin
-    if os_mode = osOS2 then
-        begin
-            L1 := 10;
-            if DosSetRelMaxFH (L1, L2) <> 0 then
-                Increase_File_Handle_Count := false
-            else
-                if L2 > FileHandleCount then
-                    begin
-                        FileHandleCount := L2;
-                        Increase_File_Handle_Count := true;
-                    end
-                else
-                    Increase_File_Handle_Count := false;
-        end
-    else
-        begin
-            Inc (FileHandleCount, 10);
-            Err := 0;
-            asm
-                movl $0x6700, %eax
-                movl FileHandleCount, %ebx
-                call syscall
-                jnc .LIncFHandles
-                movw %ax, Err
-.LIncFHandles:
-            end;
-            if Err <> 0 then
-                begin
-                    Increase_File_Handle_Count := false;
-                    Dec (FileHandleCount, 10);
-                end
-            else
-                Increase_File_Handle_Count := true;
-        end;
-end;
-
-procedure do_open(var f;p:pchar;flags:longint);
-
-{
-  filerec and textrec have both handle and mode as the first items so
-  they could use the same routine for opening/creating.
-  when (flags and $100)   the file will be append
-  when (flags and $1000)  the file will be truncate/rewritten
-  when (flags and $10000) there is no check for close (needed for textfiles)
-}
-
-var Action: longint;
-
-begin
-    allowslash(p);
-    { close first if opened }
-    if ((flags and $10000)=0) then
-        begin
-            case filerec(f).mode of
-                fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
-                fmclosed:;
-            else
-                begin
-                    inoutres:=102; {not assigned}
-                    exit;
-                end;
-            end;
-       end;
-    { reset file handle }
-    filerec(f).handle := UnusedHandle;
-    Action := 0;
-    { convert filemode to filerec modes }
-    case (flags and 3) of
-        0 : filerec(f).mode:=fminput;
-        1 : filerec(f).mode:=fmoutput;
-        2 : filerec(f).mode:=fminout;
-    end;
-    if (flags and $1000)<>0 then
-        Action := $50000; (* Create / replace *)
-    { empty name is special }
-    if p[0]=#0 then
-        begin
-          case FileRec(f).mode of
-            fminput :
-              FileRec(f).Handle:=StdInputHandle;
-            fminout, { this is set by rewrite }
-            fmoutput :
-              FileRec(f).Handle:=StdOutputHandle;
-            fmappend :
-              begin
-                FileRec(f).Handle:=StdOutputHandle;
-                FileRec(f).mode:=fmoutput; {fool fmappend}
-              end;
-            end;
-            exit;
-        end;
-    Action := Action or (Flags and $FF);
-(* DenyAll if sharing not specified. *)
-    if Flags and 112 = 0 then
-        Action := Action or 16;
-    asm
-        movl $0x7f2b, %eax
-        movl Action, %ecx
-        movl p, %edx
-        call syscall
-        cmpl $0xffffffff, %eax
-        jnz .LOPEN1
-        movw %cx, InOutRes
-        movw UnusedHandle, %ax
-.LOPEN1:
-        movl f,%edx
-        movw %ax,(%edx)
-    end;
-    if (InOutRes = 4) and Increase_File_Handle_Count then
-(* Trying again after increasing amount of file handles *)
-        asm
-            movl $0x7f2b, %eax
-            movl Action, %ecx
-            movl p, %edx
-            call syscall
-            cmpl $0xffffffff, %eax
-            jnz .LOPEN2
-            movw %cx, InOutRes
-            movw UnusedHandle, %ax
-.LOPEN2:
-            movl f,%edx
-            movw %ax,(%edx)
-        end;
-      { for systems that have more handles }
-    if FileRec (F).Handle > FileHandleCount then
-        FileHandleCount := FileRec (F).Handle;
-    if (flags and $100)<>0 then
-        begin
-            do_seekend(filerec(f).handle);
-            FileRec (F).Mode := fmOutput; {fool fmappend}
-        end;
-end;
-
-{$ASMMODE INTEL}
-function do_isdevice (Handle: longint): boolean; assembler;
-(*
-var HT, Attr: longint;
-begin
-    if os_mode = osOS2 then
-        begin
-            if DosQueryHType (Handle, HT, Attr) <> 0 then HT := 1;
-        end
-    else
-*)
-asm
-    mov ebx, Handle
-    mov eax, 4400h
-    call syscall
-    mov eax, 1
-    jc @IsDevEnd
-    test edx, 80h
-    jnz @IsDevEnd
-    dec eax
-@IsDevEnd:
-end;
-{$ASMMODE ATT}
-
-
-{*****************************************************************************
-                           UnTyped File Handling
-*****************************************************************************}
-
-{$i file.inc}
-
-{*****************************************************************************
-                           Typed File Handling
-*****************************************************************************}
-
-{$i typefile.inc}
-
-{*****************************************************************************
-                           Text File Handling
-*****************************************************************************}
-
-{$DEFINE EOF_CTRLZ}
-
-{$i text.inc}
-
-{****************************************************************************
-
-                          Directory related routines.
-
-****************************************************************************}
-
-{*****************************************************************************
-                           Directory Handling
-*****************************************************************************}
-
-procedure dosdir(func:byte;const s:string);
-
-var buffer:array[0..255] of char;
-
-begin
-    move(s[1],buffer,length(s));
-    buffer[length(s)]:=#0;
-    allowslash(Pchar(@buffer));
-    asm
-        leal buffer,%edx
-        movb func,%ah
-        call syscall
-        jnc  .LDOS_DIRS1
-        movw %ax,inoutres;
-    .LDOS_DIRS1:
-    end;
-end;
-
-
-procedure mkdir(const s : string);
-
-begin
-    DosDir($39,s);
-end;
-
-
-procedure rmdir(const s : string);
-
-begin
-    DosDir($3a,s);
-end;
-
-procedure chdir(const s : string);
-
-begin
-    DosDir($3b,s);
-end;
-
-procedure getdir(drivenr : byte;var dir : shortstring);
-
-{Written by Michael Van Canneyt.}
-
-var temp:array[0..255] of char;
-    sof:Pchar;
-    i:byte;
-
-begin
-    sof:=pchar(@dir[4]);
-    { dir[1..3] will contain '[drivenr]:\', but is not }
-    { supplied by DOS, so we let dos string start at   }
-    { dir[4]                                           }
-    { Get dir from drivenr : 0=default, 1=A etc... }
-    asm
-        movb drivenr,%dl
-        movl sof,%esi
-        mov  $0x47,%ah
-        call syscall
-    end;
-    { Now Dir should be filled with directory in ASCIIZ, }
-    { starting from dir[4]                               }
-    dir[0]:=#3;
-    dir[2]:=':';
-    dir[3]:='\';
-    i:=4;
-    {Conversion to Pascal string }
-    while (dir[i]<>#0) do
-        begin
-            { convert path name to DOS }
-            if dir[i]='/' then
-            dir[i]:='\';
-            dir[0]:=char(i);
-            inc(i);
-        end;
-    { upcase the string (FPC function) }
-    if not (FileNameCaseSensitive) then dir:=upcase(dir);
-    if drivenr<>0 then   { Drive was supplied. We know it }
-        dir[1]:=char(65+drivenr-1)
-    else
-        begin
-            { We need to get the current drive from DOS function 19H  }
-            { because the drive was the default, which can be unknown }
-            asm
-                movb $0x19,%ah
-                call syscall
-                addb $65,%al
-                movb %al,i
-            end;
-            dir[1]:=char(i);
-        end;
-end;
-
-
-
-{****************************************************************************
-
-                        System unit initialization.
-
-****************************************************************************}
-
-function GetFileHandleCount: longint;
-var L1, L2: longint;
-begin
-    L1 := 0; (* Don't change the amount, just check. *)
-    if DosSetRelMaxFH (L1, L2) <> 0 then GetFileHandleCount := 50
-                                                 else GetFileHandleCount := L2;
-end;
-
-var pib:Pprocessinfoblock;
-    tib:Pthreadinfoblock;
-
-begin
-    {Determine the operating system we are running on.}
-    asm
-        movl $0,os_mode
-        movw $0x7f0a,%ax
-        call syscall
-        testw $512,%bx         {Bit 9 is OS/2 flag.}
-        setnzb os_mode
-        testw $4096,%bx
-        jz .LnoRSX
-        movl $2,os_mode
-    .LnoRSX:
-    end;
-
-    {$ASMMODE DIRECT}
-    {Enable the brk area by initializing it with the initial heap size.}
-    asm
-        movw $0x7f01,%ax
-        movl HEAPSIZE,%edx
-        addl __heap_base,%edx
-        call ___SYSCALL
-        cmpl $-1,%eax
-        jnz Lheapok
-        pushl $204
-        {call RUNERROR$$WORD}
-    Lheapok:
-    end;
-    {$ASMMODE ATT}
-
-    {Now request, if we are running under DOS,
-     read-access to the first meg. of memory.}
-    if os_mode in [osDOS,osDPMI] then
-        asm
-            movw $0x7f13,%ax
-            xorl %ebx,%ebx
-            movl $0xfff,%ecx
-            xorl %edx,%edx
-            call syscall
-            movl %eax,first_meg
-        end
-    else
-        begin
-            first_meg := nil;
-    (* Initialize the amount of file handles *)
-            FileHandleCount := GetFileHandleCount;
-        end;
-    {At 0.9.2, case for enumeration does not work.}
-    case os_mode of
-        osDOS:
-            stackbottom:=0;     {In DOS mode, heap_brk is also the
-                                 stack bottom.}
-        osOS2:
-            begin
-                dosgetinfoblocks(tib,pib);
-                stackbottom:=longint(tib^.stack);
-            end;
-        osDPMI:
-            stackbottom:=0;     {Not sure how to get it, but seems to be
-                                 always zero.}
-    end;
-    exitproc:=nil;
-
-    {Initialize the heap.}
-    initheap;
-
-    { ... and exceptions }
-    InitExceptions;
-
-    { to test stack depth }
-    loweststack:=maxlongint;
-
-    OpenStdIO(Input,fmInput,StdInputHandle);
-    OpenStdIO(Output,fmOutput,StdOutputHandle);
-    OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-    OpenStdIO(StdErr,fmOutput,StdErrorHandle);
-
-    { no I/O-Error }
-    inoutres:=0;
-end.
-{
-  $Log$
-  Revision 1.3  2000-09-29 21:49:41  jonas
-    * removed warnings
-
-  Revision 1.2  2000/07/14 10:33:11  michael
-  + Conditionals fixed
-
-  Revision 1.1  2000/07/13 06:31:07  michael
-  + Initial import
-
-}
+{$i system.pas}

rtl/os2/system.pas

@@ -0,0 +1,825 @@
+{
+ $Id$
+ ****************************************************************************
+
+                     Free Pascal -- OS/2 runtime library
+
+                  Copyright (c) 1999-2000 by Florian Klaempfl
+                   Copyright (c) 1999-2000 by Daniel Mantione
+
+ Free Pascal is distributed under the GNU Public License v2. So is this unit.
+ The GNU Public License requires you to distribute the source code of this
+ unit with any product that uses it. We grant you an exception to this, and
+ that is, when you compile a program with the Free Pascal Compiler, you do not
+ need to ship source code with that program, AS LONG AS YOU ARE USING
+ UNMODIFIED CODE! If you modify this code, you MUST change the next line:
+
+ <This an official, unmodified Free Pascal source code file.>
+
+ Send us your modified files, we can work together if you want!
+
+ Free Pascal 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
+ Library GNU General Public License for more details.
+
+ You should have received a copy of the Library GNU General Public License
+ along with Free Pascal; see the file COPYING.LIB.  If not, write to
+ the Free Software Foundation, 59 Temple Place - Suite 330,
+ Boston, MA 02111-1307, USA.
+
+****************************************************************************}
+
+unit sysos2;
+
+{Changelog:
+
+    People:
+
+        DM - Daniel Mantione
+
+    Date:           Description of change:              Changed by:
+
+     -              First released version 0.1.         DM
+
+Coding style:
+
+    My coding style is a bit unusual for Pascal. Nevertheless I friendly ask
+    you to try to make your changes not look all to different. In general,
+    set your IDE to use tab characters, optimal fill on and a tabsize of 4.}
+
+interface
+
+{Link the startup code.}
+{$l prt1.oo2}
+
+{$I SYSTEMH.INC}
+{$I heaph.inc}
+
+type    Tos=(osDOS,osOS2,osDPMI);
+
+var     os_mode:Tos;
+        first_meg:pointer;
+
+type    Psysthreadib=^Tsysthreadib;
+        Pthreadinfoblock=^Tthreadinfoblock;
+        Pprocessinfoblock=^Tprocessinfoblock;
+
+        Tbytearray=array[0..$ffff] of byte;
+        Pbytearray=^Tbytearray;
+
+        Tsysthreadib=record
+            tid,
+            priority,
+            version:longint;
+            MCcount,
+            MCforceflag:word;
+        end;
+
+        Tthreadinfoblock=record
+            pexchain,
+            stack,
+            stacklimit:pointer;
+            tib2:Psysthreadib;
+            version,
+            ordinal:longint;
+        end;
+
+        Tprocessinfoblock=record
+            pid,
+            parentpid,
+            hmte:longint;
+            cmd,
+            env:Pbytearray;
+            flstatus,
+            ttype:longint;
+        end;
+
+const   UnusedHandle=$ffff;
+        StdInputHandle=0;
+        StdOutputHandle=1;
+        StdErrorHandle=2;
+
+        FileNameCaseSensitive : boolean = false;
+
+var
+{ C-compatible arguments and environment }
+  argc  : longint;external name '_argc';
+  argv  : ppchar;external name '_argv';
+  envp  : ppchar;external name '_environ';
+
+
+implementation
+
+{$I SYSTEM.INC}
+
+procedure DosGetInfoBlocks (var Atib: PThreadInfoBlock;
+                            var Apib: PProcessInfoBlock); cdecl;
+                            external 'DOSCALLS' index 312;
+
+function DosSetRelMaxFH (var ReqCount, CurMaxFH: longint): longint; cdecl;
+external 'DOSCALLS' index 382;
+
+{This is the correct way to call external assembler procedures.}
+procedure syscall; external name '___SYSCALL';
+
+{***************************************************************************
+
+                Runtime error checking related routines.
+
+***************************************************************************}
+
+{$S-}
+procedure st1(stack_size:longint);[public,alias: 'STACKCHECK'];
+
+begin
+    { called when trying to get local stack }
+    { if the compiler directive $S is set   }
+    {$ASMMODE DIRECT}
+    asm
+        movl stack_size,%ebx
+        movl %esp,%eax
+        subl %ebx,%eax
+{$ifdef SYSTEMDEBUG}
+        movl U_SYSOS2_LOWESTSTACK,%ebx
+        cmpl %eax,%ebx
+        jb   Lis_not_lowest
+        movl %eax,U_SYSOS2_LOWESTSTACK
+    Lis_not_lowest:
+{$endif SYSTEMDEBUG}
+        cmpb $2,U_SYSOS2_OS_MODE
+        jne Lrunning_in_dos
+        movl U_SYSOS2_STACKBOTTOM,%ebx
+        jmp Lrunning_in_os2
+    Lrunning_in_dos:
+        movl __heap_brk,%ebx
+    Lrunning_in_os2:
+        cmpl %eax,%ebx
+        jae  Lshort_on_stack
+        leave
+        ret  $4
+    Lshort_on_stack:
+    end ['EAX','EBX'];
+    {$ASMMODE ATT}
+    { this needs a local variable }
+    { so the function called itself !! }
+    { Writeln('low in stack ');}
+    HandleError(202);
+end;
+{no stack check in system }
+
+{****************************************************************************
+
+                    Miscellaneous related routines.
+
+****************************************************************************}
+
+{$asmmode intel}
+procedure system_exit; assembler;
+asm
+    mov  ah, 04ch
+    mov  al, byte ptr exitcode
+    call syscall
+end;
+
+{$asmmode att}
+
+{$asmmode direct}
+function paramcount:longint;assembler;
+
+asm
+    movl _argc,%eax
+    decl %eax
+end ['EAX'];
+
+function paramstr(l:longint):string;
+
+    function args:pointer;assembler;
+
+    asm
+        movl _argv,%eax
+    end ['EAX'];
+
+var p:^Pchar;
+
+begin
+     if (l>=0) and (l<=paramcount) then
+        begin
+            p:=args;
+            paramstr:=strpas(p[l]);
+        end
+     else paramstr:='';
+end;
+
+{$asmmode att}
+
+procedure randomize;
+
+var hl:longint;
+
+begin
+    asm
+        movb $0x2c,%ah
+        call syscall
+        movw %cx,-4(%ebp)
+        movw %dx,-2(%ebp)
+    end;
+    randseed:=hl;
+end;
+
+{****************************************************************************
+
+                    Heap management releated routines.
+
+****************************************************************************}
+
+
+{ this function allows to extend the heap by calling
+syscall $7f00 resizes the brk area}
+
+function sbrk(size:longint):longint; assembler;
+asm
+    movl size,%edx
+    movw $0x7f00,%ax
+    call syscall
+end;
+
+{$ASMMODE direct}
+function getheapstart:pointer;assembler;
+
+asm
+    movl __heap_base,%eax
+end ['EAX'];
+
+function getheapsize:longint;assembler;
+asm
+    movl    HEAPSIZE,%eax
+end ['EAX'];
+{$ASMMODE ATT}
+
+{$i heap.inc}
+
+{****************************************************************************
+
+                          Low Level File Routines
+
+****************************************************************************}
+
+procedure allowslash(p:Pchar);
+
+{Allow slash as backslash.}
+
+var i:longint;
+
+begin
+    for i:=0 to strlen(p) do
+        if p[i]='/' then p[i]:='\';
+end;
+
+procedure do_close(h:longint);
+
+begin
+{ Only three standard handles under real OS/2 }
+  if (h > 4) or
+     (os_MODE = osOS2) and (h > 2) then
+   begin
+     asm
+        movb $0x3e,%ah
+        movl h,%ebx
+        call syscall
+     end;
+   end;
+end;
+
+procedure do_erase(p:Pchar);
+
+begin
+    allowslash(p);
+    asm
+        movl P,%edx
+        movb $0x41,%ah
+        call syscall
+        jnc .LERASE1
+        movw %ax,inoutres;
+    .LERASE1:
+    end;
+end;
+
+procedure do_rename(p1,p2:Pchar);
+
+begin
+    allowslash(p1);
+    allowslash(p2);
+    asm
+        movl P1, %edx
+        movl P2, %edi
+        movb $0x56,%ah
+        call syscall
+        jnc .LRENAME1
+        movw %ax,inoutres;
+    .LRENAME1:
+    end;
+end;
+
+function do_read(h,addr,len:longint):longint; assembler;
+asm
+    movl len,%ecx
+    movl addr,%edx
+    movl h,%ebx
+    movb $0x3f,%ah
+    call syscall
+    jnc .LDOSREAD1
+    movw %ax,inoutres;
+    xorl %eax,%eax
+.LDOSREAD1:
+end;
+
+function do_write(h,addr,len:longint) : longint; assembler;
+asm
+    movl len,%ecx
+    movl addr,%edx
+    movl h,%ebx
+    movb $0x40,%ah
+    call syscall
+    jnc .LDOSWRITE1
+    movw %ax,inoutres;
+.LDOSWRITE1:
+end;
+
+function do_filepos(handle:longint): longint; assembler;
+asm
+    movw $0x4201,%ax
+    movl handle,%ebx
+    xorl %edx,%edx
+    call syscall
+    jnc .LDOSFILEPOS
+    movw %ax,inoutres;
+    xorl %eax,%eax
+.LDOSFILEPOS:
+end;
+
+procedure do_seek(handle,pos:longint); assembler;
+asm
+    movw $0x4200,%ax
+    movl handle,%ebx
+    movl pos,%edx
+    call syscall
+    jnc .LDOSSEEK1
+    movw %ax,inoutres;
+.LDOSSEEK1:
+end;
+
+function do_seekend(handle:longint):longint; assembler;
+asm
+    movw $0x4202,%ax
+    movl handle,%ebx
+    xorl %edx,%edx
+    call syscall
+    jnc .Lset_at_end1
+    movw %ax,inoutres;
+    xorl %eax,%eax
+.Lset_at_end1:
+end;
+
+function do_filesize(handle:longint):longint;
+
+var aktfilepos:longint;
+
+begin
+    aktfilepos:=do_filepos(handle);
+    do_filesize:=do_seekend(handle);
+    do_seek(handle,aktfilepos);
+end;
+
+procedure do_truncate(handle,pos:longint); assembler;
+asm
+(* DOS function 40h isn't safe for this according to EMX documentation
+        movl $0x4200,%eax
+        movl 8(%ebp),%ebx
+        movl 12(%ebp),%edx
+        call syscall
+        jc .LTruncate1
+        movl 8(%ebp),%ebx
+        movl 12(%ebp),%edx
+        movl %ebp,%edx
+        xorl %ecx,%ecx
+        movb $0x40,%ah
+        call syscall
+*)
+    movl $0x7F25,%eax
+    movl Handle,%ebx
+    movl Pos,%edx
+    call syscall
+    inc %eax
+    movl %ecx, %eax
+    jnz .LTruncate1
+(* File position is undefined after truncation, move to the end. *)
+    movl $0x4202,%eax
+    movl Handle,%ebx
+    movl $0,%edx
+    call syscall
+    jnc .LTruncate2
+.LTruncate1:
+    movw %ax,inoutres;
+.LTruncate2:
+end;
+
+const
+    FileHandleCount: longint = 20;
+
+function Increase_File_Handle_Count: boolean;
+var Err: word;
+    L1, L2: longint;
+begin
+    if os_mode = osOS2 then
+        begin
+            L1 := 10;
+            if DosSetRelMaxFH (L1, L2) <> 0 then
+                Increase_File_Handle_Count := false
+            else
+                if L2 > FileHandleCount then
+                    begin
+                        FileHandleCount := L2;
+                        Increase_File_Handle_Count := true;
+                    end
+                else
+                    Increase_File_Handle_Count := false;
+        end
+    else
+        begin
+            Inc (FileHandleCount, 10);
+            Err := 0;
+            asm
+                movl $0x6700, %eax
+                movl FileHandleCount, %ebx
+                call syscall
+                jnc .LIncFHandles
+                movw %ax, Err
+.LIncFHandles:
+            end;
+            if Err <> 0 then
+                begin
+                    Increase_File_Handle_Count := false;
+                    Dec (FileHandleCount, 10);
+                end
+            else
+                Increase_File_Handle_Count := true;
+        end;
+end;
+
+procedure do_open(var f;p:pchar;flags:longint);
+
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+
+var Action: longint;
+
+begin
+    allowslash(p);
+    { close first if opened }
+    if ((flags and $10000)=0) then
+        begin
+            case filerec(f).mode of
+                fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+                fmclosed:;
+            else
+                begin
+                    inoutres:=102; {not assigned}
+                    exit;
+                end;
+            end;
+       end;
+    { reset file handle }
+    filerec(f).handle := UnusedHandle;
+    Action := 0;
+    { convert filemode to filerec modes }
+    case (flags and 3) of
+        0 : filerec(f).mode:=fminput;
+        1 : filerec(f).mode:=fmoutput;
+        2 : filerec(f).mode:=fminout;
+    end;
+    if (flags and $1000)<>0 then
+        Action := $50000; (* Create / replace *)
+    { empty name is special }
+    if p[0]=#0 then
+        begin
+          case FileRec(f).mode of
+            fminput :
+              FileRec(f).Handle:=StdInputHandle;
+            fminout, { this is set by rewrite }
+            fmoutput :
+              FileRec(f).Handle:=StdOutputHandle;
+            fmappend :
+              begin
+                FileRec(f).Handle:=StdOutputHandle;
+                FileRec(f).mode:=fmoutput; {fool fmappend}
+              end;
+            end;
+            exit;
+        end;
+    Action := Action or (Flags and $FF);
+(* DenyAll if sharing not specified. *)
+    if Flags and 112 = 0 then
+        Action := Action or 16;
+    asm
+        movl $0x7f2b, %eax
+        movl Action, %ecx
+        movl p, %edx
+        call syscall
+        cmpl $0xffffffff, %eax
+        jnz .LOPEN1
+        movw %cx, InOutRes
+        movw UnusedHandle, %ax
+.LOPEN1:
+        movl f,%edx
+        movw %ax,(%edx)
+    end;
+    if (InOutRes = 4) and Increase_File_Handle_Count then
+(* Trying again after increasing amount of file handles *)
+        asm
+            movl $0x7f2b, %eax
+            movl Action, %ecx
+            movl p, %edx
+            call syscall
+            cmpl $0xffffffff, %eax
+            jnz .LOPEN2
+            movw %cx, InOutRes
+            movw UnusedHandle, %ax
+.LOPEN2:
+            movl f,%edx
+            movw %ax,(%edx)
+        end;
+      { for systems that have more handles }
+    if FileRec (F).Handle > FileHandleCount then
+        FileHandleCount := FileRec (F).Handle;
+    if (flags and $100)<>0 then
+        begin
+            do_seekend(filerec(f).handle);
+            FileRec (F).Mode := fmOutput; {fool fmappend}
+        end;
+end;
+
+{$ASMMODE INTEL}
+function do_isdevice (Handle: longint): boolean; assembler;
+(*
+var HT, Attr: longint;
+begin
+    if os_mode = osOS2 then
+        begin
+            if DosQueryHType (Handle, HT, Attr) <> 0 then HT := 1;
+        end
+    else
+*)
+asm
+    mov ebx, Handle
+    mov eax, 4400h
+    call syscall
+    mov eax, 1
+    jc @IsDevEnd
+    test edx, 80h
+    jnz @IsDevEnd
+    dec eax
+@IsDevEnd:
+end;
+{$ASMMODE ATT}
+
+
+{*****************************************************************************
+                           UnTyped File Handling
+*****************************************************************************}
+
+{$i file.inc}
+
+{*****************************************************************************
+                           Typed File Handling
+*****************************************************************************}
+
+{$i typefile.inc}
+
+{*****************************************************************************
+                           Text File Handling
+*****************************************************************************}
+
+{$DEFINE EOF_CTRLZ}
+
+{$i text.inc}
+
+{****************************************************************************
+
+                          Directory related routines.
+
+****************************************************************************}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+procedure dosdir(func:byte;const s:string);
+
+var buffer:array[0..255] of char;
+
+begin
+    move(s[1],buffer,length(s));
+    buffer[length(s)]:=#0;
+    allowslash(Pchar(@buffer));
+    asm
+        leal buffer,%edx
+        movb func,%ah
+        call syscall
+        jnc  .LDOS_DIRS1
+        movw %ax,inoutres;
+    .LDOS_DIRS1:
+    end;
+end;
+
+
+procedure mkdir(const s : string);
+
+begin
+    DosDir($39,s);
+end;
+
+
+procedure rmdir(const s : string);
+
+begin
+    DosDir($3a,s);
+end;
+
+procedure chdir(const s : string);
+
+begin
+    DosDir($3b,s);
+end;
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+
+{Written by Michael Van Canneyt.}
+
+var temp:array[0..255] of char;
+    sof:Pchar;
+    i:byte;
+
+begin
+    sof:=pchar(@dir[4]);
+    { dir[1..3] will contain '[drivenr]:\', but is not }
+    { supplied by DOS, so we let dos string start at   }
+    { dir[4]                                           }
+    { Get dir from drivenr : 0=default, 1=A etc... }
+    asm
+        movb drivenr,%dl
+        movl sof,%esi
+        mov  $0x47,%ah
+        call syscall
+    end;
+    { Now Dir should be filled with directory in ASCIIZ, }
+    { starting from dir[4]                               }
+    dir[0]:=#3;
+    dir[2]:=':';
+    dir[3]:='\';
+    i:=4;
+    {Conversion to Pascal string }
+    while (dir[i]<>#0) do
+        begin
+            { convert path name to DOS }
+            if dir[i]='/' then
+            dir[i]:='\';
+            dir[0]:=char(i);
+            inc(i);
+        end;
+    { upcase the string (FPC function) }
+    if not (FileNameCaseSensitive) then dir:=upcase(dir);
+    if drivenr<>0 then   { Drive was supplied. We know it }
+        dir[1]:=char(65+drivenr-1)
+    else
+        begin
+            { We need to get the current drive from DOS function 19H  }
+            { because the drive was the default, which can be unknown }
+            asm
+                movb $0x19,%ah
+                call syscall
+                addb $65,%al
+                movb %al,i
+            end;
+            dir[1]:=char(i);
+        end;
+end;
+
+
+
+{****************************************************************************
+
+                        System unit initialization.
+
+****************************************************************************}
+
+function GetFileHandleCount: longint;
+var L1, L2: longint;
+begin
+    L1 := 0; (* Don't change the amount, just check. *)
+    if DosSetRelMaxFH (L1, L2) <> 0 then GetFileHandleCount := 50
+                                                 else GetFileHandleCount := L2;
+end;
+
+var pib:Pprocessinfoblock;
+    tib:Pthreadinfoblock;
+
+begin
+    {Determine the operating system we are running on.}
+    asm
+        movl $0,os_mode
+        movw $0x7f0a,%ax
+        call syscall
+        testw $512,%bx         {Bit 9 is OS/2 flag.}
+        setnzb os_mode
+        testw $4096,%bx
+        jz .LnoRSX
+        movl $2,os_mode
+    .LnoRSX:
+    end;
+
+    {$ASMMODE DIRECT}
+    {Enable the brk area by initializing it with the initial heap size.}
+    asm
+        movw $0x7f01,%ax
+        movl HEAPSIZE,%edx
+        addl __heap_base,%edx
+        call ___SYSCALL
+        cmpl $-1,%eax
+        jnz Lheapok
+        pushl $204
+        {call RUNERROR$$WORD}
+    Lheapok:
+    end;
+    {$ASMMODE ATT}
+
+    {Now request, if we are running under DOS,
+     read-access to the first meg. of memory.}
+    if os_mode in [osDOS,osDPMI] then
+        asm
+            movw $0x7f13,%ax
+            xorl %ebx,%ebx
+            movl $0xfff,%ecx
+            xorl %edx,%edx
+            call syscall
+            movl %eax,first_meg
+        end
+    else
+        begin
+            first_meg := nil;
+    (* Initialize the amount of file handles *)
+            FileHandleCount := GetFileHandleCount;
+        end;
+    {At 0.9.2, case for enumeration does not work.}
+    case os_mode of
+        osDOS:
+            stackbottom:=0;     {In DOS mode, heap_brk is also the
+                                 stack bottom.}
+        osOS2:
+            begin
+                dosgetinfoblocks(tib,pib);
+                stackbottom:=longint(tib^.stack);
+            end;
+        osDPMI:
+            stackbottom:=0;     {Not sure how to get it, but seems to be
+                                 always zero.}
+    end;
+    exitproc:=nil;
+
+    {Initialize the heap.}
+    initheap;
+
+    { ... and exceptions }
+    InitExceptions;
+
+    { to test stack depth }
+    loweststack:=maxlongint;
+
+    OpenStdIO(Input,fmInput,StdInputHandle);
+    OpenStdIO(Output,fmOutput,StdOutputHandle);
+    OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+    OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+
+    { no I/O-Error }
+    inoutres:=0;
+end.
+{
+  $Log$
+  Revision 1.1  2000-10-15 08:19:49  peter
+    * system unit rename for 1.1 branch
+
+  Revision 1.3  2000/09/29 21:49:41  jonas
+    * removed warnings
+
+  Revision 1.2  2000/07/14 10:33:11  michael
+  + Conditionals fixed
+
+  Revision 1.1  2000/07/13 06:31:07  michael
+  + Initial import
+
+}

rtl/win32/Makefile

@@ -123,12 +123,16 @@ WININC=wininc
 
 UNITPREFIX=rtl
 
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=syswin32
+endif
+
 # Paths
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 
-SYSTEMUNIT=syswin32
-
 # Files used by windows.pp
 include $(WININC)/makefile.inc
 
@@ -1282,39 +1286,39 @@ wdllprt0$(OEXT) : wdllprt0.as
 # System Units (System, Objpas, Strings)
 #
 
-$(SYSTEMPPU) : syswin32.pp win32.inc $(SYSDEPS)
-	$(COMPILER) -Us -Sg syswin32.pp $(REDIR)
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp win32.inc $(SYSDEPS)
+	$(COMPILER) -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMPPU)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
 		   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
-		   $(SYSTEMPPU)
+		   $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # System Dependent Units
 #
 
-windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMPPU)
+windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -I$(WININC) windows.pp $(REDIR)
 
-ole2$(PPUEXT) : ole2.pp windows$(PPUEXT) $(SYSTEMPPU)
+ole2$(PPUEXT) : ole2.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMPPU)
+opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 os_types$(PPUEXT) : $(INC)/os_types.pp
 
-winsock$(PPUEXT) : winsock.pp windows$(PPUEXT) $(SYSTEMPPU) os_types$(PPUEXT)
+winsock$(PPUEXT) : winsock.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) os_types$(PPUEXT)
 
-sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMPPU) \
+sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
 		   $(INC)/sockets.inc $(INC)/socketsh.inc
 
-initc$(PPUEXT) : initc.pp $(SYSTEMPPU)
+initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT)
 
-wincrt$(PPUEXT) : wincrt.pp $(SYSTEMPPU) windows$(PPUEXT) graph$(PPUEXT)
+wincrt$(PPUEXT) : wincrt.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT)
 
-winmouse$(PPUEXT) : winmouse.pp $(SYSTEMPPU) windows$(PPUEXT) graph$(PPUEXT)
+winmouse$(PPUEXT) : winmouse.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT)
 
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT)
 
@@ -1322,11 +1326,11 @@ dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT)
 # TP7 Compatible RTL Units
 #
 
-dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMPPU)
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMPPU) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
+objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Graph
@@ -1335,7 +1339,7 @@ objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
 include $(GRAPHDIR)/makefile.inc
 GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
 
-graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMPPU) \
+graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
 		 $(GRAPHINCDEPS)
 	$(COMPILER) -I$(GRAPHDIR) graph.pp $(REDIR)
 
@@ -1362,16 +1366,16 @@ varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
 # Other system-independent RTL Units
 #
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
 
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMPPU)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Other system-dependent RTL Units

rtl/win32/Makefile.fpc

@@ -36,12 +36,16 @@ WININC=wininc
 
 UNITPREFIX=rtl
 
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+SYSTEMUNIT=system
+else
+SYSTEMUNIT=syswin32
+endif
+
 # Paths
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 
-SYSTEMUNIT=syswin32
-
 # Files used by windows.pp
 include $(WININC)/makefile.inc
 
@@ -87,39 +91,39 @@ wdllprt0$(OEXT) : wdllprt0.as
 # System Units (System, Objpas, Strings)
 #
 
-$(SYSTEMPPU) : syswin32.pp win32.inc $(SYSDEPS)
-        $(COMPILER) -Us -Sg syswin32.pp $(REDIR)
+$(SYSTEMUNIT)$(PPUEXT) : $(SYSTEMUNIT).pp win32.inc $(SYSDEPS)
+        $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp $(REDIR)
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMPPU)
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp $(REDIR)
 
 strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
                    $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
-                   $(SYSTEMPPU)
+                   $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # System Dependent Units
 #
 
-windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMPPU)
+windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -I$(WININC) windows.pp $(REDIR)
 
-ole2$(PPUEXT) : ole2.pp windows$(PPUEXT) $(SYSTEMPPU)
+ole2$(PPUEXT) : ole2.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMPPU)
+opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 os_types$(PPUEXT) : $(INC)/os_types.pp
 
-winsock$(PPUEXT) : winsock.pp windows$(PPUEXT) $(SYSTEMPPU) os_types$(PPUEXT)
+winsock$(PPUEXT) : winsock.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) os_types$(PPUEXT)
 
-sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMPPU) \
+sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
                    $(INC)/sockets.inc $(INC)/socketsh.inc
 
-initc$(PPUEXT) : initc.pp $(SYSTEMPPU)
+initc$(PPUEXT) : initc.pp $(SYSTEMUNIT)$(PPUEXT)
 
-wincrt$(PPUEXT) : wincrt.pp $(SYSTEMPPU) windows$(PPUEXT) graph$(PPUEXT)
+wincrt$(PPUEXT) : wincrt.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT)
 
-winmouse$(PPUEXT) : winmouse.pp $(SYSTEMPPU) windows$(PPUEXT) graph$(PPUEXT)
+winmouse$(PPUEXT) : winmouse.pp $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) graph$(PPUEXT)
 
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT)
 
@@ -127,11 +131,11 @@ dynlibs$(PPUEXT) : $(INC)/dynlibs.pp windows$(PPUEXT)
 # TP7 Compatible RTL Units
 #
 
-dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMPPU)
+dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMPPU) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT)
 
-objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
+objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Graph
@@ -140,7 +144,7 @@ objects$(PPUEXT) : $(INC)/objects.pp objinc.inc $(SYSTEMPPU)
 include $(GRAPHDIR)/makefile.inc
 GRAPHINCDEPS=$(addprefix $(GRAPHDIR)/,$(GRAPHINCNAMES))
 
-graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMPPU) \
+graph$(PPUEXT) : graph.pp strings$(PPUEXT) windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
                  $(GRAPHINCDEPS)
         $(COMPILER) -I$(GRAPHDIR) graph.pp $(REDIR)
 
@@ -167,16 +171,16 @@ varutils$(PPUEXT) : varutils.pp $(OBJPASDIR)/cvarutil.inc \
 # Other system-independent RTL Units
 #
 
-cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMPPU)
+cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT)
 
-mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMPPU)
+mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
-getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMPPU)
+getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT)
 
-heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMPPU)
+heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
         $(COMPILER) -Sg $(INC)/heaptrc.pp $(REDIR)
 
-lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMPPU)
+lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # Other system-dependent RTL Units

rtl/win32/system.pp

@@ -0,0 +1,1401 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
+    member of the Free Pascal development team.
+
+    FPC Pascal system unit for the Win32 API.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+unit {$ifdef VER1_0}SysWin32{$else}System{$endif};
+interface
+
+{$ifdef SYSTEMDEBUG}
+  {$define SYSTEMEXCEPTIONDEBUG}
+{$endif SYSTEMDEBUG}
+
+{$ifdef i386}
+  {$define Set_i386_Exception_handler}
+{$endif i386}
+
+{ include system-independent routine headers }
+{$I systemh.inc}
+
+{ include heap support headers }
+{$I heaph.inc}
+
+const
+{ Default filehandles }
+   UnusedHandle    : longint = -1;
+   StdInputHandle  : longint = 0;
+   StdOutputHandle : longint = 0;
+   StdErrorHandle  : longint = 0;
+
+   FileNameCaseSensitive : boolean = true;
+
+type
+  TStartupInfo=packed record
+    cb : longint;
+    lpReserved : Pointer;
+    lpDesktop : Pointer;
+    lpTitle : Pointer;
+    dwX : longint;
+    dwY : longint;
+    dwXSize : longint;
+    dwYSize : longint;
+    dwXCountChars : longint;
+    dwYCountChars : longint;
+    dwFillAttribute : longint;
+    dwFlags : longint;
+    wShowWindow : Word;
+    cbReserved2 : Word;
+    lpReserved2 : Pointer;
+    hStdInput : longint;
+    hStdOutput : longint;
+    hStdError : longint;
+  end;
+
+var
+{ C compatible arguments }
+  argc  : longint;
+  argv  : ppchar;
+{ Win32 Info }
+  startupinfo : tstartupinfo;
+  hprevinst,
+  HInstance,
+  MainInstance,
+  cmdshow     : longint;
+  DLLreason,DLLparam:longint;
+  Win32StackTop : Dword;
+{ Thread count for DLL }
+const
+  Thread_count : longint = 0;
+type
+  TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool;
+  TDLL_Entry_Hook = procedure (dllparam : longint);
+
+const
+  Dll_Process_Attach_Hook : TDLL_Process_Entry_Hook = nil;
+  Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
+  Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
+  Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
+
+implementation
+
+{ include system independent routines }
+{$I system.inc}
+
+{ some declarations for Win32 API calls }
+{$I win32.inc}
+
+
+CONST
+  { These constants are used for conversion of error codes }
+  { from win32 i/o errors to tp i/o errors                 }
+  { errors 1 to 18 are the same as in Turbo Pascal         }
+  { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING! }
+
+{  The media is write protected.                   }
+    ERROR_WRITE_PROTECT       =      19;
+{  The system cannot find the device specified.    }
+    ERROR_BAD_UNIT            =      20;
+{  The device is not ready.                        }
+    ERROR_NOT_READY           =      21;
+{  The device does not recognize the command.      }
+    ERROR_BAD_COMMAND         =      22;
+{  Data error (cyclic redundancy check)            }
+    ERROR_CRC                 =      23;
+{  The program issued a command but the            }
+{  command length is incorrect.                    }
+    ERROR_BAD_LENGTH           =     24;
+{  The drive cannot locate a specific              }
+{  area or track on the disk.                      }
+    ERROR_SEEK                 =     25;
+{  The specified disk or diskette cannot be accessed. }
+    ERROR_NOT_DOS_DISK         =     26;
+{  The drive cannot find the sector requested.     }
+    ERROR_SECTOR_NOT_FOUND      =    27;
+{  The printer is out of paper.                    }
+    ERROR_OUT_OF_PAPER          =    28;
+{  The system cannot write to the specified device. }
+    ERROR_WRITE_FAULT           =    29;
+{  The system cannot read from the specified device. }
+    ERROR_READ_FAULT            =    30;
+{  A device attached to the system is not functioning.}
+    ERROR_GEN_FAILURE           =    31;
+{  The process cannot access the file because         }
+{  it is being used by another process.               }
+    ERROR_SHARING_VIOLATION      =   32;
+
+var
+    errno : longint;
+
+{$ASMMODE ATT}
+
+
+   { misc. functions }
+   function GetLastError : DWORD;
+     external 'kernel32' name 'GetLastError';
+
+   { time and date functions }
+   function GetTickCount : longint;
+     external 'kernel32' name 'GetTickCount';
+
+   { process functions }
+   procedure ExitProcess(uExitCode : UINT);
+     external 'kernel32' name 'ExitProcess';
+
+
+   Procedure Errno2InOutRes;
+   Begin
+     { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING }
+     if (errno >= ERROR_WRITE_PROTECT) and (errno <= ERROR_GEN_FAILURE) THEN
+       BEGIN
+          { This is the offset to the Win32 to add to directly map  }
+          { to the DOS/TP compatible error codes when in this range }
+          InOutRes := word(errno)+131;
+       END
+     else
+     { This case is special }
+     if errno=ERROR_SHARING_VIOLATION THEN
+       BEGIN
+         InOutRes :=5;
+       END
+     else
+     { other error codes can directly be mapped }
+         InOutRes := Word(errno);
+     errno:=0;
+   end;
+
+
+{$ifdef dummy}
+procedure int_stackcheck(stack_size:longint);[public,alias: 'STACKCHECK'];
+{
+  called when trying to get local stack if the compiler directive $S
+  is set this function must preserve esi !!!! because esi is set by
+  the calling proc for methods it must preserve all registers !!
+
+  With a 2048 byte safe area used to write to StdIo without crossing
+  the stack boundary
+
+}
+begin
+  asm
+        pushl   %eax
+        pushl   %ebx
+        movl    stack_size,%ebx
+        addl    $2048,%ebx
+        movl    %esp,%eax
+        subl    %ebx,%eax
+        movl    stacklimit,%ebx
+        cmpl    %eax,%ebx
+        jae     .L__short_on_stack
+        popl    %ebx
+        popl    %eax
+        leave
+        ret     $4
+.L__short_on_stack:
+        { can be usefull for error recovery !! }
+        popl    %ebx
+        popl    %eax
+  end['EAX','EBX'];
+  HandleError(202);
+end;
+{$endif dummy}
+
+
+function paramcount : longint;
+begin
+  paramcount := argc - 1;
+end;
+
+   { module functions }
+   function GetModuleFileName(l1:longint;p:pointer;l2:longint):longint;
+     external 'kernel32' name 'GetModuleFileNameA';
+   function GetModuleHandle(p : pointer) : longint;
+     external 'kernel32' name 'GetModuleHandleA';
+   function GetCommandFile:pchar;forward;
+
+function paramstr(l : longint) : string;
+begin
+  if (l>=0) and (l<argc) then
+    paramstr:=strpas(argv[l])
+  else
+    paramstr:='';
+end;
+
+
+procedure randomize;
+begin
+  randseed:=GetTickCount;
+end;
+
+
+{*****************************************************************************
+                              Heap Management
+*****************************************************************************}
+   { memory functions }
+   function GetProcessHeap : DWord;
+     external 'kernel32' name 'GetProcessHeap';
+   function HeapAlloc(hHeap : DWord; dwFlags : DWord; dwBytes : DWord) : Longint;
+     external 'kernel32' name 'HeapAlloc';
+{$IFDEF SYSTEMDEBUG}
+   function HeapSize(hHeap : DWord; dwFlags : DWord; ptr : Pointer) : DWord;
+     external 'kernel32' name 'HeapSize';
+{$ENDIF}
+
+var
+  heap : longint;external name 'HEAP';
+  intern_heapsize : longint;external name 'HEAPSIZE';
+
+function getheapstart:pointer;assembler;
+asm
+        leal    HEAP,%eax
+end ['EAX'];
+
+
+function getheapsize:longint;assembler;
+asm
+        movl    intern_HEAPSIZE,%eax
+end ['EAX'];
+
+
+function Sbrk(size : longint):longint;
+var
+  l : longint;
+begin
+  l := HeapAlloc(GetProcessHeap(), 0, size);
+  if (l = 0) then
+    l := -1;
+{$ifdef DUMPGROW}
+  Writeln('new heap part at $',hexstr(l,8), ' size = ',HeapSize(GetProcessHeap()));
+{$endif}
+  sbrk:=l;
+end;
+
+{ include standard heap management }
+{$I heap.inc}
+
+
+{*****************************************************************************
+                          Low Level File Routines
+*****************************************************************************}
+
+   function WriteFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
+     overlap:pointer):longint;
+     external 'kernel32' name 'WriteFile';
+   function ReadFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
+     overlap:pointer):longint;
+     external 'kernel32' name 'ReadFile';
+   function CloseHandle(h : longint) : longint;
+     external 'kernel32' name 'CloseHandle';
+   function DeleteFile(p : pchar) : longint;
+     external 'kernel32' name 'DeleteFileA';
+   function MoveFile(old,_new : pchar) : longint;
+     external 'kernel32' name 'MoveFileA';
+   function SetFilePointer(l1,l2 : longint;l3 : pointer;l4 : longint) : longint;
+     external 'kernel32' name 'SetFilePointer';
+   function GetFileSize(h:longint;p:pointer) : longint;
+     external 'kernel32' name 'GetFileSize';
+   function CreateFile(name : pointer;access,sharing : longint;
+     security : pointer;how,attr,template : longint) : longint;
+     external 'kernel32' name 'CreateFileA';
+   function SetEndOfFile(h : longint) : longbool;
+     external 'kernel32' name 'SetEndOfFile';
+   function GetFileType(Handle:DWORD):DWord;
+     external 'kernel32' name 'GetFileType';
+
+
+procedure AllowSlash(p:pchar);
+var
+   i : longint;
+begin
+{ allow slash as backslash }
+   for i:=0 to strlen(p) do
+     if p[i]='/' then p[i]:='\';
+end;
+
+function do_isdevice(handle:longint):boolean;
+begin
+  do_isdevice:=(getfiletype(handle)=2);
+end;
+
+
+procedure do_close(h : longint);
+begin
+  if do_isdevice(h) then
+   exit;
+  CloseHandle(h);
+end;
+
+
+procedure do_erase(p : pchar);
+begin
+   AllowSlash(p);
+   if DeleteFile(p)=0 then
+    Begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+end;
+
+
+procedure do_rename(p1,p2 : pchar);
+begin
+  AllowSlash(p1);
+  AllowSlash(p2);
+  if MoveFile(p1,p2)=0 then
+   Begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+   end;
+end;
+
+
+function do_write(h,addr,len : longint) : longint;
+var
+   size:longint;
+begin
+   if writefile(h,pointer(addr),len,size,nil)=0 then
+    Begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+   do_write:=size;
+end;
+
+
+function do_read(h,addr,len : longint) : longint;
+var
+  _result:longint;
+begin
+  if readfile(h,pointer(addr),len,_result,nil)=0 then
+    Begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+  do_read:=_result;
+end;
+
+
+function do_filepos(handle : longint) : longint;
+var
+  l:longint;
+begin
+  l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
+  if l=-1 then
+   begin
+    l:=0;
+    errno:=GetLastError;
+    Errno2InoutRes;
+   end;
+  do_filepos:=l;
+end;
+
+
+procedure do_seek(handle,pos : longint);
+begin
+  if SetFilePointer(handle,pos,nil,FILE_BEGIN)=-1 then
+   Begin
+    errno:=GetLastError;
+    Errno2InoutRes;
+   end;
+end;
+
+
+function do_seekend(handle:longint):longint;
+begin
+  do_seekend:=SetFilePointer(handle,0,nil,FILE_END);
+  if do_seekend=-1 then
+    begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+end;
+
+
+function do_filesize(handle : longint) : longint;
+var
+  aktfilepos : longint;
+begin
+  aktfilepos:=do_filepos(handle);
+  do_filesize:=do_seekend(handle);
+  do_seek(handle,aktfilepos);
+end;
+
+
+procedure do_truncate (handle,pos:longint);
+begin
+   do_seek(handle,pos);
+   if not(SetEndOfFile(handle)) then
+    begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+end;
+
+
+procedure do_open(var f;p : pchar;flags:longint);
+{
+  filerec and textrec have both handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+Const
+  file_Share_Read  = $00000001;
+  file_Share_Write = $00000002;
+Var
+  shflags,
+  oflags,cd : longint;
+begin
+  AllowSlash(p);
+{ close first if opened }
+  if ((flags and $10000)=0) then
+   begin
+     case filerec(f).mode of
+       fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
+       fmclosed : ;
+     else
+      begin
+        {not assigned}
+        inoutres:=102;
+        exit;
+      end;
+     end;
+   end;
+{ reset file handle }
+  filerec(f).handle:=UnusedHandle;
+{ convert filesharing }
+  shflags:=0;
+  if ((filemode and fmshareExclusive) = fmshareExclusive) then
+    { no sharing }
+  else
+    if (filemode = fmShareCompat) or ((filemode and fmshareDenyWrite) = fmshareDenyWrite) then
+      shflags := file_Share_Read
+  else
+    if ((filemode and fmshareDenyRead) = fmshareDenyRead) then
+      shflags := file_Share_Write
+  else
+    if ((filemode and fmshareDenyNone) = fmshareDenyNone) then
+      shflags := file_Share_Read + file_Share_Write;
+{ convert filemode to filerec modes }
+  case (flags and 3) of
+   0 : begin
+         filerec(f).mode:=fminput;
+         oflags:=GENERIC_READ;
+       end;
+   1 : begin
+         filerec(f).mode:=fmoutput;
+         oflags:=GENERIC_WRITE;
+       end;
+   2 : begin
+         filerec(f).mode:=fminout;
+         oflags:=GENERIC_WRITE or GENERIC_READ;
+       end;
+  end;
+{ standard is opening and existing file }
+  cd:=OPEN_EXISTING;
+{ create it ? }
+  if (flags and $1000)<>0 then
+   cd:=CREATE_ALWAYS
+{ or append ? }
+  else
+   if (flags and $100)<>0 then
+    cd:=OPEN_ALWAYS;
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case FileRec(f).mode of
+       fminput :
+         FileRec(f).Handle:=StdInputHandle;
+       fminout, { this is set by rewrite }
+       fmoutput :
+         FileRec(f).Handle:=StdOutputHandle;
+       fmappend :
+         begin
+           FileRec(f).Handle:=StdOutputHandle;
+           FileRec(f).mode:=fmoutput; {fool fmappend}
+         end;
+     end;
+     exit;
+   end;
+  filerec(f).handle:=CreateFile(p,oflags,shflags,nil,cd,FILE_ATTRIBUTE_NORMAL,0);
+{ append mode }
+  if (flags and $100)<>0 then
+   begin
+     do_seekend(filerec(f).handle);
+     filerec(f).mode:=fmoutput; {fool fmappend}
+   end;
+{ get errors }
+  { handle -1 is returned sometimes !! (PM) }
+  if (filerec(f).handle=0) or (filerec(f).handle=-1) then
+    begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+end;
+
+
+
+
+{*****************************************************************************
+                           UnTyped File Handling
+*****************************************************************************}
+
+{$i file.inc}
+
+{*****************************************************************************
+                           Typed File Handling
+*****************************************************************************}
+
+{$i typefile.inc}
+
+{*****************************************************************************
+                           Text File Handling
+*****************************************************************************}
+
+{$DEFINE EOF_CTRLZ}
+
+{$i text.inc}
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+   function CreateDirectory(name : pointer;sec : pointer) : longint;
+     external 'kernel32' name 'CreateDirectoryA';
+   function RemoveDirectory(name:pointer):longint;
+     external 'kernel32' name 'RemoveDirectoryA';
+   function SetCurrentDirectory(name : pointer) : longint;
+     external 'kernel32' name 'SetCurrentDirectoryA';
+   function GetCurrentDirectory(bufsize : longint;name : pchar) : longint;
+     external 'kernel32' name 'GetCurrentDirectoryA';
+
+type
+ TDirFnType=function(name:pointer):word;
+
+procedure dirfn(afunc : TDirFnType;const s:string);
+var
+  buffer : array[0..255] of char;
+begin
+  move(s[1],buffer,length(s));
+  buffer[length(s)]:=#0;
+  AllowSlash(pchar(@buffer));
+  if aFunc(@buffer)=0 then
+    begin
+      errno:=GetLastError;
+      Errno2InoutRes;
+    end;
+end;
+
+function CreateDirectoryTrunc(name:pointer):word;
+ begin
+  CreateDirectoryTrunc:=CreateDirectory(name,nil);
+ end;
+
+procedure mkdir(const s:string);[IOCHECK];
+ begin
+  If InOutRes <> 0 then exit;
+  dirfn(TDirFnType(@CreateDirectoryTrunc),s);
+ end;
+
+procedure rmdir(const s:string);[IOCHECK];
+ begin
+  If InOutRes <> 0 then exit;
+  dirfn(TDirFnType(@RemoveDirectory),s);
+ end;
+
+procedure chdir(const s:string);[IOCHECK];
+ begin
+  If InOutRes <> 0 then exit;
+  dirfn(TDirFnType(@SetCurrentDirectory),s);
+ end;
+
+procedure getdir(drivenr:byte;var dir:shortstring);
+const
+  Drive:array[0..3]of char=(#0,':',#0,#0);
+var
+  defaultdrive:boolean;
+  DirBuf,SaveBuf:array[0..259] of Char;
+begin
+  defaultdrive:=drivenr=0;
+  if not defaultdrive then
+   begin
+    byte(Drive[0]):=Drivenr+64;
+    GetCurrentDirectory(SizeOf(SaveBuf),SaveBuf);
+    SetCurrentDirectory(@Drive);
+   end;
+  GetCurrentDirectory(SizeOf(DirBuf),DirBuf);
+  if not defaultdrive then
+   SetCurrentDirectory(@SaveBuf);
+  dir:=strpas(DirBuf);
+  if not FileNameCaseSensitive then
+   dir:=upcase(dir);
+end;
+
+
+{*****************************************************************************
+                         SystemUnit Initialization
+*****************************************************************************}
+
+   { Startup }
+   procedure GetStartupInfo(p : pointer);
+     external 'kernel32' name 'GetStartupInfoA';
+   function GetStdHandle(nStdHandle:DWORD):THANDLE;
+     external 'kernel32' name 'GetStdHandle';
+
+   { command line/enviroment functions }
+   function GetCommandLine : pchar;
+     external 'kernel32' name 'GetCommandLineA';
+
+
+var
+  ModuleName : array[0..255] of char;
+
+function GetCommandFile:pchar;
+begin
+  GetModuleFileName(0,@ModuleName,255);
+  GetCommandFile:=@ModuleName;
+end;
+
+
+procedure setup_arguments;
+var
+  arglen,
+  count   : longint;
+  argstart,
+  pc      : pchar;
+  quote   : set of char;
+  argsbuf : array[0..127] of pchar;
+begin
+  { create commandline, it starts with the executed filename which is argv[0] }
+  { Win32 passes the command NOT via the args, but via getmodulefilename}
+  count:=0;
+  pc:=getcommandfile;
+  Arglen:=0;
+  repeat
+    Inc(Arglen);
+  until (pc[Arglen]=#0);
+  getmem(argsbuf[count],arglen+1);
+  move(pc^,argsbuf[count]^,arglen);
+  { Now skip the first one }
+  pc:=GetCommandLine;
+  repeat
+    { skip leading spaces }
+    while pc^ in [' ',#9,#13] do
+     inc(pc);
+    case pc^ of
+      #0 : break;
+     '"' : begin
+             quote:=['"'];
+             inc(pc);
+           end;
+    '''' : begin
+             quote:=[''''];
+             inc(pc);
+           end;
+    else
+     quote:=[' ',#9,#13];
+    end;
+  { scan until the end of the argument }
+    argstart:=pc;
+    while (pc^<>#0) and not(pc^ in quote) do
+     inc(pc);
+    { Don't copy the first one, it is already there.}
+    If Count<>0 then
+     begin
+       { reserve some memory }
+       arglen:=pc-argstart;
+       getmem(argsbuf[count],arglen+1);
+       move(argstart^,argsbuf[count]^,arglen);
+       argsbuf[count][arglen]:=#0;
+     end;
+    { skip quote }
+    if pc^ in quote then
+     inc(pc);
+    inc(count);
+  until false;
+{ create argc }
+  argc:=count;
+{ create an nil entry }
+  argsbuf[count]:=nil;
+  inc(count);
+{ create the argv }
+  getmem(argv,count shl 2);
+  move(argsbuf,argv^,count shl 2);
+{ Setup cmdline variable }
+  cmdline:=GetCommandLine;
+end;
+
+
+{*****************************************************************************
+                         System Dependent Exit code
+*****************************************************************************}
+
+  procedure install_exception_handlers;forward;
+  procedure remove_exception_handlers;forward;
+  procedure PascalMain;external name 'PASCALMAIN';
+  procedure fpc_do_exit;external name 'FPC_DO_EXIT';
+  Procedure ExitDLL(Exitcode : longint); forward;
+
+Procedure system_exit;
+begin
+  { don't call ExitProcess inside
+    the DLL exit code !!
+    This crashes Win95 at least PM }
+  if IsLibrary then
+    ExitDLL(ExitCode);
+  if not IsConsole then
+   begin
+     Close(stderr);
+     Close(stdout);
+     { what about Input and Output ?? PM }
+   end;
+  remove_exception_handlers;
+  ExitProcess(ExitCode);
+end;
+
+{$ifdef dummy}
+Function SetUpStack : longint;
+{ This routine does the following :                            }
+{  returns the value of the initial SP - __stklen              }
+begin
+  asm
+    pushl %ebx
+    pushl %eax
+    movl  __stklen,%ebx
+    movl  %esp,%eax
+    subl  %ebx,%eax
+    movl  %eax,__RESULT
+    popl  %eax
+    popl  %ebx
+  end;
+end;
+{$endif}
+
+
+var
+  { value of the stack segment
+    to check if the call stack can be written on exceptions }
+  _SS : longint;
+
+const
+  fpucw : word = $1332;
+
+procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
+  begin
+     IsLibrary:=false;
+     { install the handlers for exe only ?
+       or should we install them for DLL also ? (PM) }
+     install_exception_handlers;
+     { This strange construction is needed to solve the _SS problem
+       with a smartlinked syswin32 (PFV) }
+     asm
+        pushl %ebp
+        xorl %ebp,%ebp
+        movl %esp,%eax
+        movl %eax,Win32StackTop
+        movw %ss,%bp
+        movl %ebp,_SS
+        fninit
+        fldcw   fpucw
+        xorl %ebp,%ebp
+        call PASCALMAIN
+        popl %ebp
+     end;
+     { if we pass here there was no error ! }
+     system_exit;
+  end;
+
+Const
+  { DllEntryPoint  }
+     DLL_PROCESS_ATTACH = 1;
+     DLL_THREAD_ATTACH = 2;
+     DLL_PROCESS_DETACH = 0;
+     DLL_THREAD_DETACH = 3;
+Var
+     DLLBuf : Jmp_buf;
+Const
+     DLLExitOK : boolean = true;
+
+function Dll_entry : longbool;[public, alias : '_FPC_DLL_Entry'];
+var
+  res : longbool;
+
+  begin
+     IsLibrary:=true;
+     Dll_entry:=false;
+     case DLLreason of
+       DLL_PROCESS_ATTACH :
+         begin
+           If SetJmp(DLLBuf) = 0 then
+             begin
+               if assigned(Dll_Process_Attach_Hook) then
+                 begin
+                   res:=Dll_Process_Attach_Hook(DllParam);
+                   if not res then
+                     exit(false);
+                 end;
+               PASCALMAIN;
+               Dll_entry:=true;
+             end
+           else
+             Dll_entry:=DLLExitOK;
+         end;
+       DLL_THREAD_ATTACH :
+         begin
+           inc(Thread_count);
+           if assigned(Dll_Thread_Attach_Hook) then
+             Dll_Thread_Attach_Hook(DllParam);
+           Dll_entry:=true; { return value is ignored }
+         end;
+       DLL_THREAD_DETACH :
+         begin
+           dec(Thread_count);
+           if assigned(Dll_Thread_Detach_Hook) then
+             Dll_Thread_Detach_Hook(DllParam);
+           Dll_entry:=true; { return value is ignored }
+         end;
+       DLL_PROCESS_DETACH :
+         begin
+           Dll_entry:=true; { return value is ignored }
+           If SetJmp(DLLBuf) = 0 then
+             begin
+               FPC_DO_EXIT;
+             end;
+           if assigned(Dll_Process_Detach_Hook) then
+             Dll_Process_Detach_Hook(DllParam);
+         end;
+     end;
+  end;
+
+Procedure ExitDLL(Exitcode : longint);
+begin
+    DLLExitOK:=ExitCode=0;
+    LongJmp(DLLBuf,1);
+end;
+
+//
+// Hardware exception handling
+//
+
+{$ifdef Set_i386_Exception_handler}
+
+(*
+  Error code definitions for the Win32 API functions
+
+
+  Values are 32 bit values layed out as follows:
+   3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
+   1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+  +---+-+-+-----------------------+-------------------------------+
+  |Sev|C|R|     Facility          |               Code            |
+  +---+-+-+-----------------------+-------------------------------+
+
+  where
+      Sev - is the severity code
+          00 - Success
+          01 - Informational
+          10 - Warning
+          11 - Error
+
+      C - is the Customer code flag
+      R - is a reserved bit
+      Facility - is the facility code
+      Code - is the facility's status code
+*)
+
+const
+        SEVERITY_SUCCESS                = $00000000;
+        SEVERITY_INFORMATIONAL  = $40000000;
+        SEVERITY_WARNING                = $80000000;
+        SEVERITY_ERROR                  = $C0000000;
+
+const
+        STATUS_SEGMENT_NOTIFICATION             = $40000005;
+        DBG_TERMINATE_THREAD                    = $40010003;
+        DBG_TERMINATE_PROCESS                   = $40010004;
+        DBG_CONTROL_C                                   = $40010005;
+        DBG_CONTROL_BREAK                               = $40010008;
+
+        STATUS_GUARD_PAGE_VIOLATION             = $80000001;
+        STATUS_DATATYPE_MISALIGNMENT    = $80000002;
+        STATUS_BREAKPOINT                               = $80000003;
+        STATUS_SINGLE_STEP                              = $80000004;
+        DBG_EXCEPTION_NOT_HANDLED               = $80010001;
+
+        STATUS_ACCESS_VIOLATION                 = $C0000005;
+        STATUS_IN_PAGE_ERROR                    = $C0000006;
+        STATUS_INVALID_HANDLE                   = $C0000008;
+        STATUS_NO_MEMORY                                = $C0000017;
+        STATUS_ILLEGAL_INSTRUCTION              = $C000001D;
+        STATUS_NONCONTINUABLE_EXCEPTION = $C0000025;
+        STATUS_INVALID_DISPOSITION              = $C0000026;
+        STATUS_ARRAY_BOUNDS_EXCEEDED    = $C000008C;
+        STATUS_FLOAT_DENORMAL_OPERAND   = $C000008D;
+        STATUS_FLOAT_DIVIDE_BY_ZERO             = $C000008E;
+        STATUS_FLOAT_INEXACT_RESULT             = $C000008F;
+        STATUS_FLOAT_INVALID_OPERATION  = $C0000090;
+        STATUS_FLOAT_OVERFLOW                   = $C0000091;
+        STATUS_FLOAT_STACK_CHECK                = $C0000092;
+        STATUS_FLOAT_UNDERFLOW                  = $C0000093;
+        STATUS_INTEGER_DIVIDE_BY_ZERO   = $C0000094;
+        STATUS_INTEGER_OVERFLOW                 = $C0000095;
+        STATUS_PRIVILEGED_INSTRUCTION   = $C0000096;
+        STATUS_STACK_OVERFLOW                   = $C00000FD;
+        STATUS_CONTROL_C_EXIT                   = $C000013A;
+        STATUS_FLOAT_MULTIPLE_FAULTS    = $C00002B4;
+        STATUS_FLOAT_MULTIPLE_TRAPS             = $C00002B5;
+        STATUS_REG_NAT_CONSUMPTION              = $C00002C9;
+
+        EXCEPTION_EXECUTE_HANDLER               = 1;
+        EXCEPTION_CONTINUE_EXECUTION    = -1;
+        EXCEPTION_CONTINUE_SEARCH               = 0;
+
+        EXCEPTION_MAXIMUM_PARAMETERS    = 15;
+
+        CONTEXT_X86                                     = $00010000;
+        CONTEXT_CONTROL                         = CONTEXT_X86 or $00000001;
+        CONTEXT_INTEGER                         = CONTEXT_X86 or $00000002;
+        CONTEXT_SEGMENTS                        = CONTEXT_X86 or $00000004;
+        CONTEXT_FLOATING_POINT          = CONTEXT_X86 or $00000008;
+        CONTEXT_DEBUG_REGISTERS         = CONTEXT_X86 or $00000010;
+        CONTEXT_EXTENDED_REGISTERS      = CONTEXT_X86 or $00000020;
+
+        CONTEXT_FULL                            = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS;
+
+        MAXIMUM_SUPPORTED_EXTENSION     = 512;
+
+type
+        PFloatingSaveArea = ^TFloatingSaveArea;
+        TFloatingSaveArea = packed record
+                ControlWord : Cardinal;
+                StatusWord : Cardinal;
+                TagWord : Cardinal;
+                ErrorOffset : Cardinal;
+                ErrorSelector : Cardinal;
+                DataOffset : Cardinal;
+                DataSelector : Cardinal;
+                RegisterArea : array[0..79] of Byte;
+                Cr0NpxState : Cardinal;
+        end;
+
+        PContext = ^TContext;
+        TContext = packed record
+            //
+            // The flags values within this flag control the contents of
+            // a CONTEXT record.
+            //
+                ContextFlags : Cardinal;
+
+            //
+            // This section is specified/returned if CONTEXT_DEBUG_REGISTERS is
+            // set in ContextFlags.  Note that CONTEXT_DEBUG_REGISTERS is NOT
+            // included in CONTEXT_FULL.
+            //
+                Dr0, Dr1, Dr2,
+                Dr3, Dr6, Dr7 : Cardinal;
+
+            //
+            // This section is specified/returned if the
+            // ContextFlags word contains the flag CONTEXT_FLOATING_POINT.
+            //
+                FloatSave : TFloatingSaveArea;
+
+            //
+            // This section is specified/returned if the
+            // ContextFlags word contains the flag CONTEXT_SEGMENTS.
+            //
+                SegGs, SegFs,
+                SegEs, SegDs : Cardinal;
+
+            //
+            // This section is specified/returned if the
+            // ContextFlags word contains the flag CONTEXT_INTEGER.
+            //
+                Edi, Esi, Ebx,
+                Edx, Ecx, Eax : Cardinal;
+
+            //
+            // This section is specified/returned if the
+            // ContextFlags word contains the flag CONTEXT_CONTROL.
+            //
+                Ebp : Cardinal;
+                Eip : Cardinal;
+                SegCs : Cardinal;
+                EFlags, Esp, SegSs : Cardinal;
+
+            //
+            // This section is specified/returned if the ContextFlags word
+            // contains the flag CONTEXT_EXTENDED_REGISTERS.
+            // The format and contexts are processor specific
+            //
+                ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte;
+        end;
+
+type
+        PExceptionRecord = ^TExceptionRecord;
+        TExceptionRecord = packed record
+                ExceptionCode   : Longint;
+                ExceptionFlags  : Longint;
+                ExceptionRecord : PExceptionRecord;
+                ExceptionAddress : Pointer;
+                NumberParameters : Longint;
+                ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer;
+        end;
+
+        PExceptionPointers = ^TExceptionPointers;
+        TExceptionPointers = packed record
+                ExceptionRecord   : PExceptionRecord;
+                ContextRecord     : PContext;
+        end;
+
+     { type of functions that should be used for exception handling }
+        TTopLevelExceptionFilter = function (excep : PExceptionPointers) : Longint;stdcall;
+
+function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
+        external 'kernel32' name 'SetUnhandledExceptionFilter';
+
+const
+        MaxExceptionLevel = 16;
+        exceptLevel : Byte = 0;
+
+var
+        exceptEip       : array[0..MaxExceptionLevel-1] of Longint;
+        exceptError     : array[0..MaxExceptionLevel-1] of Byte;
+        resetFPU        : array[0..MaxExceptionLevel-1] of Boolean;
+
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+procedure DebugHandleErrorAddrFrame(error, addr, frame : longint);
+begin
+        if IsConsole then begin
+                write(stderr,'HandleErrorAddrFrame(error=',error);
+                write(stderr,',addr=',hexstr(addr,8));
+                writeln(stderr,',frame=',hexstr(frame,8),')');
+        end;
+        HandleErrorAddrFrame(error,addr,frame);
+end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+
+procedure JumpToHandleErrorFrame;
+var
+        eip, ebp, error : Longint;
+begin
+        // save ebp
+        asm
+                movl (%ebp),%eax
+                movl %eax,ebp
+        end;
+        if (exceptLevel > 0) then
+                dec(exceptLevel);
+
+        eip:=exceptEip[exceptLevel];
+        error:=exceptError[exceptLevel];
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+        if IsConsole then
+                writeln(stderr,'In JumpToHandleErrorFrame error=',error);
+        end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+        if resetFPU[exceptLevel] then asm
+                fninit
+                fldcw   fpucw
+        end;
+        { build a fake stack }
+        asm
+                movl   ebp,%eax
+                pushl  %eax
+                movl   eip,%eax
+                pushl  %eax
+                movl   error,%eax
+                pushl  %eax
+                movl   eip,%eax
+                pushl  %eax
+                movl   ebp,%ebp // Change frame pointer
+
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+                jmpl   DebugHandleErrorAddrFrame
+{$else not SYSTEMEXCEPTIONDEBUG}
+                jmpl   HandleErrorAddrFrame
+{$endif SYSTEMEXCEPTIONDEBUG}
+        end;
+end;
+
+function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
+var
+        frame,
+        res  : longint;
+
+function SysHandleErrorFrame(error, frame : Longint; must_reset_fpu : Boolean) : Longint;
+begin
+        if (frame = 0) then
+                SysHandleErrorFrame:=EXCEPTION_CONTINUE_SEARCH
+        else begin
+                if (exceptLevel >= MaxExceptionLevel) then exit;
+
+                exceptEip[exceptLevel] := excep^.ContextRecord^.Eip;
+                exceptError[exceptLevel] := error;
+                resetFPU[exceptLevel] := must_reset_fpu;
+                inc(exceptLevel);
+
+                excep^.ContextRecord^.Eip := Longint(@JumpToHandleErrorFrame);
+                excep^.ExceptionRecord^.ExceptionCode := 0;
+
+                SysHandleErrorFrame := EXCEPTION_CONTINUE_EXECUTION;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+                if IsConsole then begin
+                        writeln(stderr,'Exception Continue Exception set at ',
+                                hexstr(exceptEip[exceptLevel],8));
+                        writeln(stderr,'Eip changed to ',
+                                hexstr(longint(@JumpToHandleErrorFrame),8), ' error=', error);
+                end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+        end;
+end;
+
+begin
+        if excep^.ContextRecord^.SegSs=_SS then
+                frame := excep^.ContextRecord^.Ebp
+        else
+                frame := 0;
+        res := EXCEPTION_CONTINUE_SEARCH;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+        if IsConsole then Writeln(stderr,'Exception  ',
+                hexstr(excep^.ExceptionRecord^.ExceptionCode, 8));
+{$endif SYSTEMEXCEPTIONDEBUG}
+        case excep^.ExceptionRecord^.ExceptionCode of
+                STATUS_INTEGER_DIVIDE_BY_ZERO,
+                STATUS_FLOAT_DIVIDE_BY_ZERO :
+                        res := SysHandleErrorFrame(200, frame, true);
+                STATUS_ARRAY_BOUNDS_EXCEEDED :
+                        res := SysHandleErrorFrame(201, frame, false);
+                STATUS_STACK_OVERFLOW :
+                        res := SysHandleErrorFrame(202, frame, false);
+                STATUS_FLOAT_OVERFLOW :
+                        res := SysHandleErrorFrame(205, frame, true);
+                STATUS_FLOAT_UNDERFLOW :
+                        res := SysHandleErrorFrame(206, frame, true);
+{excep^.ContextRecord^.FloatSave.StatusWord := excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;}
+                STATUS_FLOAT_INVALID_OPERATION,
+                STATUS_FLOAT_STACK_CHECK :
+                        res := SysHandleErrorFrame(207, frame, true);
+                STATUS_INTEGER_OVERFLOW :
+                        res := SysHandleErrorFrame(215, frame, false);
+                STATUS_ACCESS_VIOLATION,
+                STATUS_FLOAT_DENORMAL_OPERAND :
+                        res := SysHandleErrorFrame(216, frame, true);
+                else begin
+                        if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
+                                res  :=  SysHandleErrorFrame(217, frame, true);
+                end;
+        end;
+        syswin32_i386_exception_handler := res;
+end;
+
+
+procedure install_exception_handlers;
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+var
+        oldexceptaddr,
+        newexceptaddr : Longint;
+{$endif SYSTEMEXCEPTIONDEBUG}
+
+begin
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+        asm
+                movl $0,%eax
+                movl %fs:(%eax),%eax
+                movl %eax,oldexceptaddr
+        end;
+{$endif SYSTEMEXCEPTIONDEBUG}
+        SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
+{$ifdef SYSTEMEXCEPTIONDEBUG}
+        asm
+                movl $0,%eax
+                movl %fs:(%eax),%eax
+                movl %eax,newexceptaddr
+        end;
+        if IsConsole then
+                writeln(stderr,'Old exception  ',hexstr(oldexceptaddr,8),
+                        ' new exception  ',hexstr(newexceptaddr,8));
+{$endif SYSTEMEXCEPTIONDEBUG}
+end;
+
+procedure remove_exception_handlers;
+begin
+        SetUnhandledExceptionFilter(nil);
+end;
+
+{$else not i386 (Processor specific !!)}
+procedure install_exception_handlers;
+begin
+end;
+
+procedure remove_exception_handlers;
+begin
+end;
+
+{$endif Set_i386_Exception_handler}
+
+
+{****************************************************************************
+                    Error Message writing using messageboxes
+****************************************************************************}
+
+function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
+   external 'user32' name 'MessageBoxA';
+
+const
+  ErrorBufferLength = 1024;
+var
+  ErrorBuf : array[0..ErrorBufferLength] of char;
+  ErrorLen : longint;
+
+Function ErrorWrite(Var F: TextRec): Integer;
+{
+  An error message should always end with #13#10#13#10
+}
+var
+  p : pchar;
+  i : longint;
+Begin
+  if F.BufPos>0 then
+   begin
+     if F.BufPos+ErrorLen>ErrorBufferLength then
+       i:=ErrorBufferLength-ErrorLen
+     else
+       i:=F.BufPos;
+     Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
+     inc(ErrorLen,i);
+     ErrorBuf[ErrorLen]:=#0;
+   end;
+  if ErrorLen>3 then
+   begin
+     p:=@ErrorBuf[ErrorLen];
+     for i:=1 to 4 do
+      begin
+        dec(p);
+        if not(p^ in [#10,#13]) then
+         break;
+      end;
+   end;
+   if ErrorLen=ErrorBufferLength then
+     i:=4;
+   if (i=4) then
+    begin
+      MessageBox(0,@ErrorBuf,pchar('Error'),0);
+      ErrorLen:=0;
+    end;
+  F.BufPos:=0;
+  ErrorWrite:=0;
+End;
+
+
+Function ErrorClose(Var F: TextRec): Integer;
+begin
+  if ErrorLen>0 then
+   begin
+     MessageBox(0,@ErrorBuf,pchar('Error'),0);
+     ErrorLen:=0;
+   end;
+  ErrorLen:=0;
+  ErrorClose:=0;
+end;
+
+
+Function ErrorOpen(Var F: TextRec): Integer;
+Begin
+  TextRec(F).InOutFunc:=@ErrorWrite;
+  TextRec(F).FlushFunc:=@ErrorWrite;
+  TextRec(F).CloseFunc:=@ErrorClose;
+  ErrorOpen:=0;
+End;
+
+
+procedure AssignError(Var T: Text);
+begin
+  Assign(T,'');
+  TextRec(T).OpenFunc:=@ErrorOpen;
+  Rewrite(T);
+end;
+
+
+
+const
+   Exe_entry_code : pointer = @Exe_entry;
+   Dll_entry_code : pointer = @Dll_entry;
+
+begin
+{ get some helpful informations }
+  GetStartupInfo(@startupinfo);
+{ some misc Win32 stuff }
+  hprevinst:=0;
+  if not IsLibrary then
+    HInstance:=getmodulehandle(GetCommandFile);
+  MainInstance:=HInstance;
+  { No idea how to know this issue !! }
+  IsMultithreaded:=false;
+  cmdshow:=startupinfo.wshowwindow;
+{ to test stack depth }
+  loweststack:=maxlongint;
+{ real test stack depth        }
+{   stacklimit := setupstack;  }
+{ Setup heap }
+  InitHeap;
+  InitExceptions;
+{ Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
+  displayed in and messagebox }
+  StdInputHandle:=longint(GetStdHandle(STD_INPUT_HANDLE));
+  StdOutputHandle:=longint(GetStdHandle(STD_OUTPUT_HANDLE));
+  StdErrorHandle:=longint(GetStdHandle(STD_ERROR_HANDLE));
+  if not IsConsole then
+   begin
+     AssignError(stderr);
+     AssignError(stdout);
+     Assign(Output,'');
+     Assign(Input,'');
+   end
+  else
+   begin
+     OpenStdIO(Input,fmInput,StdInputHandle);
+     OpenStdIO(Output,fmOutput,StdOutputHandle);
+     OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+     OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+   end;
+{ Arguments }
+  setup_arguments;
+{ Reset IO Error }
+  InOutRes:=0;
+{ Reset internal error variable }
+  errno:=0;
+end.
+
+{
+  $Log$
+  Revision 1.1  2000-10-15 08:19:49  peter
+    * system unit rename for 1.1 branch
+
+  Revision 1.6  2000/10/13 12:01:52  peter
+    * fixed exception callback
+
+  Revision 1.5  2000/10/11 16:05:55  peter
+    * stdcall for callbacks (merged)
+
+  Revision 1.4  2000/09/11 20:19:28  florian
+    * complete exception handling provided by Thomas Schatzl
+
+  Revision 1.3  2000/09/04 19:36:59  peter
+    * new heapalloc calls, patch from Thomas Schatzl
+
+  Revision 1.2  2000/07/13 11:33:58  michael
+  + removed logs
+
+}

rtl/win32/syswin32.pp

@@ -1,1398 +1 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Florian Klaempfl and Pavel Ozerski
-    member of the Free Pascal development team.
-
-    FPC Pascal system unit for the Win32 API.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-unit syswin32;
-interface
-
-{$ifdef SYSTEMDEBUG}
-  {$define SYSTEMEXCEPTIONDEBUG}
-{$endif SYSTEMDEBUG}
-
-{$ifdef i386}
-  {$define Set_i386_Exception_handler}
-{$endif i386}
-
-{ include system-independent routine headers }
-{$I systemh.inc}
-
-{ include heap support headers }
-{$I heaph.inc}
-
-const
-{ Default filehandles }
-   UnusedHandle    : longint = -1;
-   StdInputHandle  : longint = 0;
-   StdOutputHandle : longint = 0;
-   StdErrorHandle  : longint = 0;
-
-   FileNameCaseSensitive : boolean = true;
-
-type
-  TStartupInfo=packed record
-    cb : longint;
-    lpReserved : Pointer;
-    lpDesktop : Pointer;
-    lpTitle : Pointer;
-    dwX : longint;
-    dwY : longint;
-    dwXSize : longint;
-    dwYSize : longint;
-    dwXCountChars : longint;
-    dwYCountChars : longint;
-    dwFillAttribute : longint;
-    dwFlags : longint;
-    wShowWindow : Word;
-    cbReserved2 : Word;
-    lpReserved2 : Pointer;
-    hStdInput : longint;
-    hStdOutput : longint;
-    hStdError : longint;
-  end;
-
-var
-{ C compatible arguments }
-  argc  : longint;
-  argv  : ppchar;
-{ Win32 Info }
-  startupinfo : tstartupinfo;
-  hprevinst,
-  HInstance,
-  MainInstance,
-  cmdshow     : longint;
-  DLLreason,DLLparam:longint;
-  Win32StackTop : Dword;
-{ Thread count for DLL }
-const
-  Thread_count : longint = 0;
-type
-  TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool;
-  TDLL_Entry_Hook = procedure (dllparam : longint);
-
-const
-  Dll_Process_Attach_Hook : TDLL_Process_Entry_Hook = nil;
-  Dll_Process_Detach_Hook : TDLL_Entry_Hook = nil;
-  Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil;
-  Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil;
-
-implementation
-
-{ include system independent routines }
-{$I system.inc}
-
-{ some declarations for Win32 API calls }
-{$I win32.inc}
-
-
-CONST
-  { These constants are used for conversion of error codes }
-  { from win32 i/o errors to tp i/o errors                 }
-  { errors 1 to 18 are the same as in Turbo Pascal         }
-  { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING! }
-
-{  The media is write protected.                   }
-    ERROR_WRITE_PROTECT       =      19;
-{  The system cannot find the device specified.    }
-    ERROR_BAD_UNIT            =      20;
-{  The device is not ready.                        }
-    ERROR_NOT_READY           =      21;
-{  The device does not recognize the command.      }
-    ERROR_BAD_COMMAND         =      22;
-{  Data error (cyclic redundancy check)            }
-    ERROR_CRC                 =      23;
-{  The program issued a command but the            }
-{  command length is incorrect.                    }
-    ERROR_BAD_LENGTH           =     24;
-{  The drive cannot locate a specific              }
-{  area or track on the disk.                      }
-    ERROR_SEEK                 =     25;
-{  The specified disk or diskette cannot be accessed. }
-    ERROR_NOT_DOS_DISK         =     26;
-{  The drive cannot find the sector requested.     }
-    ERROR_SECTOR_NOT_FOUND      =    27;
-{  The printer is out of paper.                    }
-    ERROR_OUT_OF_PAPER          =    28;
-{  The system cannot write to the specified device. }
-    ERROR_WRITE_FAULT           =    29;
-{  The system cannot read from the specified device. }
-    ERROR_READ_FAULT            =    30;
-{  A device attached to the system is not functioning.}
-    ERROR_GEN_FAILURE           =    31;
-{  The process cannot access the file because         }
-{  it is being used by another process.               }
-    ERROR_SHARING_VIOLATION      =   32;
-
-var
-    errno : longint;
-
-{$ASMMODE ATT}
-
-
-   { misc. functions }
-   function GetLastError : DWORD;
-     external 'kernel32' name 'GetLastError';
-
-   { time and date functions }
-   function GetTickCount : longint;
-     external 'kernel32' name 'GetTickCount';
-
-   { process functions }
-   procedure ExitProcess(uExitCode : UINT);
-     external 'kernel32' name 'ExitProcess';
-
-
-   Procedure Errno2InOutRes;
-   Begin
-     { DO NOT MODIFY UNLESS YOU KNOW EXACTLY WHAT YOU ARE DOING }
-     if (errno >= ERROR_WRITE_PROTECT) and (errno <= ERROR_GEN_FAILURE) THEN
-       BEGIN
-          { This is the offset to the Win32 to add to directly map  }
-          { to the DOS/TP compatible error codes when in this range }
-          InOutRes := word(errno)+131;
-       END
-     else
-     { This case is special }
-     if errno=ERROR_SHARING_VIOLATION THEN
-       BEGIN
-         InOutRes :=5;
-       END
-     else
-     { other error codes can directly be mapped }
-         InOutRes := Word(errno);
-     errno:=0;
-   end;
-
-
-{$ifdef dummy}
-procedure int_stackcheck(stack_size:longint);[public,alias: 'STACKCHECK'];
-{
-  called when trying to get local stack if the compiler directive $S
-  is set this function must preserve esi !!!! because esi is set by
-  the calling proc for methods it must preserve all registers !!
-
-  With a 2048 byte safe area used to write to StdIo without crossing
-  the stack boundary
-
-}
-begin
-  asm
-        pushl   %eax
-        pushl   %ebx
-        movl    stack_size,%ebx
-        addl    $2048,%ebx
-        movl    %esp,%eax
-        subl    %ebx,%eax
-        movl    stacklimit,%ebx
-        cmpl    %eax,%ebx
-        jae     .L__short_on_stack
-        popl    %ebx
-        popl    %eax
-        leave
-        ret     $4
-.L__short_on_stack:
-        { can be usefull for error recovery !! }
-        popl    %ebx
-        popl    %eax
-  end['EAX','EBX'];
-  HandleError(202);
-end;
-{$endif dummy}
-
-
-function paramcount : longint;
-begin
-  paramcount := argc - 1;
-end;
-
-   { module functions }
-   function GetModuleFileName(l1:longint;p:pointer;l2:longint):longint;
-     external 'kernel32' name 'GetModuleFileNameA';
-   function GetModuleHandle(p : pointer) : longint;
-     external 'kernel32' name 'GetModuleHandleA';
-   function GetCommandFile:pchar;forward;
-
-function paramstr(l : longint) : string;
-begin
-  if (l>=0) and (l<argc) then
-    paramstr:=strpas(argv[l])
-  else
-    paramstr:='';
-end;
-
-
-procedure randomize;
-begin
-  randseed:=GetTickCount;
-end;
-
-
-{*****************************************************************************
-                              Heap Management
-*****************************************************************************}
-   { memory functions }
-   function GetProcessHeap : DWord;
-     external 'kernel32' name 'GetProcessHeap';
-   function HeapAlloc(hHeap : DWord; dwFlags : DWord; dwBytes : DWord) : Longint;
-     external 'kernel32' name 'HeapAlloc';
-{$IFDEF SYSTEMDEBUG}
-   function HeapSize(hHeap : DWord; dwFlags : DWord; ptr : Pointer) : DWord;
-     external 'kernel32' name 'HeapSize';
-{$ENDIF}
-
-var
-  heap : longint;external name 'HEAP';
-  intern_heapsize : longint;external name 'HEAPSIZE';
-
-function getheapstart:pointer;assembler;
-asm
-        leal    HEAP,%eax
-end ['EAX'];
-
-
-function getheapsize:longint;assembler;
-asm
-        movl    intern_HEAPSIZE,%eax
-end ['EAX'];
-
-
-function Sbrk(size : longint):longint;
-var
-  l : longint;
-begin
-  l := HeapAlloc(GetProcessHeap(), 0, size);
-  if (l = 0) then
-    l := -1;
-{$ifdef DUMPGROW}
-  Writeln('new heap part at $',hexstr(l,8), ' size = ',HeapSize(GetProcessHeap()));
-{$endif}
-  sbrk:=l;
-end;
-
-{ include standard heap management }
-{$I heap.inc}
-
-
-{*****************************************************************************
-                          Low Level File Routines
-*****************************************************************************}
-
-   function WriteFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
-     overlap:pointer):longint;
-     external 'kernel32' name 'WriteFile';
-   function ReadFile(fh:longint;buf:pointer;len:longint;var loaded:longint;
-     overlap:pointer):longint;
-     external 'kernel32' name 'ReadFile';
-   function CloseHandle(h : longint) : longint;
-     external 'kernel32' name 'CloseHandle';
-   function DeleteFile(p : pchar) : longint;
-     external 'kernel32' name 'DeleteFileA';
-   function MoveFile(old,_new : pchar) : longint;
-     external 'kernel32' name 'MoveFileA';
-   function SetFilePointer(l1,l2 : longint;l3 : pointer;l4 : longint) : longint;
-     external 'kernel32' name 'SetFilePointer';
-   function GetFileSize(h:longint;p:pointer) : longint;
-     external 'kernel32' name 'GetFileSize';
-   function CreateFile(name : pointer;access,sharing : longint;
-     security : pointer;how,attr,template : longint) : longint;
-     external 'kernel32' name 'CreateFileA';
-   function SetEndOfFile(h : longint) : longbool;
-     external 'kernel32' name 'SetEndOfFile';
-   function GetFileType(Handle:DWORD):DWord;
-     external 'kernel32' name 'GetFileType';
-
-
-procedure AllowSlash(p:pchar);
-var
-   i : longint;
-begin
-{ allow slash as backslash }
-   for i:=0 to strlen(p) do
-     if p[i]='/' then p[i]:='\';
-end;
-
-function do_isdevice(handle:longint):boolean;
-begin
-  do_isdevice:=(getfiletype(handle)=2);
-end;
-
-
-procedure do_close(h : longint);
-begin
-  if do_isdevice(h) then
-   exit;
-  CloseHandle(h);
-end;
-
-
-procedure do_erase(p : pchar);
-begin
-   AllowSlash(p);
-   if DeleteFile(p)=0 then
-    Begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-end;
-
-
-procedure do_rename(p1,p2 : pchar);
-begin
-  AllowSlash(p1);
-  AllowSlash(p2);
-  if MoveFile(p1,p2)=0 then
-   Begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-   end;
-end;
-
-
-function do_write(h,addr,len : longint) : longint;
-var
-   size:longint;
-begin
-   if writefile(h,pointer(addr),len,size,nil)=0 then
-    Begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-   do_write:=size;
-end;
-
-
-function do_read(h,addr,len : longint) : longint;
-var
-  _result:longint;
-begin
-  if readfile(h,pointer(addr),len,_result,nil)=0 then
-    Begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-  do_read:=_result;
-end;
-
-
-function do_filepos(handle : longint) : longint;
-var
-  l:longint;
-begin
-  l:=SetFilePointer(handle,0,nil,FILE_CURRENT);
-  if l=-1 then
-   begin
-    l:=0;
-    errno:=GetLastError;
-    Errno2InoutRes;
-   end;
-  do_filepos:=l;
-end;
-
-
-procedure do_seek(handle,pos : longint);
-begin
-  if SetFilePointer(handle,pos,nil,FILE_BEGIN)=-1 then
-   Begin
-    errno:=GetLastError;
-    Errno2InoutRes;
-   end;
-end;
-
-
-function do_seekend(handle:longint):longint;
-begin
-  do_seekend:=SetFilePointer(handle,0,nil,FILE_END);
-  if do_seekend=-1 then
-    begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-end;
-
-
-function do_filesize(handle : longint) : longint;
-var
-  aktfilepos : longint;
-begin
-  aktfilepos:=do_filepos(handle);
-  do_filesize:=do_seekend(handle);
-  do_seek(handle,aktfilepos);
-end;
-
-
-procedure do_truncate (handle,pos:longint);
-begin
-   do_seek(handle,pos);
-   if not(SetEndOfFile(handle)) then
-    begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-end;
-
-
-procedure do_open(var f;p : pchar;flags:longint);
-{
-  filerec and textrec have both handle and mode as the first items so
-  they could use the same routine for opening/creating.
-  when (flags and $100)   the file will be append
-  when (flags and $1000)  the file will be truncate/rewritten
-  when (flags and $10000) there is no check for close (needed for textfiles)
-}
-Const
-  file_Share_Read  = $00000001;
-  file_Share_Write = $00000002;
-Var
-  shflags,
-  oflags,cd : longint;
-begin
-  AllowSlash(p);
-{ close first if opened }
-  if ((flags and $10000)=0) then
-   begin
-     case filerec(f).mode of
-       fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
-       fmclosed : ;
-     else
-      begin
-        {not assigned}
-        inoutres:=102;
-        exit;
-      end;
-     end;
-   end;
-{ reset file handle }
-  filerec(f).handle:=UnusedHandle;
-{ convert filesharing }
-  shflags:=0;
-  if ((filemode and fmshareExclusive) = fmshareExclusive) then
-    { no sharing }
-  else
-    if (filemode = fmShareCompat) or ((filemode and fmshareDenyWrite) = fmshareDenyWrite) then
-      shflags := file_Share_Read
-  else
-    if ((filemode and fmshareDenyRead) = fmshareDenyRead) then
-      shflags := file_Share_Write
-  else
-    if ((filemode and fmshareDenyNone) = fmshareDenyNone) then
-      shflags := file_Share_Read + file_Share_Write;
-{ convert filemode to filerec modes }
-  case (flags and 3) of
-   0 : begin
-         filerec(f).mode:=fminput;
-         oflags:=GENERIC_READ;
-       end;
-   1 : begin
-         filerec(f).mode:=fmoutput;
-         oflags:=GENERIC_WRITE;
-       end;
-   2 : begin
-         filerec(f).mode:=fminout;
-         oflags:=GENERIC_WRITE or GENERIC_READ;
-       end;
-  end;
-{ standard is opening and existing file }
-  cd:=OPEN_EXISTING;
-{ create it ? }
-  if (flags and $1000)<>0 then
-   cd:=CREATE_ALWAYS
-{ or append ? }
-  else
-   if (flags and $100)<>0 then
-    cd:=OPEN_ALWAYS;
-{ empty name is special }
-  if p[0]=#0 then
-   begin
-     case FileRec(f).mode of
-       fminput :
-         FileRec(f).Handle:=StdInputHandle;
-       fminout, { this is set by rewrite }
-       fmoutput :
-         FileRec(f).Handle:=StdOutputHandle;
-       fmappend :
-         begin
-           FileRec(f).Handle:=StdOutputHandle;
-           FileRec(f).mode:=fmoutput; {fool fmappend}
-         end;
-     end;
-     exit;
-   end;
-  filerec(f).handle:=CreateFile(p,oflags,shflags,nil,cd,FILE_ATTRIBUTE_NORMAL,0);
-{ append mode }
-  if (flags and $100)<>0 then
-   begin
-     do_seekend(filerec(f).handle);
-     filerec(f).mode:=fmoutput; {fool fmappend}
-   end;
-{ get errors }
-  { handle -1 is returned sometimes !! (PM) }
-  if (filerec(f).handle=0) or (filerec(f).handle=-1) then
-    begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-end;
-
-
-
-
-{*****************************************************************************
-                           UnTyped File Handling
-*****************************************************************************}
-
-{$i file.inc}
-
-{*****************************************************************************
-                           Typed File Handling
-*****************************************************************************}
-
-{$i typefile.inc}
-
-{*****************************************************************************
-                           Text File Handling
-*****************************************************************************}
-
-{$DEFINE EOF_CTRLZ}
-
-{$i text.inc}
-
-{*****************************************************************************
-                           Directory Handling
-*****************************************************************************}
-
-   function CreateDirectory(name : pointer;sec : pointer) : longint;
-     external 'kernel32' name 'CreateDirectoryA';
-   function RemoveDirectory(name:pointer):longint;
-     external 'kernel32' name 'RemoveDirectoryA';
-   function SetCurrentDirectory(name : pointer) : longint;
-     external 'kernel32' name 'SetCurrentDirectoryA';
-   function GetCurrentDirectory(bufsize : longint;name : pchar) : longint;
-     external 'kernel32' name 'GetCurrentDirectoryA';
-
-type
- TDirFnType=function(name:pointer):word;
-
-procedure dirfn(afunc : TDirFnType;const s:string);
-var
-  buffer : array[0..255] of char;
-begin
-  move(s[1],buffer,length(s));
-  buffer[length(s)]:=#0;
-  AllowSlash(pchar(@buffer));
-  if aFunc(@buffer)=0 then
-    begin
-      errno:=GetLastError;
-      Errno2InoutRes;
-    end;
-end;
-
-function CreateDirectoryTrunc(name:pointer):word;
- begin
-  CreateDirectoryTrunc:=CreateDirectory(name,nil);
- end;
-
-procedure mkdir(const s:string);[IOCHECK];
- begin
-  If InOutRes <> 0 then exit;
-  dirfn(TDirFnType(@CreateDirectoryTrunc),s);
- end;
-
-procedure rmdir(const s:string);[IOCHECK];
- begin
-  If InOutRes <> 0 then exit;
-  dirfn(TDirFnType(@RemoveDirectory),s);
- end;
-
-procedure chdir(const s:string);[IOCHECK];
- begin
-  If InOutRes <> 0 then exit;
-  dirfn(TDirFnType(@SetCurrentDirectory),s);
- end;
-
-procedure getdir(drivenr:byte;var dir:shortstring);
-const
-  Drive:array[0..3]of char=(#0,':',#0,#0);
-var
-  defaultdrive:boolean;
-  DirBuf,SaveBuf:array[0..259] of Char;
-begin
-  defaultdrive:=drivenr=0;
-  if not defaultdrive then
-   begin
-    byte(Drive[0]):=Drivenr+64;
-    GetCurrentDirectory(SizeOf(SaveBuf),SaveBuf);
-    SetCurrentDirectory(@Drive);
-   end;
-  GetCurrentDirectory(SizeOf(DirBuf),DirBuf);
-  if not defaultdrive then
-   SetCurrentDirectory(@SaveBuf);
-  dir:=strpas(DirBuf);
-  if not FileNameCaseSensitive then
-   dir:=upcase(dir);
-end;
-
-
-{*****************************************************************************
-                         SystemUnit Initialization
-*****************************************************************************}
-
-   { Startup }
-   procedure GetStartupInfo(p : pointer);
-     external 'kernel32' name 'GetStartupInfoA';
-   function GetStdHandle(nStdHandle:DWORD):THANDLE;
-     external 'kernel32' name 'GetStdHandle';
-
-   { command line/enviroment functions }
-   function GetCommandLine : pchar;
-     external 'kernel32' name 'GetCommandLineA';
-
-
-var
-  ModuleName : array[0..255] of char;
-
-function GetCommandFile:pchar;
-begin
-  GetModuleFileName(0,@ModuleName,255);
-  GetCommandFile:=@ModuleName;
-end;
-
-
-procedure setup_arguments;
-var
-  arglen,
-  count   : longint;
-  argstart,
-  pc      : pchar;
-  quote   : set of char;
-  argsbuf : array[0..127] of pchar;
-begin
-  { create commandline, it starts with the executed filename which is argv[0] }
-  { Win32 passes the command NOT via the args, but via getmodulefilename}
-  count:=0;
-  pc:=getcommandfile;
-  Arglen:=0;
-  repeat
-    Inc(Arglen);
-  until (pc[Arglen]=#0);
-  getmem(argsbuf[count],arglen+1);
-  move(pc^,argsbuf[count]^,arglen);
-  { Now skip the first one }
-  pc:=GetCommandLine;
-  repeat
-    { skip leading spaces }
-    while pc^ in [' ',#9,#13] do
-     inc(pc);
-    case pc^ of
-      #0 : break;
-     '"' : begin
-             quote:=['"'];
-             inc(pc);
-           end;
-    '''' : begin
-             quote:=[''''];
-             inc(pc);
-           end;
-    else
-     quote:=[' ',#9,#13];
-    end;
-  { scan until the end of the argument }
-    argstart:=pc;
-    while (pc^<>#0) and not(pc^ in quote) do
-     inc(pc);
-    { Don't copy the first one, it is already there.}
-    If Count<>0 then
-     begin
-       { reserve some memory }
-       arglen:=pc-argstart;
-       getmem(argsbuf[count],arglen+1);
-       move(argstart^,argsbuf[count]^,arglen);
-       argsbuf[count][arglen]:=#0;
-     end;
-    { skip quote }
-    if pc^ in quote then
-     inc(pc);
-    inc(count);
-  until false;
-{ create argc }
-  argc:=count;
-{ create an nil entry }
-  argsbuf[count]:=nil;
-  inc(count);
-{ create the argv }
-  getmem(argv,count shl 2);
-  move(argsbuf,argv^,count shl 2);
-{ Setup cmdline variable }
-  cmdline:=GetCommandLine;
-end;
-
-
-{*****************************************************************************
-                         System Dependent Exit code
-*****************************************************************************}
-
-  procedure install_exception_handlers;forward;
-  procedure remove_exception_handlers;forward;
-  procedure PascalMain;external name 'PASCALMAIN';
-  procedure fpc_do_exit;external name 'FPC_DO_EXIT';
-  Procedure ExitDLL(Exitcode : longint); forward;
-
-Procedure system_exit;
-begin
-  { don't call ExitProcess inside
-    the DLL exit code !!
-    This crashes Win95 at least PM }
-  if IsLibrary then
-    ExitDLL(ExitCode);
-  if not IsConsole then
-   begin
-     Close(stderr);
-     Close(stdout);
-     { what about Input and Output ?? PM }
-   end;
-  remove_exception_handlers;
-  ExitProcess(ExitCode);
-end;
-
-{$ifdef dummy}
-Function SetUpStack : longint;
-{ This routine does the following :                            }
-{  returns the value of the initial SP - __stklen              }
-begin
-  asm
-    pushl %ebx
-    pushl %eax
-    movl  __stklen,%ebx
-    movl  %esp,%eax
-    subl  %ebx,%eax
-    movl  %eax,__RESULT
-    popl  %eax
-    popl  %ebx
-  end;
-end;
-{$endif}
-
-
-var
-  { value of the stack segment
-    to check if the call stack can be written on exceptions }
-  _SS : longint;
-
-const
-  fpucw : word = $1332;
-
-procedure Exe_entry;[public, alias : '_FPC_EXE_Entry'];
-  begin
-     IsLibrary:=false;
-     { install the handlers for exe only ?
-       or should we install them for DLL also ? (PM) }
-     install_exception_handlers;
-     { This strange construction is needed to solve the _SS problem
-       with a smartlinked syswin32 (PFV) }
-     asm
-        pushl %ebp
-        xorl %ebp,%ebp
-        movl %esp,%eax
-        movl %eax,Win32StackTop
-        movw %ss,%bp
-        movl %ebp,_SS
-        fninit
-        fldcw   fpucw
-        xorl %ebp,%ebp
-        call PASCALMAIN
-        popl %ebp
-     end;
-     { if we pass here there was no error ! }
-     system_exit;
-  end;
-
-Const
-  { DllEntryPoint  }
-     DLL_PROCESS_ATTACH = 1;
-     DLL_THREAD_ATTACH = 2;
-     DLL_PROCESS_DETACH = 0;
-     DLL_THREAD_DETACH = 3;
-Var
-     DLLBuf : Jmp_buf;
-Const
-     DLLExitOK : boolean = true;
-
-function Dll_entry : longbool;[public, alias : '_FPC_DLL_Entry'];
-var
-  res : longbool;
-
-  begin
-     IsLibrary:=true;
-     Dll_entry:=false;
-     case DLLreason of
-       DLL_PROCESS_ATTACH :
-         begin
-           If SetJmp(DLLBuf) = 0 then
-             begin
-               if assigned(Dll_Process_Attach_Hook) then
-                 begin
-                   res:=Dll_Process_Attach_Hook(DllParam);
-                   if not res then
-                     exit(false);
-                 end;
-               PASCALMAIN;
-               Dll_entry:=true;
-             end
-           else
-             Dll_entry:=DLLExitOK;
-         end;
-       DLL_THREAD_ATTACH :
-         begin
-           inc(Thread_count);
-           if assigned(Dll_Thread_Attach_Hook) then
-             Dll_Thread_Attach_Hook(DllParam);
-           Dll_entry:=true; { return value is ignored }
-         end;
-       DLL_THREAD_DETACH :
-         begin
-           dec(Thread_count);
-           if assigned(Dll_Thread_Detach_Hook) then
-             Dll_Thread_Detach_Hook(DllParam);
-           Dll_entry:=true; { return value is ignored }
-         end;
-       DLL_PROCESS_DETACH :
-         begin
-           Dll_entry:=true; { return value is ignored }
-           If SetJmp(DLLBuf) = 0 then
-             begin
-               FPC_DO_EXIT;
-             end;
-           if assigned(Dll_Process_Detach_Hook) then
-             Dll_Process_Detach_Hook(DllParam);
-         end;
-     end;
-  end;
-
-Procedure ExitDLL(Exitcode : longint);
-begin
-    DLLExitOK:=ExitCode=0;
-    LongJmp(DLLBuf,1);
-end;
-
-//
-// Hardware exception handling
-//
-
-{$ifdef Set_i386_Exception_handler}
-
-(*
-  Error code definitions for the Win32 API functions
-
-
-  Values are 32 bit values layed out as follows:
-   3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
-   1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
-  +---+-+-+-----------------------+-------------------------------+
-  |Sev|C|R|     Facility          |               Code            |
-  +---+-+-+-----------------------+-------------------------------+
-
-  where
-      Sev - is the severity code
-          00 - Success
-          01 - Informational
-          10 - Warning
-          11 - Error
-
-      C - is the Customer code flag
-      R - is a reserved bit
-      Facility - is the facility code
-      Code - is the facility's status code
-*)
-
-const
-        SEVERITY_SUCCESS                = $00000000;
-        SEVERITY_INFORMATIONAL  = $40000000;
-        SEVERITY_WARNING                = $80000000;
-        SEVERITY_ERROR                  = $C0000000;
-
-const
-        STATUS_SEGMENT_NOTIFICATION             = $40000005;
-        DBG_TERMINATE_THREAD                    = $40010003;
-        DBG_TERMINATE_PROCESS                   = $40010004;
-        DBG_CONTROL_C                                   = $40010005;
-        DBG_CONTROL_BREAK                               = $40010008;
-
-        STATUS_GUARD_PAGE_VIOLATION             = $80000001;
-        STATUS_DATATYPE_MISALIGNMENT    = $80000002;
-        STATUS_BREAKPOINT                               = $80000003;
-        STATUS_SINGLE_STEP                              = $80000004;
-        DBG_EXCEPTION_NOT_HANDLED               = $80010001;
-
-        STATUS_ACCESS_VIOLATION                 = $C0000005;
-        STATUS_IN_PAGE_ERROR                    = $C0000006;
-        STATUS_INVALID_HANDLE                   = $C0000008;
-        STATUS_NO_MEMORY                                = $C0000017;
-        STATUS_ILLEGAL_INSTRUCTION              = $C000001D;
-        STATUS_NONCONTINUABLE_EXCEPTION = $C0000025;
-        STATUS_INVALID_DISPOSITION              = $C0000026;
-        STATUS_ARRAY_BOUNDS_EXCEEDED    = $C000008C;
-        STATUS_FLOAT_DENORMAL_OPERAND   = $C000008D;
-        STATUS_FLOAT_DIVIDE_BY_ZERO             = $C000008E;
-        STATUS_FLOAT_INEXACT_RESULT             = $C000008F;
-        STATUS_FLOAT_INVALID_OPERATION  = $C0000090;
-        STATUS_FLOAT_OVERFLOW                   = $C0000091;
-        STATUS_FLOAT_STACK_CHECK                = $C0000092;
-        STATUS_FLOAT_UNDERFLOW                  = $C0000093;
-        STATUS_INTEGER_DIVIDE_BY_ZERO   = $C0000094;
-        STATUS_INTEGER_OVERFLOW                 = $C0000095;
-        STATUS_PRIVILEGED_INSTRUCTION   = $C0000096;
-        STATUS_STACK_OVERFLOW                   = $C00000FD;
-        STATUS_CONTROL_C_EXIT                   = $C000013A;
-        STATUS_FLOAT_MULTIPLE_FAULTS    = $C00002B4;
-        STATUS_FLOAT_MULTIPLE_TRAPS             = $C00002B5;
-        STATUS_REG_NAT_CONSUMPTION              = $C00002C9;
-
-        EXCEPTION_EXECUTE_HANDLER               = 1;
-        EXCEPTION_CONTINUE_EXECUTION    = -1;
-        EXCEPTION_CONTINUE_SEARCH               = 0;
-
-        EXCEPTION_MAXIMUM_PARAMETERS    = 15;
-
-        CONTEXT_X86                                     = $00010000;
-        CONTEXT_CONTROL                         = CONTEXT_X86 or $00000001;
-        CONTEXT_INTEGER                         = CONTEXT_X86 or $00000002;
-        CONTEXT_SEGMENTS                        = CONTEXT_X86 or $00000004;
-        CONTEXT_FLOATING_POINT          = CONTEXT_X86 or $00000008;
-        CONTEXT_DEBUG_REGISTERS         = CONTEXT_X86 or $00000010;
-        CONTEXT_EXTENDED_REGISTERS      = CONTEXT_X86 or $00000020;
-
-        CONTEXT_FULL                            = CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS;
-
-        MAXIMUM_SUPPORTED_EXTENSION     = 512;
-
-type
-        PFloatingSaveArea = ^TFloatingSaveArea;
-        TFloatingSaveArea = packed record
-                ControlWord : Cardinal;
-                StatusWord : Cardinal;
-                TagWord : Cardinal;
-                ErrorOffset : Cardinal;
-                ErrorSelector : Cardinal;
-                DataOffset : Cardinal;
-                DataSelector : Cardinal;
-                RegisterArea : array[0..79] of Byte;
-                Cr0NpxState : Cardinal;
-        end;
-
-        PContext = ^TContext;
-        TContext = packed record
-            //
-            // The flags values within this flag control the contents of
-            // a CONTEXT record.
-            //
-                ContextFlags : Cardinal;
-
-            //
-            // This section is specified/returned if CONTEXT_DEBUG_REGISTERS is
-            // set in ContextFlags.  Note that CONTEXT_DEBUG_REGISTERS is NOT
-            // included in CONTEXT_FULL.
-            //
-                Dr0, Dr1, Dr2,
-                Dr3, Dr6, Dr7 : Cardinal;
-
-            //
-            // This section is specified/returned if the
-            // ContextFlags word contains the flag CONTEXT_FLOATING_POINT.
-            //
-                FloatSave : TFloatingSaveArea;
-
-            //
-            // This section is specified/returned if the
-            // ContextFlags word contains the flag CONTEXT_SEGMENTS.
-            //
-                SegGs, SegFs,
-                SegEs, SegDs : Cardinal;
-
-            //
-            // This section is specified/returned if the
-            // ContextFlags word contains the flag CONTEXT_INTEGER.
-            //
-                Edi, Esi, Ebx,
-                Edx, Ecx, Eax : Cardinal;
-
-            //
-            // This section is specified/returned if the
-            // ContextFlags word contains the flag CONTEXT_CONTROL.
-            //
-                Ebp : Cardinal;
-                Eip : Cardinal;
-                SegCs : Cardinal;
-                EFlags, Esp, SegSs : Cardinal;
-
-            //
-            // This section is specified/returned if the ContextFlags word
-            // contains the flag CONTEXT_EXTENDED_REGISTERS.
-            // The format and contexts are processor specific
-            //
-                ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte;
-        end;
-
-type
-        PExceptionRecord = ^TExceptionRecord;
-        TExceptionRecord = packed record
-                ExceptionCode   : Longint;
-                ExceptionFlags  : Longint;
-                ExceptionRecord : PExceptionRecord;
-                ExceptionAddress : Pointer;
-                NumberParameters : Longint;
-                ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer;
-        end;
-
-        PExceptionPointers = ^TExceptionPointers;
-        TExceptionPointers = packed record
-                ExceptionRecord   : PExceptionRecord;
-                ContextRecord     : PContext;
-        end;
-
-     { type of functions that should be used for exception handling }
-        TTopLevelExceptionFilter = function (excep : PExceptionPointers) : Longint;stdcall;
-
-function SetUnhandledExceptionFilter(lpTopLevelExceptionFilter : TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
-        external 'kernel32' name 'SetUnhandledExceptionFilter';
-
-const
-        MaxExceptionLevel = 16;
-        exceptLevel : Byte = 0;
-
-var
-        exceptEip       : array[0..MaxExceptionLevel-1] of Longint;
-        exceptError     : array[0..MaxExceptionLevel-1] of Byte;
-        resetFPU        : array[0..MaxExceptionLevel-1] of Boolean;
-
-{$ifdef SYSTEMEXCEPTIONDEBUG}
-procedure DebugHandleErrorAddrFrame(error, addr, frame : longint);
-begin
-        if IsConsole then begin
-                write(stderr,'HandleErrorAddrFrame(error=',error);
-                write(stderr,',addr=',hexstr(addr,8));
-                writeln(stderr,',frame=',hexstr(frame,8),')');
-        end;
-        HandleErrorAddrFrame(error,addr,frame);
-end;
-{$endif SYSTEMEXCEPTIONDEBUG}
-
-procedure JumpToHandleErrorFrame;
-var
-        eip, ebp, error : Longint;
-begin
-        // save ebp
-        asm
-                movl (%ebp),%eax
-                movl %eax,ebp
-        end;
-        if (exceptLevel > 0) then
-                dec(exceptLevel);
-
-        eip:=exceptEip[exceptLevel];
-        error:=exceptError[exceptLevel];
-{$ifdef SYSTEMEXCEPTIONDEBUG}
-        if IsConsole then
-                writeln(stderr,'In JumpToHandleErrorFrame error=',error);
-        end;
-{$endif SYSTEMEXCEPTIONDEBUG}
-        if resetFPU[exceptLevel] then asm
-                fninit
-                fldcw   fpucw
-        end;
-        { build a fake stack }
-        asm
-                movl   ebp,%eax
-                pushl  %eax
-                movl   eip,%eax
-                pushl  %eax
-                movl   error,%eax
-                pushl  %eax
-                movl   eip,%eax
-                pushl  %eax
-                movl   ebp,%ebp // Change frame pointer
-
-{$ifdef SYSTEMEXCEPTIONDEBUG}
-                jmpl   DebugHandleErrorAddrFrame
-{$else not SYSTEMEXCEPTIONDEBUG}
-                jmpl   HandleErrorAddrFrame
-{$endif SYSTEMEXCEPTIONDEBUG}
-        end;
-end;
-
-function syswin32_i386_exception_handler(excep : PExceptionPointers) : Longint;stdcall;
-var
-        frame,
-        res  : longint;
-
-function SysHandleErrorFrame(error, frame : Longint; must_reset_fpu : Boolean) : Longint;
-begin
-        if (frame = 0) then
-                SysHandleErrorFrame:=EXCEPTION_CONTINUE_SEARCH
-        else begin
-                if (exceptLevel >= MaxExceptionLevel) then exit;
-
-                exceptEip[exceptLevel] := excep^.ContextRecord^.Eip;
-                exceptError[exceptLevel] := error;
-                resetFPU[exceptLevel] := must_reset_fpu;
-                inc(exceptLevel);
-
-                excep^.ContextRecord^.Eip := Longint(@JumpToHandleErrorFrame);
-                excep^.ExceptionRecord^.ExceptionCode := 0;
-
-                SysHandleErrorFrame := EXCEPTION_CONTINUE_EXECUTION;
-{$ifdef SYSTEMEXCEPTIONDEBUG}
-                if IsConsole then begin
-                        writeln(stderr,'Exception Continue Exception set at ',
-                                hexstr(exceptEip[exceptLevel],8));
-                        writeln(stderr,'Eip changed to ',
-                                hexstr(longint(@JumpToHandleErrorFrame),8), ' error=', error);
-                end;
-{$endif SYSTEMEXCEPTIONDEBUG}
-        end;
-end;
-
-begin
-        if excep^.ContextRecord^.SegSs=_SS then
-                frame := excep^.ContextRecord^.Ebp
-        else
-                frame := 0;
-        res := EXCEPTION_CONTINUE_SEARCH;
-{$ifdef SYSTEMEXCEPTIONDEBUG}
-        if IsConsole then Writeln(stderr,'Exception  ',
-                hexstr(excep^.ExceptionRecord^.ExceptionCode, 8));
-{$endif SYSTEMEXCEPTIONDEBUG}
-        case excep^.ExceptionRecord^.ExceptionCode of
-                STATUS_INTEGER_DIVIDE_BY_ZERO,
-                STATUS_FLOAT_DIVIDE_BY_ZERO :
-                        res := SysHandleErrorFrame(200, frame, true);
-                STATUS_ARRAY_BOUNDS_EXCEEDED :
-                        res := SysHandleErrorFrame(201, frame, false);
-                STATUS_STACK_OVERFLOW :
-                        res := SysHandleErrorFrame(202, frame, false);
-                STATUS_FLOAT_OVERFLOW :
-                        res := SysHandleErrorFrame(205, frame, true);
-                STATUS_FLOAT_UNDERFLOW :
-                        res := SysHandleErrorFrame(206, frame, true);
-{excep^.ContextRecord^.FloatSave.StatusWord := excep^.ContextRecord^.FloatSave.StatusWord and $ffffff00;}
-                STATUS_FLOAT_INVALID_OPERATION,
-                STATUS_FLOAT_STACK_CHECK :
-                        res := SysHandleErrorFrame(207, frame, true);
-                STATUS_INTEGER_OVERFLOW :
-                        res := SysHandleErrorFrame(215, frame, false);
-                STATUS_ACCESS_VIOLATION,
-                STATUS_FLOAT_DENORMAL_OPERAND :
-                        res := SysHandleErrorFrame(216, frame, true);
-                else begin
-                        if ((excep^.ExceptionRecord^.ExceptionCode and SEVERITY_ERROR) = SEVERITY_ERROR) then
-                                res  :=  SysHandleErrorFrame(217, frame, true);
-                end;
-        end;
-        syswin32_i386_exception_handler := res;
-end;
-
-
-procedure install_exception_handlers;
-{$ifdef SYSTEMEXCEPTIONDEBUG}
-var
-        oldexceptaddr,
-        newexceptaddr : Longint;
-{$endif SYSTEMEXCEPTIONDEBUG}
-
-begin
-{$ifdef SYSTEMEXCEPTIONDEBUG}
-        asm
-                movl $0,%eax
-                movl %fs:(%eax),%eax
-                movl %eax,oldexceptaddr
-        end;
-{$endif SYSTEMEXCEPTIONDEBUG}
-        SetUnhandledExceptionFilter(@syswin32_i386_exception_handler);
-{$ifdef SYSTEMEXCEPTIONDEBUG}
-        asm
-                movl $0,%eax
-                movl %fs:(%eax),%eax
-                movl %eax,newexceptaddr
-        end;
-        if IsConsole then
-                writeln(stderr,'Old exception  ',hexstr(oldexceptaddr,8),
-                        ' new exception  ',hexstr(newexceptaddr,8));
-{$endif SYSTEMEXCEPTIONDEBUG}
-end;
-
-procedure remove_exception_handlers;
-begin
-        SetUnhandledExceptionFilter(nil);
-end;
-
-{$else not i386 (Processor specific !!)}
-procedure install_exception_handlers;
-begin
-end;
-
-procedure remove_exception_handlers;
-begin
-end;
-
-{$endif Set_i386_Exception_handler}
-
-
-{****************************************************************************
-                    Error Message writing using messageboxes
-****************************************************************************}
-
-function MessageBox(w1:longint;l1,l2:pointer;w2:longint):longint;
-   external 'user32' name 'MessageBoxA';
-
-const
-  ErrorBufferLength = 1024;
-var
-  ErrorBuf : array[0..ErrorBufferLength] of char;
-  ErrorLen : longint;
-
-Function ErrorWrite(Var F: TextRec): Integer;
-{
-  An error message should always end with #13#10#13#10
-}
-var
-  p : pchar;
-  i : longint;
-Begin
-  if F.BufPos>0 then
-   begin
-     if F.BufPos+ErrorLen>ErrorBufferLength then
-       i:=ErrorBufferLength-ErrorLen
-     else
-       i:=F.BufPos;
-     Move(F.BufPtr^,ErrorBuf[ErrorLen],i);
-     inc(ErrorLen,i);
-     ErrorBuf[ErrorLen]:=#0;
-   end;
-  if ErrorLen>3 then
-   begin
-     p:=@ErrorBuf[ErrorLen];
-     for i:=1 to 4 do
-      begin
-        dec(p);
-        if not(p^ in [#10,#13]) then
-         break;
-      end;
-   end;
-   if ErrorLen=ErrorBufferLength then
-     i:=4;
-   if (i=4) then
-    begin
-      MessageBox(0,@ErrorBuf,pchar('Error'),0);
-      ErrorLen:=0;
-    end;
-  F.BufPos:=0;
-  ErrorWrite:=0;
-End;
-
-
-Function ErrorClose(Var F: TextRec): Integer;
-begin
-  if ErrorLen>0 then
-   begin
-     MessageBox(0,@ErrorBuf,pchar('Error'),0);
-     ErrorLen:=0;
-   end;
-  ErrorLen:=0;
-  ErrorClose:=0;
-end;
-
-
-Function ErrorOpen(Var F: TextRec): Integer;
-Begin
-  TextRec(F).InOutFunc:=@ErrorWrite;
-  TextRec(F).FlushFunc:=@ErrorWrite;
-  TextRec(F).CloseFunc:=@ErrorClose;
-  ErrorOpen:=0;
-End;
-
-
-procedure AssignError(Var T: Text);
-begin
-  Assign(T,'');
-  TextRec(T).OpenFunc:=@ErrorOpen;
-  Rewrite(T);
-end;
-
-
-
-const
-   Exe_entry_code : pointer = @Exe_entry;
-   Dll_entry_code : pointer = @Dll_entry;
-
-begin
-{ get some helpful informations }
-  GetStartupInfo(@startupinfo);
-{ some misc Win32 stuff }
-  hprevinst:=0;
-  if not IsLibrary then
-    HInstance:=getmodulehandle(GetCommandFile);
-  MainInstance:=HInstance;
-  { No idea how to know this issue !! }
-  IsMultithreaded:=false;
-  cmdshow:=startupinfo.wshowwindow;
-{ to test stack depth }
-  loweststack:=maxlongint;
-{ real test stack depth        }
-{   stacklimit := setupstack;  }
-{ Setup heap }
-  InitHeap;
-  InitExceptions;
-{ Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
-  displayed in and messagebox }
-  StdInputHandle:=longint(GetStdHandle(STD_INPUT_HANDLE));
-  StdOutputHandle:=longint(GetStdHandle(STD_OUTPUT_HANDLE));
-  StdErrorHandle:=longint(GetStdHandle(STD_ERROR_HANDLE));
-  if not IsConsole then
-   begin
-     AssignError(stderr);
-     AssignError(stdout);
-     Assign(Output,'');
-     Assign(Input,'');
-   end
-  else
-   begin
-     OpenStdIO(Input,fmInput,StdInputHandle);
-     OpenStdIO(Output,fmOutput,StdOutputHandle);
-     OpenStdIO(StdOut,fmOutput,StdOutputHandle);
-     OpenStdIO(StdErr,fmOutput,StdErrorHandle);
-   end;
-{ Arguments }
-  setup_arguments;
-{ Reset IO Error }
-  InOutRes:=0;
-{ Reset internal error variable }
-  errno:=0;
-end.
-
-{
-  $Log$
-  Revision 1.6  2000-10-13 12:01:52  peter
-    * fixed exception callback
-
-  Revision 1.5  2000/10/11 16:05:55  peter
-    * stdcall for callbacks (merged)
-
-  Revision 1.4  2000/09/11 20:19:28  florian
-    * complete exception handling provided by Thomas Schatzl
-
-  Revision 1.3  2000/09/04 19:36:59  peter
-    * new heapalloc calls, patch from Thomas Schatzl
-
-  Revision 1.2  2000/07/13 11:33:58  michael
-  + removed logs
-
-}
+{$i system.pp}