From 061d89620a6e3412367397d1b6952965352b6a1b Mon Sep 17 00:00:00 2001 From: peter Date: Sat, 2 Jun 2001 00:31:30 +0000 Subject: [PATCH] * merge unix updates from the 1.0 branch, mostly related to the solaris target --- rtl/freebsd/{bsdsock.inc => unixsock.inc} | 0 .../bsdsysca.inc => freebsd/unixsysc.inc} | 91 +++-- rtl/linux/Makefile | 4 +- rtl/linux/Makefile.fpc | 4 +- rtl/linux/syscalls.inc | 86 +++-- rtl/linux/sysconst.inc | 21 +- rtl/linux/systypes.inc | 16 +- rtl/{unix/linsock.inc => linux/unixsock.inc} | 8 +- rtl/{unix/linsysca.inc => linux/unixsysc.inc} | 10 +- rtl/unix/dos.pp | 21 +- rtl/unix/linux.pp | 312 +++++++++--------- rtl/unix/sockets.pp | 15 +- rtl/unix/sysunix.inc | 112 ++----- rtl/unix/unix.pp | 217 +++++++----- 14 files changed, 481 insertions(+), 436 deletions(-) rename rtl/freebsd/{bsdsock.inc => unixsock.inc} (100%) rename rtl/{unix/bsdsysca.inc => freebsd/unixsysc.inc} (91%) rename rtl/{unix/linsock.inc => linux/unixsock.inc} (97%) rename rtl/{unix/linsysca.inc => linux/unixsysc.inc} (98%) diff --git a/rtl/freebsd/bsdsock.inc b/rtl/freebsd/unixsock.inc similarity index 100% rename from rtl/freebsd/bsdsock.inc rename to rtl/freebsd/unixsock.inc diff --git a/rtl/unix/bsdsysca.inc b/rtl/freebsd/unixsysc.inc similarity index 91% rename from rtl/unix/bsdsysca.inc rename to rtl/freebsd/unixsysc.inc index 69963e9384..863a3f1058 100644 --- a/rtl/unix/bsdsysca.inc +++ b/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 } diff --git a/rtl/linux/Makefile b/rtl/linux/Makefile index 2bfb7a83b1..fe433327fa 100644 --- a/rtl/linux/Makefile +++ b/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) diff --git a/rtl/linux/Makefile.fpc b/rtl/linux/Makefile.fpc index 90308c0476..78a8941add 100644 --- a/rtl/linux/Makefile.fpc +++ b/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) diff --git a/rtl/linux/syscalls.inc b/rtl/linux/syscalls.inc index 3a5226a37a..39c8db51b2 100644 --- a/rtl/linux/syscalls.inc +++ b/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; + +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; + +{ + 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; + { $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 - - 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 + Revision 1.4 2001-06-02 00:31:30 peter + * merge unix updates from the 1.0 branch, mostly related to the + solaris target } diff --git a/rtl/linux/sysconst.inc b/rtl/linux/sysconst.inc index d2d64b4451..824bdf617e 100644 --- a/rtl/linux/sysconst.inc +++ b/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 } diff --git a/rtl/linux/systypes.inc b/rtl/linux/systypes.inc index 7a600d5f93..24778e276c 100644 --- a/rtl/linux/systypes.inc +++ b/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 } diff --git a/rtl/unix/linsock.inc b/rtl/linux/unixsock.inc similarity index 97% rename from rtl/unix/linsock.inc rename to rtl/linux/unixsock.inc index 1b9ed8c2fe..e6b8ec4422 100644 --- a/rtl/unix/linsock.inc +++ b/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 diff --git a/rtl/unix/linsysca.inc b/rtl/linux/unixsysc.inc similarity index 98% rename from rtl/unix/linsysca.inc rename to rtl/linux/unixsysc.inc index ad22d560d5..e8b58cdd78 100644 --- a/rtl/unix/linsysca.inc +++ b/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 diff --git a/rtl/unix/dos.pp b/rtl/unix/dos.pp index 0f331b7186..06fcee8012 100644 --- a/rtl/unix/dos.pp +++ b/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 diff --git a/rtl/unix/linux.pp b/rtl/unix/linux.pp index f60eb1dcf1..2ca4904506 100644 --- a/rtl/unix/linux.pp +++ b/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) diff --git a/rtl/unix/sockets.pp b/rtl/unix/sockets.pp index f2daea00ac..4511fe694c 100644 --- a/rtl/unix/sockets.pp +++ b/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 - + } diff --git a/rtl/unix/sysunix.inc b/rtl/unix/sysunix.inc index addf850222..cb28040aea 100644 --- a/rtl/unix/sysunix.inc +++ b/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 diff --git a/rtl/unix/unix.pp b/rtl/unix/unix.pp index de652db5e1..4d4df75545 100644 --- a/rtl/unix/unix.pp +++ b/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