Browse Source

* rtl part of BeOS patch from Olivier Coursiere

git-svn-id: trunk@7438 -
florian 18 years ago
parent
commit
271c970e9d

+ 29 - 0
.gitattributes

@@ -4369,25 +4369,54 @@ 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/baseunix.pp svneol=native#text/plain
 rtl/beos/beos.inc svneol=native#text/plain
 rtl/beos/beos.pp svneol=native#text/plain
+rtl/beos/bethreads.pp svneol=native#text/plain
+rtl/beos/classes.pp svneol=native#text/plain
 rtl/beos/dos.pp svneol=native#text/plain
 rtl/beos/dos_beos.inc 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 -text
 rtl/beos/i386/dllprt.as -text
 rtl/beos/i386/dllprt.cpp -text
 rtl/beos/i386/func.as -text
 rtl/beos/i386/prt0.as -text
 rtl/beos/objinc.inc svneol=native#text/plain
+rtl/beos/osmacro.inc svneol=native#text/plain
 rtl/beos/osposix.inc svneol=native#text/plain
 rtl/beos/osposixh.inc svneol=native#text/plain
+rtl/beos/ossysc.inc svneol=native#text/plain
+rtl/beos/ostypes.inc svneol=native#text/plain
 rtl/beos/posix.pp 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/syscallh.inc svneol=native#text/plain
+rtl/beos/sysconst.inc svneol=native#text/plain
+rtl/beos/sysdir.inc svneol=native#text/plain
+rtl/beos/sysfile.inc svneol=native#text/plain
 rtl/beos/sysfiles.inc svneol=native#text/plain
+rtl/beos/sysheap.inc svneol=native#text/plain
+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/termio.pp svneol=native#text/plain
+rtl/beos/termios.inc svneol=native#text/plain
+rtl/beos/termiosproc.inc svneol=native#text/plain
 rtl/beos/timezone.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/beos/unxsysc.inc svneol=native#text/plain
+rtl/beos/unxsysch.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

File diff suppressed because it is too large
+ 366 - 209
rtl/beos/Makefile


+ 83 - 38
rtl/beos/Makefile.fpc

@@ -7,12 +7,15 @@ 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 objpas strings \
+#      beos \
+      errors dos objects \
+      sysconst sysutils \
+      types typinfo classes math varutils \
+      cpu mmx getopts heaptrc lineinfo variants \
+      rtlconsts syscall unix unixutil strutils termio initc crt video keyboard \
+      dateutils fmtbcd sockets dynlibs
+rsts=math varutils typinfo variants sysconst rtlconsts dateutils
 
 [require]
 nortl=y
@@ -26,8 +29,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 +59,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 +80,7 @@ SYSCPUDEPS=$(addprefix $(PROCINC)/,$(CPUINCNAMES))
 
 # Put system unit dependencies together.
 SYSDEPS=$(SYSINCDEPS) $(SYSCPUDEPS)
-
+SYSTEMUNIT=system
 
 #
 # Loaders
@@ -87,29 +102,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 system$(PPUEXT)
-        $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
 
-strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
-                   $(PROCINC)/strings.inc $(PROCINC)/stringss.inc\
-                   system$(PPUEXT)
+dateutils$(PPUEXT): $(OBJPASDIR)/dateutils.pp baseunix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+	$(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp
+
+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 \
+                 unxsysc.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 $(INC)/textrec.inc termio.pp system$(PPUEXT)
+        $(COMPILER) $(UNIXINC)/keyboard.pp $(REDIR) -dNOGPM
 
+                       
 objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
 
 #
@@ -117,12 +158,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) $(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,24 +177,24 @@ 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
 
-fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp objpas$(PPUEXT) types$(PPUEXT) system$(PPUEXT) sysutils$(PPUEXT)
-        $(COMPILER) $(OBJPASDIR)/fgl.pp
+sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+        $(COMPILER) $(OBJPASDIR)/sysconst.pp
 
-#
-# Mac Pascal Model
-#
-
-macpas$(PPUEXT) : $(INC)/macpas.pp system$(PPUEXT)
-        $(COMPILER) $(INC)/macpas.pp $(REDIR)
+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
+        
 #
 # Other system-independent RTL Units
 #
@@ -164,12 +206,15 @@ 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)
-
-
 #
 # Other system-dependent RTL Units
+#
+
+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)

+ 159 - 0
rtl/beos/baseunix.pp

@@ -0,0 +1,159 @@
+{
+    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 fStatFS(Fd:Longint;Var Info:tstatfs):cint;
+Function fpFlock (var fd : text; mode : longint) : cint; 
+Function fpFlock (var fd : File; mode : longint) : cint; 
+Function fpFlock (fd, mode : longint) : cint; 
+Function StatFS  (Path:string;Var Info:tstatfs):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 fStatFS(Fd:Longint;Var Info:tstatfs):cint;
+begin
+  {$warning TODO BeOS fStatFS implementation}  
+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 StatFS  (Path:string;Var Info:tstatfs):cint; 
+begin
+  {$warning TODO BeOS StatFS implementation}  
+end;
+
+Function  FpNanoSleep  (req : ptimespec;rem : ptimespec):cint;
+begin
+  {$warning TODO BeOS FpNanoSleep implementation}  
+end;
+
+end.

+ 519 - 0
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.

+ 52 - 0
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.

+ 349 - 133
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);
 

+ 150 - 0
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 }

+ 10 - 4
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
+	

+ 3 - 3
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

+ 6 - 6
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();
 }
 

+ 1 - 1
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
 

+ 9 - 4
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

+ 89 - 0
rtl/beos/osmacro.inc

@@ -0,0 +1,89 @@
+{
+    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 127) =0;
+end;
+
+function wexitstatus(status : cint): cint;
+begin
+ wexitstatus:=status shr 8;
+end;
+
+function wstopsig(status : cint): cint;
+begin
+ wstopsig:=status shr 8;
+end;
+
+const wstopped=127;
+
+function wifsignaled(status : cint): boolean;
+begin
+ wifsignaled:=((status and 127)<>wstopped) and ((status and 127)<>0);
+end;
+
+function wtermsig(status : cint):cint;
+
+begin
+ wtermsig:=cint(status and 127);
+end;
+

+ 29 - 27
rtl/beos/osposixh.inc

@@ -63,29 +63,29 @@ TYPE
   { 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_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                   }
+    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) }
+	 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;
@@ -119,17 +119,21 @@ CONST
     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. }
+    O_RDONLY    =  0;	{ Open read-only.  }
+    O_WRONLY    =  1;	{ Open write-only. }
+    O_RDWR      =  2;	{ Open read/write. }
+    O_RWMASK    =  3; { Mask to get open mode. }
     { 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. }
+    O_CREAT     =$0200;	{ Create file if it doesn't exist.  }
+    O_TEXT      =$4000;
+    O_BINARY    =$8000;
+    
+    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.                 }
+    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   }
@@ -177,5 +181,3 @@ CONST
     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 }
-
-

+ 1060 - 0
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;
+*)
+

+ 365 - 0
rtl/beos/ostypes.inc

@@ -0,0 +1,365 @@
+{
+    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  = 61440;
+  S_IFIFO = 4096;
+  S_IFCHR = 8192;
+  S_IFDIR = 16384;
+  S_IFBLK = 24576;
+  S_IFREG = 32768;
+  S_IFLNK = 40960;
+  S_IFSOCK= 49152;
+  S_IFWHT = 57344;
+  S_ISVTX = 512;
+
+//      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      =  $800;        { Fail if file already exists.      }
+    O_TRUNC     =  $400;        { Truncate file to zero length.     }
+    O_NOCTTY    = $8000;        { Don't assign a controlling terminal. }
+    { File status flags for `open' and `fcntl'.  }
+    O_APPEND    =     8;        { Writes append to the file.        }
+    O_NONBLOCK  =     4;        { 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;

+ 210 - 0
rtl/beos/ptypes.inc

@@ -0,0 +1,210 @@
+{
+    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
+  TStatfs = packed record
+    spare2,            { place holder}
+    bsize,             { fundamental block size}
+    iosize,            { optimal block size }
+    blocks,            {  total blocks}
+    bfree,             { blocks free}
+    bavail,            { block available for mortal users}
+    files,             { Total file nodes}
+    ffree          : longint;    { file nodes free}
+    fsid           : array[0..1] of longint;
+    fowner         : longint; {mounter uid}
+    ftype          : longint;
+    fflags         : longint; {copy of mount flags}
+    spare          : array [0..1] of longint; { For later use }
+    fstypename     : array[0..15] of char;
+    mountpoint     : array[0..89] of char;
+    mnfromname     : array[0..89] of char;
+  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;
+
+    size_t   = cuint32;         { as definied in the C standard}
+    TSize    = size_t;
+    pSize    = ^size_t;		
+
+    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;
+    
+
+    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;
+
+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;

+ 49 - 0
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}
+

+ 159 - 0
rtl/beos/signal.inc

@@ -0,0 +1,159 @@
+{
+    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 
+  // sigset_t = clong; ??? BeOS ? should be this...
+  sigset_t = array[0..3] of Longint;  // here for compiling...
+
+    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: SigContextRec;someptr:pointer);cdecl;
+
+  Sigset=sigset_t;
+  TSigset=sigset_t;
+  PSigSet = ^SigSet;
+
+  SigActionRec = packed record
+//    Handler  : record
+    sa_handler : sigActionHandler;
+//      case byte of
+//        0: (Sh: SignalHandler);
+//        1: (Sa: TSigAction);
+//      end;
+    Sa_Flags    : Longint;
+    Sa_Mask     : SigSet;
+  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.
+}
+

+ 38 - 0
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;

+ 30 - 22
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)
+
+}

+ 55 - 0
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;

+ 91 - 0
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;
+}

+ 129 - 0
rtl/beos/sysdir.inc

@@ -0,0 +1,129 @@
+Procedure MkDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  {$warning TODO BeOS MkDir implementation}
+{  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  If Fpmkdir(@buffer, MODE_MKDIR)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+}
+End;
+
+
+Procedure RmDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  {$warning TODO BeOS RmDir implementation}
+{  if (s = '.') then
+    InOutRes := 16;
+  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  If Fprmdir(@buffer)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+}
+End;
+
+
+Procedure ChDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  {$warning TODO BeOS ChDir implementation}
+{  If (s='') or (InOutRes <> 0) then
+   exit;
+  Move(s[1], Buffer, Length(s));
+  Buffer[Length(s)] := #0;
+  If Fpchdir(@buffer)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+  { file not exists is path not found under tp7 }
+  if InOutRes=2 then
+   InOutRes:=3;
+}
+End;
+
+{ // $define usegetcwd}
+
+procedure getdir(drivenr : byte;var dir : shortstring);
+var
+{$ifndef usegetcwd}
+  cwdinfo      : stat;
+  rootinfo     : stat;
+  thedir,dummy : string[255];
+  dirstream    : pdir;
+  d            : pdirent;
+  name         : string[255];
+  thisdir      : stat;
+{$endif}
+  tmp          : string[255];
+
+begin
+{$ifdef usegetcwd}
+ Fpgetcwd(@tmp[1],4096);
+ dir:=tmp;
+{$else}
+  dir:='';
+  thedir:='';
+  dummy:='';
+
+  { get root directory information }
+  tmp := '/'+#0;
+  if Fpstat(@tmp[1],rootinfo)<0 then
+    Exit;
+  repeat
+    tmp := dummy+'.'+#0;
+    { get current directory information }
+    if Fpstat(@tmp[1],cwdinfo)<0 then
+      Exit;
+    tmp:=dummy+'..'+#0;
+    { open directory stream }
+    { try to find the current inode number of the cwd }
+    dirstream:=Fpopendir(@tmp[1]);
+    if dirstream=nil then
+       exit;
+    repeat
+      name:='';
+      d:=Fpreaddir(dirstream);
+      { no more entries to read ... }
+      if not assigned(d) then
+        break;
+      tmp:=dummy+'../'+strpas(d^.d_name) + #0;
+      if (Fpstat(@tmp[1],thisdir)=0) then
+       begin
+         { found the entry for this directory name }
+         if (cwdinfo.dev=thisdir.dev) and (cwdinfo.ino=thisdir.ino) then
+          begin
+            { are the filenames of type '.' or '..' ? }
+            { then do not set the name.               }
+            if (not ((d^.d_name[0]='.') and ((d^.d_name[1]=#0) or
+                    ((d^.d_name[1]='.') and (d^.d_name[2]=#0))))) then
+              name:='/'+strpas(d^.d_name);
+          end;
+       end;
+    until (name<>'');
+    if Fpclosedir(dirstream)<0 then
+      Exit;
+    thedir:=name+thedir;
+    dummy:=dummy+'../';
+    if ((cwdinfo.dev=rootinfo.dev) and (cwdinfo.ino=rootinfo.ino)) then
+      begin
+        if thedir='' then
+          dir:='/'
+        else
+          dir:=thedir;
+        exit;
+      end;
+  until false;
+ {$endif}
+end;

+ 235 - 0
rtl/beos/sysfile.inc

@@ -0,0 +1,235 @@
+{
+    This file is part of the Free Pascal run time library.
+
+    Main OS dependant body of the system unit, loosely modelled
+    after POSIX.  *BSD version (Linux version is near identical)
+
+    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.
+
+ **********************************************************************}
+Procedure Do_Close(Handle:thandle);
+Begin
+  Fpclose(cint(Handle));
+End;
+
+Procedure Do_Erase(p:pchar);
+var
+ fileinfo : stat;
+Begin
+  { verify if the filename is actually a directory }
+  { if so return error and do nothing, as defined  }
+  { by POSIX                                       }
+  if Fpstat(p,fileinfo)<0 then
+   begin
+     Errno2Inoutres;
+     exit;
+   end;
+  if FpS_ISDIR(fileinfo.st_mode) then
+   begin
+     InOutRes := 2;
+     exit;
+   end;
+  if Fpunlink(p)<0 then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+{ truncate at a given position }
+procedure do_truncate (handle:thandle;fpos:longint);
+begin
+  { should be simulated in cases where it is not }
+  { available.                                   }
+  If Fpftruncate(handle,fpos)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+end;
+
+
+
+Procedure Do_Rename(p1,p2:pchar);
+Begin
+  If Fprename(p1,p2)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+
+Function Do_Write(Handle:thandle;Addr:Pointer;Len:Longint):longint;
+
+var j : cint;
+Begin
+  repeat
+    Do_Write:=Fpwrite(Handle,addr,len);
+    j:=geterrno;
+  until (do_write<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
+  If Do_Write<0 Then
+   Begin
+    Errno2InOutRes;
+    Do_Write:=0;
+   End
+  else
+   InOutRes:=0;
+End;
+
+
+Function Do_Read(Handle:thandle;Addr:Pointer;Len:Longint):Longint;
+
+var j:cint;
+
+Begin
+  repeat
+    Do_Read:=Fpread(Handle,addr,len);
+    j:=geterrno;
+  until (do_read<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
+  If Do_Read<0 Then
+   Begin
+    Errno2InOutRes;
+    Do_Read:=0;
+   End
+  else
+   InOutRes:=0;
+End;
+
+function Do_FilePos(Handle: thandle):longint;
+Begin
+  do_FilePos:=Fplseek(Handle, 0, SEEK_CUR);
+  If Do_FilePos<0 Then
+    Errno2InOutRes
+  else
+   InOutRes:=0;
+End;
+
+Procedure Do_Seek(Handle:thandle;Pos:Longint);
+Begin
+  If Fplseek(Handle, pos, SEEK_SET)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+Function Do_SeekEnd(Handle:thandle): Longint;
+begin
+  Do_SeekEnd:=Fplseek(Handle,0,SEEK_END);
+  If Do_SeekEnd<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+end;
+
+Function Do_FileSize(Handle:thandle): Longint;
+var
+  Info : Stat;
+  Ret  : Longint;
+Begin
+  Ret:=Fpfstat(handle,info);
+  If Ret=0 Then
+   Do_FileSize:=Info.st_size
+  else
+   Do_FileSize:=0;
+  If Ret<0 Then
+   Errno2InOutRes
+  Else
+   InOutRes:=0;
+End;
+
+Procedure Do_Open(var f;p:pchar;flags:longint);
+{
+  FileRec and textrec have both Handle and mode as the first items so
+  they could use the same routine for opening/creating.
+  when (flags and $100)   the file will be append
+  when (flags and $1000)  the file will be truncate/rewritten
+  when (flags and $10000) there is no check for close (needed for textfiles)
+}
+const
+  { read/write permission for everyone }
+  MODE_OPEN = S_IWUSR OR S_IRUSR OR
+              S_IWGRP OR S_IRGRP OR
+              S_IWOTH OR S_IROTH;
+var
+  oflags : cint;
+Begin
+{ close first if opened }
+  if ((flags and $10000)=0) then
+   begin
+     case FileRec(f).mode of
+      fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
+      fmclosed : ;
+     else
+      begin
+        inoutres:=102; {not assigned}
+        exit;
+      end;
+     end;
+   end;
+{ reset file Handle }
+  FileRec(f).Handle:=UnusedHandle;
+{ We do the conversion of filemodes here, concentrated on 1 place }
+  case (flags and 3) of
+   0 : begin
+         oflags :=O_RDONLY;
+         FileRec(f).mode:=fminput;
+       end;
+   1 : begin
+         oflags :=O_WRONLY;
+         FileRec(f).mode:=fmoutput;
+       end;
+   2 : begin
+         oflags :=O_RDWR;
+         FileRec(f).mode:=fminout;
+       end;
+  end;
+  if (flags and $1000)=$1000 then
+   oflags:=oflags or (O_CREAT or O_TRUNC)
+  else
+   if (flags and $100)=$100 then
+    oflags:=oflags or (O_APPEND);
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case FileRec(f).mode of
+       fminput :
+         FileRec(f).Handle:=StdInputHandle;
+       fminout, { this is set by rewrite }
+       fmoutput :
+         FileRec(f).Handle:=StdOutputHandle;
+       fmappend :
+         begin
+           FileRec(f).Handle:=StdOutputHandle;
+           FileRec(f).mode:=fmoutput; {fool fmappend}
+         end;
+     end;
+     exit;
+   end;
+{ real open call }
+  FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
+  if (FileRec(f).Handle<0) and
+    (getErrNo=ESysEROFS) and ((OFlags and O_RDWR)<>0) then
+   begin
+     Oflags:=Oflags and not(O_RDWR);
+     FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
+   end;
+  If Filerec(f).Handle<0 Then
+   Errno2Inoutres
+  else
+   InOutRes:=0;
+End;
+
+
+{
+  $Log: sysfile.inc,v $
+  Revision 1.1  2005/02/07 22:04:55  peter
+    * moved to unix
+
+  Revision 1.1  2005/02/06 13:06:20  peter
+    * moved file and dir functions to sysfile/sysdir
+    * win32 thread in systemunit
+
+}

+ 53 - 0
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: ptrint): 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: ptrint);
+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
+
+}
+

+ 47 - 0
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

+ 146 - 0
rtl/beos/sysos.inc

@@ -0,0 +1,146 @@
+{
+    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;
+  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;

+ 35 - 0
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;

+ 404 - 309
rtl/beos/system.pp

@@ -1,82 +1,34 @@
-{
-    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 }
-
-{$I systemh.inc}
+// Was needed too bootstrap with our old 2.1 fpc for BeOS
+// to define real
+{ $define VER2_0}
 
-type
-  THandle = longint;
-  TThreadID = THandle;
-  
-{ include heap support headers }
+{$define FPC_IS_SYSTEM}
 
-{$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';
+//begin
+//end;
 
-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';
+{ OS independant parts}
 
 {$I system.inc}
 
-
 {*****************************************************************************
                          System Dependent Exit code
 *****************************************************************************}
@@ -89,96 +41,143 @@ 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;
+//  Sbrk:=nil;
+end;*)
 
+function sys_resize_area (handle:cardinal; size:longint):longint; cdecl; external name 'sys_resize_area';
 
-{ include standard heap management }
-{$I heap.inc}
+//function sbrk2 (size : longint):pointer; cdecl; external name 'sbrk';
 
+{ 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;
+  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;
+  Sbrk:=nil;
+*)
+//end;
 
 {****************************************************************************
                         Low level File Routines
@@ -186,50 +185,38 @@ end;
  ****************************************************************************}
 
 
-
+(*
 { 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);
+  InOutRes := fpclose(handle);
 end;
 
 
 procedure do_erase(p : pchar);
 begin
-  if sys_unlink($FF000000,p)<>0 then InOutRes:=1
+  if fpunlink(p)<>0 then InOutRes:=1
   else InOutRes:=0;
 end;
 
 procedure do_rename(p1,p2 : pchar);
 begin
-  InOutRes:=sys_rename($FF000000,p1,$FF000000,p2);
+  InOutRes := fprename(p1, p2);
 end;
 
-function do_write(h:longint;addr:pointer;len : longint) : longint;
+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);
+  do_write := fpwrite (h,addr,len);
   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;
+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);
+  do_read := fpread (h,addr,len);
   if (do_read<0) then begin
     InOutRes:=do_read;
     do_read:=0;
@@ -238,7 +225,7 @@ end;
 
 function do_filepos(handle : longint) : longint;
 begin
-  do_filepos:=sys_lseek(handle,0,1); {1=SEEK_CUR}
+  do_filepos := fplseek(handle,0,1); {1=SEEK_CUR}
   if (do_filepos<0) then begin
     InOutRes:=do_filepos;
     do_filepos:=0;
@@ -247,13 +234,13 @@ end;
 
 procedure do_seek(handle,pos : longint);
 begin
-  InOutRes:=sys_lseek(handle,pos,0);
+  InOutRes := fplseek(handle,pos,0);
   if InOutRes>0 then InOutRes:=0;
 end;
 
 function do_seekend(handle:longint):longint;
 begin
-  do_seekend:=sys_lseek (handle,0,2); {2=SEEK_END}
+  do_seekend := fplseek (handle,0,2); {2=SEEK_END}
   if do_seekend<0 then begin
     InOutRes:=do_seekend;
     do_seekend:=0;
@@ -263,19 +250,19 @@ end;
 function do_filesize(handle : longint) : longint;
 var cur:longint;
 begin
-  cur:=sys_lseek (handle,0,1); {1=SEEK_CUR}
+  cur := fplseek (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}
+  do_filesize := fplseek (handle,0,2); {2=SEEK_END}
   if do_filesize<0 then begin
     InOutRes:=do_filesize;
     do_filesize:=0;
     exit;
   end;
-  cur:=sys_lseek (handle,cur,0); {0=SEEK_POS}
+  cur := fplseek (handle,cur,0); {0=SEEK_POS}
   if cur<0 then begin
     InOutRes:=cur;
     do_filesize:=0;
@@ -289,7 +276,7 @@ begin
   InOutRes:=1;
 end;
 
-procedure do_open(var f;p:pchar;flags:longint);
+(*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.
@@ -299,25 +286,67 @@ procedure do_open(var f;p:pchar;flags:longint);
 }
 var m:longint;
     mode,h:longint;
+    s : string;
 begin
+//  WriteLn('do_open; -> ');
+//  WriteLn('p : ' + p);
+//  Str(flags, s);
+//  WriteLn('flags : ' + s);
 {  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;
+  case (flags and 3) of
+        0: 
+          begin 
+//            WriteLn('0');
+            m:=m or O_RDONLY; 
+            mode:=fminput;  
+          end;
+        1: 
+          begin 
+//            WriteLn('1');          
+            m:=m or O_WRONLY or O_CREAT; 
+            mode:=fmoutput;
+          end;
+        2: 
+          begin 
+//            WriteLn('2');          
+            m:=m or O_RDWR or O_CREAT; 
+            mode:=fminout; 
+          end;
+        3: 
+          begin 
+//            WriteLn('3');          
+            m:=m or O_APPEND; 
+            mode:=fmAppend; 
+          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 $100)<>0 then m:=m or O_APPEND;
+{  if (flags and $200)<>0 then 
+  begin
+    WriteLn('Création');
+    m := m or O_CREAT;
+  end;
+}
+
+
+//  if (flags and $1000)<>0 then m:=m {or O_TRUNC} or O_CREAT;
+//  m := m or O_CREAT;
+
+//  if (flags and $10000)<>0 then m:=m or O_TEXT else m:=m or O_BINARY;
 
-{  if (flags and $10000)<>0 then m:=m or O_TEXT else m:=m or O_BINARY;}
+  h := fpopen(p, m, mode);
+  Str(mode, s);
+//  WriteLn('mode : ' + s);
 
-  h:=sys_open($FF000000,p,m,0,0);
+//  Str(m, s);
+//  WriteLn('m : ' + s);
 
+//  Str(h, s);
+//  WriteLn('h : ' + s);
   if h<0 then InOutRes:=h
   else InOutRes:=0;
 
@@ -325,174 +354,205 @@ begin
     FileRec(f).handle:=h;
     FileRec(f).mode:=mode;
   end;
-end;
+end;*)
 
-function do_isdevice(handle:THandle):boolean;
+const
+     { Default creation mode for directories and files }
+
+     { read/write permission for everyone }
+     MODE_OPEN = S_IWUSR OR S_IRUSR OR
+                 S_IWGRP OR S_IRGRP OR
+                 S_IWOTH OR S_IROTH;
+     { read/write search permission for everyone }
+     MODE_MKDIR = MODE_OPEN OR
+                 S_IXUSR OR S_IXGRP OR S_IXOTH;
+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
+  oflags : cint;
+Begin
+{ close first if opened }
+  if ((flags and $10000)=0) then
+   begin
+     case FileRec(f).mode of
+      fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
+      fmclosed : ;
+     else
+      begin
+        inoutres:=102; {not assigned}
+        exit;
+      end;
+     end;
+   end;
+{ reset file Handle }
+  FileRec(f).Handle:=UnusedHandle;
+{ We do the conversion of filemodes here, concentrated on 1 place }
+  case (flags and 3) of
+   0 : begin
+         oflags :=O_RDONLY;
+         FileRec(f).mode:=fminput;
+       end;
+   1 : begin
+         oflags :=O_WRONLY;
+         FileRec(f).mode:=fmoutput;
+       end;
+   2 : begin
+         oflags :=O_RDWR;
+         FileRec(f).mode:=fminout;
+       end;
+  end;
+  if (flags and $1000)=$1000 then
+   oflags:=oflags or (O_CREAT or O_TRUNC)
+  else
+   if (flags and $100)=$100 then
+    oflags:=oflags or (O_APPEND);
+{ empty name is special }
+  if p[0]=#0 then
+   begin
+     case FileRec(f).mode of
+       fminput :
+         FileRec(f).Handle:=StdInputHandle;
+       fminout, { this is set by rewrite }
+       fmoutput :
+         FileRec(f).Handle:=StdOutputHandle;
+       fmappend :
+         begin
+           FileRec(f).Handle:=StdOutputHandle;
+           FileRec(f).mode:=fmoutput; {fool fmappend}
+         end;
+     end;
+     exit;
+   end;
+{ real open call }
+  FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
+  if (FileRec(f).Handle<0) and
+     (getErrNo=ESysEROFS) and
+     ((OFlags and O_RDWR)<>0) then
+   begin
+     Oflags:=Oflags and not(O_RDWR);
+     FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
+   end;
+  If Filerec(f).Handle<0 Then
+   InOutRes := 2
+  else
+   InOutRes:=0;
+end;
+*)
+{function do_isdevice(handle:longint):boolean;
 begin
   do_isdevice:=false;
   InOutRes:=0;
 end;
+}
 
+{ $I text.inc}
 
 {*****************************************************************************
                            UnTyped File Handling
 *****************************************************************************}
 
-{$i file.inc}
-
-{*****************************************************************************
-                           Typed File Handling
-*****************************************************************************}
 
-{$i typefile.inc}
+{ $i file.inc}
 
 {*****************************************************************************
-                           Text File Handling
+                           Typed File Handling
 *****************************************************************************}
 
-{$i text.inc}
+{ $i typefile.inc}
 
 {*****************************************************************************
-                           Directory Handling
+                       Misc. System Dependent Functions
 *****************************************************************************}
-procedure mkdir(const s : string);[IOCheck];
-var t:string;
-begin
-  t:=s+#0;
-  InOutRes:=sys_mkdir ($FF000000,@t[1],493);
-end;
 
-procedure rmdir(const s : string);[IOCheck];
-var t:string;
-begin
-  t:=s+#0;
-  InOutRes:=sys_rmdir ($FF000000,@t[1]);
-end;
+Function ParamCount: Longint;
+var
+  s : string;
+Begin
+  ParamCount := 0;
+  Paramcount:=argc - 1;
+End;
 
-procedure chdir(const s : string);[IOCheck];
-var t:string;
-begin
-  t:=s+#0;
-  InOutRes:=sys_chdir ($FF000000,@t[1]);
-end;
+ { variable where full path and filename and executable is stored }
+ { is setup by the startup of the system unit.                    }
+var
+ execpathstr : shortstring;
 
-{*****************************************************************************
-                             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;
+{$ifdef FPC_USE_LIBC}
 
-    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;
+// 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 sys_stat (a:cardinal;path:pchar;info:pstat;n:longint):longint; cdecl; external name 'sys_stat';
+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 FStat(Path:String;Var Info:stat):Boolean;
-{
-  Get all information on a file, and return it in Info.
-}
-var tmp:string;
-var p:pchar;
+function get_image_info(image : image_id; var info : image_info) : status_t;
 begin
-  tmp:=path+#0;
-  p:=@tmp[1];
-  FStat:=(sys_stat($FF000000,p,@Info,0)=0);
+  Result := _get_image_info(image, info, SizeOf(info));
 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 get_next_image_info(team : team_id; var cookie : Longint; var info : image_info) : status_t;
 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;
-  end;
-
-  err:=0;
+  Result := _get_next_image_info(team, cookie, info, SizeOf(info));
 end;
 
+{$endif}
 
-function getdir2:string;
-var tmp:string;
-    info:stat;
-    info2:stat;
-    fd:longint;
-    name:string;
-        cur:string;
-        res:string;
-        err:longint;
+{ this routine sets up the paramstr(0) string at startup }
+procedure setupexecname;
+var
+ cookie: longint;
+ image : image_info;
+ index : byte;
+ s : string;
 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;
+  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;
 
-procedure getdir(drivenr : byte;var dir : shortstring);
+function paramstr(l: longint) : string;
+var
+  s: string;
+  s1: string;
 begin
-  drivenr:=0;
-  dir:=getdir2;
+   
+  { 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;
 end;
 
+Procedure Randomize;
+Begin
+  randseed:=longint(Fptime(nil));
+End;
 
 function GetProcessID:SizeUInt;
 begin
@@ -500,7 +560,6 @@ begin
  GetProcessID := 1;
 end;
 
-
 {*****************************************************************************
                          SystemUnit Initialization
 *****************************************************************************}
@@ -509,12 +568,8 @@ 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 +579,67 @@ begin
   result := stklen;
 end;
 
+var
+  s : string;
 begin
+  IsConsole := TRUE;
+  IsLibrary := FALSE;
+  StackLength := CheckInitialStkLen(InitialStkLen);
+  StackBottom := Sptr - StackLength;
+  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;
-  initwidestringmanager;
+{$endif HASVARIANT}
+  setupexecname;
 end.

+ 41 - 0
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.

+ 396 - 0
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));
+

+ 130 - 0
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;
+

+ 610 - 0
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}
+

+ 110 - 0
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;
+

+ 77 - 0
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 }

+ 88 - 0
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;

+ 351 - 0
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;

+ 163 - 0
rtl/beos/unxsysc.inc

@@ -0,0 +1,163 @@
+{
+   This file is part of the Free Pascal run time library.
+   Copyright (c) 2003 Marco van de Voort
+   member of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+function fpNice(N:cint):cint;
+{
+  Set process priority. A positive N means a lower priority.
+  A negative N decreases priority.
+
+Doesn't exist in BSD. Linux emu uses setpriority in a construct as below:
+}
+
+begin
+  fpNice:=fpSetPriority(Prio_Process,0,N);
+end;
+
+
+Function fpGetPriority(Which,Who:cint):cint;
+{
+  Get Priority of process, process group, or user.
+   Which : selects what kind of priority is used.
+           can be one of the following predefined Constants :
+              Prio_User.
+              Prio_PGrp.
+              Prio_Process.
+   Who : depending on which, this is , respectively :
+              Uid
+              Pid
+              Process Group id
+   Errors are reported in linuxerror _only_. (priority can be negative)
+}
+begin
+  if (which<prio_process) or (which>prio_user) then
+   begin
+     { We can save an interrupt here }
+     fpgetpriority:=0;
+     fpseterrno(ESysEinval);
+   end
+  else
+   begin
+    {$warning TODO BeOS fpGetPriority implementation}      
+//     fpGetPriority:=do_syscall(syscall_nr_GetPriority,which,who);
+   end;
+end;
+
+
+Function fpSetPriority(Which,Who,What:cint):cint;
+{
+ Set Priority of process, process group, or user.
+   Which : selects what kind of priority is used.
+           can be one of the following predefined Constants :
+              Prio_User.
+              Prio_PGrp.
+              Prio_Process.
+   Who : depending on value of which, this is, respectively :
+              Uid
+              Pid
+              Process Group id
+   what : A number between -20 and 20. -20 is most favorable, 20 least.
+          0 is the default.
+}
+begin
+  if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
+   fpseterrno(ESyseinval)  { We can save an interrupt here }
+  else
+   begin
+    {$warning TODO BeOS fpSetPriority implementation}   
+//     fpSetPriority:=do_syscall(Syscall_nr_Setpriority,which,who,what);
+   end;
+end;
+
+Function fpLstat(path:pchar;Info:pstat):cint;
+{
+  Get all information on a link (the link itself), and return it in info.
+}
+
+begin
+  {$warning TODO BeOS fpLstat implementation}
+// fpLStat:=do_syscall(syscall_nr_lstat,TSysParam(path),TSysParam(info));
+end;
+
+
+Function fpLstat(Filename: PathStr;Info:pstat):cint;
+{
+  Get all information on a link (the link itself), and return it in info.
+}
+
+begin
+  {$warning TODO BeOS fpLstat implementation}
+ FileName:=FileName+#0;
+// fpLStat:=do_syscall(syscall_nr_lstat,TSysParam(@filename[1]),TSysParam(info));
+end;
+
+Function fpSymlink(oldname,newname:pchar):cint;
+{
+  We need this for erase
+}
+
+begin
+  {$warning TODO BeOS fpSymlink implementation}
+// fpsymlink:=do_syscall(syscall_nr_symlink,TSysParam(oldname),TSysParam(newname));
+end;
+
+Function fpReadLink(name,linkname:pchar;maxlen:cint):cint;
+
+begin
+  {$warning TODO BeOS fsync implementation}
+//  fpreadlink:=do_syscall(syscall_nr_readlink, TSysParam(name),TSysParam(linkname),maxlen);
+end;
+
+{$ifndef FPC_USE_LIBC}
+Function  fsync (fd : cint) : cint;
+
+begin
+  {$warning TODO BeOS fsync implementation}
+//  fsync:=do_syscall(syscall_nr_fsync,fd);
+end;
+
+
+
+Function  fpFlock (fd,mode : longint) : cint;
+
+begin
+  {$warning TODO BeOS fpFlock implementation}
+// Flock:=do_syscall(syscall_nr_flock,fd,mode);
+end;
+
+
+Function fStatFS(Fd:Longint;Var Info:tstatfs):cint;
+{
+  Get all information on a fileSystem, and return it in Info.
+  Fd is the file descriptor of a file/directory on the fileSystem
+  you wish to investigate.
+}
+
+begin
+  {$warning TODO BeOS fStatFS implementation}
+// fStatFS:=do_syscall(syscall_nr_fstatfs,fd,longint(@info));
+end;
+
+Function StatFS(path:pchar;Var Info:tstatfs):cint;
+{
+  Get all information on a fileSystem, and return it in Info.
+  Fd is the file descriptor of a file/directory on the fileSystem
+  you wish to investigate.
+}
+
+begin
+  {$warning TODO BeOS StatFS implementation}
+// StatFS:=do_syscall(syscall_nr_statfs,longint(path),longint(@info));
+end;
+
+{$endif}

+ 24 - 0
rtl/beos/unxsysch.inc

@@ -0,0 +1,24 @@
+{
+   This file is part of the Free Pascal run time library.
+   Copyright (c) 2003 Marco van de Voort
+   member of the Free Pascal development team.
+
+   See the file COPYING.FPC, included in this distribution,
+   for details about the copyright.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY;without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+**********************************************************************}
+
+function fpNice(N:cint):cint;
+Function fpGetPriority(Which,Who:cint):cint;
+Function fpSetPriority(Which,Who,What:cint):cint;
+Function fpLstat(path:pchar;Info:pstat):cint;
+Function fpLstat(Filename: PathStr;Info:pstat):cint;
+Function fpSymlink(oldname,newname:pchar):cint;
+Function fpReadLink(name,linkname:pchar;maxlen:cint):cint;
+Function Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_t):pointer; external name  'FPC_SYSC_MMAP';
+Function Fpmunmap(start:pointer;len:size_t):cint;  external name 'FPC_SYSC_MUNMAP';
+function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; external name 'FPC_SYSC_GETTIMEOFDAY';

Some files were not shown because too many files changed in this diff