paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 07:19:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

* updated for 1.9.x unix rtl

Browse Source
This commit is contained in:
peter 2005-02-07 22:17:26 +00:00
parent 2808b3acea
commit 6e766b7261
12 changed files with 533 additions and 1492 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

124
rtl/sunos/bunxmacr.inc Normal file
View File

@ -0,0 +1,124 @@
{
$Id$
Copyright (c) 2000-2002 by Marco van de Voort
The *BSD POSIX macro's that are used both in the Baseunix unit as the
system unit. Not aliased via public names because I want these to be
inlined as much as possible in the future.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************}
function FPS_ISDIR(m : TMode): boolean;
begin
FPS_ISDIR:=((m and S_IFMT) = S_IFDIR);
end;
function FPS_ISCHR(m : TMode): boolean;
begin
FPS_ISCHR:=((m and S_IFMT) = S_IFCHR);
end;
function FPS_ISBLK(m : TMode): boolean;
begin
FPS_ISBLK:=((m and S_IFMT) = S_IFBLK);
end;
function FPS_ISREG(m : TMode): boolean;
begin
FPS_ISREG:=((m and S_IFMT) = S_IFREG);
end;
function FPS_ISFIFO(m : TMode): boolean;
begin
FPS_ISFIFO:=((m and S_IFMT) = S_IFIFO);
end;
Function FPS_ISLNK(m:TMode):boolean;
begin
FPS_ISLNK:=((m and S_IFMT) = S_IFLNK);
end;
Function FPS_ISSOCK(m:TMode):boolean;
begin
FPS_ISSOCK:=((m and S_IFMT) = S_IFSOCK);
end;
function wifexited(status : cint): cint;
begin
wifexited:=cint((status AND 127) =0);
end;
function wexitstatus(status : cint): cint;
begin
wexitstatus:=(status and 127) shr 8;
end;
function wstopsig(status : cint): cint;
begin
wstopsig:=(status and 127) shr 8;
end;
const wstopped=127;
function wifsignaled(status : cint): cint;
begin
wifsignaled:=cint(((status and 127)<>wstopped) and ((status and 127)<>0));
end;
function wtermsig(status : cint):cint;
begin
wtermsig:=cint(status and 127);
end;
{
$Log$
Revision 1.1 2005-02-07 22:17:26 peter
* updated for 1.9.x unix rtl
Revision 1.5 2003/09/27 13:04:58 peter
* fpISxxx renamed
Revision 1.4 2003/09/17 11:52:05 marco
* stat macro fixes voor BSD
Revision 1.3 2003/09/14 20:15:01 marco
* Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
Revision 1.2 2003/01/21 15:34:59 marco
* fix octal that broke 1.0.x
Revision 1.1 2003/01/05 19:01:28 marco
* FreeBSD compiles now with baseunix mods.
Revision 1.4 2002/11/12 14:19:46 marco
* fixes to macro
Revision 1.3 2002/10/26 18:27:51 marco
* First series POSIX calls commits. Including getcwd.
Revision 1.2 2002/09/07 16:01:17 peter
* old logs removed and tabs fixed
Revision 1.1 2002/08/19 12:29:11 marco
* First working POSIX *BSD system unit.
}

265
rtl/sunos/errno.inc
View File

@ -35,152 +35,155 @@ var
Const
Sys_EPERM = 1; { Operation not permitted }
Sys_ENOENT = 2; { No such file or directory }
Sys_ESRCH = 3; { No such process }
Sys_EINTR = 4; { Interrupted system call }
Sys_EIO = 5; { I/O error }
Sys_ENXIO = 6; { No such device or address }
Sys_E2BIG = 7; { Arg list too long }
Sys_ENOEXEC = 8; { Exec format error }
Sys_EBADF = 9; { Bad file number }
Sys_ECHILD = 10; { No child processes }
Sys_EAGAIN = 11; { Try again }
Sys_ENOMEM = 12; { Out of memory }
Sys_EACCES = 13; { Permission denied }
Sys_EFAULT = 14; { Bad address }
Sys_ENOTBLK = 15; { Block device required }
Sys_EBUSY = 16; { Device or resource busy }
Sys_EEXIST = 17; { File exists }
Sys_EXDEV = 18; { Cross-device link }
Sys_ENODEV = 19; { No such device }
Sys_ENOTDIR = 20; { Not a directory }
Sys_EISDIR = 21; { Is a directory }
Sys_EINVAL = 22; { Invalid argument }
Sys_ENFILE = 23; { File table overflow }
Sys_EMFILE = 24; { Too many open files }
Sys_ENOTTY = 25; { Not a typewriter }
Sys_ETXTBSY = 26; { Text file busy. The new process was
ESysEPERM = 1; { Operation not permitted }
ESysENOENT = 2; { No such file or directory }
ESysESRCH = 3; { No such process }
ESysEINTR = 4; { Interrupted system call }
ESysEIO = 5; { I/O error }
ESysENXIO = 6; { No such device or address }
ESysE2BIG = 7; { Arg list too long }
ESysENOEXEC = 8; { Exec format error }
ESysEBADF = 9; { Bad file number }
ESysECHILD = 10; { No child processes }
ESysEAGAIN = 11; { Try again }
ESysENOMEM = 12; { Out of memory }
ESysEACCES = 13; { Permission denied }
ESysEFAULT = 14; { Bad address }
ESysENOTBLK = 15; { Block device required }
ESysEBUSY = 16; { Device or resource busy }
ESysEEXIST = 17; { File exists }
ESysEXDEV = 18; { Cross-device link }
ESysENODEV = 19; { No such device }
ESysENOTDIR = 20; { Not a directory }
ESysEISDIR = 21; { Is a directory }
ESysEINVAL = 22; { Invalid argument }
ESysENFILE = 23; { File table overflow }
ESysEMFILE = 24; { Too many open files }
ESysENOTTY = 25; { Not a typewriter }
ESysETXTBSY = 26; { Text file busy. The new process was
a pure procedure (shared text) file which was
open for writing by another process, or file
which was open for writing by another process,
or while the pure procedure file was being
executed an open(2) call requested write access
requested write access.}
Sys_EFBIG = 27; { File too large }
Sys_ENOSPC = 28; { No space left on device }
Sys_ESPIPE = 29; { Illegal seek }
Sys_EROFS = 30; { Read-only file system }
Sys_EMLINK = 31; { Too many links }
Sys_EPIPE = 32; { Broken pipe }
Sys_EDOM = 33; { Math argument out of domain of func }
Sys_ERANGE = 34; { Math result not representable }
ESysEFBIG = 27; { File too large }
ESysENOSPC = 28; { No space left on device }
ESysESPIPE = 29; { Illegal seek }
ESysEROFS = 30; { Read-only file system }
ESysEMLINK = 31; { Too many links }
ESysEPIPE = 32; { Broken pipe }
ESysEDOM = 33; { Math argument out of domain of func }
ESysERANGE = 34; { Math result not representable }
Sys_ENOMSG = 35; { No message of desired type }
Sys_EIDRM = 36; { Identifier removed }
Sys_ECHRNG = 37; { Channel number out of range }
Sys_EL2NSYNC = 38; { Level 2 not synchronized }
Sys_EL3HLT = 39; { Level 3 halted }
Sys_EL3RST = 40; { Level 3 reset }
Sys_ELNRNG = 41; { Link number out of range }
Sys_EUNATCH = 42; { Protocol driver not attached }
Sys_ENOCSI = 43; { No CSI structure available }
Sys_EL2HLT = 44; { Level 2 halted }
Sys_EDEADLK = 45; { Resource deadlock would occur }
Sys_ENOLCK = 46; { No record locks available }
Sys_ECANCELED = 47;
Sys_ENOTSUP = 48;
Sys_EDQUOT = 49;
Sys_EBADE = 50; { Invalid exchange }
Sys_EBADR = 51; { Invalid request descriptor }
Sys_EXFULL = 52; { Exchange full }
Sys_ENOANO = 53; { No anode }
Sys_EBADRQC = 54; { Invalid request code }
Sys_EBADSLT = 55; { Invalid slot }
Sys_EDEADLOCK = 56; { File locking deadlock error }
Sys_EBFONT = 57; { Bad font file format }
Sys_EOWNERDEAD = 58;
Sys_ENOTRECOVERABLE = 59;
Sys_ENOSTR = 60; { Device not a stream }
Sys_ENODATA = 61; { No data available }
Sys_ETIME = 62; { Timer expired }
Sys_ENOSR = 63; { Out of streams resources }
Sys_ENONET = 64; { Machine is not on the network }
Sys_ENOPKG = 65; { Package not installed }
Sys_EREMOTE = 66; { Object is remote }
Sys_ENOLINK = 67; { Link has been severed }
Sys_EADV = 68; { Advertise error }
Sys_ESRMNT = 69; { Srmount error }
Sys_ECOMM = 70; { Communication error on send }
Sys_EPROTO = 71; { Protocol error }
Sys_ELOCKUNMAPPED = 72;
Sys_ENOTACTIVE = 73;
Sys_EMULTIHOP = 74; { Multihop attempted }
Sys_EBADMSG = 77; { Not a data message }
ESysENOMSG = 35; { No message of desired type }
ESysEIDRM = 36; { Identifier removed }
ESysECHRNG = 37; { Channel number out of range }
ESysEL2NSYNC = 38; { Level 2 not synchronized }
ESysEL3HLT = 39; { Level 3 halted }
ESysEL3RST = 40; { Level 3 reset }
ESysELNRNG = 41; { Link number out of range }
ESysEUNATCH = 42; { Protocol driver not attached }
ESysENOCSI = 43; { No CSI structure available }
ESysEL2HLT = 44; { Level 2 halted }
ESysEDEADLK = 45; { Resource deadlock would occur }
ESysENOLCK = 46; { No record locks available }
ESysECANCELED = 47;
ESysENOTSUP = 48;
ESysEDQUOT = 49;
ESysEBADE = 50; { Invalid exchange }
ESysEBADR = 51; { Invalid request descriptor }
ESysEXFULL = 52; { Exchange full }
ESysENOANO = 53; { No anode }
ESysEBADRQC = 54; { Invalid request code }
ESysEBADSLT = 55; { Invalid slot }
ESysEDEADLOCK = 56; { File locking deadlock error }
ESysEBFONT = 57; { Bad font file format }
ESysEOWNERDEAD = 58;
ESysENOTRECOVERABLE = 59;
ESysENOSTR = 60; { Device not a stream }
ESysENODATA = 61; { No data available }
ESysETIME = 62; { Timer expired }
ESysENOSR = 63; { Out of streams resources }
ESysENONET = 64; { Machine is not on the network }
ESysENOPKG = 65; { Package not installed }
ESysEREMOTE = 66; { Object is remote }
ESysENOLINK = 67; { Link has been severed }
ESysEADV = 68; { Advertise error }
ESysESRMNT = 69; { Srmount error }
ESysECOMM = 70; { Communication error on send }
ESysEPROTO = 71; { Protocol error }
ESysELOCKUNMAPPED = 72;
ESysENOTACTIVE = 73;
ESysEMULTIHOP = 74; { Multihop attempted }
ESysEBADMSG = 77; { Not a data message }
Sys_ENAMETOOLONG= 78;
Sys_EOVERFLOW = 79; { Value too large for defined data type }
Sys_ENOTUNIQ = 80; { Name not unique on network }
Sys_EBADFD = 81; { File descriptor in bad state }
Sys_EREMCHG = 82; { Remote address changed }
Sys_ELIBACC = 83; { Can not access a needed shared library }
Sys_ELIBBAD = 84; { Accessing a corrupted shared library }
Sys_ELIBSCN = 85; { .lib section in a.out corrupted }
Sys_ELIBMAX = 86; { Attempting to link in too many shared libraries }
Sys_ELIBEXEC = 87; { Cannot exec a shared library directly }
Sys_EILSEQ = 88; { Illegal byte sequence }
Sys_ELOOP = 90; { Too many symbolic links encountered }
Sys_ERESTART = 91; { Interrupted system call should be restarted }
Sys_ESTRPIPE = 92; { Streams pipe error }
Sys_ENOTEMPTY = 93; { Directory not empty }
Sys_EUSERS = 94; { Too many users }
Sys_ENOTSOCK = 95; { Socket operation on non-socket }
Sys_EDESTADDRREQ= 96; { Destination address required }
Sys_EMSGSIZE = 97; { Message too long }
Sys_EPROTOTYPE = 98; { Protocol wrong type for socket }
Sys_ENOPROTOOPT = 99; { Protocol not available }
Sys_EPROTONOSUPPORT= 120; { Protocol not supported }
Sys_ESOCKTNOSUPPORT= 121; { Socket type not supported }
Sys_EOPNOTSUPP = 122; { Operation not supported on transport endpoint }
Sys_EPFNOSUPPORT= 123; { Protocol family not supported }
Sys_EAFNOSUPPORT= 124; { Address family not supported by protocol }
Sys_EADDRINUSE = 125; { Address already in use }
Sys_EADDRNOTAVAIL= 126; { Cannot assign requested address }
Sys_ENETDOWN = 127; { Network is down }
Sys_ENETUNREACH = 128; { Network is unreachable }
Sys_ENETRESET = 129; { Network dropped connection because of reset }
Sys_ECONNABORTED= 130; { Software caused connection abort }
Sys_ECONNRESET = 131; { Connection reset by peer }
Sys_ENOBUFS = 132; { No buffer space available }
Sys_EISCONN = 133; { Transport endpoint is already connected }
Sys_ENOTCONN = 134; { Transport endpoint is not connected }
Sys_ESHUTDOWN = 143; { Cannot send after transport endpoint shutdown }
Sys_ETOOMANYREFS= 144; { Too many references: cannot splice }
Sys_ETIMEDOUT = 145; { Connection timed out }
Sys_ECONNREFUSED= 146; { Connection refused }
Sys_EHOSTDOWN = 147; { Host is down }
Sys_EHOSTUNREACH= 148; { No route to host }
Sys_EWOULDBLOCK = Sys_EAGAIN; { Operation would block }
Sys_EALREADY = 149; { Operation already in progress }
Sys_EINPROGRESS = 150; { Operation now in progress }
Sys_ESTALE = 151; { Stale NFS file handle }
ESysENAMETOOLONG= 78;
ESysEOVERFLOW = 79; { Value too large for defined data type }
ESysENOTUNIQ = 80; { Name not unique on network }
ESysEBADFD = 81; { File descriptor in bad state }
ESysEREMCHG = 82; { Remote address changed }
ESysELIBACC = 83; { Can not access a needed shared library }
ESysELIBBAD = 84; { Accessing a corrupted shared library }
ESysELIBSCN = 85; { .lib section in a.out corrupted }
ESysELIBMAX = 86; { Attempting to link in too many shared libraries }
ESysELIBEXEC = 87; { Cannot exec a shared library directly }
ESysEILSEQ = 88; { Illegal byte sequence }
ESysELOOP = 90; { Too many symbolic links encountered }
ESysERESTART = 91; { Interrupted system call should be restarted }
ESysESTRPIPE = 92; { Streams pipe error }
ESysENOTEMPTY = 93; { Directory not empty }
ESysEUSERS = 94; { Too many users }
ESysENOTSOCK = 95; { Socket operation on non-socket }
ESysEDESTADDRREQ= 96; { Destination address required }
ESysEMSGSIZE = 97; { Message too long }
ESysEPROTOTYPE = 98; { Protocol wrong type for socket }
ESysENOPROTOOPT = 99; { Protocol not available }
ESysEPROTONOSUPPORT= 120; { Protocol not supported }
ESysESOCKTNOSUPPORT= 121; { Socket type not supported }
ESysEOPNOTSUPP = 122; { Operation not supported on transport endpoint }
ESysEPFNOSUPPORT= 123; { Protocol family not supported }
ESysEAFNOSUPPORT= 124; { Address family not supported by protocol }
ESysEADDRINUSE = 125; { Address already in use }
ESysEADDRNOTAVAIL= 126; { Cannot assign requested address }
ESysENETDOWN = 127; { Network is down }
ESysENETUNREACH = 128; { Network is unreachable }
ESysENETRESET = 129; { Network dropped connection because of reset }
ESysECONNABORTED= 130; { Software caused connection abort }
ESysECONNRESET = 131; { Connection reset by peer }
ESysENOBUFS = 132; { No buffer space available }
ESysEISCONN = 133; { Transport endpoint is already connected }
ESysENOTCONN = 134; { Transport endpoint is not connected }
ESysESHUTDOWN = 143; { Cannot send after transport endpoint shutdown }
ESysETOOMANYREFS= 144; { Too many references: cannot splice }
ESysETIMEDOUT = 145; { Connection timed out }
ESysECONNREFUSED= 146; { Connection refused }
ESysEHOSTDOWN = 147; { Host is down }
ESysEHOSTUNREACH= 148; { No route to host }
ESysEWOULDBLOCK = ESysEAGAIN; { Operation would block }
ESysEALREADY = 149; { Operation already in progress }
ESysEINPROGRESS = 150; { Operation now in progress }
ESysESTALE = 151; { Stale NFS file handle }
(* Linux Errors not supported in Solaris:
Sys_ENAMETOOLONG= 36; { File name too long }
Sys_ENOSYS = 38; { Function not implemented }
Sys_EDOTDOT = 73; { RFS specific error }
Sys_EUCLEAN = 117; { Structure needs cleaning }
Sys_ENOTNAM = 118; { Not a XENIX named type file }
Sys_ENAVAIL = 119; { No XENIX semaphores available }
Sys_EISNAM = 120; { Is a named type file }
Sys_EREMOTEIO = 121; { Remote I/O error }
Sys_EDQUOT = 122; { Quota exceeded }
ESysENAMETOOLONG= 36; { File name too long }
ESysENOSYS = 38; { Function not implemented }
ESysEDOTDOT = 73; { RFS specific error }
ESysEUCLEAN = 117; { Structure needs cleaning }
ESysENOTNAM = 118; { Not a XENIX named type file }
ESysENAVAIL = 119; { No XENIX semaphores available }
ESysEISNAM = 120; { Is a named type file }
ESysEREMOTEIO = 121; { Remote I/O error }
ESysEDQUOT = 122; { Quota exceeded }
*)
{
$Log$
Revision 1.3 2004-03-04 13:11:56 olle
Revision 1.4 2005-02-07 22:17:26 peter
* updated for 1.9.x unix rtl
Revision 1.3 2004/03/04 13:11:56 olle
+ added comment to ETXTBSY
* changed i386 -> cpui386, m68k -> cpum68k

352
rtl/sunos/osmain.inc
View File

@ -14,18 +14,6 @@
**********************************************************************}
const
{ Default creation mode for directories and files }
{ read/write permission for everyone }
MODE_OPEN = S_IWUSR OR S_IRUSR OR
S_IWGRP OR S_IRGRP OR
S_IWOTH OR S_IROTH;
{ read/write search permission for everyone }
MODE_MKDIR = MODE_OPEN OR
S_IXUSR OR S_IXGRP OR S_IXOTH;
{*****************************************************************************
Misc. System Dependent Functions
*****************************************************************************}
@ -132,341 +120,6 @@ begin
InoutRes:=Errno2InoutRes;
end;
Procedure Do_Close(Handle:thandle);
Begin
Fpclose(cint(Handle));
End;
Procedure Do_Erase(p:pchar);
var
fileinfo : stat;
Begin
{ verify if the filename is actually a directory }
{ if so return error and do nothing, as defined }
{ by POSIX }
if Fpstat(p,fileinfo)<0 then
begin
Errno2Inoutres;
exit;
end;
if FpS_ISDIR(fileinfo.st_mode) then
begin
InOutRes := 2;
exit;
end;
if Fpunlink(p)<0 then
Errno2Inoutres
Else
InOutRes:=0;
End;
{ truncate at a given position }
procedure do_truncate (handle:thandle;fpos:longint);
begin
{ should be simulated in cases where it is not }
{ available. }
If Fpftruncate(handle,fpos)<0 Then
Errno2Inoutres
Else
InOutRes:=0;
end;
Procedure Do_Rename(p1,p2:pchar);
Begin
If Fprename(p1,p2)<0 Then
Errno2Inoutres
Else
InOutRes:=0;
End;
Function Do_Write(Handle:thandle;Addr:Pointer;Len:Longint):longint;
var j : cint;
Begin
repeat
Do_Write:=Fpwrite(Handle,addr,len);
j:=geterrno;
until (do_write<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
If Do_Write<0 Then
Begin
Errno2InOutRes;
Do_Write:=0;
End
else
InOutRes:=0;
End;
Function Do_Read(Handle:thandle;Addr:Pointer;Len:Longint):Longint;
var j:cint;
Begin
repeat
Do_Read:=Fpread(Handle,addr,len);
j:=geterrno;
until (do_read<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
If Do_Read<0 Then
Begin
Errno2InOutRes;
Do_Read:=0;
End
else
InOutRes:=0;
End;
function Do_FilePos(Handle: thandle):longint;
Begin
do_FilePos:=Fplseek(Handle, 0, SEEK_CUR);
If Do_FilePos<0 Then
Errno2InOutRes
else
InOutRes:=0;
End;
Procedure Do_Seek(Handle:thandle;Pos:Longint);
Begin
If Fplseek(Handle, pos, SEEK_SET)<0 Then
Errno2Inoutres
Else
InOutRes:=0;
End;
Function Do_SeekEnd(Handle:thandle): Longint;
begin
Do_SeekEnd:=Fplseek(Handle,0,SEEK_END);
If Do_SeekEnd<0 Then
Errno2Inoutres
Else
InOutRes:=0;
end;
Function Do_FileSize(Handle:thandle): Longint;
var
Info : Stat;
Ret : Longint;
Begin
Ret:=Fpfstat(handle,info);
If Ret=0 Then
Do_FileSize:=Info.st_size
else
Do_FileSize:=0;
If Ret<0 Then
Errno2InOutRes
Else
InOutRes:=0;
End;
Procedure Do_Open(var f;p:pchar;flags:longint);
{
FileRec and textrec have both Handle and mode as the first items so
they could use the same routine for opening/creating.
when (flags and $100) the file will be append
when (flags and $1000) the file will be truncate/rewritten
when (flags and $10000) there is no check for close (needed for textfiles)
}
var
oflags : cint;
Begin
{ close first if opened }
if ((flags and $10000)=0) then
begin
case FileRec(f).mode of
fminput,fmoutput,fminout : Do_Close(FileRec(f).Handle);
fmclosed : ;
else
begin
inoutres:=102; {not assigned}
exit;
end;
end;
end;
{ reset file Handle }
FileRec(f).Handle:=UnusedHandle;
{ We do the conversion of filemodes here, concentrated on 1 place }
case (flags and 3) of
0 : begin
oflags :=O_RDONLY;
FileRec(f).mode:=fminput;
end;
1 : begin
oflags :=O_WRONLY;
FileRec(f).mode:=fmoutput;
end;
2 : begin
oflags :=O_RDWR;
FileRec(f).mode:=fminout;
end;
end;
if (flags and $1000)=$1000 then
oflags:=oflags or (O_CREAT or O_TRUNC)
else
if (flags and $100)=$100 then
oflags:=oflags or (O_APPEND);
{ empty name is special }
if p[0]=#0 then
begin
case FileRec(f).mode of
fminput :
FileRec(f).Handle:=StdInputHandle;
fminout, { this is set by rewrite }
fmoutput :
FileRec(f).Handle:=StdOutputHandle;
fmappend :
begin
FileRec(f).Handle:=StdOutputHandle;
FileRec(f).mode:=fmoutput; {fool fmappend}
end;
end;
exit;
end;
{ real open call }
FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
if (FileRec(f).Handle<0) and
(getErrNo=ESysEROFS) and ((OFlags and O_RDWR)<>0) then
begin
Oflags:=Oflags and not(O_RDWR);
FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
end;
If Filerec(f).Handle<0 Then
Errno2Inoutres
else
InOutRes:=0;
End;
{*****************************************************************************
Directory Handling
*****************************************************************************}
Procedure MkDir(Const s: String);[IOCheck];
Var
Buffer: Array[0..255] of Char;
Begin
If (s='') or (InOutRes <> 0) then
exit;
Move(s[1], Buffer, Length(s));
Buffer[Length(s)] := #0;
If Fpmkdir(@buffer, MODE_MKDIR)<0 Then
Errno2Inoutres
Else
InOutRes:=0;
End;
Procedure RmDir(Const s: String);[IOCheck];
Var
Buffer: Array[0..255] of Char;
Begin
if (s = '.') then
InOutRes := 16;
If (s='') or (InOutRes <> 0) then
exit;
Move(s[1], Buffer, Length(s));
Buffer[Length(s)] := #0;
If Fprmdir(@buffer)<0 Then
Errno2Inoutres
Else
InOutRes:=0;
End;
Procedure ChDir(Const s: String);[IOCheck];
Var
Buffer: Array[0..255] of Char;
Begin
If (s='') or (InOutRes <> 0) then
exit;
Move(s[1], Buffer, Length(s));
Buffer[Length(s)] := #0;
If Fpchdir(@buffer)<0 Then
Errno2Inoutres
Else
InOutRes:=0;
{ file not exists is path not found under tp7 }
if InOutRes=2 then
InOutRes:=3;
End;
{ // $define usegetcwd}
procedure getdir(drivenr : byte;var dir : shortstring);
var
{$ifndef usegetcwd}
cwdinfo : stat;
rootinfo : stat;
thedir,dummy : string[255];
dirstream : pdir;
d : pdirent;
name : string[255];
thisdir : stat;
{$endif}
tmp : string[255];
begin
{$ifdef usegetcwd}
Fpgetcwd(@tmp[1],4096);
dir:=tmp;
{$else}
dir:='';
thedir:='';
dummy:='';
{ get root directory information }
tmp := '/'+#0;
if Fpstat(@tmp[1],rootinfo)<0 then
Exit;
repeat
tmp := dummy+'.'+#0;
{ get current directory information }
if Fpstat(@tmp[1],cwdinfo)<0 then
Exit;
tmp:=dummy+'..'+#0;
{ open directory stream }
{ try to find the current inode number of the cwd }
dirstream:=Fpopendir(@tmp[1]);
if dirstream=nil then
exit;
repeat
name:='';
d:=Fpreaddir(dirstream);
{ no more entries to read ... }
if not assigned(d) then
break;
tmp:=dummy+'../'+strpas(d^.d_name) + #0;
if (Fpstat(@tmp[1],thisdir)=0) then
begin
{ found the entry for this directory name }
if (cwdinfo.st_dev=thisdir.st_dev) and (cwdinfo.st_ino=thisdir.st_ino) then
begin
{ are the filenames of type '.' or '..' ? }
{ then do not set the name. }
if (not ((d^.d_name[0]='.') and ((d^.d_name[1]=#0) or
((d^.d_name[1]='.') and (d^.d_name[2]=#0))))) then
name:='/'+strpas(d^.d_name);
end;
end;
until (name<>'');
if Fpclosedir(dirstream)<0 then
Exit;
thedir:=name+thedir;
dummy:=dummy+'../';
if ((cwdinfo.st_dev=rootinfo.st_dev) and (cwdinfo.st_ino=rootinfo.st_ino)) then
begin
if thedir='' then
dir:='/'
else
dir:=thedir;
exit;
end;
until false;
{$endif}
end;
{*****************************************************************************
SystemUnit Initialization
@ -570,7 +223,10 @@ end;
{
$Log$
Revision 1.1 2004-11-06 22:22:28 florian
Revision 1.2 2005-02-07 22:17:26 peter
* updated for 1.9.x unix rtl
Revision 1.1 2004/11/06 22:22:28 florian
* some sunos stuff from 1.0.x merged
Revision 1.16 2004/10/25 15:38:59 peter

105
rtl/sunos/osposix.inc
View File

@ -1,105 +0,0 @@
{
$Id$
Copyright (c) 2001 by Carl Eric Codere
Implements POSIX 1003.1 conforming interface
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
{$Linklib c}
{ var
Errno : cint; external name 'errno';}
function sys_fork : pid_t; cdecl; external name 'fork';
function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; cdecl; external name 'execve';
function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; cdecl; external name 'waitpid';
procedure sys_exit(status : cint); cdecl; external name '_exit';
function sys_uname(var name: utsname): cint; cdecl; external name 'uname';
function sys_opendir(const dirname : pchar): pdir; cdecl; external name 'opendir';
function sys_readdir(dirp : pdir) : pdirent;cdecl; external name 'readdir';
function sys_closedir(dirp : pdir): cint; cdecl; external name 'closedir';
function sys_chdir(const path : pchar): cint; cdecl; external name 'chdir';
function sys_open(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open';
function sys_mkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
function sys_unlink(const path: pchar): cint; cdecl; external name 'unlink';
function sys_rmdir(const path : pchar): cint; cdecl; external name 'rmdir';
function sys_rename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
function sys_fstat(fd : cint; var sb : stat): cint; cdecl; external name 'fstat';
function sys_stat(const path: pchar; var buf : stat): cint; cdecl; external name 'stat';
function sys_access(const pathname : pchar; amode : cint): cint; cdecl; external name 'access';
function sys_close(fd : cint): cint; cdecl; external name 'close';
function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external name 'read';
function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t; cdecl; external name 'lseek';
function sys_time(var tloc:time_t): time_t; cdecl; external name 'time';
function sys_ftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
function S_ISDIR(m : mode_t): boolean;
begin
end;
function S_ISCHR(m : mode_t): boolean;
begin
end;
function S_ISBLK(m : mode_t): boolean;
begin
end;
function S_ISREG(m : mode_t): boolean;
begin
end;
function S_ISFIFO(m : mode_t): boolean;
begin
end;
function wifexited(status : cint): cint;
begin
end;
function wexitstatus(status : cint): cint;
begin
end;
function wstopsig(status : cint): cint;
begin
end;
function wifsignaled(status : cint): cint;
begin
end;
{
$Log$
Revision 1.2 2004-11-06 22:22:28 florian
* some sunos stuff from 1.0.x merged
Revision 1.3 2002/09/07 16:01:26 peter
* old logs removed and tabs fixed
Revision 1.2 2002/08/10 13:42:36 marco
* Fixes Posix dir copied to devel branch
}

37
rtl/sunos/ossysc.inc Normal file
View File

@ -0,0 +1,37 @@
{
$Id$
Copyright (c) 2002 by Marco van de Voort
The base *BSD syscalls required to implement the system unit. These
are aliased for use in other units (to avoid poluting the system units
interface)
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
****************************************************************************
}
{$i ostypes.inc}
{$ifdef FPC_USE_LIBC}
{$Linklib c}
// Out of date atm.
{$ifdef FPC_IS_SYSTEM}
{$i oscdeclh.inc}
{$endif}
{$I bunxmacr.inc}
{
$Log$
Revision 1.1 2005-02-07 22:17:26 peter
* updated for 1.9.x unix rtl
}

114
rtl/sunos/ostypes.inc Normal file
View File

@ -0,0 +1,114 @@
{
$Id$
Copyright (c) 2000-2002 by Marco van de Voort
Some non POSIX BSD types used internally in the system unit.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
(*
Type
timezone = packed record
tz_minuteswest,
tz_dsttime : cint;
end;
ptimezone =^timezone;
TTimeZone = timezone;
rusage = packed record
ru_utime : timeval; { user time used }
ru_stime : timeval; { system time used }
ru_maxrss : clong; { max resident set size }
ru_ixrss : clong; { integral shared memory size }
ru_idrss : clong; { integral unshared data " }
ru_isrss : clong; { integral unshared stack " }
ru_minflt : clong; { page reclaims }
ru_majflt : clong; { page faults }
ru_nswap : clong; { swaps }
ru_inblock : clong; { block input operations }
ru_oublock : clong; { block output operations }
ru_msgsnd : clong; { messages sent }
ru_msgrcv : clong; { messages received }
ru_nsignals : clong; { signals received }
ru_nvcsw : clong; { voluntary context switches }
ru_nivcsw : clong; { involuntary " }
end;
// #define ru_last ru_nivcsw
// #define ru_first ru_ixrss
{ auto generated by a c prog, statmacr.c}
*)
Const
S_IFMT = 61440;
S_IFIFO = 4096;
S_IFCHR = 8192;
S_IFDIR = 16384;
S_IFBLK = 24576;
S_IFREG = 32768;
S_IFLNK = 40960;
S_IFSOCK= 49152;
S_IFWHT = 57344;
S_ISVTX = 512;
CONST
{ Constansts for MMAP }
MAP_PRIVATE =2;
MAP_ANONYMOUS =$1000;
{
$Log$
Revision 1.1 2005-02-07 22:17:26 peter
* updated for 1.9.x unix rtl
Revision 1.7 2005/02/06 12:16:52 peter
* bsd thread updates
Revision 1.6 2004/12/02 11:22:11 marco
* tz_ prefixed for timezone
Revision 1.5 2003/09/27 13:45:58 peter
* fpnanosleep exported in baseunix
* fpnanosleep has pointer arguments to be C compliant
Revision 1.4 2003/09/17 11:52:05 marco
* stat macro fixes voor BSD
Revision 1.3 2003/09/15 07:23:51 marco
* fix
Revision 1.2 2003/09/14 20:15:01 marco
* Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
Revision 1.1 2003/01/05 19:01:28 marco
* FreeBSD compiles now with baseunix mods.
Revision 1.4 2002/10/27 17:21:29 marco
* Only "difficult" functions + execvp + termios + rewinddir left to do
Revision 1.3 2002/10/27 11:58:30 marco
* Modifications from Saturday.
Revision 1.2 2002/09/07 16:01:17 peter
* old logs removed and tabs fixed
Revision 1.1 2002/08/19 12:29:11 marco
* First working POSIX *BSD system unit.
}

5
rtl/sunos/sysconst.inc
View File

@ -1,5 +0,0 @@
{
$Log$
Revision 1.1 2004-11-06 22:22:28 florian
* some sunos stuff from 1.0.x merged
}

74
rtl/sunos/sysos.inc Normal file
View File

@ -0,0 +1,74 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
This file implements all the base types and limits required
for a minimal POSIX compliant subset required to port the compiler
to a new OS.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
const clib = 'c';
type libcint=longint;
plibcint=^libcint;
function geterrnolocation: Plibcint; cdecl;external clib name'__errno_location';
function geterrno:libcint; [public, alias: 'FPC_SYS_GETERRNO'];
begin
geterrno:=geterrnolocation^;
end;
procedure seterrno(err:libcint); [public, alias: 'FPC_SYS_SETERRNO'];
begin
geterrnolocation^:=err;
end;
{ OS dependant parts }
{$I errno.inc} // error numbers
{$I bunxtype.inc} // c-types, unix base types, unix
// base structures
{*****************************************************************************
Extra cdecl declarations for FPC_USE_LIBC for this os
*****************************************************************************}
Function fpReadLink(name,linkname:pchar;maxlen:cint):cint; cdecl; external name 'readlink';
function fpgetcwd(buf:pchar;_size:size_t):pchar; cdecl; external name 'getcwd';
{$I ossysc.inc} // base syscalls
{$I osmain.inc} // base wrappers *nix RTL (derivatives)
function do_isdevice(handle:longint):boolean;
begin
do_isdevice:= (handle=StdInputHandle) or
(handle=StdOutputHandle) or
(handle=StdErrorHandle);
end;
{
$Log$
Revision 1.1 2005-02-07 22:17:26 peter
* updated for 1.9.x unix rtl
Revision 1.2 2005/02/06 13:06:20 peter
* moved file and dir functions to sysfile/sysdir
* win32 thread in systemunit
Revision 1.1 2005/02/06 11:20:52 peter
* threading in system unit
* removed systhrds unit
}

41
rtl/sunos/sysosh.inc Normal file
View File

@ -0,0 +1,41 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
This file implements all the base types and limits required
for a minimal POSIX compliant subset required to port the compiler
to a new OS.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
type
THandle = Longint;
PRTLCriticalSection = ^TRTLCriticalSection;
TRTLCriticalSection = record
{$warning TODO TRTLCriticalSection}
Locked: boolean
end;
{
$Log$
Revision 1.1 2005-02-07 22:17:26 peter
* updated for 1.9.x unix rtl
Revision 1.1 2005/02/06 16:57:18 peter
* threads for go32v2,os,emx,netware
Revision 1.1 2005/02/06 13:06:20 peter
* moved file and dir functions to sysfile/sysdir
* win32 thread in systemunit
}

62
rtl/sunos/system.pp
View File

@ -23,63 +23,10 @@ interface
implementation
var
Errno : longint; external name 'errno'; { declared in libc }
{ OS independant parts}
{$I system.inc}
{*****************************************************************************
OS Memory allocation / deallocation
****************************************************************************}
{ OS dependant parts }
{$I errno.inc}
{$I bunxtype.inc}
{$I osposix.inc}
{$I sysposix.inc}
function SysOSAlloc(size: ptrint): pointer;
begin
// result := sbrk(size);
end;
{$define HAS_SYSOSFREE}
procedure SysOSFree(p: pointer; size: ptrint);
begin
// fpmunmap(p, size);
end;
function do_isdevice(handle:longint):boolean;
begin
do_isdevice:= (handle=StdInputHandle) or
(handle=StdOutputHandle) or
(handle=StdErrorHandle);
end;
{$I text.inc}
{$I heap.inc}
{*****************************************************************************
UnTyped File Handling
*****************************************************************************}
{$i file.inc}
{*****************************************************************************
Typed File Handling
*****************************************************************************}
{$i typefile.inc}
procedure SysInitStdIO;
begin
@ -126,9 +73,7 @@ Begin
SysInitStdIO;
{ Reset IO Error }
InOutRes:=0;
(* This should be changed to a real value during *)
(* thread driver initialization if appropriate. *)
ThreadID := 1;
InitSystemThreads;
{$ifdef HASVARIANT}
initvariantmanager;
{$endif HASVARIANT}
@ -139,7 +84,10 @@ End.
{
$Log$
Revision 1.4 2005-02-01 20:22:50 florian
Revision 1.5 2005-02-07 22:17:26 peter
* updated for 1.9.x unix rtl
Revision 1.4 2005/02/01 20:22:50 florian
* improved widestring infrastructure manager
Revision 1.3 2004/12/05 14:36:38 hajny

31
rtl/sunos/systypes.inc
View File

@ -1,31 +0,0 @@
// copy paste of Solaris checked constants from Unix.pp. Not checked.
{********************
Process
********************}
const
{ For getting/setting priority }
Prio_Process = 0;
Prio_PGrp = 1;
Prio_User = 2;
WNOHANG = $100;
WUNTRACED = $4;
F_GetFd = 1;
F_SetFd = 2;
F_GetFl = 3;
F_SetFl = 4;
// zlowaris specific
F_DupFd = 0;
F_Dup2Fd = 9;
F_GetOwn = 23;
F_SetOwn = 24;
F_GetLk = 14;
F_SetLk = 6;
F_SetLkW = 7;
F_FreeSp = 11;

815
rtl/sunos/unixsysc.inc
View File

@ -1,815 +0,0 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2000 by Michael Van Canneyt,
member of the Free Pascal development team.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY;without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
//- libc funktions
const _MKNOD_VER=2;
Function cFork:longint;cdecl; external name 'fork1'; // fork1 is better here then fork
Procedure cExecve(path:pchar;args:ppchar;ep:ppchar); cdecl; external name 'execve';
Function cWaitPid(Pid:longint;Status:pointer;Options:Longint):Longint; cdecl; external name 'waitpid';
Function cGetTimeOfDay(var tv:timeval;var tz:timezone):integer;cdecl;external name 'gettimeofday';
Function cNice(n:LongInt):LongInt; cdecl; external name 'nice';
Function cGetPid:LongInt;cdecl; external name 'getpid';
Function cGetPPid:LongInt;cdecl; external name 'getppid';
Function cGetUid:Longint;cdecl; external name 'getuid';
Function cGetEUid:Longint;cdecl; external name 'geteuid';
Function cGetGid:Longint;cdecl; external name 'getgid';
Function cGetEGid:Longint;cdecl; external name 'getgid';
Function cSetUid(aUID:longint):longint;cdecl; external name 'setuid';
Function cSetGid(aGID:longint):longint;cdecl; external name 'setuid';
function cSetreUid(aRealUID,aEffUid:Longint):Longint; cdecl; external name 'setreuid';
function cSetreGid(aRealGID,aEffGid:Longint):Longint; cdecl; external name 'setreuid';
Function cfTruncate(fd,size:longint):Longint;cdecl; external name 'ftruncate';
Function cfSync (fd : Longint) : Longint; cdecl; external name 'fsync';
Function cChmod(path:pathstr;Newmode:longint):Longint; cdecl; external name 'chmod';
Function cChown(path:pathstr;NewUid,NewGid:longint):Longint;cdecl; external name 'chown';
Function cUmask(Mask:Longint):Longint;cdecl;external name 'umask';
//Function cFlock (fd,mode : longint) : longint; cdecl; external name 'flock';
Function cDup(oldfile:longint):longint;cdecl;external name 'dup';
Function cDup2(oldfile,newfile:longint):longint;cdecl;external name 'dup2';
Function cGetPriority(Which,Who:LongInt):LongInt;cdecl; external name 'getpriority';
Function cSetPriority(Which:LongInt;Who:LongInt;What:LongInt):LongInt;cdecl; external name 'setpriority';
Function cFcntl(Fd:longint;Cmd:LongInt):LongInt;cdecl;external name 'fcntl';
Function cFcntlArg(Fd:longint;Cmd:LongInt; arg:LongInt):LongInt;cdecl;external name 'fcntl';
Function cAccess(Path:pCHar; mode:LongInt):LongInt; cdecl; external name 'access';
Function cPipe(var pip:tpipe):LongInt; cdecl; external name 'pipe';
Function cUtime(path:pchar; var utim:utimebuf):LongInt; cdecl; external name 'utime';
Function cSelect(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):LongInt;cdecl; external name 'select';
Function cKill(Pid:longint;Sig:longint):LongINt;cdecl; external name 'kill';
Function cIOCtl(Handle,Ndx: Longint;Data: Pointer):LongInt; cdecl; external name 'ioctl';
Function cAlarm(Sec : Longint) : longint;cdecl; external name 'alarm';
Function cmknod(Vers:LongInt;pathname:pchar;mode,dev:longint):longint; cdecl; external name '_xmknod';
Function clStat(Vers:LongInt; Filename:pchar;var Buffer: Stat):longint; cdecl; external name '_lxstat';
Function cfStatfs(fd:LongInt; var Info:StatFs):LongInt; cdecl; external name 'fstatvfs';
Function cStatfs(Filename:pchar;var Buffer: StatFs):longint; cdecl; external name 'statvfs';
function cMUnMap(p:pointer;size:longint):integer;cdecl;external name 'munmap';
function cNanoSleep(const req : timespec;var rem : timespec) : longint; cdecl;external name 'nanosleep';
function cPause:longint; cdecl; external name 'pause';
function cSigProcMask(How:longint;SSet,OldSSet:PSigSet):longint; cdecl; external name 'sigprocmask';
function cSigPending(var s:SigSet):integer;cdecl; external name 'sigpending';
function cSigSuspend(s:PSigSet):longint;cdecl;external name 'sigsuspend';
function _cSignal(Signum:longint;Handler:Longint):SignalHandler; cdecl; external name 'signal';
function cSysInfo(cmd:longint; buff:pchar; len:longint):longint; cdecl; external name 'sysinfo';
{$LinkLib rt} // nanosleep
procedure libcerrorfix(fl:boolean); inline;
begin
if fl then
begin
Linuxerror:=libcerrno;
errno:=liberrno;
end
else
begin
Linuxerror:=0;
ErrNo:=0;
end;
end;
Function Fork:longint;
{
This function issues the 'fork' System call. the program is duplicated in memory
and Execution continues in parent and child process.
In the parent process, fork returns the PID of the child. In the child process,
zero is returned.
A negative value indicates that an error has occurred, the error is returned in
LinuxError.
}
var r : LongInt;
begin
r:=cFork; Fork:=r;
libcerrorfix((r=-1));
end;
{ Solaris has no clone, there thread funktion (libthread), like thr_create, but they haven't
the same options with flags and return a TID istead of a PID.
If one is interestet he might look to a Hack for lxrun which is contributed as diff.
Allthough the lxrun-hack dos not work at all, it shows what to take care of }
function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
var pid : Longint;
begin // Quick Hack, never tested, but should work if func does not believe on the Stack
if (pointer(func)=nil) or (sp=nil) then
begin
LinuxError:=Sys_EInval;
Errno:=sys_einval;
exit(-1);
end;
pid:=fork;
if (pid=0) then begin //Child
func(args) ;
ExitProcess(0);
end;
clone:=pid;
end;
Procedure Execve(path:pchar;args:ppchar;ep:ppchar);
{
Replaces the current program by the program specified in path,
arguments in args are passed to Execve.
environment specified in ep is passed on.
}
begin
cExecve(path,args,ep);
{ This only gets set when the call fails, otherwise we don't get here ! }
Linuxerror:=libcerrno;
errno:=libcerrno;
end;
Procedure Execve(path:pathstr;args:ppchar;ep:ppchar);
{
Replaces the current program by the program specified in path,
arguments in args are passed to Execve.
environment specified in ep is passed on.
}
begin
path:=path+#0; cExecve(@path[1],args,ep);
{ This only gets set when the call fails, otherwise we don't get here ! }
Linuxerror:=libcerrno;
errno:=libcerrno;
end;
Procedure ExitProcess(val:longint);external name '_exit'; // not 'exit' ('exit' close the shared handle)
Function WaitPid(Pid:longint;Status:pointer;Options:Longint):Longint;
{
Waits until a child with PID Pid exits, or returns if it is exited already.
Any resources used by the child are freed.
The exit status is reported in the adress referred to by Status. It should
be a longint.
}
begin
WaitPid:=cWaitPid(Pid,Status,Options); { =>PID, -1+errno=eintr: Signal, -1+errno, 0=Ok }
libcerrorfix(WaitPid=-1));
end;
Procedure GetTimeOfDay(var tv:timeval);
{
Get the number of seconds since 00:00, January 1 1970, GMT
the time NOT corrected any way
}
var tz : timezone;
r : Integer;
begin
r:=cGetTimeOfDay(tv,tz);
libcerrorfix (r=-1);
end;
Function GetTimeOfDay: longint;
{
Get the number of seconds since 00:00, January 1 1970, GMT
the time NOT corrected any way
}
var tz : timezone;
tv : timeval;
begin
libcerrorfix(cGetTimeOfDay(tv,tz)=-1);
GetTimeOfDay:=tv.sec;
end;
Function GetPriority(Which,Who:Integer):integer;
{
Get Priority of process, process group, or user.
Which : selects what kind of priority is used.
can be one of the following predefined Constants :
Prio_User.
Prio_PGrp.
Prio_Process.
Who : depending on which, this is , respectively :
Uid
Pid
Process Group id
Errors are reported in linuxerror _only_. (priority can be negative)
}
begin
errno:=0;
if (which<prio_process) or (which>prio_user) then
begin
{ We can save an interrupt here }
getpriority:=0;
linuxerror:=Sys_einval;
Errno:=sys_einval;
end
else
begin
GetPriority:=cGetPriority(Which,Who);
libcerrorfix(getpriority=-1);
end;
end;
Procedure SetPriority(Which:Integer;Who:Integer;What:Integer);
{
Set Priority of process, process group, or user.
Which : selects what kind of priority is used.
can be one of the following predefined Constants :
Prio_User.
Prio_PGrp.
Prio_Process.
Who : depending on value of which, this is, respectively :
Uid
Pid
Process Group id
what : A number between -20 and 20. -20 is most favorable, 20 least.
0 is the default.
}
var r : Integer;
begin
errno:=0;
if ((which<prio_process) or (which>prio_user)) or ((what<-20) or (what>20)) then
begin
linuxerror:=Sys_einval { We can save an interrupt here }
errno:=libcerrno;
end
else
begin
r:=cSetPriority(Which,Who,What);
libcerrorfix(r=-1);
end;
end;
Procedure Nice(N:integer);
{
Set process priority. A positive N means a lower priority.
A negative N decreases priority.
}
begin
libcerrorfix(cNice(n)=-1);
end;
Function GetPid:LongInt;
{
Get Process ID.
}
begin
GetPid:=cGetPid;
libcerrorfix(GetPID=-1);
end;
Function GetPPid:LongInt;
{
Get Process ID of parent process.
}
begin
GetPPid:=cGetPPid;
libcerrorfix(GetPPID=-1);
end;
Function GetUid:Longint;
{
Get User ID.
}
begin
GetUid:=cGetUid;
libcerrorfix (GetUid=-1);
end;
Function GetEUid:Longint;
{
Get _effective_ User ID.
}
begin
GetEUid:=cGetEUid;
libcerrorfix(GetEUid=-1);
end;
Function GetGid:Longint;
{
Get Group ID.
}
begin
GetGid:=cGetGid;
libcerrorfix(GetGid=-1);
end;
Function GetEGid:Longint;
{
Get _effective_ Group ID.
}
begin
GetEGid:=cGetEGid;
libcerrorfix (GetEGid=-1);
end;
// Set the real userid/groupid (uid/gid from calling process)
function SetUid(aUID:Longint):Boolean;
begin
SetUid:=(cSetUid(aUid)=0);
libcerrorfix( not(SetUid));
end;
function SetGid(aGID:Longint):Boolean;
begin
SetGid:=(cSetGid(aGid)=0);
libcerrorfix( not(SetGid));
end;
// Set the real and effective userid/groupid (like setuid/setgid bit in file permissions)
function SetreUid(aRealUID,aEffUid:Longint):Boolean;
begin
SetreUid:=(cSetreUid(aRealUID,aEffUID)=0);
libcerrorfix( not(SetreUid));
end;
function SetreUid(aUID:Longint):Boolean;
begin
SetreUid:=SetreUid(aUID,aUID);
end;
function SetreGid(aRealGid,aEffGid:Longint):Boolean; overload;
begin
SetreGid:=(cSetreUid(aRealGID,aEffGID)=0);
libcerrorfix(not(SetreGid));
end;
function SetreGid(aGid:Longint):Boolean;overload;
begin
SetreGid:=SetreGid(aGID,aGID);
end;
Function fdTruncate(fd,size:longint):boolean;
begin
fdTruncate:=cfTruncate(fd,size)<>-1;
libcerrorfix(not fdTruncate);
end;
Function fdFlush (fd : Longint) : Boolean;
begin
fdFlush:=cfSync(fd)<>-1;
libcerrorfix( not fdFlush);
end;
Function Fcntl(Fd:longint;Cmd:integer):integer;
{
Read or manipulate a file.(See also fcntl (2) )
Possible values for Cmd are :
F_GetFd,F_GetFl,F_GetOwn F_DUPFd, F_Dup2FD...
Errors are reported in Linuxerror;
If Cmd is different from the allowed values, linuxerror=Sys_eninval.
}
begin
// the retun is not compatible to the linux-definition (returning 0 on -1 (err)), but 0 may be a valid return
if (cmd in [F_GetFd,F_GetFl,F_GetOwn, {solaris:} F_DupFd]) then
begin
Fcntl:=cFcntl(fd,Cmd);
libcerrorfix(Fcntl=-1);
end
else
begin
linuxerror:=Sys_einval;
Errno:=sys_einval;
Fcntl:=-1;
end;
end;
Procedure Fcntl(Fd:longint;Cmd:Integer;Arg:Longint);
{
Read or manipulate a file. (See also fcntl (2) )
Possible values for Cmd are :
F_setFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkW,F_SetOwn;
Errors are reported in Linuxerror;
If Cmd is different from the allowed values, linuxerror=Sys_eninval.
F_DupFD is not allowed, due to the structure of Files in Pascal.
}
begin
if (cmd in [F_SetFd,F_SetFl,F_GetLk,F_SetLk,F_SetLkw,F_SetOwn {Solaris:} ,F_Dup2Fd,F_FreeSp{,F_GetLk64,F_SetLk64,F_SetLkw64}]) then
begin
libcerrorfix( cFcntlArg(fd,Cmd,Arg)=-1);
end
else begin
linuxerror:=Sys_einval;
errno:=sys_einval;
end;
end;
Function Chmod(path:pathstr;Newmode:longint):Boolean;
{
Changes the permissions of a file.
}
begin
Chmod:=cChmod(path,NewMode)=0;
libcerrorfix( not Chmod);
end;
Function Chown(path:pathstr;NewUid,NewGid:longint):boolean;
{
Change the owner and group of a file.
A user can only change the group to a group of which he is a member.
The super-user can change uid and gid of any file.
}
begin
Chown:=cChown(path,NewUid,NewGid)=0;
libcerrorfix(not Chown);
end;
Function Utime(path:pathstr;utim:utimebuf):boolean;
begin
path:=path+#0;
UTime:=cUtime(@Path[1],utim)=0;
libcerrorfix( not UTime);
end;
Function Flock (fd,mode : longint) : boolean;
begin
FLock:=TRUE;
// FLock:=cFLock(fd,mode)=0;
libcerrorfix(not FLock);
end;
Function Fstat(Fd:Longint;var Info:stat):Boolean;
{
Get all information on a file descriptor, and return it in info.
}
begin
FStat:=Sys_fstat(fd,Info)=0;
libcerrorfix( not FStat);
end;
Function Lstat(Filename: PathStr;var Info:stat):Boolean;
{
Get all information on a link (the link itself), and return it in info.
}
begin
FileName:=FileName+#0;
LStat:=clstat(STAT_VERS,@FileName[1],Info)=0;
libcerrorfix( not LStat);
end;
Function FSStat(Path:Pathstr;Var Info:statfs):Boolean;
{
Get all information on a fileSystem, and return it in Info.
Path is the name of a file/directory on the fileSystem you wish to
investigate.
}
begin
path:=path+#0;
FSStat:=cstatfs(@path[1],Info)=0;
libcerrorfix(not FSStat);
end;
Function FSStat(Fd:Longint;Var Info:statfs):Boolean;
{
Get all information on a fileSystem, and return it in Info.
Fd is the file descriptor of a file/directory on the fileSystem
you wish to investigate.
}
begin
FSStat:=cfstatfs(fd,Info)=0;
libcerrorfix( not FSStat);
end;
Function Link(OldPath,NewPath:pathstr):boolean;
{
Proceduces a hard link from new to old.
In effect, new will be the same file as old.
}
begin
OldPath:=OldPath+#0; NewPath:=NewPath+#0;
Link:=Sys_SymLink(@OldPath[1],@NewPath[1])<>-1;
libcerrorfix( not Link);
end;
Function Umask(Mask:Integer):integer;
{
Sets file creation mask to (Mask and 0777 (octal) ), and returns the
previous value.
}
begin
Umask:=cUmask(Mask);
libcerrorfix (Umask=-1);
end;
Function Access(Path:Pathstr ;mode:integer):boolean;
{
Test users access rights on the specified file.
Mode is a mask xosisting of one or more of R_OK, W_OK, X_OK, F_OK.
R,W,X stand for read,write and Execute access, simultaneously.
F_OK checks whether the test would be allowed on the file.
i.e. It checks the search permissions in all directory components
of the path.
The test is done with the real user-ID, instead of the effective.
If access is denied, or an error occurred, false is returned.
If access is granted, true is returned.
Errors other than no access,are reported in linuxerror.
}
begin
path:=path+#0;
Access:=cAccess(@Path[1],mode)=0;
libcerrorfix( not Access);
end;
Function Dup(oldfile:longint;var newfile:longint):Boolean;
{
Copies the filedescriptor oldfile to newfile
}
begin
NewFile:=cDup(OldFile);
Dup:=(NewFile<>-1);
libcerrorfix( not Dup);
end;
Function Dup2(oldfile,newfile:longint):Boolean;
{
Copies the filedescriptor oldfile to newfile
}
begin
Dup2:=cDup2(OldFile,NewFile)<>-1;
libcerrorfix( not Dup2);
end;
Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
{
Select checks whether the file descriptor sets in readfs/writefs/exceptfs
have changed.
}
Var
SelectArray : Array[1..5] of longint;
begin
Select:=cSelect(N,readfds,writefds,exceptfds,TimeOut);
libcerrorfix( Select=-1);
end;
Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
{
Sets up a pair of file variables, which act as a pipe. The first one can
be read from, the second one can be written to.
If the operation was unsuccesful, linuxerror is set.
}
var
pip : tpipe;
begin
AssignPipe:=cPipe(pip)=0;
if AssignPipe then begin
pipe_in:=pip[1];
pipe_out:=pip[2];
LinuxError:=0;
Errno:=0;
end
else
begin
LinuxError:=libcErrNo;
Errno:=libcerrno;
end;
end;
Function PClose(Var F:text) :longint;
var
pl : ^longint;
begin
Sys_Close(Textrec(F).Handle);
{ closed our side, Now wait for the other - this appears to be needed ?? }
pl:=@(textrec(f).userdata[2]);
pclose:=WaitProcess(pl^);
end;
Function PClose(Var F:file) : longint;
var
pl : ^longint;
begin
Sys_Close(Filerec(F).Handle);
{ closed our side, Now wait for the other - this appears to be needed ?? }
pl:=@(filerec(f).userdata[2]);
pclose:=WaitProcess(pl^);
end;
Function Sysinfo(var Info:TSysinfo):Boolean; // ToDO
{
Get system info
(Mvdv:Linux specific, not implemented under FreeBSD too.
Under FreeBSD I will simply implement a sysctl unit)
}
var
regs : SysCallregs;
Begin
(* regs.reg2:=longint(@info);
Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0;*)
WriteLN('SysInfo not supported yet ');
End;
Function mkFifo(pathname:string;mode:longint):boolean;
begin
pathname:=pathname+#0;
mode:=mode or STAT_IFIFO;
mkFifo:=cmknod(_MKNOD_VER,@pathname[1],mode,0)=0;
libcerrorfix(not mkFifo);
end;
{
Function Uname(var unamerec:utsname):Boolean; // ToDo
{
Get machine's names
}
var
regs : SysCallregs;
Begin
Errno:=0;
cSysInfo(SI_SYSNAME,@unamerec.sysname,SizeOf(unamerec.sysname));
cSysInfo(SI_HOSTNAME,@unamerec.nodename,SizeOf(unamerec.nodename));
cSysInfo(SI_RELEASE,@unamerec.release,SizeOf(unamerec.release));
cSysInfo(SI_VERSION,@unamerec.version,SizeOf(unamerec.version));
cSysInfo(SI_MACHINE,@unamerec.machine,SizeOf(unamerec.machine));
cSysInfo(SI_SRPC_DOMAIN,@unamerec.domainname,SizeOf(unamerec.domainname));
LinuxError:=Errno;
End;
}
Function Kill(Pid:longint;Sig:longint):integer;
{
Send signal 'sig' to a process, or a group of processes.
If Pid > 0 then the signal is sent to pid
pid=-1 to all processes except process 1
pid < -1 to process group -pid
Return value is zero, except for case three, where the return value
is the number of processes to which the signal was sent.
}
begin
Kill:=cKill(PID,Sig);
libcerrorfix( Kill=-1);
if kill<0 then Kill:=0; // from the linux source
end;
Procedure SigProcMask(How:longint;SSet,OldSSet:PSigSet); //ToDo
{
Change the list of currently blocked signals.
How determines which signals will be blocked :
SigBlock : Add SSet to the current list of blocked signals
SigUnBlock : Remove the signals in SSet from the list of blocked signals.
SigSetMask : Set the list of blocked signals to SSet
if OldSSet is non-null, the old set will be saved there.
}
begin
libcerrorfix( cSigProcMask(How,SSet,OldSSet)=0);
end;
Function SigPending:SigSet;
{
Allows examination of pending signals. The signal mask of pending
signals is set in SSet
}
Var
dummy : Sigset;
begin
libcerrorfix(cSigPending(dummy)=0);
Sigpending:=dummy;
end;
Procedure SigSuspend(Mask:Sigset); // ToDo
{
Set the signal mask with Mask, and suspend the program until a signal
is received.
}
begin
libcerrorfix (cSigSuspend(@Mask)=0);
end;
Function Signal(Signum:longint;Handler:SignalHandler):SignalHandler;
{
Install a new handler for signal Signum.
The old signal handler is returned.
This call does, in fact, the same as SigAction.
}
var
r :LongInt;
begin
Signal:=NIL;
r:=longint(_cSignal(Signum,longint(Handler)));
if (r=-1) then begin
Signal:=nil;
LinuxError:=libcerrno;
Errno:=libcerrno;
end
else
begin
Signal:=signalhandler(r);
LinuxError:=0;
ErrNo:=0;
end;
exit;
end;
Function Alarm(Sec : Longint) : longint;
begin
Alarm:=cAlarm(Sec);
LinuxError:=0; // no error
Errno:=0;
end;
Procedure Pause;
begin cPause;end;
Function NanoSleep(const req : timespec;var rem : timespec) : longint;
begin
NanoSleep:=cNanoSleep(req,rem);
Libcerrorfix( NanoSleep=-1);
end;
Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean;
{
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.
}
begin
IOCtl:=cIOCtl(Handle,Ndx,Data)<>-1;
libcerrorfix( not IOCtl);
end;
function MUnMap (P : Pointer; Size : Longint) : Boolean;
begin
MUnMap:=cMUnMap(p,size)=0;
libcerrorfix( not MUnMap);
end;
{--------------------------------
Port IO functions
--------------------------------}
{
// all of them has to be checked for soalris
Function IOperm (From,Num : Cardinal; Value : Longint) : boolean;
{
Set permissions on NUM ports starting with port FROM to VALUE
this works ONLY as root.
}
Var
Sr : Syscallregs;
begin
(* Sr.Reg2:=From;
Sr.Reg3:=Num;
Sr.Reg4:=Value;
IOPerm:=Syscall(Syscall_nr_ioperm,sr)=0;
LinuxError:=Errno;*)
WriteLN('IOperm not suppoted yet');
end;
Function IoPL(Level : longint) : Boolean;
Var
Sr : Syscallregs;
begin
(* Sr.Reg2:=Level;
IOPL:=Syscall(Syscall_nr_iopl,sr)=0;
LinuxError:=Errno;*)
WriteLN('IoPL not suppoted yet');
end;
{
$Log$
Revision 1.3 2002-09-07 16:01:26 peter
* old logs removed and tabs fixed
}