paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-12 16:29:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* renamed after baseunix changes.

Browse Source
This commit is contained in:
marco 2003-01-05 19:18:16 +00:00
parent 07f5401b2b
commit cc042060e0
7 changed files with 0 additions and 1636 deletions

498
rtl/bsd/bsdfuncs.inc
View File

@ -1,498 +0,0 @@
{
$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 bsdsysch.inc} // external interface to syscalls in system unit.
{$i posixunx.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.
Function sys_Kill(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
sys_kill:=do_syscall(syscall_nr_kill,pid,sig);
// if kill<0 THEN
// Kill:=0;
end;
function sys_SigProcMask(how:cint;var _set : sigset_t; var _oset : sigset_t):cint;
{
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
sys_sigprocmask:=do_syscall(syscall_nr_sigprocmask,longint(how),longint(@_set),longint(@_oset));
end;
Function sys_SigPending(var _set: sigset_t):cint;
{
Allows examination of pending signals. The signal mask of pending
signals is set in SSet
}
begin
sys_sigpending:=do_syscall(syscall_nr_sigpending,longint(@_set));
end;
function sys_sigsuspend(const sigmask:sigset_t):cint;
{
Set the signal mask with Mask, and suspend the program until a signal
is received.
}
begin
sys_sigsuspend:= 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 sys_alarm(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);
sys_Alarm:=oitv.it_value.tv_sec;
End;
function sigblock(mask:cuint):cint;
{Depreciated, but used by pause.}
var nset,oset: sigset_t;
begin
sys_sigemptyset(nset);
nset[0]:=mask;
sigblock:= sys_sigprocmask(SIG_BLOCK,nset,oset); // SIG_BLOCK=1
if sigblock=0 Then
sigblock:=oset[0];
el
end;
function sigpause(sigmask:cint):cint;
{Depreciated, but used by pause.}
var nset: sigset_t;
begin
sys_sigemptyset(nset);
nset[0]:=sigmask;
sigpause:= sys_sigsuspend(nset);
end;
function sys_pause:cint;
begin
sys_pause:=sigpause(sigblock(cuint(0)));
end;
function sys_sleep(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
sys_sleep:= (seconds - high(cint)) + sys_sleep(HIGH(cint));
time_to_sleep.tv_sec := seconds;
time_to_sleep.tv_nsec := 0;
if (sys_nanosleep(time_to_sleep, time_remaining) <> -1) Then
Exit(0);
if (geterrno <> sys_EINTR) Then
Exit (seconds); { best guess }
sys_sleep:= time_remaining.tv_sec;
if (time_remaining.tv_nsec <> 0) Then
inc(sys_sleep);
End;
function sys_uname(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 (sys_sysctl(@mib, 2, pz, @len, NIL, 0) = -1) Then
Begin
if (geterrno = sys_ENOMEM) 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);
sys_Uname:=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 (sys_sysctl(@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 (sys_sysctl(@Mib_GetHostName, 2, name, @tsize, NIL, 0) = -1) Then
GetHostName:=-1
Else
GetHostName:=0;
End;
const WAIT_ANY = -1;
function sys_wait(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.
sys_Wait:=do_syscall(syscall_nr_WaitPID,WAIT_ANY,longint(@Stat_loc),0,0);
end;
//function sys_getpid : pid_t;
// begin
// sys_getpid:=do_syscall(syscall_nr_getpid);
// end;
function sys_getppid : pid_t;
begin
sys_getppid:=do_syscall(syscall_nr_getppid);
end;
function sys_getuid : uid_t;
begin
sys_getuid:=do_syscall(syscall_nr_getuid);
end;
function sys_geteuid : uid_t;
begin
sys_geteuid:=do_syscall(syscall_nr_geteuid);
end;
function sys_getgid : gid_t;
begin
sys_getgid:=do_syscall(syscall_nr_getgid);
end;
function sys_getegid : gid_t;
begin
sys_getegid:=do_syscall(syscall_nr_getegid);
end;
function sys_setuid(uid : uid_t): cint;
begin
sys_setuid:=do_syscall(syscall_nr_setuid,uid);
end;
function sys_setgid(gid : gid_t): cint;
begin
sys_setgid:=do_syscall(syscall_nr_setgid,gid);
end;
// type tgrparr=array[0..0] of gid_t;
function sys_getgroups(gidsetsize : cint; var grouplist:tgrparr): cint;
begin
sys_getgroups:=do_syscall(syscall_nr_getgroups,gidsetsize,longint(@grouplist));
end;
function sys_getpgrp : pid_t;
begin
sys_getpgrp:=do_syscall(syscall_nr_getpgrp);
end;
function sys_setsid : pid_t;
begin
sys_setsid:=do_syscall(syscall_nr_setsid);
end;
Function sys_umask(cmask:mode_t):mode_t;
{
Sets file creation mask to (Mask and 0777 (octal) ), and returns the
previous value.
}
begin
sys_umask:=Do_syscall(syscall_nr_umask,cmask);
end;
Function sys_link(existing:pchar;_new:pchar):cint;
{
Proceduces a hard link from new to old.
In effect, new will be the same file as old.
}
begin
sys_Link:=Do_Syscall(syscall_nr_link,longint(existing),longint(_new));
end;
Function sys_mkfifo(path:pchar;mode:mode_t):cint;
begin
sys_mkfifo:=do_syscall(syscall_nr_mkfifo,longint(path),longint(mode));
end;
Function sys_chmod(path:pchar;mode:mode_t):cint;
begin
sys_chmod:=do_syscall(syscall_nr_chmod,longint(path),longint(mode));
end;
Function sys_chown(path:pchar;owner:uid_t;group:gid_t):cint;
begin
sys_ChOwn:=do_syscall(syscall_nr_chown,longint(path),longint(owner),longint(group));
end;
Function sys_Utime(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;
sys_utime:=do_syscall(syscall_nr_utimes,longint(path),longint(tvp));
end;
Function sys_pipe(var fildes : tfildes):cint;
begin
sys_pipe:=do_syscall(syscall_nr_pipe,longint(@fildes));
end;
function sys_fcntl(fildes:cint;Cmd:cint;Arg:cint):cint;
begin
sys_fcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd,arg);
end;
function sys_fcntl(fildes:cint;Cmd:cint;var Arg:flock):cint;
begin
sys_fcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd,longint(@arg));
end;
function sys_fcntl(fildes:cint;Cmd:cint):cint;
begin
sys_fcntl:=do_syscall(syscall_nr_fcntl,fildes,cmd);
end;
function sys_execve(path:pchar;argv:ppchar;envp:ppchar):cint;
Begin
sys_execve:=do_syscall(syscall_nr_Execve,longint(path),longint(argv),longint(envp));
End;
function sys_execv(path:pchar;argv:ppchar):cint;
Begin
sys_execv:=do_syscall(syscall_nr_Execve,longint(path),longint(argv),longint(envp));
End;
CONST RUSAGE_SELF = 0;
RUSAGE_CHILDREN = -1;
function sys_getrusage(who:cint;var ru : rusage):cint;
begin
sys_getrusage:=do_syscall(syscall_nr_getrusage,longint(who),longint(@ru));
end;
function sys_times(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 (sys_getrusage(RUSAGE_SELF, ru) < 0) Then
exit(clock_t(-1));
buffer.tms_utime := CONVTCK(ru.ru_utime);
buffer.tms_stime := CONVTCK(ru.ru_stime);
if (sys_getrusage(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));
sys_times:=clock_t(CONVTCK(t));
end;
{
$Log$
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 sys_time
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
}

95
rtl/bsd/bsdmacro.inc
View File

@ -1,95 +0,0 @@
{
$Id$
Copyright (c) 2000-2002 by Marco van de Voort
The *BSD POSIX macro's that are used both in the POSIX 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 S_ISDIR(m : mode_t): boolean;
begin
S_ISDIR:=((m and %001111000000000000) = %100000000000000);
end;
function S_ISCHR(m : mode_t): boolean;
begin
S_ISCHR:=((m and %001111000000000000) = %10000000000000);
end;
function S_ISBLK(m : mode_t): boolean;
begin
S_ISBLK:=((m and %001111000000000000) = %110000000000000);
end;
function S_ISREG(m : mode_t): boolean;
begin
S_ISREG:=((m and %001111000000000000) = %1000000000000000);
end;
function S_ISFIFO(m : mode_t): boolean;
begin
S_ISFIFO:=((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.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.
}

620
rtl/bsd/bsdsysc.inc
View File

@ -1,620 +0,0 @@
{
$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 sys_time(tloc:ptime_t): time_t; cdecl; external name 'time';
function sys_open(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open';
function sys_close(fd : cint): cint; cdecl; external name 'close';
function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t; cdecl; external name 'lseek';
function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external name 'read';
function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
function sys_unlink(const path: pchar): cint; cdecl; external name 'unlink';
function sys_rename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
function sys_stat(const path: pchar; var buf : stat): cint; cdecl; external name 'stat';
function sys_chdir(const path : pchar): cint; cdecl; external name 'chdir';
function sys_mkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
function sys_rmdir(const path : pchar): cint; cdecl; external name 'rmdir';
function sys_opendir(const dirname : pchar): pdir; cdecl; external name 'opendir';
function sys_readdir(var dirp : dir) : pdirent;cdecl; external name 'readdir';
function sys_closedir(var dirp : dir): cint; cdecl; external name 'closedir';
procedure sys_exit(status : cint); cdecl; external name '_exit';
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
function sys_ftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
function sys_rename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
function sys_fstat(fd : cint; var sb : stat): cint; cdecl; external name 'fstat';
function sys_fork : pid_t; cdecl; external name 'fork';
function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; cdecl; external name 'execve';
function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; cdecl; external name 'waitpid';
function sys_access(const pathname : pchar; amode : cint): cint; cdecl; external name 'access';
function sys_uname(var name: utsname): cint; cdecl; external name 'uname';
function sys_Dup(oldd:cint):cint; cdecl; external name 'dup';
function sys_Dup2(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 syscall.inc}
{$I sysnr.inc}
{$I bsdmacro.inc}
{$I bsdtypes.inc}
// Should be moved to a FreeBSD specific unit in the future.
function sys_time( tloc:ptime_t): time_t; [public, alias : 'FPC_SYSC_TIME'];
VAR tv : timeval;
tz : timezone;
retval : longint;
begin
Retval:=do_syscall(syscall_nr_gettimeofday,longint(@tv),longint(@tz));
If retval=-1 then
sys_time:=-1
else
Begin
If Assigned(tloc) Then
TLoc^:=tv.tv_sec;
sys_time:=tv.tv_sec;
End;
End;
{*****************************************************************************
--- File:File handling related calls ---
*****************************************************************************}
function sys_open(const path: pchar; flags : cint; mode: mode_t):cint; [public, alias : 'FPC_SYSC_OPEN'];
Begin
sys_open:=do_syscall(syscall_nr_open,longint(path),longint(flags),longint(mode));
End;
function sys_close(fd : cint): cint;
begin
sys_close:=do_syscall(syscall_nr_close,fd);
end;
function sys_lseek(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
sys_lseek:=do_syscall(syscall_nr___syscall,syscall_nr_lseek,0,longint(fd),0,lo(Offset),{0} hi(offset),Whence);
end;
function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_READ'];
begin
sys_read:=do_syscall(syscall_nr_read,Fd,longint(buf),nbytes);
end;
function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; [public, alias : 'FPC_SYSC_WRITE'];
begin
sys_write:=do_syscall(syscall_nr_write,Fd,longint(buf),nbytes);
end;
function sys_unlink(const path: pchar): cint; [public, alias : 'FPC_SYSC_UNLINK'];
begin
sys_unlink:=do_syscall(syscall_nr_unlink,longint(path));
end;
function sys_rename(const old : pchar; const newpath: pchar): cint; [public, alias : 'FPC_SYSC_RENAME'];
begin
sys_rename:=do_syscall(syscall_nr_rename,longint(old),longint(newpath));
end;
function sys_stat(const path: pchar; var buf : stat):cint; [public, alias : 'FPC_SYSC_STAT'];
begin
sys_stat:=do_syscall(syscall_nr_stat,longint(path),longint(@buf));
end;
{*****************************************************************************
--- Directory:Directory related calls ---
*****************************************************************************}
function sys_chdir(const path : pchar): cint; [public, alias : 'FPC_SYSC_CHDIR'];
begin
sys_chdir:=do_syscall(syscall_nr_chdir,longint(path));
end;
function sys_mkdir(const path : pchar; mode: mode_t):cint; [public, alias : 'FPC_SYSC_MKDIR'];
begin {Mode is 16-bit on F-BSD}
sys_mkdir:=do_syscall(syscall_nr_mkdir,longint(path),mode);
end;
function sys_rmdir(const path : pchar): cint; [public, alias : 'FPC_SYSC_RMDIR'];
begin
sys_rmdir:=do_syscall(syscall_nr_rmdir,longint(path));
end;
{$ifndef NewReaddir}
const DIRBLKSIZ=1024;
function sys_opendir(const dirname : pchar): pdir; [public, alias : 'FPC_SYSC_OPENDIR'];
var
fd:longint;
st:stat;
ptr:pdir;
begin
sys_opendir:=nil;
if sys_stat(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:=sys_open(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^);
sys_opendir:=ptr;
end;
function sys_closedir(dirp : pdir): cint; [public, alias : 'FPC_SYSC_CLOSEDIR'];
begin
sys_closedir:=sys_close(dirp^.dd_fd);
Freemem(dirp^.dd_buf);
dispose(dirp);
end;
function sys_readdir(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,longint(dirp^.dd_fd),longint(@dirp^.dd_buf^),DIRBLKSIZ {sizeof(getdentsbuffer)});
dirp^.dd_rewind:=longint(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;
Sys_ReadDir:=FinalEntry;
end;
{$endif}
{*****************************************************************************
--- Process:Process & program handling - related calls ---
*****************************************************************************}
procedure sys_exit(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 sys_sigaction(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,longint(sig),longint(@act),longint(@oact));
end;
(*=================== MOVED from sysunix.inc ========================*)
function sys_ftruncate(fd : cint; flength : off_t): cint; [public, alias : 'FPC_SYSC_FTRUNCATE'];
{ See notes lseek. This one is completely similar.
}
begin
sys_ftruncate:=Do_syscall(syscall_nr___syscall,syscall_nr_ftruncate,0,fd,0,lo(flength),hi(flength));
end;
function sys_fstat(fd : cint; var sb : stat): cint; [public, alias : 'FPC_SYSC_FSTAT'];
begin
Sys_FStat:=do_SysCall(syscall_nr_fstat,fd,longint(@sb));
end;
{$ifdef NewReaddir}
{$I readdir.inc}
{$endif}
function sys_fork : 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
sys_fork:=Do_syscall(SysCall_nr_fork);
End;
{
function sys_execve(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,longint(@path[1]),longint(Argv),longint(envp));
End;
}
{
function sys_execve(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,longint(path),longint(Argv),longint(envp));
End;
}
function sys_waitpid(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.
sys_WaitPID:=do_syscall(syscall_nr_WaitPID,PID,longint(@Stat_loc),options,0);
end;
function sys_access(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
sys_Access:=do_syscall(syscall_nr_access,longint(pathname),amode);
end;
{
function sys_access(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, longint(@pathname[1]),mode)=0;
end;
}
Function sys_Dup(fildes:cint):cint; [public, alias : 'FPC_SYSC_DUP'];
begin
sys_dup:=Do_syscall(syscall_nr_dup,longint(fildes));
end;
Function sys_Dup2(fildes,fildes2:cint):cint; [public, alias : 'FPC_SYSC_DUP2'];
begin
sys_dup2:=do_syscall(syscall_nr_dup2,longint(fildes),longint(fildes2));
end;
CONST
{ Constansts for MMAP }
MAP_PRIVATE =2;
MAP_ANONYMOUS =$1000;
Function Sys_mmap(adr,len,prot,flags,fdes,off:longint):longint; [public, alias : 'FPC_SYSC_MMAP'];
begin
Sys_mmap:=do_syscall(syscall_nr_mmap,Adr,Len,Prot,Flags,fdes,off,0);
end;
Function Sys_munmap(adr:longint;len:size_t):longint; [public, alias :'FPC_SYSC_MUNMAP'];
begin
Sys_munmap:=do_syscall(syscall_nr_munmap,longint(Adr),Len);
end;
Function sbrk(size : longint) : Longint;
begin
sbrk:=Sys_mmap(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 Sys_IOCtl(Handle,Ndx: Longint;Data: Pointer):LongInt; [public, alias : 'FPC_SYSC_IOCTL'];
// This was missing here, instead hardcoded in Do_IsDevice
begin
Sys_IOCtl:=do_SysCall(syscall_nr_ioctl,handle,Ndx,longint(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:=(sys_ioctl(handle,IOCTL_TCGETS,@data)<>-1);
end;
Function sys_GetPid:LongInt; [public, alias : 'FPC_SYSC_GETPID'];
{
Get Process ID.
}
begin
sys_GetPID:=do_syscall(syscall_nr_getpid);
end;
Function Sys_ReadLink(name,linkname:pchar;maxlen:longint):longint; [public, alias : 'FPC_SYSC_READLINK'];
begin
sys_readlink:=do_syscall(syscall_nr_readlink, longint(name),longint(linkname),maxlen);
end;
Function sys_NanoSleep(const req : timespec;var rem : timespec) : longint; [public, alias : 'FPC_SYSC_NANOSLEEP'];
begin
sys_NanoSleep:=Do_SysCall(syscall_nr_nanosleep,longint(@req),longint(@rem));
end;
function sys_getcwd(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,longint(pt),longint( 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;
sys_getcwd:=pt;
end;
{$endif}
{
$Log$
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
* 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.
}

37
rtl/bsd/bsdsysch.inc
View File

@ -1,37 +0,0 @@
{
$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 Sys_mmap(adr,len,prot,flags,fdes,off:longint):longint; external name 'FPC_SYSC_MMAP';
Function Sys_munmap(adr:longint;len:size_t):longint; external name 'FPC_SYSC_MUNMAP';
Function Sys_IOCtl(Handle,Ndx: Longint;Data: Pointer):LongInt; external name 'FPC_SYSC_IOCTL';
Function sys_GetPid:LongInt; external name 'FPC_SYSC_GETPID';
Function Sys_ReadLink(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 sys_NanoSleep (const req : timespec;var rem : timespec) : longint; external name 'FPC_SYSC_NANOSLEEP';
{ can be used for getdir?}
Function sys_getcwd (pt:pchar; _size:size_t):pchar; external name 'FPC_SYSC_GETCWD';
{
$Log$
Revision 1.4 2002-10-27 11:58:29 marco
* Modifications from Saturday.
}

79
rtl/bsd/bsdtypes.inc
View File

@ -1,79 +0,0 @@
{
$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.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.
}

119
rtl/bsd/osposix.inc
View File

@ -1,119 +0,0 @@
{
$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 bsdtypes.inc}
{$I bsdmacro.inc}
{$ifdef uselibc}
{$Linklib c}
{ var
Errno : cint; external name 'errno';}
function sys_time(var tloc:time_t): time_t; cdecl; external name 'time';
function sys_open(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open';
function sys_close(fd : cint): cint; cdecl; external name 'close';
function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t; cdecl; external name 'lseek';
function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external name 'read';
function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
function sys_unlink(const path: pchar): cint; cdecl; external name 'unlink';
function sys_rename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
function sys_stat(const path: pchar; var buf : stat): cint; cdecl; external name 'stat';
function sys_chdir(const path : pchar): cint; cdecl; external name 'chdir';
function sys_mkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
function sys_rmdir(const path : pchar): cint; cdecl; external name 'rmdir';
function sys_opendir(const dirname : pchar): pdir; cdecl; external name 'opendir';
function sys_readdir(var dirp : dir) : pdirent;cdecl; external name 'readdir';
function sys_closedir(var dirp : dir): cint; cdecl; external name 'closedir';
procedure sys_exit(status : cint); cdecl; external name '_exit';
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
function sys_ftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
function sys_rename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
function sys_fstat(fd : cint; var sb : stat): cint; cdecl; external name 'fstat';
function sys_fork : pid_t; cdecl; external name 'fork';
function sys_execve(path : pchar; argv : ppchar; envp: ppchar): cint; cdecl; external name 'execve';
function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; cdecl; external name 'waitpid';
function sys_access(const pathname : pchar; amode : cint): cint; cdecl; external name 'access';
function sys_uname(var name: utsname): cint; cdecl; external name 'uname';
function sys_Dup(fildes:cint):cint; cdecl; external name 'dup';
function sys_Dup2(fildes:cint;fildes2:cint):cint; cdecl; external name 'dup2';
{$else}
// uses syscalls.
function sys_time(var tloc:time_t): time_t; external name 'FPC_SYSC_TIME';
function sys_open(const path: pchar; flags : cint; mode: mode_t):cint; external name 'FPC_SYSC_OPEN';
function sys_close(fd : cint): cint; external name 'FPC_SYSC_CLOSE';
function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t; external name 'FPC_SYSC_LSEEK';
function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t; external name 'FPC_SYSC_READ';
function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; external name 'FPC_SYSC_WRITE';
function sys_unlink(const path: pchar): cint; external name 'FPC_SYSC_UNLINK';
function sys_rename(const old : pchar; const newpath: pchar): cint; external name 'FPC_SYSC_RENAME';
function sys_stat(const path: pchar; var buf : stat):cint; external name 'FPC_SYSC_STAT';
function sys_chdir(const path : pchar): cint; external name 'FPC_SYSC_CHDIR';
function sys_mkdir(const path : pchar; mode: mode_t):cint; external name 'FPC_SYSC_MKDIR';
function sys_rmdir(const path : pchar): cint; external name 'FPC_SYSC_RMDIR';
function sys_opendir(const dirname : pchar): pdir; external name 'FPC_SYSC_OPENDIR';
function sys_closedir(var dirp : dir): cint; external name 'FPC_SYSC_CLOSEDIR';
function sys_readdir(var dirp : dir) : pdirent; external name 'FPC_SYSC_READDIR';
procedure sys_exit(status : cint); external name 'FPC_SYSC_EXIT';
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; external name 'FPC_SYSC_SIGACTION';
function sys_ftruncate(fd : cint; flength : off_t): cint; external name 'FPC_SYSC_FTRUNCATE';
function sys_fstat(fd : cint; var sb : stat): cint; external name 'FPC_SYSC_FSTAT';
function sys_fork : pid_t; external name 'FPC_SYSC_FORK';
// function sys_execve(path : pchar; argv : ppchar;envp: ppchar): cint; external name 'FPC_SYSC_EXECVE';
function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; external name 'FPC_SYSC_WAITPID';
function sys_access(const pathname : pchar; amode : cint): cint;external name 'FPC_SYSC_ACCESS';
function sys_Dup(fildes:cint):cint; external name 'FPC_SYSC_DUP';
function sys_Dup2(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 bsdfuncs.inc}
{
$Log$
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.
}

188
rtl/bsd/osposixh.inc
View File

@ -1,188 +0,0 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
Implements roughly POSIX 1003.1 conforming interface for *BSD
header part.
This file implements all the types/constants which must
be defined to port FPC to a new POSIX compliant OS.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{***********************************************************************}
{ POSIX STRUCTURES }
{***********************************************************************}
{$i ptypes.inc}
// Can't find these two in Posix and in FreeBSD
//CONST
// _UTSNAME_LENGTH = ;
// _UTSNAME_NODENAME_LENGTH = ;
TYPE
{ system information services }
utsname = record
sysname : Array[0..SYS_NMLN-1] OF Char; // Name of this OS
nodename: Array[0..SYS_NMLN-1] OF Char; // Name of this network node.
release : Array[0..SYS_NMLN-1] OF Char; // Release level.
version : Array[0..SYS_NMLN-1] OF Char; // Version level.
machine : Array[0..SYS_NMLN-1] OF Char; // Hardware type.
end;
{ file characteristics services }
stat = record { the types are real}
st_dev : dev_t; // inode's device
st_ino : ino_t; // inode's number
st_mode : mode_t; // inode protection mode
st_nlink : nlink_t; // number of hard links
st_uid : uid_t; // user ID of the file's owner
st_gid : gid_t; // group ID of the file's group
st_rdev : dev_t; // device type
st_atime : time_t; // time of last access
st_atimensec : clong; // nsec of last access
st_mtime : time_t; // time of last data modification
st_mtimensec : clong; // nsec of last data modification
st_ctime : time_t; // time of last file status change
st_ctimensec : clong; // nsec of last file status change
st_size : off_t; // file size, in bytes
st_blocks : cint64; // blocks allocated for file
st_blksize : cuint32; // optimal blocksize for I/O
st_flags : cuint32; // user defined flags for file
st_gen : cuint32; // file generation number
{$ifndef NetBSD}
st_lspare : cint32;
{$endif}
st_qspare : array[0..1] Of cint64;
end;
{ directory services }
pdirent = ^dirent;
dirent = record
d_fileno : cuint32; // file number of entry
d_reclen : cuint16; // length of this record
d_type : cuint8; // file type, see below
d_namlen : cuint8; // length of string in d_name
d_name : array[0..(255 + 1)-1] of char; // name must be no longer than this
end;
pdir = ^dir;
dir = packed record
dd_fd : cint; // file descriptor associated with directory
dd_loc : clong; // offset in current buffer
dd_size : clong; // amount of data returned by getdirentries
dd_buf : pchar; // data buffer
dd_len : cint; // size of data buffer
dd_seek : clong; // magic cookie returned by getdirentries
dd_rewind : clong; // magic cookie for rewinding
dd_flags : cint; // flags for readdir
end;
putimbuf = ^utimbuf;
utimbuf = record
actime : time_t;
modtime : time_t;
end;
flock = record
l_start : off_t; { starting offset }
l_len : off_t; { len = 0 means until end of file }
l_pid : pid_t; { lock owner }
l_type : cshort; { lock type: read/write, etc. }
l_whence: cshort; { type of l_start }
end;
tms = packed record
tms_utime : clock_t; { User CPU time }
tms_stime : clock_t; { System CPU time }
tms_cutime : clock_t; { User CPU time of terminated child procs }
tms_cstime : clock_t; { System CPU time of terminated child procs }
end;
{***********************************************************************}
{ POSIX CONSTANT ROUTINE DEFINITIONS }
{***********************************************************************}
CONST
{ access routine - these maybe OR'ed together }
F_OK = 0; { test for existence of file }
R_OK = 4; { test for read permission on file }
W_OK = 2; { test for write permission on file }
X_OK = 1; { test for execute or search permission }
{ seek routine }
SEEK_SET = 0; { seek from beginning of file }
SEEK_CUR = 1; { seek from current position }
SEEK_END = 2; { seek from end of file }
{ open routine }
{ File access modes for `open' and `fcntl'. }
O_RDONLY = 0; { Open read-only. }
O_WRONLY = 1; { Open write-only. }
O_RDWR = 2; { Open read/write. }
{ Bits OR'd into the second argument to open. }
O_CREAT = $200; { Create file if it doesn't exist. }
O_EXCL = $800; { Fail if file already exists. }
O_TRUNC = $400; { Truncate file to zero length. }
O_NOCTTY = $8000; { Don't assign a controlling terminal. }
{ File status flags for `open' and `fcntl'. }
O_APPEND = 8; { Writes append to the file. }
O_NONBLOCK = 4; { Non-blocking I/O. }
{ mode_t possible values }
S_IRUSR = %0100000000; { Read permission for owner }
S_IWUSR = %0010000000; { Write permission for owner }
S_IXUSR = %0001000000; { Exec permission for owner }
S_IRGRP = %0000100000; { Read permission for group }
S_IWGRP = %0000010000; { Write permission for group }
S_IXGRP = %0000001000; { Exec permission for group }
S_IROTH = %0000000100; { Read permission for world }
S_IWOTH = %0000000010; { Write permission for world }
S_IXOTH = %0000000001; { Exec permission for world }
{ Used for waitpid }
WNOHANG = 1; { don't block waiting }
WUNTRACED = 2; { report status of stopped children }
{*************************************************************************}
{ SIGNALS }
{*************************************************************************}
{$i signal.inc}
// function geterrno:longint;
// procedure seterrno(i:longint);
{
$Log$
Revision 1.6 2002-10-27 17:21:29 marco
* Only "difficult" functions + execvp + termios + rewinddir left to do
Revision 1.5 2002/10/27 11:58:30 marco
* Modifications from Saturday.
Revision 1.4 2002/09/07 16:01:17 peter
* old logs removed and tabs fixed
Revision 1.3 2002/08/21 07:03:16 marco
* Fixes from Tuesday.
Revision 1.2 2002/08/19 12:29:11 marco
* First working POSIX *BSD system unit.
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.
}