Browse Source

* FreeBSD support and removed old signalhandling

marco 25 years ago
parent
commit
d36f066e6a
8 changed files with 703 additions and 427 deletions
  1. 64 23
      rtl/linux/bsdsysca.inc
  2. 268 0
      rtl/linux/linsock.inc
  3. 12 9
      rtl/linux/linsysca.inc
  4. 13 143
      rtl/linux/linux.pp
  5. 5 1
      rtl/linux/objinc.inc
  6. 204 0
      rtl/linux/signal.inc
  7. 87 249
      rtl/linux/sockets.pp
  8. 50 2
      rtl/linux/syscalls.inc

+ 64 - 23
rtl/linux/bsdsysca.inc

@@ -137,7 +137,7 @@ begin
  LinuxError:=ErrNo;
 end;
 
-Function WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
+Function WaitPid(Pid:longint;Status:pointer;Options:longint):Longint;
 {
   Waits until a child with PID Pid exits, or returns if it is exited already.
   Any resources used by the child are freed.
@@ -535,7 +535,7 @@ begin
 end;
 
 
-Function Kill(Pid:longint;Sig:integer):integer;
+Function Kill(Pid:longint;Sig:longint):integer;
 {
   Send signal 'sig' to a process, or a group of processes.
   If Pid >  0 then the signal is sent to pid
@@ -552,20 +552,7 @@ begin
  LinuxError:=Errno;
 end;
 
-Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
-{
-  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(signum),longint(act),longint(oldact));
- LinuxError:=Errno;
-end;
-
-Procedure SigProcMask(How:Integer;SSet,OldSSet:PSigSet);
+Procedure SigProcMask(How:longint;SSet,OldSSet:PSigSet);
 {
   Change the list of currently blocked signals.
   How determines which signals will be blocked :
@@ -629,17 +616,71 @@ begin
 end;
 
 function MUnMap (P : Pointer; Size : Longint) : Boolean;
-Var
-  Sr : Syscallregs;
+
 begin
-  Sr.reg2:=longint(P);
-  sr.reg3:=Size;
-  MUnMap:=syscall(syscall_nr_munmap,P,Size,0)=0;
+  MUnMap:=do_syscall(syscall_nr_munmap,longint(P),Size)=0;
   LinuxError:=Errno;
 end;
+
+
+function signal(signum:longint;Handler:signalhandler):signalhandler;
+
+var sa,osa : sigactionrec;
+
+begin
+     sa.handler.sh:=handler;
+     FillChar(sa.sa_mask,sizeof(sigset),#0);
+     sa.sa_flags := 0;
+{     if (sigintr and signum) =0 then
 {restart behaviour needs libc}
+      sa.sa_flags :=sa.sa_flags or SA_RESTART;
}
+     sigaction(signum,@sa,@osa);
+     if ErrNo<>0 then
+      signal:=NIL
+     else
+      signal:=osa.handler.sh;
+     LinuxError:=Errno;
+
+end;
+
+
+function  Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint; assembler;
+asm
+	pushl	%esi
+	movl	12(%ebp), %esi	// get stack addr
+	subl	$4, %esi
+	movl	20(%ebp), %eax	// get __arg
+	movl	%eax, (%esi)
+	subl	$4, %esi
+	movl	8(%ebp), %eax	// get __fn
+	movl	%eax, (%esi)
+	pushl	16(%ebp)
+	pushl	%esi
+	mov	syscall_nr_rfork, %eax
+	int     $0x80                  // call actualsyscall
+	jb 	.L2
+	test    %edx, %edx
+	jz	.L1
+	movl	%esi,%esp
+	popl	%eax
+	call	%eax
+	addl	$8, %esp
+        call	halt		// Does not return
+.L2:	
+	mov	%eax,ErrNo
+	mov	$-1,%eax
+	jmp     .L1
+//	jmp	PIC_PLT(HIDENAME(cerror))
+.L1:
+	addl	$8, %esp
+	popl	%esi
+end;
+
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:47  michael
+  Revision 1.3  2000-09-11 14:05:31  marco
+   * FreeBSD support and removed old signalhandling
+
+  Revision 1.2  2000/07/13 11:33:47  michael
   + removed logs
  
-}
+}

+ 268 - 0
rtl/linux/linsock.inc

@@ -0,0 +1,268 @@
+{
+   $Id$
+   This file is part of the Free Pascal run time library.
+   Copyright (c) 2000 by Marco van de Voort
+     member of the Free Pascal development team.
+
+   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
+  {
+    Arguments to the Linux Kernel system call for sockets. All
+    Socket Connected calls go through the same system call,
+    with an extra argument to determine what action to take.
+  }
+  Socket_Sys_SOCKET      = 1;
+  Socket_Sys_BIND        = 2;
+  Socket_Sys_CONNECT     = 3;
+  Socket_Sys_LISTEN      = 4;
+  Socket_Sys_ACCEPT      = 5;
+  Socket_Sys_GETSOCKNAME = 6;
+  Socket_Sys_GETPEERNAME = 7;
+  Socket_Sys_SOCKETPAIR  = 8;
+  Socket_Sys_SEND        = 9;
+  Socket_Sys_RECV        = 10;
+  Socket_Sys_SENDTO      = 11;
+  Socket_Sys_RECVFROM    = 12;
+  Socket_Sys_SHUTDOWN    = 13;
+  Socket_Sys_SETSOCKOPT  = 14;
+  Socket_Sys_GETSOCKOPT  = 15;
+  Socket_Sys_SENDMSG     = 16;
+  Socket_Sys_RECVMSG     = 17;
+
+
+Function SocketCall(SockCallNr,a1,a2,a3,a4,a5,a6:longint):longint;
+var
+  Regs:SysCallRegs;
+  Args:array[1..6] of longint;
+begin
+{$IFNDEF BSD}
+  args[1]:=a1;
+  args[2]:=a2;
+  args[3]:=a3;
+  args[4]:=a4;
+  args[5]:=a5;
+  args[6]:=a6;
+  regs.reg2:=SockCallNr;
+  regs.reg3:=Longint(@args);
+  SocketCall:=Syscall(syscall_nr_socketcall,regs);
+  If SocketCall<0 then
+   SocketError:=Errno
+  else 
+   SocketError:=0;
+ {$ELSE}
+  SocketError:=-1;
+ {$ENDIF}
+end;
+
+
+Function SocketCall(SockCallNr,a1,a2,a3:longint):longint;
+begin
+  SocketCall:=SocketCall(SockCallNr,a1,a2,a3,0,0,0);
+end;
+
+
+{******************************************************************************
+                          Basic Socket Functions
+******************************************************************************}
+
+Function socket(Domain,SocketType,Protocol:Longint):Longint;
+begin
+  Socket:=SocketCall(Socket_Sys_Socket,Domain,SocketType,ProtoCol);
+end;
+
+
+
+Function Send(Sock:Longint;Var Addr;AddrLen,Flags:Longint):Longint;
+begin
+  Send:=SocketCall(Socket_Sys_Send,Sock,Longint(@Addr),AddrLen,Flags,0,0);
+end;
+
+
+
+Function Recv(Sock:Longint;Var Addr;AddrLen,Flags:Longint):Longint;
+begin
+  Recv:=SocketCall(Socket_Sys_Recv,Sock,Longint(@Addr),AddrLen,Flags,0,0);
+end;
+
+
+
+Function Bind(Sock:Longint;Var Addr;AddrLen:Longint):Boolean;
+begin
+  Bind:=(SocketCall(Socket_Sys_Bind,Sock,Longint(@Addr),AddrLen)=0);
+end;
+
+
+
+Function Listen(Sock,MaxConnect:Longint):Boolean;
+begin
+  Listen:=(SocketCall(Socket_Sys_Listen,Sock,MaxConnect,0)=0);
+end;
+
+
+
+Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+  Accept:=SocketCall(Socket_Sys_Accept,Sock,longint(@Addr),longint(@AddrLen));
+  If Accept<0 Then
+    Accept:=-1;
+end;
+
+
+
+Function Connect(Sock:Longint;Var Addr;Addrlen:Longint): boolean;
+
+begin
+  Connect:=SocketCall(Socket_Sys_Connect,Sock,longint(@Addr),AddrLen)=0;
+end;
+
+
+
+Function Shutdown(Sock:Longint;How:Longint):Longint;
+begin
+  ShutDown:=SocketCall(Socket_Sys_ShutDown,Sock,How,0);
+end;
+
+
+
+Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+  GetSocketName:=SocketCall(Socket_Sys_GetSockName,Sock,longint(@Addr),longint(@AddrLen));
+end;
+
+
+
+Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
+begin
+  GetPeerName:=SocketCall(Socket_Sys_GetPeerName,Sock,longint(@Addr),longint(@AddrLen));
+end;
+
+
+
+Function SetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;optlen:longint):Longint;
+begin
+  SetSocketOptions:=SocketCall(Socket_Sys_SetSockOpt,Sock,Level,OptName,Longint(@OptVal),OptLen,0);
+end;
+
+
+
+Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
+begin
+  GetSocketOptions:=SocketCall(Socket_Sys_GetSockOpt,Sock,Level,OptName,Longint(@OptVal),OptLen,0);
+end;
+
+
+
+Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
+begin
+  SocketPair:=SocketCall(Socket_Sys_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
+end;
+
+{******************************************************************************
+                               UnixSock
+******************************************************************************}
+
+Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint);
+begin
+  Move(Addr[1],t.Path,length(Addr));
+  t.Family:=AF_UNIX;
+  t.Path[length(Addr)]:=#0;
+  Len:=Length(Addr)+3;
+end;
+
+
+Function Bind(Sock:longint;const addr:string):boolean;
+var
+  UnixAddr : TUnixSockAddr;
+  AddrLen  : longint;
+begin
+  Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+  Bind(Sock,UnixAddr,AddrLen);
+  Bind:=(SocketError=0);
+end;
+
+
+
+Function DoAccept(Sock:longint;var addr:string):longint;
+var
+  UnixAddr : TUnixSockAddr;
+  AddrLen  : longint;
+begin
+  AddrLen:=length(addr)+3;
+  DoAccept:=Accept(Sock,UnixAddr,AddrLen);
+  Move(UnixAddr.Path,Addr[1],AddrLen);
+  SetLength(Addr,AddrLen);
+end;
+
+
+
+Function DoConnect(Sock:longint;const addr:string):Boolean;
+var
+  UnixAddr : TUnixSockAddr;
+  AddrLen  : longint;
+begin
+  Str2UnixSockAddr(addr,UnixAddr,AddrLen);
+  DoConnect:=Connect(Sock,UnixAddr,AddrLen);
+end;
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
+var
+  s : longint;
+begin
+  S:=DoAccept(Sock,addr);
+  if S>0 then
+   begin
+     Sock2Text(S,SockIn,SockOut);
+     Accept:=true;
+   end
+  else
+   Accept:=false;
+end;
+
+
+
+Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
+var
+  s : longint;
+begin
+  S:=DoAccept(Sock,addr);
+  if S>0 then
+   begin
+     Sock2File(S,SockIn,SockOut);
+     Accept:=true;
+   end
+  else
+   Accept:=false;
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
+begin
+  Connect:=DoConnect(Sock,addr);
+  If Connect then
+     Sock2Text(Sock,SockIn,SockOut);
+end;
+
+
+
+Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
+begin
+  Connect:=DoConnect(Sock,addr);
+  if Connect then
+     Sock2File(Sock,SockIn,SockOut);
+end;
+
+{
+  $Log$
+  Revision 1.2  2000-09-11 14:05:31  marco
+   * FreeBSD support and removed old signalhandling
+
+}

+ 12 - 9
rtl/linux/linsysca.inc

@@ -730,7 +730,7 @@ Begin
 End;
 
 
-Function Kill(Pid:longint;Sig:integer):integer;
+Function Kill(Pid:longint;Sig:longint):integer;
 {
   Send signal 'sig' to a process, or a group of processes.
   If Pid >  0 then the signal is sent to pid
@@ -751,8 +751,9 @@ begin
 end;
 
 
-
-Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
+{ Moved to syscalls.inc, because it is needed for initialising the runerror/
+exceptions system
+Procedure SigAction(Signum:longint;Var Act,OldAct:PSigActionRec );
 {
   Change action of process upon receipt of a signal.
   Signum specifies the signal (all except SigKill and SigStop).
@@ -768,10 +769,8 @@ begin
   SysCall(Syscall_nr_sigaction,sr);
   linuxerror:=errno;
 end;
-
-
-
-Procedure SigProcMask(How:Integer;SSet,OldSSet:PSigSet);
+}
+Procedure SigProcMask(How:longint;SSet,OldSSet:PSigSet);
 {
   Change the list of currently blocked signals.
   How determines which signals will be blocked :
@@ -824,7 +823,7 @@ end;
 
 
 
-Function Signal(Signum:Integer;Handler:SignalHandler):SignalHandler;
+Function Signal(Signum:longint;Handler:SignalHandler):SignalHandler;
 {
   Install a new handler for signal Signum.
   The old signal handler is returned.
@@ -1191,9 +1190,13 @@ begin
   end ['ECX','EDI','EDX'];
 end;
 {$ENDIF}  
+
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:48  michael
+  Revision 1.3  2000-09-11 14:05:31  marco
+   * FreeBSD support and removed old signalhandling
+
+  Revision 1.2  2000/07/13 11:33:48  michael
   + removed logs
  
 }

+ 13 - 143
rtl/linux/linux.pp

@@ -23,6 +23,7 @@ Interface
 { Get System call numbers and error-numbers}
 {$i sysnr.inc}
 {$i errno.inc}
+{$I signal.inc}
 
 var
   ErrNo,
@@ -32,8 +33,7 @@ var
 {********************
       Process
 ********************}
-{$ifndef BSD} {BSD doesn't know signals}
-const
+const
 {Checked for BSD using Linuxthreads port}
   { cloning flags }
   CSIGNAL       = $000000ff; // signal mask to be sent at exit
   CLONE_VM      = $00000100; // set if VM shared between processes
@@ -43,7 +43,6 @@ const
   CLONE_PID     = $00001000; // set if pid shared
 type
   TCloneFunc=function(args:pointer):longint;cdecl;
-{$endif}
 
 const
   { For getting/setting priority }
@@ -105,136 +104,6 @@ const
   F_GetOwn = 8;
   F_SetOwn = 9;
 
-
-
-{********************
-      Signal
-********************}
-
-Const
-  { For sending a signal }
-  SA_NOCLDSTOP = 1;
-  SA_SHIRQ     = $04000000;
-  SA_STACK     = $08000000;
-  SA_RESTART   = $10000000;
-  SA_INTERRUPT = $20000000;
-  SA_NOMASK    = $40000000;
-  SA_ONESHOT   = $80000000;
-
-  SIG_BLOCK   = 0;
-  SIG_UNBLOCK = 1;
-  SIG_SETMASK = 2;
-
-  SIG_DFL = 0 ;
-  SIG_IGN = 1 ;
-  SIG_ERR = -1 ;
-
-  SIGHUP     = 1;
-  SIGINT     = 2;
-  SIGQUIT    = 3;
-  SIGILL     = 4;
-  SIGTRAP    = 5;
-  SIGABRT    = 6;
-  SIGIOT     = 6;
-  SIGBUS     = 7;
-  SIGFPE     = 8;
-  SIGKILL    = 9;
-  SIGUSR1    = 10;
-  SIGSEGV    = 11;
-  SIGUSR2    = 12;
-  SIGPIPE    = 13;
-  SIGALRM    = 14;
-  SIGTerm    = 15;
-  SIGSTKFLT  = 16;
-  SIGCHLD    = 17;
-  SIGCONT    = 18;
-  SIGSTOP    = 19;
-  SIGTSTP    = 20;
-  SIGTTIN    = 21;
-  SIGTTOU    = 22;
-  SIGURG     = 23;
-  SIGXCPU    = 24;
-  SIGXFSZ    = 25;
-  SIGVTALRM  = 26;
-  SIGPROF    = 27;
-  SIGWINCH   = 28;
-  SIGIO      = 29;
-  SIGPOLL    = SIGIO;
-  SIGPWR     = 30;
-  SIGUNUSED  = 31;
-
-Type
-  SignalHandler   = Procedure(Sig : LongInt);cdecl;
-  PSignalHandler  = ^SignalHandler;
-  SignalRestorer  = Procedure;cdecl;
-  PSignalRestorer = ^SignalRestorer;
-
-{$ifdef BSD}
-  SigSet  = Array[0..31] of byte;
-{$else}
-  SigSet  = Longint;
-{$endif}
-  PSigSet = ^SigSet;
-
-  tfpreg = record
-          significand: array[0..3] of word;
-          exponent: word;
-  end;
-
-  pfpstate = ^tfpstate;
-  tfpstate = record
-           cw, sw, tag, ipoff, cssel, dataoff, datasel: cardinal;
-           st: array[0..7] of tfpreg;
-           status: cardinal;
-  end;
-
-{$ifdef i386}
-  PSigContextRec = ^SigContextRec;
-  SigContextRec = record
-    gs, __gsh: word;
-    fs, __fsh: word;
-    es, __esh: word;
-    ds, __dsh: word;
-    edi: cardinal;
-    esi: cardinal;
-    ebp: cardinal;
-    esp: cardinal;
-    ebx: cardinal;
-    edx: cardinal;
-    ecx: cardinal;
-    eax: cardinal;
-    trapno: cardinal;
-    err: cardinal;
-    eip: cardinal;
-    cs, __csh: word;
-    eflags: cardinal;
-    esp_at_signal: cardinal;
-    ss, __ssh: word;
-    fpstate: pfpstate;
-    oldmask: cardinal;
-    cr2: cardinal;
-  end;
-  TSigContextRec = SigContextRec;
-{$endif}
-
-  TSigAction = procedure(Sig: Longint; SigContext: SigContextRec);cdecl;
-
-  PSigActionRec = ^SigActionRec;
-  SigActionRec = packed record
-    Handler  : record
-      case byte of
-        0: (Sh: SignalHandler);
-        1: (Sa: TSigAction);
-      end;
-    Sa_Mask     : SigSet;
-    Sa_Flags    : Longint;
-    {$ifndef BSD}
-    Sa_restorer : SignalRestorer; { Obsolete - Don't use }
-    {$endif}
-  end;
-  TSigActionRec = SigActionRec;
-
-
 {********************
    IOCtl(TermIOS)
 ********************}
@@ -540,7 +409,6 @@ Type
 ******************************************************************************}
 
 {$ifdef bsd}
-
 function Do_SysCall(sysnr:longint):longint;
 function Do_Syscall(sysnr,param1:integer):longint;
 function Do_SysCall(sysnr,param1:LONGINT):longint;
@@ -548,6 +416,7 @@ function Do_SysCall(sysnr,param1,param2:LONGINT):longint;
 function Do_SysCall(sysnr,param1,param2,param3:LONGINT):longint;
 function Do_SysCall(sysnr,param1,param2,param3,param4:LONGINT):longint;
 function Do_SysCall(sysnr,param1,param2,param3,param4,param5:LONGINT):longint;
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:LONGINT):longint;
 function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:LONGINT):longint;
 {$else}
 Function SysCall(callnr:longint;var regs:SysCallregs):longint;
@@ -597,9 +466,8 @@ Procedure Execlp(Todo:string;Ep:ppchar);
 Function  Shell(const Command:String):Longint;
 Function  Shell(const Command:AnsiString):Longint;
 Function  Fork:longint;
-{$ifndef BSD}
+{Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
 function  Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
-{$endif}
 Procedure ExitProcess(val:longint);
 Function  WaitPid(Pid:longint;Status:pointer;Options:Integer):Longint;
 Procedure Nice(N:integer);
@@ -726,14 +594,12 @@ Function  Uname(var unamerec:utsname):Boolean;
         Signal
 ***************************}
 
-Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
-Procedure SigProcMask (How:Integer;SSet,OldSSet:PSigSet);
+Procedure SigAction(Signum:longint;Act,OldAct:PSigActionRec );
+Procedure SigProcMask (How:longint;SSet,OldSSet:PSigSet);
 Function  SigPending:SigSet;
 Procedure SigSuspend(Mask:Sigset);
-{$ifndef BSD}
-Function  Signal(Signum:Integer;Handler:SignalHandler):SignalHandler;
-{$endif}
-Function  Kill(Pid:longint;Sig:integer):integer;
+Function  Signal(Signum:longint;Handler:SignalHandler):SignalHandler;
+Function  Kill(Pid:longint;Sig:longint):integer;
 Procedure SigRaise(Sig:integer);
 {$ifndef BSD}
 Function  Alarm(Sec : Longint) : longint;
@@ -2933,7 +2799,11 @@ End.
 
 {
   $Log$
-  Revision 1.5  2000-09-06 20:47:34  peter
+  Revision 1.6  2000-09-11 14:05:31  marco
+   * FreeBSD support and removed old signalhandling
+
+
+  Revision 1.5  2000/09/06 20:47:34  peter
     * removed previous fsplit() patch as it's not the correct behaviour for
       LFNs. The code showing the bug could easily be adapted (merged)
 

+ 5 - 1
rtl/linux/objinc.inc

@@ -7,6 +7,7 @@ Var errno : Longint;
 {$i errno.inc}
 {$i sysconst.inc}
 {$i systypes.inc}
+{$i signal.inc}
 {$i syscalls.inc}
 
 FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
@@ -96,7 +97,10 @@ END;
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:49  michael
+  Revision 1.3  2000-09-11 14:05:31  marco
+   * FreeBSD support and removed old signalhandling
+
+  Revision 1.2  2000/07/13 11:33:49  michael
   + removed logs
  
 }

+ 204 - 0
rtl/linux/signal.inc

@@ -0,0 +1,204 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Jonas Maebe,
+    member of the Free Pascal development team.
+
+    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.
+
+ **********************************************************************}
+
+{$packrecords C}
+
+{********************
+      Signal
+********************}
+
+Const
+  { For sending a signal }
+  SA_NOCLDSTOP = 1;
+  SA_SHIRQ     = $04000000;
+  SA_STACK     = $08000000;
+  SA_RESTART   = $10000000;
+  SA_INTERRUPT = $20000000;
+  SA_NOMASK    = $40000000;
+  SA_ONESHOT   = $80000000;
+
+  SIG_BLOCK   = 0;
+  SIG_UNBLOCK = 1;
+  SIG_SETMASK = 2;
+
+  SIG_DFL = 0 ;
+  SIG_IGN = 1 ;
+  SIG_ERR = -1 ;
+
+  SIGHUP     = 1;
+  SIGINT     = 2;
+  SIGQUIT    = 3;
+  SIGILL     = 4;
+  SIGTRAP    = 5;
+  SIGABRT    = 6;
+  SIGIOT     = 6;
+  SIGBUS     = 7;
+  SIGFPE     = 8;
+  SIGKILL    = 9;
+  SIGUSR1    = 10;
+  SIGSEGV    = 11;
+  SIGUSR2    = 12;
+  SIGPIPE    = 13;
+  SIGALRM    = 14;
+  SIGTerm    = 15;
+  SIGSTKFLT  = 16;
+  SIGCHLD    = 17;
+  SIGCONT    = 18;
+  SIGSTOP    = 19;
+  SIGTSTP    = 20;
+  SIGTTIN    = 21;
+  SIGTTOU    = 22;
+  SIGURG     = 23;
+  SIGXCPU    = 24;
+  SIGXFSZ    = 25;
+  SIGVTALRM  = 26;
+  SIGPROF    = 27;
+  SIGWINCH   = 28;
+  SIGIO      = 29;
+  SIGPOLL    = SIGIO;
+  SIGPWR     = 30;
+  SIGUNUSED  = 31;
+
+
+const
+  SI_PAD_SIZE	= ((128/sizeof(longint)) - 3);
+
+type
+  tfpreg = record
+	  significand: array[0..3] of word;
+	  exponent: word;
+  end;
+
+  pfpstate = ^tfpstate;
+  tfpstate = record
+	   cw, sw, tag, ipoff, cssel, dataoff, datasel: cardinal;
+	   st: array[0..7] of tfpreg;
+	   status: cardinal;
+  end;
+
+{$Ifdef i386}
+  PSigContextRec = ^SigContextRec;
+  SigContextRec = record
+    gs, __gsh: word;
+    fs, __fsh: word;
+    es, __esh: word;
+    ds, __dsh: word;
+    edi: cardinal;
+    esi: cardinal;
+    ebp: cardinal;
+    esp: cardinal;
+    ebx: cardinal;
+    edx: cardinal;
+    ecx: cardinal;
+    eax: cardinal;
+    trapno: cardinal;
+    err: cardinal;
+    eip: cardinal;
+    cs, __csh: word;
+    eflags: cardinal;
+    esp_at_signal: cardinal;
+    ss, __ssh: word;
+    fpstate: pfpstate;
+    oldmask: cardinal;
+    cr2: cardinal;
+  end;
+{$ENDIF}
+
+(*
+  PSigInfoRec = ^SigInfoRec;
+  SigInfoRec = record
+    si_signo: longint;
+    si_errno: longint;
+    si_code: longint;
+
+    case longint of
+      0:
+        (pad: array[SI_PAD_SIZE] of longint);
+      1: { kill }
+        ( kill: record
+            pid: longint;  { sender's pid }
+            uid : longint; { sender's uid }
+          end );
+      2: { POSIX.1b timers }
+        ( timer : record
+            timer1 : cardinal;
+            timer2 : cardinal;
+           end );
+      3: { POSIX.1b signals }
+        ( rt : record
+            pid : longint;    { sender's pid }
+            uid : longint;    { sender's uid }
+            sigval : longint;
+         end );
+      4: { SIGCHLD }
+        ( sigchld : record
+          pid : longint;    { which child }
+          uid : longint;    { sender's uid }
+          status : longint; { exit code }
+          utime : timeval;
+          stime : timeval;
+         end );
+      5: { SIGILL, SIGFPE, SIGSEGV, SIGBUS }
+        ( sigfault : record
+            addr : pointer;{ faulting insn/memory ref. }
+          end );
+      6:
+        ( sigpoll : record
+            band : longint; { POLL_IN, POLL_OUT, POLL_MSG }
+            fd : longint;
+          end );
+  end;
+*)
+
+  SignalHandler   = Procedure(Sig : Longint);cdecl;
+  PSignalHandler  = ^SignalHandler;
+  SignalRestorer  = Procedure;cdecl;
+  PSignalRestorer = ^SignalRestorer;
+  TSigAction = procedure(Sig: Longint; SigContext: SigContextRec);cdecl;
+
+  SigSet  = Longint;
+  PSigSet = ^SigSet;
+
+  SigActionRec = packed record
+    Handler  : record
+      case byte of
+        0: (Sh: SignalHandler);
+        1: (Sa: TSigAction);
+      end;
+    Sa_Mask     : SigSet;
+    Sa_Flags    : Longint;
+    Sa_restorer : SignalRestorer; { Obsolete - Don't use }
+  end;
+  PSigActionRec = ^SigActionRec;
+
+{
+  $Log$
+  Revision 1.2  2000-09-11 14:05:31  marco
+   * FreeBSD support and removed old signalhandling
+
+  Revision 1.1.2.1  2000/09/10 16:17:25  marco
+   * added (moved from sockets.pp and i386/signal.inc)
+
+  Revision 1.1  2000/07/13 06:30:55  michael
+  + Initial import
+
+  Revision 1.2  2000/03/31 23:11:23  pierre
+   * TSigAction Context param is the full record not a pointer
+
+  Revision 1.1  2000/03/31 13:24:28  jonas
+    * signal handling using sigaction when compiled with -dnewsignal
+      (allows multiple signals to be received in one run)
+
+}

+ 87 - 249
rtl/linux/sockets.pp

@@ -15,6 +15,7 @@ unit Sockets;
 Interface
 
 const
+ {$Ifndef BSD}
   { Adress families, Linux specific }
   AF_AX25         = 3;      { Amateur Radio AX.25          }
   AF_IPX          = 4;      { Novell IPX                   }
@@ -38,6 +39,82 @@ const
   PF_INET6        = AF_INET6;
 
   PF_MAX          = AF_MAX;
+ {$ELSE}
+ {BSD}
+  AF_LOCAL        =1;              { local to host (pipes, portals) }
+  AF_IMPLINK      =3;               { arpanet imp addresses }
+  AF_PUP          =4;              { pup protocols: e.g. BSP }
+  AF_CHAOS        =5;               { mit CHAOS protocols }
+  AF_NS           =6;              { XEROX NS protocols }
+  AF_ISO          =7;              { ISO protocols }
+  AF_OSI          =AF_ISO;
+  AF_ECMA         =8;              { European computer manufacturers }
+  AF_DATAKIT      =9;              { datakit protocols }
+  AF_CCITT        =10;             { CCITT protocols, X.25 etc }
+  AF_SNA          =11;             { IBM SNA }
+  AF_DECnet       =12;             { DECnet }
+  AF_DLI          =13;             { DEC Direct data link interface }
+  AF_LAT          =14;             { LAT }
+  AF_HYLINK       =15;             { NSC Hyperchannel }
+  AF_APPLETALK    =16;             { Apple Talk }
+  AF_ROUTE        =17;             { Internal Routing Protocol }
+  AF_LINK         =18;             { Link layer interface }
+  pseudo_AF_XTP   =19;             { eXpress Transfer Protocol (no AF) }
+  AF_COIP         =20;             { connection-oriented IP, aka ST II }
+  AF_CNT          =21;             { Computer Network Technology }
+  pseudo_AF_RTIP  =22;             { Help Identify RTIP packets }
+  AF_IPX          =23;             { Novell Internet Protocol }
+  AF_SIP          =24;             { Simple Internet Protocol }
+  pseudo_AF_PIP   =25;             { Help Identify PIP packets }
+  AF_ISDN         =26;             { Integrated Services Digital Network}
+  AF_E164         =AF_ISDN;        { CCITT E.164 recommendation }
+  pseudo_AF_KEY   =27;             { Internal key-management function }
+  AF_INET6        =28;             { IPv6 }
+  AF_NATM         =29;             { native ATM access }
+  AF_ATM          =30;             { ATM }
+  pseudo_AF_HDRCMPLT=31;           { Used by BPF to not rewrite headers
+                                    in interface output routine}
+  AF_NETGRAPH     =32;             { Netgraph sockets }
+  AF_MAX          =33;
+
+  SOCK_MAXADDRLEN =255;             { longest possible addresses }
+
+{
+* Protocol families, same as address families for now.
+}
+  PF_LOCAL        =AF_LOCAL;
+  PF_IMPLINK      =AF_IMPLINK;
+  PF_PUP          =AF_PUP;
+  PF_CHAOS        =AF_CHAOS;
+  PF_NS           =AF_NS;
+  PF_ISO          =AF_ISO;
+  PF_OSI          =AF_ISO;
+  PF_ECMA         =AF_ECMA;
+  PF_DATAKIT      =AF_DATAKIT;
+  PF_CCITT        =AF_CCITT;
+  PF_SNA          =AF_SNA;
+  PF_DECnet       =AF_DECnet;
+  PF_DLI          =AF_DLI;
+  PF_LAT          =AF_LAT;
+  PF_HYLINK       =AF_HYLINK;
+  PF_APPLETALK    =AF_APPLETALK;
+  PF_ROUTE        =AF_ROUTE;
+  PF_LINK         =AF_LINK;
+  PF_XTP          =pseudo_AF_XTP;  { really just proto family, no AF }
+  PF_COIP         =AF_COIP;
+  PF_CNT          =AF_CNT;
+  PF_SIP          =AF_SIP;
+  PF_IPX          =AF_IPX;         { same format as AF_NS }
+  PF_RTIP         =pseudo_AF_RTIP; { same format as AF_INET }
+  PF_PIP          =pseudo_AF_PIP;
+  PF_ISDN         =AF_ISDN;
+  PF_KEY          =pseudo_AF_KEY;
+  PF_INET6        =AF_INET6;
+  PF_NATM         =AF_NATM;
+  PF_ATM          =AF_ATM;
+  PF_NETGRAPH     =AF_NETGRAPH;
+  PF_MAX          =AF_MAX;
+{$ENDIF}
 
 type
   TUnixSockAddr = packed Record
@@ -56,263 +133,21 @@ Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
 Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
 
 Implementation
+
 Uses Linux;
 
 { Include filerec and textrec structures }
 {$i filerec.inc}
 {$i textrec.inc}
-
 {******************************************************************************
                           Kernel Socket Callings
 ******************************************************************************}
 
-Const
-  {
-    Arguments to the Linux Kernel system call for sockets. All
-    Socket Connected calls go through the same system call,
-    with an extra argument to determine what action to take.
-  }
-  Socket_Sys_SOCKET      = 1;
-  Socket_Sys_BIND        = 2;
-  Socket_Sys_CONNECT     = 3;
-  Socket_Sys_LISTEN      = 4;
-  Socket_Sys_ACCEPT      = 5;
-  Socket_Sys_GETSOCKNAME = 6;
-  Socket_Sys_GETPEERNAME = 7;
-  Socket_Sys_SOCKETPAIR  = 8;
-  Socket_Sys_SEND        = 9;
-  Socket_Sys_RECV        = 10;
-  Socket_Sys_SENDTO      = 11;
-  Socket_Sys_RECVFROM    = 12;
-  Socket_Sys_SHUTDOWN    = 13;
-  Socket_Sys_SETSOCKOPT  = 14;
-  Socket_Sys_GETSOCKOPT  = 15;
-  Socket_Sys_SENDMSG     = 16;
-  Socket_Sys_RECVMSG     = 17;
-
-
-Function SocketCall(SockCallNr,a1,a2,a3,a4,a5,a6:longint):longint;
-var
-  Regs:SysCallRegs;
-  Args:array[1..6] of longint;
-begin
-{$IFNDEF BSD}
-  args[1]:=a1;
-  args[2]:=a2;
-  args[3]:=a3;
-  args[4]:=a4;
-  args[5]:=a5;
-  args[6]:=a6;
-  regs.reg2:=SockCallNr;
-  regs.reg3:=Longint(@args);
-  SocketCall:=Syscall(syscall_nr_socketcall,regs);
-  If SocketCall<0 then
-   SocketError:=Errno
-  else 
-   SocketError:=0;
- {$ELSE}
-  SocketError:=-1;
- {$ENDIF}
-end;
-
-
-
-Function SocketCall(SockCallNr,a1,a2,a3:longint):longint;
-begin
-  SocketCall:=SocketCall(SockCallNr,a1,a2,a3,0,0,0);
-end;
-
-
-{******************************************************************************
-                          Basic Socket Functions
-******************************************************************************}
-
-Function socket(Domain,SocketType,Protocol:Longint):Longint;
-begin
-  Socket:=SocketCall(Socket_Sys_Socket,Domain,SocketType,ProtoCol);
-end;
-
-
-
-Function Send(Sock:Longint;Var Addr;AddrLen,Flags:Longint):Longint;
-begin
-  Send:=SocketCall(Socket_Sys_Send,Sock,Longint(@Addr),AddrLen,Flags,0,0);
-end;
-
-
-
-Function Recv(Sock:Longint;Var Addr;AddrLen,Flags:Longint):Longint;
-begin
-  Recv:=SocketCall(Socket_Sys_Recv,Sock,Longint(@Addr),AddrLen,Flags,0,0);
-end;
-
-
-
-Function Bind(Sock:Longint;Var Addr;AddrLen:Longint):Boolean;
-begin
-  Bind:=(SocketCall(Socket_Sys_Bind,Sock,Longint(@Addr),AddrLen)=0);
-end;
-
-
-
-Function Listen(Sock,MaxConnect:Longint):Boolean;
-begin
-  Listen:=(SocketCall(Socket_Sys_Listen,Sock,MaxConnect,0)=0);
-end;
-
-
-
-Function Accept(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
-begin
-  Accept:=SocketCall(Socket_Sys_Accept,Sock,longint(@Addr),longint(@AddrLen));
-  If Accept<0 Then
-    Accept:=-1;
-end;
-
-
-
-Function Connect(Sock:Longint;Var Addr;Addrlen:Longint): boolean;
-
-begin
-  Connect:=SocketCall(Socket_Sys_Connect,Sock,longint(@Addr),AddrLen)=0;
-end;
-
-
-
-Function Shutdown(Sock:Longint;How:Longint):Longint;
-begin
-  ShutDown:=SocketCall(Socket_Sys_ShutDown,Sock,How,0);
-end;
-
-
-
-Function GetSocketName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
-begin
-  GetSocketName:=SocketCall(Socket_Sys_GetSockName,Sock,longint(@Addr),longint(@AddrLen));
-end;
-
-
-
-Function GetPeerName(Sock:Longint;Var Addr;Var Addrlen:Longint):Longint;
-begin
-  GetPeerName:=SocketCall(Socket_Sys_GetPeerName,Sock,longint(@Addr),longint(@AddrLen));
-end;
-
-
-
-Function SetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;optlen:longint):Longint;
-begin
-  SetSocketOptions:=SocketCall(Socket_Sys_SetSockOpt,Sock,Level,OptName,Longint(@OptVal),OptLen,0);
-end;
-
-
-
-Function GetSocketOptions(Sock,Level,OptName:Longint;Var OptVal;Var optlen:longint):Longint;
-begin
-  GetSocketOptions:=SocketCall(Socket_Sys_GetSockOpt,Sock,Level,OptName,Longint(@OptVal),OptLen,0);
-end;
-
-
-
-Function SocketPair(Domain,SocketType,Protocol:Longint;var Pair:TSockArray):Longint;
-begin
-  SocketPair:=SocketCall(Socket_Sys_SocketPair,Domain,SocketType,Protocol,longint(@Pair),0,0);
-end;
-
-{******************************************************************************
-                               UnixSock
-******************************************************************************}
-
-Procedure Str2UnixSockAddr(const addr:string;var t:TUnixSockAddr;var len:longint);
-begin
-  Move(Addr[1],t.Path,length(Addr));
-  t.Family:=AF_UNIX;
-  t.Path[length(Addr)]:=#0;
-  Len:=Length(Addr)+3;
-end;
-
-
-Function Bind(Sock:longint;const addr:string):boolean;
-var
-  UnixAddr : TUnixSockAddr;
-  AddrLen  : longint;
-begin
-  Str2UnixSockAddr(addr,UnixAddr,AddrLen);
-  Bind(Sock,UnixAddr,AddrLen);
-  Bind:=(SocketError=0);
-end;
-
-
-
-Function DoAccept(Sock:longint;var addr:string):longint;
-var
-  UnixAddr : TUnixSockAddr;
-  AddrLen  : longint;
-begin
-  AddrLen:=length(addr)+3;
-  DoAccept:=Accept(Sock,UnixAddr,AddrLen);
-  Move(UnixAddr.Path,Addr[1],AddrLen);
-  SetLength(Addr,AddrLen);
-end;
-
-
-
-Function DoConnect(Sock:longint;const addr:string):Boolean;
-var
-  UnixAddr : TUnixSockAddr;
-  AddrLen  : longint;
-begin
-  Str2UnixSockAddr(addr,UnixAddr,AddrLen);
-  DoConnect:=Connect(Sock,UnixAddr,AddrLen);
-end;
-
-Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:text):Boolean;
-var
-  s : longint;
-begin
-  S:=DoAccept(Sock,addr);
-  if S>0 then
-   begin
-     Sock2Text(S,SockIn,SockOut);
-     Accept:=true;
-   end
-  else
-   Accept:=false;
-end;
-
-
-
-Function Accept(Sock:longint;var addr:string;var SockIn,SockOut:File):Boolean;
-var
-  s : longint;
-begin
-  S:=DoAccept(Sock,addr);
-  if S>0 then
-   begin
-     Sock2File(S,SockIn,SockOut);
-     Accept:=true;
-   end
-  else
-   Accept:=false;
-end;
-
-
-
-Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:text):Boolean;
-begin
-  Connect:=DoConnect(Sock,addr);
-  If Connect then
-     Sock2Text(Sock,SockIn,SockOut);
-end;
-
-
-
-Function Connect(Sock:longint;const addr:string;var SockIn,SockOut:file):Boolean;
-begin
-  Connect:=DoConnect(Sock,addr);
-  if Connect then
-     Sock2File(Sock,SockIn,SockOut);
-end;
+{$ifdef BSD}
+ {$I bsdsock.inc}
+{$else}
+ {$I linsock.inc}
+{$endif}
 
 {$i sockets.inc}
 
@@ -320,7 +155,10 @@ end.
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:49  michael
+  Revision 1.3  2000-09-11 14:05:31  marco
+   * FreeBSD support and removed old signalhandling
+
+  Revision 1.2  2000/07/13 11:33:49  michael
   + removed logs
  
 }

+ 50 - 2
rtl/linux/syscalls.inc

@@ -396,9 +396,57 @@ begin
   SysCall(SysCall_nr_exit,regs)
 end;
 
+Procedure SigAction(Signum:longint;Act,OldAct:PSigActionRec );
+{
+  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.
+}
+Var
+  sr : Syscallregs;
+begin
+  sr.reg2:=Signum;
+  sr.reg3:=Longint(act);
+  sr.reg4:=Longint(oldact);
+  SysCall(Syscall_nr_sigaction,sr);
+end;
+
+
 {
   $Log$
-  Revision 1.2  2000-07-13 11:33:49  michael
+  Revision 1.3  2000-09-11 14:05:31  marco
+   * FreeBSD support and removed old signalhandling
+
+
+  Revision 1.2  2000/07/13 11:33:49  michael
   + removed logs
- 
+
+  Revision 1.1  2000/07/13 06:30:54  michael
+  + Initial import
+
+  Revision 1.11  2000/07/08 18:02:39  peter
+    * do_open checks for directory, if directory then ioerror 2
+
+  Revision 1.10  2000/02/09 16:59:32  peter
+    * truncated log
+
+  Revision 1.9  2000/02/08 11:47:09  peter
+    * paramstr(0) support
+
+  Revision 1.8  2000/01/07 16:41:41  daniel
+    * copyright 2000
+
+  Revision 1.7  2000/01/07 16:32:28  daniel
+    * copyright 2000 added
+
+  Revision 1.6  1999/07/28 17:37:06  michael
+  * forgot ;
+
+  Revision 1.5  1999/07/28 12:15:16  michael
+  * Memory leak fixed in CloseDir, by Sebastian Guenther
+
+  Revision 1.4  1999/07/28 12:14:37  michael
+  * Memory leak fixed in CloseDir, by Sebastian Guenther
+
 }