paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 02:09:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
solaris target
This commit is contained in:
peter 2001-06-02 00:31:30 +00:00
parent 8c521811f7
commit 061d89620a
14 changed files with 481 additions and 436 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
rtl/freebsd/bsdsock.inc → rtl/freebsd/unixsock.inc
View File

33
rtl/unix/bsdsysca.inc → rtl/freebsd/unixsysc.inc
View File

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

4
rtl/linux/Makefile
View File

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

4
rtl/linux/Makefile.fpc
View File

@ -135,7 +135,7 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\
unix$(PPUEXT) : unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \ unix$(PPUEXT) : unix.pp strings$(PPUEXT) $(INC)/textrec.inc $(INC)/filerec.inc \
syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \ syscalls.inc systypes.inc sysconst.inc $(UNIXINC)/timezone.inc $(SYSTEMUNIT)$(PPUEXT) \
$(UNIXINC)/linsysca.inc unixsysc.inc
ports$(PPUEXT) : ports.pp unix$(PPUEXT) objpas$(PPUEXT) 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 \ 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) errors$(PPUEXT) : errors.pp strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT)

86
rtl/linux/syscalls.inc
View File

@ -412,41 +412,61 @@ begin
SysCall(Syscall_nr_sigaction,sr); SysCall(Syscall_nr_sigaction,sr);
end; 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$ $Log$
Revision 1.3 2000-09-11 14:05:31 marco Revision 1.4 2001-06-02 00:31:30 peter
* FreeBSD support and removed old signalhandling * merge unix updates from the 1.0 branch, mostly related to the
solaris target
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
} }

15
rtl/linux/sysconst.inc
View File

@ -82,12 +82,17 @@ Const
fs_proc = $9fa0; fs_proc = $9fa0;
fs_xia = $012FD16D; 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$ $Log$
Revision 1.3 2000-10-26 22:55:11 peter Revision 1.4 2001-06-02 00:31:30 peter
* merges from fixes * merge unix updates from the 1.0 branch, mostly related to the
solaris target
Revision 1.2 2000/07/13 11:33:49 michael
+ removed logs
} }

16
rtl/linux/systypes.inc
View File

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

6
rtl/unix/linsock.inc → rtl/linux/unixsock.inc
View File

@ -262,7 +262,11 @@ end;
{ {
$Log$ $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) * Global Linux +bsd to (rtl/freebsd rtl/unix rtl/linux structure)
Revision 1.2 2000/09/11 14:05:31 marco Revision 1.2 2000/09/11 14:05:31 marco

10
rtl/unix/linsysca.inc → rtl/linux/unixsysc.inc
View File

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

21
rtl/unix/dos.pp
View File

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

310
rtl/unix/linux.pp
View File

@ -51,9 +51,14 @@ const
Prio_PGrp = 1; Prio_PGrp = 1;
Prio_User = 2; Prio_User = 2;
{$ifdef Solaris}
WNOHANG = $100;
WUNTRACED = $4;
{$ELSE}
WNOHANG = $1; WNOHANG = $1;
WUNTRACED = $2; WUNTRACED = $2;
__WCLONE = $80000000; __WCLONE = $80000000;
{$ENDIF}
{******************** {********************
@ -99,11 +104,22 @@ const
F_SetFd = 2; F_SetFd = 2;
F_GetFl = 3; F_GetFl = 3;
F_SetFl = 4; 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_GetLk = 5;
F_SetLk = 6; F_SetLk = 6;
F_SetLkW = 7; F_SetLkW = 7;
F_SetOwn = 8; F_SetOwn = 8;
F_GetOwn = 9; F_GetOwn = 9;
{$endif}
{******************** {********************
IOCtl(TermIOS) IOCtl(TermIOS)
@ -215,7 +231,8 @@ Function Fork:longint;
{Clone for FreeBSD is copied from the LinuxThread port, and rfork based} {Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint; function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
Procedure ExitProcess(val: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); Procedure Nice(N:integer);
{$ifdef bsd} {$ifdef bsd}
Function GetPriority(Which,Who:longint):longint; 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 fdOpen(pathname:pchar;flags,mode:longint):longint;
Function fdClose(fd:longint):boolean; Function fdClose(fd:longint):boolean;
Function fdRead(fd:longint;var buf;size:longint):longint; 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 fdTruncate(fd,size:longint):boolean;
Function fdSeek (fd,pos,seektype :longint): longint; Function fdSeek (fd,pos,seektype :longint): longint;
Function fdFlush (fd : Longint) : Boolean; 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:PTimeVal):longint;
Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):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 :PTimeVal):Longint;
Function SelectText(var T:Text;TimeOut :Longint):Longint;
{************************** {**************************
Directory Handling Directory Handling
@ -385,10 +403,10 @@ const
PROT_NONE = $0; { page can not be accessed } PROT_NONE = $0; { page can not be accessed }
MAP_SHARED = $1; { Share changes } 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_TYPE = $f; { Mask for type of mapping }
MAP_FIXED = $10; { Interpret addr exactly } 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_GROWSDOWN = $100; { stack-like segment }
MAP_DENYWRITE = $800; { ETXTBSY } MAP_DENYWRITE = $800; { ETXTBSY }
@ -413,9 +431,11 @@ function MUnMap (P : Pointer; Size : Longint) : Boolean;
Port IO functions Port IO functions
***************************} ***************************}
{$ifndef BSD}
Function IOperm (From,Num : Cardinal; Value : Longint) : boolean; 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 : Byte);
Procedure WritePort (Port : Longint; Value : Word); Procedure WritePort (Port : Longint; Value : Word);
Procedure WritePort (Port : Longint; Value : Longint); 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 ReadPortW (Port : Longint; Var Buf; Count: longint);
Procedure ReadPortB (Port : Longint; Var Buf; Count: longint); Procedure ReadPortB (Port : Longint; Var Buf; Count: longint);
{$endif} {$endif}
{$endif}
{************************** {**************************
Utility functions Utility functions
@ -484,36 +503,65 @@ Uses Strings;
{ Raw System calls are in Syscalls.inc} { Raw System calls are in Syscalls.inc}
{$i syscalls.inc} {$i syscalls.inc}
{$ifdef BSD}
{$i bsdsysca.inc} {$i unixsysc.inc} {Syscalls only used in unit Unix/Linux}
{$else}
{$i linsysca.inc}
{$endif}
{****************************************************************************** {******************************************************************************
Process related calls 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 Create an argv which executes a command in a shell using /bin/sh -c
} }
const Shell = '/bin/sh'#0'-c'#0;
var var
pp,p : ppchar; pp,p : ppchar;
temp : string; // temp : string; !! Never pass a local var back!!
begin begin
getmem(pp,4*4); getmem(pp,4*4);
temp:='/bin/sh'#0'-c'#0+prog+#0;
p:=pp; p:=pp;
p^:=@temp[1]; p^:=@Shell[1];
inc(p); inc(p);
p^:=@temp[9]; p^:=@Shell[9];
inc(p); inc(p);
p^:=@temp[12]; getmem(p^,len+1);
move(cmd^,p^^,len);
pchar(p^)[len]:=#0;
inc(p); inc(p);
p^:=Nil; p^:=Nil;
CreateShellArgV:=pp; InternalCreateShellArgV:=pp;
end;
function CreateShellArgV(const prog:string):ppchar;
begin
CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog));
end; end;
function CreateShellArgV(const prog:Ansistring):ppchar; 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 Create an argv which executes a command in a shell using /bin/sh -c
using a AnsiString; using a AnsiString;
} }
var
pp,p : ppchar;
temp : AnsiString;
begin begin
getmem(pp,4*4); CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog)); // if ppc works like delphi this also work when @prog[1] is invalid (len=0)
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;
end; 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); Procedure Execv(const path:pathstr;args:ppchar);
{ {
@ -552,7 +594,6 @@ begin
end; end;
Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar); Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
{ {
This does the same as Execve, only it searches the PATH environment This does the same as Execve, only it searches the PATH environment
@ -578,7 +619,6 @@ begin
end; end;
Procedure Execle(Todo:string;Ep:ppchar); Procedure Execle(Todo:string;Ep:ppchar);
{ {
This procedure takes the string 'Todo', parses it for command and This procedure takes the string 'Todo', parses it for command and
@ -598,7 +638,6 @@ begin
end; end;
Procedure Execl(const Todo:string); Procedure Execl(const Todo:string);
{ {
This procedure takes the string 'Todo', parses it for command and This procedure takes the string 'Todo', parses it for command and
@ -613,7 +652,6 @@ begin
end; end;
Procedure Execlp(Todo:string;Ep:ppchar); Procedure Execlp(Todo:string;Ep:ppchar);
{ {
This procedure takes the string 'Todo', parses it for command and This procedure takes the string 'Todo', parses it for command and
@ -632,6 +670,7 @@ begin
ExecVP(StrPas(p^),p,EP); ExecVP(StrPas(p^),p,EP);
end; end;
Function Shell(const Command:String):Longint; Function Shell(const Command:String):Longint;
{ {
Executes the shell, and passes it the string Command. (Through /bin/sh -c) Executes the shell, and passes it the string Command. (Through /bin/sh -c)
@ -639,25 +678,31 @@ Function Shell(const Command:String):Longint;
It waits for the shell to exit, and returns its exit status. It waits for the shell to exit, and returns its exit status.
If the Exec call failed exit status 127 is reported. 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 var
p : ppchar; p : ppchar;
temp,pid : longint; pid : longint;
begin begin
p:=CreateShellArgv(command);
pid:=fork; pid:=fork;
if pid=-1 then if pid=0 then // We are in the Child
exit; {Linuxerror already set in Fork}
if pid=0 then
begin begin
{This is the child.} {This is the child.}
p:=CreateShellArgv(command);
Execve(p^,p,envp); Execve(p^,p,envp);
exit(127); 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; end;
temp:=0;
WaitPid(pid,@temp,0);{Linuxerror is set there}
Shell:=temp;{ Return exit status }
end;
Function Shell(const Command:AnsiString):Longint; Function Shell(const Command:AnsiString):Longint;
@ -666,23 +711,23 @@ Function Shell(const Command:AnsiString):Longint;
} }
var var
p : ppchar; p : ppchar;
temp,pid : longint; pid : longint;
begin begin { Changes as above }
pid:=fork;
if pid=-1 then
exit; {Linuxerror already set in Fork}
if pid=0 then
begin
{This is the child.}
p:=CreateShellArgv(command); p:=CreateShellArgv(command);
pid:=fork;
if pid=0 then // We are in the Child
begin
Execve(p^,p,envp); Execve(p^,p,envp);
exit(127); ExitProcess(127); // was exit(127)!! We must exit the Process, not the function
end; end
temp:=0; else if (pid<>-1) then // Successfull started
WaitPid(pid,@temp,0);{Linuxerror is set there} Shell:=WaitProcess(pid) {Linuxerror is set there}
Shell:=temp;{ Return exit status } else // no success
Shell:=-1;
FreeShellArgV(p);
end; end;
{****************************************************************************** {******************************************************************************
Date and Time related calls 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 begin
fdWrite:=Sys_Write(fd,pchar(@buf),size); fdWrite:=Sys_Write(fd,pchar(@buf),size);
LinuxError:=Errno; LinuxError:=Errno;
@ -1208,6 +1253,23 @@ begin
end; 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 Directory
******************************************************************************} ******************************************************************************}
@ -1936,28 +1998,16 @@ begin
end; end;
Function TCFlush(fd,qsel:longint):boolean; Function TCFlush(fd,qsel:longint):boolean;
var com:longint;
begin begin
{$ifndef BSD} {$ifndef BSD}
TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel)); TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
{$else} {$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)); TCFlush:=IOCtl(fd,TIOCFLUSH,pointer(qsel));
{$endif} {$endif}
end; end;
Function IsATTY(Handle:Longint):Boolean; Function IsATTY(Handle:Longint):Boolean;
{ {
Check if the filehandle described by 'handle' is a TTY (Terminal) Check if the filehandle described by 'handle' is a TTY (Terminal)
@ -2126,75 +2176,22 @@ begin
end; end;
{
function FExpand (const Path: PathStr): PathStr;
- declared in fexpand.inc
}
Function FExpand(Const Path:PathStr):PathStr; {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
var {$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
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;
const
LFNSupport = true;
FileNameCaseSensitive = true;
{$I fexpand.inc}
{$UNDEF FPC_FEXPAND_GETENVPCHAR}
{$UNDEF FPC_FEXPAND_TILDE}
Function FSearch(const path:pathstr;dirlist:string):pathstr; Function FSearch(const path:pathstr;dirlist:string):pathstr;
@ -2618,7 +2615,6 @@ end;
--------------------------------} --------------------------------}
{$IFDEF I386} {$IFDEF I386}
Procedure WritePort (Port : Longint; Value : Byte); Procedure WritePort (Port : Longint; Value : Byte);
{ {
Writes 'Value' to port 'Port' Writes 'Value' to port 'Port'
@ -2885,6 +2881,7 @@ end;
{$ENDIF} {$ENDIF}
Initialization Initialization
InitLocalTime; InitLocalTime;
@ -2895,11 +2892,30 @@ End.
{ {
$Log$ $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 + Fixed F_[G,S]etOwn constants. By Alexander Sychev
Revision 1.7 2001/02/11 18:55:07 peter Revision 1.4 2001/03/17 16:04:37 hajny
* readded removed readport* from implementation * 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 Revision 1.6 2000/12/28 20:42:12 peter
* ttyname fix from the mailinglist (merged) * ttyname fix from the mailinglist (merged)

13
rtl/unix/sockets.pp
View File

@ -139,15 +139,12 @@ Uses Unix;
{ Include filerec and textrec structures } { Include filerec and textrec structures }
{$i filerec.inc} {$i filerec.inc}
{$i textrec.inc} {$i textrec.inc}
{****************************************************************************** {******************************************************************************
Kernel Socket Callings Kernel Socket Callings
******************************************************************************} ******************************************************************************}
{$ifdef BSD} {$I unixsock.inc}
{$I bsdsock.inc}
{$else}
{$I linsock.inc}
{$endif}
{$i sockets.inc} {$i sockets.inc}
@ -155,7 +152,11 @@ end.
{ {
$Log$ $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 * Rename fest II. Rtl OK
Revision 1.2 2000/09/18 13:14:51 marco Revision 1.2 2000/09/18 13:14:51 marco

108
rtl/unix/sysunix.inc
View File

@ -4,6 +4,9 @@
Copyright (c) 1999-2000 by Michael Van Canneyt, Copyright (c) 1999-2000 by Michael Van Canneyt,
member of the Free Pascal development team. 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, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -129,45 +132,14 @@ end ['D0'];
{$endif} {$endif}
{$ifdef bsd}
Function sbrk(size : longint) : Longint; Function sbrk(size : longint) : Longint;
CONST MAP_PRIVATE =2;
MAP_ANONYMOUS =$1000; {$20 under linux}
begin begin
Sbrk:=do_syscall(syscall_nr_mmap,0,size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0,0); sbrk:=Sys_mmap(0,Size,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
if ErrNo<>0 then if sbrk<>-1 then
Sbrk:=0; errno:=0;
{! It must be -1, not 0 as before, see heap.inc. Should be in sysmmap?}
end; 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 } { include standard heap management }
{$I heap.inc} {$I heap.inc}
@ -190,6 +162,7 @@ Procedure Errno2Inoutres;
begin begin
if ErrNo=0 then { Else it will go through all the cases } if ErrNo=0 then { Else it will go through all the cases }
exit; exit;
If errno<0 then Errno:=-errno;
case ErrNo of case ErrNo of
Sys_ENFILE, Sys_ENFILE,
Sys_EMFILE : Inoutres:=4; Sys_EMFILE : Inoutres:=4;
@ -266,54 +239,31 @@ End;
Procedure Do_Seek(Handle,Pos:Longint); Procedure Do_Seek(Handle,Pos:Longint);
Begin Begin
sys_lseek(Handle, pos, Seek_set); sys_lseek(Handle, pos, Seek_set);
errno2inoutres;
End; End;
Function Do_SeekEnd(Handle:Longint): Longint; Function Do_SeekEnd(Handle:Longint): Longint;
begin begin
Do_SeekEnd:=sys_lseek(Handle,0,Seek_End); Do_SeekEnd:=sys_lseek(Handle,0,Seek_End);
errno2inoutres;
end; end;
{$ifdef BSD}
Function Do_FileSize(Handle:Longint): Longint; Function Do_FileSize(Handle:Longint): Longint;
var var
Info : Stat; Info : Stat;
Begin Begin
if do_SysCall(syscall_nr_fstat,handle,longint(@info))=0 then if sys_fstat(handle,info)=0 then
Do_FileSize:=Info.Size Do_FileSize:=Info.Size
else else
Do_FileSize:=0; Do_FileSize:=0;
Errno2Inoutres; Errno2Inoutres;
End; 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} Procedure Do_Truncate(Handle,fPos:longint);
var
sr : syscallregs;
{$endif}
begin begin
{$ifdef bsd} sys_ftruncate(handle,fpos);
do_syscall(syscall_nr_ftruncate,handle,pos,0);
{$else}
sr.reg2:=Handle;
sr.reg3:=Pos;
syscall(syscall_nr_ftruncate,sr);
{$endif}
Errno2Inoutres; Errno2Inoutres;
end; end;
@ -401,19 +351,9 @@ Function Do_IsDevice(Handle:Longint):boolean;
data is function-dependent. data is function-dependent.
} }
var var
{$ifndef BSD}
sr: SysCallRegs;
{$endif}
Data : array[0..255] of byte; {Large enough for termios info} Data : array[0..255] of byte; {Large enough for termios info}
begin begin
{$ifdef BSD} Do_IsDevice:=(sys_ioctl(handle,IOCTL_TCGETS,@data)<>-1);
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}
end; end;
@ -489,7 +429,7 @@ var
dotdotino : longint; dotdotino : longint;
rootdev, rootdev,
thisdev, thisdev,
dotdotdev : {$ifdef bsd}longint{$else}word{$endif}; dotdotdev : dev_t;
thedir,dummy : string[255]; thedir,dummy : string[255];
dirstream : pdir; dirstream : pdir;
d : pdirent; d : pdirent;
@ -586,8 +526,12 @@ end;
{$ifdef BSD} {$ifdef BSD}
procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl; procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl;
{$else}
{$ifdef Solaris}
procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl;
{$else} {$else}
procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec); cdecl; procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec); cdecl;
{$endif}
{$ENDIF} {$ENDIF}
var var
@ -659,8 +603,12 @@ end;
Procedure InstallSignals; Procedure InstallSignals;
const const
{$Ifndef BSD} {$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; act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_mask:0;sa_flags:0;
Sa_restorer: NIL); Sa_restorer: NIL);
{$endif}
{$ELSE} {$ELSE}
act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_flags:SA_SIGINFO; act: SigActionRec = (handler:(Sa:@SignalToRunError);sa_flags:SA_SIGINFO;
sa_mask:0); sa_mask:0);
@ -671,9 +619,11 @@ const
begin begin
ResetFPU; ResetFPU;
SigAction(SIGFPE,@act,oldact); SigAction(SIGFPE,@act,oldact);
{$ifndef Solaris}
SigAction(SIGSEGV,@act,oldact); SigAction(SIGSEGV,@act,oldact);
SigAction(SIGBUS,@act,oldact); SigAction(SIGBUS,@act,oldact);
SigAction(SIGILL,@act,oldact); SigAction(SIGILL,@act,oldact);
{$endif}
end; end;
@ -753,7 +703,11 @@ End.
{ {
$Log$ $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 * also install sig handlers for sigill,sigbus
Revision 1.9 2001/04/13 22:39:05 peter Revision 1.9 2001/04/13 22:39:05 peter

215
rtl/unix/unix.pp
View File

@ -51,9 +51,14 @@ const
Prio_PGrp = 1; Prio_PGrp = 1;
Prio_User = 2; Prio_User = 2;
{$ifdef Solaris}
WNOHANG = $100;
WUNTRACED = $4;
{$ELSE}
WNOHANG = $1; WNOHANG = $1;
WUNTRACED = $2; WUNTRACED = $2;
__WCLONE = $80000000; __WCLONE = $80000000;
{$ENDIF}
{******************** {********************
@ -99,11 +104,22 @@ const
F_SetFd = 2; F_SetFd = 2;
F_GetFl = 3; F_GetFl = 3;
F_SetFl = 4; 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_GetLk = 5;
F_SetLk = 6; F_SetLk = 6;
F_SetLkW = 7; F_SetLkW = 7;
F_SetOwn = 8; F_SetOwn = 8;
F_GetOwn = 9; F_GetOwn = 9;
{$endif}
{******************** {********************
IOCtl(TermIOS) IOCtl(TermIOS)
@ -215,7 +231,8 @@ Function Fork:longint;
{Clone for FreeBSD is copied from the LinuxThread port, and rfork based} {Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint; function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
Procedure ExitProcess(val: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); Procedure Nice(N:integer);
{$ifdef bsd} {$ifdef bsd}
Function GetPriority(Which,Who:longint):longint; 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 fdOpen(pathname:pchar;flags,mode:longint):longint;
Function fdClose(fd:longint):boolean; Function fdClose(fd:longint):boolean;
Function fdRead(fd:longint;var buf;size:longint):longint; 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 fdTruncate(fd,size:longint):boolean;
Function fdSeek (fd,pos,seektype :longint): longint; Function fdSeek (fd,pos,seektype :longint): longint;
Function fdFlush (fd : Longint) : Boolean; Function fdFlush (fd : Longint) : Boolean;
Function Link(OldPath,NewPath:pathstr):boolean; Function Link(OldPath,NewPath:pathstr):boolean;
Function SymLink(OldPath,NewPath:pathstr):boolean; Function SymLink(OldPath,NewPath:pathstr):boolean;
{$ifndef bsd}
Function ReadLink(name,linkname:pchar;maxlen:longint):longint; Function ReadLink(name,linkname:pchar;maxlen:longint):longint;
Function ReadLink(name:pathstr):pathstr; Function ReadLink(name:pathstr):pathstr;
{$endif}
Function UnLink(Path:pathstr):boolean; Function UnLink(Path:pathstr):boolean;
Function UnLink(Path:pchar):Boolean; Function UnLink(Path:pchar):Boolean;
Function FReName (OldName,NewName : 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:PTimeVal):longint;
Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:Longint):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 :PTimeVal):Longint;
Function SelectText(var T:Text;TimeOut :Longint):Longint;
{************************** {**************************
Directory Handling Directory Handling
@ -383,10 +403,10 @@ const
PROT_NONE = $0; { page can not be accessed } PROT_NONE = $0; { page can not be accessed }
MAP_SHARED = $1; { Share changes } 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_TYPE = $f; { Mask for type of mapping }
MAP_FIXED = $10; { Interpret addr exactly } 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_GROWSDOWN = $100; { stack-like segment }
MAP_DENYWRITE = $800; { ETXTBSY } MAP_DENYWRITE = $800; { ETXTBSY }
@ -412,6 +432,9 @@ function MUnMap (P : Pointer; Size : Longint) : Boolean;
***************************} ***************************}
Function IOperm (From,Num : Cardinal; Value : Longint) : boolean; Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
{$ifndef BSD}
Function IoPL(Level : longint) : Boolean;
{$endif}
{$ifdef i386} {$ifdef i386}
Procedure WritePort (Port : Longint; Value : Byte); Procedure WritePort (Port : Longint; Value : Byte);
Procedure WritePort (Port : Longint; Value : Word); Procedure WritePort (Port : Longint; Value : Word);
@ -480,36 +503,65 @@ Uses Strings;
{ Raw System calls are in Syscalls.inc} { Raw System calls are in Syscalls.inc}
{$i syscalls.inc} {$i syscalls.inc}
{$ifdef BSD}
{$i bsdsysca.inc} {$i unixsysc.inc} {Syscalls only used in unit Unix/Linux}
{$else}
{$i linsysca.inc}
{$endif}
{****************************************************************************** {******************************************************************************
Process related calls 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 Create an argv which executes a command in a shell using /bin/sh -c
} }
const Shell = '/bin/sh'#0'-c'#0;
var var
pp,p : ppchar; pp,p : ppchar;
temp : string; // temp : string; !! Never pass a local var back!!
begin begin
getmem(pp,4*4); getmem(pp,4*4);
temp:='/bin/sh'#0'-c'#0+prog+#0;
p:=pp; p:=pp;
p^:=@temp[1]; p^:=@Shell[1];
inc(p); inc(p);
p^:=@temp[9]; p^:=@Shell[9];
inc(p); inc(p);
p^:=@temp[12]; getmem(p^,len+1);
move(cmd^,p^^,len);
pchar(p^)[len]:=#0;
inc(p); inc(p);
p^:=Nil; p^:=Nil;
CreateShellArgV:=pp; InternalCreateShellArgV:=pp;
end;
function CreateShellArgV(const prog:string):ppchar;
begin
CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog));
end; end;
function CreateShellArgV(const prog:Ansistring):ppchar; 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 Create an argv which executes a command in a shell using /bin/sh -c
using a AnsiString; using a AnsiString;
} }
var
pp,p : ppchar;
temp : AnsiString;
begin begin
getmem(pp,4*4); CreateShellArgV:=InternalCreateShellArgV(@prog[1],length(prog)); // if ppc works like delphi this also work when @prog[1] is invalid (len=0)
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;
end; 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); Procedure Execv(const path:pathstr;args:ppchar);
{ {
@ -548,7 +594,6 @@ begin
end; end;
Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar); Procedure Execvp(Path:Pathstr;Args:ppchar;Ep:ppchar);
{ {
This does the same as Execve, only it searches the PATH environment This does the same as Execve, only it searches the PATH environment
@ -574,7 +619,6 @@ begin
end; end;
Procedure Execle(Todo:string;Ep:ppchar); Procedure Execle(Todo:string;Ep:ppchar);
{ {
This procedure takes the string 'Todo', parses it for command and This procedure takes the string 'Todo', parses it for command and
@ -594,7 +638,6 @@ begin
end; end;
Procedure Execl(const Todo:string); Procedure Execl(const Todo:string);
{ {
This procedure takes the string 'Todo', parses it for command and This procedure takes the string 'Todo', parses it for command and
@ -609,7 +652,6 @@ begin
end; end;
Procedure Execlp(Todo:string;Ep:ppchar); Procedure Execlp(Todo:string;Ep:ppchar);
{ {
This procedure takes the string 'Todo', parses it for command and This procedure takes the string 'Todo', parses it for command and
@ -628,6 +670,7 @@ begin
ExecVP(StrPas(p^),p,EP); ExecVP(StrPas(p^),p,EP);
end; end;
Function Shell(const Command:String):Longint; Function Shell(const Command:String):Longint;
{ {
Executes the shell, and passes it the string Command. (Through /bin/sh -c) Executes the shell, and passes it the string Command. (Through /bin/sh -c)
@ -635,25 +678,31 @@ Function Shell(const Command:String):Longint;
It waits for the shell to exit, and returns its exit status. It waits for the shell to exit, and returns its exit status.
If the Exec call failed exit status 127 is reported. 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 var
p : ppchar; p : ppchar;
temp,pid : longint; pid : longint;
begin begin
p:=CreateShellArgv(command);
pid:=fork; pid:=fork;
if pid=-1 then if pid=0 then // We are in the Child
exit; {Linuxerror already set in Fork}
if pid=0 then
begin begin
{This is the child.} {This is the child.}
p:=CreateShellArgv(command);
Execve(p^,p,envp); Execve(p^,p,envp);
exit(127); 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; end;
temp:=0;
WaitPid(pid,@temp,0);{Linuxerror is set there}
Shell:=temp;{ Return exit status }
end;
Function Shell(const Command:AnsiString):Longint; Function Shell(const Command:AnsiString):Longint;
@ -662,23 +711,23 @@ Function Shell(const Command:AnsiString):Longint;
} }
var var
p : ppchar; p : ppchar;
temp,pid : longint; pid : longint;
begin begin { Changes as above }
pid:=fork;
if pid=-1 then
exit; {Linuxerror already set in Fork}
if pid=0 then
begin
{This is the child.}
p:=CreateShellArgv(command); p:=CreateShellArgv(command);
pid:=fork;
if pid=0 then // We are in the Child
begin
Execve(p^,p,envp); Execve(p^,p,envp);
exit(127); ExitProcess(127); // was exit(127)!! We must exit the Process, not the function
end; end
temp:=0; else if (pid<>-1) then // Successfull started
WaitPid(pid,@temp,0);{Linuxerror is set there} Shell:=WaitProcess(pid) {Linuxerror is set there}
Shell:=temp;{ Return exit status } else // no success
Shell:=-1;
FreeShellArgV(p);
end; end;
{****************************************************************************** {******************************************************************************
Date and Time related calls 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 begin
fdWrite:=Sys_Write(fd,pchar(@buf),size); fdWrite:=Sys_Write(fd,pchar(@buf),size);
LinuxError:=Errno; LinuxError:=Errno;
@ -1204,6 +1253,23 @@ begin
end; 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 Directory
******************************************************************************} ******************************************************************************}
@ -1932,28 +1998,16 @@ begin
end; end;
Function TCFlush(fd,qsel:longint):boolean; Function TCFlush(fd,qsel:longint):boolean;
{var com:longint;}
begin begin
{$ifndef BSD} {$ifndef BSD}
TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel)); TCFlush:=IOCtl(fd,TCFLSH,pointer(qsel));
{$else} {$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)); TCFlush:=IOCtl(fd,TIOCFLUSH,pointer(qsel));
{$endif} {$endif}
end; end;
Function IsATTY(Handle:Longint):Boolean; Function IsATTY(Handle:Longint):Boolean;
{ {
Check if the filehandle described by 'handle' is a TTY (Terminal) Check if the filehandle described by 'handle' is a TTY (Terminal)
@ -2122,13 +2176,13 @@ begin
end; end;
(* {
function FExpand (const Path: PathStr): PathStr; function FExpand (const Path: PathStr): PathStr;
- declared in fexpand.inc - declared in fexpand.inc
*) }
{$DEFINE FPC_FEXPAND_TILDE} (* Tilde is expanded to home *) {$DEFINE FPC_FEXPAND_TILDE} { Tilde is expanded to home }
{$DEFINE FPC_FEXPAND_GETENVPCHAR} (* GetEnv result is a PChar *) {$DEFINE FPC_FEXPAND_GETENVPCHAR} { GetEnv result is a PChar }
const const
LFNSupport = true; LFNSupport = true;
@ -2561,7 +2615,6 @@ end;
--------------------------------} --------------------------------}
{$IFDEF I386} {$IFDEF I386}
Procedure WritePort (Port : Longint; Value : Byte); Procedure WritePort (Port : Longint; Value : Byte);
{ {
Writes 'Value' to port 'Port' Writes 'Value' to port 'Port'
@ -2839,7 +2892,11 @@ End.
{ {
$Log$ $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. * Readlink uncommented for FreeBSD.
Revision 1.6 2001/04/13 22:37:21 peter Revision 1.6 2001/04/13 22:37:21 peter