* merge unix updates from the 1.0 branch, mostly related to the

    solaris target

rtl/unix/bsdsysca.inc → rtl/freebsd/unixsysc.inc

@@ -31,14 +31,14 @@ End;
 {
 function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
 {NOT IMPLEMENTED YET UNDER BSD}
-begin
+begin // perhaps it is better to implement the hack from solaris then this msg
  HALT;
 END;
 
   if (pointer(func)=nil) or (sp=nil) then
    begin
      LinuxError:=Sys_EInval;
-     exit;
+     exit(-1);
    end;
   asm
         { Insert the argument onto the new stack. }
@@ -306,12 +306,14 @@ begin
   LinuxError:=Errno;
 end;
 
+{$ifndef newreaddir}
 function sys_fcntl(Fd:longint;Cmd:longint;Arg:Longint):longint;
 
 begin
  sys_fcntl:=do_syscall(syscall_nr_fcntl,fd,cmd,arg);
  LinuxError:=Errno;
 end;
+{$endif}
 
 Function Chmod(path:pathstr;Newmode:longint):Boolean;
 {
@@ -591,7 +593,6 @@ begin
   LinuxError:=Errno;
 end;
 
-
 Function NanoSleep(const req : timespec;var rem : timespec) : longint;
 begin
   NanoSleep:=Do_SysCall(syscall_nr_nanosleep,longint(@req),longint(@rem));
@@ -599,6 +600,7 @@ begin
 end;
 
 
+
 Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
 {
   Interface to Unix ioctl call.
@@ -628,7 +630,6 @@ begin
   LinuxError:=Errno;
 end;
 
-
 function signal(signum:longint;Handler:signalhandler):signalhandler;
 
 var sa,osa : sigactionrec;
@@ -637,8 +638,8 @@ 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;}
+{     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
@@ -651,41 +652,36 @@ 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))
+	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
+	addl	$8, %esp
+	popl	%esi
 end;
 
-
-{
- * Architecture specific syscalls (i386) using the SYSARCH pseudo call
-}
-
 {$packrecords C}
 
 TYPE uint=CARDINAL;
@@ -750,23 +746,10 @@ begin
   LinuxError:=ErrNo;
 end;
 
-
-
 {
   $Log$
-  Revision 1.4  2001-01-22 07:25:10  marco
-   * IOPERM for FreeBSD. Port routines moved from linsysca to Unix again .
-
-  Revision 1.3  2000/10/26 22:51:12  peter
-    * nano sleep (merged)
-
-  Revision 1.2  2000/09/18 13:14:50  marco
-   * Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
-
-  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
+  Revision 1.2  2001-06-02 00:31:30  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
 
 }

rtl/linux/Makefile

@@ -849,7 +849,7 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
 		   $(SYSTEMUNIT)$(PPUEXT)
 unix$(PPUEXT) : unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
 		 syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \
-		 $(UNIXINC)/linsysca.inc
+		 unixsysc.inc
 ports$(PPUEXT) : ports.pp unix$(PPUEXT) objpas$(PPUEXT)
 dl$(PPUEXT) : $(UNIXINC)/dl.pp
 dynlibs$(PPUEXT) : $(INC)/dynlibs.pp $(UNIXINC)/dynlibs.inc dl$(PPUEXT) objpas$(PPUEXT)
@@ -885,7 +885,7 @@ heaptrc$(PPUEXT) : $(INC)/heaptrc.pp $(SYSTEMUNIT)$(PPUEXT)
 	$(COMPILER) -Sg $(INC)/heaptrc.pp
 lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
 sockets$(PPUEXT) : sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
-		   unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+		   unixsock.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 ipc$(PPUEXT) : ipc.pp unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 terminfo$(PPUEXT) : terminfo.pp unix$(PPUEXT)

rtl/linux/Makefile.fpc

@@ -135,7 +135,7 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
 
 unix$(PPUEXT) : unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
                  syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \
-                 $(UNIXINC)/linsysca.inc
+                 unixsysc.inc
 
 ports$(PPUEXT) : ports.pp unix$(PPUEXT) objpas$(PPUEXT)
 
@@ -213,7 +213,7 @@ lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT)
 #
 
 sockets$(PPUEXT) : sockets.pp $(INC)/textrec.inc $(INC)/filerec.inc \
-                   unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
+                   unixsock.inc unix$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 
 errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)
 

rtl/linux/syscalls.inc

@@ -412,41 +412,61 @@ begin
   SysCall(Syscall_nr_sigaction,sr);
 end;
 
+function Sys_FTruncate(Handle,Pos:longint):longint;  //moved from sysunix.inc Do_Truncate
+var
+  sr : syscallregs;
+begin
+  sr.reg2:=Handle;
+  sr.reg3:=Pos;
+  Sys_FTruncate:=syscall(syscall_nr_ftruncate,sr);
+end;
 
-{
-  $Log$
-  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
+Function Sys_mmap(adr,len,prot,flags,fdes,off:longint):longint; // moved from sysunix.inc, used in sbrk
+type
+  tmmapargs=packed record
+    address : longint;
+    size    : longint;
+    prot    : longint;
+    flags   : longint;
+    fd      : longint;
+    offset  : longint;
+  end;
+var
+  t     : syscallregs;
+  mmapargs : tmmapargs;
+begin
+  mmapargs.address:=adr;
+  mmapargs.size:=len;
+  mmapargs.prot:=prot;
+  mmapargs.flags:=flags;
+  mmapargs.fd:=fdes;
+  mmapargs.offset:=off;
+  t.reg2:=longint(@mmapargs);
+  Sys_mmap:=syscall(syscall_nr_mmap,t);
+end;
 
-  Revision 1.6  1999/07/28 17:37:06  michael
-  * forgot ;
+{
+  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;  // This was missing here, instead hardcode in Do_IsDevice
+var
+  sr: SysCallRegs;
+begin
+  sr.reg2:=Handle;
+  sr.reg3:=Ndx;
+  sr.reg4:=Longint(Data);
+  Sys_IOCtl:=SysCall(Syscall_nr_ioctl,sr);
+end;
 
-  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
+{
+  $Log$
+  Revision 1.4  2001-06-02 00:31:30  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
 
 }

rtl/linux/sysconst.inc

@@ -32,9 +32,9 @@ Const
   Open_NDelay    = Open_NonBlock;
   Open_Sync      = 1 shl 12;
   Open_Direct    = 4 shl 12;
-  Open_LargeFile = 1 shl 15;
-  Open_Directory = 2 shl 15;
-  Open_NoFollow  = 4 shl 15;
+  Open_LargeFile = 1 shl 15; 
+  Open_Directory = 2 shl 15; 
+  Open_NoFollow  = 4 shl 15; 
   { The waitpid uses the following options:}
   Wait_NoHang   = 1;
   Wait_UnTraced = 2;
@@ -82,12 +82,17 @@ Const
   fs_proc     = $9fa0;
   fs_xia      = $012FD16D;
 
+  { Constansts for MMAP }
+  MAP_PRIVATE   =2;
+  MAP_ANONYMOUS =$20;
+
+  {Constansts Termios/Ioctl (used in Do_IsDevice) }
+  IOCtl_TCGETS=$5401; // TCGETS is also in termios.inc, but the sysunix needs only this
+  
 {
   $Log$
-  Revision 1.3  2000-10-26 22:55:11  peter
-    * merges from fixes
-
-  Revision 1.2  2000/07/13 11:33:49  michael
-  + removed logs
+  Revision 1.4  2001-06-02 00:31:30  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
 
 }

rtl/linux/systypes.inc

@@ -58,15 +58,17 @@ type
   end;
   PDir =^TDir;
 
+  dev_t	= word;
+
   Stat = packed record
-    dev,
+    dev     : dev_t;		
     pad1    : word;
     ino     : longint;
     mode,
     nlink,
     uid,
-    gid,
-    rdev,
+    gid     : word;
+    rdev    : dev_t;
     pad2    : word;
     size,
     blksze,
@@ -131,10 +133,8 @@ type
 
 {
   $Log$
-  Revision 1.3  2000-10-26 22:55:11  peter
-    * merges from fixes
-
-  Revision 1.2  2000/07/13 11:33:49  michael
-  + removed logs
+  Revision 1.4  2001-06-02 00:31:30  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
 
 }

rtl/unix/linsock.inc → rtl/linux/unixsock.inc

@@ -55,7 +55,7 @@ begin
   SocketCall:=Syscall(syscall_nr_socketcall,regs);
   If SocketCall<0 then
    SocketError:=Errno
-  else 
+  else
    SocketError:=0;
  {$ELSE}
   SocketError:=-1;
@@ -262,7 +262,11 @@ end;
 
 {
   $Log$
-  Revision 1.2  2000-09-18 13:14:50  marco
+  Revision 1.2  2001-06-02 00:31:30  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
+
+  Revision 1.2  2000/09/18 13:14:50  marco
    * Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
 
   Revision 1.2  2000/09/11 14:05:31  marco

rtl/unix/linsysca.inc → rtl/linux/unixsysc.inc

@@ -34,7 +34,7 @@ begin
   if (pointer(func)=nil) or (sp=nil) then
    begin
      LinuxError:=Sys_EInval;
-     exit;
+     exit(-1); // give an error result
    end;
   asm
         { Insert the argument onto the new stack. }
@@ -927,8 +927,12 @@ end;
 
 {
   $Log$
-  Revision 1.6  2001-01-22 07:25:10  marco
-   * IOPERM for FreeBSD. Port routines moved from linsysca to Unix again .
+  Revision 1.2  2001-06-02 00:31:30  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
+
+  Revision 1.6  2001/01/22 07:25:10  marco
+   * IOPERM for FreeBSD. Port routines moved from unixsysc to Unix again .
 
   Revision 1.5  2000/12/28 20:50:04  peter
     * merged fixes from 1.0.x

rtl/unix/dos.pp

@@ -319,7 +319,7 @@ var
 Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
 var
   pid    : longint;
-  status : longint;
+  // The Error-Checking in the previous Version failed, since halt($7F) gives an WaitPid-status of $7F00
 Begin
   LastDosExitCode:=0;
   pid:=Fork;
@@ -328,7 +328,7 @@ Begin
    {The child does the actual exec, and then exits}
      Execl (Path+' '+ComLine);
    {If the execve fails, we return an exitvalue of 127, to let it be known}
-     halt (127)
+     ExitProcess(127);
    end
   else
    if pid=-1 then         {Fork failed}
@@ -337,14 +337,11 @@ Begin
       exit
     end;
 {We're in the parent, let's wait.}
-  Waitpid (pid,@status,0);
-  if status=127 then {The child couldn't execve !!}
-   DosError:=8 {We set this error, erroneously, since we cannot get to the real error}
+  LastDosExitCode:=WaitProcess(pid); // WaitPid and result-convert
+  if (LastDosExitCode>=0) and (LastDosExitCode<>127) then
+   DosError:=0
   else
-   begin
-     LastDosExitCode:=status shr 8;
-     DosError:=0
-   end;
+   DosError:=8; // perhaps one time give an better error
 End;
 
 
@@ -880,7 +877,11 @@ End.
 
 {
   $Log$
-  Revision 1.4  2001-05-06 14:23:21  peter
+  Revision 1.5  2001-06-02 00:31:30  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
+
+  Revision 1.4  2001/05/06 14:23:21  peter
     * fixed adddisk
 
   Revision 1.3  2001/01/21 20:21:40  marco

rtl/unix/linux.pp

@@ -51,9 +51,14 @@ const
   Prio_PGrp    = 1;
   Prio_User    = 2;
 
+{$ifdef Solaris}
+  WNOHANG   = $100;
+  WUNTRACED = $4;
+{$ELSE}
   WNOHANG   = $1;
   WUNTRACED = $2;
   __WCLONE  = $80000000;
+{$ENDIF}
 
 
 {********************
@@ -99,11 +104,22 @@ const
   F_SetFd  = 2;
   F_GetFl  = 3;
   F_SetFl  = 4;
+{$ifdef Solaris}
+  F_DupFd  = 0;
+  F_Dup2Fd = 9;
+  F_GetOwn = 23;
+  F_SetOwn = 24;
+  F_GetLk  = 14;
+  F_SetLk  = 6;
+  F_SetLkW = 7;
+  F_FreeSp = 11;
+{$else}
   F_GetLk  = 5;
   F_SetLk  = 6;
   F_SetLkW = 7;
   F_SetOwn = 8;
   F_GetOwn = 9;
+{$endif}
 
 {********************
    IOCtl(TermIOS)
@@ -215,7 +231,8 @@ Function  Fork:longint;
 {Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
 function  Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
 Procedure ExitProcess(val:longint);
-Function  WaitPid(Pid:longint;Status:pointer;Options:longint):Longint;
+Function  WaitPid(Pid:longint;Status:pointer;Options:Longint):Longint;  {=>PID (Status Valid), 0 (No Status), -1: Error, special case errno=EINTR }
+Function  WaitProcess(Pid:longint):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
 Procedure Nice(N:integer);
 {$ifdef bsd}
 Function  GetPriority(Which,Who:longint):longint;
@@ -242,7 +259,7 @@ Function  fdOpen(pathname:pchar;flags:longint):longint;
 Function  fdOpen(pathname:pchar;flags,mode:longint):longint;
 Function  fdClose(fd:longint):boolean;
 Function  fdRead(fd:longint;var buf;size:longint):longint;
-Function  fdWrite(fd:longint;var buf;size:longint):longint;
+Function  fdWrite(fd:longint;const buf;size:longint):longint;
 Function  fdTruncate(fd,size:longint):boolean;
 Function  fdSeek (fd,pos,seektype :longint): longint;
 Function  fdFlush (fd : Longint) : Boolean;
@@ -295,6 +312,7 @@ Function  Dup2(var oldfile,newfile:file):Boolean;
 Function  Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
 Function  Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
 Function  SelectText(var T:Text;TimeOut :PTimeVal):Longint;
+Function  SelectText(var T:Text;TimeOut :Longint):Longint;
 
 {**************************
    Directory Handling
@@ -385,10 +403,10 @@ const
   PROT_NONE  = $0;             { page can not be accessed }
 
   MAP_SHARED    = $1;          { Share changes }
-  MAP_PRIVATE   = $2;          { Changes are private }
+//  MAP_PRIVATE   = $2;          { Changes are private }
   MAP_TYPE      = $f;          { Mask for type of mapping }
   MAP_FIXED     = $10;         { Interpret addr exactly }
-  MAP_ANONYMOUS = $20;         { don't use a file }
+//  MAP_ANONYMOUS = $20;         { don't use a file }
 
   MAP_GROWSDOWN  = $100;       { stack-like segment }
   MAP_DENYWRITE  = $800;       { ETXTBSY }
@@ -413,9 +431,11 @@ function MUnMap (P : Pointer; Size : Longint) : Boolean;
      Port IO functions
 ***************************}
 
-{$ifndef BSD}
 Function  IOperm (From,Num : Cardinal; Value : Longint) : boolean;
-{$IFDEF I386}
+{$ifndef BSD}
+Function  IoPL(Level : longint) : Boolean;
+{$endif}
+{$ifdef i386}
 Procedure WritePort (Port : Longint; Value : Byte);
 Procedure WritePort (Port : Longint; Value : Word);
 Procedure WritePort (Port : Longint; Value : Longint);
@@ -435,7 +455,6 @@ Procedure ReadPortL (Port : Longint; Var Buf; Count: longint);
 Procedure ReadPortW (Port : Longint; Var Buf; Count: longint);
 Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
 {$endif}
-{$endif}
 
 {**************************
     Utility functions
@@ -484,36 +503,65 @@ Uses Strings;
 
 { Raw System calls are in Syscalls.inc}
 {$i syscalls.inc}
-{$ifdef BSD}
- {$i bsdsysca.inc}
-{$else}
- {$i linsysca.inc}
-{$endif}
+
+{$i unixsysc.inc}   {Syscalls only used in unit Unix/Linux}
 
 
 {******************************************************************************
                           Process related calls
 ******************************************************************************}
 
-function CreateShellArgV(const prog:string):ppchar;
+{ Most calls of WaitPID do not handle the result correctly, this funktion treats errors more correctly }
+Function  WaitProcess(Pid:longint):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
+var     r,s     : LongInt;
+begin
+  repeat
+    s:=$7F00;
+    r:=WaitPid(Pid,@s,0);
+  until (r<>-1) or (LinuxError<>Sys_EINTR);
+  if (r=-1) or (r=0) then // 0 is not a valid return and should never occur (it means status invalid when using WNOHANG)
+    WaitProcess:=-1 // return -1 to indicate an error
+  else
+   begin
+{$ifndef Solaris}
+     WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value
+{$else}
+     if (s and $FF)=0 then // Only this is a valid returncode
+      WaitProcess:=s shr 8
+     else if (s>0) then  // Until now there is not use of the highest bit , but check this for the future
+      WaitProcess:=-s // normal case
+     else
+      WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value
+{$endif}
+   end;
+end;
+
+function InternalCreateShellArgV(cmd:pChar; len:longint):ppchar;
 {
   Create an argv which executes a command in a shell using /bin/sh -c
 }
+const   Shell   = '/bin/sh'#0'-c'#0;
 var
   pp,p : ppchar;
-  temp : string;
+//  temp : string; !! Never pass a local var back!!
 begin
   getmem(pp,4*4);
-  temp:='/bin/sh'#0'-c'#0+prog+#0;
   p:=pp;
-  p^:=@temp[1];
+  p^:=@Shell[1];
   inc(p);
-  p^:=@temp[9];
+  p^:=@Shell[9];
   inc(p);
-  p^:=@temp[12];
+  getmem(p^,len+1);
+  move(cmd^,p^^,len);
+  pchar(p^)[len]:=#0;
   inc(p);
   p^:=Nil;
-  CreateShellArgV:=pp;
+  InternalCreateShellArgV:=pp;
+end;
+
+function CreateShellArgV(const prog:string):ppchar;
+begin
+  CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog));
 end;
 
 function CreateShellArgV(const prog:Ansistring):ppchar;
@@ -521,25 +569,19 @@ function CreateShellArgV(const prog:Ansistring):ppchar;
   Create an argv which executes a command in a shell using /bin/sh -c
   using a AnsiString;
 }
-var
-  pp,p : ppchar;
-  temp : AnsiString;
 begin
-  getmem(pp,4*4);
-  temp:='/bin/sh'#0'-c'#0+prog+#0;
-  p:=pp;
-  GetMem(p^,Length(Temp));
-  Move(Temp[1],p^^,Length(Temp));
-  inc(p);
-  p^:=@pp[0][8];
-  inc(p);
-  p^:=@pp[0][11];
-  inc(p);
-  p^:=Nil;
-  CreateShellArgV:=pp;
+  CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog)); // if ppc works like delphi this also work when @prog[1] is invalid (len=0)
 end;
 
 
+procedure FreeShellArgV(p:ppchar);
+begin
+  if (p<>nil) then begin
+    freemem(p[2]);
+    freemem(p);
+   end;
+end;
+
 
 Procedure Execv(const path:pathstr;args:ppchar);
 {
@@ -552,7 +594,6 @@ begin
 end;
 
 
-
 Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
 {
   This does the same as Execve, only it searches the PATH environment
@@ -578,7 +619,6 @@ begin
 end;
 
 
-
 Procedure Execle(Todo:string;Ep:ppchar);
 {
   This procedure takes the string 'Todo', parses it for command and
@@ -598,7 +638,6 @@ begin
 end;
 
 
-
 Procedure Execl(const Todo:string);
 {
   This procedure takes the string 'Todo', parses it for command and
@@ -613,7 +652,6 @@ begin
 end;
 
 
-
 Procedure Execlp(Todo:string;Ep:ppchar);
 {
   This procedure takes the string 'Todo', parses it for command and
@@ -632,6 +670,7 @@ begin
   ExecVP(StrPas(p^),p,EP);
 end;
 
+
 Function Shell(const Command:String):Longint;
 {
   Executes the shell, and passes it the string Command. (Through /bin/sh -c)
@@ -639,50 +678,56 @@ Function Shell(const Command:String):Longint;
   It waits for the shell to exit, and returns its exit status.
   If the Exec call failed exit status 127 is reported.
 }
+{ Changed the structure:
+- the previous version returns an undefinied value if fork fails
+- it returns the status of Waitpid instead of the Process returnvalue (see the doc to Shell)
+- it uses exit(127) not ExitProc (The Result in pp386: going on Compiling in 2 processes!)
+- ShellArgs are now released
+- The Old CreateShellArg gives back pointers to a local var
+}
 var
-  p        : ppchar;
-  temp,pid : longint;
+  p      : ppchar;
+  pid    : longint;
 begin
+  p:=CreateShellArgv(command);
   pid:=fork;
-  if pid=-1 then
-   exit; {Linuxerror already set in Fork}
-  if pid=0 then
+  if pid=0 then // We are in the Child
    begin
      {This is the child.}
-     p:=CreateShellArgv(command);
      Execve(p^,p,envp);
-     exit(127);
-   end;
-  temp:=0;
-  WaitPid(pid,@temp,0);{Linuxerror is set there}
-  Shell:=temp;{ Return exit status }
+     ExitProcess(127);  // was Exit(127)
+   end
+  else if (pid<>-1) then // Successfull started
+   Shell:=WaitProcess(pid) {Linuxerror is set there}
+  else // no success
+   Shell:=-1; // indicate an error
+  FreeShellArgV(p);
 end;
 
 
-
 Function Shell(const Command:AnsiString):Longint;
 {
   AnsiString version of Shell
 }
 var
-  p        : ppchar;
-  temp,pid : longint;
-begin
+  p     : ppchar;
+  pid   : longint;
+begin { Changes as above }
+  p:=CreateShellArgv(command);
   pid:=fork;
-  if pid=-1 then
-   exit; {Linuxerror already set in Fork}
-  if pid=0 then
+  if pid=0 then // We are in the Child
    begin
-     {This is the child.}
-     p:=CreateShellArgv(command);
      Execve(p^,p,envp);
-     exit(127);
-   end;
-  temp:=0;
-  WaitPid(pid,@temp,0);{Linuxerror is set there}
-  Shell:=temp;{ Return exit status }
+     ExitProcess(127); // was exit(127)!! We must exit the Process, not the function
+   end
+  else if (pid<>-1) then // Successfull started
+   Shell:=WaitProcess(pid) {Linuxerror is set there}
+  else // no success
+   Shell:=-1;
+  FreeShellArgV(p);
 end;
 
+
 {******************************************************************************
                        Date and Time related calls
 ******************************************************************************}
@@ -885,7 +930,7 @@ end;
 
 
 
-Function fdWrite(fd:longint;var buf;size:longint):longint;
+Function fdWrite(fd:longint;const buf;size:longint):longint;
 begin
   fdWrite:=Sys_Write(fd,pchar(@buf),size);
   LinuxError:=Errno;
@@ -1208,6 +1253,23 @@ begin
 end;
 
 
+Function SelectText(var T:Text;TimeOut :Longint):Longint;
+var
+  p  : PTimeVal;
+  tv : TimeVal;
+begin
+  if TimeOut=-1 then
+   p:=nil
+  else
+   begin
+     tv.Sec:=Timeout div 1000;
+     tv.Usec:=(Timeout mod 1000)*1000;
+     p:=@tv;
+   end;
+  SelectText:=SelectText(T,p);
+end;
+
+
 {******************************************************************************
                                Directory
 ******************************************************************************}
@@ -1936,28 +1998,16 @@ begin
 end;
 
 
-
 Function TCFlush(fd,qsel:longint):boolean;
-
-var com:longint;
-
 begin
  {$ifndef BSD}
   TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
  {$else}
-  {
-  CASE Qsel of
-   TCIFLUSH :  com:=fread;
-   TCOFLUSH :  com:=FWRITE;
-   TCIOFLUSH:  com:=FREAD OR FWRITE;
-  else
-   exit(false);
-  end;
-  }
   TCFlush:=IOCtl(fd,TIOCFLUSH,pointer(qsel));
  {$endif}
 end;
 
+
 Function IsATTY(Handle:Longint):Boolean;
 {
   Check if the filehandle described by 'handle' is a TTY (Terminal)
@@ -2126,75 +2176,22 @@ begin
 end;
 
 
+{
+function FExpand (const Path: PathStr): PathStr;
+- declared in fexpand.inc
+}
 
-Function FExpand(Const Path:PathStr):PathStr;
-var
-  temp  : pathstr;
-  i,j   : longint;
-  p     : pchar;
-Begin
-{Remove eventual drive - doesn't exist in Linux}
-  if path[2]=':' then
-   i:=3
-  else
-   i:=1;
-  temp:='';
-{Replace ~/ with $HOME}
-  if (path[i]='~') and ((i+1>length(path)) or (path[i+1]='/'))  then
-   begin
-     p:=getenv('HOME');
-     if not (p=nil) then
-      Insert(StrPas(p),temp,i);
-     i:=1;
-     temp:=temp+Copy(Path,2,255);
-   end;
-{Do we have an absolute path ? No - prefix the current dir}
-  if temp='' then
-   begin
-     if path[i]<>'/' then
-      begin
-        {$I-}
-         getdir(0,temp);
-        {$I+}
-        if ioresult<>0 then;
-      end
-     else
-      inc(i);
-     temp:=temp+'/'+copy(path,i,length(path)-i+1)+'/';
-   end;
-{First remove all references to '/./'}
-  while pos('/./',temp)<>0 do
-   delete(temp,pos('/./',temp),2);
-{Now remove also all references to '/../' + of course previous dirs..}
-  repeat
-    i:=pos('/../',temp);
-   {Find the pos of the previous dir}
-    if i>1 then
-     begin
-       j:=i-1;
-       while (j>1) and (temp[j]<>'/') do
-        dec (j);{temp[1] is always '/'}
-       delete(temp,j,i-j+3);
-      end
-     else
-      if i=1 then               {i=1, so we have temp='/../something', just delete '/../'}
-       delete(temp,1,3);
-  until i=0;
-  { Remove ending /.. }
-  i:=pos('/..',temp);
-  if (i<>0) and (i =length(temp)-2) then
-    begin
-    j:=i-1;
-    while (j>1) and (temp[j]<>'/') do
-      dec (j);
-    delete (temp,j,i-j+3);
-    end;
-  { if last character is / then remove it - dir is also a file :-) }
-  if (length(temp)>0) and (temp[length(temp)]='/') then
-   dec(byte(temp[0]));
-  fexpand:=temp;
-End;
+{$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
+{$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
+
+const
+  LFNSupport = true;
+  FileNameCaseSensitive = true;
 
+{$I fexpand.inc}
+
+{$UNDEF FPC_FEXPAND_GETENVPCHAR}
+{$UNDEF FPC_FEXPAND_TILDE}
 
 
 Function FSearch(const path:pathstr;dirlist:string):pathstr;
@@ -2618,7 +2615,6 @@ end;
 --------------------------------}
 
 {$IFDEF I386}
-
 Procedure WritePort (Port : Longint; Value : Byte);
 {
   Writes 'Value' to port 'Port'
@@ -2885,6 +2881,7 @@ end;
 {$ENDIF}
 
 
+
 Initialization
   InitLocalTime;
 
@@ -2895,11 +2892,30 @@ End.
 
 {
   $Log$
-  Revision 1.8  2001-03-27 11:46:38  michael
+  Revision 1.9  2001-06-02 00:31:30  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
+
+  Revision 1.7  2001/04/19 12:57:33  marco
+   * Readlink uncommented for FreeBSD.
+
+  Revision 1.6  2001/04/13 22:37:21  peter
+    * remove warning
+
+  Revision 1.5  2001/03/27 11:47:25  michael
   + Fixed F_[G,S]etOwn constants. By Alexander Sychev
 
-  Revision 1.7  2001/02/11 18:55:07  peter
-    * readded removed readport* from implementation
+  Revision 1.4  2001/03/17 16:04:37  hajny
+    * FExpand omission fixed
+
+  Revision 1.3  2001/03/16 20:09:58  hajny
+    * universal FExpand
+
+  Revision 1.2  2001/01/22 07:25:10  marco
+   * IOPERM for FreeBSD. Port routines moved from linsysca to Unix again .
+
+  Revision 1.1  2001/01/21 20:21:41  marco
+   * Rename fest II. Rtl OK
 
   Revision 1.6  2000/12/28 20:42:12  peter
     * ttyname fix from the mailinglist (merged)

rtl/unix/sockets.pp

@@ -139,15 +139,12 @@ Uses Unix;
 { Include filerec and textrec structures }
 {$i filerec.inc}
 {$i textrec.inc}
+
 {******************************************************************************
                           Kernel Socket Callings
 ******************************************************************************}
 
-{$ifdef BSD}
- {$I bsdsock.inc}
-{$else}
- {$I linsock.inc}
-{$endif}
+{$I unixsock.inc}
 
 {$i sockets.inc}
 
@@ -155,7 +152,11 @@ end.
 
 {
   $Log$
-  Revision 1.3  2001-01-21 20:21:40  marco
+  Revision 1.4  2001-06-02 00:31:31  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
+
+  Revision 1.3  2001/01/21 20:21:40  marco
    * Rename fest II. Rtl OK
 
   Revision 1.2  2000/09/18 13:14:51  marco
@@ -166,5 +167,5 @@ end.
 
   Revision 1.2  2000/07/13 11:33:49  michael
   + removed logs
- 
+
 }

rtl/unix/sysunix.inc

@@ -4,6 +4,9 @@
     Copyright (c) 1999-2000 by Michael Van Canneyt,
     member of the Free Pascal development team.
 
+    This is the core of the system unit *nix systems (now FreeBSD
+     and Unix).
+
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
@@ -129,45 +132,14 @@ end ['D0'];
 {$endif}
 
 
-{$ifdef bsd}
 Function sbrk(size : longint) : Longint;
-
-CONST MAP_PRIVATE   =2;
-      MAP_ANONYMOUS =$1000;             {$20 under linux}
-
 begin
-  Sbrk:=do_syscall(syscall_nr_mmap,0,size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0,0);
-  if ErrNo<>0 then
-   Sbrk:=0;
+  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;
 
-{$else}
-Function sbrk(size : longint) : Longint;
-type
-  tmmapargs=packed record
-    address : longint;
-    size    : longint;
-    prot    : longint;
-    flags   : longint;
-    fd      : longint;
-    offset  : longint;
-  end;
-var
-  t     : syscallregs;
-  mmapargs : tmmapargs;
-begin
-  mmapargs.address:=0;
-  mmapargs.size:=Size;
-  mmapargs.prot:=3;
-  mmapargs.flags:=$22;
-  mmapargs.fd:=-1;
-  mmapargs.offset:=0;
-  t.reg2:=longint(@mmapargs);
-  Sbrk:=syscall(syscall_nr_mmap,t);
-  if ErrNo<>0 then
-   Sbrk:=0;
-end;
-{$endif}
 
 { include standard heap management }
 {$I heap.inc}
@@ -190,6 +162,7 @@ Procedure Errno2Inoutres;
 begin
   if ErrNo=0 then { Else it will go through all the cases }
    exit;
+  If errno<0 then Errno:=-errno;
   case ErrNo of
    Sys_ENFILE,
    Sys_EMFILE : Inoutres:=4;
@@ -266,54 +239,31 @@ End;
 Procedure Do_Seek(Handle,Pos:Longint);
 Begin
   sys_lseek(Handle, pos, Seek_set);
+  errno2inoutres;
 End;
 
 
 Function Do_SeekEnd(Handle:Longint): Longint;
 begin
   Do_SeekEnd:=sys_lseek(Handle,0,Seek_End);
+  errno2inoutres;
 end;
 
-{$ifdef BSD}
 Function Do_FileSize(Handle:Longint): Longint;
 var
   Info : Stat;
 Begin
-  if do_SysCall(syscall_nr_fstat,handle,longint(@info))=0 then
+  if sys_fstat(handle,info)=0 then
    Do_FileSize:=Info.Size
   else
    Do_FileSize:=0;
   Errno2Inoutres;
 End;
-{$ELSE}
-Function Do_FileSize(Handle:Longint): Longint;
-var
-  regs : Syscallregs;
-  Info : Stat;
-Begin
-  regs.reg2:=Handle;
-  regs.reg3:=longint(@Info);
-  if SysCall(SysCall_nr_fstat,regs)=0 then
-   Do_FileSize:=Info.Size
-  else
-   Do_FileSize:=0;
-  Errno2Inoutres;
-End;
-{$endif}
 
-Procedure Do_Truncate(Handle,Pos:longint);
-{$ifndef bsd}
-var
-  sr : syscallregs;
-{$endif}
+
+Procedure Do_Truncate(Handle,fPos:longint);
 begin
-{$ifdef bsd}
-  do_syscall(syscall_nr_ftruncate,handle,pos,0);
-{$else}
-  sr.reg2:=Handle;
-  sr.reg3:=Pos;
-  syscall(syscall_nr_ftruncate,sr);
-{$endif}
+  sys_ftruncate(handle,fpos);
   Errno2Inoutres;
 end;
 
@@ -401,19 +351,9 @@ Function Do_IsDevice(Handle:Longint):boolean;
   data is function-dependent.
 }
 var
-{$ifndef BSD}
-  sr: SysCallRegs;
-{$endif}
   Data : array[0..255] of byte; {Large enough for termios info}
 begin
-{$ifdef BSD}
-  Do_IsDevice:=(do_SysCall(syscall_nr_ioctl,handle,$5413,longint(@data))=0);
-{$else}
-  sr.reg2:=Handle;
-  sr.reg3:=$5401; {=TCGETS}
-  sr.reg4:=Longint(@Data);
-  Do_IsDevice:=(SysCall(Syscall_nr_ioctl,sr)=0);
-{$endif}
+  Do_IsDevice:=(sys_ioctl(handle,IOCTL_TCGETS,@data)<>-1);
 end;
 
 
@@ -489,7 +429,7 @@ var
   dotdotino    : longint;
   rootdev,
   thisdev,
-  dotdotdev    : {$ifdef bsd}longint{$else}word{$endif};
+  dotdotdev    : dev_t;
   thedir,dummy : string[255];
   dirstream    : pdir;
   d            : pdirent;
@@ -585,9 +525,13 @@ end;
 
 
 {$ifdef BSD}
-procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl;
+ procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl;
 {$else}
-procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec); cdecl;
+ {$ifdef Solaris}
+  procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl;
+ {$else}
+  procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec); cdecl;
+ {$endif}
 {$ENDIF}
 var
 
@@ -659,8 +603,12 @@ end;
 Procedure InstallSignals;
 const
 {$Ifndef BSD}
+ {$ifdef solaris}
+  act: SigActionRec =(sa_flags:SA_SIGINFO;Handler:(sa:@signaltorunerror;sa_mask:0);
+ {$else}
   act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_mask:0;sa_flags:0;
                        Sa_restorer: NIL);
+ {$endif}
 {$ELSE}
    act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_flags:SA_SIGINFO;
     sa_mask:0);
@@ -671,9 +619,11 @@ const
 begin
   ResetFPU;
   SigAction(SIGFPE,@act,oldact);
+{$ifndef Solaris}
   SigAction(SIGSEGV,@act,oldact);
   SigAction(SIGBUS,@act,oldact);
   SigAction(SIGILL,@act,oldact);
+{$endif}
 end;
 
 
@@ -753,7 +703,11 @@ End.
 
 {
   $Log$
-  Revision 1.10  2001-04-23 20:33:31  peter
+  Revision 1.11  2001-06-02 00:31:31  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
+
+  Revision 1.10  2001/04/23 20:33:31  peter
     * also install sig handlers for sigill,sigbus
 
   Revision 1.9  2001/04/13 22:39:05  peter

rtl/unix/unix.pp

@@ -51,9 +51,14 @@ const
   Prio_PGrp    = 1;
   Prio_User    = 2;
 
+{$ifdef Solaris}
+  WNOHANG   = $100;
+  WUNTRACED = $4;
+{$ELSE}
   WNOHANG   = $1;
   WUNTRACED = $2;
   __WCLONE  = $80000000;
+{$ENDIF}
 
 
 {********************
@@ -99,11 +104,22 @@ const
   F_SetFd  = 2;
   F_GetFl  = 3;
   F_SetFl  = 4;
+{$ifdef Solaris}
+  F_DupFd  = 0;
+  F_Dup2Fd = 9;
+  F_GetOwn = 23;
+  F_SetOwn = 24;
+  F_GetLk  = 14;
+  F_SetLk  = 6;
+  F_SetLkW = 7;
+  F_FreeSp = 11;
+{$else}
   F_GetLk  = 5;
   F_SetLk  = 6;
   F_SetLkW = 7;
   F_SetOwn = 8;
   F_GetOwn = 9;
+{$endif}
 
 {********************
    IOCtl(TermIOS)
@@ -215,7 +231,8 @@ Function  Fork:longint;
 {Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
 function  Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
 Procedure ExitProcess(val:longint);
-Function  WaitPid(Pid:longint;Status:pointer;Options:longint):Longint;
+Function  WaitPid(Pid:longint;Status:pointer;Options:Longint):Longint;  {=>PID (Status Valid), 0 (No Status), -1: Error, special case errno=EINTR }
+Function  WaitProcess(Pid:longint):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
 Procedure Nice(N:integer);
 {$ifdef bsd}
 Function  GetPriority(Which,Who:longint):longint;
@@ -242,14 +259,16 @@ Function  fdOpen(pathname:pchar;flags:longint):longint;
 Function  fdOpen(pathname:pchar;flags,mode:longint):longint;
 Function  fdClose(fd:longint):boolean;
 Function  fdRead(fd:longint;var buf;size:longint):longint;
-Function  fdWrite(fd:longint;var buf;size:longint):longint;
+Function  fdWrite(fd:longint;const buf;size:longint):longint;
 Function  fdTruncate(fd,size:longint):boolean;
 Function  fdSeek (fd,pos,seektype :longint): longint;
 Function  fdFlush (fd : Longint) : Boolean;
 Function  Link(OldPath,NewPath:pathstr):boolean;
 Function  SymLink(OldPath,NewPath:pathstr):boolean;
+{$ifndef bsd}
 Function  ReadLink(name,linkname:pchar;maxlen:longint):longint;
 Function  ReadLink(name:pathstr):pathstr;
+{$endif}
 Function  UnLink(Path:pathstr):boolean;
 Function  UnLink(Path:pchar):Boolean;
 Function  FReName (OldName,NewName : Pchar) : Boolean;
@@ -293,6 +312,7 @@ Function  Dup2(var oldfile,newfile:file):Boolean;
 Function  Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
 Function  Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):longint;
 Function  SelectText(var T:Text;TimeOut :PTimeVal):Longint;
+Function  SelectText(var T:Text;TimeOut :Longint):Longint;
 
 {**************************
    Directory Handling
@@ -383,10 +403,10 @@ const
   PROT_NONE  = $0;             { page can not be accessed }
 
   MAP_SHARED    = $1;          { Share changes }
-  MAP_PRIVATE   = $2;          { Changes are private }
+//  MAP_PRIVATE   = $2;          { Changes are private }
   MAP_TYPE      = $f;          { Mask for type of mapping }
   MAP_FIXED     = $10;         { Interpret addr exactly }
-  MAP_ANONYMOUS = $20;         { don't use a file }
+//  MAP_ANONYMOUS = $20;         { don't use a file }
 
   MAP_GROWSDOWN  = $100;       { stack-like segment }
   MAP_DENYWRITE  = $800;       { ETXTBSY }
@@ -412,6 +432,9 @@ function MUnMap (P : Pointer; Size : Longint) : Boolean;
 ***************************}
 
 Function  IOperm (From,Num : Cardinal; Value : Longint) : boolean;
+{$ifndef BSD}
+Function  IoPL(Level : longint) : Boolean;
+{$endif}
 {$ifdef i386}
 Procedure WritePort (Port : Longint; Value : Byte);
 Procedure WritePort (Port : Longint; Value : Word);
@@ -480,36 +503,65 @@ Uses Strings;
 
 { Raw System calls are in Syscalls.inc}
 {$i syscalls.inc}
-{$ifdef BSD}
- {$i bsdsysca.inc}
-{$else}
- {$i linsysca.inc}
-{$endif}
+
+{$i unixsysc.inc}   {Syscalls only used in unit Unix/Linux}
 
 
 {******************************************************************************
                           Process related calls
 ******************************************************************************}
 
-function CreateShellArgV(const prog:string):ppchar;
+{ Most calls of WaitPID do not handle the result correctly, this funktion treats errors more correctly }
+Function  WaitProcess(Pid:longint):Longint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
+var     r,s     : LongInt;
+begin
+  repeat
+    s:=$7F00;
+    r:=WaitPid(Pid,@s,0);
+  until (r<>-1) or (LinuxError<>Sys_EINTR);
+  if (r=-1) or (r=0) then // 0 is not a valid return and should never occur (it means status invalid when using WNOHANG)
+    WaitProcess:=-1 // return -1 to indicate an error
+  else
+   begin
+{$ifndef Solaris}
+     WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value
+{$else}
+     if (s and $FF)=0 then // Only this is a valid returncode
+      WaitProcess:=s shr 8
+     else if (s>0) then  // Until now there is not use of the highest bit , but check this for the future
+      WaitProcess:=-s // normal case
+     else
+      WaitProcess:=s; // s<0 should not occur, but wie return also a negativ value
+{$endif}
+   end;
+end;
+
+function InternalCreateShellArgV(cmd:pChar; len:longint):ppchar;
 {
   Create an argv which executes a command in a shell using /bin/sh -c
 }
+const   Shell   = '/bin/sh'#0'-c'#0;
 var
   pp,p : ppchar;
-  temp : string;
+//  temp : string; !! Never pass a local var back!!
 begin
   getmem(pp,4*4);
-  temp:='/bin/sh'#0'-c'#0+prog+#0;
   p:=pp;
-  p^:=@temp[1];
+  p^:=@Shell[1];
   inc(p);
-  p^:=@temp[9];
+  p^:=@Shell[9];
   inc(p);
-  p^:=@temp[12];
+  getmem(p^,len+1);
+  move(cmd^,p^^,len);
+  pchar(p^)[len]:=#0;
   inc(p);
   p^:=Nil;
-  CreateShellArgV:=pp;
+  InternalCreateShellArgV:=pp;
+end;
+
+function CreateShellArgV(const prog:string):ppchar;
+begin
+  CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog));
 end;
 
 function CreateShellArgV(const prog:Ansistring):ppchar;
@@ -517,25 +569,19 @@ function CreateShellArgV(const prog:Ansistring):ppchar;
   Create an argv which executes a command in a shell using /bin/sh -c
   using a AnsiString;
 }
-var
-  pp,p : ppchar;
-  temp : AnsiString;
 begin
-  getmem(pp,4*4);
-  temp:='/bin/sh'#0'-c'#0+prog+#0;
-  p:=pp;
-  GetMem(p^,Length(Temp));
-  Move(Temp[1],p^^,Length(Temp));
-  inc(p);
-  p^:=@pp[0][8];
-  inc(p);
-  p^:=@pp[0][11];
-  inc(p);
-  p^:=Nil;
-  CreateShellArgV:=pp;
+  CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog)); // if ppc works like delphi this also work when @prog[1] is invalid (len=0)
 end;
 
 
+procedure FreeShellArgV(p:ppchar);
+begin
+  if (p<>nil) then begin
+    freemem(p[2]);
+    freemem(p);
+   end;
+end;
+
 
 Procedure Execv(const path:pathstr;args:ppchar);
 {
@@ -548,7 +594,6 @@ begin
 end;
 
 
-
 Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
 {
   This does the same as Execve, only it searches the PATH environment
@@ -574,7 +619,6 @@ begin
 end;
 
 
-
 Procedure Execle(Todo:string;Ep:ppchar);
 {
   This procedure takes the string 'Todo', parses it for command and
@@ -594,7 +638,6 @@ begin
 end;
 
 
-
 Procedure Execl(const Todo:string);
 {
   This procedure takes the string 'Todo', parses it for command and
@@ -609,7 +652,6 @@ begin
 end;
 
 
-
 Procedure Execlp(Todo:string;Ep:ppchar);
 {
   This procedure takes the string 'Todo', parses it for command and
@@ -628,6 +670,7 @@ begin
   ExecVP(StrPas(p^),p,EP);
 end;
 
+
 Function Shell(const Command:String):Longint;
 {
   Executes the shell, and passes it the string Command. (Through /bin/sh -c)
@@ -635,50 +678,56 @@ Function Shell(const Command:String):Longint;
   It waits for the shell to exit, and returns its exit status.
   If the Exec call failed exit status 127 is reported.
 }
+{ Changed the structure:
+- the previous version returns an undefinied value if fork fails
+- it returns the status of Waitpid instead of the Process returnvalue (see the doc to Shell)
+- it uses exit(127) not ExitProc (The Result in pp386: going on Compiling in 2 processes!)
+- ShellArgs are now released
+- The Old CreateShellArg gives back pointers to a local var
+}
 var
-  p        : ppchar;
-  temp,pid : longint;
+  p      : ppchar;
+  pid    : longint;
 begin
+  p:=CreateShellArgv(command);
   pid:=fork;
-  if pid=-1 then
-   exit; {Linuxerror already set in Fork}
-  if pid=0 then
+  if pid=0 then // We are in the Child
    begin
      {This is the child.}
-     p:=CreateShellArgv(command);
      Execve(p^,p,envp);
-     exit(127);
-   end;
-  temp:=0;
-  WaitPid(pid,@temp,0);{Linuxerror is set there}
-  Shell:=temp;{ Return exit status }
+     ExitProcess(127);  // was Exit(127)
+   end
+  else if (pid<>-1) then // Successfull started
+   Shell:=WaitProcess(pid) {Linuxerror is set there}
+  else // no success
+   Shell:=-1; // indicate an error
+  FreeShellArgV(p);
 end;
 
 
-
 Function Shell(const Command:AnsiString):Longint;
 {
   AnsiString version of Shell
 }
 var
-  p        : ppchar;
-  temp,pid : longint;
-begin
+  p     : ppchar;
+  pid   : longint;
+begin { Changes as above }
+  p:=CreateShellArgv(command);
   pid:=fork;
-  if pid=-1 then
-   exit; {Linuxerror already set in Fork}
-  if pid=0 then
+  if pid=0 then // We are in the Child
    begin
-     {This is the child.}
-     p:=CreateShellArgv(command);
      Execve(p^,p,envp);
-     exit(127);
-   end;
-  temp:=0;
-  WaitPid(pid,@temp,0);{Linuxerror is set there}
-  Shell:=temp;{ Return exit status }
+     ExitProcess(127); // was exit(127)!! We must exit the Process, not the function
+   end
+  else if (pid<>-1) then // Successfull started
+   Shell:=WaitProcess(pid) {Linuxerror is set there}
+  else // no success
+   Shell:=-1;
+  FreeShellArgV(p);
 end;
 
+
 {******************************************************************************
                        Date and Time related calls
 ******************************************************************************}
@@ -881,7 +930,7 @@ end;
 
 
 
-Function fdWrite(fd:longint;var buf;size:longint):longint;
+Function fdWrite(fd:longint;const buf;size:longint):longint;
 begin
   fdWrite:=Sys_Write(fd,pchar(@buf),size);
   LinuxError:=Errno;
@@ -1204,6 +1253,23 @@ begin
 end;
 
 
+Function SelectText(var T:Text;TimeOut :Longint):Longint;
+var
+  p  : PTimeVal;
+  tv : TimeVal;
+begin
+  if TimeOut=-1 then
+   p:=nil
+  else
+   begin
+     tv.Sec:=Timeout div 1000;
+     tv.Usec:=(Timeout mod 1000)*1000;
+     p:=@tv;
+   end;
+  SelectText:=SelectText(T,p);
+end;
+
+
 {******************************************************************************
                                Directory
 ******************************************************************************}
@@ -1932,28 +1998,16 @@ begin
 end;
 
 
-
 Function TCFlush(fd,qsel:longint):boolean;
-
-{var com:longint;}
-
 begin
  {$ifndef BSD}
   TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
  {$else}
-  {
-  CASE Qsel of
-   TCIFLUSH :  com:=fread;
-   TCOFLUSH :  com:=FWRITE;
-   TCIOFLUSH:  com:=FREAD OR FWRITE;
-  else
-   exit(false);
-  end;
-  }
   TCFlush:=IOCtl(fd,TIOCFLUSH,pointer(qsel));
  {$endif}
 end;
 
+
 Function IsATTY(Handle:Longint):Boolean;
 {
   Check if the filehandle described by 'handle' is a TTY (Terminal)
@@ -2122,13 +2176,13 @@ begin
 end;
 
 
-(*
+{
 function FExpand (const Path: PathStr): PathStr;
 - declared in fexpand.inc
-*)
+}
 
-{$DEFINE FPC_FEXPAND_TILDE} (* Tilde is expanded to home *)
-{$DEFINE FPC_FEXPAND_GETENVPCHAR} (* GetEnv result is a PChar *)
+{$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
+{$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
 
 const
   LFNSupport = true;
@@ -2561,7 +2615,6 @@ end;
 --------------------------------}
 
 {$IFDEF I386}
-
 Procedure WritePort (Port : Longint; Value : Byte);
 {
   Writes 'Value' to port 'Port'
@@ -2839,7 +2892,11 @@ End.
 
 {
   $Log$
-  Revision 1.7  2001-04-19 12:57:33  marco
+  Revision 1.8  2001-06-02 00:31:31  peter
+    * merge unix updates from the 1.0 branch, mostly related to the
+      solaris target
+
+  Revision 1.7  2001/04/19 12:57:33  marco
    * Readlink uncommented for FreeBSD.
 
   Revision 1.6  2001/04/13 22:37:21  peter