Browse Source

* superceded by bunxfunc.inc

marco 22 years ago
parent
commit
b316d02f8d
1 changed files with 0 additions and 461 deletions
  1. 0 461
      rtl/linux/posfuncs.inc

+ 0 - 461
rtl/linux/posfuncs.inc

@@ -1,461 +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      = 1024;	// highest signal version
-   wordsinsigset   = 32;	// 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;
-    retval  : cuint;
-	
-Begin
-//      register struct itimerval *itp = &it;
-
- it.it_interval.tv_sec:=0;
- it.it_interval.tv_usec:=0;
- it.it_value.tv_usec:=0;
- it.it_value.tv_sec:=seconds;
- If SetITimer(ITIMER_REAL,it,oitv)<0 Then
-   Exit(0);			// different from *BSD!
-
- retval:= oitv.it_value.tv_usec;
- if retval<>0 Then
-   inc(retval);
- sys_Alarm:=retval;
-End;
-
-// The following versions are for internal use _ONLY_
-// This because it works for the first 32 signals _ONLY_, but that 
-// is enough since they are depreciated, and for legacy applications
-// anyway.
-
-function sigblock(mask:cuint):cint;
-
-var nset,oset: sigset_t;
-
-begin
- sys_sigemptyset(nset); 
- // sys_sigaddset(nset,mask);   needs _mask_
- nset[0]:=mask;
- sigblock:= sys_sigprocmask(SIG_BLOCK,nset,oset);   // SIG_BLOCK=1
- if sigblock=0 Then
-  sigblock:=oset[0];
-end;
-
-function sigpause(sigmask:cint):cint;
-
-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;
-{see comments in libc}
-
-var time_to_sleep,time_remaining : timespec;
-    nset,oset  : sigset_t;
-    oerrno     : cint;
-    oact       : sigactionrec;
-
-begin
-	time_to_sleep.tv_sec := seconds;
-	time_to_sleep.tv_nsec := 0;
-	 sys_sigemptyset(nset);
-         sys_sigaddset  (nset,SIGCHLD);
-     	 if sys_sigprocmask(SIG_BLOCK,nset,oset) Then
-          exit(-1);
-	if not sys_sigismember(oset,SIGCHLD) Then
-          Begin
-	    sigemptyset(nset);
-            sigaddset  (nset,SIGCHLD);
-    	    if sys_sigaction(SIGCHLD,NIL,oact)<0 Then
-	      begin
- 	        oerrno:=geterrno;	
-		sys_sigprocmask(SIG_SETMASK,oset,NIL);
-		seterrno(oerrno);
-		exit(-1);
-	      End;
-	    if oact.sa_handler=SIG_IGN Then
-	     Begin
-	       result:=sys_nanosleep(time_to_sleep, time_remaining)	       
-	       oerrno:=geterrno;
-	       sys_sigprocmask(SIG_SETMASK,oset,NIL);
-	       seterrno(oerrno);
-	     End
-	    Else
-	     Begin
-	       sys_sigprocmask(SIG_SETMASK,oset,NIL);
-	       result:=sys_nanosleep(time_to_sleep, time_remaining)	       
-	     End;
-	  end
-	else
-            result:=sys_nanosleep(time_to_sleep, time_remaining)	       
-	if res<>0 Then
-	 if ts.tv_nsec>=500000000 Then
-	  inc(result);
-End;
-
-function sys_uname(var name:utsname):cint; [public,alias:'FPC_SYSC_UNAME'];
-
-begin
-  sys_uname:=Do_Syscall(sys_nr_uname,TSysParam(@name0);
-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 tx  : utimbuf;
-    ty  : ^utimbuf;
-
-begin
- if times=nil Then
-   ty:=nil
- else
-   begin
-    tx.actime:=times[0].tv_sec+ times[0].utv_sec div 1000000;
-    tx.modtime:=times[1].tv_sec+ times[1].utv_sec div 1000000;
-    ty:=@tx;
-   end;
- sys_utime:=do_syscall(syscall_nr_utimes,TSysParam(path),TSysParam(ty));
-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;
-begin
-  sys_times:=Do_syscall(syscall_nr_times,TSysParam(@tms));
-end;
-
-{
- $Log$
- Revision 1.1  2002-11-14 16:48:39  marco
-  * Initial version
-
- 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
-}