Преглед изворни кода

* FreeBSD compiles now with baseunix mods.

marco пре 22 година
родитељ
комит
832a1bcb96

+ 48 - 0
rtl/bsd/baseunix.pp

@@ -0,0 +1,48 @@
+{
+    $Id$
+    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
+{$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)
+
+{$i errno.inc}		{ Error numbers }
+{$i bunxtype.inc}	{ Types }
+{$i bunxh.inc}		{ Functions}
+
+implementation
+
+{$i bunxmain.inc}	{ implementation}
+{$i bunxovl.inc}	{ redefs and overloads implementation}
+
+end.
+
+{
+  $Log$
+  Revision 1.1  2003-01-05 19:01:28  marco
+   * FreeBSD compiles now with baseunix mods.
+
+  Revision 1.1  2002/12/18 16:44:09  marco
+   * more new RTL
+
+  Revision 1.2  2002/11/14 12:17:28  marco
+   * for now.
+
+}

+ 7 - 4
rtl/bsd/bsdsysc.inc

@@ -189,7 +189,7 @@ begin
 { Is it a dir ? }
   if not((st.st_mode and $f000)=$4000)then
    begin
-     errno:=sys_enotdir;
+     errno:=ESysENOTDIR;
      exit
    end;
 { Open it}
@@ -541,12 +541,12 @@ begin
     Begin
       if (_size=0) Then
         Begin
-          seterrno(sys_EINVAL);
+          seterrno(ESysEINVAL);
 	  exit(nil);
         End; 
       if (_size=1) Then
         Begin
-          seterrno(sys_ERANGE);
+          seterrno(ESysERANGE);
 	  exit(nil);
         End; 
       ept:=pt+_size;
@@ -574,7 +574,10 @@ end;
 
 {
  $Log$
- Revision 1.9  2002-11-13 18:15:08  marco
+ Revision 1.10  2003-01-05 19:01:28  marco
+  * FreeBSD compiles now with baseunix mods.
+
+ Revision 1.9  2002/11/13 18:15:08  marco
   * sigset functions more flexible, small changes to sys_time
 
  Revision 1.8  2002/10/27 17:21:29  marco

+ 504 - 0
rtl/bsd/bunxfunc.inc

@@ -0,0 +1,504 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2002 by Marco van de Voort
+
+    Calls needed for the POSIX unit, but not for system.
+    Some calls that can be used for both Linux and *BSD will be
+    moved to a /unix/ includedfile later.
+
+    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 syscallh.inc}	// do_syscall declarations themselves
+{$i sysnr.inc}		// syscall numbers.
+{$i ossysch.inc}	// external interface to syscalls in system unit.
+{$i genfuncs.inc}	// generic calls. (like getenv)
+
+Const 			// OS specific parameters for general sigset behaviour
+   SIG_MAXSIG      = 128;	// highest signal version
+   wordsinsigset   = 4;		// words in sigset_t
+   ln2bitsinword   = 5;         { 32bit : ln(32)/ln(2)=5 } 
+
+   ln2bitmask	   = 2 shl ln2bitsinword - 1;
+
+{$I gensigset.inc}     // general sigset funcs implementation. 
+
+{$ifndef ver1_0}
+Function  FpSigProcMask(how : cInt; Const nset : TSigSet; var oset : TSigSet): cInt; external name 'FPC_SYSC_SIGPROGMASK';
+{$endif}
+
+Function FPKill(Pid:pid_t;Sig:cint):cint;
+{
+  Send signal 'sig' to a process, or a group of processes.
+  If Pid >  0 then the signal is sent to pid
+     pid=-1                         to all processes except process 1
+     pid < -1                         to process group -pid
+  Return value is zero, except for case three, where the return value
+  is the number of processes to which the signal was sent.
+}
+
+begin
+ FPkill:=do_syscall(syscall_nr_kill,pid,sig);
+// if kill<0 THEN
+//  Kill:=0;
+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
+  FPsigprocmask:=do_syscall(syscall_nr_sigprocmask,longint(how),longint(nset),longint(oset));
+end;
+
+Function FPSigPending(var nset: sigset_t):cint;
+{
+  Allows examination of pending signals. The signal mask of pending
+  signals is set in SSet
+}
+begin
+  FPsigpending:=do_syscall(syscall_nr_sigpending,longint(@nset));
+end;
+
+function FPsigsuspend(const sigmask:sigset_t):cint;
+{
+ Set the signal mask with Mask, and suspend the program until a signal
+ is received.
+}
+
+begin
+  FPsigsuspend:= do_syscall(syscall_nr_sigsuspend,longint(@sigmask));
+end;
+
+Type // implementation side for now. Should move to BSD unit.
+  ITimerVal= Record
+              It_Interval,
+              It_Value      : TimeVal;
+             end;
+
+Const   ITimer_Real    =0;
+  ITimer_Virtual =1;
+  ITimer_Prof    =2;
+
+Function SetITimer(Which : Longint;Const value : ItimerVal; var VarOValue:ItimerVal):Longint;
+
+Begin
+  SetItimer:=Do_Syscall(syscall_nr_setitimer,Which,Longint(@Value),longint(@varovalue));
+End;
+
+Function GetITimer(Which : Longint;Var value : ItimerVal):Longint;
+
+Begin
+  GetItimer:=Do_Syscall(syscall_nr_getItimer,Which,Longint(@value));
+End;
+
+Function FPalarm(Seconds: cuint):cuint;
+
+Var it,oitv : Itimerval;
+
+Begin
+//      register struct itimerval *itp = &it;
+
+ it.it_interval.tv_sec:=0;
+ it.it_interval.tv_usec:=0;
+ it.it_value.tv_sec:=seconds;
+ it.it_value.tv_usec:=0;
+ If SetITimer(ITIMER_REAL,it,oitv)<0 Then
+   Exit(-1);
+
+ if oitv.it_value.tv_usec<>0 Then
+   Inc(oitv.it_value.tv_sec);
+ FPAlarm:=oitv.it_value.tv_sec;
+End;
+
+function sigblock(mask:cuint):cint;
+{Depreciated, but used by pause.}
+
+var nset,oset: sigset_t;
+
+begin
+ FPsigemptyset(nset); 
+ nset[0]:=mask;
+ sigblock:= FPsigprocmask(SIG_BLOCK,@nset,@oset);   // SIG_BLOCK=1
+ if sigblock=0 Then
+  sigblock:=oset[0];
+end;
+
+function sigpause(sigmask:cint):cint;
+{Depreciated, but used by pause.}
+
+var nset: sigset_t;
+
+begin
+ FPsigemptyset(nset); 
+ nset[0]:=sigmask;
+ sigpause:= FPsigsuspend(nset);
+end;
+
+function FPpause:cint;
+
+begin
+  FPpause:=sigpause(sigblock(cuint(0)));
+end;
+
+function FPsleep(seconds:cuint):cuint;
+
+var time_to_sleep,time_remaining : timespec;
+
+begin
+	{
+	 * Avoid overflow when `seconds' is huge.  This assumes that
+	 * the maximum value for a time_t is >= INT_MAX.
+	 }
+	if seconds > high(cint) Then
+		FPsleep:= (seconds - high(cint)) + FPsleep(HIGH(cint));
+
+	time_to_sleep.tv_sec := seconds;
+	time_to_sleep.tv_nsec := 0;
+	if (FPnanosleep(time_to_sleep, time_remaining) <> -1) Then
+	 Exit(0);
+	if (geterrno <> ESysEINTR) Then
+	 Exit (seconds);		     { best guess }
+	FPsleep:= time_remaining.tv_sec;
+	if   (time_remaining.tv_nsec <> 0) Then 
+         inc(FPsleep);
+End;
+
+function FPuname(var name:utsname):cint; [public,alias:'FPC_SYSC_UNAME'];
+
+Var
+        mib  : array[0..1] of cint;
+        rval : cint;
+        len  : size_t;
+        i    : longint;
+        oerrno : cint;
+
+procedure Doone(pz:pchar;pzsize:cint;val1,val2:cint);
+
+Begin
+        mib[0] := val1;
+        mib[1] := val2;
+        len    := pzsize;
+        oerrno := geterrno;
+
+        if (FPsysctl(@mib, 2, pz, @len, NIL, 0) = -1) Then
+           Begin
+                if (geterrno = ESysENOMEM) Then
+                        seterrno(oerrno)
+                else
+                        rval := -1;
+           End;
+         pz[pzsize- 1] := #0;
+End;
+
+Begin
+        rval := 0;
+        DoOne(@name.sysname,sizeof(name.sysname),CTL_KERN,KERN_OSTYPE);
+        DoOne(@name.nodename,sizeof(name.nodename),CTL_KERN,KERN_HOSTNAME);
+        DoOne(@name.release,sizeof(name.release),CTL_KERN,KERN_OSRELEASE);
+        { The version may have newlines in it, turn them into spaces. }
+        DoOne(@name.version,sizeof(name.version),CTL_KERN,KERN_VERSION);
+
+        For I:=0 to sizeof(name.sysname)-2 Do
+          If (name.version[i]=#13) or (name.version[i]=#9) Then
+            name.version[i]:=' ';
+        DoOne(@name.machine,sizeof(name.machine),CTL_HW,HW_MACHINE);
+        FPUname:=rval;
+end;
+
+function GetDomainName(Name:PChar; NameLen:Cint):cint; [public,alias:'FPC_SYSC_GETDOMAINNAME'];
+
+Const Mib_GetDomainName : array[0..1] of cint=(CTL_KERN,KERN_NISDOMAINNAME);
+
+VAR
+	tsize : size_t;
+begin
+	tsize := namelen;
+	if (FPsysctl(@Mib_GetDomainname, 2, name, @tsize, NIL, 0) = -1) Then
+          GetDomainName:=-1
+        Else
+          GetDomainName:=0;
+end;          
+
+function GetHostName(Name:PChar; NameLen:Cint):cint;[public,alias:'FPC_SYSC_GETHOSTNAME'];
+
+Const Mib_GetHostName : array[0..1] of cint=(CTL_KERN,KERN_HOSTNAME);
+
+Var
+	tsize : size_t;
+begin
+	tsize := namelen;
+	if (FPsysctl(@Mib_GetHostName, 2, name, @tsize, NIL, 0) = -1) Then
+	  GetHostName:=-1
+	Else
+	  GetHostName:=0;
+End;
+
+const WAIT_ANY = -1;
+
+function FPwait(var stat_loc:cint): pid_t;
+{
+  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.
+ FPWait:=do_syscall(syscall_nr_WaitPID,WAIT_ANY,longint(@Stat_loc),0,0);
+end;
+
+//function FPgetpid : pid_t;
+
+// begin
+//  FPgetpid:=do_syscall(syscall_nr_getpid);
+// end;
+
+function FPgetppid : pid_t;
+
+begin
+ FPgetppid:=do_syscall(syscall_nr_getppid);
+end;
+
+function FPgetuid : uid_t;
+
+begin
+ FPgetuid:=do_syscall(syscall_nr_getuid);
+end;
+
+function FPgeteuid : uid_t;
+
+begin
+ FPgeteuid:=do_syscall(syscall_nr_geteuid);
+end;
+
+function FPgetgid : gid_t;
+
+begin
+ FPgetgid:=do_syscall(syscall_nr_getgid);
+end;
+
+function FPgetegid : gid_t;
+
+begin
+ FPgetegid:=do_syscall(syscall_nr_getegid);
+end;
+
+function FPsetuid(uid : uid_t): cint;
+
+begin
+ FPsetuid:=do_syscall(syscall_nr_setuid,uid);
+end;
+
+function FPsetgid(gid : gid_t): cint;
+
+begin
+ FPsetgid:=do_syscall(syscall_nr_setgid,gid);
+end;
+
+// type tgrparr=array[0..0] of gid_t;
+
+function FPgetgroups(gidsetsize : cint; var grouplist:tgrparr): cint;
+
+begin
+ FPgetgroups:=do_syscall(syscall_nr_getgroups,gidsetsize,longint(@grouplist));
+end;
+
+function FPgetpgrp : pid_t;
+
+begin
+ FPgetpgrp:=do_syscall(syscall_nr_getpgrp);
+end;
+
+function FPsetsid : pid_t;
+
+begin
+ FPsetsid:=do_syscall(syscall_nr_setsid);
+end;
+
+Function FPumask(cmask:mode_t):mode_t;
+{
+  Sets file creation mask to (Mask and 0777 (octal) ), and returns the
+  previous value.
+}
+begin
+ FPumask:=Do_syscall(syscall_nr_umask,cmask);
+end;
+
+Function FPlink(existing:pchar;newone:pchar):cint;
+{
+  Proceduces a hard link from new to old.
+  In effect, new will be the same file as old.
+}
+begin
+  FPLink:=Do_Syscall(syscall_nr_link,longint(existing),longint(newone));
+end;
+
+Function FPmkfifo(path:pchar;mode:mode_t):cint;
+
+begin
+  FPmkfifo:=do_syscall(syscall_nr_mkfifo,longint(path),longint(mode));
+end;
+
+Function FPchmod(path:pchar;mode:mode_t):cint;
+
+begin
+  FPchmod:=do_syscall(syscall_nr_chmod,longint(path),longint(mode));
+end;
+
+Function FPchown(path:pchar;owner:uid_t;group:gid_t):cint;
+
+begin
+  FPChOwn:=do_syscall(syscall_nr_chown,longint(path),longint(owner),longint(group));
+end;
+
+Function FPUtime(path:pchar;times:putimbuf):cint;
+
+var tv  : array[0..1] of timeval;
+    tvp : ^timeval;
+
+begin
+ if times=nil Then
+   tvp:=nil
+ else
+   begin
+    tv[0].tv_sec :=times^.actime;
+    tv[1].tv_sec :=times^.modtime;
+    tv[0].tv_usec:=0;
+    tv[1].tv_usec:=0; 
+    tvp:=@tv;
+   end;
+ FPutime:=do_syscall(syscall_nr_utimes,longint(path),longint(tvp));
+end;
+
+Function FPpipe(var fildes : tfildes):cint;
+
+begin
+ FPpipe:=do_syscall(syscall_nr_pipe,longint(@fildes));
+end;
+
+function FPfcntl(fildes:cint;Cmd:cint;Arg:cint):cint;
+
+begin
+ FPfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd,arg);
+end;
+
+function FPfcntl(fildes:cint;Cmd:cint;var Arg:flock):cint;
+
+begin
+ FPfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd,longint(@arg));
+end;
+
+function FPfcntl(fildes:cint;Cmd:cint):cint;
+
+begin
+ FPfcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd);
+end;
+
+function FPexecve(path:pchar;argv:ppchar;envp:ppchar):cint;
+
+Begin
+  FPexecve:=do_syscall(syscall_nr_Execve,longint(path),longint(argv),longint(envp));
+End;
+
+function FPexecv(path:pchar;argv:ppchar):cint;
+
+Begin
+  FPexecv:=do_syscall(syscall_nr_Execve,longint(path),longint(argv),longint(envp));
+End;
+
+CONST RUSAGE_SELF	= 0;
+      RUSAGE_CHILDREN   = -1;
+
+function FPgetrusage(who:cint;var ru : rusage):cint;
+
+begin
+ FPgetrusage:=do_syscall(syscall_nr_getrusage,longint(who),longint(@ru));
+end;
+
+function FPtimes(var buffer : tms):clock_t;
+
+var ru : rusage;
+    t  : timeval;
+
+CONST CLK_TCK=128;
+
+function CONVTCK(r:timeval):clock_t;	
+{
+ * Convert usec to clock ticks; could do (usec * CLK_TCK) / 1000000,
+ * but this would overflow if we switch to nanosec.
+ }
+begin
+ CONVTCK:=(r.tv_sec * CLK_TCK + r.tv_usec DIV (1000000 DIV CLK_TCK));
+end;
+
+begin
+
+	if (FPgetrusage(RUSAGE_SELF, ru) < 0) Then
+	    exit(clock_t(-1));
+	buffer.tms_utime := CONVTCK(ru.ru_utime);
+	buffer.tms_stime := CONVTCK(ru.ru_stime);
+	if (FPgetrusage(RUSAGE_CHILDREN, ru) < 0) Then
+ 	    exit(clock_t(-1));
+	buffer.tms_cutime := CONVTCK(ru.ru_utime);
+	buffer.tms_cstime := CONVTCK(ru.ru_stime);
+	if do_syscall(syscall_nr_gettimeofday,longint(@t),0)<>0 Then
+		    exit(clock_t(-1));
+	FPtimes:=clock_t(CONVTCK(t));
+end;
+
+
+{
+ $Log$
+ Revision 1.1  2003-01-05 19:01:28  marco
+  * FreeBSD compiles now with baseunix mods.
+
+ Revision 1.11  2002/11/14 13:25:27  marco
+  * Fix setitimer.
+
+ Revision 1.10  2002/11/14 12:34:20  marco
+  * took out the generic sethandling.
+
+ Revision 1.9  2002/11/13 18:15:08  marco
+  * sigset functions more flexible, small changes to FPtime
+
+ Revision 1.8  2002/10/27 17:21:29  marco
+  * Only "difficult" functions + execvp + termios + rewinddir left to do
+
+ Revision 1.7  2002/10/27 11:58:29  marco
+  * Modifications from Saturday.
+
+ Revision 1.6  2002/10/26 18:27:51  marco
+  * First series POSIX calls commits. Including getcwd.
+
+ Revision 1.5  2002/10/25 15:46:48  marco
+  * Should be alias.
+
+ Revision 1.4  2002/09/08 16:20:27  marco
+  * Forgot external name's
+
+ Revision 1.3  2002/09/08 16:11:59  marco
+  * Added GetDomainName and that other one ..
+
+ Revision 1.2  2002/09/07 16:01:17  peter
+   * old logs removed and tabs fixed
+
+ Revision 1.1  2002/08/21 07:03:16  marco
+  * Fixes from Tuesday.
+
+ Revision 1.1  2002/08/08 11:39:30  marco
+  * Initial versions, to allow support for uname in posix.pp
+}

+ 98 - 0
rtl/bsd/bunxmacr.inc

@@ -0,0 +1,98 @@
+{
+    $Id$
+    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 FPISDIR(m : mode_t): boolean;
+
+begin
+ FPISDIR:=((m and %001111000000000000) = %100000000000000);
+end;
+
+function FPISCHR(m : mode_t): boolean;
+begin
+ FPISCHR:=((m and %001111000000000000) = %10000000000000);
+end;
+
+function FPISBLK(m : mode_t): boolean;
+begin
+ FPISBLK:=((m and %001111000000000000) = %110000000000000);
+end;
+
+function FPISREG(m : mode_t): boolean;
+begin
+ FPISREG:=((m and %001111000000000000) = %1000000000000000);
+end;
+
+function FPISFIFO(m : mode_t): boolean;
+begin
+ FPISFIFO:=((m and %001111000000000000) = %1000000000000);
+end;
+
+function wifexited(status : cint): cint;
+begin
+ wifexited:=cint((status AND &177) =0);
+end;
+
+function wexitstatus(status : cint): cint;
+begin
+ wexitstatus:=(status and &177) shr 8;
+end;
+
+function wstopsig(status : cint): cint;
+begin
+ wstopsig:=(status and &177) shr 8;
+end;
+
+const wstopped=&177;
+
+function wifsignaled(status : cint): cint;
+begin
+ wifsignaled:=cint(((status and &177)<>wstopped) and ((status and &177)<>0));
+end;
+
+function wtermsig(status : cint):cint;
+
+begin
+ wtermsig:=cint(status and &177);
+end;
+
+{
+  $Log$
+  Revision 1.1  2003-01-05 19:01:28  marco
+   * FreeBSD compiles now with baseunix mods.
+
+  Revision 1.4  2002/11/12 14:19:46  marco
+   * fixes to macro
+
+  Revision 1.3  2002/10/26 18:27:51  marco
+   * First series POSIX calls commits. Including getcwd.
+
+  Revision 1.2  2002/09/07 16:01:17  peter
+    * old logs removed and tabs fixed
+
+  Revision 1.1  2002/08/19 12:29:11  marco
+   * First working POSIX *BSD system unit.
+
+
+}

+ 122 - 0
rtl/bsd/bunxmain.inc

@@ -0,0 +1,122 @@
+{
+    $Id$
+    Copyright (c) 2002 by Marco van de Voort.
+
+    Implementation of the POSIX unit for *BSD. In practice only includes
+    other files, or specifies libc bindings.
+
+    The conditional uselibc can be used to switch from libc to syscall
+    usage for basic primitives, but it is best to use unit POSIX if
+    possible. Note that the system unit must also be compiled using uselibc.
+
+    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.
+
+ ****************************************************************************
+}
+
+Uses Sysctl;
+
+{$I ostypes.inc}
+{$I bunxmacr.inc}
+
+{$ifdef uselibc}
+  {$Linklib c}
+
+{   var
+     Errno : cint; external name 'errno';}
+
+    function Fptime(var tloc:time_t): time_t; cdecl; external name 'time';
+    function Fpopen(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;buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
+    function Fpunlink(path: pchar): cint; cdecl; external name 'unlink';
+    function Fprename(old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
+    function Fpstat( path: pchar; var buf : stat): cint; cdecl; external name 'stat';
+    function Fpchdir(path : pchar): cint; cdecl; external name 'chdir';
+    function Fpmkdir(path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
+    function Fprmdir(path : pchar): cint; cdecl; external name 'rmdir';
+    function Fpopendir(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(old : pchar; 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(path : pchar; argv : ppchar; envp: ppchar): cint; cdecl; external name 'execve';
+    function Fpwaitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; cdecl; external name 'waitpid';
+    function Fpaccess(pathname : pchar; amode : cint): cint; cdecl; external name 'access';
+    function Fpuname(var name: utsname): cint; cdecl; external name 'uname';
+    function FpDup(fildes:cint):cint; cdecl; external name 'dup';
+    function FpDup2(fildes:cint;fildes2:cint):cint; cdecl; external name 'dup2';
+
+{$else}
+
+// uses syscalls.
+
+function Fptime(var tloc:time_t): time_t; external name 'FPC_SYSC_TIME';
+function Fpopen(path: pchar; flags : cint; mode: mode_t):cint;  external name 'FPC_SYSC_OPEN';
+function Fpclose(fd : cint): cint;  external name 'FPC_SYSC_CLOSE';
+function Fplseek(fd : cint; offset : off_t; whence : cint): off_t; external name 'FPC_SYSC_LSEEK';
+function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; external name 'FPC_SYSC_READ';
+function Fpwrite(fd: cint;buf:pchar; nbytes : size_t): ssize_t;  external name 'FPC_SYSC_WRITE';
+function Fpunlink(path: pchar): cint;  external name 'FPC_SYSC_UNLINK';
+function Fprename(old : pchar; newpath: pchar): cint;  external name 'FPC_SYSC_RENAME';
+function Fpstat(path: pchar; var buf : stat):cint;  external name 'FPC_SYSC_STAT';
+function Fpchdir(path : pchar): cint; external name 'FPC_SYSC_CHDIR';
+function Fpmkdir(path : pchar; mode: mode_t):cint; external name 'FPC_SYSC_MKDIR';
+function Fprmdir(path : pchar): cint; external name 'FPC_SYSC_RMDIR';
+function Fpopendir(dirname : pchar): pdir; external name 'FPC_SYSC_OPENDIR';
+function Fpclosedir(var dirp : dir): cint; external name 'FPC_SYSC_CLOSEDIR';
+function Fpreaddir(var dirp : dir) : pdirent; external name 'FPC_SYSC_READDIR';
+procedure Fpexit(status : cint); external name 'FPC_SYSC_EXIT';
+function Fpsigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;  external name 'FPC_SYSC_SIGACTION';
+function Fpftruncate(fd : cint; flength : off_t): cint; external name 'FPC_SYSC_FTRUNCATE';
+function Fpfstat(fd : cint; var sb : stat): cint; external name 'FPC_SYSC_FSTAT';
+function Fpfork : pid_t; external name 'FPC_SYSC_FORK';
+// function Fpexecve(path : pchar; argv : ppchar;envp: ppchar): cint; external name 'FPC_SYSC_EXECVE';
+function Fpwaitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; external name 'FPC_SYSC_WAITPID';
+function Fpaccess(pathname : pchar; amode : cint): cint;external name 'FPC_SYSC_ACCESS';
+function FpDup(fildes:cint):cint;  external name 'FPC_SYSC_DUP';
+function FpDup2(fildes:cint;fildes2:cint):cint; external name 'FPC_SYSC_DUP2';
+function geterrno:cint; external name  'FPC_SYS_GETERRNO';
+procedure seterrno (i:cint); external name  'FPC_SYS_SETERRNO';
+
+{$endif}
+
+{$I bunxfunc.inc}
+
+{
+ $Log$
+ Revision 1.1  2003-01-05 19:01:28  marco
+  * FreeBSD compiles now with baseunix mods.
+
+ Revision 1.8  2002/10/27 17:21:29  marco
+  * Only "difficult" functions + execvp + termios + rewinddir left to do
+
+ Revision 1.7  2002/10/27 11:58:30  marco
+  * Modifications from Saturday.
+
+ Revision 1.6  2002/10/26 18:27:51  marco
+  * First series POSIX calls commits. Including getcwd.
+
+ Revision 1.5  2002/09/07 16:01:17  peter
+   * old logs removed and tabs fixed
+
+ Revision 1.4  2002/08/21 07:03:16  marco
+  * Fixes from Tuesday.
+
+ Revision 1.3  2002/08/19 12:29:11  marco
+  * First working POSIX *BSD system unit.
+
+
+
+}

+ 9 - 9
rtl/bsd/i386/syscall.inc

@@ -44,14 +44,14 @@ procedure actualsyscall; assembler; {inline requires a dummy push IIRC}
        mov $-1,%eax
    end;
 
-function Do_SysCall(sysnr:LONGINT):longint; assembler; [public,alias:'FPC_DOSYS0'];
+function FpSysCall(sysnr:TSysParam):TSysResult; assembler; [public,alias:'FPC_DOSYS0'];
 
 asm
   movl  sysnr,%eax
   call  actualsyscall
 end;
 
-function Do_SysCall(sysnr,param1:longint):longint; assembler;[public,alias:'FPC_DOSYS1'];
+function FpSysCall(sysnr,param1:TSysParam):TSysResult; assembler;[public,alias:'FPC_DOSYS1'];
 
  asm
   movl  sysnr,%eax
@@ -60,7 +60,7 @@ function Do_SysCall(sysnr,param1:longint):longint; assembler;[public,alias:'FPC_
   addl  $4,%esp
  end;
 
-function Do_SysCall(sysnr,param1:integer):longint; assembler;[public,alias:'FPC_DOSYS1w'];
+function FpSysCall(sysnr,param1:integer):TSysResult; assembler;[public,alias:'FPC_DOSYS1w'];
 
  asm
   movl  sysnr,%eax
@@ -69,7 +69,7 @@ function Do_SysCall(sysnr,param1:integer):longint; assembler;[public,alias:'FPC_
   add   $2,%esp
  end;
 
-function Do_SysCall(sysnr,param1,param2:LONGINT):longint; assembler; [public,alias:'FPC_DOSYS2'];
+function FpSysCall(sysnr,param1,param2:TSysParam):TSysResult; assembler; [public,alias:'FPC_DOSYS2'];
 
  asm
    movl  sysnr,%eax
@@ -79,7 +79,7 @@ function Do_SysCall(sysnr,param1,param2:LONGINT):longint; assembler; [public,ali
    addl  $8,%esp
  end;
 
-function Do_SysCall(sysnr,param1,param2,param3:LONGINT):longint; assembler;[public,alias:'FPC_DOSYS3'];
+function FpSysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; assembler;[public,alias:'FPC_DOSYS3'];
 
  asm
    movl  sysnr,%eax
@@ -90,7 +90,7 @@ function Do_SysCall(sysnr,param1,param2,param3:LONGINT):longint; assembler;[publ
    addl  $12,%esp
 end;
 
-function Do_SysCall(sysnr,param1,param2,param3,param4:LONGINT):longint; assembler;[public,alias:'FPC_DOSYS4'];
+function FpSysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; assembler;[public,alias:'FPC_DOSYS4'];
 
 asm
    movl  sysnr,%eax
@@ -103,7 +103,7 @@ asm
 end;
 
 
-function Do_SysCall(sysnr,param1,param2,param3,param4,param5:LONGINT):longint;  assembler;[public,alias:'FPC_DOSYS5'];
+function FpSysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;  assembler;[public,alias:'FPC_DOSYS5'];
 
  asm
    movl  sysnr,%eax
@@ -116,7 +116,7 @@ function Do_SysCall(sysnr,param1,param2,param3,param4,param5:LONGINT):longint;
    addl  $20,%esp
 end;
 
-function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:LONGINT):int64;  assembler;[public,alias:'FPC_DOSYS6'];
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64;  assembler;[public,alias:'FPC_DOSYS6'];
 
 asm
    movl  sysnr,%eax
@@ -130,7 +130,7 @@ asm
    addl  $24,%esp
 end;
 
-function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:LONGINT):int64;  assembler; [public,alias:'FPC_DOSYS7'];
+function FpSysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:TSysParam):int64;  assembler; [public,alias:'FPC_DOSYS7'];
 
 asm
    movl  sysnr,%eax

+ 25 - 11
rtl/bsd/i386/syscallh.inc

@@ -22,19 +22,34 @@
 
 }
 
-function Do_SysCall(sysnr:LONGINT):longint;  external name 'FPC_DOSYS0';
-function Do_SysCall(sysnr,param1:longint):longint; external name 'FPC_DOSYS1';
-function Do_SysCall(sysnr,param1:integer):longint; external name 'FPC_DOSYS1w';
-function Do_SysCall(sysnr,param1,param2:LONGINT):longint;  external name 'FPC_DOSYS2';
-function Do_SysCall(sysnr,param1,param2,param3:LONGINT):longint; external name 'FPC_DOSYS3';
-function Do_SysCall(sysnr,param1,param2,param3,param4:LONGINT):longint; external name 'FPC_DOSYS4';
-function Do_SysCall(sysnr,param1,param2,param3,param4,param5:LONGINT):longint;  external name 'FPC_DOSYS5';
-function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:LONGINT):int64;  external name 'FPC_DOSYS6';
-function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:LONGINT):int64;   external name 'FPC_DOSYS7';
+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;
+
+function Do_SysCall(sysnr:TSysParam):TSysResult;  external name 'FPC_DOSYS0';
+function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_DOSYS1';
+function Do_SysCall(sysnr,param1:integer):TSysResult; external name 'FPC_DOSYS1w';
+function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult;  external name 'FPC_DOSYS2';
+function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_DOSYS3';
+function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_DOSYS4';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;  external name 'FPC_DOSYS5';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64;  external name 'FPC_DOSYS6';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:TSysParam):int64;   external name 'FPC_DOSYS7';
 
 {
   $Log$
-  Revision 1.4  2002-10-16 18:44:00  marco
+  Revision 1.5  2003-01-05 19:01:28  marco
+   * FreeBSD compiles now with baseunix mods.
+
+  Revision 1.4  2002/10/16 18:44:00  marco
    * and again for ftruncate (sigh)
 
   Revision 1.3  2002/10/16 18:41:14  marco
@@ -46,5 +61,4 @@ function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:LONGI
   Revision 1.1  2002/08/20 08:28:14  marco
    * Updates for new errno scheme.
 
-
 }

+ 620 - 0
rtl/bsd/osmain.inc

@@ -0,0 +1,620 @@
+{
+    $Id$
+    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.
+
+ **********************************************************************}
+
+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;
+
+
+{*****************************************************************************
+                       Misc. System Dependent Functions
+*****************************************************************************}
+
+procedure System_exit;
+begin
+   Fpexit(cint(ExitCode));
+End;
+
+
+Function ParamCount: Longint;
+Begin
+  Paramcount:=argc-1
+End;
+
+
+function BackPos(c:char; const s: shortstring): integer;
+var
+ i: integer;
+Begin
+  for i:=length(s) downto 0 do
+    if s[i] = c then break;
+  if i=0 then
+    BackPos := 0
+  else
+    BackPos := i;
+end;
+
+
+ { variable where full path and filename and executable is stored }
+ { is setup by the startup of the system unit.                    }
+var
+ execpathstr : shortstring;
+
+function paramstr(l: longint) : string;
+ var
+  s: string;
+  s1: string;
+ begin
+   { stricly conforming POSIX applications  }
+   { have the executing filename as argv[0] }
+   if l=0 then
+     begin
+       paramstr := execpathstr;
+     end
+   else
+     paramstr:=strpas(argv[l]);
+ end;
+
+Procedure Randomize;
+Begin
+  randseed:=longint(Fptime(nil));
+End;
+
+{*****************************************************************************
+                              Heap Management
+*****************************************************************************}
+
+var
+  _HEAP : longint;external name 'HEAP';
+  _HEAPSIZE : longint;external name 'HEAPSIZE';
+
+{$ifndef SYSTEM_HAS_GETHEAPSTART}
+function getheapstart:pointer;
+begin
+  getheapstart := @_HEAP;
+end;
+{$endif}
+
+
+{$ifndef SYSTEM_HAS_GETHEAPSIZE}
+function getheapsize:longint;
+begin
+  getheapsize := _HEAPSIZE;
+end;
+{$endif}
+
+
+{*****************************************************************************
+                          Low Level File Routines
+*****************************************************************************}
+
+{
+  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(Errno);
+  InoutRes:=Errno2InoutRes;
+end;
+
+Procedure Do_Close(Handle:Longint);
+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 FpISDIR(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,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,Addr,Len:Longint):longint;
+Begin
+  repeat
+    Do_Write:=Fpwrite(Handle,pchar(addr),len);
+  until ErrNo<>ESysEINTR;
+  If Do_Write<0 Then
+   Begin
+    Errno2InOutRes;
+    Do_Write:=0;
+   End
+  else
+   InOutRes:=0;
+End;
+
+
+Function Do_Read(Handle,Addr,Len:Longint):Longint;
+Begin
+  repeat
+    Do_Read:=Fpread(Handle,pchar(addr),len);
+  until ErrNo<>ESysEINTR;
+  If Do_Read<0 Then
+   Begin
+    Errno2InOutRes;
+    Do_Read:=0;
+   End
+  else
+   InOutRes:=0;
+End;
+
+function Do_FilePos(Handle: Longint):longint;
+Begin
+  do_FilePos:=Fplseek(Handle, 0, SEEK_CUR);
+  If Do_FilePos<0 Then
+    Errno2InOutRes
+  else
+   InOutRes:=0;
+End;
+
+Procedure Do_Seek(Handle,Pos:Longint);
+Begin
+  If Fplseek(Handle, pos, SEEK_SET)<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+End;
+
+Function Do_SeekEnd(Handle:Longint): Longint;
+begin
+  Do_SeekEnd:=Fplseek(Handle,0,SEEK_END);
+  If Do_SeekEnd<0 Then
+   Errno2Inoutres
+  Else
+   InOutRes:=0;
+end;
+
+Function Do_FileSize(Handle:Longint): 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)
+}
+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 (ErrNo=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;
+
+
+
+{*****************************************************************************
+                           Directory Handling
+*****************************************************************************}
+
+Procedure MkDir(Const s: String);[IOCheck];
+Var
+  Buffer: Array[0..255] of Char;
+Begin
+  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
+  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
+  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],255);
+ 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.st_dev=thisdir.st_dev) and (cwdinfo.st_ino=thisdir.st_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
+      else
+       begin
+	 if (Errno<>ESysENOENT) then
+	  Exit;
+       end;
+    until (name<>'');
+    if Fpclosedir(dirstream)<0 then
+      Exit;
+    thedir:=name+thedir;
+    dummy:=dummy+'../';
+    if ((cwdinfo.st_dev=rootinfo.st_dev) and (cwdinfo.st_ino=rootinfo.st_ino)) then
+      begin
+        if thedir='' then
+          dir:='/'
+        else
+          dir:=thedir;
+        exit;
+      end;
+  until false;
+ {$endif}
+end;
+
+
+{*****************************************************************************
+                         SystemUnit Initialization
+*****************************************************************************}
+
+
+procedure SignalToRunerror(signo: cint); cdecl;
+var
+  res : word;
+begin
+    res:=0;
+    if signo = SIGFPE then
+     begin
+        res := 200;
+     end
+    else
+    if (signo = SIGILL) or (signo = SIGBUS) or (signo = SIGSEGV) then
+      begin
+        res := 216;
+      end;
+  { give runtime error at the position where the signal was raised }
+  if res<>0 then
+   begin
+     HandleError(res);
+   end;
+end;
+
+
+var
+  act: SigActionRec;
+
+Procedure InstallSignals;
+var
+  oldact: SigActionRec;
+begin
+  { Initialize the sigaction structure }
+  { all flags and information set to zero }
+  FillChar(act, sizeof(SigActionRec),0);
+  { initialize handler                    }
+  act.sa_handler := @SignalToRunError;
+  FpSigAction(SIGFPE,act,oldact);
+  FpSigAction(SIGSEGV,act,oldact);
+  FpSigAction(SIGBUS,act,oldact);
+  FpSigAction(SIGILL,act,oldact);
+end;
+
+
+procedure SetupCmdLine;
+var
+  bufsize,
+  len,j,
+  size,i : longint;
+  found  : boolean;
+  buf    : pchar;
+
+  procedure AddBuf;
+  begin
+    reallocmem(cmdline,size+bufsize);
+    move(buf^,cmdline[size],bufsize);
+    inc(size,bufsize);
+    bufsize:=0;
+  end;
+
+begin
+  GetMem(buf,ARG_MAX);
+  size:=0;
+  bufsize:=0;
+  i:=0;
+  while (i<argc) do
+   begin
+     len:=strlen(argv[i]);
+     if len>ARG_MAX-2 then
+      len:=ARG_MAX-2;
+     found:=false;
+     for j:=1 to len do
+      if argv[i][j]=' ' then
+       begin
+         found:=true;
+         break;
+       end;
+     if bufsize+len>=ARG_MAX-2 then
+      AddBuf;
+     if found then
+      begin
+        buf[bufsize]:='"';
+        inc(bufsize);
+      end;
+     move(argv[i]^,buf[bufsize],len);
+     inc(bufsize,len);
+     if found then
+      begin
+        buf[bufsize]:='"';
+        inc(bufsize);
+      end;
+     if i<argc then
+      buf[bufsize]:=' '
+     else
+      buf[bufsize]:=#0;
+     inc(bufsize);
+     inc(i);
+   end;
+  AddBuf;
+  FreeMem(buf,ARG_MAX);
+end;
+
+(*
+Begin
+{ Set up signals handlers }
+   InstallSignals;
+{ Setup heap }
+  InitHeap;
+  InitExceptions;
+{ Arguments }
+  SetupCmdLine;
+{ Setup stdin, stdout and stderr }
+  OpenStdIO(Input,fmInput,StdInputHandle);
+  OpenStdIO(Output,fmOutput,StdOutputHandle);
+  OpenStdIO(StdOut,fmOutput,StdOutputHandle);
+  OpenStdIO(StdErr,fmOutput,StdErrorHandle);
+{ Reset IO Error }
+  InOutRes:=0;
+End.
+*)
+
+{
+   $Log$
+   Revision 1.1  2003-01-05 19:01:28  marco
+    * FreeBSD compiles now with baseunix mods.
+
+
+}

+ 621 - 0
rtl/bsd/ossysc.inc

@@ -0,0 +1,621 @@
+{
+    $Id$
+    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.
+
+ ****************************************************************************
+}
+
+{$ifdef uselibc}
+  {$Linklib c}
+  // Out of date atm.
+
+{   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; var stat_loc : cint; 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 bunxmacr.inc}
+{$I ostypes.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;
+
+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'];
+
+Begin
+ Fpopen:=do_syscall(syscall_nr_open,TSysParam(path),TSysParam(flags),TSysParam(mode));
+End;
+
+function Fpclose(fd : cint): cint;
+
+begin
+ Fpclose:=do_syscall(syscall_nr_close,fd);
+end;
+
+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.
+}
+
+begin
+  Fplseek:=do_syscall(syscall_nr___syscall,syscall_nr_lseek,0,TSysParam(fd),0,lo(Offset),{0} hi(offset),Whence);
+end;
+
+function Fpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_READ'];
+
+begin
+  Fpread:=do_syscall(syscall_nr_read,Fd,TSysParam(buf),nbytes);
+end;
+
+function Fpwrite(fd: cint;buf:pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_WRITE'];
+
+begin
+ Fpwrite:=do_syscall(syscall_nr_write,Fd,TSysParam(buf),nbytes);
+end;
+
+function Fpunlink(const path: pchar): cint; [public, alias : 'FPC_SYSC_UNLINK'];
+
+begin
+  Fpunlink:=do_syscall(syscall_nr_unlink,TSysParam(path));
+end;
+
+function Fprename(old : pchar; newpath: pchar): cint; [public, alias : 'FPC_SYSC_RENAME'];
+
+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'];
+
+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'];
+
+begin
+ Fpchdir:=do_syscall(syscall_nr_chdir,TSysParam(path));
+end;
+
+function Fpmkdir(path : pchar; mode: mode_t):cint; [public, alias : 'FPC_SYSC_MKDIR'];
+
+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'];
+
+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
+  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'];
+
+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
+    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'];
+
+begin
+  do_syscall(syscall_nr_exit,status);
+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.
+}
+
+begin
+  do_syscall(syscall_nr_sigaction,TSysParam(sig),TSysParam(@act),TSysParam(@oact));
+end;
+
+(*=================== MOVED from sysunix.inc ========================*)
+
+function Fpftruncate(fd : cint; flength : off_t): cint; [public, alias : 'FPC_SYSC_FTRUNCATE'];
+{ See notes lseek. This one is completely similar.
+
+}
+begin
+ Fpftruncate:=Do_syscall(syscall_nr___syscall,syscall_nr_ftruncate,0,fd,0,lo(flength),hi(flength));
+end;
+
+function Fpfstat(fd : cint; var sb : stat): cint;  [public, alias : 'FPC_SYSC_FSTAT'];
+
+begin
+  fpFStat:=do_SysCall(syscall_nr_fstat,fd,TSysParam(@sb));
+end;
+
+{$ifdef NewReaddir}
+{$I readdir.inc}
+{$endif}
+
+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
+ 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 Fpwaitpid(pid : pid_t; var stat_loc : cint; 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:=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.
+}
+
+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
+  Fpdup:=Do_syscall(syscall_nr_dup,TSysParam(fildes));
+end;
+
+Function FpDup2(fildes,fildes2:cint):cint; [public, alias : 'FPC_SYSC_DUP2'];
+
+begin
+ Fpdup2:=do_syscall(syscall_nr_dup2,TSysParam(fildes),TSysParam(fildes2));
+end;
+
+CONST
+ { Constansts for MMAP }
+  MAP_PRIVATE   =2;
+  MAP_ANONYMOUS =$1000;
+
+
+Function Fpmmap(adr,len,prot,flags,fdes,off:longint):longint;  [public, alias : 'FPC_SYSC_MMAP'];
+begin
+  Fpmmap:=do_syscall(syscall_nr_mmap,Adr,Len,Prot,Flags,fdes,off,0);
+end;
+
+Function Fpmunmap(adr:longint;len:size_t):longint; [public, alias :'FPC_SYSC_MUNMAP'];
+begin
+  Fpmunmap:=do_syscall(syscall_nr_munmap,TSysParam(Adr),Len);
+end;
+
+Function sbrk(size : longint) : Longint;
+begin
+  sbrk:=Fpmmap(0,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
+  if sbrk<>-1 then
+   errno:=0;
+  {! It must be -1, not 0 as before, see heap.inc. Should be in sysmmap?}
+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,Ndx: Longint;Data: Pointer):LongInt;  [public, alias : 'FPC_SYSC_IOCTL'];
+// This was missing here, instead hardcoded in Do_IsDevice
+begin
+  FpIOCtl:=do_SysCall(syscall_nr_ioctl,handle,Ndx,TSysParam(data));
+end;
+
+CONST
+  IOCtl_TCGETS=$5401;
+
+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.
+}
+var
+  Data : array[0..255] of byte; {Large enough for termios info}
+begin
+  Do_IsDevice:=(Fpioctl(handle,IOCTL_TCGETS,@data)<>-1);
+end;
+
+Function FpGetPid:LongInt;   [public, alias : 'FPC_SYSC_GETPID'];
+{
+  Get Process ID.
+}
+
+begin
+ FpGetPID:=do_syscall(syscall_nr_getpid);
+end;
+
+Function FpReadLink(name,linkname:pchar;maxlen:longint):longint;  [public, alias : 'FPC_SYSC_READLINK'];
+
+begin
+  Fpreadlink:=do_syscall(syscall_nr_readlink, TSysParam(name),TSysParam(linkname),maxlen);
+end;
+
+Function FpNanoSleep(const req : timespec;var rem : timespec) : longint; [public, alias : 'FPC_SYSC_NANOSLEEP'];
+begin
+  FpNanoSleep:=Do_SysCall(syscall_nr_nanosleep,TSysParam(@req),TSysParam(@rem));
+end;
+
+function Fpgetcwd(pt:pchar; _size:size_t):pchar;[public, alias :'FPC_SYSC_GETCWD'];
+
+const intpathmax = 1024-4;	// didn't use POSIX data in libc
+				// implementation.
+var ept,bpt : pchar;
+    c	    : char;
+    ret	    : cint;
+
+begin
+   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;
+
+{$endif}
+
+{
+ $Log$
+ Revision 1.1  2003-01-05 19:01:28  marco
+  * FreeBSD compiles now with baseunix mods.
+
+ Revision 1.9  2002/11/13 18:15:08  marco
+  * sigset functions more flexible, small changes to sys_ktime
+
+ Revision 1.8  2002/10/27 17:21:29  marco
+  * Only "difficult" functions + execvp + termios + rewinddir left to do
+
+ Revision 1.7  2002/10/27 11:58:29  marco
+  * Modifications from Saturday.
+
+ Revision 1.6  2002/10/26 18:27:51  marco
+  * First series POSIX calls commits. Including getcwd.
+
+ Revision 1.5  2002/10/18 12:19:58  marco
+  * Fixes to get the generic *BSD RTL compiling again + fixes for thread
+    support. Still problems left in fexpand. (inoutres?) Therefore fixed
+    sysposix not yet commited
+
+ Revision 1.4  2002/10/16 18:44:18  marco
+  * Lseek and ftruncate 64-bit fix
+
+ Revision 1.3  2002/09/07 16:01:17  peter
+   * old logs removed and tabs fixed
+
+ Revision 1.2  2002/08/21 07:03:16  marco
+  * Fixes from Tuesday.
+
+ Revision 1.1  2002/08/19 12:29:11  marco
+  * First working POSIX *BSD system unit.
+
+
+ Revision 1.2  2002/08/04 04:29:34  marco
+  * More POSIX updates. Small changes to lseek and ftruncate in osposix.inc
+    Initial versions of the type includefiles
+
+ Revision 1.1  2002/08/03 19:34:19  marco
+  * Initial *BSD versions. Seems that OpenBSD doesn't need much change,
+     NetBSD may need some fixes to stat record and ftruncate and lseek.
+     It is all close together, and it should be doable to have just one copy
+     of these for *BSD.
+
+}

+ 40 - 0
rtl/bsd/ossysch.inc

@@ -0,0 +1,40 @@
+{
+    $Id$
+    Copyright (c) 2002 by Marco van de Voort
+
+    Header for functions/syscalls included in system, but not in POSIX.  To
+    implement unit UNIX, and/or other lowlevel unix routines.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ****************************************************************************
+}
+
+Function Fpmmap(adr,len,prot,flags,fdes,off:longint):longint;  external name  'FPC_SYSC_MMAP';
+Function Fpmunmap(adr:longint;len:size_t):longint;  external name 'FPC_SYSC_MUNMAP';
+Function FpIOCtl(Handle,Ndx: Longint;Data: Pointer):LongInt;  external name  'FPC_SYSC_IOCTL';
+Function FpGetPid:LongInt;   external name  'FPC_SYSC_GETPID';
+Function FpReadLink(name,linkname:pchar;maxlen:longint):longint;  external name  'FPC_SYSC_READLINK';
+
+{ Needed in both POSIX (for implementation of sleep()) as POSIX realtime extensions or  Unix/freebsd}
+Function FpNanoSleep (const req : timespec;var rem : timespec) : longint; external name 'FPC_SYSC_NANOSLEEP';
+
+{ can be used for getdir?}
+Function Fpgetcwd (path:pchar; siz:size_t):pchar; external name 'FPC_SYSC_GETCWD';
+
+{
+  $Log$
+  Revision 1.1  2003-01-05 19:01:28  marco
+   * FreeBSD compiles now with baseunix mods.
+
+  Revision 1.4  2002/10/27 11:58:29  marco
+   * Modifications from Saturday.
+
+
+
+}

+ 82 - 0
rtl/bsd/ostypes.inc

@@ -0,0 +1,82 @@
+{
+    $Id$
+    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.
+
+ ****************************************************************************
+}
+
+Type
+  timeval  = packed record
+    tv_sec,tv_usec:clong;
+  end;
+  ptimeval = ^timeval;
+  TTimeVal = timeval;
+
+  timespec = packed record
+    tv_sec   : time_t;
+    tv_nsec  : clong;
+  end;
+
+  timezone = packed record
+    minuteswest,
+    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
+
+{
+ $Log$
+ Revision 1.1  2003-01-05 19:01:28  marco
+  * FreeBSD compiles now with baseunix mods.
+
+ Revision 1.4  2002/10/27 17:21:29  marco
+  * Only "difficult" functions + execvp + termios + rewinddir left to do
+
+ Revision 1.3  2002/10/27 11:58:30  marco
+  * Modifications from Saturday.
+
+ Revision 1.2  2002/09/07 16:01:17  peter
+   * old logs removed and tabs fixed
+
+ Revision 1.1  2002/08/19 12:29:11  marco
+  * First working POSIX *BSD system unit.
+
+
+}

+ 14 - 11
rtl/bsd/sysctl.pp

@@ -75,9 +75,9 @@ TYPE    CtlNameRec = Record
 // function is not implemented
 //
 
-function sys_sysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
-function sys_sysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
-function sys_sysctlnametomib (Name: pchar; mibp:plongint;sizep:psize_t):cint;
+function FPsysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+function FPsysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+function FPsysctlnametomib (Name: pchar; mibp:plongint;sizep:psize_t):cint;
 
 Implementation
 
@@ -89,7 +89,7 @@ CONST  syscall_nr___sysctl                    = 202;
 {$I sysnr.inc}
 {$I syscallh.inc}
 
-function sys_sysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+function FPsysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
 
 Begin
         if (name[0] <> chr(CTL_USER)) Then
@@ -98,7 +98,7 @@ Begin
          Exit(0);
 End;
 
-function sys_sysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
+function FPsysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
 Var
         name2oid_oid    : array[0..1] of cint;
         real_oid        : array[0..CTL_MAXNAME+1] of cint;
@@ -109,16 +109,16 @@ Begin
         name2oid_oid[1] := 3;
 
         oidlen := sizeof(real_oid);
-        error := sys_sysctl(@name2oid_oid, 2, @real_oid, @oidlen, name,
+        error := FPsysctl(@name2oid_oid, 2, @real_oid, @oidlen, name,
                        strlen(name));
         if (error < 0)  Then
                 Exit(error);
         oidlen := Oidlen DIV sizeof (cint);
-        error := sys_sysctl(@real_oid, oidlen, oldp, oldlenp, newp, newlen);
+        error := FPsysctl(@real_oid, oidlen, oldp, oldlenp, newp, newlen);
         exit(error);
 End;
 
-function sys_sysctlnametomib (Name: pchar; mibp:plongint;sizep:psize_t):cint;
+function FPsysctlnametomib (Name: pchar; mibp:plongint;sizep:psize_t):cint;
 Var     oid   : array[0..1] OF cint;
         error : cint;
 
@@ -126,19 +126,22 @@ Begin
         oid[0] := 0;
         oid[1] := 3;
         sizep^:=sizep^*sizeof(cint);
-        error := sys_sysctl(@oid, 2, mibp, sizep, name, strlen(name));
+        error := FPsysctl(@oid, 2, mibp, sizep, name, strlen(name));
         sizep^ := sizep^ div sizeof (cint);
 
         if (error < 0)  Then
                 Exit (error);
-        sys_sysctlnametomib:=0;
+        FPsysctlnametomib:=0;
 End;
 
 end.
 
 {
   $Log$
-  Revision 1.3  2002-09-07 16:01:17  peter
+  Revision 1.4  2003-01-05 19:01:28  marco
+   * FreeBSD compiles now with baseunix mods.
+
+  Revision 1.3  2002/09/07 16:01:17  peter
     * old logs removed and tabs fixed
 
   Revision 1.2  2002/08/19 12:29:11  marco

+ 7 - 10
rtl/bsd/system.pp

@@ -53,18 +53,12 @@ end;
 { OS dependant parts  }
 
 {$I errno.inc}
-{$I osposixh.inc}
-{$ifdef BSD}
-{$I bsdsysc.inc}
-{$else}
-{$I linsysc.inc}
-{$endif}
-{$I sysposix.inc}
+{$I bunxtype.inc}
+{$I ossysc.inc}
+{$I osmain.inc}
 {$I text.inc}
 {$I heap.inc}
 
-
-
 {*****************************************************************************
                            UnTyped File Handling
 *****************************************************************************}
@@ -108,7 +102,10 @@ End.
 
 {
   $Log$
-  Revision 1.7  2002-11-12 14:57:48  marco
+  Revision 1.8  2003-01-05 19:01:28  marco
+   * FreeBSD compiles now with baseunix mods.
+
+  Revision 1.7  2002/11/12 14:57:48  marco
    * Ugly hack to temporarily be able to use system.pp for Linux too
 
   Revision 1.6  2002/10/27 11:58:30  marco