Merged revisions 7438-7445,7450,7456,7463,7467,7475,7479,7486,7504,7506-7509,7522,7527,7534-7536,7558-7559,7563-7565,7567,7570-7571,7573-7576,7586,7589,7592-7594,7607,7612,7615,7619-7620,7622-7623,7626,7628,7631,7633,7646,7663,7677,7681-7683,7689,7697,7704-7712,7725,7736,7738,7740,7744-7746,7751,7753,7764,7767,7769-7770,7776-7777,7788,7830,7836-7839,7846,7849,7862,7864-7865,7869,7872,7877,7882,7927-7929,7953,7961,7967,7971,7986-7987,7990-7994,7998-8000,8004-8006,8008-8012,8016,8027,8034,8036-8037,8039,8044,8046,8048,8051,8060,8071,8075-8076,8082-8083,8087-8089,8095-8096,8099-8100,8136,8187,8190,8203,8206-8207,8212-8213,8215,8225,8227,8233-8239,8262,8302,8307,8309,8316,8318-8319,8336,8338-8340,8396-8397 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

........
  r7438 | florian | 2007-05-24 08:52:50 +0200 (Thu, 24 May 2007) | 1 line
  
  * rtl part of BeOS patch from Olivier Coursiere
........
  r7439 | peter | 2007-05-24 09:08:29 +0200 (Thu, 24 May 2007) | 2 lines
  
    * use elf writer for beos
........
  r7440 | peter | 2007-05-24 09:13:15 +0200 (Thu, 24 May 2007) | 2 lines
  
    * obsolete files
........
  r7443 | peter | 2007-05-24 09:16:17 +0200 (Thu, 24 May 2007) | 2 lines
  
    * beos support from Olivier Coursiere
........
  r8396 | florian | 2007-09-07 21:25:05 +0200 (Fri, 07 Sep 2007) | 1 line
  
  * rtl part of Olivier Coursier's BeOS patch
........
  r8397 | florian | 2007-09-07 21:27:06 +0200 (Fri, 07 Sep 2007) | 1 line
  
  * tests part of Olivier Coursier's BeOS patch
........

git-svn-id: branches/fixes_2_2@8541 -

.gitattributes

@@ -4423,25 +4423,39 @@ rtl/atari/sysatari.pas svneol=native#text/plain
 rtl/atari/system.pas svneol=native#text/plain
 rtl/beos/Makefile svneol=native#text/plain
 rtl/beos/Makefile.fpc svneol=native#text/plain
-rtl/beos/beos.inc svneol=native#text/plain
-rtl/beos/beos.pp svneol=native#text/plain
-rtl/beos/dos.pp svneol=native#text/plain
-rtl/beos/dos_beos.inc svneol=native#text/plain
+rtl/beos/baseunix.pp svneol=native#text/plain
+rtl/beos/bethreads.pp svneol=native#text/plain
+rtl/beos/classes.pp svneol=native#text/plain
 rtl/beos/errno.inc svneol=native#text/plain
+rtl/beos/errnostr.inc svneol=native#text/plain
 rtl/beos/i386/cprt0.as svneol=native#text/plain
 rtl/beos/i386/dllprt.as svneol=native#text/plain
 rtl/beos/i386/dllprt.cpp -text
 rtl/beos/i386/func.as svneol=native#text/plain
 rtl/beos/i386/prt0.as svneol=native#text/plain
-rtl/beos/objinc.inc svneol=native#text/plain
-rtl/beos/osposix.inc svneol=native#text/plain
-rtl/beos/osposixh.inc svneol=native#text/plain
-rtl/beos/posix.pp svneol=native#text/plain
+rtl/beos/osmacro.inc svneol=native#text/plain
+rtl/beos/ossysc.inc svneol=native#text/plain
+rtl/beos/ostypes.inc svneol=native#text/plain
+rtl/beos/ptypes.inc svneol=native#text/plain
+rtl/beos/settimeo.inc svneol=native#text/plain
+rtl/beos/signal.inc svneol=native#text/plain
+rtl/beos/suuid.inc svneol=native#text/plain
 rtl/beos/syscall.inc svneol=native#text/plain
-rtl/beos/sysfiles.inc svneol=native#text/plain
+rtl/beos/syscallh.inc svneol=native#text/plain
+rtl/beos/sysconst.inc svneol=native#text/plain
+rtl/beos/sysheap.inc -text
+rtl/beos/sysnr.inc svneol=native#text/plain
+rtl/beos/sysos.inc svneol=native#text/plain
+rtl/beos/sysosh.inc svneol=native#text/plain
 rtl/beos/system.pp svneol=native#text/plain
-rtl/beos/sysutils.pp svneol=native#text/plain
-rtl/beos/timezone.inc svneol=native#text/plain
+rtl/beos/termio.pp svneol=native#text/plain
+rtl/beos/termios.inc svneol=native#text/plain
+rtl/beos/termiosproc.inc svneol=native#text/plain
+rtl/beos/tthread.inc svneol=native#text/plain
+rtl/beos/unixsock.inc svneol=native#text/plain
+rtl/beos/unxconst.inc svneol=native#text/plain
+rtl/beos/unxfunc.inc svneol=native#text/plain
+rtl/beos/unxsockh.inc svneol=native#text/plain
 rtl/bsd/bsd.pas -text
 rtl/bsd/bunxfunch.inc svneol=native#text/plain
 rtl/bsd/bunxsysc.inc svneol=native#text/plain
@@ -6402,6 +6416,10 @@ tests/test/cg/cdecl/taoc4.pp svneol=native#text/plain
 tests/test/cg/cdecl/taoc5.pp svneol=native#text/plain
 tests/test/cg/cdecl/taoc6.pp svneol=native#text/plain
 tests/test/cg/obj/amiga/m68k/ctest.o -text
+tests/test/cg/obj/beos/i386/ctest.o -text
+tests/test/cg/obj/beos/i386/tcext3.o -text
+tests/test/cg/obj/beos/i386/tcext4.o -text
+tests/test/cg/obj/beos/i386/tcext5.o -text
 tests/test/cg/obj/ctest.c -text
 tests/test/cg/obj/darwin/i386/ctest.o -text
 tests/test/cg/obj/darwin/i386/tcext3.o -text

compiler/systems/i_beos.pas

@@ -57,7 +57,7 @@ unit i_beos;
             Cprefix      : '';
             newline      : #10;
             dirsep       : '/';
-            assem        : as_gas;
+            assem        : as_i386_elf32;
             assemextern  : as_gas;
             link         : nil;
             linkextern   : nil;

fv/platform.inc

@@ -206,6 +206,12 @@ FOR FPC THESE ARE THE TRANSLATIONS
   {$DEFINE OS_UNIX}
 {$ENDIF}
 
+{$IFDEF BEOS}
+  {$UNDEF OS_DOS}
+  {$DEFINE OS_BEOS}
+  {$DEFINE OS_UNIX}
+{$ENDIF}
+
 {------------------------------------------------}
 {  FPC Netware COMPILER changes operating system }
 {------------------------------------------------}

packages/base/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/09/12]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/08/25]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded
@@ -345,7 +345,7 @@ ifeq ($(FULL_TARGET),sparc-embedded)
 override TARGET_DIRS+=hash paszlib pasjpeg regexpr netdb
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_DIRS+=hash paszlib pasjpeg regexpr netdb  gdbint libasync mysql ibase postgres oracle odbc pthreads sqlite imagemagick dbus httpd libc
+override TARGET_DIRS+=hash paszlib pasjpeg regexpr netdb  gdbint libasync mysql ibase postgres oracle odbc pthreads sqlite imagemagick dbus httpd
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_DIRS+=hash paszlib pasjpeg regexpr netdb  gdbint libasync mysql ibase postgres oracle odbc sqlite pthreads imagemagick httpd
@@ -1933,7 +1933,6 @@ TARGET_DIRS_SQLITE=1
 TARGET_DIRS_IMAGEMAGICK=1
 TARGET_DIRS_DBUS=1
 TARGET_DIRS_HTTPD=1
-TARGET_DIRS_LIBC=1
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 TARGET_DIRS_HASH=1

packages/base/gdbint/gdbint.pp

@@ -219,6 +219,30 @@ interface
   {$LINKLIB user32}
 {$endif win32}
 
+{$ifdef beos}
+  { still need some work... stollen from netbsd}
+  {$undef NotImplemented}
+  {$LINKLIB gdb}
+  {$ifdef GDB_HAS_SIM}
+    {$LINKLIB sim}
+  {$endif GDB_HAS_SIM}
+  {$LINKLIB bfd}
+  {$LINKLIB readline}
+  {$LINKLIB opcodes}
+  {$LINKLIB history}
+  {$LINKLIB iberty}
+  {$LINKLIB ncurses}
+  {$LINKLIB m}
+  {$LINKLIB iberty}
+  {$LINKLIB intl}
+  {$ifdef GDB_USES_EXPAT_LIB}
+    {$LINKLIB expat}
+  {$endif GDB_USES_EXPAT_LIB}
+  { does not seem to exist on netbsd LINKLIB dl}
+  {$LINKLIB c}
+  {$LINKLIB gcc}
+{$endif beos}
+
 {$ifdef go32v2}
   {$define supportexceptions}
 {$endif go32v2}

packages/base/libasync/Makefile.fpc

@@ -14,6 +14,7 @@ fpcpackage=y
 
 [compiler]
 sourcedir_linux=unix
+sourcedir_beos=unix
 sourcedir_freebsd=unix
 sourcedir_darwin=unix
 sourcedir_solaris=unix

rtl/beos/Makefile.fpc

@@ -7,12 +7,16 @@ main=rtl
 
 [target]
 loaders=prt0 cprt0 func dllprt
-units=system posix objpas macpas strings \
-      beos \
-      dos matrix \
-      sysutils fgl classes typinfo math varutils fmtbcd \
-      cpu mmx getopts heaptrc lineinfo lnfodwrf variants types sysconst
-rsts=math varutils typinfo sysconst
+units=system baseunix unixtype ctypes objpas macpas strings \
+#      beos \
+      errors dos dl objects \
+      sysconst sysutils \
+      types charset ucomplex typinfo classes math varutils \
+      cpu mmx getopts heaptrc lineinfo lnfodwrf variants \
+      rtlconsts syscall unix unixutil strutils termio initc \
+      cmem crt video mouse keyboard \
+      dateutils fmtbcd sockets dynlibs cwstring
+rsts=math varutils typinfo variants sysconst rtlconsts dateutils
 
 [require]
 nortl=y
@@ -26,8 +30,19 @@ target=beos
 cpu=i386
 
 [compiler]
-includedir=$(INC) $(PROCINC) $(UNIXINC)
-sourcedir=$(INC) $(PROCINC) $(UNIXINC)
+includedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET) $(OSPROCINC)
+sourcedir=$(INC) $(PROCINC) $(UNIXINC) $(CPU_TARGET) 
+targetdir=.
+
+[lib]
+libname=libfprtl.so
+libversion=2.0.0
+libunits=$(SYSTEMUNIT) objpas strings \
+      unix  \
+      dos crt objects printer \
+      sysutils typinfo math \
+      $(CPU_UNITS) getopts heaptrc \
+      errors sockets ipc dynlibs
 
 
 [prerules]
@@ -45,12 +60,13 @@ ifdef RELEASE
 override FPCOPT+=-Ur
 endif
 
+override FPCOPT+= -dHASUNIX -n -dFPC_USE_LIBC -Si
+
 # Paths
 OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 
 [rules]
-.NOTPARALLEL:
 # Get the system independent include file names.
 # This will set the following variables :
 # SYSINCNAMES
@@ -65,7 +81,7 @@ SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 
 # Put system unit dependencies together.
 SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
-
+SYSTEMUNIT=system
 
 #
 # Loaders
@@ -87,29 +103,55 @@ dllprt$(OEXT) : $(CPU_TARGET)/dllprt.as
 # system Units (system, Objpas, Strings)
 #
 
-system$(PPUEXT) : system.pp sysfiles.inc $(SYSDEPS)
-        $(COMPILER) -Us -Sg system.pp
+system$(PPUEXT) : system.pp $(SYSDEPS) $(UNIXINC)/sysunixh.inc
+        $(COMPILER) -Us -Sg $(SYSTEMUNIT).pp
+
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
 
-objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
-        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+dateutils$(PPUEXT): $(OBJPASDIR)/dateutils.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) types$(PPUEXT)
+	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
 
-strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
-                   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
-                   system$(PPUEXT)
+strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
+                   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
+                   $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # system Dependent Units
 #
 
-beos$(PPUEXT) : beos.pp system$(PPUEXT)
+# beos$(PPUEXT) : beos.pp $(SYSTEMUNIT)$(PPUEXT)
+
+baseunix$(PPUEXT) : $(UNIXINC)/unixtype.pp $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Fi$(UNIXINC) -Fu$(UNIXINC) baseunix.pp
+
+unix$(PPUEXT) : $(UNIXINC)/unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
+                 sysconst.inc $(UNIXINC)/timezone.inc \
+                 baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+linux$(PPUEXT) : baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 #
 # TP7 Compatible RTL Units
 #
 
-dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
-               beos$(PPUEXT) system$(PPUEXT)
+# dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+#               beos$(PPUEXT) system$(PPUEXT)
 
+dos$(PPUEXT) : $(UNIXINC)/dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) \
+               unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -I$(INC) -Fu$(INC) $(UNIXINC)/dos.pp
+                       
+crt$(PPUEXT) : crt.pp $(INC)/textrec.inc termio.pp system$(PPUEXT)
+        $(COMPILER) $(UNIXINC)/crt.pp $(REDIR)
+
+video$(PPUEXT) : video.pp $(INC)/textrec.inc termio.pp system$(PPUEXT)
+        $(COMPILER) -Fu$(UNIXINC) $(UNIXINC)/video.pp $(REDIR)
+        
+keyboard$(PPUEXT) : $(UNIXINC)/keyboard.pp mouse$(PPUEXT) $(INC)/textrec.inc termio.pp system$(PPUEXT)
+        $(COMPILER) $(UNIXINC)/keyboard.pp $(REDIR) -dNOGPM
+
+                       
 objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
 
 #
@@ -117,12 +159,13 @@ objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
 #
 
 sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
-                    objpas$(PPUEXT) beos$(PPUEXT) sysconst$(PPUEXT)
-        $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+                    objpas$(PPUEXT) $(OBJPASDIR)/sysconst$(PPUEXT) # beos$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR)/sysutils -Fi$(UNIXINC) $(UNIXINC)/sysutils.pp
 
 classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
-                   sysutils$(PPUEXT) typinfo$(PPUEXT) fgl$(PPUEXT)
-        $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+                   sysutils$(PPUEXT) $(OBJPASDIR)/typinfo$(PPUEXT) types$(PPUEXT) $(OBJPASDIR)/rtlconsts$(PPUEXT) 
+#                   $(UNIXINC)/systhrd$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR) -Fi$(OBJPASDIR)/classes classes.pp
 
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
         $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
@@ -135,16 +178,23 @@ gettext$(PPUEXT): $(OBJPASDIR)/gettext.pp objpas$(PPUEXT) sysutils$(PPUEXT)
 
 varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
                     $(OBJPASDIR)/varutilh.inc varutils.pp
-        $(COMPILER) -I$(OBJPASDIR) $(UNIXINC)/varutils.pp
+				$(COMPILER) -Fi$(OBJPASDIR) $(UNIXINC)/varutils.pp
 
 fmtbcd$(PPUEXT) : $(OBJPASDIR)/fmtbcd.pp objpas$(PPUEXT) sysutils$(PPUEXT) variants$(PPUEXT) classes$(PPUEXT) system$(PPUEXT)
         $(COMPILER) $(OBJPASDIR)/fmtbcd.pp
 
 types$(PPUEXT) : $(OBJPASDIR/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
-        $(COMPILER) $(OBJPASDIR)/types.pp
+       	$(COMPILER) $(OBJPASDIR)/types.pp
+
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/sysconst.pp
 
-fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp objpas$(PPUEXT) types$(PPUEXT) system$(PPUEXT) sysutils$(PPUEXT)
-        $(COMPILER) $(OBJPASDIR)/fgl.pp
+rtlconsts$(PPUEXT) : $(OBJPASDIR)/rtlconsts.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+         $(COMPILER) $(OBJPASDIR)/rtlconsts.pp
+
+strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) \
+                    sysutils$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/strutils.pp
 
 #
 # Mac Pascal Model
@@ -152,7 +202,7 @@ fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp objpas$(PPUEXT) types$(PPUEXT) system$(PPUEXT
 
 macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
         $(COMPILER) $(INC)/macpas.pp $(REDIR)
-
+        
 #
 # Other system-independent RTL Units
 #
@@ -164,12 +214,39 @@ mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
 getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
 
 heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
-        $(COMPILER) -Sg $(INC)/heaptrc.pp
+        $(COMPILER) $(INC)/heaptrc.pp
 
 lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
 
-lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp system$(PPUEXT)
+lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp $(SYSTEMUNIT)$(PPUEXT) strings$(PPUEXT)
+
+charset$(PPUEXT) : $(INC)/charset.pp objpas$(PPUEXT)
 
+ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) math$(PPUEXT)
 
 #
 # Other system-dependent RTL Units
+#
+
+termio$(PPUEXT) : baseunix$(PPUEXT)
+
+mouse$(PPUEXT) : baseunix$(PPUEXT) video$(PPUEXT)
+        $(COMPILER) $(UNIXINC)/mouse.pp $(REDIR) -dNOGPM
+
+dl$(PPUEXT) : $(SYSTEMUNIT)$(PPUEXT) unixtype$(PPUEXT)
+
+sockets$(PPUEXT) : $(UNIXINC)/sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
+                   unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+
+dynlibs$(PPUEXT) : $(INC)/dynlibs.pas $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
+
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+
+ctypes$(PPUEXT) :  $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT)
+
+variants$(PPUEXT) : $(INC)/variants.pp sysutils$(PPUEXT) sysconst$(PPUEXT) varutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) math$(PPUEXT)
+        $(COMPILER) -Fi$(INC) $(INC)/variants.pp
+
+cwstring$(PPUEXT) : $(UNIXINC)/cwstring.pp $(SYSTEMUNIT)$(PPUEXT) sysutils$(PPUEXT) baseunix$(PPUEXT) unix$(PPUEXT) unixtype$(PPUEXT) ctypes$(PPUEXT)
+
+

rtl/beos/baseunix.pp

@@ -0,0 +1,147 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Carl Eric Codere development team
+
+    Base Unix unit modelled after POSIX 2001.
+
+    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 BaseUnix;
+
+Interface
+
+uses UnixType;
+
+{$i aliasptp.inc}
+
+{$packrecords C}
+{$define oldreaddir}		// Keep using readdir system call instead
+				// of userland getdents stuff.
+{$define usedomain}		// Allow uname with "domain" entry.
+				// (which is a GNU extension)
+{$define posixworkaround}	// Temporary ugly workaround for signal handler.
+				// (mainly until baseunix migration is complete)
+
+{$ifndef FPC_USE_LIBC}
+{$define FPC_USE_SYSCALL}
+{$endif}
+
+{$i errno.inc}		{ Error numbers }
+{$i ostypes.inc}
+
+{$ifdef FPC_USE_LIBC}
+const clib = 'root';
+const netlib = 'net';
+{$i oscdeclh.inc}
+{$ELSE}
+{$i bunxh.inc}		{ Functions}
+{$ENDIF}
+
+function fpgeterrno:longint; 
+procedure fpseterrno(err:longint); 
+
+{$ifndef ver1_0}
+property errno : cint read fpgeterrno write fpseterrno;
+{$endif}
+
+{$i bunxovlh.inc}
+
+{$ifdef FPC_USE_LIBC}
+{$ifdef beos}
+function  fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
+Function fpFlock (var fd : text; mode : longint) : cint; 
+Function fpFlock (var fd : File; mode : longint) : cint; 
+Function fpFlock (fd, mode : longint) : cint; 
+Function  FpNanoSleep  (req : ptimespec;rem : ptimespec):cint;
+{$endif}
+{$endif}
+
+{ Fairly portable constants. I'm not going to waste time to duplicate and alias
+them anywhere}
+
+Const
+  MAP_FAILED    = pointer(-1);  { mmap() has failed }
+  MAP_SHARED    =  $1;          { Share changes }
+  MAP_PRIVATE   =  $2;          { Changes are private }
+  MAP_TYPE      =  $f;          { Mask for type of mapping }
+  MAP_FIXED     = $10;          { Interpret addr exactly }
+
+// MAP_ANON(YMOUS) is OS dependant but used in the RTL and in ostypes.inc
+// Under BSD without -YMOUS, so alias it:
+  MAP_ANON	= MAP_ANONYMOUS;
+
+  PROT_READ     =  $1;          { page can be read }
+  PROT_WRITE    =  $2;          { page can be written }
+  PROT_EXEC     =  $4;          { page can be executed }
+  PROT_NONE     =  $0;          { page can not be accessed }
+
+implementation
+
+{$i genfuncs.inc}       // generic calls. (like getenv)
+{$I gensigset.inc}     // general sigset funcs implementation.
+{$I genfdset.inc}      // general fdset funcs.
+
+{$ifndef FPC_USE_LIBC}
+  {$i syscallh.inc}       // do_syscall declarations themselves
+  {$i sysnr.inc}          // syscall numbers.
+  {$i bsyscall.inc}  			// cpu specific syscalls
+  {$i bunxsysc.inc}       // syscalls in system unit.
+//  {$i settimeo.inc}
+{$endif}
+{$i settimeo.inc}
+{$i osmacro.inc}        { macro implenenations }
+{$i bunxovl.inc}        { redefs and overloads implementation }
+
+{$ifndef ver1_0}
+function fpgeterrno:longint; external name 'FPC_SYS_GETERRNO';
+procedure fpseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
+{$else}
+// workaround for 1.0.10 bugs.
+
+function intgeterrno:longint; external name 'FPC_SYS_GETERRNO';
+procedure intseterrno(err:longint); external name 'FPC_SYS_SETERRNO';
+
+function fpgeterrno:longint; 
+begin
+  fpgeterrno:=intgeterrno;
+end;
+
+procedure fpseterrno(err:longint); 
+begin
+  intseterrno(err);
+end;
+
+{$endif}
+
+function fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
+begin
+  fpsettimeofday := settimeofday(tp, tzp);
+end;
+
+Function fpFlock (var fd : File; mode : longint) : cint; 
+begin
+  {$warning TODO BeOS fpFlock implementation}  
+end;
+
+Function fpFlock (var fd : Text; mode : longint) : cint; 
+begin
+  {$warning TODO BeOS fpFlock implementation}  
+end;
+
+Function fpFlock (fd, mode : longint) : cint; 
+begin
+  {$warning TODO BeOS fpFlock implementation}  
+end;
+
+Function  FpNanoSleep  (req : ptimespec;rem : ptimespec):cint;
+begin
+  {$warning TODO BeOS FpNanoSleep implementation}  
+end;
+
+end.

rtl/beos/beos.inc

@@ -1,543 +0,0 @@
-{
-    Copyright (c) 2001 by Carl Eric Codere
-
-
-    Implements BeOS system calls and types
-
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-
- ****************************************************************************
-}
-const
-      { BeOS specific calls }
-      syscall_nr_create_area = $14;
-      syscall_nr_resize_area = $08;
-      syscall_nr_delete_area = $15;
-      syscall_nr_load_image  = $34;
-      syscall_nr_wait_thread = $22;
-      syscall_nr_rstat       = $30;
-      syscall_nr_statfs      = $5F;
-      syscall_nr_get_team_info = $3b;
-      syscall_nr_kill_team   = $3a;
-      syscall_nr_get_system_info = $56;
-      syscall_nr_kget_tzfilename = $AF;
-      syscall_nr_get_next_image_info = $3C;
-
-const
-{ -----
-  system-wide constants;
------ *}
-  MAXPATHLEN = PATH_MAX;
-  B_FILE_NAME_LENGTH = NAME_MAX;
-  B_OS_NAME_LENGTH  =   32;
-  B_PAGE_SIZE    =   4096;
-
-
-
-
-(* -----
-  types
------ *)
-
-
-type area_id = longint;
-type port_id = longint;
-type sem_id = longint;
-type thread_id = longint;
-type team_id = longint;
-type bigtime_t = int64;
-type status_t = longint;
-
-
-{*************************************************************}
-{*********************** KERNEL KIT **************************}
-{*************************************************************}
-{ ------------------------- Areas --------------------------- }
-const
-      { create_area constant definitions }
-      { lock type }
-      B_NO_LOCK        = 0;
-      B_LAZY_LOCK      = 1;
-      B_FULL_LOCK      = 2;
-      B_CONTIGUOUS     = 3;
-      B_LOMEM          = 4;
-      { address type }
-      B_ANY_ADDRESS    = 0;
-      B_EXACT_ADDRESS  = 1;
-      B_BASE_ADDRESS   = 2;
-      B_CLONE_ADDRESS  = 3;
-      B_ANY_KERNEL_ADDRESS = 4;
-      { protection bits }
-      B_READ_AREA     = 1;
-      B_WRITE_AREA    = 2;
-
-
-type
-    area_info = packed record
-      area:       area_id;
-      name:       array[0..B_OS_NAME_LENGTH-1] of char;
-      size:       size_t;
-      lock:       cardinal;
-      protection: cardinal;
-      team:       team_id;
-      ram_size:   cardinal;
-      copy_count: cardinal;
-      in_count:   cardinal;
-      out_count:  cardinal;
-      address:    pointer;
-    end;
-
-
-    function create_area(name : pchar; var addr : longint;
-      addr_typ : longint; size : longint; lock_type: longint; protection : longint): area_id;
-    var
-     args : SysCallArgs;
-    begin
-     args.param[1] := cint(name);
-     args.param[2] := cint(@addr);
-     args.param[3] := cint(addr_typ);
-     args.param[4] := cint(size);
-     args.param[5] := cint(lock_type);
-     args.param[6] := cint(protection);
-     create_area := SysCall(syscall_nr_create_area, args);
-    end;
-
-
-    function delete_area(area : area_id): status_t;
-    var
-     args: SysCallargs;
-    begin
-     args.param[1] := cint(area);
-     delete_area:= SysCall(syscall_nr_delete_area, args);
-    end;
-
-
-    function resize_area(area: area_id; new_size: size_t): status_t;
-    var
-     args: SysCallArgs;
-    begin
-     args.param[1] := cint(area);
-     args.param[2] := cint(new_size);
-     resize_area := SysCall(syscall_nr_resize_area, args);
-    end;
-
-    { the buffer should at least have MAXPATHLEN+1 bytes in size }
-    function kget_tzfilename(buffer:pchar): cint;
-    var
-     args: SysCallArgs;
-    begin
-      args.param[1] := cint(buffer);
-      kget_tzfilename := SysCall(syscall_nr_kget_tzfilename,args);
-    end;
-
-(*
-extern _IMPEXP_ROOT area_id    clone_area(const char *name, void **dest_addr,
-                       uint32 addr_spec, uint32 protection,
-                       area_id source);
-
-
-extern _IMPEXP_ROOT area_id    find_area(const char *name);
-extern _IMPEXP_ROOT area_id    area_for(void *addr);
-extern _IMPEXP_ROOT status_t  set_area_protection(area_id id,
-                    uint32 new_protection);
-
-
-extern _IMPEXP_ROOT status_t  _get_area_info(area_id id, area_info *ainfo,
-                    size_t size);
-extern _IMPEXP_ROOT status_t  _get_next_area_info(team_id team, int32 *cookie,
-                    area_info *ainfo, size_t size);
-*)
-{ ------------------------- Threads --------------------------- }
-
-
-
-
-const
-   { thread state }
-   B_THREAD_RUNNING = 1;
-   B_THREAD_READY   = 2;
-   B_THREAD_RECEIVING = 3;
-   B_THREAD_ASLEEP    = 4;
-   B_THREAD_SUSPENDED = 5;
-   B_THREAD_WAITING   = 6;
-   { thread priorities }
-   B_LOW_PRIORITY        =    5;
-   B_NORMAL_PRIORITY     =    10;
-   B_DISPLAY_PRIORITY    =    15;
-   B_URGENT_DISPLAY_PRIORITY  =    20;
-   B_REAL_TIME_DISPLAY_PRIORITY=    100;
-   B_URGENT_PRIORITY     =    110;
-   B_REAL_TIME_PRIORITY  =    120;
-
-
-type
-    thread_info = packed record
-       thread: thread_id;
-       team: team_id;
-       name: array[0..B_OS_NAME_LENGTH-1] of char;
-       state: longint; { thread_state enum }
-       priority:longint;
-       sem:sem_id;
-       user_time:bigtime_t;
-       kernel_time:bigtime_t;
-       stack_base:pointer;
-       stack_end:pointer;
-    end;
-
-
-{
-
-
-extern _IMPEXP_ROOT thread_id spawn_thread (
-  thread_func    function_name,
-  const char     *thread_name,
-  int32      priority,
-  void      *arg
-);
-
-
-extern _IMPEXP_ROOT thread_id  find_thread(const char *name);
-extern _IMPEXP_ROOT status_t  kill_thread(thread_id thread);
-extern _IMPEXP_ROOT status_t  resume_thread(thread_id thread);
-extern _IMPEXP_ROOT status_t  suspend_thread(thread_id thread);
-extern _IMPEXP_ROOT status_t  rename_thread(thread_id thread, const char *new_name);
-extern _IMPEXP_ROOT status_t  set_thread_priority (thread_id thread, int32 new_priority);
-extern _IMPEXP_ROOT void    exit_thread(status_t status);
-
-
-extern _IMPEXP_ROOT status_t  _get_thread_info(thread_id thread, thread_info *info, size_t size);
-extern _IMPEXP_ROOT status_t  _get_next_thread_info(team_id tmid, int32 *cookie, thread_info *info, size_t size);
-
-
-
-
-
-
-extern _IMPEXP_ROOT status_t  send_data(thread_id thread,
-                    int32 code,
-                    const void *buf,
-                    size_t buffer_size);
-
-
-extern _IMPEXP_ROOT status_t  receive_data(thread_id *sender,
-                   void *buf,
-                   size_t buffer_size);
-
-
-extern _IMPEXP_ROOT bool    has_data(thread_id thread);
-
-
-
-
-extern _IMPEXP_ROOT status_t  snooze(bigtime_t microseconds);
-
-
-/*
-  Right now you can only snooze_until() on a single time base, the
-  system time base given by system_time().  The "time" argument is
-  the time (in the future) relative to the current system_time() that
-  you want to snooze until.  Eventually there will be multiple time
-  bases (and a way to find out which ones exist) but for now just pass
-  the value B_SYSTEM_TIMEBASE.
-*/
-extern _IMPEXP_ROOT status_t  snooze_until(bigtime_t time, int timebase);
-#define B_SYSTEM_TIMEBASE  (0)
-
-
-}
-
-
-
-
-    function wait_for_thread(thread: thread_id; var status : status_t): status_t;
-     var
-      args: SysCallArgs;
-      i: longint;
-     begin
-       args.param[1] := cint(thread);
-       args.param[2] := cint(@status);
-       wait_for_thread := SysCall(syscall_nr_wait_thread, args);
-     end;
-
-
-{ ------------------------- Teams --------------------------- }
-
-
-const
-     B_SYSTEM_TEAM  = 2;
-
-
-type
-    team_info = packed record
-     team:    team_id;
-     image_count:   longint;
-     thread_count:  longint;
-     area_count:    longint;
-     debugger_nub_thread: thread_id;
-     debugger_nub_port: port_id;
-     argc:longint;     (* number of args on the command line *)
-     args: array[0..63] of char;  {* abbreviated command line args *}
-     uid: uid_t;
-     gid: gid_t;
-    end;
-{
-extern _IMPEXP_ROOT status_t  _get_next_team_info(int32 *cookie, team_info *info, size_t size);
-}
-
-
-    function get_team_info(team: team_id; var info : team_info): status_t;
-     var
-      args: SysCallArgs;
-     begin
-       args.param[1] := cint(team);
-       args.param[2] := cint(@info);
-       get_team_info := SysCall(syscall_nr_get_team_info, args);
-     end;
-
-
-    function kill_team(team: team_id): status_t;
-     var
-      args: SysCallArgs;
-     begin
-       args.param[1] := cint(team);
-       kill_team := SysCall(syscall_nr_kill_team, args);
-     end;
-
-
-{ ------------------------- Images --------------------------- }
-
-
-type image_id = longint;
-
-
-    { image types }
-const
-   B_APP_IMAGE     = 1;
-   B_LIBRARY_IMAGE = 2;
-   B_ADD_ON_IMAGE  = 3;
-   B_SYSTEM_IMAGE  = 4;
-type
-    image_info = packed record
-     id      : image_id;
-     _type   : longint;
-     sequence: longint;
-     init_order: longint;
-     init_routine: pointer;
-     term_routine: pointer;
-     device: dev_t;
-     node: ino_t;
-     name: array[0..MAXPATHLEN-1] of char;
-     text: pointer;
-     data: pointer;
-     text_size: longint;
-     data_size: longint;
-    end;
-
-
-
-  function get_next_image_info(team : team_id; var cookie: longint;var info : image_info): status_t;
-     var
-      args: SysCallArgs;
-   begin
-       args.param[1] := cint(team);
-       args.param[2] := cint(@cookie);
-       args.param[3] := cint(@info);
-       args.param[4] := cint(sizeof(image_info));
-       get_next_image_info := SysCall(syscall_nr_get_next_image_info, args);
-   end;
-
-{
-extern _IMPEXP_ROOT image_id  load_add_on(const char *path);
-extern _IMPEXP_ROOT status_t  unload_add_on(image_id imid);
-
-
-/* private; use the macros, below */
-extern _IMPEXP_ROOT status_t  _get_image_info (image_id image,
-                  image_info *info, size_t size);
-extern _IMPEXP_ROOT status_t  _get_next_image_info (team_id team, int32 *cookie,
-                  image_info *info, size_t size);
-
-
-}
-(*----- symbol types and functions ------------------------*)
-
-
-const B_SYMBOL_TYPE_DATA = $1;
-const B_SYMBOL_TYPE_TEXT = $2;
-const B_SYMBOL_TYPE_ANY  = $5;
-{
-extern _IMPEXP_ROOT status_t  get_image_symbol(image_id imid,
-                  const char *name, int32 sclass,  void **ptr);
-extern _IMPEXP_ROOT status_t  get_nth_image_symbol(image_id imid, int32 index,
-                  char *buf, int32 *bufsize, int32 *sclass,
-                  void **ptr);
-}
-
-
-{*----- cache manipulation --------------------------------*}
-const
-  B_FLUSH_DCACHE         =$0001;  {* dcache = data cache *}
-  B_FLUSH_ICACHE         =$0004;   {* icache = instruction cache *}
-  B_INVALIDATE_DCACHE    =$0002;
-  B_INVALIDATE_ICACHE    =$0008;
-
-
-{
-extern _IMPEXP_ROOT void  clear_caches(void *addr, size_t len, uint32 flags);
-}
-
-
-    function load_image(argc : longint; argv : ppchar; envp : ppchar): thread_id;
-     var
-      args: SysCallArgs;
-      i: longint;
-     begin
-       args.param[1] := cint(argc);
-       args.param[2] := cint(argv);
-       args.param[3] := cint(envp);
-       load_image := SysCall(syscall_nr_load_image, args);
-     end;
-
-
-{ ------------------------ System information --------------------------- }
-{ for both intel and ppc platforms }
-const B_MAX_CPU_COUNT     = 8;
-
-
-type
-    system_info = packed record
-     id: array[0..1] of longint;  {* unique machine ID *}
-     boot_time: bigtime_t;        {* time of boot (# usec since 1/1/70) *}
-     cpu_count: longint;         {* # of cpus *}
-     cpu_type: longint;          {* type of cpu *}
-     cpu_revision:longint ;        {* revision # of cpu *}
-     cpu_infos: array [0..B_MAX_CPU_COUNT-1] of bigtime_t;  {* info about individual cpus *}
-     cpu_clock_speed:int64;      {* processor clock speed (Hz) *}
-     bus_clock_speed:int64;      {* bus clock speed (Hz) *      }
-     platform_type:longint;      {* type of machine we're on *}
-     max_pages:longint;          {* total # physical pages *}
-     used_pages:longint;         {* # physical pages in use *}
-     page_faults:longint;        {* # of page faults *}
-     max_sems:longint;           {* maximum # semaphores *}
-     used_sems:longint;          {* # semaphores in use *}
-     max_ports:longint;          {* maximum # ports *}
-     used_ports:longint;         {* # ports in use *}
-     max_threads:longint;        {* maximum # threads *}
-     used_threads:longint;       {* # threads in use *}
-     max_teams:longint;          {* maximum # teams *}
-     used_teams:longint;         {* # teams in use *}
-
-     kernel_name: array[0..B_FILE_NAME_LENGTH-1] of char;    {* name of kernel *}
-     kernel_build_date: array[0..B_OS_NAME_LENGTH-1] of char;  {* date kernel built *}
-     kernel_build_time: array[0..B_OS_NAME_LENGTH-1] of char;  {* time kernel built *}
-     kernel_version:int64;               {* version of this kernel *}
-     _busy_wait_time:bigtime_t;      {* reserved for Be *}
-     pad:array[1..4] of longint;     {* just in case... *}
-    end;
-
-
-    function get_system_info(var info: system_info): status_t;
-     var
-      args: SysCallArgs;
-      i: longint;
-     begin
-       args.param[1] := cint(@info);
-       i := SysCall(syscall_nr_get_system_info, args);
-       get_system_info := i;
-     end;
-
-
-
-
-{*************************************************************}
-{*********************** STORAGE KIT *************************}
-{*************************************************************}
-const
-     { file system flags }
-     B_FS_IS_READONLY    = $00000001;
-     B_FS_IS_REMOVABLE    = $00000002;
-     B_FS_IS_PERSISTENT    = $00000004;
-     B_FS_IS_SHARED      = $00000008;
-     B_FS_HAS_MIME      = $00010000;
-     B_FS_HAS_ATTR      = $00020000;
-     B_FS_HAS_QUERY      = $00040000;
-
-
-type
-   fs_info = packed record
-     dev   : dev_t;              { fs dev_t }
-     root  : ino_t;              { root ino_t }
-     flags : cardinal;           { file system flags }
-     block_size:off_t;           { fundamental block size }
-     io_size:off_t;              { optimal io size }
-     total_blocks:off_t;         { total number of blocks }
-     free_blocks:off_t;          { number of free blocks  }
-     total_nodes:off_t;          { total number of nodes  }
-     free_nodes:off_t;           { number of free nodes   }
-     device_name: array[0..127] of char;    { device holding fs      }
-     volume_name: array[0..B_FILE_NAME_LENGTH-1] of char;{ volume name            }
-     fsh_name : array[0..B_OS_NAME_LENGTH-1] of char;{ name of fs handler     }
-   end;
-
-
-    function dev_for_path(const pathname : pchar): dev_t;
-     var
-      args: SysCallArgs;
-      buffer: array[1..15] of longint;
-      i: cint;
-     begin
-       args.param[1] := $FFFFFFFF;
-       args.param[2] := cint(pathname);
-       args.param[3] := cint(@buffer);
-       args.param[4] := $01000000;
-       if SysCall(syscall_nr_rstat, args)=0 then
-          i:=buffer[1]
-       else
-          i:=-1;
-       dev_for_path := i;
-     end;
-
-
-    function fs_stat_dev(device: dev_t; var info: fs_info): dev_t;
-     var
-      args: SysCallArgs;
-     begin
-       args.param[1] := cint(device);
-       args.param[2] := 0;
-       args.param[3] := $FFFFFFFF;
-       args.param[4] := 0;
-       args.param[5] := cint(@info);
-       fs_stat_dev := SysCall(syscall_nr_statfs, args);
-     end;
-
-
-{
-_IMPEXP_ROOT dev_t    next_dev(int32 *pos);
-}
-
-
-{*****************************************************************}
-
-
-
-
-
-
-
-

rtl/beos/beos.pp

@@ -1,384 +0,0 @@
-unit beos;
-
-interface
-
-type
-    Stat = packed record
-      dev:longint;     {"device" that this file resides on}
-      ino:int64;       {this file's inode #, unique per device}
-      mode:dword;      {mode bits (rwx for user, group, etc)}
-      nlink:longint;   {number of hard links to this file}
-      uid:dword;       {user id of the owner of this file}
-      gid:dword;       {group id of the owner of this file}
-      size:int64;      {size of this file (in bytes)}
-      rdev:longint;    {device type (not used)}
-      blksize:longint; {preferref block size for i/o}
-      atime:longint;   {last access time}
-      mtime:longint;   {last modification time}
-      ctime:longint;   {last change time, not creation time}
-      crtime:longint;  {creation time}
-    end;
-    PStat=^Stat;
-    TStat=Stat;
-
-                ComStr  = String[255];
-                  PathStr = String[255];
-                    DirStr  = String[255];
-                      NameStr = String[255];
-        ExtStr  = String[255];
-
-function FStat(Path:String;Var Info:stat):Boolean;
-function FStat(var f:File;Var Info:stat):Boolean;
-function GetEnv(P: string): pchar;
-
-function  FExpand(Const Path: PathStr):PathStr;
-function  FSearch(const path:pathstr;dirlist:string):pathstr;
-procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
-function  Dirname(Const path:pathstr):pathstr;
-function  Basename(Const path:pathstr;Const suf:pathstr):pathstr;
-function  FNMatch(const Pattern,Name:string):Boolean;
-{function  StringToPPChar(Var S:STring):ppchar;}
-
-function PExists(path:string):boolean;
-function FExists(path:string):boolean;
-
-Function Shell(const Command:String):Longint;
-
-implementation
-
-uses strings;
-
-{$i filerec.inc}
-{$i textrec.inc}
-
-function sys_stat (a:cardinal;path:pchar;info:pstat;n:longint):longint; cdecl; external name 'sys_stat';
-
-function FStat(Path:String;Var Info:stat):Boolean;
-{
-  Get all information on a file, and return it in Info.
-}
-var tmp:string;
-var p:pchar;
-begin
-  tmp:=path+#0;
-  p:=@tmp[1];
-  FStat:=(sys_stat($FF000000,p,@Info,0)=0);
-end;
-
-function FStat(var f:File;Var Info:stat):Boolean;
-{
-  Get all information on a file, and return it in Info.
-}
-begin
-  FStat:=(sys_stat($FF000000,PChar(@FileRec(f).Name),@Info,0)=0);
-end;
-
-
-
-Function GetEnv(P:string):Pchar;
-{
-  Searches the environment for a string with name p and
-  returns a pchar to it's value.
-  A pchar is used to accomodate for strings of length > 255
-}
-var
-  ep    : ppchar;
-  found : boolean;
-Begin
-  p:=p+'=';            {Else HOST will also find HOSTNAME, etc}
-  ep:=envp;
-  found:=false;
-  if ep<>nil then
-   begin
-     while (not found) and (ep^<>nil) do
-      begin
-        if strlcomp(@p[1],(ep^),length(p))=0 then
-         found:=true
-        else
-         inc(ep);
-      end;
-   end;
-  if found then
-   getenv:=ep^+length(p)
-  else
-   getenv:=nil;
-{  writeln ('GETENV (',P,') =',getenv);}
-end;
-
-
-
-Function StringToPPChar(Var S:String; Var nr:longint):ppchar;
-{
-  Create a PPChar to structure of pchars which are the arguments specified
-  in the string S. Especially usefull for creating an ArgV for Exec-calls
-}
-var
-  Buf : ^char;
-  p   : ppchar;
-begin
-  s:=s+#0;
-  buf:=@s[1];
-  nr:=0;
-  while(buf^<>#0) do
-   begin
-     while (buf^ in [' ',#8,#10]) do
-      inc(buf);
-     inc(nr);
-     while not (buf^ in [' ',#0,#8,#10]) do
-      inc(buf);
-   end;
-  getmem(p,nr*4);
-  StringToPPChar:=p;
-  if p=nil then
-   begin
-{     LinuxError:=sys_enomem;}
-     exit;
-   end;
-  buf:=@s[1];
-  while (buf^<>#0) do
-   begin
-     while (buf^ in [' ',#8,#10]) do
-      begin
-        buf^:=#0;
-        inc(buf);
-      end;
-     p^:=buf;
-     inc(p);
-     p^:=nil;
-     while not (buf^ in [' ',#0,#8,#10]) do
-      inc(buf);
-   end;
-end;
-
-
-
-{
-function FExpand (const Path: PathStr): PathStr;
-- declared in fexpand.inc
-}
-
-{$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
-{$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
-
-{$I fexpand.inc}
-
-{$UNDEF FPC_FEXPAND_GETENVPCHAR}
-{$UNDEF FPC_FEXPAND_TILDE}
-
-
-
-Function FSearch(const path:pathstr;dirlist:string):pathstr;
-{
-  Searches for a file 'path' in the list of direcories in 'dirlist'.
-  returns an empty string if not found. Wildcards are NOT allowed.
-  If dirlist is empty, it is set to '.'
-}
-Var
-  NewDir : PathStr;
-  p1     : Longint;
-  Info   : Stat;
-Begin
-{Replace ':' with ';'}
-  for p1:=1to length(dirlist) do
-   if dirlist[p1]=':' then
-    dirlist[p1]:=';';
-{Check for WildCards}
-  If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
-   FSearch:='' {No wildcards allowed in these things.}
-  Else
-   Begin
-     Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
-     Repeat
-       p1:=Pos(';',DirList);
-       If p1=0 Then
-        p1:=255;
-       NewDir:=Copy(DirList,1,P1 - 1);
-       if NewDir[Length(NewDir)]<>'/' then
-        NewDir:=NewDir+'/';
-       NewDir:=NewDir+Path;
-       Delete(DirList,1,p1);
-       if FStat(NewDir,Info) then
-        Begin
-          If Pos('./',NewDir)=1 Then
-           Delete(NewDir,1,2);
-        {DOS strips off an initial .\}
-        End
-       Else
-        NewDir:='';
-     Until (DirList='') or (Length(NewDir) > 0);
-     FSearch:=NewDir;
-   End;
-End;
-
-
-
-Procedure FSplit(const Path:PathStr;Var Dir:DirStr;Var Name:NameStr;Var Ext:ExtStr);
-Var
-  DotPos,SlashPos,i : longint;
-Begin
-  SlashPos:=0;
-  DotPos:=256;
-  i:=Length(Path);
-  While (i>0) and (SlashPos=0) Do
-   Begin
-     If (DotPos=256) and (Path[i]='.') Then
-      DotPos:=i;
-     If (Path[i]='/') Then
-      SlashPos:=i;
-     Dec(i);
-   End;
-  Ext:=Copy(Path,DotPos,255);
-  Dir:=Copy(Path,1,SlashPos);
-  Name:=Copy(Path,SlashPos + 1,DotPos - SlashPos - 1);
-End;
-
-
-
-Function Dirname(Const path:pathstr):pathstr;
-{
-  This function returns the directory part of a complete path.
-  Unless the directory is root '/', The last character is not
-  a slash.
-}
-var
-  Dir  : PathStr;
-  Name : NameStr;
-  Ext  : ExtStr;
-begin
-  FSplit(Path,Dir,Name,Ext);
-  if length(Dir)>1 then
-   Delete(Dir,length(Dir),1);
-  DirName:=Dir;
-end;
-
-
-
-Function Basename(Const path:pathstr;Const suf:pathstr):pathstr;
-{
-  This function returns the filename part of a complete path. If suf is
-  supplied, it is cut off the filename.
-}
-var
-  Dir  : PathStr;
-  Name : NameStr;
-  Ext  : ExtStr;
-begin
-  FSplit(Path,Dir,Name,Ext);
-  if Suf<>Ext then
-   Name:=Name+Ext;
-  BaseName:=Name;
-end;
-
-
-
-Function FNMatch(const Pattern,Name:string):Boolean;
-Var
-  LenPat,LenName : longint;
-
-  Function DoFNMatch(i,j:longint):Boolean;
-  Var
-    Found : boolean;
-  Begin
-  Found:=true;
-  While Found and (i<=LenPat) Do
-   Begin
-     Case Pattern[i] of
-      '?' : Found:=(j<=LenName);
-      '*' : Begin
-            {find the next character in pattern, different of ? and *}
-              while Found and (i<LenPat) do
-                begin
-                inc(i);
-                case Pattern[i] of
-                  '*' : ;
-                  '?' : begin
-                          inc(j);
-                          Found:=(j<=LenName);
-                        end;
-                else
-                  Found:=false;
-                end;
-               end;
-            {Now, find in name the character which i points to, if the * or ?
-             wasn't the last character in the pattern, else, use up all the
-             chars in name}
-              Found:=true;
-              if (i<=LenPat) then
-                begin
-                repeat
-                {find a letter (not only first !) which maches pattern[i]}
-                while (j<=LenName) and (name[j]<>pattern[i]) do
-                  inc (j);
-                 if (j<LenName) then
-                  begin
-                    if DoFnMatch(i+1,j+1) then
-                     begin
-                       i:=LenPat;
-                       j:=LenName;{we can stop}
-                       Found:=true;
-                     end
-                    else
-                     inc(j);{We didn't find one, need to look further}
-                  end;
-               until (j>=LenName);
-                end
-              else
-                j:=LenName;{we can stop}
-            end;
-     else {not a wildcard character in pattern}
-       Found:=(j<=LenName) and (pattern[i]=name[j]);
-     end;
-     inc(i);
-     inc(j);
-   end;
-  DoFnMatch:=Found and (j>LenName);
-  end;
-
-Begin {start FNMatch}
-  LenPat:=Length(Pattern);
-  LenName:=Length(Name);
-  FNMatch:=DoFNMatch(1,1);
-End;
-
-
-function PExists(path:string):boolean;
-begin
-  PExists:=FExists(path);
-end;
-
-function FExists(path:string):boolean;
-var
-    info:stat;
-begin
-  FExists:=Fstat(path,info);
-end;
-
-function sys_load_image(a:cardinal; argp:ppchar; envp:ppchar):longint; cdecl; external name 'sys_load_image';
-function sys_wait_for_thread (th:longint; var exitcode:longint):longint; cdecl; external name 'sys_wait_for_thread';
-
-Function Shell(const Command:String):Longint;
-var s:string;
-    argv:ppchar;
-    argc:longint;
-    th:longint;
-begin
-  s:=Command;
-  argv:=StringToPPChar(s,argc);
-  th:=0;
-{  writeln ('argc = ',argc);
-  while argv[th]<>Nil do begin
-    writeln ('argv[',th,'] = ',argv[th]);
-    th:=th+1;
-  end;
-}
-  th:=sys_load_image(argc,argv,system.envp);
-  if th<0 then begin
-    shell:=0;
-    exit;
-  end;
-  sys_wait_for_thread(th,Shell);
-end;
-
-
-
-end.

rtl/beos/bethreads.pp

@@ -0,0 +1,519 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2002 by Peter Vreman,
+    member of the Free Pascal development team.
+
+    BeOS (bethreads) threading support implementation
+
+    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.
+
+ **********************************************************************}
+{$mode objfpc}
+
+unit bethreads;
+interface
+{$S-}
+
+Procedure SetBeThreadManager;
+
+implementation
+
+Uses
+  systhrds,
+  BaseUnix,
+  unix,
+  unixtype,
+  sysutils;
+
+{*****************************************************************************
+                             Generic overloaded
+*****************************************************************************}
+
+{ Include OS specific parts. }
+
+{*****************************************************************************
+                             Threadvar support
+*****************************************************************************}
+
+{$ifdef HASTHREADVAR}
+    const
+      threadvarblocksize : dword = 0;
+
+    var
+      TLSKey : pthread_key_t;
+
+    procedure BeInitThreadvar(var offset : dword;size : dword);
+      begin
+        offset:=threadvarblocksize;
+        inc(threadvarblocksize,size);
+      end;
+
+    function BeRelocateThreadvar(offset : dword) : pointer;
+      begin
+        BeRelocateThreadvar:=pthread_getspecific(tlskey)+Offset;
+      end;
+
+
+    procedure BeAllocateThreadVars;
+      var
+        dataindex : pointer;
+      begin
+        { we've to allocate the memory from system  }
+        { because the FPC heap management uses      }
+        { exceptions which use threadvars but       }
+        { these aren't allocated yet ...            }
+        { allocate room on the heap for the thread vars }
+        DataIndex:=Pointer(Fpmmap(nil,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0));
+        FillChar(DataIndex^,threadvarblocksize,0);
+        pthread_setspecific(tlskey,dataindex);
+      end;
+
+
+    procedure BeReleaseThreadVars;
+      begin
+        {$ifdef ver1_0}
+        Fpmunmap(longint(pthread_getspecific(tlskey)),threadvarblocksize);
+        {$else}
+        Fpmunmap(pointer(pthread_getspecific(tlskey)),threadvarblocksize);
+        {$endif}
+      end;
+
+{ Include OS independent Threadvar initialization }
+
+{$endif HASTHREADVAR}
+
+
+{*****************************************************************************
+                            Thread starting
+*****************************************************************************}
+
+    type
+      pthreadinfo = ^tthreadinfo;
+      tthreadinfo = record
+        f : tthreadfunc;
+        p : pointer;
+        stklen : cardinal;
+      end;
+
+    procedure DoneThread;
+      begin
+        { Release Threadvars }
+{$ifdef HASTHREADVAR}
+        CReleaseThreadVars;
+{$endif HASTHREADVAR}
+      end;
+
+
+    function ThreadMain(param : pointer) : pointer;cdecl;
+      var
+        ti : tthreadinfo;
+{$ifdef DEBUG_MT}
+        // in here, don't use write/writeln before having called
+        // InitThread! I wonder if anyone ever debugged these routines,
+        // because they will have crashed if DEBUG_MT was enabled!
+        // this took me the good part of an hour to figure out
+        // why it was crashing all the time!
+        // this is kind of a workaround, we simply write(2) to fd 0
+        s: string[100]; // not an ansistring
+{$endif DEBUG_MT}
+      begin
+{$ifdef DEBUG_MT}
+        s := 'New thread started, initing threadvars'#10;
+        fpwrite(0,s[1],length(s));
+{$endif DEBUG_MT}
+{$ifdef HASTHREADVAR}
+        { Allocate local thread vars, this must be the first thing,
+          because the exception management and io depends on threadvars }
+        CAllocateThreadVars;
+{$endif HASTHREADVAR}
+        { Copy parameter to local data }
+{$ifdef DEBUG_MT}
+        s := 'New thread started, initialising ...'#10;
+        fpwrite(0,s[1],length(s));
+{$endif DEBUG_MT}
+        ti:=pthreadinfo(param)^;
+        dispose(pthreadinfo(param));
+        { Initialize thread }
+        InitThread(ti.stklen);
+        { Start thread function }
+{$ifdef DEBUG_MT}
+        writeln('Jumping to thread function');
+{$endif DEBUG_MT}
+        ThreadMain:=pointer(ti.f(ti.p));
+        DoneThread;
+        pthread_detach(pthread_t(pthread_self()));
+      end;
+
+
+    function BeBeginThread(sa : Pointer;stacksize : dword;
+                         ThreadFunction : tthreadfunc;p : pointer;
+                         creationFlags : dword; var ThreadId : THandle) : DWord;
+      var
+        ti : pthreadinfo;
+        thread_attr : pthread_attr_t;
+      begin
+{$ifdef DEBUG_MT}
+        writeln('Creating new thread');
+{$endif DEBUG_MT}
+        { Initialize multithreading if not done }
+        if not IsMultiThread then
+         begin
+{$ifdef HASTHREADVAR}
+          { We're still running in single thread mode, setup the TLS }
+           pthread_key_create(@TLSKey,nil);
+           InitThreadVars(@CRelocateThreadvar);
+{$endif HASTHREADVAR}
+           IsMultiThread:=true;
+         end;
+        { the only way to pass data to the newly created thread
+          in a MT safe way, is to use the heap }
+        new(ti);
+        ti^.f:=ThreadFunction;
+        ti^.p:=p;
+        ti^.stklen:=stacksize;
+        { call pthread_create }
+{$ifdef DEBUG_MT}
+        writeln('Starting new thread');
+{$endif DEBUG_MT}
+        pthread_attr_init(@thread_attr);
+        pthread_attr_setinheritsched(@thread_attr, PTHREAD_EXPLICIT_SCHED);
+
+        // will fail under linux -- apparently unimplemented
+        pthread_attr_setscope(@thread_attr, PTHREAD_SCOPE_PROCESS);
+
+        // don't create detached, we need to be able to join (waitfor) on
+        // the newly created thread!
+        //pthread_attr_setdetachstate(@thread_attr, PTHREAD_CREATE_DETACHED);
+        if pthread_create(@threadid, @thread_attr, @ThreadMain,ti) <> 0 then begin
+          threadid := 0;
+        end;
+        BeBeginThread:=threadid;
+{$ifdef DEBUG_MT}
+        writeln('BeginThread returning ',BeBeginThread);
+{$endif DEBUG_MT}
+      end;
+
+
+    procedure BeEndThread(ExitCode : DWord);
+      begin
+        DoneThread;
+        pthread_detach(pthread_t(pthread_self()));
+        pthread_exit(pointer(ExitCode));
+      end;
+
+
+{$warning threadhandle can be larger than a dword}
+    function  BeSuspendThread (threadHandle : dword) : dword;
+    begin
+      {$Warning SuspendThread needs to be implemented}
+    end;
+
+{$warning threadhandle can be larger than a dword}
+    function  BeResumeThread  (threadHandle : dword) : dword;
+    begin
+      {$Warning ResumeThread needs to be implemented}
+    end;
+
+    procedure CThreadSwitch;  {give time to other threads}
+    begin
+      {extern int pthread_yield (void) __THROW;}
+      {$Warning ThreadSwitch needs to be implemented}
+    end;
+
+{$warning threadhandle can be larger than a dword}
+    function  BeKillThread (threadHandle : dword) : dword;
+    begin
+      pthread_detach(pthread_t(threadHandle));
+      CKillThread := pthread_cancel(pthread_t(threadHandle));
+    end;
+
+{$warning threadhandle can be larger than a dword}
+    function  BeWaitForThreadTerminate (threadHandle : dword; TimeoutMs : longint) : dword;  {0=no timeout}
+    var
+      LResultP: Pointer;
+      LResult: DWord;
+    begin
+      LResult := 0;
+      LResultP := @LResult;
+      pthread_join(pthread_t(threadHandle), @LResultP);
+      CWaitForThreadTerminate := LResult;
+    end;
+
+{$warning threadhandle can be larger than a dword}
+    function  BeThreadSetPriority (threadHandle : dword; Prio: longint): boolean; {-15..+15, 0=normal}
+    begin
+      {$Warning ThreadSetPriority needs to be implemented}
+    end;
+
+
+{$warning threadhandle can be larger than a dword}
+    function  BeThreadGetPriority (threadHandle : dword): Integer;
+    begin
+      {$Warning ThreadGetPriority needs to be implemented}
+    end;
+
+{$warning threadhandle can be larger than a dword}
+    function  BeGetCurrentThreadId : dword;
+    begin
+      CGetCurrentThreadId:=dword(pthread_self());
+    end;
+
+
+{*****************************************************************************
+                          Delphi/Win32 compatibility
+*****************************************************************************}
+
+    procedure BeInitCriticalSection(var CS);
+
+    var
+      MAttr : pthread_mutexattr_t;
+      res: longint;
+    begin
+      res:=pthread_mutexattr_init(@MAttr);
+      if res=0 then
+        begin
+          res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
+          if res=0 then
+            res := pthread_mutex_init(@CS,@MAttr)
+          else
+            { No recursive mutex support :/ }
+            res := pthread_mutex_init(@CS,NIL);
+        end
+      else 
+        res:= pthread_mutex_init(@CS,NIL);
+      pthread_mutexattr_destroy(@MAttr);
+      if res <> 0 then
+        runerror(6);
+    end;                           
+
+    procedure BeEnterCriticalSection(var CS);
+      begin
+         if pthread_mutex_lock(@CS) <> 0 then
+           runerror(6);
+      end;
+
+    procedure BeLeaveCriticalSection(var CS);
+      begin
+         if pthread_mutex_unlock(@CS) <> 0 then
+           runerror(6)
+      end;
+
+    procedure BeDoneCriticalSection(var CS);
+      begin
+         if pthread_mutex_destroy(@CS) <> 0 then
+           runerror(6);
+      end;
+
+
+{*****************************************************************************
+                           Heap Mutex Protection
+*****************************************************************************}
+
+    var
+      HeapMutex : pthread_mutex_t;
+
+    procedure BeThreadHeapMutexInit;
+      begin
+         pthread_mutex_init(@heapmutex,nil);
+      end;
+
+    procedure BeThreadHeapMutexDone;
+      begin
+         pthread_mutex_destroy(@heapmutex);
+      end;
+
+    procedure BeThreadHeapMutexLock;
+      begin
+         pthread_mutex_lock(@heapmutex);
+      end;
+
+    procedure BeThreadHeapMutexUnlock;
+      begin
+         pthread_mutex_unlock(@heapmutex);
+      end;
+
+    const
+      BeThreadMemoryMutexManager : TMemoryMutexManager = (
+        MutexInit : @BeThreadHeapMutexInit;
+        MutexDone : @BeThreadHeapMutexDone;
+        MutexLock : @BeThreadHeapMutexLock;
+        MutexUnlock : @BeThreadHeapMutexUnlock;
+      );
+
+    procedure InitHeapMutexes;
+      begin
+        SetMemoryMutexManager(BeThreadMemoryMutexManager);
+      end;
+
+Function BeInitThreads : Boolean;
+
+begin
+{$ifdef DEBUG_MT}
+  Writeln('Entering InitThreads.');
+{$endif}  
+{$ifndef dynpthreads}
+  Result:=True;
+{$else}
+  Result:=LoadPthreads;
+{$endif}
+  ThreadID := SizeUInt (pthread_self);
+{$ifdef DEBUG_MT}
+  Writeln('InitThreads : ',Result);
+{$endif DEBUG_MT}
+end;
+
+Function BeDoneThreads : Boolean;
+
+begin
+{$ifndef dynpthreads}
+  Result:=True;
+{$else}
+  Result:=UnloadPthreads;
+{$endif}
+end;
+
+type
+     TPthreadMutex = pthread_mutex_t;
+     Tbasiceventstate=record
+         FSem: Pointer;
+         FManualReset: Boolean;
+         FEventSection: TPthreadMutex;
+	end;
+     plocaleventstate = ^tbasiceventstate;  
+//     peventstate=pointer;
+
+Const 
+	wrSignaled = 0;
+	wrTimeout  = 1;
+	wrAbandoned= 2;
+	wrError	   = 3;
+
+function IntBasicEventCreate(EventAttributes : Pointer; AManualReset,InitialState : Boolean;const Name : ansistring):pEventState;
+
+var
+  MAttr : pthread_mutexattr_t;
+  res   : cint;
+
+
+begin
+  new(plocaleventstate(result));
+  plocaleventstate(result)^.FManualReset:=AManualReset;
+  plocaleventstate(result)^.FSem:=New(PSemaphore);  //sem_t.
+//  plocaleventstate(result)^.feventsection:=nil;
+  res:=pthread_mutexattr_init(@MAttr);
+  if res=0 then
+    begin
+      res:=pthread_mutexattr_settype(@MAttr,longint(_PTHREAD_MUTEX_RECURSIVE));
+      if Res=0 then
+        Res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,@MAttr)
+      else
+        res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
+    end
+  else
+    res:=pthread_mutex_init(@plocaleventstate(result)^.feventsection,nil);
+  pthread_mutexattr_destroy(@MAttr);
+  if res <> 0 then
+    runerror(6);
+  if sem_init(psem_t(plocaleventstate(result)^.FSem),ord(False),Ord(InitialState)) <> 0 then
+    runerror(6);
+end;
+
+procedure Intbasiceventdestroy(state:peventstate);
+
+begin
+  sem_destroy(psem_t(  plocaleventstate(state)^.FSem));
+end;
+
+procedure IntbasiceventResetEvent(state:peventstate);
+
+begin
+  While sem_trywait(psem_t( plocaleventstate(state)^.FSem))=0 do
+    ;
+end;
+
+procedure IntbasiceventSetEvent(state:peventstate);
+
+Var
+  Value : Longint;
+
+begin
+  pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+  Try
+    sem_getvalue(plocaleventstate(state)^.FSem,@value);
+    if Value=0 then
+      sem_post(psem_t( plocaleventstate(state)^.FSem));
+  finally
+    pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+  end;
+end;
+
+function IntbasiceventWaitFor(Timeout : Cardinal;state:peventstate) : longint;
+
+begin
+  If TimeOut<>Cardinal($FFFFFFFF) then
+    result:=wrError
+  else
+    begin
+      sem_wait(psem_t(plocaleventstate(state)^.FSem));
+      result:=wrSignaled;
+      if plocaleventstate(state)^.FManualReset then
+        begin
+          pthread_mutex_lock(@plocaleventstate(state)^.feventsection);
+          Try
+              intbasiceventresetevent(State);
+              sem_post(psem_t( plocaleventstate(state)^.FSem));
+            Finally
+          pthread_mutex_unlock(@plocaleventstate(state)^.feventsection);
+        end;
+      end;
+    end;
+end;
+
+Var
+  BeThreadManager : TThreadManager;
+
+Procedure SetBeThreadManager;
+
+begin
+  With BeThreadManager do
+    begin
+    InitManager            :=@BeInitThreads;
+    DoneManager            :=@BeDoneThreads;
+    BeginThread            :=@BeBeginThread;
+    EndThread              :=@BeEndThread;
+    SuspendThread          :=@BeSuspendThread;
+    ResumeThread           :=@BeResumeThread;
+    KillThread             :=@BeKillThread;
+    ThreadSwitch           :=@BeThreadSwitch;
+    WaitForThreadTerminate :=@BeWaitForThreadTerminate;
+    ThreadSetPriority      :=@BeThreadSetPriority;
+    ThreadGetPriority      :=@BeThreadGetPriority;
+    GetCurrentThreadId     :=@BeGetCurrentThreadId;
+    InitCriticalSection    :=@BeInitCriticalSection;
+    DoneCriticalSection    :=@BeDoneCriticalSection;
+    EnterCriticalSection   :=@BeEnterCriticalSection;
+    LeaveCriticalSection   :=@BeLeaveCriticalSection;
+{$ifdef hasthreadvar}
+    InitThreadVar          :=@BeInitThreadVar;
+    RelocateThreadVar      :=@BeRelocateThreadVar;
+    AllocateThreadVars     :=@BeAllocateThreadVars;
+    ReleaseThreadVars      :=@BeReleaseThreadVars;
+{$endif}
+    BasicEventCreate       :=@intBasicEventCreate;       
+    BasicEventDestroy      :=@intBasicEventDestroy;
+    BasicEventResetEvent   :=@intBasicEventResetEvent;
+    BasicEventSetEvent     :=@intBasicEventSetEvent;
+    BasiceventWaitFor      :=@intBasiceventWaitFor;
+    end;
+  SetThreadManager(BeThreadManager);
+  InitHeapMutexes;
+end;
+
+initialization
+  SetBeThreadManager;
+end.

rtl/beos/classes.pp

@@ -0,0 +1,52 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
+
+    Classes unit for BeOS
+
+    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.
+
+ **********************************************************************}
+
+{$mode objfpc}
+
+{ determine the type of the resource/form file }
+{$define Win16Res}
+
+unit Classes;
+
+interface
+
+uses
+  sysutils,
+  rtlconsts,
+  types,  
+  typinfo;
+
+{$i classesh.inc}
+
+implementation
+
+uses
+  baseunix,unix;
+
+{ OS - independent class implementations are in /inc directory. }
+{$i classes.inc}
+
+
+initialization
+  CommonInit;
+
+finalization
+  CommonCleanup;
+
+{$ifndef ver1_0}
+  if ThreadsInited then
+     DoneThreads;
+{$endif}
+end.

rtl/beos/dos.pp

@@ -1,820 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2001 by members of the Free Pascal
-    development team
-
-    DOS unit template based on POSIX
-
-    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 Dos;
-
-Interface
-
-{$goto on}
-
-Const
-  FileNameLen = 255;
-
-Type
-  SearchRec = packed Record
-  {Fill : array[1..21] of byte;  Fill replaced with below}
-    DirPtr     : pointer;        {directory pointer for reading directory}
-    SearchAttr : Byte;        {attribute we are searching for}
-    Fill       : Array[1..16] of Byte; {future use}
-  {End of fill}
-    Attr       : Byte;        {attribute of found file}
-    Time       : LongInt;     {last modify date of found file}
-    Size       : LongInt;     {file size of found file}
-    Reserved   : Word;        {future use}
-    Name       : String[FileNameLen]; {name of found file}
-    SearchSpec : String[FileNameLen]; {search pattern}
-    SearchDir  : String[FileNameLen]; { path we are searching in }
-  End;
-
-{$DEFINE HAS_FILENAMELEN}
-{$I dosh.inc}
-
-Procedure AddDisk(const path:string);
-
-Implementation
-
-Uses
-  strings,posix;
-
-(* Potentially needed FPC_FEXPAND_* defines should be defined here. *)
-{$I dos.inc}
-
-  { Used by AddDisk(), DiskFree() and DiskSize() }
-const
-  Drives   : byte = 4;
-  MAX_DRIVES = 26;
-var
-  DriveStr : array[4..MAX_DRIVES] of pchar;
-
-
-Function StringToPPChar(Var S:STring; var count : longint):ppchar;
-{
-  Create a PPChar to structure of pchars which are the arguments specified
-  in the string S. Especially usefull for creating an ArgV for Exec-calls
-}
-var
-  nr  : longint;
-  Buf : ^char;
-  p   : ppchar;
-begin
-  s:=s+#0;
-  buf:=@s[1];
-  nr:=0;
-  while(buf^<>#0) do
-   begin
-     while (buf^ in [' ',#8,#10]) do
-      inc(buf);
-     inc(nr);
-     while not (buf^ in [' ',#0,#8,#10]) do
-      inc(buf);
-   end;
-  getmem(p,nr*4);
-  StringToPPChar:=p;
-  if p=nil then
-   begin
-     Errno:=sys_enomem;
-     count := 0;
-     exit;
-   end;
-  buf:=@s[1];
-  while (buf^<>#0) do
-   begin
-     while (buf^ in [' ',#8,#10]) do
-      begin
-        buf^:=#0;
-        inc(buf);
-      end;
-     p^:=buf;
-     inc(p);
-     p^:=nil;
-     while not (buf^ in [' ',#0,#8,#10]) do
-      inc(buf);
-   end;
-   count := nr;
-end;
-
-
-{$i dos_beos.inc}    { include OS specific stuff }
-
-
-
-
-{******************************************************************************
-                        --- Info / Date / Time ---
-******************************************************************************}
-var
-  TZSeconds : longint;   { offset to add/ subtract from Epoch to get local time }
-  tzdaylight : boolean;
-  tzname     : array[boolean] of pchar;
-
-
-type
-  GTRec = packed Record
-    Year,
-    Month,
-    MDay,
-    WDay,
-    Hour,
-    Minute,
-    Second : Word;
-  End;
-Const
-{Date Calculation}
-  C1970 = 2440588;
-  D0    = 1461;
-  D1    = 146097;
-  D2    = 1721119;
-
-
-function WeekDay (y,m,d:longint):longint;
-{
-  Calculates th day of the week. returns -1 on error
-}
-var
-  u,v : longint;
-begin
-  if (m<1) or (m>12) or (y<1600) or (y>4000) or
-     (d<1) or (d>30+((m+ord(m>7)) and 1)-ord(m=2)) or
-     ((m*d=58) and (((y mod 4>0) or (y mod 100=0)) and (y mod 400>0))) then
-   WeekDay:=-1
-  else
-   begin
-     u:=m;
-     v:=y;
-     if m<3 then
-      begin
-        inc(u,12);
-        dec(v);
-      end;
-     WeekDay:=(d+2*u+((3*(u+1)) div 5)+v+(v div 4)-(v div 100)+(v div 400)+1) mod 7;
-   end;
-end;
-
-
-
-
-Procedure JulianToGregorian(JulianDN:LongInt;Var Year,Month,Day:Word);
-Var
-  YYear,XYear,Temp,TempMonth : LongInt;
-Begin
-  Temp:=((JulianDN-D2) shl 2)-1;
-  JulianDN:=Temp Div D1;
-  XYear:=(Temp Mod D1) or 3;
-  YYear:=(XYear Div D0);
-  Temp:=((((XYear mod D0)+4) shr 2)*5)-3;
-  Day:=((Temp Mod 153)+5) Div 5;
-  TempMonth:=Temp Div 153;
-  If TempMonth>=10 Then
-   Begin
-     inc(YYear);
-     dec(TempMonth,12);
-   End;
-  inc(TempMonth,3);
-  Month := TempMonth;
-  Year:=YYear+(JulianDN*100);
-end;
-
-
-
-Procedure EpochToLocal(epoch:time_t;var year,month,day,hour,minute,second:Word);
-{
-  Transforms Epoch time into local time (hour, minute,seconds)
-}
-Var
-  DateNum: time_t;
-Begin
-  Epoch:=Epoch+TZSeconds;
-  Datenum:=(Epoch Div 86400) + c1970;
-  JulianToGregorian(DateNum,Year,Month,day);
-  Epoch:=Abs(Epoch Mod 86400);
-  Hour:=Epoch Div 3600;
-  Epoch:=Epoch Mod 3600;
-  Minute:=Epoch Div 60;
-  Second:=Epoch Mod 60;
-End;
-
-
-
-Procedure GetDate(Var Year, Month, MDay, WDay: Word);
-var
-  hour,minute,second : word;
-  timeval : time_t;
-Begin
-  timeval := sys_time(timeval);
-  { convert the GMT time to local time }
-  EpochToLocal(timeval,year,month,mday,hour,minute,second);
-  Wday:=weekday(Year,Month,MDay);
-end;
-
-
-
-Procedure SetDate(Year, Month, Day: Word);
-Begin
-  {!!}
-End;
-
-
-
-
-Procedure GetTime(Var Hour, Minute, Second, Sec100: Word);
-var
- timeval : time_t;
- year,month,day: word;
-Begin
-  timeval := sys_time(timeval);
-  EpochToLocal(timeval,year,month,day,hour,minute,second);
-  Sec100 := 0;
-end;
-
-
-
-Procedure SetTime(Hour, Minute, Second, Sec100: Word);
-Begin
-  {!!}
-End;
-
-
-Procedure UnixDateToDt(SecsPast: LongInt; Var Dt: DateTime);
-Begin
-  EpochToLocal(SecsPast,dt.Year,dt.Month,dt.Day,dt.Hour,dt.Min,dt.Sec);
-End;
-
-
-{$ifndef DOS_HAS_EXEC}
-{******************************************************************************
-                               --- Exec ---
-******************************************************************************}
-
-Function  InternalWaitProcess(Pid:pid_t):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
-var     r,s     : cint;
-begin
-  repeat
-    s:=$7F00;
-    r:=sys_WaitPid(Pid,s,0);
-  until (r<>-1) or (Errno<>Sys_EINTR);
-  { When r = -1 or r = 0, no status is available, so there was an error. }
-  if (r=-1) or (r=0) then
-    InternalWaitProcess:=-1 { return -1 to indicate an error }
-  else
-   begin
-     { process terminated normally }
-     if wifexited(s)<>0 then
-       begin
-         { get status code }
-         InternalWaitProcess := wexitstatus(s);
-         exit;
-       end;
-     { process terminated due to a signal }
-     if wifsignaled(s)<>0 then
-       begin
-         { get signal number }
-         InternalWaitProcess := wstopsig(s);
-         exit;
-       end;
-     InternalWaitProcess:=-1;
-   end;
-end;
-
-
-
-
-Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
-var
-  pid    : pid_t;
-  tmp : string;
-  p : ppchar;
-  count: longint;
-  // The Error-Checking in the previous Version failed, since halt($7F) gives an WaitPid-status of $7F00
-  F: File;
-Begin
-{$IFOPT I+}
-{$DEFINE IOCHECK}
-{$ENDIF}
-{$I-}
-  { verify if the file to execute exists }
-  Assign(F,Path);
-  Reset(F,1);
-  if IOResult <> 0 then
-    { file not found }
-    begin
-      DosError := 2;
-      exit;
-    end
-  else
-    Close(F);
-{$IFDEF IOCHECK}
-{$I+}
-{$UNDEF IOCHECK}
-{$ENDIF}
-  LastDosExitCode:=0;
-  { Fork the process }
-  pid:=sys_Fork;
-  if pid=0 then
-   begin
-   {The child does the actual execution, and then exits}
-    tmp := Path+' '+ComLine;
-    p:=StringToPPChar(tmp,count);
-    if (p<>nil) and (p^<>nil) then
-    begin
-      sys_Execve(p^,p,Envp);
-    end;
-   {If the execve fails, we return an exitvalue of 127, to let it be known}
-     sys_exit(127);
-   end
-  else
-   if pid=-1 then         {Fork failed - parent only}
-    begin
-      DosError:=8;
-      exit
-    end;
-{We're in the parent, let's wait.}
-  LastDosExitCode:=InternalWaitProcess(pid); // WaitPid and result-convert
-  if (LastDosExitCode>=0) and (LastDosExitCode<>127) then DosError:=0 else
-     DosError:=8; // perhaps one time give an better error
-End;
-{$ENDIF}
-
-
-{******************************************************************************
-                               --- Disk ---
-******************************************************************************}
-
-
-Procedure AddDisk(const path:string);
-begin
-  if not (DriveStr[Drives]=nil) then
-   FreeMem(DriveStr[Drives],StrLen(DriveStr[Drives])+1);
-  GetMem(DriveStr[Drives],length(Path)+1);
-  StrPCopy(DriveStr[Drives],path);
-  inc(Drives);
-  if Drives>26 then
-   Drives:=4;
-end;
-
-
-{******************************************************************************
-                       --- Findfirst FindNext ---
-******************************************************************************}
-
-
-Function FNMatch(const Pattern,Name:string):Boolean;
-Var
-  LenPat,LenName : longint;
-
-  Function DoFNMatch(i,j:longint):Boolean;
-  Var
-    Found : boolean;
-  Begin
-  Found:=true;
-  While Found and (i<=LenPat) Do
-   Begin
-     Case Pattern[i] of
-      '?' : Found:=(j<=LenName);
-      '*' : Begin
-            {find the next character in pattern, different of ? and *}
-              while Found and (i<LenPat) do
-                begin
-                inc(i);
-                case Pattern[i] of
-                  '*' : ;
-                  '?' : begin
-                          inc(j);
-                          Found:=(j<=LenName);
-                        end;
-                else
-                  Found:=false;
-                end;
-               end;
-            {Now, find in name the character which i points to, if the * or ?
-             wasn't the last character in the pattern, else, use up all the
-             chars in name}
-              Found:=true;
-              if (i<=LenPat) then
-                begin
-                repeat
-                {find a letter (not only first !) which maches pattern[i]}
-                while (j<=LenName) and (name[j]<>pattern[i]) do
-                  inc (j);
-                 if (j<LenName) then
-                  begin
-                    if DoFnMatch(i+1,j+1) then
-                     begin
-                       i:=LenPat;
-                       j:=LenName;{we can stop}
-                       Found:=true;
-                     end
-                    else
-                     inc(j);{We didn't find one, need to look further}
-                  end;
-               until (j>=LenName);
-                end
-              else
-                j:=LenName;{we can stop}
-            end;
-     else {not a wildcard character in pattern}
-       Found:=(j<=LenName) and (pattern[i]=name[j]);
-     end;
-     inc(i);
-     inc(j);
-   end;
-  DoFnMatch:=Found and (j>LenName);
-  end;
-
-Begin {start FNMatch}
-  LenPat:=Length(Pattern);
-  LenName:=Length(Name);
-  FNMatch:=DoFNMatch(1,1);
-End;
-
-
-Procedure FindClose(Var f: SearchRec);
-{
-  Closes dirptr if it is open
-}
-Begin
-  { could already have been closed }
-  if assigned(f.dirptr) then
-     sys_closedir(pdir(f.dirptr));
-  f.dirptr := nil;
-End;
-
-
-{ Returns a filled in searchRec structure }
-{ and TRUE if the specified file in s is  }
-{ found.                                  }
-Function FindGetFileInfo(s:string;var f:SearchRec):boolean;
-var
-  DT   : DateTime;
-  st   : stat;
-  Fmode : byte;
-  res: string;    { overlaid variable }
-  Dir : DirsTr;
-  Name : NameStr;
-  Ext: ExtStr;
-begin
-  FindGetFileInfo:=false;
-  res := s + #0;
-  if sys_stat(@res[1],st)<>0 then
-   exit;
-  if S_ISDIR(st.st_mode) then
-   fmode:=directory
-  else
-   fmode:=0;
-  if (st.st_mode and S_IWUSR)=0 then
-   fmode:=fmode or readonly;
-  FSplit(s,Dir,Name,Ext);
-  if Name[1]='.' then
-   fmode:=fmode or hidden;
-  If ((FMode and Not(f.searchattr))=0) Then
-   Begin
-     if Ext <> '' then
-       res := Name + Ext
-     else
-       res := Name;
-     f.Name:=res;
-     f.Attr:=FMode;
-     f.Size:=longint(st.st_size);
-     UnixDateToDT(st.st_mtime, DT);
-     PackTime(DT,f.Time);
-     FindGetFileInfo:=true;
-   End;
-end;
-
-
-Procedure FindNext(Var f: SearchRec);
-{
-  re-opens dir if not already in array and calls FindWorkProc
-}
-Var
-  FName,
-  SName    : string;
-  Found,
-  Finished : boolean;
-  p        : PDirEnt;
-Begin
-{Main loop}
-  SName:=f.SearchSpec;
-  Found:=False;
-  Finished:=(f.dirptr=nil);
-  While Not Finished Do
-   Begin
-     p:=sys_readdir(pdir(f.dirptr));
-     if p=nil then
-     begin
-      FName:=''
-     end
-     else
-      FName:=Strpas(@p^.d_name);
-     If FName='' Then
-      Finished:=True
-     Else
-      Begin
-        If FNMatch(SName,FName) Then
-         Begin
-           Found:=FindGetFileInfo(f.SearchDir+FName,f);
-           if Found then
-           begin
-            Finished:=true;
-           end;
-         End;
-      End;
-   End;
-{Shutdown}
-  If Found Then
-   Begin
-     DosError:=0;
-   End
-  Else
-   Begin
-     FindClose(f);
-     { FindClose() might be called thereafter also... }
-     f.dirptr := nil;
-     DosError:=18;
-   End;
-End;
-
-
-Procedure FindFirst(Const Path: PathStr; Attr: Word; Var f: SearchRec);
-{
-  opens dir
-}
-var
- res: string;
-  Dir : DirsTr;
-  Name : NameStr;
-  Ext: ExtStr;
-Begin
-  { initialize f.dirptr because it is used    }
-  { to see if we need to close the dir stream }
-  f.dirptr := nil;
-  if Path='' then
-   begin
-     DosError:=3;
-     exit;
-   end;
-  {We always also search for readonly and archive, regardless of Attr:}
-  f.SearchAttr := Attr or archive or readonly;
-{Wildcards?}
-  if (Pos('?',Path)=0)  and (Pos('*',Path)=0) then
-   begin
-     if FindGetFileInfo(Path,f) then
-      DosError:=0
-     else
-      begin
-        if ErrNo=Sys_ENOENT then
-         DosError:=3
-        else
-         DosError:=18;
-      end;
-     f.DirPtr:=nil;
-   end
-  else
-{Find Entry}
-   begin
-     FSplit(Path,Dir,Name,Ext);
-     if Ext <> '' then
-       res := Name + Ext
-     else
-       res := Name;
-     f.SearchSpec := res;
-     { if dir is an empty string }
-     { then this indicates that  }
-     { use the current working   }
-     { directory.                }
-     if dir = '' then
-        dir := './';
-     f.SearchDir := Dir;
-     { add terminating null character }
-     Dir := Dir + #0;
-     f.dirptr := sys_opendir(@Dir[1]);
-     if not assigned(f.dirptr) then
-     begin
-        DosError := 8;
-        exit;
-     end;
-     FindNext(f);
-   end;
-End;
-
-
-{******************************************************************************
-                               --- File ---
-******************************************************************************}
-
-
-Function FSearch(const path:pathstr;dirlist:string):pathstr;
-{
-  Searches for a file 'path' in the list of direcories in 'dirlist'.
-  returns an empty string if not found. Wildcards are NOT allowed.
-  If dirlist is empty, it is set to '.'
-}
-Var
-  NewDir : PathStr;
-  p1     : Longint;
-  Info   : Stat;
-  buffer : array[0..FileNameLen+1] of char;
-Begin
-  Move(path[1], Buffer, Length(path));
-  Buffer[Length(path)]:=#0;
-  if (length(Path)>0) and (path[1]='/') and (sys_stat(pchar(@Buffer),info)=0) then
-  begin
-    FSearch:=path;
-    exit;
-  end;
-{Replace ':' with ';'}
-  for p1:=1to length(dirlist) do
-   if dirlist[p1]=':' then
-    dirlist[p1]:=';';
-{Check for WildCards}
-  If (Pos('?',Path) <> 0) or (Pos('*',Path) <> 0) Then
-   FSearch:='' {No wildcards allowed in these things.}
-  Else
-   Begin
-     Dirlist:='.;'+dirlist;{Make sure current dir is first to be searched.}
-     Repeat
-       p1:=Pos(';',DirList);
-       If p1=0 Then
-        p1:=255;
-       NewDir:=Copy(DirList,1,P1 - 1);
-       if NewDir[Length(NewDir)]<>'/' then
-        NewDir:=NewDir+'/';
-       NewDir:=NewDir+Path;
-       Delete(DirList,1,p1);
-       Move(NewDir[1], Buffer, Length(NewDir));
-       Buffer[Length(NewDir)]:=#0;
-       if sys_stat(pchar(@Buffer),Info)=0 then
-        Begin
-          If Pos('./',NewDir)=1 Then
-           Delete(NewDir,1,2);
-        {DOS strips off an initial .\}
-        End
-       Else
-        NewDir:='';
-     Until (DirList='') or (Length(NewDir) > 0);
-     FSearch:=NewDir;
-   End;
-End;
-
-
-
-Procedure GetFAttr(var f; var attr : word);
-Var
-  info : stat;
-  LinAttr : mode_t;
-Begin
-  DosError:=0;
-  if sys_stat(@textrec(f).name,info)<>0 then
-   begin
-     Attr:=0;
-     DosError:=3;
-     exit;
-   end
-  else
-   LinAttr:=Info.st_Mode;
-  if S_ISDIR(LinAttr) then
-   Attr:=directory
-  else
-   Attr:=0;
-  if sys_Access(@textrec(f).name,W_OK)<>0 then
-   Attr:=Attr or readonly;
-  if (filerec(f).name[0]='.')  then
-   Attr:=Attr or hidden;
-end;
-
-
-
-Procedure getftime (var f; var time : longint);
-Var
-  Info: stat;
-  DT: DateTime;
-Begin
-  doserror:=0;
-  if sys_fstat(filerec(f).handle,info)<>0 then
-   begin
-     Time:=0;
-     doserror:=3;
-     exit
-   end
-  else
-   UnixDateToDT(Info.st_mtime,DT);
-  PackTime(DT,Time);
-End;
-
-
-
-{******************************************************************************
-                             --- Environment ---
-******************************************************************************}
-
-Function EnvCount: Longint;
-var
-  envcnt : longint;
-  p      : ppchar;
-Begin
-  envcnt:=0;
-  p:=envp;      {defined in syslinux}
-  while (p^<>nil) do
-   begin
-     inc(envcnt);
-     inc(p);
-   end;
-  EnvCount := envcnt
-End;
-
-
-
-Function EnvStr (Index: longint): String;
-Var
-  i : longint;
-  p : ppchar;
-Begin
-  p:=envp;      {defined in syslinux}
-  i:=1;
-  envstr:='';
-  if (index < 1) or (index > EnvCount) then
-    exit;
-  while (i<Index) and (p^<>nil) do
-   begin
-     inc(i);
-     inc(p);
-   end;
-  if p<>nil then
-   envstr:=strpas(p^)
-End;
-
-
-Function GetEnv(EnvVar:string):string;
-{
-  Searches the environment for a string with name p and
-  returns a pchar to it's value.
-  A pchar is used to accomodate for strings of length > 255
-}
-var
-  ep    : ppchar;
-  found : boolean;
-  p1 : pchar;
-Begin
-  EnvVar:=EnvVar+'=';            {Else HOST will also find HOSTNAME, etc}
-  ep:=envp;
-  found:=false;
-  if ep<>nil then
-   begin
-     while (not found) and (ep^<>nil) do
-      begin
-        if strlcomp(@EnvVar[1],(ep^),length(EnvVar))=0 then
-         found:=true
-        else
-         inc(ep);
-      end;
-   end;
-  if found then
-   p1:=ep^+length(EnvVar)
-  else
-   p1:=nil;
-  if p1 = nil then
-    GetEnv := ''
-  else
-    GetEnv := StrPas(p1);
-end;
-
-
-
-Procedure setftime(var f; time : longint);
-Begin
-  {! No POSIX equivalent !}
-End;
-
-
-
-Procedure setfattr (var f;attr : word);
-Begin
-  {! No POSIX equivalent !}
-End;
-
-
-
-{ Include timezone routines }
-{$i timezone.inc}
-
-{******************************************************************************
-                            --- Initialization ---
-******************************************************************************}
-
-Initialization
-  InitLocalTime;
-
-finalization
-  DoneLocalTime;
-end.

rtl/beos/dos_beos.inc

@@ -1,143 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2001 by members of the Free Pascal
-    development team
-
-    Operating system specific calls for DOS unit (part of POSIX interface)
-
-    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.
-
- **********************************************************************}
-{$i syscall.inc}
-{$i beos.inc}
-
-{$define DOS_HAS_EXEC}
-
-
-{
-  The Diskfree and Disksize functions need a file on the specified drive, since this
-  is required for the statfs system call.
-  These filenames are set in drivestr[0..26], and have been preset to :
-   0 - '.'      (default drive - hence current dir is ok.)
-   1 - '/fd0/.'  (floppy drive 1 - should be adapted to local system )
-   2 - '/fd1/.'  (floppy drive 2 - should be adapted to local system )
-   3 - '/'       (C: equivalent of dos is the root partition)
-   4..26          (can be set by you're own applications)
-  ! Use AddDisk() to Add new drives !
-  They both return -1 when a failure occurs.
-  The drive names are OS specific
-}
-Const
-  FixDriveStr : array[0..3] of pchar=(
-    '.',            { the current directory }
-    '/disk 0/.',    { mounted floppy 1 }
-    '/disk 1/.',    { mounted floppy 2 }
-    '/boot/.'       { the boot up disk }
-    );
-
-
-Function DosVersion:Word;
-Begin
-  DosVersion := 0;
-End;
-
-
-
-Function DiskFree(Drive: Byte): int64;
-var
-  info: fs_info;
-  device : dev_t;
-Begin
-  device := 0;
-  DiskFree := -1;
-  if (Drive < 4) and (FixDriveStr[Drive]<>nil) then
-    begin
-     device:= dev_for_path(FixDriveStr[Drive]);
-    end
-  else
-  if (Drive>4) and (Drive<=MAX_DRIVES) and (drivestr[Drive]<>nil) then
-     device := dev_for_path(driveStr[drive])
-  else
-     begin
-       exit;
-     end;
-  if fs_Stat_dev(device,info)=0 then
-    DiskFree := int64(info.block_size)*int64(info.free_blocks);
-End;
-
-
-
-Function DiskSize(Drive: Byte): int64;
-var
-  info: fs_info;
-  device : dev_t;
-Begin
-  device := 0;
-  DiskSize:= -1;
-  if (Drive < 4) and (FixDriveStr[Drive]<>nil) then
-    begin
-     device:= dev_for_path(FixDriveStr[Drive]);
-    end
-  else
-  if (Drive>4) and (Drive<=MAX_DRIVES) and (drivestr[Drive]<>nil) then
-     device := dev_for_path(driveStr[drive])
-  else
-     begin
-       exit;
-     end;
-  if fs_Stat_dev(device,info)=0 then
-    DiskSize := int64(info.block_size)*int64(info.total_blocks);
-End;
-
-
-
-{******************************************************************************
-                               --- Exec ---
-******************************************************************************}
-Procedure Exec(const path: pathstr; const comline: comstr);
-var p:string;
-    argv:ppchar;
-    argc:longint;
-    th:thread_id;
-    status : status_t;
-begin
-  LastDosExitCode:=0;
-  DosError:= 0;
-  p:=path+' '+comline;
-  argv:=StringToPPChar(p,argc);
-  th:=load_image(argc,argv,system.envp);
-  if th<0 then begin
-    DosError:=5;  { lets emulate an error }
-    exit;
-  end;
-  wait_for_thread(th,status);
-  LastDosExitCode:=status and $FF; { only keep the lower 8-bits }
-end;
-
-
-function GetTimeZoneString : string;
-begin
-  GetTimeZoneString:=getenv('TZ');
-end;
-
-function GetTimezoneFile:string;
-var
-  f,len : longint;
-  s : string;
-  info : stat;
-  buffer : array[0..MAXPATHLEN+1] of char;
-begin
-  GetTimezoneFile:='';
-
-  if kget_tzfilename(pchar(@buffer))=0 then
-  begin
-     GetTimeZoneFile := strpas(pchar(@buffer));
-  end;
-end;
-
-

rtl/beos/errno.inc

@@ -14,6 +14,223 @@
  **********************************************************************}
 
 const
+
+  LONG_MIN = -2147483648;
+
+//----- Error baselines ---------------------------------------
+  B_GENERAL_ERROR_BASE      = LONG_MIN;
+  B_OS_ERROR_BASE           = B_GENERAL_ERROR_BASE + $1000;
+  B_APP_ERROR_BASE          = B_GENERAL_ERROR_BASE + $2000;
+  B_INTERFACE_ERROR_BASE    = B_GENERAL_ERROR_BASE + $3000;
+  B_MEDIA_ERROR_BASE        = B_GENERAL_ERROR_BASE + $4000; // - 0x41ff
+  B_TRANSLATION_ERROR_BASE  = B_GENERAL_ERROR_BASE + $4800; // - 0x48ff
+  B_MIDI_ERROR_BASE         = B_GENERAL_ERROR_BASE + $5000;
+  B_STORAGE_ERROR_BASE      = B_GENERAL_ERROR_BASE + $6000;
+  B_POSIX_ERROR_BASE        = B_GENERAL_ERROR_BASE + $7000;
+  B_MAIL_ERROR_BASE         = B_GENERAL_ERROR_BASE + $8000;
+  B_PRINT_ERROR_BASE        = B_GENERAL_ERROR_BASE + $9000;
+  B_DEVICE_ERROR_BASE       = B_GENERAL_ERROR_BASE + $a000;
+
+  //--- Developer-defined errors start at (B_ERRORS_END+1)
+  B_ERRORS_END = B_GENERAL_ERROR_BASE + $ffff;
+
+//----- General Errors ----------------------------------------
+  B_NO_MEMORY         = B_GENERAL_ERROR_BASE;
+  B_IO_ERROR          = B_GENERAL_ERROR_BASE + 1;
+  B_PERMISSION_DENIED = B_GENERAL_ERROR_BASE + 2;
+  B_BAD_INDEX         = B_GENERAL_ERROR_BASE + 3;
+  B_BAD_TYPE          = B_GENERAL_ERROR_BASE + 4;
+  B_BAD_VALUE         = B_GENERAL_ERROR_BASE + 5;
+  B_MISMATCHED_VALUES = B_GENERAL_ERROR_BASE + 6;
+  B_NAME_NOT_FOUND    = B_GENERAL_ERROR_BASE + 7;
+  B_NAME_IN_USE       = B_GENERAL_ERROR_BASE + 8;
+  B_TIMED_OUT         = B_GENERAL_ERROR_BASE + 9;
+  B_INTERRUPTED       = B_GENERAL_ERROR_BASE + 10;
+  B_WOULD_BLOCK       = B_GENERAL_ERROR_BASE + 11;
+  B_CANCELED          = B_GENERAL_ERROR_BASE + 12;
+  B_NO_INIT           = B_GENERAL_ERROR_BASE + 13;
+  B_BUSY              = B_GENERAL_ERROR_BASE + 14;
+  B_NOT_ALLOWED       = B_GENERAL_ERROR_BASE + 15;
+
+  B_ERROR = -1;
+  B_OK = 0;
+  B_NO_ERROR = 0;
+
+//----- Kernel Kit Errors -------------------------------------
+  B_BAD_SEM_ID   = B_OS_ERROR_BASE;
+  B_NO_MORE_SEMS = B_OS_ERROR_BASE + 1;
+
+  B_BAD_THREAD_ID    = B_OS_ERROR_BASE + $100;
+  B_NO_MORE_THREADS  = B_BAD_THREAD_ID + 1;
+  B_BAD_THREAD_STATE = B_BAD_THREAD_ID + 2;
+  B_BAD_TEAM_ID      = B_BAD_THREAD_ID + 3;
+  B_NO_MORE_TEAMS    = B_BAD_THREAD_ID + 4;
+
+  B_BAD_PORT_ID   = B_OS_ERROR_BASE + $200;
+  B_NO_MORE_PORTS = B_BAD_PORT_ID + 1;
+
+  B_BAD_IMAGE_ID      = B_OS_ERROR_BASE + $300;
+  B_BAD_ADDRESS       = B_BAD_IMAGE_ID + 1;
+  B_NOT_AN_EXECUTABLE = B_BAD_IMAGE_ID + 2;
+  B_MISSING_LIBRARY   = B_BAD_IMAGE_ID + 3;
+  B_MISSING_SYMBOL    = B_BAD_IMAGE_ID + 4;
+
+  B_DEBUGGER_ALREADY_INSTALLED = B_OS_ERROR_BASE + $400;
+
+//----- Application Kit Errors --------------------------------
+  B_BAD_REPLY                         = B_APP_ERROR_BASE;
+  B_DUPLICATE_REPLY                   = B_APP_ERROR_BASE + 1;
+  B_MESSAGE_TO_SELF                   = B_APP_ERROR_BASE + 2;
+  B_BAD_HANDLER                       = B_APP_ERROR_BASE + 3;
+  B_ALREADY_RUNNING                   = B_APP_ERROR_BASE + 4;
+  B_LAUNCH_FAILED                     = B_APP_ERROR_BASE + 5;
+  B_AMBIGUOUS_APP_LAUNCH              = B_APP_ERROR_BASE + 6;
+  B_UNKNOWN_MIME_TYPE                 = B_APP_ERROR_BASE + 7;
+  B_BAD_SCRIPT_SYNTAX                 = B_APP_ERROR_BASE + 8;
+  B_LAUNCH_FAILED_NO_RESOLVE_LINK     = B_APP_ERROR_BASE + 9;
+  B_LAUNCH_FAILED_EXECUTABLE          = B_APP_ERROR_BASE + 10;
+  B_LAUNCH_FAILED_APP_NOT_FOUND       = B_APP_ERROR_BASE + 11;
+  B_LAUNCH_FAILED_APP_IN_TRASH        = B_APP_ERROR_BASE + 12;
+  B_LAUNCH_FAILED_NO_PREFERRED_APP    = B_APP_ERROR_BASE + 13;
+  B_LAUNCH_FAILED_FILES_APP_NOT_FOUND = B_APP_ERROR_BASE + 14;
+  B_BAD_MIME_SNIFFER_RULE             = B_APP_ERROR_BASE + 15;
+
+//----- Storage Kit/File System Errors ------------------------
+  B_FILE_ERROR          = B_STORAGE_ERROR_BASE;
+  B_FILE_NOT_FOUND      = B_STORAGE_ERROR_BASE + 1; // discouraged; use B_ENTRY_NOT_FOUND in new code
+  B_FILE_EXISTS         = B_STORAGE_ERROR_BASE + 2;
+  B_ENTRY_NOT_FOUND     = B_STORAGE_ERROR_BASE + 3;
+  B_NAME_TOO_LONG       = B_STORAGE_ERROR_BASE + 4;
+  B_NOT_A_DIRECTORY     = B_STORAGE_ERROR_BASE + 5;
+  B_DIRECTORY_NOT_EMPTY = B_STORAGE_ERROR_BASE + 6;
+  B_DEVICE_FULL         = B_STORAGE_ERROR_BASE + 7;
+  B_READ_ONLY_DEVICE    = B_STORAGE_ERROR_BASE + 8;
+  B_IS_A_DIRECTORY      = B_STORAGE_ERROR_BASE + 9;
+  B_NO_MORE_FDS         = B_STORAGE_ERROR_BASE + 10;
+  B_CROSS_DEVICE_LINK   = B_STORAGE_ERROR_BASE + 11;
+  B_LINK_LIMIT          = B_STORAGE_ERROR_BASE + 12;
+  B_BUSTED_PIPE         = B_STORAGE_ERROR_BASE + 13;
+  B_UNSUPPORTED         = B_STORAGE_ERROR_BASE + 14;
+  B_PARTITION_TOO_SMALL = B_STORAGE_ERROR_BASE + 15;
+
+//----- POSIX Errors ------------------------------------------
+  E2BIG           = B_POSIX_ERROR_BASE + 1;
+  ECHILD          = B_POSIX_ERROR_BASE + 2;
+  EDEADLK         = B_POSIX_ERROR_BASE + 3;
+  EFBIG           = B_POSIX_ERROR_BASE + 4;
+  EMLINK          = B_POSIX_ERROR_BASE + 5;
+  ENFILE          = B_POSIX_ERROR_BASE + 6;
+  ENODEV          = B_POSIX_ERROR_BASE + 7;
+  ENOLCK          = B_POSIX_ERROR_BASE + 8;
+  ENOSYS          = B_POSIX_ERROR_BASE + 9;
+  ENOTTY          = B_POSIX_ERROR_BASE + 10;
+  ENXIO           = B_POSIX_ERROR_BASE + 11;
+  ESPIPE          = B_POSIX_ERROR_BASE + 12;
+  ESRCH           = B_POSIX_ERROR_BASE + 13;
+  EFPOS           = B_POSIX_ERROR_BASE + 14;
+  ESIGPARM        = B_POSIX_ERROR_BASE + 15;
+  EDOM            = B_POSIX_ERROR_BASE + 16;
+  ERANGE          = B_POSIX_ERROR_BASE + 17;
+  EPROTOTYPE      = B_POSIX_ERROR_BASE + 18;
+  EPROTONOSUPPORT = B_POSIX_ERROR_BASE + 19;
+  EPFNOSUPPORT    = B_POSIX_ERROR_BASE + 20;
+  EAFNOSUPPORT    = B_POSIX_ERROR_BASE + 21;
+  EADDRINUSE      = B_POSIX_ERROR_BASE + 22;
+  EADDRNOTAVAIL   = B_POSIX_ERROR_BASE + 23;
+  ENETDOWN        = B_POSIX_ERROR_BASE + 24;
+  ENETUNREACH     = B_POSIX_ERROR_BASE + 25;
+  ENETRESET       = B_POSIX_ERROR_BASE + 26;
+  ECONNABORTED    = B_POSIX_ERROR_BASE + 27;
+  ECONNRESET      = B_POSIX_ERROR_BASE + 28;
+  EISCONN         = B_POSIX_ERROR_BASE + 29;
+  ENOTCONN        = B_POSIX_ERROR_BASE + 30;
+  ESHUTDOWN       = B_POSIX_ERROR_BASE + 31;
+  ECONNREFUSED    = B_POSIX_ERROR_BASE + 32;
+  EHOSTUNREACH    = B_POSIX_ERROR_BASE + 33;
+  ENOPROTOOPT     = B_POSIX_ERROR_BASE + 34;
+  ENOBUFS         = B_POSIX_ERROR_BASE + 35;
+  EINPROGRESS     = B_POSIX_ERROR_BASE + 36;
+  EALREADY        = B_POSIX_ERROR_BASE + 37;
+  EILSEQ          = B_POSIX_ERROR_BASE + 38;
+  ENOMSG          = B_POSIX_ERROR_BASE + 39;
+  ESTALE          = B_POSIX_ERROR_BASE + 40;
+  EOVERFLOW       = B_POSIX_ERROR_BASE + 41;
+  EMSGSIZE        = B_POSIX_ERROR_BASE + 42;
+  EOPNOTSUPP      = B_POSIX_ERROR_BASE + 43;                      
+  ENOTSOCK        = B_POSIX_ERROR_BASE + 44;
+
+  ENOMEM       = B_NO_MEMORY;
+  EACCES       = B_PERMISSION_DENIED;
+  EINTR        = B_INTERRUPTED;
+  EIO          = B_IO_ERROR;
+  EBUSY        = B_BUSY;
+  EFAULT       = B_BAD_ADDRESS;
+  ETIMEDOUT    = B_TIMED_OUT;
+  EAGAIN       = B_WOULD_BLOCK; // SysV compatibility
+  EWOULDBLOCK  = B_WOULD_BLOCK; // BSD compatibility
+  EBADF        = B_FILE_ERROR;
+  EEXIST       = B_FILE_EXISTS;
+  EINVAL       = B_BAD_VALUE;
+  ENAMETOOLONG = B_NAME_TOO_LONG;
+  ENOENT       = B_ENTRY_NOT_FOUND;
+  EPERM        = B_NOT_ALLOWED;
+  ENOTDIR      = B_NOT_A_DIRECTORY;
+  EISDIR       = B_IS_A_DIRECTORY;
+  ENOTEMPTY    = B_DIRECTORY_NOT_EMPTY;
+  ENOSPC       = B_DEVICE_FULL;
+  EROFS        = B_READ_ONLY_DEVICE;
+  EMFILE       = B_NO_MORE_FDS;
+  EXDEV        = B_CROSS_DEVICE_LINK;
+  ELOOP        = B_LINK_LIMIT;
+  ENOEXEC      = B_NOT_AN_EXECUTABLE;
+  EPIPE        = B_BUSTED_PIPE;
+
+//----- Media Kit Errors --------------------------------------
+  B_STREAM_NOT_FOUND       = B_MEDIA_ERROR_BASE;
+  B_SERVER_NOT_FOUND       = B_MEDIA_ERROR_BASE + 1;
+  B_RESOURCE_NOT_FOUND     = B_MEDIA_ERROR_BASE + 2;
+  B_RESOURCE_UNAVAILABLE   = B_MEDIA_ERROR_BASE + 3;
+  B_BAD_SUBSCRIBER         = B_MEDIA_ERROR_BASE + 4;
+  B_SUBSCRIBER_NOT_ENTERED = B_MEDIA_ERROR_BASE + 5;
+  B_BUFFER_NOT_AVAILABLE   = B_MEDIA_ERROR_BASE + 6;
+  B_LAST_BUFFER_ERROR      = B_MEDIA_ERROR_BASE + 7;
+
+//----- Mail Kit Errors ---------------------------------------
+  B_MAIL_NO_DAEMON      = B_MAIL_ERROR_BASE;
+  B_MAIL_UNKNOWN_USER   = B_MAIL_ERROR_BASE + 1;
+  B_MAIL_WRONG_PASSWORD = B_MAIL_ERROR_BASE + 2;
+  B_MAIL_UNKNOWN_HOST   = B_MAIL_ERROR_BASE + 3;
+  B_MAIL_ACCESS_ERROR   = B_MAIL_ERROR_BASE + 4;
+  B_MAIL_UNKNOWN_FIELD  = B_MAIL_ERROR_BASE + 5;
+  B_MAIL_NO_RECIPIENT   = B_MAIL_ERROR_BASE + 6;
+  B_MAIL_INVALID_MAIL   = B_MAIL_ERROR_BASE + 7;
+
+//----- Printing Errors --------------------------------------
+  B_NO_PRINT_SERVER = B_PRINT_ERROR_BASE;
+
+//----- Device Kit Errors -------------------------------------
+  B_DEV_INVALID_IOCTL          = B_DEVICE_ERROR_BASE;
+  B_DEV_NO_MEMORY              = B_DEVICE_ERROR_BASE + 1;
+  B_DEV_BAD_DRIVE_NUM          = B_DEVICE_ERROR_BASE + 2;
+  B_DEV_NO_MEDIA               = B_DEVICE_ERROR_BASE + 3;
+  B_DEV_UNREADABLE             = B_DEVICE_ERROR_BASE + 4;
+  B_DEV_FORMAT_ERROR           = B_DEVICE_ERROR_BASE + 5;
+  B_DEV_TIMEOUT                = B_DEVICE_ERROR_BASE + 6;
+  B_DEV_RECALIBRATE_ERROR      = B_DEVICE_ERROR_BASE + 7;
+  B_DEV_SEEK_ERROR             = B_DEVICE_ERROR_BASE + 8;
+  B_DEV_ID_ERROR               = B_DEVICE_ERROR_BASE + 9;
+  B_DEV_READ_ERROR             = B_DEVICE_ERROR_BASE + 10;
+  B_DEV_WRITE_ERROR            = B_DEVICE_ERROR_BASE + 11;
+  B_DEV_NOT_READY              = B_DEVICE_ERROR_BASE + 12;
+  B_DEV_MEDIA_CHANGED          = B_DEVICE_ERROR_BASE + 13;
+  B_DEV_MEDIA_CHANGE_REQUESTED = B_DEVICE_ERROR_BASE + 14;
+  B_DEV_RESOURCE_CONFLICT      = B_DEVICE_ERROR_BASE + 15;
+  B_DEV_CONFIGURATION_ERROR    = B_DEVICE_ERROR_BASE + 16;
+  B_DEV_DISABLED_BY_USER       = B_DEVICE_ERROR_BASE + 17;
+  B_DEV_DOOR_OPEN              = B_DEVICE_ERROR_BASE + 18;
+
+//-------------------------------------------------------------
+(*
 {----- Error baselines ---------------------------------------}
 
     B_GENERAL_ERROR_BASE        =   -2147483647-1;
@@ -36,94 +253,94 @@ const
 type
 {----- General Errors ----------------------------------------}
 tgeneralerrors=  (
-        B_NO_MEMORY := B_GENERAL_ERROR_BASE,
-        B_IO_ERROR,
-        B_PERMISSION_DENIED,
-        B_BAD_INDEX,
-        B_BAD_TYPE,
-        B_BAD_VALUE,
-        B_MISMATCHED_VALUES,
-        B_NAME_NOT_FOUND,
-        B_NAME_IN_USE,
-        B_TIMED_OUT,
+	B_NO_MEMORY := B_GENERAL_ERROR_BASE,
+	B_IO_ERROR,
+	B_PERMISSION_DENIED,
+	B_BAD_INDEX,
+	B_BAD_TYPE,
+	B_BAD_VALUE,
+	B_MISMATCHED_VALUES,
+	B_NAME_NOT_FOUND,
+	B_NAME_IN_USE,
+	B_TIMED_OUT,
     B_INTERRUPTED,
-        B_WOULD_BLOCK,
+	B_WOULD_BLOCK,
     B_CANCELED,
-        B_NO_INIT,
-        B_BUSY,
-        B_NOT_ALLOWED,
+	B_NO_INIT,
+	B_BUSY,
+	B_NOT_ALLOWED,
 
-        B_ERROR := -1,
-        B_OK := 0,
-        B_NO_ERROR := 0
+	B_ERROR := -1,
+	B_OK := 0,
+	B_NO_ERROR := 0
 );
 
 {----- Kernel Kit Errors -------------------------------------}
 tkernelerror  = (
-        B_BAD_SEM_ID := B_OS_ERROR_BASE,
-        B_NO_MORE_SEMS,
+	B_BAD_SEM_ID := B_OS_ERROR_BASE,
+	B_NO_MORE_SEMS,
 
-        B_BAD_THREAD_ID := B_OS_ERROR_BASE + $100,
-        B_NO_MORE_THREADS,
-        B_BAD_THREAD_STATE,
-        B_BAD_TEAM_ID,
-        B_NO_MORE_TEAMS,
+	B_BAD_THREAD_ID := B_OS_ERROR_BASE + $100,
+	B_NO_MORE_THREADS,
+	B_BAD_THREAD_STATE,
+	B_BAD_TEAM_ID,
+	B_NO_MORE_TEAMS,
 
-        B_BAD_PORT_ID := B_OS_ERROR_BASE + $200,
-        B_NO_MORE_PORTS,
+	B_BAD_PORT_ID := B_OS_ERROR_BASE + $200,
+	B_NO_MORE_PORTS,
 
-        B_BAD_IMAGE_ID := B_OS_ERROR_BASE + $300,
-        B_BAD_ADDRESS,
-        B_NOT_AN_EXECUTABLE,
-        B_MISSING_LIBRARY,
-        B_MISSING_SYMBOL,
+	B_BAD_IMAGE_ID := B_OS_ERROR_BASE + $300,
+	B_BAD_ADDRESS,
+	B_NOT_AN_EXECUTABLE,
+	B_MISSING_LIBRARY,
+	B_MISSING_SYMBOL,
 
-        B_DEBUGGER_ALREADY_INSTALLED := B_OS_ERROR_BASE + $400
+	B_DEBUGGER_ALREADY_INSTALLED := B_OS_ERROR_BASE + $400
 );
 
 
 {----- Application Kit Errors --------------------------------}
 tapperrors =
 (
-        B_BAD_REPLY := B_APP_ERROR_BASE,
-        B_DUPLICATE_REPLY,
-        B_MESSAGE_TO_SELF,
-        B_BAD_HANDLER,
-        B_ALREADY_RUNNING,
-        B_LAUNCH_FAILED,
-        B_AMBIGUOUS_APP_LAUNCH,
-        B_UNKNOWN_MIME_TYPE,
-        B_BAD_SCRIPT_SYNTAX,
-        B_LAUNCH_FAILED_NO_RESOLVE_LINK,
-        B_LAUNCH_FAILED_EXECUTABLE,
-        B_LAUNCH_FAILED_APP_NOT_FOUND,
-        B_LAUNCH_FAILED_APP_IN_TRASH,
-        B_LAUNCH_FAILED_NO_PREFERRED_APP,
-        B_LAUNCH_FAILED_FILES_APP_NOT_FOUND
+	B_BAD_REPLY := B_APP_ERROR_BASE,
+	B_DUPLICATE_REPLY,
+	B_MESSAGE_TO_SELF,
+	B_BAD_HANDLER,
+	B_ALREADY_RUNNING,
+	B_LAUNCH_FAILED,
+	B_AMBIGUOUS_APP_LAUNCH,
+	B_UNKNOWN_MIME_TYPE,
+	B_BAD_SCRIPT_SYNTAX,
+	B_LAUNCH_FAILED_NO_RESOLVE_LINK,
+	B_LAUNCH_FAILED_EXECUTABLE,
+	B_LAUNCH_FAILED_APP_NOT_FOUND,
+	B_LAUNCH_FAILED_APP_IN_TRASH,
+	B_LAUNCH_FAILED_NO_PREFERRED_APP,
+	B_LAUNCH_FAILED_FILES_APP_NOT_FOUND
 );
 
 
 {----- Storage Kit/File System Errors ------------------------}
 tfserrors= (
-        B_FILE_ERROR :=B_STORAGE_ERROR_BASE,
-        B_FILE_NOT_FOUND,       { discouraged; use B_ENTRY_NOT_FOUND in new code }
-        B_FILE_EXISTS,
-        B_ENTRY_NOT_FOUND,
-        B_NAME_TOO_LONG,
-        B_NOT_A_DIRECTORY,
-        B_DIRECTORY_NOT_EMPTY,
-        B_DEVICE_FULL,
-        B_READ_ONLY_DEVICE,
-        B_IS_A_DIRECTORY,
-        B_NO_MORE_FDS,
-        B_CROSS_DEVICE_LINK,
-        B_LINK_LIMIT,
-        B_BUSTED_PIPE,
-        B_UNSUPPORTED,
-        B_PARTITION_TOO_SMALL
+	B_FILE_ERROR :=B_STORAGE_ERROR_BASE,
+	B_FILE_NOT_FOUND,       { discouraged; use B_ENTRY_NOT_FOUND in new code }
+	B_FILE_EXISTS,
+	B_ENTRY_NOT_FOUND,
+	B_NAME_TOO_LONG,
+	B_NOT_A_DIRECTORY,
+	B_DIRECTORY_NOT_EMPTY,
+	B_DEVICE_FULL,
+	B_READ_ONLY_DEVICE,
+	B_IS_A_DIRECTORY,
+	B_NO_MORE_FDS,
+	B_CROSS_DEVICE_LINK,
+	B_LINK_LIMIT,
+	B_BUSTED_PIPE,
+	B_UNSUPPORTED,
+	B_PARTITION_TOO_SMALL
 );
 
-
+*)
 const
 
 {***********************************************************************}
@@ -131,78 +348,77 @@ const
 {***********************************************************************}
 
     { The following constants are system dependent but must all exist }
-    Sys_E2BIG       = (B_POSIX_ERROR_BASE + 1);
-    Sys_EACCES      = ord(B_PERMISSION_DENIED);
-    Sys_EAGAIN      = ord(B_WOULD_BLOCK);
-    Sys_EBADF       = ord(B_FILE_ERROR);
-    Sys_EBUSY       = ord(B_BUSY);
-    Sys_ECHILD      = (B_POSIX_ERROR_BASE + 2);
-    Sys_EDEADLK     = (B_POSIX_ERROR_BASE + 3);
-    Sys_EDOM        = (B_POSIX_ERROR_BASE + 16);
-    Sys_EEXIST      = ord(B_FILE_EXISTS);
-    Sys_EFAULT      = ord(B_BAD_ADDRESS);
-    Sys_EFBIG       = (B_POSIX_ERROR_BASE + 4);
-    Sys_EINTR       = ord(B_INTERRUPTED);
-    Sys_EINVAL      = ord(B_BAD_VALUE);
-    Sys_EIO         = ord(B_IO_ERROR);
-    Sys_EISDIR      = ord(B_IS_A_DIRECTORY);
-    Sys_EMFILE      = ord(B_NO_MORE_FDS);
-    Sys_EMLINK      = (B_POSIX_ERROR_BASE + 5);
-    Sys_ENAMETOOLONG= ord(B_NAME_TOO_LONG);
-    Sys_ENFILE      = (B_POSIX_ERROR_BASE + 6);
-    Sys_ENODEV      = (B_POSIX_ERROR_BASE + 7);
-    Sys_ENOENT      = ord(B_ENTRY_NOT_FOUND);
-    Sys_ENOEXEC     = ord(B_NOT_AN_EXECUTABLE);
-    Sys_ENOLCK      = (B_POSIX_ERROR_BASE + 8);
-    Sys_ENOMEM      = ord(B_NO_MEMORY);
-    Sys_ENOSPC      = ord(B_DEVICE_FULL);
-    Sys_ENOSYS      = (B_POSIX_ERROR_BASE + 9);
-    Sys_ENOTDIR     = ord(B_NOT_A_DIRECTORY);
-    Sys_ENOTEMPTY   = ord(B_DIRECTORY_NOT_EMPTY);
-    Sys_ENOTTY      = (B_POSIX_ERROR_BASE + 10);
-    Sys_ENXIO       = (B_POSIX_ERROR_BASE + 11);
-    Sys_EPERM       = ord(B_NOT_ALLOWED);
-    Sys_EPIPE       = ord(B_BUSTED_PIPE);
-    Sys_ERANGE      = (B_POSIX_ERROR_BASE + 17);
-    Sys_EROFS       = ord(B_READ_ONLY_DEVICE);
-    Sys_ESPIPE      = (B_POSIX_ERROR_BASE + 12);
-    Sys_ESRCH       = (B_POSIX_ERROR_BASE + 13);
-    Sys_ETIMEDOUT   = ord(B_TIMED_OUT);
-    Sys_EXDEV       = ord(B_CROSS_DEVICE_LINK);
-
-    {Sys_EBADMSG     =    realtime extension POSIX only   }
-    {Sys_ECANCELED   =    async. I/O extension POSIX only }
-    {Sys_EMSGSIZE    =    realtime extension POSIX only   }
-    {Sys_EINPROGRESS =    async. I/O extension POSIX only }
+    ESysE2BIG       = (B_POSIX_ERROR_BASE + 1);
+    ESysEACCES      = ord(B_PERMISSION_DENIED);
+    ESysEAGAIN      = ord(B_WOULD_BLOCK);
+    ESysEBADF       = ord(B_FILE_ERROR);
+    ESysEBUSY       = ord(B_BUSY);
+    ESysECHILD      = (B_POSIX_ERROR_BASE + 2);
+    ESysEDEADLK     = (B_POSIX_ERROR_BASE + 3);
+    ESysEDOM        = (B_POSIX_ERROR_BASE + 16);
+    ESysEEXIST      = ord(B_FILE_EXISTS);
+    ESysEFAULT      = ord(B_BAD_ADDRESS);
+    ESysEFBIG       = (B_POSIX_ERROR_BASE + 4);
+    ESysEINTR       = ord(B_INTERRUPTED);
+    ESysEINVAL      = ord(B_BAD_VALUE);
+    ESysEIO         = ord(B_IO_ERROR);
+    ESysEISDIR      = ord(B_IS_A_DIRECTORY);
+    ESysEMFILE      = ord(B_NO_MORE_FDS);
+    ESysEMLINK      = (B_POSIX_ERROR_BASE + 5);
+    ESysENAMETOOLONG= ord(B_NAME_TOO_LONG);
+    ESysENFILE      = (B_POSIX_ERROR_BASE + 6);
+    ESysENODEV      = (B_POSIX_ERROR_BASE + 7);
+    ESysENOENT      = ord(B_ENTRY_NOT_FOUND);
+    ESysENOEXEC     = ord(B_NOT_AN_EXECUTABLE);
+    ESysENOLCK      = (B_POSIX_ERROR_BASE + 8);
+    ESysENOMEM      = ord(B_NO_MEMORY);
+    ESysENOSPC      = ord(B_DEVICE_FULL);
+    ESysENOSYS      = (B_POSIX_ERROR_BASE + 9);
+    ESysENOTDIR     = ord(B_NOT_A_DIRECTORY);
+    ESysENOTEMPTY   = ord(B_DIRECTORY_NOT_EMPTY);
+    ESysENOTTY      = (B_POSIX_ERROR_BASE + 10);
+    ESysENXIO       = (B_POSIX_ERROR_BASE + 11);
+    ESysEPERM       = ord(B_NOT_ALLOWED);
+    ESysEPIPE       = ord(B_BUSTED_PIPE);
+    ESysERANGE      = (B_POSIX_ERROR_BASE + 17);
+    ESysEROFS       = ord(B_READ_ONLY_DEVICE);
+    ESysESPIPE      = (B_POSIX_ERROR_BASE + 12);
+    ESysESRCH       = (B_POSIX_ERROR_BASE + 13);
+    ESysETIMEDOUT   = ord(B_TIMED_OUT);
+    ESysEXDEV       = ord(B_CROSS_DEVICE_LINK);
+
+    {ESysEBADMSG     =    realtime extension POSIX only   }
+    {ESysECANCELED   =    async. I/O extension POSIX only }
+    {ESysEMSGSIZE    =    realtime extension POSIX only   }
+    {ESysEINPROGRESS =    async. I/O extension POSIX only }
 
 {***********************************************************************}
 {                   NON POSIX ERROR DEFINITIONS                         }
 {***********************************************************************}
-     sys_EFPOS           = (B_POSIX_ERROR_BASE + 14);
-     sys_ESIGPARM        = (B_POSIX_ERROR_BASE + 15);
-     sys_EPROTOTYPE      = (B_POSIX_ERROR_BASE + 18);
-     sys_EPROTONOSUPPORT = (B_POSIX_ERROR_BASE + 19);
-     sys_EPFNOSUPPORT    = (B_POSIX_ERROR_BASE + 20);
-     sys_EAFNOSUPPORT    = (B_POSIX_ERROR_BASE + 21);
-     sys_EADDRINUSE      = (B_POSIX_ERROR_BASE + 22);
-     sys_EADDRNOTAVAIL   = (B_POSIX_ERROR_BASE + 23);
-     sys_ENETDOWN        = (B_POSIX_ERROR_BASE + 24);
-     sys_ENETUNREACH     = (B_POSIX_ERROR_BASE + 25);
-     sys_ENETRESET       = (B_POSIX_ERROR_BASE + 26);
-     sys_ECONNABORTED    = (B_POSIX_ERROR_BASE + 27);
-     sys_ECONNRESET       = (B_POSIX_ERROR_BASE + 28);
-
-     sys_EISCONN      = (B_POSIX_ERROR_BASE + 29);
-     sys_ENOTCONN     = (B_POSIX_ERROR_BASE + 30);
-     sys_ESHUTDOWN    = (B_POSIX_ERROR_BASE + 31);
-     sys_ECONNREFUSED = (B_POSIX_ERROR_BASE + 32);
-     sys_EHOSTUNREACH = (B_POSIX_ERROR_BASE + 33);
-     sys_ENOPROTOOPT  = (B_POSIX_ERROR_BASE + 34);
-     sys_ENOBUFS      = (B_POSIX_ERROR_BASE + 35);
-     sys_EINPROGRESS  = (B_POSIX_ERROR_BASE + 36);
-     sys_EALREADY     = (B_POSIX_ERROR_BASE + 37);
-
-     sys_EWOULDBLOCK  = ord(B_WOULD_BLOCK);  {* BSD compatibility *}
-     sys_ELOOP        = ord(B_LINK_LIMIT);
+     EsysEFPOS           = (B_POSIX_ERROR_BASE + 14);
+     EsysESIGPARM        = (B_POSIX_ERROR_BASE + 15);
+     EsysEPROTOTYPE      = (B_POSIX_ERROR_BASE + 18);
+     EsysEPROTONOSUPPORT = (B_POSIX_ERROR_BASE + 19);
+     EsysEPFNOSUPPORT    = (B_POSIX_ERROR_BASE + 20);
+     EsysEAFNOSUPPORT    = (B_POSIX_ERROR_BASE + 21);
+     EsysEADDRINUSE      = (B_POSIX_ERROR_BASE + 22);
+     EsysEADDRNOTAVAIL   = (B_POSIX_ERROR_BASE + 23);
+     EsysENETDOWN        = (B_POSIX_ERROR_BASE + 24);
+     EsysENETUNREACH     = (B_POSIX_ERROR_BASE + 25);
+     EsysENETRESET       = (B_POSIX_ERROR_BASE + 26);
+     EsysECONNABORTED    = (B_POSIX_ERROR_BASE + 27);
+     EsysECONNRESET       = (B_POSIX_ERROR_BASE + 28);
+
+     EsysEISCONN      = (B_POSIX_ERROR_BASE + 29);
+     EsysENOTCONN     = (B_POSIX_ERROR_BASE + 30);
+     EsysESHUTDOWN    = (B_POSIX_ERROR_BASE + 31);
+     EsysECONNREFUSED = (B_POSIX_ERROR_BASE + 32);
+     EsysEHOSTUNREACH = (B_POSIX_ERROR_BASE + 33);
+     EsysENOPROTOOPT  = (B_POSIX_ERROR_BASE + 34);
+     EsysENOBUFS      = (B_POSIX_ERROR_BASE + 35);
+     EsysEINPROGRESS  = (B_POSIX_ERROR_BASE + 36);
+     EsysEALREADY     = (B_POSIX_ERROR_BASE + 37);
 
+     EsysEWOULDBLOCK  = ord(B_WOULD_BLOCK);  {* BSD compatibility *}
+     EsysELOOP        = ord(B_LINK_LIMIT);
 

rtl/beos/errnostr.inc

@@ -0,0 +1,150 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by the Free Pascal development team.
+
+    Contains BeOS specific errors for error.pp in rtl/unix
+
+    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.
+
+ **********************************************************************}
+
+const
+  // TODO : check against BeOS real values...
+  sys_errn=125;
+  sys_errlist:array[0..sys_errn-1] of pchar = (
+        'Success',                              { 0 }
+        'Operation not permitted',              { EPERM }
+        'No such file or directory',            { ENOENT }
+        'No such process',                      { ESRCH }
+        'Interrupted system call',              { EINTR }
+        'I/O error',                            { EIO }
+        'No such device or address',            { ENXIO }
+        'Arg list too long',                    { E2BIG }
+        'Exec format error',                    { ENOEXEC }
+        'Bad file number',                      { EBADF }
+        'No child processes',                   { ECHILD }
+        'Try again',                            { EAGAIN }
+        'Out of memory',                        { ENOMEM }
+        'Permission denied',                    { EACCES }
+        'Bad address',                          { EFAULT }
+        'Block device required',                { ENOTBLK }
+        'Device or resource busy',              { EBUSY }
+        'File exists',                          { EEXIST }
+        'Cross-device link',                    { EXDEV }
+        'No such device',                       { ENODEV }
+        'Not a directory',                      { ENOTDIR }
+        'Is a directory',                       { EISDIR }
+        'Invalid argument',                     { EINVAL }
+        'File table overflow',                  { ENFILE }
+        'Too many open files',                  { EMFILE }
+        'Not a typewriter',                     { ENOTTY }
+        'Text (code segment) file busy',        { ETXTBSY  Text file busy.  The new process was
+                                                    a pure procedure (shared text) file which was
+                                                    open for writing by another process, or file
+                                                    which was open for writing by another process,
+                                                    or while the pure procedure file was being
+                                                    executed an open(2) call requested write access
+                                                    requested write access.}
+        'File too large',                       { EFBIG }
+        'No space left on device',              { ENOSPC }
+        'Illegal seek',                         { ESPIPE }
+        'Read-only file system',                { EROFS }
+        'Too many links',                       { EMLINK }
+        'Broken pipe',                          { EPIPE }
+        'Math argument out of domain of func',  { EDOM }
+        'Math result not representable',        { ERANGE }
+        'Resource deadlock would occur',        { EDEADLK }
+        'File name too long',                   { ENAMETOOLONG }
+        'No record locks available',            { ENOLCK }
+        'Function not implemented',             { ENOSYS }
+        'Directory not empty',                  { ENOTEMPTY }
+        'Too many symbolic links encountered',  { ELOOP }
+        'Operation would block',                { EWOULDBLOCK }
+        'No message of desired type',           { ENOMSG }
+        'Identifier removed',                   { EIDRM }
+        'Channel number out of range',          { ECHRNG }
+        'Level 2 not synchronized',             { EL2NSYNC }
+        'Level 3 halted',                       { EL3HLT }
+        'Level 3 reset',                        { EL3RST }
+        'Link number out of range',             { ELNRNG }
+        'Protocol driver not attached',         { EUNATCH }
+        'No CSI structure available',           { ENOCSI }
+        'Level 2 halted',                       { EL2HLT }
+        'Invalid exchange',                     { EBADE }
+        'Invalid request descriptor',           { EBADR }
+        'Exchange full',                        { EXFULL }
+        'No anode',                             { ENOANO }
+        'Invalid request code',                 { EBADRQC }
+        'Invalid slot',                         { EBADSLT }
+        'File locking deadlock error',          { EDEADLOCK }
+        'Bad font file format',                 { EBFONT }
+        'Device not a stream',                  { ENOSTR }
+        'No data available',                    { ENODATA }
+        'Timer expired',                        { ETIME }
+        'Out of streams resources',             { ENOSR }
+        'Machine is not on the network',        { ENONET }
+        'Package not installed',                { ENOPKG }
+        'Object is remote',                     { EREMOTE }
+        'Link has been severed',                { ENOLINK }
+        'Advertise error',                      { EADV }
+        'Srmount error',                        { ESRMNT }
+        'Communication error on send',          { ECOMM }
+        'Protocol error',                       { EPROTO }
+        'Multihop attempted',                   { EMULTIHOP }
+        'RFS specific error',                   { EDOTDOT }
+        'Not a data message',                   { EBADMSG }
+        'Value too large for defined data type',        { EOVERFLOW }
+        'Name not unique on network',           { ENOTUNIQ }
+        'File descriptor in bad state',         { EBADFD }
+        'Remote address changed',               { EREMCHG }
+        'Can not access a needed shared library',       { ELIBACC }
+        'Accessing a corrupted shared library',         { ELIBBAD }
+        '.lib section in a.out corrupted',      { ELIBSCN }
+        'Attempting to link in too many shared libraries',      { ELIBMAX }
+        'Cannot exec a shared library directly',        { ELIBEXEC }
+        'Illegal byte sequence',                { EILSEQ }
+        'Interrupted system call should be restarted',  { ERESTART }
+        'Streams pipe error',                   { ESTRPIPE }
+        'Too many users',                       { EUSERS }
+        'Socket operation on non-socket',       { ENOTSOCK }
+        'Destination address required',         { EDESTADDRREQ }
+        'Message too long',                     { EMSGSIZE }
+        'Protocol wrong type for socket',       { EPROTOTYPE }
+        'Protocol not available',               { ENOPROTOOPT }
+        'Protocol not supported',               { EPROTONOSUPPORT }
+        'Socket type not supported',            { ESOCKTNOSUPPORT }
+        'Operation not supported on transport endpoint',        { EOPNOTSUPP }
+        'Protocol family not supported',        { EPFNOSUPPORT }
+        'Address family not supported by protocol',     { EAFNOSUPPORT }
+        'Address already in use',               { EADDRINUSE }
+        'Cannot assign requested address',      { EADDRNOTAVAIL }
+        'Network is down',                      { ENETDOWN }
+        'Network is unreachable',               { ENETUNREACH }
+        'Network dropped connection because of reset',  { ENETRESET }
+        'Software caused connection abort',     { ECONNABORTED }
+        'Connection reset by peer',             { ECONNRESET }
+        'No buffer space available',            { ENOBUFS }
+        'Transport endpoint is already connected',      { EISCONN }
+        'Transport endpoint is not connected',  { ENOTCONN }
+        'Cannot send after transport endpoint shutdown',        { ESHUTDOWN }
+        'Too many references: cannot splice',   { ETOOMANYREFS }
+        'Connection timed out',                 { ETIMEDOUT }
+        'Connection refused',                   { ECONNREFUSED }
+        'Host is down',                         { EHOSTDOWN }
+        'No route to host',                     { EHOSTUNREACH }
+        'Operation already in progress',        { EALREADY }
+        'Operation now in progress',            { EINPROGRESS }
+        'Stale NFS file handle',                { ESTALE }
+        'Structure needs cleaning',             { EUCLEAN }
+        'Not a XENIX named type file',          { ENOTNAM }
+        'No XENIX semaphores available',        { ENAVAIL }
+        'Is a named type file',                 { EISNAM }
+        'Remote I/O error',                     { EREMOTEIO }
+        'Quota exceeded',                       { EDQUOT }
+        'No medium found',                      { ENOMEDIUM }
+        'Wrong medium type');                   { EMEDIUMTYPE }

rtl/beos/i386/cprt0.as

@@ -41,9 +41,9 @@ _start:
         call _init_c_library_
         call _call_init_routines_
         movl 8(%ebp),%eax
-        movl %eax,U_SYSTEM_ARGC
-        movl %edi,U_SYSTEM_ARGV
-        movl %esi,U_SYSTEM_ENVP
+        movl %eax,operatingsystem_parameter_argc
+        movl %edi,operatingsystem_parameter_argv
+        movl %esi,operatingsystem_parameter_envp        
         xorl %ebp,%ebp
         call PASCALMAIN
 
@@ -52,7 +52,7 @@ _start:
 _haltproc:
         call _thread_do_exit_notification
         xorl %ebx,%ebx
-    movw U_SYSTEM_EXITCODE,%bx
+    movw operatingsystem_result,%bx
         pushl %ebx
         call exit
 
@@ -215,3 +215,9 @@ ret
 sys_call:
 int $0x25
 ret
+
+.bss
+        .comm operatingsystem_parameter_envp,4
+        .comm operatingsystem_parameter_argc,4
+        .comm operatingsystem_parameter_argv,4
+	

rtl/beos/i386/dllprt.as

@@ -72,14 +72,14 @@ __7FPC_DLL:
 .L11:
         popl %ebx
         addl $_GLOBAL_OFFSET_TABLE_+[.-.L11],%ebx
-        movl U_SYSBEOS_ARGC@GOT(%ebx),%eax
+        movl operatingsystem_parameter_argc@GOT(%ebx),%eax
         movl $0,(%eax)
-        movl U_SYSBEOS_ARGV@GOT(%ebx),%eax
+        movl operatingsystem_parameter_argv@GOT(%ebx),%eax
         movl %ebx,%ecx
         addl $_argv@GOTOFF,%ecx
         movl %ecx,%edx
         movl %edx,(%eax)
-        movl U_SYSBEOS_ENVP@GOT(%ebx),%eax
+        movl operatingsystem_parameter_envp@GOT(%ebx),%eax
         movl %ebx,%ecx
         addl $_envp@GOTOFF,%ecx
         movl %ecx,%edx

rtl/beos/i386/dllprt.cpp

@@ -16,9 +16,9 @@ static FPC_DLL fpc_dll();
 
 
 extern "C" void PASCALMAIN(void);
-extern int U_SYSBEOS_ARGC;
-extern void * U_SYSBEOS_ARGV;
-extern void * U_SYSBEOS_ENVP;
+extern int operatingsystem_parameter_argc;
+extern void * operatingsystem_parameter_argv;
+extern void * operatingsystem_parameter_envp;
 
 static char * _argv[] = {"dll",0};
 static char * _envp[] = {0};
@@ -26,9 +26,9 @@ static char * _envp[] = {0};
 extern "C" void BEGIN()
 {
         printf ("init\n");
-        U_SYSBEOS_ARGC=0;
-        U_SYSBEOS_ARGV = (void *)_argv;
-        U_SYSBEOS_ENVP = (void *)_envp;
+        operatingsystem_parameter_argc=0;
+        operatingsystem_parameter_argv = (void *)_argv;
+        operatingsystem_parameter_envp = (void *)_envp;
         PASCALMAIN();
 }
 

rtl/beos/i386/func.as

@@ -5,7 +5,7 @@
 .type   _haltproc,@function
 _haltproc:
         xorl %ebx,%ebx
-    movw U_SYSBEOS_EXITCODE,%bx
+    movw operatingsystem_result,%bx
         pushl %ebx
         call sys_exit
 

rtl/beos/i386/prt0.as

@@ -8,9 +8,9 @@ start:
         movl 16(%ebp),%ecx
         movl 12(%ebp),%ebx
         movl 8(%ebp),%eax
-        movl %eax,U_SYSTEM_ARGC
-        movl %ebx,U_SYSTEM_ARGV
-        movl %ecx,U_SYSTEM_ENVP
+        movl %eax,operatingsystem_parameter_argc
+        movl %ebx,operatingsystem_parameter_argv
+        movl %ecx,operatingsystem_parameter_envp
         xorl %ebp,%ebp
         call PASCALMAIN
 
@@ -18,7 +18,7 @@ start:
 .type   _haltproc,@function
 _haltproc:
         xorl %ebx,%ebx
-        movw U_SYSTEM_EXITCODE,%bx
+        movw operatingsystem_result,%bx
         pushl %ebx
         call sys_exit
 
@@ -179,3 +179,8 @@ ret
 sys_call:
 int $0x25
 ret
+
+.bss
+        .comm operatingsystem_parameter_envp,4
+        .comm operatingsystem_parameter_argc,4
+        .comm operatingsystem_parameter_argv,4

rtl/beos/objinc.inc

@@ -1,96 +0,0 @@
-{ For linux we 'steal' the following from system unit, this way
-  we don't need to change the system unit interface. }
-
-Var errno : Longint;
-
-{$i sysnr.inc}
-{$i errno.inc}
-{$i sysconst.inc}
-{$i systypes.inc}
-{$i syscalls.inc}
-
-FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
-
-Var LinuxMode : longint;
-
-BEGIN
-  LinuxMode:=0;
-  if Mode=stCreate then
-  Begin
-     LinuxMode:=Open_Creat;
-     LinuxMode:=LinuxMode or Open_RdWr;
-  end
-  else
-   Begin
-     Case (Mode and 3) of
-      0 : LinuxMode:=LinuxMode or Open_RdOnly;
-      1 : LinuxMode:=LinuxMode or Open_WrOnly;
-      2 : LinuxMode:=LinuxMode or Open_RdWr;
-     end;
-   end;
-  FileOpen:=SYS_Open (pchar(@FileName[0]),LinuxMode,438 {666 octal});
-  If FileOpen=-1 then FileOpen:=0;
-  DosStreamError:=Errno;
-END;
-
-FUNCTION FileRead (Handle: THandle; Var BufferArea; BufferLength: Sw_Word;
-Var BytesMoved: Sw_Word): Word;
-BEGIN
-  BytesMoved:=Sys_read (Handle,Pchar(@BufferArea),BufferLength);
-  DosStreamError:=Errno;
-  FileRead:=Errno;
-END;
-
-FUNCTION FileWrite (Handle:  THandle; Var BufferArea; BufferLength: Sw_Word;
-Var BytesMoved: Sw_Word): Word;
-BEGIN
-  BytesMoved:=Sys_Write (Handle,Pchar(@BufferArea),BufferLength);
-  FileWrite:=Errno;
-  DosStreamError:=Errno;
-END;
-
-FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
-VAR NewPos: LongInt): Word;
-
-BEGIN
-  NewPos:=Sys_LSeek (Handle,Pos,MoveType);
-  SetFilePos:=Errno;
-END;
-
-FUNCTION FileClose (Handle: THandle): Word;
-BEGIN
-  Sys_Close (Handle);
-  DosStreamError:=Errno;
-  FileClose := Errno;
-END;
-
-FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
-
-{$IFNDEF BSD}
-Var sr : syscallregs;
-{$ENDIF}
-{$IFDEF DOSSETFILE1}
-    Actual, Buf: LongInt;
-{$ENDIF}
-
-BEGIN
- {$IFDEF BSD}
-  Do_Syscall(Syscall_Nr_ftruncate,handle,filesize,0); {0 -> offset =64 bit}
- {$ELSE}
-  sr.reg2:=Handle;
-  sr.reg3:=FileSize;
-  Syscall(syscall_nr_fTruncate,sr);
- {$ENDIF}
-  If Errno=0 then
-    SetFileSize:=0
-  else
-    SetFileSize:=103;
-{$IFDEF DOSSETFILE1}
-   If (Actual = FileSize) Then Begin                  { No position error }
-     Actual := FileWrite(Handle, Pointer(@Buf), 0,Actual);   { Truncate the file }
-     If (Actual <> -1) Then SetFileSize := 0 Else     { No truncate error }
-       SetFileSize := 103;                            { File truncate error }
-   End Else SetFileSize := 103;                       { File truncate error }
-{$ENDIF}
-END;
-

rtl/beos/osmacro.inc

@@ -0,0 +1,92 @@
+{
+    Copyright (c) 2000-2002 by Marco van de Voort
+
+    The *BSD POSIX macro's that are used both in the Baseunix unit as the
+    system unit. Not aliased via public names because I want these to be
+    inlined as much as possible in the future.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************}
+
+function FPS_ISDIR(m : TMode): boolean;
+
+begin
+ FPS_ISDIR:=((m and S_IFMT) = S_IFDIR);
+end;
+
+function FPS_ISCHR(m : TMode): boolean;
+begin
+ FPS_ISCHR:=((m and S_IFMT) = S_IFCHR);
+end;
+
+function FPS_ISBLK(m : TMode): boolean;
+begin
+ FPS_ISBLK:=((m and S_IFMT) = S_IFBLK);
+end;
+
+function FPS_ISREG(m : TMode): boolean;
+begin
+ FPS_ISREG:=((m and S_IFMT) = S_IFREG);
+end;
+
+function FPS_ISFIFO(m : TMode): boolean;
+begin
+ FPS_ISFIFO:=((m and S_IFMT) = S_IFIFO);
+end;
+
+Function FPS_ISLNK(m:TMode):boolean;
+
+begin
+ FPS_ISLNK:=((m and S_IFMT) = S_IFLNK);
+end;
+
+Function FPS_ISSOCK(m:TMode):boolean;
+
+begin
+ FPS_ISSOCK:=((m and S_IFMT) = S_IFSOCK);
+end;
+
+function wifexited(status : cint): boolean;
+begin
+ wifexited:=(status AND (not $FF)) = 0;
+end;
+
+function wexitstatus(status : cint): cint;
+begin
+ wexitstatus:=status AND $FF;
+end;
+
+// const wstopped=127;
+
+function wifsignaled(status : cint): boolean;
+begin
+ wifsignaled := ((status shr 8) AND $FF) <> 0;
+end;
+
+function wtermsig(status : cint):cint;
+begin
+ wtermsig:= ((status shr 8) AND $FF);
+end;
+
+function wstopsig(status : cint): cint;
+begin
+ wstopsig:=((status shr 16) AND $FF);
+end;
+
+
+
+
+

rtl/beos/osposix.inc

@@ -1,463 +0,0 @@
-{
-    Copyright (c) 2001 by Carl Eric Codere
-
-    Implements POSIX 1003.1  interface
-
-    This program is free software; you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation; either version 2 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program; if not, write to the Free Software
-    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ****************************************************************************
-}
-
-
-const
-      syscall_nr_exit   =   $3F;
-      syscall_nr_chdir  =   $57;
-      syscall_nr_mkdir  =   $1E;
-      syscall_nr_unlink =   $27;
-      syscall_nr_rmdir  =   $60;
-      syscall_nr_close  =   $01;
-      syscall_nr_read   =   $02;
-      syscall_nr_write  =   $03;
-      syscall_nr_stat   =   $30;
-      syscall_nr_fstat  =   $30;
-      syscall_nr_rename =   $26;
-      syscall_nr_access =   $58;
-      syscall_nr_opendir=   $0C;
-      syscall_nr_closedir=  $0F;
-      syscall_nr_sigaction= $70;
-      syscall_nr_time     = $07;
-      syscall_nr_open     = $00;
-      syscall_nr_readdir  = $1C;
-      syscall_nr_lseek    = $05;
-      syscall_nr_ftruncate = $4b;
-
-      S_IFDIR   =$004000; { Directory.     }
-      S_IFCHR   =$002000; { Character device. }
-      S_IFBLK   =$006000; { Block device.  }
-      S_IFREG   =$008000; { Regular file.  }
-      S_IFIFO   =$001000; { FIFO.          }
-      S_IFLNK   =$00A000; { Symbolic link. }
-
-type
-  { _kwstat_ kernel call structure }
-  pwstat = ^twstat;
-  twstat = packed record
-{00}   filler : array[1..3] of longint;
-{12}   newmode : mode_t;     { chmod mode_t parameter }
-{16}   unknown1 : longint;
-{20}   newuser : uid_t;      { chown uid_t parameter  }
-{24}   newgroup : gid_t;     { chown gid_t parameter  }
-{28}   trunc_offset : off_t; { ftrucnate parameter    }
-{36}   unknown2 : array[1..2] of longint;
-{44}   utime_param: int64;
-{52}   unknown3 : array[1..2] of longint;
-  end;
-
-
-
-
-
-
-    { These routines are currently not required for BeOS }
-    function sys_fork : pid_t;
-    begin
-    end;
-
-    function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
-    begin
-    end;
-
-    function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
-    begin
-    end;
-
-
-    function sys_uname(var name: utsname): cint;
-    begin
-      FillChar(name, sizeof(utsname), #0);
-      name.machine := 'BePC'#0;
-
-    end;
-
-
-
-
-    function S_ISDIR(m : mode_t): boolean;
-    begin
-         if (m and S_IFDIR)= S_IFDIR then
-           S_ISDIR := true
-         else
-           S_ISDIR := false;
-    end;
-
-    function S_ISCHR(m : mode_t): boolean;
-    begin
-          if (m and S_IFCHR) = S_IFCHR then
-            S_ISCHR := true
-          else
-           S_ISCHR := false;
-    end;
-
-    function S_ISBLK(m : mode_t): boolean;
-      begin
-        if (m and S_IFBLK) = S_IFBLK then
-          S_ISBLK := true
-            else
-              S_ISBLK := false;
-      end;
-
-    function S_ISREG(m : mode_t): boolean;
-      begin
-       if (m and S_IFREG) = S_IFREG then
-             S_ISREG := true
-       else
-             S_ISREG := false;
-      end;
-
-    function S_ISFIFO(m : mode_t): boolean;
-      begin
-           if (m and S_IFIFO) = S_IFIFO then
-             S_ISFIFO := true
-       else
-             S_ISFIFO := false;
-      end;
-
-    function wifexited(status : cint): cint;
-     begin
-       wifexited := byte(boolean((status and not $FF) = 0));
-     end;
-
-    function wexitstatus(status : cint): cint;
-     begin
-       wexitstatus := status and $FF;
-     end;
-
-    function wstopsig(status : cint): cint;
-     begin
-       wstopsig:=(status shr 16) and $FF;
-     end;
-
-    function wifsignaled(status : cint): cint;
-     begin
-       if (((status) shr 8) and $ff) <> 0 then
-         wifsignaled := 1
-       else
-         wifsignaled := 0;
-     end;
-
-
- {$i syscall.inc}
-
-  procedure sys_exit(status : cint); external name 'sys_exit';
-(*
-  procedure sys_exit(status : cint);
-  var
-   args: SysCallArgs;
-  begin
-   args.param[1] := status;
-   SysCall(syscall_nr_exit,args);
-  end;
-*)
-
-  function sys_close(fd : cint): cint;
-  var
-   args : SysCallArgs;
-  begin
-    args.param[1] := fd;
-    sys_close:=SysCall(syscall_nr_close,args);
-  end;
-
-
-  function sys_time(var tloc:time_t): time_t;
-  var
-   args : SysCallArgs;
-  begin
-    { don't treat errno, since there is never any }
-    tloc := Do_Syscall(syscall_nr_time,args);
-    sys_time := tloc;
-  end;
-
-
-
-  function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
-  var
-   args : SysCallArgs;
-  begin
-    args.param[1] := sig;
-    args.param[2] := cint(@act);
-    args.param[3] := cint(@oact);
-    sys_sigaction := SysCall(syscall_nr_sigaction, args);
-  end;
-
-
-  function sys_closedir(dirp : pdir): cint;
-  var
-    args : SysCallArgs;
-  begin
-    if assigned(dirp) then
-      begin
-        args.param[1] := dirp^.fd;
-        sys_closedir := SysCall(syscall_nr_closedir,args);
-        Dispose(dirp);
-        dirp := nil;
-        exit;
-      end;
-    Errno := Sys_EBADF;
-    sys_closedir := -1;
-  end;
-
-
-   function sys_opendir(const dirname : pchar): pdir;
-   var
-    args : SysCallArgs;
-    dirp: pdir;
-    fd : cint;
-   begin
-      New(dirp);
-      { just in case }
-      FillChar(dirp^,sizeof(dir),#0);
-      if assigned(dirp) then
-          begin
-            args.param[1] := $FFFFFFFF;
-            args.param[2] := cint(dirname);
-            args.param[3] := 0;
-        fd:=SysCall(syscall_nr_opendir,args);
-            if fd = -1 then
-              begin
-                Dispose(dirp);
-                sys_opendir := nil;
-                exit;
-              end;
-            dirp^.fd := fd;
-            sys_opendir := dirp;
-            exit;
-          end;
-      Errno := Sys_EMFILE;
-      sys_opendir := nil;
-   end;
-
-
-    function sys_access(const pathname : pchar; amode : cint): cint;
-    var
-     args : SysCallArgs;
-    begin
-      args.param[1] := $FFFFFFFF;
-      args.param[2] := cint(pathname);
-      args.param[3] := amode;
-      sys_access := SysCall(syscall_nr_access,args);
-    end;
-
-
-    function sys_rename(const old : pchar; const newpath: pchar): cint;
-    var
-     args: SysCallArgs;
-    begin
-      args.param[1] := $FFFFFFFF;
-      args.param[2] := cint(old);
-      args.param[3] := $FFFFFFFF;
-      args.param[4] := cint(newpath);
-      sys_rename := SysCall(syscall_nr_rename,args);
-    end;
-
-
-    function sys_rmdir(const path : pchar): cint;
-    var
-     args: SysCallArgs;
-    begin
-      args.param[1] := $FFFFFFFF;
-      args.param[2] := cint(path);
-      sys_rmdir := SysCall(syscall_nr_rmdir,args);
-    end;
-
-
-    function sys_unlink(const path: pchar): cint;
-    var
-     args :SysCallArgs;
-    begin
-      args.param[1] := $FFFFFFFF;
-      args.param[2] := cint(path);
-      sys_unlink := SysCall(syscall_nr_unlink,args);
-    end;
-
-
-
-    function sys_mkdir(const path : pchar; mode: mode_t):cint;
-    var
-     args :SysCallArgs;
-    begin
-      args.param[1] := $FFFFFFFF;
-      args.param[2] := cint(path);
-      args.param[3] := cint(mode);
-      sys_mkdir := SysCall(syscall_nr_mkdir,args);
-    end;
-
-
-    function sys_fstat(fd : cint; var sb : stat): cint;
-    var
-     args : SysCallArgs;
-    begin
-      args.param[1] := fd;
-      args.param[2] := $00;
-      args.param[3] := cint(@sb);
-      args.param[4] := $00000001;
-      sys_fstat := SysCall(syscall_nr_fstat, args);
-    end;
-
-
-    function sys_stat(const path: pchar; var buf : stat): cint;
-    var
-     args : SysCallArgs;
-    begin
-      args.param[1] := $FFFFFFFF;
-      args.param[2] := cint(path);
-      args.param[3] := cint(@buf);
-      args.param[4] := $01000000;
-      sys_stat := SysCall(syscall_nr_stat, args);
-    end;
-
-
-    function sys_read(fd: cint; buf:pchar; nbytes : size_t): ssize_t;
-    var
-     args : SysCallArgs;
-     funcresult: ssize_t;
-     errorcode : cint;
-    begin
-      args.param[1] := fd;
-      args.param[2] := cint(buf);
-      args.param[3] := cint(nbytes);
-      args.param[4] := cint(@errorcode);
-      funcresult := ssize_t(Do_SysCall(syscall_nr_read,args));
-      if funcresult >= 0 then
-       begin
-         sys_read := funcresult;
-         errno := 0;
-       end
-      else
-       begin
-         sys_read := -1;
-         errno := errorcode;
-       end;
-    end;
-
-
-    function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
-     var
-      args : SysCallArgs;
-      funcresult : ssize_t;
-      errorcode : cint;
-    begin
-      args.param[1] := fd;
-      args.param[2] := cint(buf);
-      args.param[3] := cint(nbytes);
-      args.param[4] := cint(@errorcode);
-      funcresult := Do_SysCall(syscall_nr_write,args);
-      if funcresult >= 0 then
-       begin
-         sys_write := funcresult;
-         errno := 0;
-       end
-      else
-       begin
-         sys_write := -1;
-         errno := errorcode;
-       end;
-    end;
-
-
-
-    function sys_chdir(const path : pchar): cint;
-    var
-     args: SysCallArgs;
-    begin
-      args.param[1] := $FFFFFFFF;
-      args.param[2] := cint(path);
-      sys_chdir := SysCall(syscall_nr_chdir, args);
-    end;
-
-
-    function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
-    var
-     args: SysCallArgs;
-    begin
-      args.param[1] := $FFFFFFFF;
-      args.param[2] := cint(path);
-      args.param[3] := flags;
-      args.param[4] := cint(mode);
-      args.param[5] := 0;               { close on execute flag }
-      sys_open:= SysCall(syscall_nr_open, args);
-    end;
-
-
-    function sys_readdir(dirp : pdir) : pdirent;
-    var
-      args : SysCallArgs;
-      funcresult : cint;
-    begin
-      args.param[1] := dirp^.fd;
-      args.param[2] := cint(@(dirp^.ent));
-      args.param[3] := $0000011C;
-      args.param[4] := $00000001;
-      { the error will be processed here }
-      funcresult := Do_SysCall(syscall_nr_readdir, args);
-      if funcresult <> 1 then
-        begin
-          if funcresult <> 0 then
-             errno := funcresult;
-          sys_readdir := nil;
-          exit;
-        end;
-      errno := 0;
-      sys_readdir := @dirp^.ent
-    end;
-
-
-    function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
-    var
-     args: SysCallArgs;
-
-    begin
-      args.param[1] := fd;
-      args.param[2] := cint(offset and $FFFFFFFF);
-      args.param[3] := cint((offset shr 32) and $FFFFFFFF);
-      args.param[4] := whence;
-      { we currently only support seeks upto 32-bit in length }
-      sys_lseek := off_t(SysCall(syscall_nr_lseek,args));
-    end;
-
-
-    function sys_ftruncate(fd : cint; flength : off_t): cint;
-    var
-     args: SysCallArgs;
-     wstat : pwstat;
-    begin
-      New(wstat);
-      FillChar(wstat^,sizeof(wstat),0);
-      wstat^.trunc_offset := flength;
-      args.param[1] := fd;
-      args.param[2] := $00000000;
-      args.param[3] := cint(wstat);
-      args.param[4] := $00000008;
-      args.param[5] := $00000001;
-      sys_ftruncate:=SysCall(syscall_nr_ftruncate, args);
-      Dispose(wstat);
-    end;
-
-{
-
-
-  Revision 1.3  2005/02/14 17:13:21  peter
-    * truncate log
-
-}

rtl/beos/osposixh.inc

@@ -1,181 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2001 by Free Pascal development team
-
-    This file implements all the types used in POSIX for BeOS
-
-    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.
-
- **********************************************************************}
-
-{***********************************************************************}
-{                       POSIX TYPE DEFINITIONS                          }
-{***********************************************************************}
-
-type
-    { the following type definitions are compiler dependant }
-    { and system dependant                                  }
-
-    cint  = longint;       { minimum range is : 32-bit                   }
-    cuint = cardinal;      { minimum range is : 32-bit                   }
-
-
-    dev_t  = cint;             { used for device numbers      }
-    gid_t  = cuint;            { used for group IDs           }
-    ino_t  = int64;           { used for file serial numbers }
-    mode_t = cuint;            { used for file attributes     }
-    nlink_t  = cint;           { used for link counts         }
-    off_t  = int64;           { used for file sizes          }
-    pid_t  = cint;             { used as process identifier   }
-    size_t = cint;             { as definied in the C standard }
-    ssize_t = cint;            { used by function for returning number of bytes }
-    uid_t =  cuint;            { used for user ID type        }
-    time_t = cint;             { used for returning the time  }
-    sigset_t = cuint;          { used for additional signal   }
-
-{***********************************************************************}
-{                         POSIX STRUCTURES                              }
-{***********************************************************************}
-CONST
-    _UTSNAME_LENGTH = 32;
-    _UTSNAME_NODENAME_LENGTH = _UTSNAME_LENGTH;
-
-TYPE
-   { system information services }
-   utsname = packed record   { don't forget to verify the alignment }
-     { Name of this implementation of the operating systems (POSIX) }
-     sysname : array[0.._UTSNAME_LENGTH+1] of char;
-     { Name of this node (POSIX) }
-     nodename : array[0.._UTSNAME_NODENAME_LENGTH+1] of char;
-     { Current release level of this implementation (POSIX) }
-     release : array[0.._UTSNAME_LENGTH+1] of char;
-     { Current version level of this release (POSX) }
-     version : array[0.._UTSNAME_LENGTH+1] of char;
-     { Name of the hardware type on which the system is running (POSIX) }
-     machine : array[0.._UTSNAME_LENGTH+1] of char;
-   end;
-
-  { file characteristics services }
-   stat = packed record { verify the alignment of the members }
-    st_dev : dev_t;     { Device containing the file (POSIX) }
-    st_ino : ino_t;             { File serial number (POSIX)         }
-    st_mode: mode_t;    { File mode (POSIX)                  }
-    st_nlink: nlink_t;  { Link count (POSIX)                 }
-    st_uid: uid_t;              { User ID of the file's owner. (POSIX)}
-    st_gid: gid_t;              { Group ID of the file's group.(POSIX)}
-    st_size : off_t;    { Size of file, in bytes.      (POSIX)}
-    st_rdev : dev_t;    { Device type (not used).            }
-    st_blksize: cardinal;{ Preferred block size for I/O.     }
-    st_atime: time_t;   { Time of last access (POSIX)        }
-    st_mtime: time_t;   { Time of last modification (POSIX)  }
-    st_ctime: time_t;   { Time of last status change (POSIX) }
-    st_crtime: time_t;  { Time of creation                   }
-  end;
-
-  { directory services }
-   pdirent = ^dirent;
-   dirent = packed record    { directory entry record - verify alignment }
-         d_dev: dev_t;
-         d_pdev: dev_t;
-         d_fileno: ino_t;
-         d_pino: ino_t;
-         d_reclen:word;
-         d_name:array[0..255] of char;      { Filename in DIRENT (POSIX) }
-   end;
-
-   pdir = ^dir;
-   dir = packed record
-     fd : cint;         { file descriptor }
-     ent : dirent;     { directory entry }
-   end;
-
-   sighandler_t = procedure (signo: cint); cdecl;
-
-   { signal services }
-   sigactionrec = packed record
-     sa_handler : sighandler_t;  { pointer to a function (POSIX.1)     }
-     sa_mask : sigset_t;         { additional signal masks  (POSIX.1)  }
-     sa_flags : cint;             { special flags for signals (POSIX.1) }
-     sa_userdata : pointer;
-   end;
-
-{***********************************************************************}
-{                  POSIX CONSTANT ROUTINE DEFINITIONS                   }
-{***********************************************************************}
-CONST
-    { access routine - these maybe OR'ed together }
-    F_OK        =  0;   { test for existence of file }
-    R_OK        =  4;   { test for read permission on file }
-    W_OK        =  2;   { test for write permission on file }
-    X_OK        =  1;   { test for execute or search permission }
-    { seek routine }
-    SEEK_SET    =  0;    { seek from beginning of file }
-    SEEK_CUR    =  1;    { seek from current position  }
-    SEEK_END    =  2;    { seek from end of file       }
-    { open routine                                 }
-    { File access modes for `open' and `fcntl'.    }
-    O_RDONLY    =  0;   { Open read-only.  }
-    O_WRONLY    =  1;   { Open write-only. }
-    O_RDWR      =  2;   { Open read/write. }
-    { Bits OR'd into the second argument to open.  }
-    O_CREAT     =$0200; { Create file if it doesn't exist.  }
-    O_EXCL      =$0100; { Fail if file already exists.      }
-    O_TRUNC     =$0400; { Truncate file to zero length.     }
-    O_NOCTTY    =$1000; { Don't assign a controlling terminal. }
-    { File status flags for `open' and `fcntl'.  }
-    O_APPEND    =$0800; { Writes append to the file.        }
-    O_NONBLOCK  =$0080; { Non-blocking I/O.                 }
-
-    { mode_t possible values                                 }
-    S_IRUSR = $0100;           { Read permission for owner   }
-    S_IWUSR = $0080;           { Write permission for owner  }
-    S_IXUSR = $0040;           { Exec  permission for owner  }
-    S_IRGRP = S_IRUSR shr 3;   { Read permission for group   }
-    S_IWGRP = S_IWUSR shr 3;   { Write permission for group  }
-    S_IXGRP = S_IWUSR shr 3;   { Exec permission for group   }
-    S_IROTH = S_IRGRP shr 3;   { Read permission for world   }
-    S_IWOTH = S_IWGRP shr 3;   { Write permission for world  }
-    S_IXOTH = S_IXGRP shr 3;   { Exec permission for world   }
-
-    { Used for waitpid }
-    WNOHANG   = 1;               { don't block waiting               }
-    WUNTRACED = 2;               { report status of stopped children }
-
-
-    {************************ signals *****************************}
-    { more can be provided. Herein are only included the required  }
-    { values.                                                      }
-    {**************************************************************}
-    SIGABRT    =  6;     { abnormal termination           }
-    SIGALRM    = 14;     { alarm clock (used with alarm() }
-    SIGFPE     =  8;     { illegal arithmetic operation   }
-    SIGHUP     =  1;     { Hangup                         }
-    SIGILL     =  4;     { Illegal instruction            }
-    SIGINT     =  2;     { Interactive attention signal   }
-    SIGKILL    =  9;     { Kill, cannot be caught         }
-    SIGPIPE    =  7;     { Broken pipe signal             }
-    SIGQUIT    =  3;     { Interactive termination signal }
-    SIGSEGV    = 11;     { Detection of invalid memory reference }
-    SIGTERM    = 15;     { Termination request           }
-    SIGUSR1    = 18;     { Application defined signal 1  }
-    SIGUSR2    = 19;     { Application defined signal 2  }
-    SIGCHLD    =  5;     { Child process terminated / stopped }
-    SIGCONT    = 12;     { Continue if stopped                }
-    SIGSTOP    = 10;     { Stop signal. cannot be cuaght      }
-    SIGSTP     = 13;     { Interactive stop signal            }
-    SIGTTIN    = 16;     { Background read from TTY           }
-    SIGTTOU    = 17;     { Background write to TTY            }
-    SIGBUS     = SIGSEGV; { Access to undefined memory        }
-
-
-    { POSIX limits }
-    ARG_MAX =  128*1024; { Maximum number of arguments           }
-    NAME_MAX = 256;      { Maximum number of bytes in a filename }
-    PATH_MAX = 1024;     { Maximum number of bytes in a pathname }
-
-

rtl/beos/ossysc.inc

@@ -0,0 +1,1060 @@
+{
+    Copyright (c) 2002 by Marco van de Voort
+
+    The base *BSD syscalls required to implement the system unit. These
+    are aliased for use in other units (to avoid poluting the system units
+    interface)
+
+    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.
+
+ ****************************************************************************
+}
+
+{$i ostypes.inc}
+
+{$ifdef FPC_USE_LIBC}
+  {$Linklib root}
+  // Out of date atm.
+const clib = 'root';
+const netlib = 'net';
+
+
+{$ifdef FPC_IS_SYSTEM}
+{$i oscdeclh.inc}
+{$endif}
+{$I osmacro.inc}
+
+{   var
+     Errno : cint; external name 'errno';
+
+    function Fptime(tloc:ptime_t): time_t; cdecl; external name 'time';
+    function Fpopen(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open';
+    function Fpclose(fd : cint): cint; cdecl; external name 'close';
+    function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; cdecl; external name 'lseek';
+    function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external name 'read';
+    function Fpwrite(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
+    function Fpunlink(const path: pchar): cint; cdecl; external name 'unlink';
+    function Fprename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
+    function Fpstat(const path: pchar; var buf : stat): cint; cdecl; external name 'stat';
+    function Fpchdir(const path : pchar): cint; cdecl; external name 'chdir';
+    function Fpmkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
+    function Fprmdir(const path : pchar): cint; cdecl; external name 'rmdir';
+    function Fpopendir(const dirname : pchar): pdir; cdecl; external name 'opendir';
+    function Fpreaddir(var dirp : dir) : pdirent;cdecl; external name 'readdir';
+    function Fpclosedir(var dirp : dir): cint; cdecl; external name 'closedir';
+    procedure Fpexit(status : cint); cdecl; external name '_exit';
+    function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
+    function Fpftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
+    function Fprename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
+    function Fpfstat(fd : cint; var sb : stat): cint; cdecl; external name 'fstat';
+    function Fpfork : pid_t; cdecl; external name 'fork';
+    function Fpexecve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; cdecl; external name 'execve';
+    function Fpwaitpid(pid : pid_t; tat_loc : pcint; options: cint): pid_t; cdecl; external name 'waitpid';
+    function Fpaccess(const pathname : pchar; amode : cint): cint; cdecl; external name 'access';
+
+    function Fpuname(var name: utsname): cint; cdecl; external name 'uname';
+
+    function FpDup(oldd:cint):cint; cdecl; external name 'dup';
+    function FpDup2(oldd:cint;newd:cint):cint; cdecl; external name 'dup2';
+}
+{$else}
+
+{*****************************************************************************
+                     --- Main:The System Call Self ---
+*****************************************************************************}
+
+{ The system designed for Linux can't be used for *BSD so easily, since
+  *BSD pushes arguments, instead of loading them to registers.}
+
+// Var ErrNo : Longint;
+
+{$I syscallh.inc}
+{$I syscall.inc}
+{$I sysnr.inc}
+{$I osmacro.inc}
+
+// Should be moved to a FreeBSD specific unit in the future.
+
+function Fptime( tloc:ptime): time_t; [public, alias : 'FPC_SYSC_TIME'];
+
+{VAR tv     : timeval;
+    tz     : timezone;
+    retval : longint;
+}
+var
+  args : SysCallArgs;
+begin
+    { don't treat errno, since there is never any }
+    tloc^ := Do_Syscall(syscall_nr_time,args);
+    fptime := tloc^;
+{begin
+//  Retval:=do_syscall(syscall_nr_gettimeofday,TSysParam(@tv),TSysParam(@tz));
+  If retval=-1 then
+   Fptime:=-1
+  else
+   Begin
+   If Assigned(tloc) Then
+     TLoc^:=tv.tv_sec;
+    Fptime:=tv.tv_sec;
+   End;
+}
+End;
+
+{*****************************************************************************
+               --- File:File handling related calls ---
+*****************************************************************************}
+
+function Fpopen(path: pchar; flags : cint; mode: mode_t):cint; [public, alias : 'FPC_SYSC_OPEN'];
+var
+  args: SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  args.param[3] := flags;
+  args.param[4] := cint(mode);
+  args.param[5] := 0;               { close on execute flag }
+  fpopen:= SysCall(syscall_nr_open, args);   
+{Begin
+ Fpopen:=do_syscall(syscall_nr_open,TSysParam(path),TSysParam(flags),TSysParam(mode));
+}
+End;
+
+function Fpclose(fd : cint): cint; [public, alias : 'FPC_SYSC_CLOSE'];
+var
+  args : SysCallArgs;
+begin
+  args.param[1] := fd;
+  fpclose:=SysCall(syscall_nr_close,args);
+{begin
+ Fpclose:=do_syscall(syscall_nr_close,fd);
+}
+end;
+
+{$ifdef netbsd}
+  {$ifdef cpupowerpc}
+    {$define netbsdmacppc}
+  {$endif}
+{$endif}
+
+{$ifdef netbsdmacppc}
+{$i sysofft.inc}                        // odd ball calling convention.
+{$else}
+  // generic versions.
+function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; [public, alias : 'FPC_SYSC_LSEEK'];
+
+{
+this one is special for the return value being 64-bit..
+hi/lo offset not yet tested.
+
+NetBSD: ok, but implicit return value in edx:eax
+FreeBSD: same implementation as NetBSD.
+}
+var
+  args: SysCallArgs;
+
+begin
+  args.param[1] := fd;
+  args.param[2] := cint(offset and $FFFFFFFF);      
+  args.param[3] := cint((offset shr 32) and $FFFFFFFF);
+  args.param[4] := whence;
+  { we currently only support seeks upto 32-bit in length }
+  fplseek := off_t(SysCall(syscall_nr_lseek,args));
+(*begin
+  Fplseek:=do_syscall(syscall_nr___syscall,syscall_nr_lseek,0,TSysParam(fd),0,lo(Offset),{0} hi(offset),Whence);
+*)
+end;
+
+type
+  { _kwstat_ kernel call structure }
+  pwstat = ^twstat;
+  twstat = packed record
+{00}   filler : array[1..3] of longint;
+{12}   newmode : mode_t;     { chmod mode_t parameter }
+{16}   unknown1 : longint;  
+{20}   newuser : uid_t;      { chown uid_t parameter  } 
+{24}   newgroup : gid_t;     { chown gid_t parameter  }
+{28}   trunc_offset : off_t; { ftrucnate parameter    }
+{36}   unknown2 : array[1..2] of longint;
+{44}   utime_param: int64;  
+{52}   unknown3 : array[1..2] of longint;
+  end;
+  
+function Fpftruncate(fd : cint; flength : off_t): cint; [public, alias : 'FPC_SYSC_FTRUNCATE'];
+var
+  args: SysCallArgs;
+  wstat : pwstat;
+begin
+  New(wstat);
+  FillChar(wstat^,sizeof(wstat),0);
+  wstat^.trunc_offset := flength;
+  args.param[1] := fd;
+  args.param[2] := $00000000;
+  args.param[3] := cint(wstat);
+  args.param[4] := $00000008;
+  args.param[5] := $00000001;
+  fpftruncate:=SysCall(syscall_nr_ftruncate, args);
+  Dispose(wstat);
+{begin
+ Fpftruncate:=Do_syscall(syscall_nr___syscall,syscall_nr_ftruncate,0,fd,0,lo(flength),hi(flength));
+}
+end;
+
+const
+  B_OS_NAME_LENGTH = 32;
+  B_PAGE_SIZE = 4096;  
+
+const
+  B_NO_LOCK       = 0;
+  B_LAZY_LOCK     = 1;
+  B_FULL_LOCK     = 2;
+  B_CONTIGUOUS    = 3;
+  B_LOMEM         = 4;
+
+  B_ANY_ADDRESS        = 0;
+  B_EXACT_ADDRESS      = 1;
+  B_BASE_ADDRESS       = 2;
+  B_CLONE_ADDRESS      = 3;
+  B_ANY_KERNEL_ADDRESS = 4;
+
+  B_READ_AREA  = 1;
+  B_WRITE_AREA = 2;
+
+type
+  area_id   = Longint;
+  
+function create_area(name : pchar; var addr : longint;
+  addr_typ : longint; size : longint; lock_type: longint; protection : longint): area_id;
+var
+ args : SysCallArgs;
+begin
+ args.param[1] := cint(name);
+ args.param[2] := cint(@addr);
+ args.param[3] := cint(addr_typ);
+ args.param[4] := cint(size);
+ args.param[5] := cint(lock_type);
+ args.param[6] := cint(protection);
+ create_area := SysCall(syscall_nr_create_area, args);
+end;
+
+Function Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_t):pointer; [public, alias:  'FPC_SYSC_MMAP'];
+var
+  heap_handle : area_id;
+const
+  zero=0;
+  myheapsize=$20000;
+  myheaprealsize=$20000;
+var
+  myheapstart:pointer;
+  s : string;
+begin
+  WriteLn('fpmmap');
+  Str(len, s);
+  WriteLn(s);
+  myheapstart:=start;
+{$IFDEF FPC_USE_LIBC}  
+  heap_handle := create_area('fpcheap',myheapstart,0,len,0,3);//!!
+{$ELSE}
+  heap_handle := create_area('fpcheap',longint(myheapstart),0,len,0,3);//!!
+{$ENDIF}
+  case heap_handle of
+    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
+    B_PAGE_SIZE : WriteLn('B_PAGE_SIZE');
+    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
+    B_ERROR : WriteLn('B_ERROR');
+  end;
+
+  fpmmap := myheapstart;
+// not available under BeOS
+//  Fpmmap:=pointer(longint(do_syscall(syscall_nr_mmap,TSysParam(Start),Len,Prot,Flags,fd,{$ifdef cpupowerpc}0,{$endif}offst{$ifdef cpui386},0{$endif})));
+end;
+
+{$endif}
+
+
+function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_READ'];
+var
+  args : SysCallArgs;
+  funcresult: ssize_t;
+  errorcode : cint;
+begin
+  args.param[1] := fd;
+  args.param[2] := cint(buf);
+  args.param[3] := cint(nbytes);
+  args.param[4] := cint(@errorcode);
+  funcresult := ssize_t(Do_SysCall(syscall_nr_read,args));
+  if funcresult >= 0 then
+   begin
+     fpread := funcresult;
+     errno := 0;
+   end
+  else
+   begin
+     fpread := -1;
+     errno := errorcode;
+   end;
+{begin
+  Fpread:=do_syscall(syscall_nr_read,Fd,TSysParam(buf),nbytes);
+}
+end;
+
+//function Fpmywrite(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
+
+function Fpwrite(fd: cint;buf:pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_WRITE'];
+var
+  args : SysCallArgs;
+  funcresult : ssize_t;
+  errorcode : cint;
+begin
+  errorcode := 0;
+  // There is a bug in syscall in 1.9 under BeOS !!!
+  // Fixed ! 26/05/2004 ! See in syscall.inc
+  args.param[1] := fd;
+  args.param[2] := cint(buf);
+  args.param[3] := cint(nbytes);
+  args.param[4] := cint(@errorcode);
+  funcresult := Do_SysCall(syscall_nr_write,args);
+
+//  funcresult := Fpmywrite(fd, buf, nbytes);
+
+  if funcresult >= 0 then
+   begin
+     fpwrite := funcresult;
+     errno := 0;
+   end
+  else
+   begin
+     fpwrite := -1; 
+     errno := errorcode;
+   end;
+{begin
+ Fpwrite:=do_syscall(syscall_nr_write,Fd,TSysParam(buf),nbytes);
+}
+end;
+
+function Fpunlink(const path: pchar): cint; [public, alias : 'FPC_SYSC_UNLINK'];
+var
+  args :SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  fpunlink := SysCall(syscall_nr_unlink,args);
+{begin
+  Fpunlink:=do_syscall(syscall_nr_unlink,TSysParam(path));
+}
+end;
+
+function Fprename(old : pchar; newpath: pchar): cint; [public, alias : 'FPC_SYSC_RENAME'];
+var
+  args: SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(old);
+  args.param[3] := $FFFFFFFF;
+  args.param[4] := cint(newpath);
+  fprename := SysCall(syscall_nr_rename,args);
+{begin
+  Fprename:=do_syscall(syscall_nr_rename,TSysParam(old),TSysParam(newpath));
+}
+end;
+
+function Fpstat(const path: pchar; var buf : stat):cint; [public, alias : 'FPC_SYSC_STAT'];
+var
+  args : SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  args.param[3] := cint(@buf);
+  args.param[4] := $01000000;
+  fpstat := SysCall(syscall_nr_stat, args);
+{begin
+ Fpstat:=do_syscall(syscall_nr_stat,TSysParam(path),TSysParam(@buf));
+}
+end;
+
+
+{*****************************************************************************
+               --- Directory:Directory related calls ---
+*****************************************************************************}
+
+function Fpchdir(path : pchar): cint; [public, alias : 'FPC_SYSC_CHDIR'];
+var
+  args: SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  fpchdir := SysCall(syscall_nr_chdir, args);
+{begin
+ Fpchdir:=do_syscall(syscall_nr_chdir,TSysParam(path));
+}
+end;
+
+function Fpmkdir(path : pchar; mode: mode_t):cint; [public, alias : 'FPC_SYSC_MKDIR'];
+var
+  args :SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  args.param[3] := cint(mode);
+  fpmkdir := SysCall(syscall_nr_mkdir,args);
+(*begin {Mode is 16-bit on F-BSD 4!}
+  Fpmkdir:=do_syscall(syscall_nr_mkdir,TSysParam(path),mode);
+*)
+end;
+
+function Fprmdir(path : pchar): cint;  [public, alias : 'FPC_SYSC_RMDIR'];
+var
+  args: SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(path);
+  fprmdir := SysCall(syscall_nr_rmdir,args);
+{begin
+ Fprmdir:=do_syscall(syscall_nr_rmdir,TSysParam(path));
+}
+end;
+
+{$ifndef NewReaddir}
+
+const DIRBLKSIZ=1024;
+
+
+function Fpopendir(dirname : pchar): pdir;  [public, alias : 'FPC_SYSC_OPENDIR'];
+var
+  args : SysCallArgs;
+  dirp: pdir;
+  fd : cint;
+begin
+  New(dirp);
+  { just in case }
+  FillChar(dirp^,sizeof(dir),#0);
+  if assigned(dirp) then
+	 begin
+	   args.param[1] := $FFFFFFFF;
+     args.param[2] := cint(dirname);
+ 	   args.param[3] := 0;
+     fd:=SysCall(syscall_nr_opendir,args);
+	   if fd = -1 then
+	    begin
+	      Dispose(dirp);
+	      fpopendir := nil;
+	      exit;
+	    end;
+	   dirp^.fd := fd;
+	   fpopendir := dirp;
+	   exit;
+	 end;
+  Errno := ESysEMFILE;
+  fpopendir := nil;
+(*var
+  fd:longint;
+  st:stat;
+  ptr:pdir;
+begin
+  Fpopendir:=nil;
+  if Fpstat(dirname,st)<0 then
+   exit;
+{ Is it a dir ? }
+  if not((st.st_mode and $f000)=$4000)then
+   begin
+     errno:=ESysENOTDIR;
+     exit
+   end;
+{ Open it}
+  fd:=Fpopen(dirname,O_RDONLY,438);
+  if fd<0 then
+   Begin
+    Errno:=-1;
+    exit;
+   End;
+  new(ptr);
+  if ptr=nil then
+   Begin
+    Errno:=1;
+    exit;
+   End;
+  Getmem(ptr^.dd_buf,2*DIRBLKSIZ);
+  if ptr^.dd_buf=nil then
+   exit;
+  ptr^.dd_fd:=fd;
+  ptr^.dd_loc:=-1;
+  ptr^.dd_rewind:=longint(ptr^.dd_buf);
+  ptr^.dd_size:=0;
+//  ptr^.dd_max:=sizeof(ptr^.dd_buf^);
+  Fpopendir:=ptr;
+*)
+end;
+
+function Fpclosedir(dirp : pdir): cint; [public, alias : 'FPC_SYSC_CLOSEDIR'];
+var
+  args : SysCallArgs;
+begin
+  if assigned(dirp) then
+   begin
+	   args.param[1] := dirp^.fd;
+	   fpclosedir := SysCall(syscall_nr_closedir,args);
+	   Dispose(dirp);
+	   dirp := nil;
+	   exit;
+    end;
+   Errno := ESysEBADF;
+   fpclosedir := -1;
+{begin
+  Fpclosedir:=Fpclose(dirp^.dd_fd);
+  Freemem(dirp^.dd_buf);
+  dispose(dirp);
+}
+end;
+
+function Fpreaddir(dirp : pdir) : pdirent; [public, alias : 'FPC_SYSC_READDIR'];
+
+{Different from Linux, Readdir on BSD is based on Getdents, due to the
+missing of the readdir syscall.
+Getdents requires the buffer to be larger than the blocksize.
+This usually the sectorsize =512 bytes, but maybe tapedrives and harddisks
+with blockmode have this higher?}
+
+(*function readbuffer:longint;
+
+var retval :longint;
+
+begin
+ Retval:=do_syscall(syscall_nr_getdents,TSysParam(dirp^.dd_fd),TSysParam(@dirp^.dd_buf^),DIRBLKSIZ {sizeof(getdentsbuffer)});
+   dirp^.dd_rewind:=TSysParam(dirp^.dd_buf);
+   if retval=0 then
+    begin
+     dirp^.dd_rewind:=0;
+     dirp^.dd_loc:=0;
+    end
+   else
+    dirP^.dd_loc:=retval;
+ readbuffer:=retval;
+end;*)
+var
+  args : SysCallArgs;
+  funcresult : cint;
+begin
+  args.param[1] := dirp^.fd;
+  args.param[2] := cint(@(dirp^.ent));
+  args.param[3] := $0000011C;
+  args.param[4] := $00000001;
+  { the error will be processed here }
+  funcresult := Do_SysCall(syscall_nr_readdir, args);
+  if funcresult <> 1 then
+   begin
+     if funcresult <> 0 then
+       errno := funcresult;
+     fpreaddir := nil;
+     exit;
+   end;
+  errno := 0;
+  fpreaddir := @dirp^.ent
+(*
+var
+    FinalEntry     : pdirent;
+    novalid        : boolean;
+    Reclen         : Longint;
+    CurEntry       : PDirent;
+
+begin
+ if (dirp^.dd_buf=nil) or (dirp^.dd_loc=0) THEN
+  exit(nil);
+ if (dirp^.dd_loc=-1)   OR     {First readdir on this pdir. Initial fill of buffer}
+   (dirp^.dd_rewind>=(longint(dirp^.dd_buf)+dirblksiz)) then  {no more entries left?}
+  Begin
+    if readbuffer=0 then        {succesful read?}
+     Exit(NIL);                 {No more data}
+  End;
+ FinalEntry:=NIL;
+ CurEntry:=nil;
+ repeat
+  novalid:=false;
+  CurEntry:=pdirent(dirp^.dd_rewind);
+  RecLen:=CurEntry^.d_reclen;
+  if RecLen<>0 Then
+   begin {valid direntry?}
+    if CurEntry^.d_fileno<>0 then
+     FinalEntry:=CurEntry;
+    inc(dirp^.dd_rewind,Reclen);
+   end
+  else
+   begin {block entirely searched or reclen=0}
+    Novalid:=True;
+    if dirp^.dd_loc<>0 THEN             {blocks left?}
+     if readbuffer()<>0 then        {succesful read?}
+      novalid:=false;
+   end;
+ until (FinalEntry<>nil) or novalid;
+ If novalid then
+  FinalEntry:=nil;
+ FpReadDir:=FinalEntry;*)
+end;
+{$endif}
+
+{*****************************************************************************
+        --- Process:Process & program handling - related calls ---
+*****************************************************************************}
+
+procedure Fpexit(status : cint); [public, alias : 'FPC_SYSC_EXIT'];
+var
+  args : SysCallArgs;
+begin
+//  sys_exit(status);
+  args.param[1] := status;
+  do_syscall(syscall_nr_exit, args);
+end;
+
+{
+  Change action of process upon receipt of a signal.
+  Signum specifies the signal (all except SigKill and SigStop).
+  If Act is non-nil, it is used to specify the new action.
+  If OldAct is non-nil the previous action is saved there.
+}
+
+function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; [public, alias : 'FPC_SYSC_SIGACTION'];
+
+{
+  Change action of process upon receipt of a signal.
+  Signum specifies the signal (all except SigKill and SigStop).
+  If Act is non-nil, it is used to specify the new action.
+  If OldAct is non-nil the previous action is saved there.
+}
+var
+  args : SysCallArgs;
+begin
+  args.param[1] := sig;
+  args.param[2] := cint(@act);
+  args.param[3] := cint(@oact);
+  fpsigaction := SysCall(syscall_nr_sigaction, args);
+//begin
+//  do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(@act),TSysParam(@oact));
+end;
+
+(*=================== MOVED from sysunix.inc ========================*)
+
+
+function Fpfstat(fd : cint; var sb : stat): cint;  [public, alias : 'FPC_SYSC_FSTAT'];
+
+var
+  args : SysCallArgs;
+begin
+  args.param[1] := fd;
+  args.param[2] := $00;
+  args.param[3] := cint(@sb);
+  args.param[4] := $00000001;
+  fpfstat := SysCall(syscall_nr_fstat, args);
+
+{begin
+  fpFStat:=do_SysCall(syscall_nr_fstat,fd,TSysParam(@sb));
+}
+end;
+
+{$ifdef NewReaddir}
+{$I readdir.inc}
+{$endif}
+
+
+function fork : pid_t; external 'root' name 'fork';
+{ These routines are currently not required for BeOS }
+function Fpfork : pid_t;  [public, alias : 'FPC_SYSC_FORK'];
+{
+  This function issues the 'fork' System call. the program is duplicated in memory
+  and Execution continues in parent and child process.
+  In the parent process, fork returns the PID of the child. In the child process,
+  zero is returned.
+  A negative value indicates that an error has occurred, the error is returned in
+  LinuxError.
+}
+
+Begin
+  WriteLn('fpfork');
+  fpfork := fork;
+// Not required for BeOS
+// Fpfork:=Do_syscall(SysCall_nr_fork);
+End;
+
+{
+function Fpexecve(const path : pathstr; const argv : ppchar; const envp: ppchar): cint;
+}
+{
+  Replaces the current program by the program specified in path,
+  arguments in args are passed to Execve.
+  environment specified in ep is passed on.
+}
+
+{
+Begin
+  path:=path+#0;
+  do_syscall(syscall_nr_Execve,TSysParam(@path[1]),TSysParam(Argv),TSysParam(envp));
+End;
+}
+{
+function Fpexecve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;  [public, alias : 'FPC_SYSC_EXECVE'];
+}
+{
+  Replaces the current program by the program specified in path,
+  arguments in args are passed to Execve.
+  environment specified in ep is passed on.
+}
+{
+Begin
+  do_syscall(syscall_nr_Execve,TSysParam(path),TSysParam(Argv),TSysParam(envp));
+End;
+}
+function waitpid(pid : pid_t; stat_loc : pcint; options: cint): pid_t; external 'root' name 'waitpid';
+function Fpwaitpid(pid : pid_t; stat_loc : pcint; options: cint): pid_t; [public, alias : 'FPC_SYSC_WAITPID'];
+{
+  Waits until a child with PID Pid exits, or returns if it is exited already.
+  Any resources used by the child are freed.
+  The exit status is reported in the adress referred to by Status. It should
+  be a longint.
+}
+
+begin // actually a wait4() call with 4th arg 0.
+  FpWaitPID := waitpid(pid, stat_loc, options);
+// FpWaitPID:=do_syscall(syscall_nr_WaitPID,PID,TSysParam(Stat_loc),options,0);
+end;
+
+function Fpaccess(const pathname : pchar; amode : cint): cint; [public, alias : 'FPC_SYSC_ACCESS'];
+{
+  Test users access rights on the specified file.
+  Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
+  R,W,X stand for read,write and Execute access, simultaneously.
+  F_OK checks whether the test would be allowed on the file.
+  i.e. It checks the search permissions in all directory components
+  of the path.
+  The test is done with the real user-ID, instead of the effective.
+  If access is denied, or an error occurred, false is returned.
+  If access is granted, true is returned.
+  Errors other than no access,are reported in unixerror.
+}
+var
+  args : SysCallArgs;
+begin
+  args.param[1] := $FFFFFFFF;
+  args.param[2] := cint(pathname);
+  args.param[3] := amode;
+  fpaccess := SysCall(syscall_nr_access,args);
+
+{begin
+ FpAccess:=do_syscall(syscall_nr_access,TSysParam(pathname),amode);
+}
+end;
+(*
+function Fpaccess(const pathname : pathstr; amode : cint): cint;
+
+{
+  Test users access rights on the specified file.
+  Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
+  R,W,X stand for read,write and Execute access, simultaneously.
+  F_OK checks whether the test would be allowed on the file.
+  i.e. It checks the search permissions in all directory components
+  of the path.
+  The test is done with the real user-ID, instead of the effective.
+  If access is denied, or an error occurred, false is returned.
+  If access is granted, true is returned.
+  Errors other than no access,are reported in unixerror.
+}
+
+begin
+ pathname:=pathname+#0;
+ Access:=do_syscall(syscall_nr_access, TSysParam(@pathname[1]),mode)=0;
+end;
+*)
+
+Function FpDup(fildes:cint):cint; [public, alias : 'FPC_SYSC_DUP'];
+
+begin
+  {$warning TODO BeOS FpDup implementation}
+//  Fpdup:=Do_syscall(syscall_nr_dup,TSysParam(fildes));
+end;
+
+Function FpDup2(fildes,fildes2:cint):cint; [public, alias : 'FPC_SYSC_DUP2'];
+
+begin
+  {$warning TODO BeOS FpDup2 implementation}
+// Fpdup2:=do_syscall(syscall_nr_dup2,TSysParam(fildes),TSysParam(fildes2));
+end;
+
+
+
+Function Fpmunmap(start:pointer;len:size_t):cint;    [public, alias :'FPC_SYSC_MUNMAP'];
+begin
+  {$warning TODO BeOS Fpmunmap implementation}
+//  Fpmunmap:=do_syscall(syscall_nr_munmap,TSysParam(start),Len);
+end;
+
+
+{
+  Interface to Unix ioctl call.
+  Performs various operations on the filedescriptor Handle.
+  Ndx describes the operation to perform.
+  Data points to data needed for the Ndx function. The structure of this
+  data is function-dependent.
+}
+
+Function FpIOCtl(Handle:cint;Ndx: culong;Data: Pointer):cint; [public, alias : 'FPC_SYSC_IOCTL'];
+// This was missing here, instead hardcoded in Do_IsDevice
+begin
+  {$warning TODO BeOS FpIOCtl implementation}
+//  FpIOCtl:=do_SysCall(syscall_nr_ioctl,handle,Ndx,TSysParam(data));
+end;
+
+
+Function FpGetPid:LongInt;   [public, alias : 'FPC_SYSC_GETPID'];
+{
+  Get Process ID.
+}
+
+begin
+  {$warning TODO BeOS FpGetPid implementation}
+// FpGetPID:=do_syscall(syscall_nr_getpid);
+end;
+
+function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; [public, alias: 'FPC_SYSC_GETTIMEOFDAY'];
+
+begin
+  {$warning TODO BeOS fpgettimeofday implementation}
+// fpgettimeofday:=do_syscall(syscall_nr_gettimeofday,TSysParam(tp),TSysParam(tzp));
+end;
+
+function FPSigProcMask(how:cint;nset : psigset;oset : psigset):cint; [public, alias : 'FPC_SYSC_SIGPROCMASK'];
+
+{
+  Change the list of currently blocked signals.
+  How determines which signals will be blocked :
+   SigBlock   : Add SSet to the current list of blocked signals
+   SigUnBlock : Remove the signals in SSet from the list of blocked signals.
+   SigSetMask : Set the list of blocked signals to SSet
+  if OldSSet is non-null, the old set will be saved there.
+}
+
+begin
+  {$warning TODO BeOS FPSigProcMask implementation}
+//  FPsigprocmask:=do_syscall(syscall_nr_sigprocmask,longint(how),longint(nset),longint(oset));
+end;
+{$user BLA!}
+Function FpNanoSleep(req : ptimespec;rem : ptimespec) : cint; [public, alias : 'FPC_SYSC_NANOSLEEP'];
+begin
+  {$warning TODO BeOS FpNanoSleep implementation}
+{$ifndef darwin}
+//  FpNanoSleep:=Do_SysCall(syscall_nr_nanosleep,TSysParam(req),TSysParam(rem));
+{$else not darwin}
+{$warning: TODO: nanosleep!!!}
+{$endif not darwin}
+end;
+
+function Fpgetcwd(pt:pchar; _size:size_t):pchar;[public, alias :'FPC_SYSC_GETCWD'];
+{$ifndef darwin}
+const intpathmax = 1024-4;      // didn't use POSIX data in libc
+                                // implementation.
+var ept,bpt : pchar;
+    c       : char;
+    ret     : cint;
+
+begin
+  {$warning TODO BeOS Fpgetcwd implementation}
+(*   if pt=NIL Then
+    begin
+      // POSIX: undefined. (exit(nil) ?)
+      // BSD  : allocate mem for path.
+      getmem(pt,intpathmax);
+      if pt=nil Then
+        exit(nil);
+      ept:=pt+intpathmax;
+    end
+   else
+    Begin
+      if (_size=0) Then
+        Begin
+          seterrno(ESysEINVAL);
+          exit(nil);
+        End;
+      if (_size=1) Then
+        Begin
+          seterrno(ESysERANGE);
+          exit(nil);
+        End;
+      ept:=pt+_size;
+    end;
+
+    ret := do_syscall(syscall_nr___getcwd,TSysParam(pt),TSysParam( ept - pt));
+    If (ret = 0) Then
+        If (pt[0] <> '/') Then
+           Begin
+             bpt := pt;
+             ept := pt + strlen(pt) - 1;
+             While (bpt < ept) Do
+               Begin
+                 c := bpt^;
+                 bpt^:=ept^;
+                 inc(bpt);
+                 ept^:=c;
+                 dec(ept);
+               End;
+           End;
+ Fpgetcwd:=pt;*)
+end;
+{$else not darwin}
+{$i getcwd.inc}
+{$endif darwin}
+
+{$endif}
+
+Function Do_IsDevice(Handle:Longint):boolean;
+{
+  Interface to Unix ioctl call.
+  Performs various operations on the filedescriptor Handle.
+  Ndx describes the operation to perform.
+  Data points to data needed for the Ndx function. The structure of this
+  data is function-dependent.
+}
+begin
+  do_isdevice:= (handle=StdInputHandle) or
+                (handle=StdOutputHandle) or
+                (handle=StdErrorHandle);
+end;
+
+{
+extern _IMPEXP_ROOT status_t  get_image_symbol(image_id imid,
+                  const char *name, int32 sclass,  void **ptr);
+extern _IMPEXP_ROOT status_t  get_nth_image_symbol(image_id imid, int32 index,
+                  char *buf, int32 *bufsize, int32 *sclass,
+                  void **ptr);
+}
+
+// 
+{$ifdef FPC_USE_LIBC}
+
+// private; use the macros, below
+function _get_image_info(image : image_id; var info : image_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_image_info';
+
+function _get_next_image_info(team : team_id; var cookie : Longint; var info : image_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_next_image_info';
+
+function get_image_info(image : image_id; var info : image_info) : status_t;
+begin
+  Result := _get_image_info(image, info, SizeOf(info));
+end;
+
+function get_next_image_info(team : team_id; var cookie : Longint; var info : image_info) : status_t;
+begin
+  Result := _get_next_image_info(team, cookie, info, SizeOf(info));
+end;
+
+{$else}
+
+    function wait_for_thread(thread: thread_id; var status : status_t): status_t;
+     var
+      args: SysCallArgs;
+      i: longint;
+     begin
+       args.param[1] := cint(thread);
+       args.param[2] := cint(@status);
+       wait_for_thread := SysCall(syscall_nr_wait_thread, args);
+     end;
+
+    function get_team_info(team: team_id; var info : team_info): status_t;
+     var
+      args: SysCallArgs;
+     begin
+       args.param[1] := cint(team);
+       args.param[2] := cint(@info);
+       get_team_info := SysCall(syscall_nr_get_team_info, args);
+     end;
+
+
+    function kill_team(team: team_id): status_t;
+     var
+      args: SysCallArgs;
+     begin
+       args.param[1] := cint(team);
+       kill_team := SysCall(syscall_nr_kill_team, args);
+     end;
+
+  function get_next_image_info(team : team_id; var cookie: longint;var info : image_info): status_t;
+     var
+      args: SysCallArgs;
+   begin
+       args.param[1] := cint(team);
+       args.param[2] := cint(@cookie);
+       args.param[3] := cint(@info);
+       args.param[4] := cint(sizeof(image_info));
+       get_next_image_info := SysCall(syscall_nr_get_next_image_info, args);
+   end;       
+
+    function load_image(argc : longint; argv : ppchar; envp : ppchar): thread_id;
+     var
+      args: SysCallArgs;
+      i: longint;
+     begin
+       args.param[1] := cint(argc);
+       args.param[2] := cint(argv);
+       args.param[3] := cint(envp);
+       load_image := SysCall(syscall_nr_load_image, args);
+     end;
+    
+    function get_system_info(var info: system_info): status_t;
+     var
+      args: SysCallArgs;
+      i: longint;
+     begin
+       args.param[1] := cint(@info);
+       i := SysCall(syscall_nr_get_system_info, args);
+       get_system_info := i;
+     end;
+
+    function dev_for_path(const pathname : pchar): dev_t;
+     var
+      args: SysCallArgs;
+      buffer: array[1..15] of longint;
+      i: cint;
+     begin
+       args.param[1] := $FFFFFFFF;
+       args.param[2] := cint(pathname);
+       args.param[3] := cint(@buffer);
+       args.param[4] := $01000000;
+       if SysCall(syscall_nr_rstat, args)=0 then
+          i:=buffer[1]
+       else
+          i:=-1;
+       dev_for_path := i;
+     end;
+
+
+    function fs_stat_dev(device: dev_t; var info: fs_info): dev_t;
+     var
+      args: SysCallArgs;
+     begin
+       args.param[1] := cint(device);
+       args.param[2] := 0;
+       args.param[3] := $FFFFFFFF;
+       args.param[4] := 0;
+       args.param[5] := cint(@info);
+       fs_stat_dev := SysCall(syscall_nr_statfs, args);
+     end;
+     
+{$endif}
+
+
+(* Implemented in sytem under BeOS
+CONST
+ { Constansts for MMAP }
+  MAP_PRIVATE   =2;
+  MAP_ANONYMOUS =$1000;
+
+Function sbrk(size : cint) : pointer;
+begin
+  sbrk:=Fpmmap(nil,cardinal(Size),3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
+  if sbrk=pointer(-1) then
+    sbrk:=nil
+  else
+    seterrno(0);
+end;
+*)
+

rtl/beos/ostypes.inc

@@ -0,0 +1,366 @@
+{
+    Copyright (c) 2000-2002 by Marco van de Voort
+
+    Some non POSIX BSD types used internally in the system unit.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{***********************************************************************}
+{                         POSIX STRUCTURES                              }
+{***********************************************************************}
+
+{$ifdef FPC_IS_SYSTEM}
+  {$i ptypes.inc}
+{$ENDIF}
+
+Type
+  timezone = packed record
+    tz_minuteswest,tz_dsttime:cint;
+  end;
+  ptimezone =^timezone;
+  TTimeZone = timezone;
+  
+  rusage = packed record
+        ru_utime    : timeval;          { user time used }
+        ru_stime    : timeval;          { system time used }
+        ru_maxrss   : clong;            { max resident set size }
+        ru_ixrss    : clong;            { integral shared memory size }
+        ru_idrss    : clong;            { integral unshared data " }
+        ru_isrss    : clong;            { integral unshared stack " }
+        ru_minflt   : clong;            { page reclaims }
+        ru_majflt   : clong;            { page faults }
+        ru_nswap    : clong;            { swaps }
+        ru_inblock  : clong;            { block input operations }
+        ru_oublock  : clong;            { block output operations }
+        ru_msgsnd   : clong;            { messages sent }
+        ru_msgrcv   : clong;            { messages received }
+        ru_nsignals : clong;            { signals received }
+        ru_nvcsw    : clong;            { voluntary context switches }
+        ru_nivcsw   : clong;            { involuntary " }
+        end;
+// #define      ru_last         ru_nivcsw
+// #define      ru_first        ru_ixrss
+
+{ auto generated by a c prog, statmacr.c}
+
+Const
+  S_IFMT  = &0000170000;
+  S_IFLNK = &0000120000;
+  S_IFREG = &0000100000;
+  S_IFBLK = &0000060000;
+  S_IFDIR = &0000040000;
+  S_IFCHR = &0000020000;
+  S_IFIFO = &0000010000;
+
+  S_IFSOCK= &0000000000; // not defined under BeOS
+  S_IFWHT = &0000000000; // not defined under BeOS
+  S_ISVTX = &1000;
+
+//      CONST SYS_NMLN=32;
+
+// Can't find these two in Posix and in BeOS
+//CONST
+//    _UTSNAME_LENGTH = ;
+//    _UTSNAME_NODENAME_LENGTH = ;
+
+CONST                		// OS specific parameters for general<fd,sig>set behaviour
+   BITSINWORD      = 8*sizeof(longint);
+//   SIG_MAXSIG      = 32;    //128;	// highest signal version
+   FD_MAXFDSET	   = 1024;
+//   wordsinsigset   = 4;		// words in sigset_t
+   ln2bitsinword   = 5;         { 32bit : ln(32)/ln(2)=5 } 
+   ln2bitmask	   = 2 shl ln2bitsinword - 1;
+   wordsinfdset    = FD_MAXFDSET DIV BITSINWORD;        // words in fdset_t   
+   wordsinsigset   = SIG_MAXSIG  DIV BITSINWORD;      
+
+TYPE
+   { system information services }
+   utsname = record
+              sysname : Array[0..SYS_NMLN-1] OF Char;   // Name of this OS
+              nodename: Array[0..SYS_NMLN-1] OF Char;   // Name of this network node.
+              release : Array[0..SYS_NMLN-1] OF Char;   // Release level.
+              version : Array[0..SYS_NMLN-1] OF Char;   // Version level.
+              machine : Array[0..SYS_NMLN-1] OF Char;   // Hardware type.
+             end;
+  TUtsName= utsname;
+  pUtsName= ^utsname;
+
+  { file characteristics services }
+(*   stat    = record { the types are real}
+        st_dev        : dev_t;             // inode's device
+        st_ino        : ino_t;             // inode's number
+        st_mode       : mode_t;            // inode protection mode
+        st_nlink      : nlink_t;           // number of hard links
+        st_uid        : uid_t;             // user ID of the file's owner
+        st_gid        : gid_t;             // group ID of the file's group
+        st_rdev       : dev_t;             // device type
+        st_atime      : time_t;            // time of last access
+        st_atimensec  : clong;             // nsec of last access
+        st_mtime      : time_t;            // time of last data modification
+        st_mtimensec  : clong;             // nsec of last data modification
+        st_ctime      : time_t;            // time of last file status change
+        st_ctimensec  : clong;             // nsec of last file status change
+{$ifdef netbsdPowerpc}
+	st_padd1	      : cint;
+{$endif}
+        st_size       : off_t;             // file size, in bytes
+        st_blocks     : cint64;            // blocks allocated for file
+        st_blksize    : cuint32;           // optimal blocksize for I/O
+        st_flags      : cuint32;           // user defined flags for file
+        st_gen        : cuint32;           // file generation number
+{$ifdef netbsdPowerpc}
+	st_padd2	      : cint;
+{$endif}
+{$ifndef NetBSD}
+        st_lspare     : cint32;
+{$endif}
+        st_qspare     : array[0..1] Of cint64;
+   end;*)
+   stat = packed record
+      dev:longint;     {"device" that this file resides on}
+      ino:int64;       {this file's inode #, unique per device}
+      st_mode:dword;      {mode bits (rwx for user, group, etc)}      
+      nlink:longint;   {number of hard links to this file}
+      uid:dword;       {user id of the owner of this file}
+      gid:dword;       {group id of the owner of this file}
+      st_size:int64;      {size of this file (in bytes)}
+      rdev:longint;    {device type (not used)}
+      blksize:longint; {preferref block size for i/o}
+      atime:longint;   {last access time}
+      st_mtime:longint;   {last modification time}
+      ctime:longint;   {last change time, not creation time}
+      crtime:longint;  {creation time}
+   end;
+   
+   TStat = stat;
+   pStat = ^stat;
+
+  { directory services }
+   dirent = packed record
+        d_dev:longint;
+        d_pdev:longint;
+        d_ino:int64;
+        d_pino:int64;
+        d_reclen:word;
+        d_name:array[0..255] of char;
+   end;
+(*   dirent  = record
+     d_dev : dev_t;
+     d_pdev : dev_t;
+     d_ino : ino_t;
+     d_pino : ino_t;
+     d_reclen : word;
+     d_name : Char;
+//        d_fileno      : cuint32;                        // file number of entry
+//        d_reclen      : cuint16;                        // length of this record
+//        d_type        : cuint8;                         // file type, see below
+//        d_namlen      : cuint8;                         // length of string in d_name
+//        d_name        : array[0..(255 + 1)-1] of char;  // name must be no longer than this
+   end;*)
+   TDirent = dirent;
+   pDirent = ^dirent;
+
+   dir     = packed record
+        fd     : cint;         // file descriptor associated with directory
+        ent : dirent;
+//        dd_loc    : clong;        // offset in current buffer
+//        dd_size   : clong;        // amount of data returned by getdirentries
+//        dd_buf    : pchar;        // data buffer
+//        dd_len    : cint;         // size of data buffer
+{$ifdef netbsdpowerpc}
+//	dd_pad1   : cint;
+//        dd_seek   : cint64;        // magic cookie returned by getdirentries
+{$else}
+//        dd_seek   : clong;        // magic cookie returned by getdirentries
+{$endif}
+//        dd_rewind : clong;        // magic cookie for rewinding
+//        dd_flags  : cint;         // flags for readdir
+   end;
+   TDir    = dir;
+   pDir    = ^dir;
+
+   utimbuf  = record
+	        actime  : time_t;
+	        modtime : time_t;
+	        end;
+   TUtimBuf = utimbuf;
+   putimbuf = ^utimbuf;
+
+   flock    = record
+		l_start : off_t;	{ starting offset }
+		l_len	: off_t;	{ len = 0 means until end of file }
+		l_pid 	: pid_t;	{ lock owner }
+		l_type	: cshort;	{ lock type: read/write, etc. }
+		l_whence: cshort;	{ type of l_start }
+                end;
+   TFlock   = flock;
+   pFlock   = ^flock;
+
+ tms = packed record
+	 tms_utime  : clock_t;	{ User CPU time }
+	 tms_stime  : clock_t;	{ System CPU time }
+	 tms_cutime : clock_t;	{ User CPU time of terminated child procs }
+	 tms_cstime : clock_t;	{ System CPU time of terminated child procs }
+	 end;
+ TTms= tms;
+ pTms= ^tms;
+
+ TFDSet    = ARRAY[0..(FD_MAXFDSET div 32)-1] of Cardinal;
+ pFDSet    = ^TFDSet;
+
+{***********************************************************************}
+{                  POSIX CONSTANT ROUTINE DEFINITIONS                   }
+{***********************************************************************}
+CONST
+    { access routine - these maybe OR'ed together }
+    F_OK        =     0;        { test for existence of file }
+    R_OK        =     4;        { test for read permission on file }
+    W_OK        =     2;        { test for write permission on file }
+    X_OK        =     1;        { test for execute or search permission }
+    { seek routine }
+    SEEK_SET    =     0;        { seek from beginning of file }
+    SEEK_CUR    =     1;        { seek from current position  }
+    SEEK_END    =     2;        { seek from end of file       }
+    { open routine                                 }
+    { File access modes for `open' and `fcntl'.    }
+    O_RDONLY    =     0;        { Open read-only.  }
+    O_WRONLY    =     1;        { Open write-only. }
+    O_RDWR      =     2;        { Open read/write. }
+    { Bits OR'd into the second argument to open.  }
+    O_CREAT     =  $200;        { Create file if it doesn't exist.  }
+    O_EXCL      =  $100;        { Fail if file already exists.      }
+    O_TRUNC     =  $400;        { Truncate file to zero length.     }
+    O_NOCTTY    = $1000;        { Don't assign a controlling terminal. }
+    { File status flags for `open' and `fcntl'.  }
+    O_APPEND    =  $800;        { Writes append to the file.        }
+    O_NONBLOCK  = $0080;        { Non-blocking I/O.                 }
+
+    { mode_t possible values                                 }
+    S_IRUSR =  %0100000000;     { Read permission for owner   }
+    S_IWUSR =  %0010000000;     { Write permission for owner  }
+    S_IXUSR =  %0001000000;     { Exec  permission for owner  }
+    S_IRGRP =  %0000100000;     { Read permission for group   }
+    S_IWGRP =  %0000010000;     { Write permission for group  }
+    S_IXGRP =  %0000001000;     { Exec permission for group   }
+    S_IROTH =  %0000000100;     { Read permission for world   }
+    S_IWOTH =  %0000000010;     { Write permission for world  }
+    S_IXOTH =  %0000000001;     { Exec permission for world   }
+
+    { Used for waitpid }
+    WNOHANG   =          1;     { don't block waiting               }
+    WUNTRACED =          2;     { report status of stopped children }
+
+Type 
+        TRLimit  = record
+                     rlim_cur,               { current (soft) limit }
+          	     rlim_max : TRLim;     { maximum value for rlim_cur }
+		    end;	
+        PRLimit  = ^TRLimit;
+
+ iovec = record
+            iov_base : pointer;
+	    iov_len  : size_t;
+	   end;
+  tiovec=iovec;
+  piovec=^tiovec;		
+
+
+    {*************************************************************************}
+    {                               SIGNALS                                   }
+    {*************************************************************************}
+
+{$i signal.inc}
+
+// BeOS types
+{ ------------------------- Images --------------------------- }
+
+type
+  // Descriptive formats
+  status_t = Longint;
+  area_id   = Longint;
+  port_id   = Longint;
+  sem_id    = Longint;
+  thread_id = Longint;
+  team_id   = Longint;
+  bigtime_t = int64;
+  image_id = longint;
+
+
+{/* commands that can be passed to fcntl */
+#define	F_DUPFD			0x0001
+#define	F_GETFD			0x0002
+#define	F_SETFD			0x0004
+#define	F_GETFL			0x0008
+#define	F_SETFL			0x0010
+#define F_GETLK         0x0020
+#define F_RDLCK         0x0040
+#define F_SETLK         0x0080
+#define F_SETLKW        0x0100
+#define F_UNLCK         0x0200
+#define F_WRLCK         0x0400
+}
+const
+  F_DUPFD	=		$0001;
+  F_GETFD	=		$0002;
+  F_SETFD	=		$0004;
+  F_GETFL	=		$0008;
+  F_SETFL	=		$0010;
+  F_GETLK   =     	$0020;
+  F_RDLCK   =     	$0040;
+  F_SETLK   =      	$0080;
+  F_SETLKW  =      	$0100;
+  F_UNLCK   =      	$0200;
+  F_WRLCK   =      	$0400;
+
+    { image types }
+const
+   B_APP_IMAGE     = 1;
+   B_LIBRARY_IMAGE = 2;
+   B_ADD_ON_IMAGE  = 3;
+   B_SYSTEM_IMAGE  = 4;
+type
+    image_info = packed record
+     id      : image_id;   
+     _type   : longint;
+     sequence: longint;
+     init_order: longint;
+     init_routine: pointer;
+     term_routine: pointer;
+     device: dev_t;
+     node: ino_t;
+     name: array[0..1024{MAXPATHLEN}-1] of char;
+{     name: string[255];
+     name2: string[255];
+     name3: string[255];
+     name4: string[255];
+     name5: string[5];
+}
+     text: pointer;
+     data: pointer;
+     text_size: longint;
+     data_size: longint;
+    end;
+    
+(*----- symbol types and functions ------------------------*)
+
+const B_SYMBOL_TYPE_DATA = $1;
+const B_SYMBOL_TYPE_TEXT = $2;
+const B_SYMBOL_TYPE_ANY  = $5;
+
+{ Constansts for MMAP }
+const
+  MAP_ANONYMOUS =$1000;

rtl/beos/posix.pp

@@ -1,78 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2001 by Carl Eric Codere
-    development team
-
-    POSIX Compliant interface unit
-
-    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 posix;
-
-interface
-
-{***********************************************************************}
-{                       POSIX PUBLIC INTERFACE                          }
-{***********************************************************************}
-
-
-{$i errno.inc}
-{$i osposixh.inc}
-
-
-    function sys_fork : pid_t;
-    function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
-    function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
-    procedure sys_exit(status : cint);
-    { get system specific information }
-    function sys_uname(var name: utsname): cint;
-    function sys_opendir(const dirname : pchar): pdir;
-    function sys_readdir(dirp : pdir) : pdirent;
-    function sys_closedir(dirp : pdir): cint;
-    function sys_chdir(const path : pchar): cint;
-    function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
-    function sys_mkdir(const path : pchar; mode: mode_t):cint;
-    function sys_unlink(const path: pchar): cint;
-    function sys_rmdir(const path : pchar): cint;
-    function sys_rename(const old : pchar; const newpath: pchar): cint;
-    function sys_fstat(fd : cint; var sb : stat): cint;
-    function sys_stat(const path: pchar; var buf : stat): cint;
-    function sys_access(const pathname : pchar; amode : cint): cint;
-    function sys_close(fd : cint): cint;
-    function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t;
-    function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
-    function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
-    function sys_time(var tloc:time_t): time_t;
-
-
-    function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
-    function sys_ftruncate(fd : cint; flength : off_t): cint;
-
-    function S_ISDIR(m : mode_t): boolean;
-    function S_ISCHR(m : mode_t): boolean;
-    function S_ISBLK(m : mode_t): boolean;
-    function S_ISREG(m : mode_t): boolean;
-    function S_ISFIFO(m : mode_t): boolean;
-
-    function wifexited(status : cint): cint;
-    function wexitstatus(status : cint): cint;
-    function wstopsig(status : cint): cint;
-    function wifsignaled(status : cint): cint;
-
-
-
-
-implementation
-
-{$i osposix.inc}
-
-
-
-
-end.

rtl/beos/ptypes.inc

@@ -0,0 +1,213 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+
+{***********************************************************************}
+{                       POSIX TYPE DEFINITIONS                          }
+{***********************************************************************}
+
+{$i ctypes.inc}
+
+type
+  fsblkcnt_t = clonglong;
+  TStatfs = packed record
+    bsize 			: Cardinal;
+    frsize			: Cardinal;
+    blocks			: fsblkcnt_t;
+    bfree			: fsblkcnt_t;
+    bavail			: fsblkcnt_t;
+    files			: fsblkcnt_t;
+    ffree			: fsblkcnt_t;
+    favail			: fsblkcnt_t;
+    fsid			: Cardinal;
+    flag			: Cardinal;
+    namemax			: Cardinal;
+  end;
+  PStatFS=^TStatFS;
+
+    dev_t    = cuint32;         { used for device numbers      }
+    TDev     = dev_t;
+    pDev     = ^dev_t;
+
+    gid_t    = cuint32;         { used for group IDs           }
+    TGid     = gid_t;
+    pGid     = ^gid_t;
+
+    ino_t    = clonglong;           { used for file serial numbers }
+    TIno     = ino_t;
+    pIno     = ^ino_t;
+
+    mode_t   = cuint16;         { used for file attributes     }
+    TMode    = mode_t;
+    pMode    = ^mode_t;
+
+    nlink_t  = cuint16;         { used for link counts         }
+    TnLink   = nlink_t;
+    pnLink   = ^nlink_t;
+
+    off_t    = cint64;          { used for file sizes          }
+    TOff     = off_t;
+    pOff     = ^off_t;
+
+    pid_t    = cint32;          { used as process identifier   }
+    TPid     = pid_t;
+    pPid     = ^pid_t;
+
+    wint_t	 = cint32;
+    size_t   = cuint32;         { as definied in the C standard}
+    TSize    = size_t;
+    pSize    = ^size_t;
+    psize_t   = pSize;		
+
+    ssize_t  = cint32;          { used by function for returning number of bytes }
+    TsSize   = ssize_t;
+    psSize   = ^ssize_t;		
+
+    uid_t    = cuint32;         { used for user ID type        }
+    TUid     = Uid_t;
+    pUid     = ^Uid_t;
+
+    clock_t  = culong;
+    TClock   = clock_t;
+    pClock   = ^clock_t;
+
+    time_t   = clong;           { used for returning the time  }
+    TTime    = time_t; 
+    pTime    = ^time_t;
+    ptime_t =  ^time_t;
+    
+    wchar_t   = widechar;
+    pwchar_t  = ^wchar_t;
+
+    socklen_t= cuint32;
+    TSocklen = socklen_t;
+    pSocklen = ^socklen_t;
+
+  timeval  = packed record
+    tv_sec,tv_usec:clong;
+  end;
+  ptimeval = ^timeval;
+  TTimeVal = timeval;
+
+  timespec = packed record
+    tv_sec   : time_t;
+    tv_nsec  : clong;
+  end;
+  ptimespec= ^timespec;
+  Ttimespec= timespec;
+  
+  pthread_t = culong;
+  
+  sched_param = record
+    __sched_priority: cint;
+  end;
+
+  pthread_attr_t = record
+    __detachstate: cint;
+    __schedpolicy: cint;
+    __schedparam: sched_param;
+    __inheritsched: cint;
+    __scope: cint;
+    __guardsize: size_t;
+    __stackaddr_set: cint;
+    __stackaddr: pointer;
+    __stacksize: size_t;
+  end;
+
+  _pthread_fastlock = record
+    __status: clong;
+    __spinlock: cint;
+  end;
+
+  pthread_mutex_t = record
+    __m_reserved: cint;
+    __m_count: cint;
+    __m_owner: pointer;
+    __m_kind:  cint;
+    __m_lock: _pthread_fastlock;
+  end;
+
+  pthread_mutexattr_t = record
+    __mutexkind: cint;
+  end;
+
+  pthread_cond_t = record
+    __c_lock: _pthread_fastlock;
+    __c_waiting: pointer;
+    __padding: array[0..48-1-sizeof(_pthread_fastlock)-sizeof(pointer)-sizeof(clonglong)] of byte;
+    __align: clonglong;
+  end;
+    
+  pthread_condattr_t = record
+    __dummy: cint;
+  end;
+
+  pthread_key_t = cuint;
+
+  pthread_rwlock_t = record
+    __rw_readers: cint;
+    __rw_writer: pointer;
+    __rw_read_waiting: pointer;
+    __rw_write_waiting: pointer;
+    __rw_kind: cint;
+    __rw_pshared: cint;
+  end;
+
+  pthread_rwlockattr_t = record
+    __lockkind: cint;
+    __pshared: cint;
+  end;
+  
+  sem_t = record
+     __sem_lock: _pthread_fastlock;
+     __sem_value: cint;
+     __sem_waiting: pointer;
+  end;
+
+   rlim_t		= int64;
+   TRlim		= rlim_t;
+
+
+CONST
+    _PTHREAD_MUTEX_TIMED_NP      = 0;
+    _PTHREAD_MUTEX_RECURSIVE_NP  = 1;
+    _PTHREAD_MUTEX_ERRORCHECK_NP = 2;
+    _PTHREAD_MUTEX_ADAPTIVE_NP   = 3;
+  
+    _PTHREAD_MUTEX_NORMAL     = _PTHREAD_MUTEX_TIMED_NP;
+    _PTHREAD_MUTEX_RECURSIVE  = _PTHREAD_MUTEX_RECURSIVE_NP;
+    _PTHREAD_MUTEX_ERRORCHECK = _PTHREAD_MUTEX_ERRORCHECK_NP;
+    _PTHREAD_MUTEX_DEFAULT    = _PTHREAD_MUTEX_NORMAL;
+    _PTHREAD_MUTEX_FAST_NP    = _PTHREAD_MUTEX_ADAPTIVE_NP;
+
+     _PTHREAD_KEYS_MAX              = 256;
+     _PTHREAD_STACK_MIN             = 1024;
+
+CONST
+   { System limits, POSIX value in parentheses, used for buffer and stack allocation }
+    ARG_MAX  = 65536;   {4096}  { Maximum number of argument size     }
+    NAME_MAX = 255;     {14}    { Maximum number of bytes in filename }
+    PATH_MAX = 1024;    {255}   { Maximum number of bytes in pathname }
+
+    SYS_NMLN = 32;              {BSD utsname struct limit}
+    
+    SIG_MAXSIG = 32; //128;	// highest signal version  // BeOS  
+
+const
+  { For getting/setting priority }
+  Prio_Process = 0;
+  Prio_PGrp    = 1;
+  Prio_User    = 2;

rtl/beos/settimeo.inc

@@ -0,0 +1,49 @@
+{
+   This file is part of the Free Pascal run time library.
+   Copyright (c) 2004 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.
+
+**********************************************************************}
+{$ifdef beos}
+{$ifdef i386}
+  {$define usestime}
+{$endif}
+{$endif}
+
+{$ifdef usestime}
+
+{$ifdef FPC_USE_LIBC}
+function stime (t:ptime_t):cint; cdecl; external name 'stime';
+{$else}
+function stime (t:ptime_t):cint; 
+begin
+ stime:=do_SysCall(Syscall_nr_stime,TSysParam(t));
+end;
+{$endif}
+
+function settimeofday(tp:ptimeval;tzp:ptimezone):cint;
+
+begin
+  settimeofday:=stime(@tp^.tv_sec);
+end;
+
+{$else}
+
+{$ifdef FPC_USE_LIBC}
+function settimeofday(tp:ptimeval;tzp:ptimezone):cint; cdecl; external clib name 'settimeofday';
+{$else}
+function settimeofday(tp:ptimeval;tzp:ptimezone):cint;
+
+begin
+  settimeofday:=do_SysCall(Syscall_nr_settimeofday,TSysParam(@tp),TSysParam(tzp));
+end;
+{$endif}
+{$endif}
+

rtl/beos/signal.inc

@@ -0,0 +1,299 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe,
+    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.
+
+ **********************************************************************}
+
+
+Const   { For sending a signal }
+
+  SA_NOCLDSTOP = 1;
+  
+  // does not exist under BeOS i think !
+  SA_ONSTACK   = $001; { take signal on signal stack }
+  SA_RESTART   = $002; { restart system call on signal return }
+  SA_RESETHAND = $004; { reset to SIG_DFL when taking signal }
+  SA_NODEFER   = $010; { don't mask the signal we're delivering }
+  SA_NOCLDWAIT = $020; { don't keep zombies around }
+  SA_SIGINFO   = $040; { signal handler with SA_SIGINFO args }
+  SA_USERTRAMP = $100; { SUNOS compat: Do not bounce off kernel's sigtramp }
+
+  SIG_BLOCK   = 1;
+  SIG_UNBLOCK = 2;
+  SIG_SETMASK = 3;
+
+{BeOS Checked}
+{
+   The numbering of signals for BeOS attempts to maintain 
+   some consistency with UN*X conventions so that things 
+   like "kill -9" do what you expect.
+}   
+
+  SIG_DFL = 0 ;
+  SIG_IGN = 1 ;
+  SIG_ERR = -1 ;
+
+  SIGHUP     = 1;
+  SIGINT     = 2;
+  SIGQUIT    = 3;
+  SIGILL     = 4;
+  SIGCHLD    = 5;
+  SIGABRT    = 6;
+  SIGPIPE    = 7;
+  SIGFPE     = 8;
+  SIGKILL    = 9;
+  SIGSTOP    = 10;
+  SIGSEGV    = 11;
+  SIGCONT    = 12;
+  SIGTSTP    = 13;
+  SIGALRM    = 14;
+  SIGTERM    = 15;
+  SIGTTIN    = 16;
+  SIGTTOU    = 17;
+  SIGUSR1    = 18;
+  SIGUSR2    = 19;
+  SIGWINCH   = 20;
+  SIGKILLTHR = 21;
+  SIGTRAP    = 22;
+  SIGBUS     = SIGSEGV;
+  
+{
+   Signal numbers 23-32 are currently free but may be used in future
+   releases.  Use them at your own peril (if you do use them, at least
+   be smart and use them backwards from signal 32).
+}
+
+{$packrecords C}
+const
+  SI_PAD_SIZE   = ((128/sizeof(longint)) - 3);
+
+{
+ * The sequence of the fields/registers in struct sigcontext should match
+ * those in mcontext_t.
+ }
+
+type 
+  packed_fp_stack = packed record
+    st0 : array[0..9] of byte;
+    st1 : array[0..9] of byte;
+    st2 : array[0..9] of byte;
+    st3 : array[0..9] of byte;
+    st4 : array[0..9] of byte;
+    st5 : array[0..9] of byte;
+    st6 : array[0..9] of byte;    
+    st7 : array[0..9] of byte;    
+  end;
+  
+  packed_mmx_regs = packed record
+    mm0 : array[0..9] of byte;
+    mm1 : array[0..9] of byte;
+    mm2 : array[0..9] of byte;
+    mm3 : array[0..9] of byte;
+    mm4 : array[0..9] of byte;
+    mm5 : array[0..9] of byte;
+    mm6 : array[0..9] of byte;    
+    mm7 : array[0..9] of byte;    
+  end;
+  
+  old_extended_regs = packed record
+    fp_control 	: word;
+    _reserved1 	: word;
+    fp_status 	: word;
+    _reserved2 	: word;
+    fp_tag 		: word;
+    _reserved3 	: word;
+    fp_eip 		: cardinal;
+    fp_cs 		: word;
+    fp_opcode	: word;
+    fp_datap	: word;
+    fp_ds		: word;
+    _reserved4	: word;
+    fp_mmx : record
+      case fp_mmx : byte of
+        0 : (fp	: packed_fp_stack);
+        1 : (mmx	: packed_mmx_regs);
+    end;
+  end;
+  
+  fp_stack = record
+    st0 : array[0..9] of byte;
+    _reserved_42_47 : array[0..5] of byte;
+    st1 : array[0..9] of byte;
+    _reserved_58_63 : array[0..5] of byte;
+    st2 : array[0..9] of byte;
+    _reserved_74_79 : array[0..5] of byte;
+    st3 : array[0..9] of byte;
+    _reserved_90_95 : array[0..5] of byte;
+    st4 : array[0..9] of byte;
+    _reserved_106_111 : array[0..5] of byte;
+    st5 : array[0..9] of byte;
+    _reserved_122_127 : array[0..5] of byte;
+    st6 : array[0..9] of byte;    
+    _reserved_138_143 : array[0..5] of byte;
+    st7 : array[0..9] of byte;        
+    _reserved_154_159 : array[0..5] of byte;
+  end;
+  
+  mmx_regs = record
+    mm0 : array[0..9] of byte;
+    _reserved_42_47 : array[0..5] of byte;
+    mm1 : array[0..9] of byte;
+    _reserved_58_63 : array[0..5] of byte;
+    mm2 : array[0..9] of byte;
+    _reserved_74_79 : array[0..5] of byte;
+    mm3 : array[0..9] of byte;
+    _reserved_90_95 : array[0..5] of byte;
+    mm4 : array[0..9] of byte;
+    _reserved_106_111 : array[0..5] of byte;
+    mm5 : array[0..9] of byte;
+    _reserved_122_127 : array[0..5] of byte;
+    mm6 : array[0..9] of byte;    
+    _reserved_138_143 : array[0..5] of byte;
+    mm7 : array[0..9] of byte;    
+    _reserved_154_159 : array[0..5] of byte;
+  end;
+  
+  xmmx_regs = record
+    xmm0 : array [0..15] of byte;
+    xmm1 : array [0..15] of byte;
+    xmm2 : array [0..15] of byte;
+    xmm3 : array [0..15] of byte;
+    xmm4 : array [0..15] of byte;
+    xmm5 : array [0..15] of byte;
+    xmm6 : array [0..15] of byte;
+    xmm7 : array [0..15] of byte;
+  end;
+  
+  new_extended_regs = record
+    fp_control 	: word;
+    fp_status 	: word;
+    fp_tag		: word;
+    fp_opcode	: word;
+    fp_eip		: Cardinal;
+    fp_cs		: word;
+    res_14_15	: word;
+    fp_datap	: Cardinal;
+    fp_ds		: word;
+    _reserved_22_23 : word;
+    mxcsr		: Cardinal;
+    _reserved_28_31 : Cardinal;
+    fp_mmx : record
+      case byte of
+        0 : (fp : fp_stack);
+        1 : (mmx : mmx_regs);
+    end;
+    xmmx : xmmx_regs;
+    _reserved_288_511 : array[0..223] of byte;
+  end;
+  
+  extended_regs = record
+    state : record
+      case byte of
+  	    0 : (old_format : old_extended_regs);
+  	    1 : (new_format : new_extended_regs);  	  
+  	end;
+  	format	: Cardinal;
+  end;
+  
+  vregs = record
+    eip 	: Cardinal;
+    eflags 	: cardinal;
+    eax		: Cardinal;
+    ecx		: Cardinal;
+    edx		: Cardinal;
+    esp		: Cardinal;
+    ebp		: Cardinal;
+    _reserved_1 : Cardinal;
+    xregs	: extended_regs;
+    _reserved_2 : array[0..2] of Cardinal;
+  end;
+  
+  Pvregs = ^vregs;
+
+  sigset_t = array[0..3] of Longint;
+
+    PSigContextRec = ^SigContextRec;
+    SigContextRec = record
+       sc_mask      : sigset_t;          { signal mask to restore }
+       sc_onstack   : longint;              { sigstack state to restore }
+
+       sc_gs        : longint;              { machine state (struct trapframe): }
+       sc_fs        : longint;
+       sc_es        : longint;
+       sc_ds        : longint;
+       sc_edi       : longint;
+       sc_esi       : longint;
+       sc_ebp       : longint;
+       sc_isp       : longint;
+       sc_ebx       : longint;
+       sc_edx       : longint;
+       sc_ecx       : longint;
+       sc_eax       : longint;
+       sc_trapno    : longint;
+       sc_err       : longint;
+       sc_eip       : longint;
+       sc_cs        : longint;
+       sc_efl       : longint;
+       sc_esp       : longint;
+       sc_ss        : longint;
+        {
+         * XXX FPU state is 27 * 4 bytes h/w, 1 * 4 bytes s/w (probably not
+         * needed here), or that + 16 * 4 bytes for emulators (probably all
+         * needed here).  The "spare" bytes are mostly not spare.
+         }
+       en_cw        : cardinal;     { control word (16bits used) }
+       en_sw        : cardinal;     { status word (16bits) }
+       en_tw        : cardinal;     { tag word (16bits) }
+       en_fip       : cardinal;     { floating point instruction pointer }
+       en_fcs       : word;         { floating code segment selector }
+       en_opcode    : word;         { opcode last executed (11 bits ) }
+       en_foo       : cardinal;     { floating operand offset }
+       en_fos       : cardinal;     { floating operand segment selector }
+       fpr_acc      : array[0..79] of char;
+       fpr_ex_sw    : cardinal;
+       fpr_pad      : array[0..63] of char;
+       end;
+       
+  SignalHandler   = Procedure(Sig : Longint);cdecl;
+  PSignalHandler  = ^SignalHandler;
+  SignalRestorer  = Procedure;cdecl;
+  PSignalRestorer = ^SignalRestorer;
+  {$WARNING TODO : check with signal.h}
+  sigActionHandler = procedure(Sig: Longint; SigContext: PSigContextRec; uContext : Pvregs);cdecl;
+
+  Sigset=sigset_t;
+  TSigset=sigset_t;
+  PSigSet = ^SigSet;
+  psigset_t=psigset;
+
+  SigActionRec = packed record
+//    Handler  : record
+    sa_handler : sigActionHandler;
+//      case byte of
+//        0: (Sh: SignalHandler);
+//        1: (Sa: TSigAction);
+//      end;
+    sa_Mask     : SigSet;
+    sa_Flags    : Longint;
+    sa_userdaa  : pointer
+  end;
+
+  PSigActionRec = ^SigActionRec;
+
+{
+  Change action of process upon receipt of a signal.
+  Signum specifies the signal (all except SigKill and SigStop).
+  If Act is non-nil, it is used to specify the new action.
+  If OldAct is non-nil the previous action is saved there.
+}
+
+
+

rtl/beos/suuid.inc

@@ -0,0 +1,38 @@
+Const 
+  RandomDevice  = '/dev/urandom';
+
+
+Function GetURandomBytes(Var Buf; NBytes : Integer) : Boolean;
+
+Var
+  fd,I : Integer;
+  P : PByte;
+  
+begin
+  P:=@Buf;
+  fd:=FileOpen(RandomDevice,fmOpenRead);
+  Result:=(fd>=0);
+  if Result then
+    Try
+      While (NBytes>0) do
+        begin
+        I:=FileRead(fd,P^,nbytes);
+        If I>0 then
+          begin
+          Inc(P,I);
+          Dec(NBytes,I);
+          end;
+        end;  
+    Finally
+      FileClose(Fd);
+    end;
+end;
+
+
+Function SysCreateGUID(out GUID : TGUID) : Integer;
+
+begin
+  if not GetUrandomBytes(Guid,SizeOf(GUID)) then
+    GetRandomBytes(GUID,SizeOf(Guid));  
+  Result:=0;    
+end;

rtl/beos/syscall.inc

@@ -1,4 +1,5 @@
 {
+    $Id: syscall.inc,v 1.1 2003/01/08 22:32:28 marco Exp $
     Copyright (c) 1998-2000 by Florian Klaempfl
 
     This include implements the actual system call for the
@@ -20,20 +21,12 @@
 
  ****************************************************************************
 }
-
-type
-     SysCallArgs = packed record
-       param: array[1..8] of cint;
-     End;
-
-
-procedure sys_call; external name 'sys_call';
-
-
-
-function Do_SysCall( callnr:longint;var regs : SysCallArgs ): longint;assembler;
+// Under BeOS, we use stdcall for this line because the default calling convention in 1.9 
+// is register instead of stdcall. But assembler is already written, so i used the stdcall
+// calling convention !
+function Do_SysCall( callnr : longint; var regs : SysCallArgs ): longint; stdcall; assembler; [public, alias : 'FPC_SYSCALL'];
 {
-  This routine sets up the parameters on the stack, all the parameters
+  This routine sets up the parameters on the stack, all the parameters 
   are in reverse order on the stack (like C parameter passing).
 }
 asm
@@ -42,7 +35,7 @@ asm
   movl  24(%eax),%ebx
   pushl %ebx
   movl  20(%eax),%ebx
-  pushl %ebx
+  pushl %ebx 
   movl  16(%eax),%ebx
   pushl %ebx
   movl  12(%eax),%ebx
@@ -59,8 +52,10 @@ asm
   addl  $28,%esp
 end;
 
-
-Function SysCall( callnr:longint;var args : SysCallArgs ):longint;
+// Under BeOS, we use stdcall for this line because the default calling convention in 1.9 
+// is register instead of stdcall. But assembler is already written, so i used the stdcall
+// calling convention ! Maybe don't needed here. But to be sure...
+Function SysCall( callnr:longint;var args : SysCallArgs ):longint; stdcall;
 {
   This function serves as an interface to do_SysCall.
   If the SysCall returned a negative number, it returns -1, and puts the
@@ -69,17 +64,30 @@ Function SysCall( callnr:longint;var args : SysCallArgs ):longint;
 var
  funcresult : longint;
 begin
-  funcresult:=do_SysCall(callnr,args);
-  if funcresult<0 then
+  funcresult := do_SysCall(callnr, args);
+  if funcresult < 0 then
    begin
-     ErrNo:=funcresult;
-     SysCall:=-1;
+     errno := funcresult;
+     SysCall := - 1;
    end
   else
    begin
-     SysCall:=funcresult;
-     errno:=0
+     SysCall := funcresult;
+     errno := 0;
    end;
 end;
 
 
+{
+  $Log: syscall.inc,v $
+  Revision 1.1  2003/01/08 22:32:28  marco
+   * Small fixes and quick merge with 1.0.x. At least the compiler builds now,
+      but it could crash hard, since there are lots of unimplemented funcs.
+
+  Revision 1.1.2.2  2001/08/15 01:08:25  carl
+  * added SysCall(0 routine here as well as argument declarations
+
+  Revision 1.1.2.1  2001/07/13 03:16:03  carl
+  + static kernel call interface (CPU specific)
+
+}

rtl/beos/syscallh.inc

@@ -0,0 +1,55 @@
+{
+    Copyright (c) 2002 by Marco van de Voort
+
+    Header for syscall in system unit for i386 *BSD.
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+
+}
+
+Type
+  TSysResult = longint; // all platforms, cint=32-bit.
+                        // On platforms with off_t =64-bit, people should
+                        // use int64, and typecast all calls that don't
+                        // return off_t to cint.
+
+// I don't think this is going to work on several platforms
+// 64-bit machines don't have only 64-bit params.
+
+  TSysParam  = longint;
+  
+type
+     SysCallArgs = packed record
+       param: array[1..8] of longint; // cint but not defined in unix.pp
+     End;
+
+{$IFDEF FPC_USE_LIBC}
+//var
+//  Errno : cint;
+  
+{$else}
+//var
+//  Errno : cint;
+
+{$ENDIF}
+procedure sys_call; external name 'sys_call'; // BeOS
+//begin
+//end;
+
+  
+//function Do_SysCall( callnr : longint; var regs : SysCallArgs ): longint; external name 'FPC_SYSCALL';//forward;
+//Function SysCall( callnr:longint;var args : SysCallArgs ):longint; external name 'sys_call';//forward;

rtl/beos/sysconst.inc

@@ -0,0 +1,91 @@
+{
+    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.
+
+    Constants for Unix unit.
+
+    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.
+
+ **********************************************************************}
+
+
+const
+  { Things for LSEEK call}
+  Seek_set = 0;
+  Seek_Cur = 1;
+  Seek_End = 2;
+
+  { The waitpid uses the following options:}
+  Wait_NoHang   = 1;
+  Wait_UnTraced = 2;
+  Wait_Any      = -1;
+  Wait_MyPGRP   = 0;
+
+
+  { Constants to check stat.mode -  checked all STAT constants with BSD}
+  STAT_IFMT   = $f000; {00170000 }
+  STAT_IFSOCK = $c000; {0140000 }
+  STAT_IFLNK  = $a000; {0120000 }
+  STAT_IFREG  = $8000; {0100000 }
+  STAT_IFBLK  = $6000; {0060000 }
+  STAT_IFDIR  = $4000; {0040000 }
+  STAT_IFCHR  = $2000; {0020000 }
+  STAT_IFIFO  = $1000; {0010000 }
+  STAT_ISUID  = $0800; {0004000 }
+  STAT_ISGID  = $0400; {0002000 }
+  STAT_ISVTX  = $0200; {0001000}
+  { Constants to check permissions all }
+  STAT_IRWXO = $7;
+  STAT_IROTH = $4;
+  STAT_IWOTH = $2;
+  STAT_IXOTH = $1;
+
+  STAT_IRWXG = STAT_IRWXO shl 3;
+  STAT_IRGRP = STAT_IROTH shl 3;
+  STAT_IWGRP = STAT_IWOTH shl 3;
+  STAT_IXGRP = STAT_IXOTH shl 3;
+
+  STAT_IRWXU = STAT_IRWXO shl 6;
+  STAT_IRUSR = STAT_IROTH shl 6;
+  STAT_IWUSR = STAT_IWOTH shl 6;
+  STAT_IXUSR = STAT_IXOTH shl 6;
+
+  { Constants to test the type of filesystem }
+  fs_old_ext2 = $ef51;
+  fs_ext2     = $ef53;
+  fs_ext      = $137d;
+  fs_iso      = $9660;
+  fs_minix    = $137f;
+  fs_minix_30 = $138f;
+  fs_minux_V2 = $2468;
+  fs_msdos    = $4d44;
+  fs_nfs      = $6969;
+  fs_proc     = $9fa0;
+  fs_xia      = $012FD16D;
+
+  {Constansts Termios/Ioctl (used in Do_IsDevice) }
+  IOCtl_TCGETS= $40000000+$2C7400+ 19; // TCGETS is also in termios.inc, but the sysunix needs only this
+
+  ITimer_Real    =0;
+  ITimer_Virtual =1;
+  ITimer_Prof    =2;
+
+{
+  {Checked for BSD using Linuxthreads port}
+  { cloning flags }
+  CSIGNAL       = $000000ff; // signal mask to be sent at exit
+  CLONE_VM      = $00000100; // set if VM shared between processes
+  CLONE_FS      = $00000200; // set if fs info shared between processes
+  CLONE_FILES   = $00000400; // set if open files shared between processes
+  CLONE_SIGHAND = $00000800; // set if signal handlers shared
+  CLONE_PID     = $00001000; // set if pid shared
+
+type
+ TCloneFunc=function(args:pointer):longint;cdecl;
+}

rtl/beos/sysfiles.inc

@@ -1,18 +0,0 @@
-
-const O_RDONLY=0;
-const O_WRONLY=1;
-const O_RDWR=2;
-const O_CREAT = $200;
-const O_TRUNC = $400;
-const O_APPEND = $800;
-{const O_TEXT = $4000;
-const O_BINARY = $8000;}
-
-
-function sys_open (a:cardinal;name:pchar;access:longint;b:longint;c:longint):longint; cdecl; external name 'sys_open';
-function sys_close (handle:longint):longint; cdecl; external name 'sys_close';
-function sys_read (handle:longint;buffer:pointer;len:longint;var a:longint):longint; cdecl; external name 'sys_read';
-function sys_write (handle:longint;buffer:pointer;len:longint;var a:longint):longint; cdecl; external name 'sys_write';
-function sys_lseek (handle:longint;pos:int64;whence:longint): int64; cdecl; external name 'sys_lseek';
-
-

rtl/beos/sysheap.inc

@@ -0,0 +1,53 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+function sbrk2 (size : longint):pointer; cdecl; external name 'sbrk';
+
+function SysOSAlloc(size: ptruint): pointer;
+begin
+  result := sbrk2(size);
+{  result:=Fpmmap(nil,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
+  if result=pointer(-1) then
+    result:=nil
+  else
+    seterrno(0);
+}
+end;
+
+{$define HAS_SYSOSFREE}
+
+procedure SysOSFree(p: pointer; size: ptruint);
+begin
+//  fpmunmap(p, size);
+//  WriteLn('TODO : SysOSFree');
+end;
+
+
+
+{
+   $Log: sysheap.inc,v $
+   Revision 1.1  2005/02/07 22:04:55  peter
+     * moved to unix
+
+   Revision 1.1  2005/02/06 16:57:18  peter
+     * threads for go32v2,os,emx,netware
+
+   Revision 1.1  2005/02/06 13:06:20  peter
+     * moved file and dir functions to sysfile/sysdir
+     * win32 thread in systemunit
+
+}
+

rtl/beos/sysnr.inc

@@ -0,0 +1,47 @@
+const
+      { BeOS specific calls }
+      syscall_nr_create_area = $14;
+      syscall_nr_resize_area = $08;
+      syscall_nr_delete_area = $15;
+      syscall_nr_load_image  = $34;
+      syscall_nr_wait_thread = $22;
+      syscall_nr_rstat       = $30;
+      syscall_nr_statfs      = $5F;
+      syscall_nr_get_team_info = $3b;
+      syscall_nr_kill_team   = $3a;
+      syscall_nr_get_system_info = $56;
+      syscall_nr_kget_tzfilename = $AF;
+      syscall_nr_get_next_image_info = $3C;
+
+const           
+      syscall_nr_exit   		= $3F;
+      syscall_nr_chdir  		= $57; 
+      syscall_nr_mkdir  		= $1E; 
+      syscall_nr_unlink 		= $27;
+      syscall_nr_rmdir  		= $60;
+      syscall_nr_close  		= $01;
+      syscall_nr_read   		= $02;
+      syscall_nr_write  		= $03;
+      syscall_nr_stat   		= $30;
+      syscall_nr_fstat  		= $30;
+      syscall_nr_rename 		= $26;
+      syscall_nr_access 		= $58;
+      syscall_nr_opendir		= $0C;
+      syscall_nr_closedir		= $0F;
+      syscall_nr_sigaction		= $70;
+      syscall_nr_time     		= $07;
+      syscall_nr_open     		= $00;
+      syscall_nr_readdir  		= $1C;
+      syscall_nr_lseek    		= $05;
+      syscall_nr_ftruncate 		= $4B;
+      syscall_nr_ioctl    		= $04;
+      syscall_nr_gettimeofday 	= $A6;
+      syscall_nr_fork           = $A1;
+      syscall_nr_waitpid        = $A3;
+      syscall_nr_fcntl          = $0B;
+      syscall_nr_dup            = syscall_nr_fcntl;
+      syscall_nr_dup2           = $4A;
+      syscall_nr_sbrk           = syscall_nr_resize_area;
+      syscall_nr_getpid         = $00; // not a syscall under BeOS
+      syscall_nr_sigprocmask    = $73;
+      syscall_nr_getcwd         = $00; // not a syscall under BeOS

rtl/beos/sysos.inc

@@ -0,0 +1,147 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+
+{$ifdef FPC_USE_LIBC}
+
+const clib = 'c';
+
+type libcint=longint;
+     plibcint=^libcint;
+
+function geterrnolocation: Plibcint; cdecl;external 'root' name '_errnop';
+
+function geterrno:libcint; [public, alias: 'FPC_SYS_GETERRNO'];
+
+begin
+ geterrno:=geterrnolocation^;
+end;
+
+procedure seterrno(err:libcint); [public, alias: 'FPC_SYS_SETERRNO'];
+begin
+  geterrnolocation^:=err;
+end;
+
+{$else}
+{$ifdef ver1_0}
+Var
+{$else}
+threadvar
+{$endif}
+      Errno : longint;
+
+function geterrno:longint; [public, alias: 'FPC_SYS_GETERRNO'];
+
+begin
+ GetErrno:=Errno;
+end;
+
+procedure seterrno(err:longint); [public, alias: 'FPC_SYS_SETERRNO'];
+
+begin
+ Errno:=err;
+end;
+{$endif}
+
+{ OS dependant parts  }
+
+{$I errno.inc}                          // error numbers
+{$I ostypes.inc}                        // c-types, unix base types, unix base structures
+{$I osmacro.inc}
+
+{$ifdef FPC_USE_LIBC}
+  {$Linklib c}
+  {$i oscdeclh.inc}
+{$else}
+  {$I syscallh.inc}
+  {$I syscall.inc}
+  {$I sysnr.inc}
+  {$I ossysc.inc}
+{$endif}
+
+
+{*****************************************************************************
+                            Error conversion
+*****************************************************************************}
+
+{
+  The lowlevel file functions should take care of setting the InOutRes to the
+  correct value if an error has occured, else leave it untouched
+}
+
+Function PosixToRunError  (PosixErrno : longint) : longint;
+{
+  Convert ErrNo error to the correct Inoutres value
+}
+
+begin
+  if PosixErrNo=0 then { Else it will go through all the cases }
+   exit(0);
+  case PosixErrNo of
+   ESysENFILE,
+   ESysEMFILE : Inoutres:=4;
+   ESysENOENT : Inoutres:=2;
+    ESysEBADF : Inoutres:=6;
+   ESysENOMEM,
+   ESysEFAULT : Inoutres:=217;
+   ESysEINVAL : Inoutres:=218;
+    ESysEPIPE,
+    ESysEINTR,
+      ESysEIO,
+   ESysEAGAIN,
+   ESysENOSPC : Inoutres:=101;
+ ESysENAMETOOLONG : Inoutres := 3;
+    ESysEROFS,
+   ESysEEXIST,
+   ESysENOTEMPTY,
+   ESysEACCES : Inoutres:=5;
+   ESysEISDIR : InOutRes:=5;
+   ESysEPERM  : InOutRes:=5;
+  else
+    begin
+       InOutRes := Integer(PosixErrno);
+    end;
+  end;
+ PosixToRunError:=InOutRes;
+end;
+
+Function Errno2InoutRes : longint;
+
+begin
+  Errno2InoutRes:=PosixToRunError(getErrno);
+  InoutRes:=Errno2InoutRes;
+end;
+
+
+{*****************************************************************************
+                          Low Level File Routines
+*****************************************************************************}
+
+Function Do_IsDevice(Handle:Longint):boolean;
+{
+  Interface to Unix ioctl call.
+  Performs various operations on the filedescriptor Handle.
+  Ndx describes the operation to perform.
+  Data points to data needed for the Ndx function. The structure of this
+  data is function-dependent.
+}
+CONST
+  IOCtl_TCGETS=$5401;
+var
+  Data : array[0..255] of byte; {Large enough for termios info}
+begin
+  Do_IsDevice:=(Fpioctl(handle,IOCTL_TCGETS,@data)<>-1);
+end;

rtl/beos/sysosh.inc

@@ -0,0 +1,35 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    This file implements all the base types and limits required
+    for a minimal POSIX compliant subset required to port the compiler
+    to a new OS.
+
+    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.
+
+ **********************************************************************}
+
+{Platform specific information}
+type
+  { fd are int in C also for 64bit targets (x86_64) }
+  THandle = Longint;
+  TThreadID = THandle;
+  
+  { pthread_mutex_t }
+  PRTLCriticalSection = ^TRTLCriticalSection;
+  TRTLCriticalSection = record
+    __m_reserved: longint;
+    __m_count: longint;
+    __m_owner: pointer;
+    __m_kind:  longint;
+    __m_lock:  record
+       __status: sizeint;
+      __spinlock: longint;
+    end;
+  end;

rtl/beos/system.pp

@@ -1,81 +1,35 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by the Free Pascal development team.
-
-    This is a prototype file to show all function that need to be implemented
-    for a new operating system (provided the processor specific
-    function are already implemented !)
-
-    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.
-
- **********************************************************************}
-{ no stack check in system }
-
-{$S-}
-unit System;
+Unit system;
 
 interface
 
-{ include system-independent routine headers }
+// Was needed to bootstrap with our old 2.1 fpc for BeOS
+// to define real
+{ $define VER2_0}
 
-{$I systemh.inc}
+{$define FPC_IS_SYSTEM}
 
-type
-  THandle = longint;
-  TThreadID = THandle;
-  
-{ include heap support headers }
-
-{$I heaph.inc}
-
-{Platform specific information}
-const
- LineEnding = #10;
- LFNSupport = true;
- DirectorySeparator = '/';
- DriveSeparator = ':';
- PathSeparator = ':';
-{ FileNameCaseSensitive is defined separately below!!! }
- maxExitCode = 255;
- MaxPathLen = 256;
- 
-const
-  FileNameCaseSensitive : boolean = true;
-  CtrlZMarksEOF: boolean = false; (* #26 not considered as end of file *)
-
-  sLineBreak : string[1] = LineEnding;
-  DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsLF;
+{$I sysunixh.inc}
 
+  
+type
+  THeapPointer = ^pointer;
 var
-  argc : longint;
-  argv : ppchar;
-  envp : ppchar;
-  errno : longint;              // MvdV: yuckie
-
-  UnusedHandle:longint;
-  StdInputHandle:longint;
-  StdOutputHandle:longint;
-  StdErrorHandle:longint;
-
+  heapstartpointer : THeapPointer;
+  heapstart : pointer;//external;//external name 'HEAP';
+  myheapsize : longint; //external;//external name 'HEAPSIZE';
+  myheaprealsize : longint;
+  heap_handle : longint;
 implementation
 
-{$I sysfiles.inc}
+procedure debugger(s : PChar); cdecl; external 'root' name 'debugger';
 
-function sys_unlink (a:cardinal;name:pchar):longint; cdecl; external name 'sys_unlink';
-function sys_rename (a:cardinal;p1:pchar;b:cardinal;p2:pchar):longint; cdecl; external name 'sys_rename';
-function sys_create_area (name:pchar; var start:pointer; a,b,c,d:longint):longint; cdecl; external name 'sys_create_area';
-function sys_resize_area (handle:cardinal; size:longint):longint; cdecl; external name 'sys_resize_area';
-function sys_mkdir (a:cardinal; name:pchar; mode:cardinal):longint; cdecl; external name 'sys_mkdir';
-function sys_chdir (a:cardinal; name:pchar):longint; cdecl; external name 'sys_chdir';
-function sys_rmdir (a:cardinal; name:pchar):longint; cdecl; external name 'sys_rmdir';
+function disable_debugger(state : integer): integer; external 'root' name 'disable_debugger';
+//begin
+//end;
 
-{$I system.inc}
+{ OS independant parts}
 
+{$I system.inc}
 
 {*****************************************************************************
                          System Dependent Exit code
@@ -89,432 +43,299 @@ begin
   end;
 End;
 
-{*****************************************************************************
-                         Stack check code
-*****************************************************************************}
-{ cheking the stack is done system independend in 1.1
-procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_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
-end;
-}
+
+{ OS dependant parts  }
 
 {*****************************************************************************
-                              ParamStr/Randomize
+                              Heap Management
 *****************************************************************************}
 
-{ number of args }
-function paramcount : longint;
-begin
-  paramcount := argc - 1;
-end;
+(*var myheapstart:pointer;
+    myheapsize:longint;
+    myheaprealsize:longint;
+    heap_handle:longint;
+    zero:longint;
+
 
-{ argument number l }
-function paramstr(l : longint) : string;
+{ first address of heap }
+function getheapstart:pointer;
 begin
-  if (l>=0) and (l+1<=argc) then
-   paramstr:=strpas(argv[l])
-  else
-   paramstr:='';
+   getheapstart:=myheapstart;
 end;
 
-{ set randseed to a new pseudo random value }
-procedure randomize;
+{ current length of heap }
+function getheapsize:longint;
 begin
-  {regs.realeax:=$2c00;
-  sysrealintr($21,regs);
-  hl:=regs.realedx and $ffff;
-  randseed:=hl*$10000+ (regs.realecx and $ffff);}
-  randseed:=0;
+   getheapsize:=myheapsize;
 end;
+*)
 
-{*****************************************************************************
-                              Heap Management
-*****************************************************************************}
 
-var myheapstart:pointer;
-    myheapsize:longint;
-    myheaprealsize:longint;
-    heap_handle:longint;
-    zero:longint;
+(*function getheapstart:pointer;
+assembler;
+asm
+        leal    HEAP,%eax
+end ['EAX'];
+
+
+function getheapsize:longint;
+assembler;
+asm
+        movl    intern_HEAPSIZE,%eax
+end ['EAX'];*)
 
 { function to allocate size bytes more for the program }
 { must return the first address of new data space or nil if fail }
-function Sbrk(size : longint):pointer;
+(*function Sbrk(size : longint):pointer;
 var newsize,newrealsize:longint;
+  s : string;
 begin
-  if (myheapsize+size)<=myheaprealsize then begin
-    Sbrk:=myheapstart+myheapsize;
+  WriteLn('SBRK');
+  Str(size, s);
+  WriteLn('size : ' + s);
+  if (myheapsize+size)<=myheaprealsize then 
+  begin
+    Sbrk:=pointer(heapstart+myheapsize);
     myheapsize:=myheapsize+size;
     exit;
   end;
   newsize:=myheapsize+size;
   newrealsize:=(newsize and $FFFFF000)+$1000;
-  if sys_resize_area(heap_handle,newrealsize)=0 then begin
-        Sbrk:=myheapstart+myheapsize;
+  case resize_area(heap_handle,newrealsize) of
+    B_OK : 
+      begin
+        WriteLn('B_OK');
+        Sbrk:=pointer(heapstart+myheapsize);
+        myheapsize:=newsize;
+        myheaprealsize:=newrealsize;
+        exit;
+      end;
+    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
+    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
+    B_ERROR : WriteLn('B_ERROR');
+    else
+      begin
+        Sbrk:=pointer(heapstart+myheapsize);
         myheapsize:=newsize;
         myheaprealsize:=newrealsize;
         exit;
+      end;
   end;
-  Sbrk:=nil;
-end;
-
-{*****************************************************************************
-      OS Memory allocation / deallocation
- ****************************************************************************}
-
-function SysOSAlloc(size: ptrint): pointer;
-begin
-  result := sbrk(size);
-end;
-
-
-{ include standard heap management }
-{$I heap.inc}
-
-
-{****************************************************************************
-                        Low level File Routines
-       All these functions can set InOutRes on errors
- ****************************************************************************}
-
-
-
-{ close a file from the handle value }
-procedure do_close(handle : longint);
-begin
-{  writeln ('CLOSE ',handle);}
-  if handle<=2 then exit;
-  InOutRes:=sys_close(handle);
-end;
-
-
-procedure do_erase(p : pchar);
-begin
-  if sys_unlink($FF000000,p)<>0 then InOutRes:=1
-  else InOutRes:=0;
-end;
 
-procedure do_rename(p1,p2 : pchar);
-begin
-  InOutRes:=sys_rename($FF000000,p1,$FF000000,p2);
-end;
-
-function do_write(h:longint;addr:pointer;len : longint) : longint;
-begin
-{  if h>0 then begin
-    sys_write ('WRITE handle=%d ',h);
-    printf ('addr=%x ',addr);
-    printf ('len=%d',len);
-    printf ('%c',10);
-  end;}
-  do_write:=sys_write (h,addr,len,zero);
-  if (do_write<0) then begin
-    InOutRes:=do_write;
-    do_write:=0;
-  end else InOutRes:=0;
-end;
-
-function do_read(h:longint;addr:pointer;len : longint) : longint;
-begin
-{  if h>2 then begin
-    printf ('READ handle=%d ',h);
-    printf ('addr=%x ',addr);
-    printf ('len=%d',len);
-  end;}
-  do_read:=sys_read (h,addr,len,zero);
-  if (do_read<0) then begin
-    InOutRes:=do_read;
-    do_read:=0;
-  end else InOutRes:=0;
-end;
-
-function do_filepos(handle : longint) : longint;
-begin
-  do_filepos:=sys_lseek(handle,0,1); {1=SEEK_CUR}
-  if (do_filepos<0) then begin
-    InOutRes:=do_filepos;
-    do_filepos:=0;
-  end else InOutRes:=0;
-end;
+//  Sbrk:=nil;
+end;*)
 
-procedure do_seek(handle,pos : longint);
-begin
-  InOutRes:=sys_lseek(handle,pos,0);
-  if InOutRes>0 then InOutRes:=0;
-end;
+function sys_resize_area (handle:cardinal; size:longint):longint; cdecl; external name 'sys_resize_area';
 
-function do_seekend(handle:longint):longint;
-begin
-  do_seekend:=sys_lseek (handle,0,2); {2=SEEK_END}
-  if do_seekend<0 then begin
-    InOutRes:=do_seekend;
-    do_seekend:=0;
-  end else InOutRes:=0;
-end;
+//function sbrk2 (size : longint):pointer; cdecl; external name 'sbrk';
 
-function do_filesize(handle : longint) : longint;
-var cur:longint;
-begin
-  cur:=sys_lseek (handle,0,1); {1=SEEK_CUR}
-  if cur<0 then begin
-    InOutRes:=cur;
-    do_filesize:=0;
-    exit;
-  end;
-  do_filesize:=sys_lseek (handle,0,2); {2=SEEK_END}
-  if do_filesize<0 then begin
-    InOutRes:=do_filesize;
-    do_filesize:=0;
+{ function to allocate size bytes more for the program }
+{ must return the first address of new data space or nil if fail }
+//function Sbrk(size : longint):pointer;
+//var newsize,newrealsize:longint;
+//  s : string;
+//begin
+//  sbrk := sbrk2(size);
+(*  sbrk := nil;
+  WriteLn('sbrk');
+  Str(size, s);
+  WriteLn('size : ' + s);
+  if (myheapsize+size)<=myheaprealsize then 
+  begin
+    Sbrk:=heapstart+myheapsize;
+    myheapsize:=myheapsize+size;
     exit;
   end;
-  cur:=sys_lseek (handle,cur,0); {0=SEEK_POS}
-  if cur<0 then begin
-    InOutRes:=cur;
-    do_filesize:=0;
+  newsize:=myheapsize+size;
+  newrealsize:=(newsize and $FFFFF000)+$1000;
+  if sys_resize_area(heap_handle,newrealsize+$1000)=0 then 
+  begin
+    WriteLn('sys_resize_area OK');
+    Str(longint(newrealsize), s);
+    WriteLn('newrealsize : $' + Hexstr(longint(newrealsize), 8));
+    Str(longint(heapstartpointer), s);
+    WriteLn('heapstart : $' + Hexstr(longint(heapstart), 8));
+    Str(myheapsize, s);
+    WriteLn('myheapsize : ' + s);
+    Str(myheapsize, s);
+    WriteLn('Total : ' + s);
+    WriteLn('Before fillchar');
+    WriteLn('sbrk : $' + Hexstr(longint(heapstart+myheapsize), 8));        
+    Sbrk:=heapstart+myheapsize;
+    FillChar(sbrk^, size, #0);    
+    WriteLn('EndFillChar');
+    WriteLn('sbrk : $' + Hexstr(longint(sbrk), 8));
+//    ReadLn(s);
+    myheapsize:=newsize;
+    Str({longint(heapstartpointer) +} myheapsize, s);
+    WriteLn('Total : ' + s);    
+    myheaprealsize:=newrealsize;
     exit;
+  end
+  else
+  begin
+    debugger('Bad resize_area');
+    WriteLn('Bad resize_area');
   end;
-end;
-
-{ truncate at a given position }
-procedure do_truncate (handle,pos:longint);
-begin
-  InOutRes:=1;
-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 m:longint;
-    mode,h:longint;
-begin
-{  printf ('OPEN %d ',longint(f));
-  printf (' %s',longint(p));
-  printf (' %x',flags);}
-
-  m:=0;
-  case (flags and $3) of
-        $0: begin m:=m or O_RDONLY; mode:=fminput;  end;
-        $1: begin m:=m or O_WRONLY; mode:=fmoutput;end;
-        $2: begin m:=m or O_RDWR; mode:=fminout; end;
-  end;
-
-  if (flags and $100)<>0 then m:=m or O_APPEND;
-  if (flags and $1000)<>0 then m:=m or O_TRUNC or O_CREAT;
-
-{  if (flags and $10000)<>0 then m:=m or O_TEXT else m:=m or O_BINARY;}
-
-  h:=sys_open($FF000000,p,m,0,0);
-
-  if h<0 then InOutRes:=h
-  else InOutRes:=0;
-
-  if InOutRes=0 then begin
-    FileRec(f).handle:=h;
-    FileRec(f).mode:=mode;
-  end;
-end;
-
-function do_isdevice(handle:THandle):boolean;
-begin
-  do_isdevice:=false;
-  InOutRes:=0;
-end;
+  Sbrk:=nil;
+*)
+//end;
 
+{ $I text.inc}
 
 {*****************************************************************************
                            UnTyped File Handling
 *****************************************************************************}
 
-{$i file.inc}
+
+{ $i file.inc}
 
 {*****************************************************************************
                            Typed File Handling
 *****************************************************************************}
 
-{$i typefile.inc}
+{ $i typefile.inc}
 
 {*****************************************************************************
-                           Text File Handling
+                       Misc. System Dependent Functions
 *****************************************************************************}
 
-{$i text.inc}
+Function ParamCount: Longint;
+var
+  s : string;
+Begin
+  ParamCount := 0;
+  Paramcount:=argc - 1;
+End;
 
-{*****************************************************************************
-                           Directory Handling
-*****************************************************************************}
-procedure mkdir(const s : string);[IOCheck];
-var t:string;
-begin
-  t:=s+#0;
-  InOutRes:=sys_mkdir ($FF000000,@t[1],493);
-end;
+ { variable where full path and filename and executable is stored }
+ { is setup by the startup of the system unit.                    }
+var
+ execpathstr : shortstring;
+
+{$ifdef FPC_USE_LIBC}
+
+// private; use the macros, below
+function _get_image_info(image : image_id; var info : image_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_image_info';
+
+function _get_next_image_info(team : team_id; var cookie : Longint; var info : image_info; size : size_t)
+         : status_t; cdecl; external 'root' name '_get_next_image_info';
 
-procedure rmdir(const s : string);[IOCheck];
-var t:string;
+function get_image_info(image : image_id; var info : image_info) : status_t;
 begin
-  t:=s+#0;
-  InOutRes:=sys_rmdir ($FF000000,@t[1]);
+  Result := _get_image_info(image, info, SizeOf(info));
 end;
 
-procedure chdir(const s : string);[IOCheck];
-var t:string;
+function get_next_image_info(team : team_id; var cookie : Longint; var info : image_info) : status_t;
 begin
-  t:=s+#0;
-  InOutRes:=sys_chdir ($FF000000,@t[1]);
+  Result := _get_next_image_info(team, cookie, info, SizeOf(info));
 end;
 
-{*****************************************************************************
-                             getdir procedure
-*****************************************************************************}
-type dirent = packed record
-        d_dev:longint;
-        d_pdev:longint;
-        d_ino:int64;
-        d_pino:int64;
-        d_reclen:word;
-        d_name:array[0..255] of char;
-  end;
-
-    stat = packed record
-      dev:longint;     {"device" that this file resides on}
-      ino:int64;       {this file's inode #, unique per device}
-      mode:dword;      {mode bits (rwx for user, group, etc)}
-      nlink:longint;   {number of hard links to this file}
-      uid:dword;       {user id of the owner of this file}
-      gid:dword;       {group id of the owner of this file}
-      size:int64;      {size of this file (in bytes)}
-      rdev:longint;    {device type (not used)}
-      blksize:longint; {preferref block size for i/o}
-      atime:longint;   {last access time}
-      mtime:longint;   {last modification time}
-      ctime:longint;   {last change time, not creation time}
-      crtime:longint;  {creation time}
-    end;
-    pstat = ^stat;
+{$endif}
 
-function sys_stat (a:cardinal;path:pchar;info:pstat;n:longint):longint; cdecl; external name 'sys_stat';
-
-function FStat(Path:String;Var Info:stat):Boolean;
-{
-  Get all information on a file, and return it in Info.
-}
-var tmp:string;
-var p:pchar;
+{ this routine sets up the paramstr(0) string at startup }
+procedure setupexecname;
+var
+ cookie: longint;
+ image : image_info;
+ index : byte;
+ s : string;
 begin
-  tmp:=path+#0;
-  p:=@tmp[1];
-  FStat:=(sys_stat($FF000000,p,@Info,0)=0);
+  cookie:=0;
+  fillchar(image, sizeof(image_info), 0);
+  if get_next_image_info(0, cookie, image) = B_OK then
+  begin
+    execpathstr := strpas(@image.name);
+  end
+  else
+    execpathstr := '';
+  { problem with Be 4.5 noted... path contains . character }
+  { if file is directly executed in CWD                    }
+  index:=pos('/./',execpathstr);
+  if index <> 0 then
+    begin
+      { remove the /. characters }
+      Delete(execpathstr,index, 2);
+    end;
 end;
 
-
-function sys_opendir (a:cardinal;path:pchar;b:longint):longint; cdecl; external name 'sys_opendir';
-function sys_readdir (fd:longint;var de:dirent;a:longint;b:byte):longint; cdecl; external name 'sys_readdir';
-
-function parentdir(fd:longint;dev:longint;ino:int64;var err:longint):string;
-var len:longint;
-    ent:dirent;
-    name:string;
+function paramstr(l: longint) : string;
+var
+  s: string;
+  s1: string;
 begin
-  err:=0;
-  parentdir:='';
-  if sys_readdir(fd,ent,$11C,1)=0 then begin
-    err:=1;
-    exit;
-  end;
-
-  len:=StrLen(@ent.d_name);
-  Move(ent.d_name,name[1],len);
-  name[0]:=chr(len);
-{  writeln ('NAME: "',name,'" = ',ent.d_dev,',',ent.d_ino);}
-  if (dev=ent.d_dev) and (ino=ent.d_ino) then begin
-    err:=0;
-    parentdir:='/'+name;
-    exit;
+   
+  { stricly conforming POSIX applications  }
+  { have the executing filename as argv[0] }
+  if l = 0 then
+  begin
+    paramstr := execpathstr;
+  end
+  else
+  begin
+    paramstr := '';
+    paramstr:=strpas(argv[l]);
   end;
-
-  err:=0;
 end;
 
+Procedure Randomize;
+Begin
+  randseed:=longint(Fptime(nil));
+End;
 
-function getdir2:string;
-var tmp:string;
-    info:stat;
-    info2:stat;
-    fd:longint;
-    name:string;
-        cur:string;
-        res:string;
-        err:longint;
+function GetProcessID: SizeUInt;
 begin
-  res:='';
-  cur:='';
-
-  repeat
-
-  FStat(cur+'.',info);
-  FStat(cur+'..',info2);
-{  writeln ('"." = ',info.dev,',',info.ino);}
-  if ((info.dev=info2.dev) and (info.ino=info2.ino)) then begin
-    if res='' then getdir2:='/' else getdir2:=res;
-    exit;
-  end;
-
-  tmp:=cur+'..'+#0;
-  fd:=sys_opendir ($FF000000,@tmp[1],0);
-  repeat
-    name:=parentdir(fd,info.dev,info.ino,err);
-  until (err<>0) or (name<>'');
-  if err<>0 then begin
-    getdir2:='';
-    exit;
-  end;
-  res:=name+res;
-{  writeln(res);}
-  cur:=cur+'../';
-  until false;
+  GetProcessID := SizeUInt (fpGetPID);
 end;
 
-procedure getdir(drivenr : byte;var dir : shortstring);
+{*****************************************************************************
+                         SystemUnit Initialization
+*****************************************************************************}
+
+function  reenable_signal(sig : longint) : boolean;
+var
+  e : TSigSet;
+  i,j : byte;
 begin
-  drivenr:=0;
-  dir:=getdir2;
+  fillchar(e,sizeof(e),#0);
+  { set is 1 based PM }
+  dec(sig);
+  i:=sig mod (sizeof(cuLong) * 8);
+  j:=sig div (sizeof(cuLong) * 8);
+  e[j]:=1 shl i;
+  fpsigprocmask(SIG_UNBLOCK,@e,nil);
+  reenable_signal:=geterrno=0;
 end;
 
+// signal handler is arch dependant due to processorexception to language
+// exception translation
 
-function GetProcessID:SizeUInt;
-begin
-{$WARNING To be corrected by platform maintainer}
- GetProcessID := 1;
-end;
+{$i sighnd.inc}
 
+var
+  act: SigActionRec;
 
-{*****************************************************************************
-                         SystemUnit Initialization
-*****************************************************************************}
+Procedure InstallSignals;
+begin
+  { Initialize the sigaction structure }
+  { all flags and information set to zero }
+  FillChar(act, sizeof(SigActionRec),0);
+  { initialize handler                    }
+  act.sa_handler := SigActionHandler(@SignalToRunError);
+  act.sa_flags:=SA_SIGINFO;
+  FpSigAction(SIGFPE,@act,nil);
+  FpSigAction(SIGSEGV,@act,nil);
+  FpSigAction(SIGBUS,@act,nil);
+  FpSigAction(SIGILL,@act,nil);
+end;
 
 procedure SysInitStdIO;
 begin
   { Setup stdin, stdout and stderr, for GUI apps redirect stderr,stdout to be
     displayed in and messagebox }
-  StdInputHandle:=0;
-  StdOutputHandle:=1;
-  StdErrorHandle:=2;
   OpenStdIO(Input,fmInput,StdInputHandle);
   OpenStdIO(Output,fmOutput,StdOutputHandle);
-  OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);
   OpenStdIO(StdOut,fmOutput,StdOutputHandle);
   OpenStdIO(StdErr,fmOutput,StdErrorHandle);
 end;
@@ -524,27 +345,73 @@ begin
   result := stklen;
 end;
 
+var
+  s : string;
 begin
+  SysResetFPU;
+  IsConsole := TRUE;
+  IsLibrary := FALSE;
+  StackLength := CheckInitialStkLen(InitialStkLen);
+  StackBottom := Sptr - StackLength;
+
+  { Set up signals handlers }
+  InstallSignals;
+
+  SysInitStdIO;
 { Setup heap }
-  zero:=0;
-  myheapsize:=$2000;
-  myheaprealsize:=$2000;
-  myheapstart:=nil;
-  heap_handle:=sys_create_area('fpcheap',myheapstart,0,myheaprealsize,0,3);//!!
-  StackLength := CheckInitialStkLen (InitialStkLen);
-  if heap_handle>0 then begin
-    InitHeap;
-  end else system_exit;
+  myheapsize:=4096*1;// $ 20000;
+  myheaprealsize:=4096*1;// $ 20000;
+  heapstart:=nil;
+  heapstartpointer := nil;
+  heapstartpointer := Sbrk2(4096*1);
+{$IFDEF FPC_USE_LIBC}  
+//  heap_handle := create_area('fpcheap',heapstart,0,myheaprealsize,0,3);//!!
+{$ELSE}
+//  debugger('tata'#0);
+//  heap_handle := create_area('fpcheap',longint(heapstartpointer),0,myheaprealsize,0,3);//!!
+//  case heap_handle of
+//    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
+//    B_PAGE_SIZE : WriteLn('B_PAGE_SIZE');
+//    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
+//    B_ERROR : WriteLn('B_ERROR');
+//  end;
+
+  FillChar(heapstartpointer^, myheaprealsize, #0);
+//  WriteLn('EndFillChar');
+//    WriteLn('P : $' + Hexstr(longint(heapstartpointer), 8));        
+//    WriteLn('heapstart : $' + Hexstr(longint(heapstartpointer^), 8));        
+  heapstart := heapstartpointer;
+{$ENDIF}
+//  WriteLn('before InitHeap');
+//  case heap_handle of
+//    B_BAD_VALUE : WriteLn('B_BAD_VALUE');
+//    B_PAGE_SIZE : WriteLn('B_PAGE_SIZE');
+//    B_NO_MEMORY : WriteLn('B_NO_MEMORY');
+//    B_ERROR : WriteLn('B_ERROR');
+//  else
+//    begin
+//      WriteLn('ok');  
+//      WriteLn('P : $' + Hexstr(longint(heapstartpointer), 8));        
+//      WriteLn('heapstart : $' + Hexstr(longint(heapstartpointer^), 8));       
+//      if heap_handle>0 then 
+//      begin
+        InitHeap;
+//      end;
+//    end;
+//  end;
+//  WriteLn('after InitHeap');
+//  end else system_exit;
   SysInitExceptions;
+//  WriteLn('after SysInitException');
 
 { Setup IO }
   SysInitStdIO;
-
 { Reset IO Error }
   InOutRes:=0;
-(* This should be changed to a real value during *)
-(* thread driver initialization if appropriate.  *)
-  ThreadID := 1;
+  InitSystemThreads;
+{$ifdef HASVARIANT}
   initvariantmanager;
+{$endif HASVARIANT}
   initwidestringmanager;
+  setupexecname;
 end.

rtl/beos/sysutils.pp

@@ -1,325 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999-2000 by Florian Klaempfl
-    member of the Free Pascal development team
-
-    Sysutils unit for BeOS
-
-    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 sysutils;
-interface
-
-{$MODE objfpc}
-{ force ansistrings }
-{$H+}
-
-uses
-  beos,
-  dos;
-
-{ Include platform independent interface part }
-{$i sysutilh.inc}
-
-
-implementation
-
-  uses
-    sysconst;
-
-(* Potentially needed FPC_FEXPAND_* defines should be defined here. *)
-
-{ Include platform independent implementation part }
-{$i sysutils.inc}
-
-
-{****************************************************************************
-                              File Functions
-****************************************************************************}
-
-Function FileOpen (Const FileName : string; Mode : Integer) : Longint;
-BEGIN
-end;
-
-
-Function FileCreate (Const FileName : String) : longint;
-begin
-end;
-
-Function FileCreate (Const FileName : String;Mode:longint) : longint;
-begin
-end;
-
-
-Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint;
-begin
-end;
-
-
-Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint;
-begin
-end;
-
-
-Function FileSeek (Handle,FOffset,Origin : longint) : longint;
-begin
-end;
-
-Function FileSeek (Handle:longint;FOffset: Int64; Origin: Longint) : int64;
-begin
-end;
-
-
-Procedure FileClose (Handle : Longint);
-begin
-end;
-
-
-Function FileTruncate (Handle: longint;Size: Int64) : boolean;
-begin
-end;
-
-
-Function FileAge (Const FileName : String): Longint;
-begin
-end;
-
-
-Function FileExists (Const FileName : String) : Boolean;
-begin
-end;
-
-
-Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint;
-begin
-end;
-
-
-Function FindNext (Var Rslt : TSearchRec) : Longint;
-begin
-end;
-
-
-Procedure FindClose (Var F : TSearchrec);
-begin
-end;
-
-
-Function FileGetDate (Handle : Longint) : Longint;
-begin
-end;
-
-
-Function FileSetDate (Handle,Age : Longint) : Longint;
-begin
-end;
-
-
-Function FileGetAttr (Const FileName : String) : Longint;
-begin
-end;
-
-
-Function FileSetAttr (Const Filename : String; Attr: longint) : Longint;
-begin
-end;
-
-
-Function DeleteFile (Const FileName : String) : Boolean;
-begin
-end;
-
-
-Function RenameFile (Const OldName, NewName : String) : Boolean;
-begin
-end;
-
-{****************************************************************************
-                              Disk Functions
-****************************************************************************}
-
-Function DiskFree(Drive: Byte): int64;
-Begin
-End;
-
-
-
-Function DiskSize(Drive: Byte): int64;
-Begin
-End;
-
-
-Function GetCurrentDir : String;
-begin
-  GetDir(0,Result);
-end;
-
-
-Function SetCurrentDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   ChDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function CreateDir (Const NewDir : String) : Boolean;
-begin
-  {$I-}
-   MkDir(NewDir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-Function RemoveDir (Const Dir : String) : Boolean;
-begin
-  {$I-}
-   RmDir(Dir);
-  {$I+}
-  result := (IOResult = 0);
-end;
-
-
-function DirectoryExists (const Directory: string): boolean;
-begin
-end;
-
-
-{****************************************************************************
-                              Misc Functions
-****************************************************************************}
-
-procedure Beep;
-begin
-end;
-
-
-{****************************************************************************
-                              Locale Functions
-****************************************************************************}
-
-Procedure GetLocalTime(var SystemTime: TSystemTime);
-begin
-end ;
-
-
-Procedure InitAnsi;
-Var
-  i : longint;
-begin
-  {  Fill table entries 0 to 127  }
-  for i := 0 to 96 do
-    UpperCaseTable[i] := chr(i);
-  for i := 97 to 122 do
-    UpperCaseTable[i] := chr(i - 32);
-  for i := 123 to 191 do
-    UpperCaseTable[i] := chr(i);
-  Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-
-  for i := 0 to 64 do
-    LowerCaseTable[i] := chr(i);
-  for i := 65 to 90 do
-    LowerCaseTable[i] := chr(i + 32);
-  for i := 91 to 191 do
-    LowerCaseTable[i] := chr(i);
-  Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT));
-end;
-
-
-Procedure InitInternational;
-begin
-  InitInternationalGeneric;
-  InitAnsi;
-end;
-
-function SysErrorMessage(ErrorCode: Integer): String;
-
-begin
-  Str(Errorcode,Result);
-  Result:='Error '+Result;
-end;
-
-{****************************************************************************
-                              OS utility functions
-****************************************************************************}
-
-Function GetEnvironmentVariable(Const EnvVar : String) : String;
-
-begin
-  Result:=StrPas(beos.Getenv(PChar(EnvVar)));
-end;
-
-Function GetEnvironmentVariableCount : Integer;
-
-begin
-  // Result:=FPCCountEnvVar(EnvP);
-  Result:=0;
-end;
-
-Function GetEnvironmentString(Index : Integer) : String;
-
-begin
-  // Result:=FPCGetEnvStrFromP(Envp,Index);
-  Result:='';
-end;
-
-
-function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
-                                                                       integer;
-
-var
-  CommandLine: AnsiString;
-
-begin
-  { always surround the name of the application by quotes
-    so that long filenames will always be accepted. But don't
-    do it if there are already double quotes!
-  }
-  if pos('"',path)=0 then
-    CommandLine:='"'+path+'"'
-  else
-    CommandLine:=path;
-  if ComLine <> '' then
-   CommandLine := Commandline + ' ' + ComLine;
-  ExecuteProcess := beos.shell (CommandLine);
-end;
-
-
-function ExecuteProcess (const Path: AnsiString;
-                                  const ComLine: array of AnsiString): integer;
-
-{$WARNING Should be probably changed according to the Unix version}
-var
-  CommandLine: AnsiString;
-  I: integer;
-
-begin
-  Commandline := '';
-  for I := 0 to High (ComLine) do
-   if Pos (' ', ComLine [I]) <> 0 then
-    CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"'
-   else
-    CommandLine := CommandLine + ' ' + Comline [I];
-  ExecuteProcess := ExecuteProcess (Path, CommandLine);
-end;
-
-
-
-{****************************************************************************
-                              Initialization code
-****************************************************************************}
-
-Initialization
-  InitExceptions;       { Initialize exceptions. OS independent }
-  InitInternational;    { Initialize internationalization settings }
-Finalization
-  DoneExceptions;
-end.

rtl/beos/termio.pp

@@ -0,0 +1,41 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Peter Vreman
+    member of the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This file contains the termios interface.
+
+    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 termio;
+
+interface
+
+Uses BaseUnix;          // load base unix typing
+
+// load types + consts
+
+{$i termios.inc}
+
+// load default prototypes from unix dir.
+
+{$i termiosh.inc}
+
+implementation
+
+{$i textrec.inc}
+
+// load implementation for prototypes from current dir.
+{$i termiosproc.inc}
+
+// load ttyname from unix dir.
+{$i ttyname.inc}
+
+end.

rtl/beos/termios.inc

@@ -0,0 +1,396 @@
+{
+   This file is part of the Free Pascal run time library.
+   (c) 2000-2003 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.
+
+   Termios header for FreeBSD
+
+   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.
+}
+
+CONST
+
+{
+ * Special Control Characters
+ *
+ * Index into c_cc[] character array.
+ *
+ *      Name         Subscript  Enabled by
+ }
+ { control characters }
+VINTR	= 0;
+VQUIT	= 1;
+VERASE	= 2;
+VKILL	= 3;
+VEOF	= 4;
+VEOL	= 5;
+VMIN	= 4;
+VTIME	= 5;
+VEOL2	= 6;
+VSWTCH	= 7;
+VSTART  = 8;
+VSTOP   = 9;
+VSUSP   = 10;
+
+{ number of control characters }
+ NCC	= 11;
+ NCCS           =NCC;
+
+Type
+  winsize = packed record
+    ws_row,
+    ws_col,
+    ws_xpixel,
+    ws_ypixel : word;
+  end;
+  TWinSize=winsize;
+
+// typedef unsigned long tcflag_t;
+// typedef unsigned char speed_t;
+// typedef unsigned char cc_t;
+ tcflag_t = Cardinal;
+ speed_t = byte;
+ cc_t = char;
+
+type
+  Termios = packed record
+    c_iflag,
+    c_oflag,
+    c_cflag,
+    c_lflag  : tcflag_t;
+    c_line   : char;
+    c_ixxxxx : speed_t;
+    c_oxxxxx : speed_t;
+    c_cc     : array[0..NCCS-1] of speed_t;
+  end;
+  TTermios=Termios;
+
+CONST
+
+
+ POSIX_VDISABLE=Chr($ff);
+{
+
+#define CCEQ(val, c)    ((c) == (val) ? (val) != _POSIX_VDISABLE : 0)
+}
+
+{ * Input flags - software input processing}
+
+        IGNBRK          =       $1;     { ignore BREAK condition }
+        BRKINT          =       $2;     { map BREAK to SIGINTR }
+        IGNPAR          =       $4;     { ignore (discard) parity errors }
+        PARMRK          =       $8;     { mark parity and framing errors }
+        INPCK           =      $10;     { enable checking of parity errors }
+        ISTRIP          =      $20;     { strip 8th bit off chars }
+        INLCR           =      $40;     { map NL into CR }
+        IGNCR           =      $80;     { ignore CR }
+        ICRNL           =     $100;     { map CR to NL (ala CRMOD) }
+        IUCLC			=		$200;	{ maps all upper case to lower }
+        IXON            =     $400;     { enable output flow control }
+        IXANY           =     $800;     { enable input flow control }
+        IXOFF           =     $1000;     { any char will restart after stop }
+
+{
+ * Output flags - software output processing
+}
+
+OPOST		= $01;		{ enable postprocessing of output }
+OLCUC		= $02;		{ maps lowercase to uppercase }
+ONLCR		= $04;		{ maps NL to CR-NL on output }
+OCRNL		= $08;		{ maps CR to NL on output }
+ONOCR		= $10;		{ no CR output when at column 0 }
+ONLRET		= $20;		{ newline performs CR function }
+OFILL		= $40;		{ uses fill characters for delays }
+OFDEL		= $80;		{ Fills are DEL, otherwise NUL }
+NLDLY		= $100;		{ Newline delays: }
+NL0			= $000;
+NL1			= $100;
+CRDLY		= $600;		{ Carriage return delays: }
+CR0			= $000;
+CR1			= $200;
+CR2			= $400;
+CR3			= $600;
+TABDLY		= $1800;		{ Tab delays: }
+TAB0		= $0000;
+TAB1		= $0800;
+TAB2		= $1000;
+TAB3		= $1800;
+BSDLY		= $2000;		{ Backspace delays: }
+BS0			= $0000;
+BS1			= $2000;
+VTDLY		= $4000;		{ Vertical tab delays: }
+VT0			= $0000;
+VT1			= $4000;
+FFDLY		= $8000;		{ Form feed delays: }
+FF0			= $0000;
+FF1			= $8000;
+
+{
+  c_cflag - control modes
+}
+
+CBAUD		= $1F;			{ line speed definitions }
+
+B0			= $00;
+B50			= $01;
+B75			= $02;
+B110		= $03;
+B134		= $04;
+B150		= $05;
+B200		= $06;
+B300		= $07;
+B600		= $08;
+B1200		= $09;
+B1800		= $0A;
+B2400		= $0B;
+B4800		= $0C;
+B9600		= $0D;
+B19200		= $0E;
+B38400		= $0F;
+B57600		= $10;
+B115200		= $11;
+B230400		= $12;
+B31250		= $13;			{ for MIDI }
+
+CSIZE		= $20;			{ character size }
+CS5			= $00;			{ only 7 and 8 bits supported }
+CS6			= $00;
+CS7			= $00;
+CS8			= $20;
+CSTOPB		= $40;			{ send 2 stop bits, not 1 }
+CREAD		= $80;			{ enables receiver }
+PARENB		= $100;			{ xmit parity enable }
+PARODD		= $200;			{ odd parity, else even }
+HUPCL		= $400;			{ hangs up on last close }
+CLOCAL		= $800;			{ indicates local line }
+XLOBLK		= $1000;			{ block layer output ?}
+CTSFLOW		= $2000;			{ enable CTS flow }
+RTSFLOW		= $4000;			{ enable RTS flow }
+CRTSCTS		= RTSFLOW or CTSFLOW;
+
+
+
+{
+ * "Local" flags - dumping ground for other state
+ *
+ * Warning: some flags in this structure begin with
+ * the letter "I" and look like they belong in the
+ * input flag.
+ }
+ 
+{
+  c_lflag - local modes
+}
+
+ISIG		= $01;			{ enable signals }
+ICANON	=	$02;			{ Canonical input }
+XCASE		= $04;			{ Canonical u/l case }
+ECHO		= $08;			{ Enable echo }
+ECHOE		= $10;			{ Echo erase as bs-sp-bs }
+ECHOK		= $20;			{ Echo nl after kill }
+ECHONL		= $40;			{ Echo nl }
+NOFLSH		= $80;			{ Disable flush after int or quit }
+TOSTOP      = $100;         { stop bg processes that write to tty }
+IEXTEN      = $200;         { implementation defined extensions }
+
+{
+  Event codes.  Returned from TCWAITEVENT
+}
+EV_RING			= $0001;
+EV_BREAK		= $0002;
+EV_CARRIER		= $0004;
+EV_CARRIERLOST	= $0008;
+ 
+{
+ * Commands passed to tcsetattr() for setting the termios structure.
+}
+
+CONST
+
+        TCSANOW         =0;             { make change immediate }
+        TCSADRAIN       =1;             { drain output, then change }
+        TCSAFLUSH       =2;             { drain output, flush input }
+        TCSASOFT        =$10;           { flag - don't alter h.w. state }
+
+
+        TCIFLUSH        =1;
+        TCOFLUSH        =2;
+        TCIOFLUSH       =3;
+        TCOOFF          =1;
+        TCOON           =2;
+        TCIOFF          =3;
+        TCION           =4;
+
+{
+#include <sys/cdefs.h>
+
+__BEGIN_DECLS
+speed_t cfgetispeed __P((const struct termios *));
+speed_t cfgetospeed __P((const struct termios *));
+int     cfsetispeed __P((struct termios *, speed_t));
+int     cfsetospeed __P((struct termios *, speed_t));
+int     tcgetattr __P((int, struct termios *));
+int     tcsetattr __P((int, int, const struct termios *));
+int     tcdrain __P((int));
+int     tcflow __P((int, int));
+int     tcflush __P((int, int));
+int     tcsendbreak __P((int, int));
+
+#ifndef _POSIX_SOURCE
+void    cfmakeraw __P((struct termios *));
+int     cfsetspeed __P((struct termios *, speed_t));
+#endif { !_POSIX_SOURCE }
+__END_DECLS
+
+#endif { !_KERNEL }
+
+
+
+struct winsize {
+        unsigned short  ws_row;         { rows, in characters }
+        unsigned short  ws_col;         { columns, in characters }
+        unsigned short  ws_xpixel;      { horizontal size, pixels }
+        unsigned short  ws_ypixel;      { vertical size, pixels }
+};
+
+}
+       IOCTLREAD        = $40000000;
+       IOCTLWRITE       = $80000000;
+       IOCTLVOID        = $20000000;
+
+        TIOCMODG        = IOCTLREAD+$47400+ 3;  { get modem control state }
+        TIOCMODS        = IOCTLWRITE+$47400+ 4; { set modem control state }
+                TIOCM_LE        =$0001;         { line enable }
+                TIOCM_DTR       =$0002;         { data terminal ready }
+                TIOCM_RTS       =$0004;         { request to send }
+                TIOCM_ST        =$0010;         { secondary transmit }
+                TIOCM_SR        =$0020;         { secondary receive }
+                TIOCM_CTS       =$0040;         { clear to send }
+                TIOCM_CAR       =$0100;         { carrier detect }
+                TIOCM_CD        =TIOCM_CAR;
+                TIOCM_RNG       =$0200;         { ring }
+                TIOCM_RI        =TIOCM_RNG;
+                TIOCM_DSR       =$0400;         { data set ready }
+                                                { 8-10 compat }
+        TIOCEXCL         =IOCTLVOID+$7400+ 13;          { set exclusive use of tty }
+        TIOCNXCL         =IOCTLVOID+$7400+ 14;          { reset exclusive use of tty }
+                                                { 15 unused }
+        TIOCFLUSH        =IOCTLWRITE+$47400+ 16;        { flush buffers }
+                                                { 17-18 compat }
+        TIOCGETA         =IOCTLREAD+$2C7400+ 19; { get termios struct }
+        TIOCSETA         =IOCTLWRITE+$2C7400+ 20; { set termios struct }
+        TIOCSETAW        =IOCTLWRITE+$2C7400+ 21; { drain output, set }
+        TIOCSETAF        =IOCTLWRITE+$2C7400+ 22; { drn out, fls in, set }
+        TIOCGETD         =IOCTLREAD+$47400+ 26; { get line discipline }
+        TIOCSETD         =IOCTLWRITE+$47400+ 27;        { set line discipline }
+                                                { 127-124 compat }
+        TIOCSBRK         =IOCTLVOID+$7400+ 123;         { set break bit }
+        TIOCCBRK         =IOCTLVOID+$7400+ 122;         { clear break bit }
+        TIOCSDTR         =IOCTLVOID+$7400+ 121;         { set data terminal ready }
+        TIOCCDTR         =IOCTLVOID+$7400+ 120;         { clear data terminal ready }
+        TIOCGPGRP        =IOCTLREAD+$47400+ 119;        { get pgrp of tty }
+        TIOCSPGRP        =IOCTLWRITE+$47400+ 118;       { set pgrp of tty }
+                                                { 117-116 compat }
+        TIOCOUTQ         =IOCTLREAD+$47400+ 115;        { output queue size }
+        TIOCSTI          =IOCTLWRITE+$17400+ 114;       { simulate terminal input }
+        TIOCNOTTY        =IOCTLVOID+$7400+ 113;         { void tty association }
+        TIOCPKT          =IOCTLWRITE+$47400+ 112;       { pty: set/clear packet mode }
+                TIOCPKT_DATA            =$00;   { data packet }
+                TIOCPKT_FLUSHREAD       =$01;   { flush packet }
+                TIOCPKT_FLUSHWRITE      =$02;   { flush packet }
+                TIOCPKT_STOP            =$04;   { stop output }
+                TIOCPKT_START           =$08;   { start output }
+                TIOCPKT_NOSTOP          =$10;   { no more ^S, ^Q }
+                TIOCPKT_DOSTOP          =$20;   { now do ^S ^Q }
+                TIOCPKT_IOCTL           =$40;   { state change of pty driver }
+        TIOCSTOP         =IOCTLVOID+$7400+ 111;         { stop output, like ^S }
+        TIOCSTART        =IOCTLVOID+$7400+ 110;         { start output, like ^Q }
+        TIOCMSET         =IOCTLWRITE+$47400+ 109;       { set all modem bits }
+        TIOCMBIS         =IOCTLWRITE+$47400+ 108;       { bis modem bits }
+        TIOCMBIC         =IOCTLWRITE+$47400+ 107;       { bic modem bits }
+        TIOCMGET         =IOCTLREAD+$47400+ 106;        { get all modem bits }
+        TIOCREMOTE       =IOCTLWRITE+$47400+ 105;       { remote input editing }
+        TIOCGWINSZ       =IOCTLREAD+$87400+ 104;        { get window size }
+        TIOCSWINSZ       =IOCTLWRITE+$87400+ 103;       { set window size }
+        TIOCUCNTL        =IOCTLWRITE+$47400+ 102;       { pty: set/clr usr cntl mode }
+        TIOCSTAT         =IOCTLVOID+$7400+ 101;         { simulate ^T status message }
+  //                       UIOCCMD(n)   _IO('u', n)     { usr cntl op "n" }
+        TIOCCONS         =IOCTLWRITE+$47400+ 98;        { become virtual console }
+        TIOCSCTTY        =IOCTLVOID+$7400+ 97;          { become controlling tty }
+        TIOCEXT          =IOCTLWRITE+$47400+ 96;        { pty: external processing }
+        TIOCSIG          =IOCTLVOID+$7400+ 95;          { pty: generate signal }
+        TIOCDRAIN        =IOCTLVOID+$7400+ 94;          { wait till output drained }
+        TIOCMSDTRWAIT    =IOCTLWRITE+$47400+ 91;        { modem: set wait on close }
+        TIOCMGDTRWAIT    =IOCTLREAD+$47400+ 90; { modem: get wait on close }
+        TIOCTIMESTAMP    =IOCTLREAD+$87400+ 89;         { enable/get timestamp
+                                                 * of last input event }
+        TIOCDCDTIMESTAMP =IOCTLREAD+$87400+ 88; { enable/get timestamp
+                                                 * of last DCd rise }
+        TIOCSDRAINWAIT   =IOCTLWRITE+$47400+ 87;        { set ttywait timeout }
+        TIOCGDRAINWAIT   =IOCTLREAD+$47400+ 86; { get ttywait timeout }
+
+        TTYDISC          =0;            { termios tty line discipline }
+        SLIPDISC         =4;            { serial IP discipline }
+        PPPDISC          =5;            { PPP discipline }
+        NETGRAPHDISC     =6;            { Netgraph tty node discipline }
+
+		// OCO 31/10/2005 For compatiblity (defined to compile ShiftState function
+		// in keyboard.pp)
+		// Maybe, it should not work but it compile at least...
+		TIOCLINUX        = $541C;
+
+
+{
+ * Defaults on "first" open.
+ }
+        TTYDEF_IFLAG     =(BRKINT       or ICRNL        or IXON or IXANY);
+       TTYDEF_OFLAG      =(OPOST or ONLCR);
+       TTYDEF_LFLAG      =(ECHO or ICANON or ISIG or IEXTEN or ECHOE );
+        TTYDEF_CFLAG     =(CREAD or CS8 or HUPCL);
+       TTYDEF_SPEED      =(B9600);
+
+
+
+{
+ * Control Character Defaults
+ }
+        CtrlMask        = $1f;  {\037}
+        CEOF            =chr( ORD('d') and CtrlMask);
+        CEOL            =chr( $ff and CtrlMask);{ XXX avoid _POSIX_VDISABLE }
+        CERASE          =chr( $7F and CtrlMask);
+        CINTR           =chr(ORD('c') and CtrlMask);
+        CSTATUS         =chr(ORD('t') and CtrlMask);
+        CKILL           =chr(ORD('u') and CtrlMask);
+        CMIN            =chr(1);
+        CQUIT           =chr(034  and CtrlMask);        { FS, ^\ }
+        CSUSP           =chr(ORD('z') and CtrlMask);
+        CTIME           =chr(0);
+        CDSUSP          =chr(ORD('y') and CtrlMask);
+        CSTART          =chr(ORD('q') and CtrlMask);
+        CSTOP           =chr(ORD('s') and CtrlMask);
+        CLNEXT          =chr(ORD('v') and CtrlMask);
+        CDISCARD        =chr(ORD('o') and CtrlMask);
+        CWERASE         =chr(ORD('w') and CtrlMask);
+        CREPRINT        =chr(ORD('r') and CtrlMask);
+        CEOT            =CEOF;
+{ compat }
+        CBRK            =CEOL;
+        CRPRNT          =CREPRINT;
+        CFLUSH          =CDISCARD;
+
+
+{
+ *        TTYDEFCHARS to include an array of default control characters.
+}
+{    ttydefchars : array[0..NCCS-1] OF char =(
+        Chr(VINTR), Chr(VQUIT), Chr(VERASE), Chr(VKILL), Chr(VEOF), Chr(VEOL),
+        Chr(VEOL2), Chr(VSWTCH), Chr(VSTART), Chr(VSTOP), Chr(VSUSP));}
+    ttydefchars : array[0..NCCS-1] OF char =(
+        Chr(VINTR), Chr(VQUIT), Chr(VERASE), Chr(VKILL), Chr(VEOF), Chr(VEOL),
+        Chr(VEOL2), Chr(VSWTCH), Chr(VSTART), Chr(VSTOP), Chr(VSUSP));
+

rtl/beos/termiosproc.inc

@@ -0,0 +1,130 @@
+{
+   This file is part of the Free Pascal run time library.
+   (c) 2000-2003 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.
+
+   Termios implementation for FreeBSD
+
+   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.
+}
+
+
+{******************************************************************************
+                         IOCtl and Termios calls
+******************************************************************************}
+
+Function TCGetAttr(fd:cint;var tios:TermIOS):cint;
+begin
+  TCGETAttr:=fpIoCtl(Fd,TIOCGETA,@tios);
+end;
+
+
+Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint;
+var
+  nr:cint;
+begin
+  case OptAct of
+   TCSANOW   : nr:=TIOCSETA;
+   TCSADRAIN : nr:=TIOCSETAW;
+   TCSAFLUSH : nr:=TIOCSETAF;
+  else
+   begin
+     fpsetErrNo(ESysEINVAL);
+     TCSetAttr:=-1;
+     exit;
+   end;
+  end;
+  TCSetAttr:=fpIOCtl(fd,nr,@Tios);
+end;
+
+
+Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
+begin
+// BeOS  tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
+end;
+
+
+Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
+begin
+// BeOS   tios.c_ospeed:=speed;
+end;
+
+
+
+Procedure CFMakeRaw(var tios:TermIOS);
+begin
+  with tios do
+   begin
+     c_iflag:=c_iflag and (not (IXOFF or INPCK or BRKINT or
+                PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
+                IGNPAR));
+     c_iflag:=c_iflag OR IGNBRK;
+     c_oflag:=c_oflag and (not OPOST);
+     c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
+                                ISIG or IEXTEN or NOFLSH or TOSTOP));
+     c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
+     c_cc[VMIN]:= 1;
+     c_cc[VTIME]:= 0;
+   end;
+end;
+
+Function TCSendBreak(fd,duration:cint):cint;
+begin
+  TCSendBreak:=fpIOCtl(fd,TIOCSBRK,nil);
+end;
+
+
+Function TCSetPGrp(fd,id:cint):cint;
+begin
+  TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(id));
+end;
+
+
+Function TCGetPGrp(fd:cint;var id:cint):cint;
+begin
+  TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id);
+end;
+
+Function TCDrain(fd:cint):cint;
+begin
+  TCDrain:=fpIOCtl(fd,TIOCDRAIN,nil); {Should set timeout to 1 first?}
+end;
+
+
+Function TCFlow(fd,act:cint):cint;
+begin
+    case act OF
+     TCOOFF :  TCFlow:=fpIoctl(fd,TIOCSTOP,nil);
+     TCOOn  :  TCFlow:=fpIOctl(Fd,TIOCStart,nil);
+     TCIOFF :  {N/I}
+    end;
+end;
+
+Function TCFlush(fd,qsel:cint):cint;
+begin
+  TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(qsel));
+end;
+
+Function BeOSIsATTY (Handle:cint):cint; cdecl; external 'root' name 'isatty';
+
+Function IsATTY (Handle:cint):cint;
+{
+  Check if the filehandle described by 'handle' is a TTY (Terminal)
+}
+begin
+ IsAtty:= BeOSIsATTY(Handle);
+end;
+
+Function IsATTY(var f: text):cint;
+{
+  Idem as previous, only now for text variables.
+}
+begin
+  IsATTY:=IsaTTY(textrec(f).handle);
+end;
+

rtl/beos/timezone.inc

@@ -1,428 +0,0 @@
-{
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 2002 by the Free Pascal development team.
-
-    Timezone extraction routines
-
-    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.
-
- **********************************************************************}
-
-const
-  TZ_MAGIC = 'TZif';
-
-type
-  plongint=^longint;
-  pbyte=^byte;
-
-  ttzhead=packed record
-    tzh_magic : array[0..3] of char;
-    tzh_reserved : array[1..16] of byte;
-    tzh_ttisgmtcnt,
-    tzh_ttisstdcnt,
-    tzh_leapcnt,
-    tzh_timecnt,
-    tzh_typecnt,
-    tzh_charcnt  : longint;
-  end;
-
-  pttinfo=^tttinfo;
-  tttinfo=packed record
-    offset : longint;
-    isdst  : boolean;
-    idx    : byte;
-    isstd  : byte;
-    isgmt  : byte;
-  end;
-
-  pleap=^tleap;
-  tleap=record
-    transition : longint;
-    change     : longint;
-  end;
-
-var
-  num_transitions,
-  num_leaps,
-  num_types    : longint;
-
-  transitions  : plongint;
-  type_idxs    : pbyte;
-  types        : pttinfo;
-  zone_names   : pchar;
-  leaps        : pleap;
-
-function find_transition(timer:time_t):pttinfo;
-var
-  i : longint;
-begin
-  if (num_transitions=0) or (timer<time_t(transitions[0])) then
-   begin
-     i:=0;
-     while (i<num_types) and (types[i].isdst) do
-      inc(i);
-     if (i=num_types) then
-      i:=0;
-   end
-  else
-   begin
-     for i:=1 to num_transitions do
-      if (timer<transitions[i]) then
-       break;
-     i:=type_idxs[i-1];
-   end;
-  find_transition:=@types[i];
-end;
-
-
-procedure GetLocalTimezone(timer:time_t;var leap_correct,leap_hit:longint);
-var
-  info : pttinfo;
-  i    : longint;
-begin
-{ reset }
-  TZDaylight:=false;
-  TZSeconds:=0;
-  TZName[false]:=nil;
-  TZName[true]:=nil;
-  leap_correct:=0;
-  leap_hit:=0;
-{ get info }
-  info:=find_transition(timer);
-  if not assigned(info) then
-   exit;
-  TZDaylight:=info^.isdst;
-  TZSeconds:=info^.offset;
-  i:=0;
-  while (i<num_types) do
-   begin
-     tzname[types[i].isdst]:=@zone_names[types[i].idx];
-     inc(i);
-   end;
-  tzname[info^.isdst]:=@zone_names[info^.idx];
-  i:=num_leaps;
-  repeat
-    if i=0 then
-     exit;
-    dec(i);
-  until (timer>leaps[i].transition);
-  leap_correct:=leaps[i].change;
-  if (timer=leaps[i].transition) and
-     (((i=0) and (leaps[i].change>0)) or
-      (leaps[i].change>leaps[i-1].change)) then
-   begin
-     leap_hit:=1;
-     while (i>0) and
-           (leaps[i].transition=leaps[i-1].transition+1) and
-           (leaps[i].change=leaps[i-1].change+1) do
-      begin
-        inc(leap_hit);
-        dec(i);
-      end;
-   end;
-end;
-
-
-procedure GetLocalTimezone(timer:longint);
-var
-  lc,lh : longint;
-begin
-  GetLocalTimezone(timer,lc,lh);
-end;
-
-
-procedure ReadTimezoneFile(fn:string);
-
-  procedure decode(var l:longint);
-  var
-    k : longint;
-    p : pbyte;
-  begin
-    p:=pbyte(@l);
-    if (p[0] and (1 shl 7))<>0 then
-     k:=not 0
-    else
-     k:=0;
-    k:=(k shl 8) or p[0];
-    k:=(k shl 8) or p[1];
-    k:=(k shl 8) or p[2];
-    k:=(k shl 8) or p[3];
-    l:=k;
-  end;
-
-var
-  f      : File;
-  tzdir  : string;
-  tzhead : ttzhead;
-  i      : longint;
-  chars  : longint;
-  buf    : pbyte;
-  _result : longint;
-  label  lose;
-begin
-  if fn = '' then
-    exit;
-{$IFOPT I+}
-{$DEFINE IOCHECK_ON}
-{$ENDIF}
-{$I-}
-  Assign(F, fn);
-  Reset(F,1);
-  If IOResult <> 0 then
-   exit;
-{$IFDEF IOCHECK_ON}
-{$I+}
-{$ENDIF}
-{$UNDEF IOCHECK_ON}
-  BlockRead(f,tzhead,sizeof(tzhead),i);
-  if i<>sizeof(tzhead) then
-     goto lose;
-  if tzhead.tzh_magic<>TZ_MAGIC then
-  begin
-     goto lose;
-  end;
-  decode(tzhead.tzh_timecnt);
-  decode(tzhead.tzh_typecnt);
-  decode(tzhead.tzh_charcnt);
-  decode(tzhead.tzh_leapcnt);
-  decode(tzhead.tzh_ttisstdcnt);
-  decode(tzhead.tzh_ttisgmtcnt);
-
-  num_transitions:=tzhead.tzh_timecnt;
-  num_types:=tzhead.tzh_typecnt;
-  chars:=tzhead.tzh_charcnt;
-
-  reallocmem(transitions,num_transitions*sizeof(longint));
-  reallocmem(type_idxs,num_transitions);
-  reallocmem(types,num_types*sizeof(tttinfo));
-  reallocmem(zone_names,chars);
-  reallocmem(leaps,num_leaps*sizeof(tleap));
-
-  BlockRead(f,transitions^,num_transitions*4,_result);
-  if _result <> num_transitions*4 then
-  begin
-     goto lose;
-  end;
-  BlockRead(f,type_idxs^,num_transitions,_result);
-  if _result <> num_transitions then
-  begin
-    goto lose;
-  end;
-  {* Check for bogus indices in the data file, so we can hereafter
-     safely use type_idxs[T] as indices into `types' and never crash.  *}
-  for i := 0 to num_transitions-1 do
-    if (type_idxs[i] >= num_types) then
-    begin
-      goto lose;
-    end;
-
-
-  for i:=0 to num_transitions-1 do
-   decode(transitions[i]);
-
-  for i:=0 to num_types-1 do
-   begin
-     blockread(f,types[i].offset,4,_result);
-     if _result <> 4 then
-     begin
-      goto lose;
-     end;
-     blockread(f,types[i].isdst,1,_result);
-     if _result <> 1 then
-     begin
-      goto lose;
-     end;
-     blockread(f,types[i].idx,1,_result);
-     if _result <> 1 then
-     begin
-      goto lose;
-     end;
-     decode(types[i].offset);
-     types[i].isstd:=0;
-     types[i].isgmt:=0;
-   end;
-
-  blockread(f,zone_names^,chars,_result);
-  if _result<>chars then
-     begin
-      goto lose;
-     end;
-
-
-  for i:=0 to num_leaps-1 do
-   begin
-     blockread(f,leaps[i].transition,4);
-     if _result <> 4 then
-     begin
-      goto lose;
-     end;
-     blockread(f,leaps[i].change,4);
-     begin
-      goto lose;
-     end;
-     decode(leaps[i].transition);
-     decode(leaps[i].change);
-   end;
-
-  getmem(buf,tzhead.tzh_ttisstdcnt);
-  blockread(f,buf^,tzhead.tzh_ttisstdcnt,_result);
-  if _result<>tzhead.tzh_ttisstdcnt then
-     begin
-      goto lose;
-     end;
-  for i:=0 to tzhead.tzh_ttisstdcnt-1 do
-   types[i].isstd:=byte(buf[i]<>0);
-  freemem(buf);
-
-  getmem(buf,tzhead.tzh_ttisgmtcnt);
-  blockread(f,buf^,tzhead.tzh_ttisgmtcnt);
-  if _result<>tzhead.tzh_ttisgmtcnt then
-     begin
-      goto lose;
-     end;
-  for i:=0 to tzhead.tzh_ttisgmtcnt-1 do
-   types[i].isgmt:=byte(buf[i]<>0);
-  freemem(buf);
-  close(f);
-  exit;
-lose:
-  close(f);
-end;
-
-
-{ help function to extract TZ variable data }
-function extractnumberend(tzstr: string; offset : integer): integer;
-var
- j: integer;
-begin
- j:=0;
- extractnumberend := 0;
- repeat
-   if (offset+j) > length(tzstr) then
-     begin
-       exit;
-     end;
-  inc(j);
- until not (tzstr[offset+j] in ['0'..'9']);
- extractnumberend := offset+j;
-end;
-
-function getoffsetseconds(tzstr: string): longint;
-{ extract GMT timezone information }
-{ Returns the number of minutes to }
-{ add or subtract to the GMT time  }
-{ to get the local time.           }
-{ Format of TZ variable (POSIX)    }
-{  std offset dst                  }
-{  std = characters of timezone    }
-{  offset = hh[:mm] to add to GMT  }
-{  dst = daylight savings time     }
-{ CURRENTLY DOES NOT TAKE CARE     }
-{ OF SUMMER TIME DIFFERENCIAL      }
-var
- s: string;
- i, j: integer;
- code : integer;
- hours : longint;
- minutes : longint;
- negative : boolean;
-begin
- hours:=0;
- minutes:=0;
- getoffsetseconds := 0;
- negative := FALSE;
- i:=-1;
- { get to offset field }
- repeat
-   if i > length(tzstr) then
-     begin
-       exit;
-     end;
-   inc(i);
- until (tzstr[i] = '-') or (tzstr[i] in ['0'..'9']);
- if tzstr[i] = '-' then
-  begin
-   Inc(i);
-   negative := TRUE;
-  end;
- j:=extractnumberend(tzstr,i);
- s:=copy(tzstr,i,j-i);
- val(s,hours,code);
- if code <> 0 then
-   begin
-     exit;
-   end;
- if tzstr[j] = ':' then
-   begin
-     i:=j;
-     Inc(i);
-     j:=extractnumberend(tzstr,i);
-     s:=copy(tzstr,i,j-i);
-     val(s,minutes,code);
-     if code <> 0 then
-      begin
-        exit;
-      end;
-   end;
- if negative then
-  begin
-    minutes := -minutes;
-    hours := -hours;
-  end;
- getoffsetseconds := minutes*60 + hours*3600;
-end;
-
-
-procedure InitLocalTime;
-var
- tloc: time_t;
- s : string;
-begin
-  TZSeconds:=0;
-  { try to get the POSIX version  }
-  { of the local time offset      }
-  { if '', then it does not exist }
-  { if ': ..', then non-POSIX     }
-  s:=GetTimezoneString;
-  if (s<>'') and (s[1]<>':') then
-   begin
-     TZSeconds := getoffsetseconds(s);
-   end
-  else
-   begin
-     s:=GetTimeZoneFile;
-     { only read if there is something to read }
-     if s<>'' then
-     begin
-       ReadTimezoneFile(s);
-       tloc:=sys_time(tloc);
-       GetLocalTimezone(tloc);
-     end;
-   end;
-end;
-
-
-procedure DoneLocalTime;
-begin
-  if assigned(transitions) then
-   freemem(transitions);
-  if assigned(type_idxs) then
-   freemem(type_idxs);
-  if assigned(types) then
-   freemem(types);
-  if assigned(zone_names) then
-   freemem(zone_names);
-  if assigned(leaps) then
-   freemem(leaps);
-  num_transitions:=0;
-  num_leaps:=0;
-  num_types:=0;
-end;
-
-
-

rtl/beos/tthread.inc

@@ -0,0 +1,610 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by Peter Vreman
+
+    BeOS TThread implementation
+
+    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.
+
+ **********************************************************************}
+
+
+{$IFDEF VER1_0} // leaving the old implementation in for now...
+type
+  PThreadRec=^TThreadRec;
+  TThreadRec=record
+    thread : TThread;
+    next   : PThreadRec;
+  end;
+
+var
+  ThreadRoot : PThreadRec;
+  ThreadsInited : boolean;
+//  MainThreadID: longint;
+
+Const
+  ThreadCount: longint = 0;
+
+function ThreadSelf:TThread;
+var
+  hp : PThreadRec;
+  sp : Pointer;
+begin
+  sp:=SPtr;
+  hp:=ThreadRoot;
+  while assigned(hp) do
+   begin
+     if (sp<=hp^.Thread.FStackPointer) and
+        (sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
+      begin
+        Result:=hp^.Thread;
+        exit;
+      end;
+     hp:=hp^.next;
+   end;
+  Result:=nil;
+end;
+
+
+//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
+procedure SIGCHLDHandler(Sig: longint); cdecl;
+
+begin
+  fpwaitpid(-1, nil, WNOHANG);
+end;
+
+procedure InitThreads;
+var
+  Act, OldAct: Baseunix.PSigActionRec;
+begin
+  ThreadRoot:=nil;
+  ThreadsInited:=true;
+
+
+// This will install SIGCHLD signal handler
+// signal() installs "one-shot" handler,
+// so it is better to install and set up handler with sigaction()
+
+  GetMem(Act, SizeOf(SigActionRec));
+  GetMem(OldAct, SizeOf(SigActionRec));
+
+  Act^.sa_handler := TSigAction(@SIGCHLDHandler);
+  Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
+  Fillchar(Act^.sa_mask,sizeof(Act^.sa_mask),0); //Do not block all signals ??. Don't need if SA_NOMASK in flags
+  FpSigAction(SIGCHLD, Act, OldAct);
+
+  FreeMem(Act, SizeOf(SigActionRec));
+  FreeMem(OldAct, SizeOf(SigActionRec));
+end;
+
+
+procedure DoneThreads;
+var
+  hp : PThreadRec;
+begin
+  while assigned(ThreadRoot) do
+   begin
+     ThreadRoot^.Thread.Destroy;
+     hp:=ThreadRoot;
+     ThreadRoot:=ThreadRoot^.Next;
+     dispose(hp);
+   end;
+  ThreadsInited:=false;
+end;
+
+
+procedure AddThread(t:TThread);
+var
+  hp : PThreadRec;
+begin
+  { Need to initialize threads ? }
+  if not ThreadsInited then
+   InitThreads;
+
+  { Put thread in the linked list }
+  new(hp);
+  hp^.Thread:=t;
+  hp^.next:=ThreadRoot;
+  ThreadRoot:=hp;
+
+  inc(ThreadCount, 1);
+end;
+
+
+procedure RemoveThread(t:TThread);
+var
+  lasthp,hp : PThreadRec;
+begin
+  hp:=ThreadRoot;
+  lasthp:=nil;
+  while assigned(hp) do
+   begin
+     if hp^.Thread=t then
+      begin
+        if assigned(lasthp) then
+         lasthp^.next:=hp^.next
+        else
+         ThreadRoot:=hp^.next;
+        dispose(hp);
+        exit;
+      end;
+     lasthp:=hp;
+     hp:=hp^.next;
+   end;
+
+  Dec(ThreadCount, 1);
+  if ThreadCount = 0 then DoneThreads;
+end;
+
+
+{ TThread }
+function ThreadProc(args:pointer): Integer;//cdecl;
+var
+  FreeThread: Boolean;
+  Thread : TThread absolute args;
+begin
+  while Thread.FHandle = 0 do fpsleep(1);
+  if Thread.FSuspended then Thread.suspend();
+  try
+    Thread.Execute;
+  except
+    Thread.FFatalException := TObject(AcquireExceptionObject);
+  end;
+  FreeThread := Thread.FFreeOnTerminate;
+  Result := Thread.FReturnValue;
+  Thread.FFinished := True;
+  Thread.DoTerminate;
+  if FreeThread then
+    Thread.Free;
+  fpexit(Result);
+end;
+
+
+constructor TThread.Create(CreateSuspended: Boolean);
+var
+  Flags: Integer;
+begin
+  inherited Create;
+  AddThread(self);
+  FSuspended := CreateSuspended;
+  Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
+  { Setup 16k of stack }
+  FStackSize:=16384;
+  Getmem(FStackPointer,FStackSize);
+  inc(FStackPointer,FStackSize);
+  FCallExitProcess:=false;
+  { Clone }
+  FHandle:= Clone(@ThreadProc,FStackPointer,Flags,self);
+//  if FSuspended then Suspend;
+  FThreadID := FHandle;
+  IsMultiThread := TRUE;
+  FFatalException := nil;
+end;
+
+
+destructor TThread.Destroy;
+begin
+  if not FFinished and not Suspended then
+   begin
+     Terminate;
+     WaitFor;
+   end;
+  if FHandle <> -1 then
+    fpkill(FHandle, SIGKILL);
+  dec(FStackPointer,FStackSize);
+  Freemem(FStackPointer);
+  FFatalException.Free;
+  FFatalException := nil;
+  inherited Destroy;
+  RemoveThread(self);
+end;
+
+
+procedure TThread.CallOnTerminate;
+begin
+  FOnTerminate(Self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+  if Assigned(FOnTerminate) then
+    Synchronize(@CallOnTerminate);
+end;
+
+
+const
+{ I Don't know idle or timecritical, value is also 20, so the largest other
+  possibility is 19 (PFV) }
+  Priorities: array [TThreadPriority] of Integer =
+   (-20,-19,-10,9,10,19,20);
+
+function TThread.GetPriority: TThreadPriority;
+var
+  P: Integer;
+  I: TThreadPriority;
+begin
+  P := fpGetPriority(Prio_Process,FHandle);
+  Result := tpNormal;
+  for I := Low(TThreadPriority) to High(TThreadPriority) do
+    if Priorities[I] = P then
+      Result := I;
+end;
+
+
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+  fpSetPriority(Prio_Process,FHandle,Priorities[Value]);
+end;
+
+
+procedure TThread.Synchronize(Method: TThreadMethod);
+begin
+  FSynchronizeException := nil;
+  FMethod := Method;
+{  SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self)); }
+  if Assigned(FSynchronizeException) then
+    raise FSynchronizeException;
+end;
+
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+  if Value <> FSuspended then
+    if Value then
+      Suspend
+    else
+      Resume;
+end;
+
+
+procedure TThread.Suspend;
+begin
+  FSuspended := true;
+  fpKill(FHandle, SIGSTOP);
+end;
+
+
+procedure TThread.Resume;
+begin
+  fpKill(FHandle, SIGCONT);
+  FSuspended := False;
+end;
+
+
+procedure TThread.Terminate;
+begin
+  FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+var
+  status : longint;
+begin
+  if FThreadID = MainThreadID then
+    fpwaitpid(0,@status,0)
+  else
+    fpwaitpid(FHandle,@status,0);
+  Result:=status;
+end;
+{$ELSE}
+
+{
+  What follows, is a short description on my implementation of TThread.
+  Most information can also be found by reading the source and accompanying
+  comments.
+  
+  A thread is created using BeginThread, which in turn calls
+  pthread_create. So the threads here are always posix threads.
+  Posix doesn't define anything for suspending threads as this is
+  inherintly unsafe. Just don't suspend threads at points they cannot
+  control. Therefore, I didn't implement .Suspend() if its called from
+  outside the threads execution flow (except on Linux _without_ NPTL).
+  
+  The implementation for .suspend uses a semaphore, which is initialized
+  at thread creation. If the thread tries to suspend itself, we simply
+  let it wait on the semaphore until it is unblocked by someone else
+  who calls .Resume.
+
+  If a thread is supposed to be suspended (from outside its own path of
+  execution) on a system where the symbol LINUX is defined, two things
+  are possible.
+  1) the system has the LinuxThreads pthread implementation
+  2) the system has NPTL as the pthread implementation.
+  
+  In the first case, each thread is a process on its own, which as far as
+  know actually violates posix with respect to signal handling.
+  But we can detect this case, because getpid(2) will
+  return a different PID for each thread. In that case, sending SIGSTOP
+  to the PID associated with a thread will actually stop that thread
+  only.
+  In the second case, this is not possible. But getpid(2) returns the same
+  PID across all threads, which is detected, and TThread.Suspend() does
+  nothing in that case. This should probably be changed, but I know of
+  no way to suspend a thread when using NPTL.
+  
+  If the symbol LINUX is not defined, then the unimplemented
+  function SuspendThread is called.
+  
+  Johannes Berg <[email protected]>, Sunday, November 16 2003
+}
+
+// ========== semaphore stuff ==========
+{
+  I don't like this. It eats up 2 filedescriptors for each thread,
+  and those are a limited resource. If you have a server programm
+  handling client connections (one per thread) it will not be able
+  to handle many if we use 2 fds already for internal structures.
+  However, right now I don't see a better option unless some sem_*
+  functions are added to systhrds.
+  I encapsulated all used functions here to make it easier to
+  change them completely.
+}
+
+{BeOS implementation}
+
+function SemaphoreInit: Pointer;
+begin
+  SemaphoreInit := GetMem(SizeOf(TFilDes));
+  fppipe(PFilDes(SemaphoreInit)^);
+end;
+
+procedure SemaphoreWait(const FSem: Pointer);
+var
+  b: byte;
+begin
+  fpread(PFilDes(FSem)^[0], b, 1);
+end;
+
+procedure SemaphorePost(const FSem: Pointer);
+begin
+  fpwrite(PFilDes(FSem)^[1], #0, 1);
+end;
+
+procedure SemaphoreDestroy(const FSem: Pointer);
+begin
+  fpclose(PFilDes(FSem)^[0]);
+  fpclose(PFilDes(FSem)^[1]);
+  FreeMemory(FSem);
+end;
+
+// =========== semaphore end ===========
+
+var
+  ThreadsInited: boolean = false;
+{$IFDEF LINUX}
+  GMainPID: LongInt = 0;
+{$ENDIF}
+const
+  // stupid, considering its not even implemented...
+  Priorities: array [TThreadPriority] of Integer =
+   (-20,-19,-10,0,9,18,19);
+
+procedure InitThreads;
+begin
+  if not ThreadsInited then begin
+    ThreadsInited := true;
+    {$IFDEF LINUX}
+    GMainPid := fpgetpid();
+    {$ENDIF}
+  end;
+end;
+
+procedure DoneThreads;
+begin
+  ThreadsInited := false;
+end;
+
+{ ok, so this is a hack, but it works nicely. Just never use
+  a multiline argument with WRITE_DEBUG! }
+{$MACRO ON}
+{$IFDEF DEBUG_MT}
+{$define WRITE_DEBUG := writeln} // actually write something
+{$ELSE}
+{$define WRITE_DEBUG := //}      // just comment out those lines
+{$ENDIF}
+
+function ThreadFunc(parameter: Pointer): LongInt; // cdecl;
+var
+  LThread: TThread;
+  c: char;
+begin
+  WRITE_DEBUG('ThreadFunc is here...');
+  LThread := TThread(parameter);
+  {$IFDEF LINUX}
+  // save the PID of the "thread"
+  // this is different from the PID of the main thread if
+  // the LinuxThreads implementation is used
+  LThread.FPid := fpgetpid();
+  {$ENDIF}
+  WRITE_DEBUG('thread initing, parameter = ', LongInt(LThread));
+  try
+    if LThread.FInitialSuspended then begin
+      SemaphoreWait(LThread.FSem);
+      if not LThread.FInitialSuspended then begin
+        WRITE_DEBUG('going into LThread.Execute');
+        LThread.Execute;
+      end;
+    end else begin
+      WRITE_DEBUG('going into LThread.Execute');
+      LThread.Execute;
+    end;
+  except
+    on e: exception do begin
+      WRITE_DEBUG('got exception: ',e.message);
+      LThread.FFatalException :=  TObject(AcquireExceptionObject);
+      // not sure if we should really do this...
+      // but .Destroy was called, so why not try FreeOnTerminate?
+      if e is EThreadDestroyCalled then LThread.FFreeOnTerminate := true;
+    end;
+  end;
+  WRITE_DEBUG('thread done running');
+  Result := LThread.FReturnValue;
+  WRITE_DEBUG('Result is ',Result);
+  LThread.FFinished := True;
+  LThread.DoTerminate;
+  if LThread.FreeOnTerminate then begin
+    WRITE_DEBUG('Thread should be freed');
+    LThread.Free;
+    WRITE_DEBUG('Thread freed');
+  end;
+  WRITE_DEBUG('thread func exiting');
+end;
+
+{ TThread }
+constructor TThread.Create(CreateSuspended: Boolean; const StackSize: SizeUInt = DefaultStackSize);
+var
+  data : pointer;
+begin
+  // lets just hope that the user doesn't create a thread
+  // via BeginThread and creates the first TThread Object in there!
+  InitThreads;
+  inherited Create;
+  FSem := SemaphoreInit;
+  FSuspended := CreateSuspended;
+  FSuspendedExternal := false;
+  FInitialSuspended := CreateSuspended;
+  FFatalException := nil;
+  WRITE_DEBUG('creating thread, self = ',longint(self));
+  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+  WRITE_DEBUG('TThread.Create done');
+end;
+
+
+destructor TThread.Destroy;
+begin
+  if FThreadID = GetCurrentThreadID then begin
+    raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
+  end;
+  // if someone calls .Free on a thread with
+  // FreeOnTerminate, then don't crash!
+  FFreeOnTerminate := false;
+  if not FFinished and not FSuspended then begin
+    Terminate;
+    WaitFor;
+  end;
+  if (FInitialSuspended) then begin
+    // thread was created suspended but never woken up.
+    SemaphorePost(FSem);
+    WaitFor;
+  end;
+  FFatalException.Free;
+  FFatalException := nil;
+  SemaphoreDestroy(FSem);
+  inherited Destroy;
+end;
+
+procedure TThread.SetSuspended(Value: Boolean);
+begin
+  if Value <> FSuspended then
+    if Value then
+      Suspend
+    else
+      Resume;
+end;
+
+procedure TThread.Suspend;
+begin
+  if not FSuspended then begin
+    if FThreadID = GetCurrentThreadID then begin
+      FSuspended := true;
+      SemaphoreWait(FSem);
+    end else begin
+      FSuspendedExternal := true;
+{$IFDEF LINUX}
+      // naughty hack if the user doesn't have Linux with NPTL...
+      // in that case, the PID of threads will not be identical
+      // to the other threads, which means that our thread is a normal
+      // process that we can suspend via SIGSTOP...
+      // this violates POSIX, but is the way it works on the
+      // LinuxThreads pthread implementation. Not with NPTL, but in that case
+      // getpid(2) also behaves properly and returns the same PID for
+      // all threads. Thats actually (FINALLY!) native thread support :-)
+      if FPid <> GMainPID then begin
+        FSuspended := true;
+        fpkill(FPid, SIGSTOP);
+      end;
+{$ELSE}
+      SuspendThread(FHandle);
+{$ENDIF}
+    end;
+  end;
+end;
+
+
+procedure TThread.Resume;
+begin
+  if (not FSuspendedExternal) then begin
+    if FSuspended then begin
+      SemaphorePost(FSem);
+      FInitialSuspended := false;
+      FSuspended := False;
+    end;
+  end else begin
+{$IFDEF LINUX}
+    // see .Suspend
+    if FPid <> GMainPID then begin
+      fpkill(FPid, SIGCONT);
+      FSuspended := False;
+    end;
+{$ELSE}
+    ResumeThread(FHandle);
+{$ENDIF}
+    FSuspendedExternal := false;
+  end;
+end;
+
+
+procedure TThread.Terminate;
+begin
+  FTerminated := True;
+end;
+
+function TThread.WaitFor: Integer;
+begin
+  WRITE_DEBUG('waiting for thread ',FHandle);
+  WaitFor := WaitForThreadTerminate(FHandle, 0);
+  WRITE_DEBUG('thread terminated');
+end;
+
+procedure TThread.CallOnTerminate;
+begin
+  // no need to check if FOnTerminate <> nil, because
+  // thats already done in DoTerminate
+  FOnTerminate(self);
+end;
+
+procedure TThread.DoTerminate;
+begin
+  if Assigned(FOnTerminate) then
+    Synchronize(@CallOnTerminate);
+end;
+
+function TThread.GetPriority: TThreadPriority;
+var
+  P: Integer;
+  I: TThreadPriority;
+begin
+  P := ThreadGetPriority(FHandle);
+  Result := tpNormal;
+  for I := Low(TThreadPriority) to High(TThreadPriority) do
+    if Priorities[I] = P then
+      Result := I;
+end;
+
+(*
+procedure TThread.Synchronize(Method: TThreadMethod);
+begin
+{$TODO someone with more clue of the GUI stuff will have to do this}
+end;
+*)
+procedure TThread.SetPriority(Value: TThreadPriority);
+begin
+  ThreadSetPriority(FHandle, Priorities[Value]);
+end;
+{$ENDIF}
+

rtl/beos/unixsock.inc

@@ -0,0 +1,110 @@
+{
+   This file is part of the Free Pascal run time library.
+   (c) 2000-2003 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.
+
+   socket call implementations for FreeBSD
+
+   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.
+}
+
+{******************************************************************************
+                          Basic Socket Functions
+******************************************************************************}
+
+function  fpsocket (domain:cint; xtype:cint; protocol: cint):cint;
+Begin
+  fpSocket:=Do_Syscall(syscall_nr_socket,Domain,xtype,Protocol);
+  internal_socketerror:=fpgeterrno;
+End;
+
+function  fpsend (s:cint; msg:pointer; len:size_t; flags:cint):ssize_t;
+begin
+  fpSend:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,0,0);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpsendto (s:cint; msg:pointer; len:size_t; flags:cint; tox :psockaddr; tolen: tsocklen):ssize_t;
+begin
+  fpSendto:=do_syscall(syscall_nr_sendto,S,TSysParam(msg),Len,Flags,TSysParam(tox),tolen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fprecv (s:cint; buf: pointer; len: size_t; flags:cint):ssize_t;
+begin
+  fpRecv:=do_syscall(syscall_nr_Recvfrom,S,tsysparam(buf),len,flags,0,0);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fprecvfrom (s:cint; buf: pointer; len: size_t; flags: cint; from : psockaddr; fromlen : psocklen):ssize_t;
+begin
+  fpRecvFrom:=do_syscall(syscall_nr_Recvfrom,S,TSysParam(buf),len,flags,TSysParam(from),TSysParam(fromlen));
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpbind (s:cint; addrx : psockaddr; addrlen : tsocklen):cint;
+begin
+  fpBind:=do_syscall(syscall_nr_Bind,S,TSysParam(addrx),addrlen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fplisten (s:cint; backlog : cint):cint;
+begin
+  fpListen:=do_syscall(syscall_nr_Listen,S,backlog);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpaccept (s:cint; addrx : psockaddr; addrlen : psocklen):cint;
+begin
+  fpAccept:=do_syscall(syscall_nr_accept,S,TSysParam(addrx),TSysParam(addrlen));
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpconnect (s:cint; name  : psockaddr; namelen : tsocklen):cint;
+begin
+  fpConnect:=do_syscall(syscall_nr_connect,S,TSysParam(name),namelen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpshutdown (s:cint; how:cint):cint;
+begin
+  fpShutDown:=do_syscall(syscall_nr_shutdown,S,how);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpgetsockname (s:cint; name  : psockaddr; namelen : psocklen):cint;
+begin
+  fpGetSockName:=do_syscall(syscall_nr_GetSockName,S,TSysParam(name),TSysParam(namelen));
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpgetpeername (s:cint; name  : psockaddr; namelen : psocklen):cint;
+begin
+  fpGetPeerName:=do_syscall(syscall_nr_GetPeerName,S,TSysParam(name),TSysParam(namelen));
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpsetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : tsocklen):cint;
+begin
+  fpSetSockOpt:=do_syscall(syscall_nr_SetSockOpt,S,level,optname,TSysParam(optval),optlen);
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpgetsockopt  (s:cint; level:cint; optname:cint; optval:pointer; optlen : psocklen):cint;
+begin
+  fpGetSockOpt:=do_syscall(syscall_nr_GetSockOpt,S,level,TSysParam(optname),TSysParam(optval),TSysParam(optlen));
+  internal_socketerror:=fpgeterrno;
+end;
+
+function  fpsocketpair (d:cint; xtype:cint; protocol:cint; sv:pcint):cint;
+
+begin
+  fpSocketPair:=do_syscall(syscall_nr_SocketPair,d,xtype,protocol,TSysParam(sv));
+  internal_socketerror:=fpgeterrno;
+end;
+

rtl/beos/unxconst.inc

@@ -0,0 +1,77 @@
+const
+  { Things for OPEN call - after include/sys/fcntl.h,
+   BSD specifies these constants in hex }
+  Open_Accmode  = 3;
+//  Open_RdOnly   = 0;
+//  Open_WrOnly   = 1;
+//  Open_RdWr     = 2;
+//  Open_NonBlock = 4;
+//  Open_Append   = 8;
+  Open_ShLock   = $10;
+  Open_ExLock   = $20;
+  Open_ASync    = $40;
+  Open_FSync    = $80;
+  Open_NoFollow = $100;
+  Open_Create   = $200;       {BSD convention}
+//  Open_Creat    = $200;       {Linux convention}
+//  Open_Trunc    = $400;
+//  Open_Excl     = $800;
+//  Open_NoCTTY   = $8000;
+
+
+{***********************************************************************}
+{                  POSIX CONSTANT ROUTINE DEFINITIONS                   }
+{***********************************************************************}
+CONST
+    { access routine - these maybe OR'ed together }
+    F_OK        =     0;        { test for existence of file }
+    R_OK        =     4;        { test for read permission on file }
+    W_OK        =     2;        { test for write permission on file }
+    X_OK        =     1;        { test for execute or search permission }
+    { seek routine }
+    SEEK_SET    =     0;        { seek from beginning of file }
+    SEEK_CUR    =     1;        { seek from current position  }
+    SEEK_END    =     2;        { seek from end of file       }
+    { open routine                                 }
+    { File access modes for `open' and `fcntl'.    }
+    OPEN_RDONLY    =     0;        { Open read-only.  }
+    OPEN_WRONLY    =     1;        { Open write-only. }
+    OPEN_RDWR      =     2;        { Open read/write. }
+    { Bits OR'd into the second argument to open.  }
+    OPEN_CREAT     =  $200;        { Create file if it doesn't exist.  }
+    OPEN_EXCL      =  $800;        { Fail if file already exists.      }
+    OPEN_TRUNC     =  $400;        { Truncate file to zero length.     }
+    OPEN_NOCTTY    = $8000;        { Don't assign a controlling terminal. }
+    { File status flags for `open' and `fcntl'.  }
+    OPEN_APPEND    =     8;        { Writes append to the file.        }
+    OPEN_NONBLOCK  =     4;        { Non-blocking I/O.                 }
+
+    { mode_t possible values                                 }
+  { Constants to check stat.mode -  checked all STAT constants with BeOS}
+  STAT_IFMT   = $f000; {00170000 }
+//  STAT_IFSOCK = $c000; {0140000 } // unavailable under BeOS
+  STAT_IFLNK  = $a000; {0120000 }
+  STAT_IFREG  = $8000; {0100000 }
+  STAT_IFBLK  = $6000; {0060000 }
+  STAT_IFDIR  = $4000; {0040000 }
+  STAT_IFCHR  = $2000; {0020000 }
+  STAT_IFIFO  = $1000; {0010000 }
+
+  STAT_ISUID  = $0800; {0004000 }
+  STAT_ISGID  = $0400; {0002000 }
+  STAT_ISVTX  = $0200; {0001000}
+    
+    
+    STAT_IRUSR =  %0100000000;     { Read permission for owner   }
+    STAT_IWUSR =  %0010000000;     { Write permission for owner  }
+    STAT_IXUSR =  %0001000000;     { Exec  permission for owner  }
+    STAT_IRGRP =  %0000100000;     { Read permission for group   }
+    STAT_IWGRP =  %0000010000;     { Write permission for group  }
+    STAT_IXGRP =  %0000001000;     { Exec permission for group   }
+    STAT_IROTH =  %0000000100;     { Read permission for world   }
+    STAT_IWOTH =  %0000000010;     { Write permission for world  }
+    STAT_IXOTH =  %0000000001;     { Exec permission for world   }
+
+    { Used for waitpid }
+    WAIT_NOHANG   =          1;     { don't block waiting               }
+    WAIT_UNTRACED =          2;     { report status of stopped children }

rtl/beos/unxfunc.inc

@@ -0,0 +1,88 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 1999-2000 by Peter Vreman
+
+    Darwin temporary pclose/assignpipe implementation
+
+    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.
+
+ **********************************************************************}
+
+
+
+Function PClose(Var F:file) : cint;
+var
+  pl : ^cint;
+  res : cint;
+
+begin
+  fpclose(filerec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+  pl:=@(filerec(f).userdata[2]);
+  fpwaitpid(pl^,@res,0);
+  pclose:=res shr 8;
+end;
+
+Function PClose(Var F:text) :cint;
+var
+  pl  : ^longint;
+  res : longint;
+
+begin
+  fpclose(Textrec(F).Handle);
+{ closed our side, Now wait for the other - this appears to be needed ?? }
+  pl:=@(textrec(f).userdata[2]);
+  fpwaitpid(pl^,@res,0);
+  pclose:=res shr 8;
+end;
+
+// type filedesarray=array[0..1] of cint;
+
+// function pipe (var fildes: filedesarray):cint;  cdecl; external 'root' name 'pipe';
+
+// can't have oldfpccall here, linux doesn't need it.
+Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
+{ 
+  Sets up a pair of file variables, which act as a pipe. The first one can
+  be read from, the second one can be written to.
+  If the operation was unsuccesful, linuxerror is set.
+}
+var
+  ret  : longint;
+  errn : cint;
+  fdis : array[0..1] of cint;
+begin
+ fdis[0]:=pipe_in;
+ fdis[1]:=pipe_out;
+ ret:=pipe(fdis);
+ pipe_in:=fdis[0];
+ pipe_out:=fdis[1];
+ AssignPipe:=ret;
+end;
+
+(*function intGetDomainName(Name:PChar; NameLen:Cint):cint;
+{$ifndef FPC_USE_LIBC}
+ external name 'FPC_SYSC_GETDOMAINNAME';
+{$else FPC_USE_LIBC}
+ cdecl; external clib name 'getdomainname';
+{$endif FPC_USE_LIBC}
+*)
+Function GetDomainName:String;  { linux only!}
+// domainname is a glibc extension.
+
+{
+  Get machines domain name. Returns empty string if not set.
+}
+
+begin
+{$WARNING TODO GetDomainName implementation}
+//  if intGetDomainName(@getdomainname[1],255)=-1 then
+//   getdomainname:=''
+//  else
+//   getdomainname[0]:=chr(strlen(@getdomainname[1]));
+end;

rtl/beos/unxsockh.inc

@@ -0,0 +1,351 @@
+{
+   This file is part of the Free Pascal run time library.
+   (c) 2000-2003 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.
+
+   OS dependant part of the header.
+
+   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.
+}
+
+Const
+{*
+ * Address families.
+ *}
+  AF_UNSPEC        = 0;		{ unspecified }
+  AF_UNIX          = 1;		{ standardized name for AF_LOCAL }
+  AF_LOCAL         = AF_UNIX;	{ local to host (pipes, portals) }
+  AF_INET          = 2;		{ internetwork: UDP, TCP, etc. }
+  AF_IMPLINK       = 3;		{ arpanet imp addresses }
+  AF_PUP           = 4;		{ pup protocols: e.g. BSP }
+  AF_CHAOS         = 5;		{ mit CHAOS protocols }
+  AF_NETBIOS       = 6;		{ SMB protocols }
+  AF_ISO           = 7;		{ ISO protocols }
+  AF_OSI           = AF_ISO;
+  AF_ECMA          = 8;		{ European computer manufacturers }
+  AF_DATAKIT       = 9;		{ datakit protocols }
+  AF_CCITT         = 10;	{ CCITT protocols, X.25 etc }
+  AF_SNA           = 11;	{ IBM SNA }
+  AF_DECnet        = 12;	{ DECnet }
+  AF_DLI           = 13;	{ DEC Direct data link interface }
+  AF_LAT           = 14;	{ LAT }
+  AF_HYLINK        = 15;	{ NSC Hyperchannel }
+  AF_APPLETALK     = 16;	{ Apple Talk }
+  AF_ROUTE         = 17;	{ Internal Routing Protocol }
+  AF_LINK          = 18;	{ Link layer interface }
+  pseudo_AF_XTP    = 19;	{ eXpress Transfer Protocol (no AF) }
+  AF_COIP          = 20;	{ connection-oriented IP, aka ST II }
+  AF_CNT           = 21;	{ Computer Network Technology }
+  pseudo_AF_RTIP   = 22;	{ Help Identify RTIP packets }
+  AF_IPX           = 23;	{ Novell Internet Protocol }
+  AF_SIP           = 24;	{ Simple Internet Protocol }
+  pseudo_AF_PIP    = 25;	{ Help Identify PIP packets }
+  AF_ISDN          = 26;	{ Integrated Services Digital Network}
+  AF_E164          = AF_ISDN;	{ CCITT E.164 recommendation }
+  pseudo_AF_KEY    = 27;	{ Internal key-management function }
+  AF_INET6         = 28;	{ IPv6 }
+  AF_NATM          = 29;	{ native ATM access }
+  AF_ATM           = 30;	{ ATM }
+  pseudo_AF_HDRCMPLT = 31;	{ Used by BPF to not rewrite headers
+					 * in interface output routine
+                                         }
+  AF_NETGRAPH      = 32;	{ Netgraph sockets }
+  AF_SLOW          = 33;	{ 802.3ad slow protocol }
+  AF_SCLUSTER      = 34;	{ Sitara cluster protocol }
+  AF_ARP           = 35;
+  AF_BLUETOOTH     = 36;	{ Bluetooth sockets }
+  AF_IEEE80211     = 37;	{ IEEE 802.11 protocol }
+  AF_MAX           = 38;
+  
+  {
+   * Protocol families, same as address families for now.
+    }
+
+  const
+     PF_UNSPEC = AF_UNSPEC;
+     PF_LOCAL = AF_LOCAL;
+  { backward compatibility  }
+     PF_UNIX = PF_LOCAL;
+     PF_INET = AF_INET;
+     PF_IMPLINK = AF_IMPLINK;
+     PF_PUP = AF_PUP;
+     PF_CHAOS = AF_CHAOS;
+     PF_NETBIOS = AF_NETBIOS;
+     PF_ISO = AF_ISO;
+     PF_OSI = AF_ISO;
+     PF_ECMA = AF_ECMA;
+     PF_DATAKIT = AF_DATAKIT;
+     PF_CCITT = AF_CCITT;
+     PF_SNA = AF_SNA;
+     PF_DECnet = AF_DECnet;
+     PF_DLI = AF_DLI;
+     PF_LAT = AF_LAT;
+     PF_HYLINK = AF_HYLINK;
+     PF_APPLETALK = AF_APPLETALK;
+     PF_ROUTE = AF_ROUTE;
+     PF_LINK = AF_LINK;
+  { really just proto family, no AF  }
+     PF_XTP = pseudo_AF_XTP;
+     PF_COIP = AF_COIP;
+     PF_CNT = AF_CNT;
+     PF_SIP = AF_SIP;
+     PF_IPX = AF_IPX;
+  { same format as AF_INET  }
+     PF_RTIP = pseudo_AF_RTIP;
+     PF_PIP = pseudo_AF_PIP;
+     PF_ISDN = AF_ISDN;
+     PF_KEY = pseudo_AF_KEY;
+     PF_INET6 = AF_INET6;
+     PF_NATM = AF_NATM;
+     PF_ATM = AF_ATM;
+     PF_NETGRAPH = AF_NETGRAPH;
+     PF_SLOW = AF_SLOW;
+     PF_SCLUSTER = AF_SCLUSTER;
+     PF_ARP = AF_ARP;
+     PF_BLUETOOTH = AF_BLUETOOTH;
+     PF_MAX = AF_MAX;
+
+
+  SOCK_PACKET     = 10;
+
+
+{ Maximum queue length specifiable by listen.  }
+  SOMAXCONN     = 128;
+
+        SOL_SOCKET 	 = $FFFF;
+        SO_DEBUG         = $0001;        { turn on debugging info recording }
+        SO_ACCEPTCONN    = $0002;        { socket has had listen() }
+        SO_REUSEADDR     = $0004;        { allow local address reuse }
+        SO_KEEPALIVE     = $0008;        { keep connections alive }
+        SO_DONTROUTE     = $0010;        { just use interface addresses }
+        SO_BROADCAST     = $0020;        { permit sending of broadcast msgs }
+        SO_USELOOPBACK   = $0040;        { bypass hardware when possible }
+        SO_LINGER        = $0080;        { linger on close if data present }
+        SO_OOBINLINE     = $0100;        { leave received OOB data in line }
+        SO_REUSEPORT     = $0200;        { allow local address & port reuse }
+        SO_TIMESTAMP     = $0400;        { timestamp received dgram traffic }
+
+{
+ * Additional options, not kept in so_options.
+ }
+        SO_SNDBUF        =$1001;        { send buffer size }
+        SO_RCVBUF        =$1002;        { receive buffer size }
+        SO_SNDLOWAT      =$1003;        { send low-water mark }
+        SO_RCVLOWAT      =$1004;        { receive low-water mark }
+        SO_SNDTIMEO      =$1005;        { send timeout }
+        SO_RCVTIMEO      =$1006;        { receive timeout }
+        SO_ERROR         =$1007;        { get error status and clear }
+        SO_TYPE          =$1008;        { get socket type }
+
+
+        SHUT_RD         =0;             { shut down the reading side }
+        SHUT_WR         =1;             { shut down the writing side }
+        SHUT_RDWR       =2;             { shut down both sides }
+
+	IPPROTO_IP              = 0;               { dummy for IP }
+	IPPROTO_ICMP            = 1;               { control message protocol }
+	IPPROTO_TCP             = 6;               { tcp }
+	IPPROTO_UDP             = 17;              { user datagram protocol }
+
+
+	IPPROTO_HOPOPTS		= 0 ; 		{ IP6 hop-by-hop options }
+	IPPROTO_IGMP		= 2 ; 		{ group mgmt protocol }
+	IPPROTO_GGP		= 3 ; 		{ gateway^2 (deprecated) }
+	IPPROTO_IPV4		= 4 ; 		{ IPv4 encapsulation }
+	IPPROTO_IPIP		= IPPROTO_IPV4;	{ for compatibility }
+	IPPROTO_ST		= 7 ; 		{ Stream protocol II }
+	IPPROTO_EGP		= 8 ; 		{ exterior gateway protocol }
+	IPPROTO_PIGP		= 9 ; 		{ private interior gateway }
+	IPPROTO_RCCMON		= 10; 		{ BBN RCC Monitoring }
+	IPPROTO_NVPII		= 11; 		{ network voice protocol}
+	IPPROTO_PUP		= 12; 		{ pup }
+	IPPROTO_ARGUS		= 13; 		{ Argus }
+	IPPROTO_EMCON		= 14; 		{ EMCON }
+	IPPROTO_XNET		= 15; 		{ Cross Net Debugger }
+	IPPROTO_CHAOS		= 16; 		{ Chaos}
+	IPPROTO_MUX		= 18; 		{ Multiplexing }
+	IPPROTO_MEAS		= 19; 		{ DCN Measurement Subsystems }
+	IPPROTO_HMP		= 20; 		{ Host Monitoring }
+	IPPROTO_PRM		= 21; 		{ Packet Radio Measurement }
+	IPPROTO_IDP		= 22; 		{ xns idp }
+	IPPROTO_TRUNK1		= 23; 		{ Trunk-1 }
+	IPPROTO_TRUNK2		= 24; 		{ Trunk-2 }
+	IPPROTO_LEAF1		= 25; 		{ Leaf-1 }
+	IPPROTO_LEAF2		= 26; 		{ Leaf-2 }
+	IPPROTO_RDP		= 27; 		{ Reliable Data }
+	IPPROTO_IRTP		= 28; 		{ Reliable Transaction }
+	IPPROTO_TP		= 29; 		{ tp-4 w/ class negotiation }
+	IPPROTO_BLT		= 30; 		{ Bulk Data Transfer }
+	IPPROTO_NSP		= 31; 		{ Network Services }
+	IPPROTO_INP		= 32; 		{ Merit Internodal }
+	IPPROTO_SEP		= 33; 		{ Sequential Exchange }
+	IPPROTO_3PC		= 34; 		{ Third Party Connect }
+	IPPROTO_IDPR		= 35; 		{ InterDomain Policy Routing }
+	IPPROTO_XTP		= 36; 		{ XTP }
+	IPPROTO_DDP		= 37; 		{ Datagram Delivery }
+	IPPROTO_CMTP		= 38; 		{ Control Message Transport }
+	IPPROTO_TPXX		= 39; 		{ TP++ Transport }
+	IPPROTO_IL		= 40; 		{ IL transport protocol }
+	IPPROTO_IPV6		= 41; 		{ IP6 header }
+	IPPROTO_SDRP		= 42; 		{ Source Demand Routing }
+	IPPROTO_ROUTING		= 43; 		{ IP6 routing header }
+	IPPROTO_FRAGMENT	= 44; 		{ IP6 fragmentation header }
+	IPPROTO_IDRP		= 45; 		{ InterDomain Routing}
+	IPPROTO_RSVP		= 46; 		{ resource reservation }
+	IPPROTO_GRE		= 47; 		{ General Routing Encap. }
+	IPPROTO_MHRP		= 48; 		{ Mobile Host Routing }
+	IPPROTO_BHA		= 49; 		{ BHA }
+	IPPROTO_ESP		= 50; 		{ IP6 Encap Sec. Payload }
+	IPPROTO_AH		= 51; 		{ IP6 Auth Header }
+	IPPROTO_INLSP		= 52; 		{ Integ. Net Layer Security }
+	IPPROTO_SWIPE		= 53; 		{ IP with encryption }
+	IPPROTO_NHRP		= 54; 		{ Next Hop Resolution }
+	IPPROTO_MOBILE		= 55; 		{ IP Mobility }
+	IPPROTO_TLSP		= 56; 		{ Transport Layer Security }
+	IPPROTO_SKIP		= 57; 		{ SKIP }
+	IPPROTO_ICMPV6		= 58; 		{ ICMP6 }
+	IPPROTO_NONE		= 59; 		{ IP6 no next header }
+	IPPROTO_DSTOPTS		= 60; 		{ IP6 destination option }
+	IPPROTO_AHIP		= 61; 		{ any host internal protocol }
+	IPPROTO_CFTP		= 62; 		{ CFTP }
+	IPPROTO_HELLO		= 63; 		{ "hello" routing protocol }
+	IPPROTO_SATEXPAK	= 64; 		{ SATNET/Backroom EXPAK }
+	IPPROTO_KRYPTOLAN	= 65; 		{ Kryptolan }
+	IPPROTO_RVD		= 66; 		{ Remote Virtual Disk }
+	IPPROTO_IPPC		= 67; 		{ Pluribus Packet Core }
+	IPPROTO_ADFS		= 68; 		{ Any distributed FS }
+	IPPROTO_SATMON		= 69; 		{ Satnet Monitoring }
+	IPPROTO_VISA		= 70; 		{ VISA Protocol }
+	IPPROTO_IPCV		= 71; 		{ Packet Core Utility }
+	IPPROTO_CPNX		= 72; 		{ Comp. Prot. Net. Executive }
+	IPPROTO_CPHB		= 73; 		{ Comp. Prot. HeartBeat }
+	IPPROTO_WSN		= 74; 		{ Wang Span Network }
+	IPPROTO_PVP		= 75; 		{ Packet Video Protocol }
+	IPPROTO_BRSATMON	= 76; 		{ BackRoom SATNET Monitoring }
+	IPPROTO_ND		= 77; 		{ Sun net disk proto (temp.) }
+	IPPROTO_WBMON		= 78; 		{ WIDEBAND Monitoring }
+	IPPROTO_WBEXPAK		= 79; 		{ WIDEBAND EXPAK }
+	IPPROTO_EON		= 80; 		{ ISO cnlp }
+	IPPROTO_VMTP		= 81; 		{ VMTP }
+	IPPROTO_SVMTP		= 82; 		{ Secure VMTP }
+	IPPROTO_VINES		= 83; 		{ Banyon VINES }
+	IPPROTO_TTP		= 84; 		{ TTP }
+	IPPROTO_IGP		= 85; 		{ NSFNET-IGP }
+	IPPROTO_DGP		= 86; 		{ dissimilar gateway prot. }
+	IPPROTO_TCF		= 87; 		{ TCF }
+	IPPROTO_IGRP		= 88; 		{ Cisco/GXS IGRP }
+	IPPROTO_OSPFIGP		= 89; 		{ OSPFIGP }
+	IPPROTO_SRPC		= 90; 		{ Strite RPC protocol }
+	IPPROTO_LARP		= 91; 		{ Locus Address Resoloution }
+	IPPROTO_MTP		= 92; 		{ Multicast Transport }
+	IPPROTO_AX25		= 93; 		{ AX.25 Frames }
+	IPPROTO_IPEIP		= 94; 		{ IP encapsulated in IP }
+	IPPROTO_MICP		= 95; 		{ Mobile Int.ing control }
+	IPPROTO_SCCSP		= 96; 		{ Semaphore Comm. security }
+	IPPROTO_ETHERIP		= 97; 		{ Ethernet IP encapsulation }
+	IPPROTO_ENCAP		= 98; 		{ encapsulation header }
+	IPPROTO_APES		= 99; 		{ any private encr. scheme }
+	IPPROTO_GMTP		= 100;		{ GMTP}
+	IPPROTO_IPCOMP		= 108;		{ payload compression (IPComp) }
+{ 101-254: Partly Unassigned }
+	IPPROTO_PIM		= 103;		{ Protocol Independent Mcast }
+	IPPROTO_CARP		= 112;		{ CARP }
+	IPPROTO_PGM		= 113;		{ PGM }
+	IPPROTO_PFSYNC		= 240;		{ PFSYNC }
+
+{ last return value of *_input(), meaning "all job for this pkt is done".  }
+	IPPROTO_RAW             = 255;
+	IPPROTO_MAX		= 256;
+	IPPROTO_DONE		= 257;
+
+{
+ * Options for use with [gs]etsockopt at the IP level.
+ * First word of comment is data type; bool is stored in int.
+ }
+	IP_OPTIONS		= 1 ;   { buf/ip_opts; set/get IP options }
+	IP_HDRINCL		= 2 ;   { int; header is included with data }
+	IP_TOS			= 3 ;   { int; IP type of service and preced. }
+	IP_TTL			= 4 ;   { int; IP time to live }
+	IP_RECVOPTS		= 5 ;   { bool; receive all IP opts w/dgram }
+	IP_RECVRETOPTS		= 6 ;   { bool; receive IP opts for response }
+	IP_RECVDSTADDR		= 7 ;   { bool; receive IP dst addr w/dgram }
+	IP_SENDSRCADDR		= IP_RECVDSTADDR; { cmsg_type to set src addr }
+	IP_RETOPTS		= 8 ;   { ip_opts; set/get IP options }
+	IP_MULTICAST_IF		= 9 ;   { u_char; set/get IP multicast i/f  }
+	IP_MULTICAST_TTL	= 10;   { u_char; set/get IP multicast ttl }
+	IP_MULTICAST_LOOP	= 11;   { u_char; set/get IP multicast loopback }
+	IP_ADD_MEMBERSHIP	= 12;   { ip_mreq; add an IP group membership }
+	IP_DROP_MEMBERSHIP	= 13;   { ip_mreq; drop an IP group membership }
+	IP_MULTICAST_VIF	= 14;   { set/get IP mcast virt. iface }
+	IP_RSVP_ON		= 15;   { enable RSVP in kernel }
+	IP_RSVP_OFF		= 16;   { disable RSVP in kernel }
+	IP_RSVP_VIF_ON		= 17;   { set RSVP per-vif socket }
+	IP_RSVP_VIF_OFF		= 18;   { unset RSVP per-vif socket }
+	IP_PORTRANGE		= 19;   { int; range to choose for unspec port }
+	IP_RECVIF		= 20;   { bool; receive reception if w/dgram }
+
+{ for IPSEC }
+	IP_IPSEC_POLICY		= 21;   { int; set/get security policy }
+	IP_FAITH		= 22;   { bool; accept FAITH'ed connections }
+
+	IP_ONESBCAST		= 23;   { bool: send all-ones broadcast }
+                                
+	IP_FW_TABLE_ADD		= 40;   { add entry }
+	IP_FW_TABLE_DEL		= 41;   { delete entry }
+	IP_FW_TABLE_FLUSH	= 42;   { flush table }
+	IP_FW_TABLE_GETSIZE	= 43;   { get table size }
+	IP_FW_TABLE_LIST	= 44;   { list table contents }
+
+	IP_FW_ADD		= 50;   { add a firewall rule to chain }
+	IP_FW_DEL		= 51;   { delete a firewall rule from chain }
+	IP_FW_FLUSH		= 52;   { flush firewall rule chain }
+	IP_FW_ZERO		= 53;   { clear single/all firewall counter(s) }
+	IP_FW_GET		= 54;   { get entire firewall rule chain }
+	IP_FW_RESETLOG		= 55;   { reset logging counters }
+
+	IP_DUMMYNET_CONFIGURE	= 60;   { add/configure a dummynet pipe }
+	IP_DUMMYNET_DEL		= 61;   { delete a dummynet pipe from chain }
+	IP_DUMMYNET_FLUSH	= 62;   { flush dummynet }
+	IP_DUMMYNET_GET		= 64;   { get entire dummynet pipes }
+
+	IP_RECVTTL		= 65;   { bool; receive IP TTL w/dgram }
+
+	IPV6_SOCKOPT_RESERVED1	= 3 ; { reserved for future use }
+	IPV6_UNICAST_HOPS	= 4 ; { int; IP6 hops }
+	IPV6_MULTICAST_IF	= 9 ; { u_int; setget IP6 multicast if  }
+	IPV6_MULTICAST_HOPS	= 10; { int; setget IP6 multicast hops }
+	IPV6_MULTICAST_LOOP	= 11; { u_int; setget IP6 multicast loopback }
+	IPV6_JOIN_GROUP		= 12; { ip6_mreq; join a group membership }
+	IPV6_LEAVE_GROUP	= 13; { ip6_mreq; leave a group membership }
+	IPV6_PORTRANGE		= 14; { int; range to choose for unspec port }
+
+	IPV6_PKTINFO            = 46; { in6_pktinfo; send if, src addr }	
+ 	IPV6_HOPLIMIT           = 47; { int; send hop limit }
+ 	IPV6_NEXTHOP            = 48; { sockaddr; next hop addr }
+ 	IPV6_HOPOPTS            = 49; { ip6_hbh; send hop-by-hop option }
+ 	IPV6_DSTOPTS            = 50; { ip6_dest; send dst option befor rthdr }
+ 	IPV6_RTHDR              = 51; { ip6_rthdr; send routing header }
+ 	IPV6_PKTOPTIONS         = 52; { buf/cmsghdr; set/get IPv6 options }
+  
+  { Flags for send, recv etc. }
+  MSG_OOB       = $0001;              { Process out-of-band data}
+  MSG_PEEK      = $0002;              { Peek at incoming messages }
+  MSG_DONTROUTE = $0004;              { Don't use local routing }
+  MSG_EOR       = $0008;              { End of record }
+  MSG_TRUNC     = $0010;
+  MSG_CTRUNC    = $0020;              { Control data lost before delivery }
+  MSG_WAITALL   = $0040;              { Wait for a full request }
+  MSG_DONTWAIT  = $0080;              { Non-blocking I/O }
+  MSG_EOF       = $0100;
+  MSG_NBIO      = $4000;
+  MSG_COMPAT    = $8000;
+  MSG_SOCALLBCK = $10000;
+  MSG_NOSIGNAL  = $20000;              { Do not generate SIGPIPE }
+  
+  INVALID_SOCKET = -1;
+  SOCKET_ERROR = -1;

rtl/inc/cmem.pp

@@ -31,6 +31,8 @@ Const
   LibName = 'libc';
 {$elseif defined(macos)}
   LibName = 'StdCLib';
+{$elseif defined(beos)}
+  LibName = 'root';
 {$else}
   LibName = 'c';
 {$endif}

rtl/inc/lineinfo.pp

@@ -814,9 +814,46 @@ end;
 
 {$ifdef beos}
 
-{$i osposixh.inc}
-{$i syscall.inc}
-{$i beos.inc}
+{$i ptypes.inc}
+
+{ ------------------------- Images --------------------------- }
+
+type
+  // Descriptive formats
+  status_t = Longint;
+  team_id   = Longint;
+  image_id = Longint;
+
+    { image types }
+const
+   B_APP_IMAGE     = 1;
+   B_LIBRARY_IMAGE = 2;
+   B_ADD_ON_IMAGE  = 3;
+   B_SYSTEM_IMAGE  = 4;
+
+type
+    image_info = packed record
+     id      : image_id;   
+     _type   : longint;
+     sequence: longint;
+     init_order: longint;
+     init_routine: pointer;
+     term_routine: pointer;
+     device: dev_t;
+     node: ino_t;
+     name: array[0..MAXPATHLEN-1] of char;
+{     name: string[255];
+     name2: string[255];
+     name3: string[255];
+     name4: string[255];
+     name5: string[5];
+}
+     text: pointer;
+     data: pointer;
+     text_size: longint;
+     data_size: longint;
+    end;
+
 function get_next_image_info(team: team_id; var cookie:longint; var info:image_info; size: size_t) : status_t;cdecl; external 'root' name '_get_next_image_info';
 
 function LoadElf32Beos:boolean;

rtl/unix/cwstring.pp

@@ -82,9 +82,16 @@ const
 {$ifdef solaris}
   CODESET=49;
   LC_ALL = 6;
+{$else solaris}
+{$ifdef beos}
+  {$warning check correct value for BeOS}
+  CODESET=49;
+  LC_ALL = 6; // Checked for BeOS, but 0 under Haiku...
+  ESysEILSEQ = EILSEQ;
 {$else}
 {$error lookup the value of CODESET in /usr/include/langinfo.h, and the value of LC_ALL in /usr/include/locale.h for your OS }
 // and while doing it, check if iconv is in libc, and if the symbols are prefixed with iconv_ or libiconv_
+{$endif beos}
 {$endif solaris}
 {$endif FreeBSD}
 {$endif darwin}
@@ -101,9 +108,11 @@ type
   piconv_t = ^iconv_t;
   iconv_t = pointer;
   nl_item = cint;
-
+{$ifndef beos}
 function nl_langinfo(__item:nl_item):pchar;cdecl;external libiconvname name 'nl_langinfo';
-{$ifndef bsd}
+{$endif}
+{ $ ifndef bsd}
+{$if not defined(bsd) and not defined(beos)}
 function iconv_open(__tocode:pchar; __fromcode:pchar):iconv_t;cdecl;external libiconvname name 'iconv_open';
 function iconv(__cd:iconv_t; __inbuf:ppchar; __inbytesleft:psize_t; __outbuf:ppchar; __outbytesleft:psize_t):size_t;cdecl;external libiconvname name 'iconv';
 function iconv_close(__cd:iconv_t):cint;cdecl;external libiconvname name 'iconv_close';
@@ -141,6 +150,14 @@ begin
 end;
 }
  
+{$ifdef beos}
+function nl_langinfo(__item:nl_item):pchar;
+begin
+  {$warning TODO BeOS nl_langinfo or more uptodate port of iconv...}  
+  Result := '';
+end;
+{$endif}
+
 procedure Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
   var
     outlength,

rtl/unix/initc.pp

@@ -72,6 +72,10 @@ function geterrnolocation: pcint; cdecl;external clib name '__error';
 function geterrnolocation: pcint; cdecl;external clib name '___errno';
 {$endif}
 
+{$ifdef beos}
+function geterrnolocation: pcint; cdecl;external 'root' name '_errnop';
+{$endif}
+
 function fpgetCerrno:cint;
 
 begin

rtl/unix/oscdeclh.inc

@@ -75,7 +75,11 @@ const
     function  fpmmap    (addr:pointer;len:size_t;prot:cint;flags:cint;fd:cint;ofs:off_t):pointer; cdecl; external clib name 'mmap'+suffix64bit;
     function  fpmunmap  (addr:pointer;len:size_t):cint; cdecl; external clib name 'munmap';
     function  FpIOCtl   (Handle:cint;Ndx: culong;Data: Pointer):cint; cdecl; external clib name 'ioctl';
+{$ifdef beos}
+    Function  FPSelect  (N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint; cdecl; external 'net' name 'select';
+{$else}
     Function  FPSelect  (N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint; cdecl; external clib name 'select';
+{$endif}
     function  fpgetenv  (name : pchar):pchar; cdecl; external clib name 'getenv';
     Function  FpKill       (pid : TPid; sig: cInt): cInt; cdecl; external clib name 'kill';
     Function  FpGetpid  : TPid; cdecl;external clib name 'getpid';
@@ -99,7 +103,10 @@ const
 {$linklib aio}
     Function  FPnanosleep  (const rqtp: ptimespec; rmtp: ptimespec): cint; cdecl; external 'rt' name 'nanosleep';
 {$else solaris}
+{$ifndef beos}
     Function  FPnanosleep  (const rqtp: ptimespec; rmtp: ptimespec): cint; cdecl; external clib name 'nanosleep';
+{$else}
+{$endif}
 {$endif solaris}
     function  fpNice       (N:cint):cint; cdecl; external clib name 'nice';
     Function  fpGetPriority (Which,Who:cint):cint;      cdecl; external clib name 'getpriority';
@@ -107,7 +114,11 @@ const
     Function  fpSymlink    (oldname,newname:pchar):cint;   cdecl; external clib name 'symlink';
     Function  fpReadLink           (name,linkname:pchar;maxlen:size_t):cint;  cdecl; external clib name 'readlink';
     Function  FpUmask       (cmask : TMode): TMode; cdecl; external clib name 'umask';
+{$ifndef beos}    
     function  fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint; cdecl; external clib name 'settimeofday';
+{$else}
+//    function  fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint;
+{$endif}
     function FpGetRLimit(resource : cInt; rlim : PRLimit) : cInt; cdecl; external clib name 'getrlimit';
     {$ifdef HAS_UGETRLIMIT}
     { there is no ugetrlimit libc call, just map it to the getrlimit call in these cases }

rtl/unix/sockets.pp

@@ -44,10 +44,14 @@ const
   EsockEINVAL           = EsysEINVAL;
   EsockEACCESS          = ESysEAcces;
   EsockEMFILE           = ESysEmfile;
+{$ifndef beos}
   EsockEMSGSIZE         = ESysEMsgSize;
+{$endif beos}
   EsockENOBUFS          = ESysENoBufs;
   EsockENOTCONN         = ESysENotConn;
+{$ifndef beos}  
   EsockENOTSOCK         = ESysENotSock;
+{$endif beos}
   EsockEPROTONOSUPPORT  = ESysEProtoNoSupport;
   EsockEWOULDBLOCK      = ESysEWouldBlock;
 

rtl/unix/ttyname.inc

@@ -55,6 +55,7 @@ var
                 exit;
               end;
            end
+{$ifndef beos}	 
           else if (ino_t(d^.d_fileno)=myino) and (st.st_dev=mydev) then
            begin
              fpclosedir(dirstream^);
@@ -62,6 +63,7 @@ var
              mysearch:=true;
              exit;
            end;
+{$endif}
         end;
        d:=fpReaddir(dirstream^);
      end;
@@ -73,8 +75,10 @@ begin
   TTYName:='';
   if (fpfstat(handle,st)=-1) or (isatty (handle)<>1) then
    exit;
+{$ifndef beos}	 
   mydev:=st.st_dev;
   myino:=st.st_ino;
+{$endif}
   mysearch('/dev');
 end;
 

rtl/unix/unix.pp

@@ -563,13 +563,17 @@ end;
 
 Function fpFlock (var T : text;mode : cint) : cint;
 begin
+{$ifndef beos}
   fpFlock:=fpFlock(TextRec(T).Handle,mode);
+{$endif}
 end;
 
 
 Function  fpFlock (var F : File;mode : cint) :cint;
 begin
+{$ifndef beos}
   fpFlock:=fpFlock(FileRec(F).Handle,mode);
+{$endif}
 end;
 
 Function SelectText(var T:Text;TimeOut :PTimeval):cint;
@@ -616,11 +620,13 @@ begin
      fpseterrno(ESysEBADF);
      exit;
    end;
- {$if not(defined(bsd)) and not(defined(solaris)) }
+ {$if not(defined(bsd)) and not(defined(solaris)) and not(defined(beos)) }
   p^.dd_nextoff:=fplseek(p^.dd_fd,loc,seek_set);
  {$endif}
+ {$if not(defined(beos))}
   p^.dd_size:=0;
   p^.dd_loc:=0;
+ {$endif} 
 end;
 
 function TellDir(p:pdir):TOff;
@@ -631,7 +637,9 @@ begin
      telldir:=-1;
      exit;
    end;
+ {$ifndef beos}   
   telldir:=fplseek(p^.dd_fd,0,seek_cur)
+ {$endif}     
   { We could try to use the nextoff field here, but on my 1.2.13
     kernel, this gives nothing... This may have to do with
     the readdir implementation of libc... I also didn't find any trace of

tests/test/cg/tprintf.pp

@@ -10,6 +10,11 @@ uses
 {$define TEST_EXTENDED}
 {$endif FPC_HAS_TYPE_EXTENDED}
 
+{$ifdef beos}
+  {it seems that BeOS doesn't support extended...}
+  {$undef TEST_EXTENDED}
+{$endif beos}
+
 {$ifdef WINDOWS}
 const
 {$ifdef wince}

tests/test/cg/tprintf2.pp

@@ -10,6 +10,11 @@ uses
 {$define TEST_EXTENDED}
 {$endif FPC_HAS_TYPE_EXTENDED}
 
+{$ifdef beos}
+  {it seems that BeOS doesn't support extended...}
+  {$undef TEST_EXTENDED}
+{$endif beos}
+
 {$ifdef WINDOWS}
 const
 {$ifdef wince}

tests/test/cg/tprintf3.pp

@@ -11,6 +11,11 @@ uses
 {$define TEST_EXTENDED}
 {$endif FPC_HAS_TYPE_EXTENDED}
 
+{$ifdef beos}
+  {it seems that BeOS doesn't support extended...}
+  {$undef TEST_EXTENDED}
+{$endif beos}
+
 {$ifdef WINDOWS}
   { the msvcrt.dll doesn't support extended because MS-C doesn't }
   {$undef TEST_EXTENDED}

tests/test/units/dos/tdos2.pp

@@ -245,8 +245,18 @@ Begin
  WriteLn('----------------------------------------------------------------------');
  WriteLn(' Note: GetTime should return the same value as the previous test.     ');
  WriteLn('----------------------------------------------------------------------');
+{$ifndef beos}
+ {This should be disabled under BeOS : maybe this is a BeOS bug (or a feature ?) 
+  in stime function.
+  When you set 36 hours, the time AND the date are changed
+  It seems it is a valid value under BeOS, but you have jump in the future :
+  36 hours in the future from the begining of the starting day, more or less
+  depending on your timezone.
+  For example in Paris, in summer (2 hours from GMT time zone),
+  this call set the clock to 14:<Minute>:<Second>:<Sec100> the next day !}
  SetTime(36,Minute,Second,Sec100);
  CheckDosError(0);
+{$endif}
  GetTime(Hour1,Minute1,Second1,Sec1001);
  CheckDosError(0);
  WriteLn('HH:MIN:SEC ',Hour1,':',Minute1,':',Second1);

tests/utils/redir.pp

@@ -42,6 +42,9 @@ Interface
 {$ifdef BSD}
 {$define implemented}
 {$endif}
+{$ifdef BEOS}
+{$define implemented}
+{$endif}
 {$ifdef macos}
 {$define shell_implemented}
 {$endif}