fpc/rtl/linux/posfuncs.inc

{
    $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
}