paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 21:28:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

* FreeBSD compiles now with baseunix mods.

Browse Source
This commit is contained in:
marco 2003-01-05 19:01:28 +00:00
parent edb37d1a72
commit 832a1bcb96
13 changed files with 2197 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
rtl/bsd/baseunix.pp Normal file
View File

@ -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.
}

11
rtl/bsd/bsdsysc.inc
View File

@ -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
rtl/bsd/bunxfunc.inc Normal file
View File

@ -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
rtl/bsd/bunxmacr.inc Normal file
View File

@ -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
rtl/bsd/bunxmain.inc Normal file
View File

@ -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.
}

18
rtl/bsd/i386/syscall.inc
View File

@ -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

36
rtl/bsd/i386/syscallh.inc
View File

@ -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
rtl/bsd/osmain.inc Normal file
View File

@ -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
rtl/bsd/ossysc.inc Normal file
View File

@ -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
rtl/bsd/ossysch.inc Normal file
View File

@ -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
rtl/bsd/ostypes.inc Normal file
View File

@ -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.
}

25
rtl/bsd/sysctl.pp
View File

@ -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

17
rtl/bsd/system.pp
View File

@ -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