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

* FPC_USE_LIBC

Browse Source
This commit is contained in:
marco 2003-12-30 12:24:01 +00:00
parent f587f35457
commit b6f9f170f7
23 changed files with 482 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
rtl/bsd/baseunix.pp
View File

@ -24,9 +24,17 @@ Interface
{$define posixworkaround} // Temporary ugly workaround for signal handler.
// (mainly until baseunix migration is complete)
{$ifndef FPC_USE_LIBC}
{$define FPC_USE_SYSCALL}
{$endif}
{$i errno.inc} { Error numbers }
{$i bunxtype.inc} { Types }
{$ifdef FPC_USE_LIBC}
{$i oscdeclh.inc}
{$ELSE}
{$i bunxh.inc} { Functions}
{$ENDIF}
function fpgeterrno:longint;
procedure fpseterrno(err:longint);
@ -35,6 +43,8 @@ procedure fpseterrno(err:longint);
property errno : cint read fpgeterrno write fpseterrno;
{$endif}
{$i bunxovlh.inc}
implementation
@ -48,7 +58,10 @@ end.
{
$Log$
Revision 1.5 2003-12-10 17:13:43 marco
Revision 1.6 2003-12-30 12:26:21 marco
* FPC_USE_LIBC
Revision 1.5 2003/12/10 17:13:43 marco
* property support under ifndef ver1_0
Revision 1.4 2003/12/10 17:08:33 marco

11
rtl/bsd/bunxfunc.inc
View File

@ -16,18 +16,22 @@
**********************************************************************}
{$ifndef FPC_USE_LIBC}
{$i syscallh.inc} // do_syscall declarations themselves
{$i sysnr.inc} // syscall numbers.
{$i ossysch.inc} // external interface to syscalls in system unit.
{$endif}
{$i genfuncs.inc} // generic calls. (like getenv)
{$I gensigset.inc} // general sigset funcs implementation.
{$I genfdset.inc} // general fdset funcs.
{$ifndef FPC_USE_LIBC}
{ $ ifndef ver1_0}
Function FpSigProcMask(how : cInt; Const nset : TSigSet; var oset : TSigSet): cInt; external name 'FPC_SYSC_SIGPROCMASK';
{ $ endif}
{$USER BLA!}
Function FPKill(Pid:pid_t;Sig:cint):cint;
{
@ -450,11 +454,14 @@ Function fpSelect(N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cin
begin
fpSelect:=do_syscall(syscall_nr_select,n,longint(readfds),longint(writefds),longint(exceptfds),longint(timeout));
end;
{$endif}
{
$Log$
Revision 1.6 2003-11-18 10:12:25 marco
Revision 1.7 2003-12-30 12:26:21 marco
* FPC_USE_LIBC
Revision 1.6 2003/11/18 10:12:25 marco
* Small fixes for EAGAIN. bunxfunc only has comments added.
Revision 1.5 2003/10/26 17:01:04 marco

10
rtl/bsd/bunxmain.inc
View File

@ -5,7 +5,7 @@
Implementation of the POSIX unit for *BSD. In practice only includes
other files, or specifies libc bindings.
The conditional uselibc can be used to switch from libc to syscall
The conditional FPC_USELIBC can be used to switch from libc to syscall
usage for basic primitives, but it is best to use unit POSIX if
possible. Note that the system unit must also be compiled using uselibc.
@ -24,13 +24,12 @@ Uses Sysctl;
{$I ostypes.inc}
{$I bunxmacr.inc}
{$ifdef uselibc}
{$ifdef FPC_USE_LIBC}
{$Linklib c}
{ var
Errno : cint; external name 'errno';}
{$i oscdeclh.inc}
{$else}
{$i sysdeclh.inc}
@ -40,7 +39,10 @@ Uses Sysctl;
{
$Log$
Revision 1.2 2003-06-01 16:35:27 marco
Revision 1.3 2003-12-30 12:26:21 marco
* FPC_USE_LIBC
Revision 1.2 2003/06/01 16:35:27 marco
* Several small fixes to harmonize the *BSD rtls and Linux.
Revision 1.1 2003/01/05 19:01:28 marco

8
rtl/bsd/i386/syscall.inc
View File

@ -23,6 +23,8 @@
These functions are the same over all three BSDs, except that some have a
32-bit Errno, and some a 16-bit}
{$ifdef FPC_USE_SYSCALL}
{$ifdef NetBSD}
{$UNDEF ErrnoWord}
{$endif}
@ -145,7 +147,11 @@ asm
addl $28,%esp
end;
{$endif}
{
$Log:
$Log$
Revision 1.10 2003-12-30 12:26:21 marco
* FPC_USE_LIBC
}

8
rtl/bsd/i386/syscallh.inc
View File

@ -22,6 +22,8 @@
}
{$ifdef FPC_USE_SYSCALL}
Type
TSysResult = longint; // all platforms, cint=32-bit.
@ -43,10 +45,14 @@ function do_sysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult;{$if
function do_sysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS5';
function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):int64;{$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS6';
function do_sysCall(sysnr,param1,param2,param3,param4,param5,param6,param7:TSysParam):int64; {$ifndef VER1_0} oldfpccall;{$endif} external name 'FPC_DOSYS7';
{$endif}
{
$Log$
Revision 1.8 2003-09-15 20:08:49 marco
Revision 1.9 2003-12-30 12:26:21 marco
* FPC_USE_LIBC
Revision 1.8 2003/09/15 20:08:49 marco
* small fixes. FreeBSD now cycles
Revision 1.7 2003/09/14 20:15:01 marco

20
rtl/bsd/osmain.inc
View File

@ -151,7 +151,7 @@ end;
Function Errno2InoutRes : longint;
begin
Errno2InoutRes:=PosixToRunError(Errno);
Errno2InoutRes:=PosixToRunError(getErrno);
InoutRes:=Errno2InoutRes;
end;
@ -206,10 +206,13 @@ End;
Function Do_Write(Handle,Addr,Len:Longint):longint;
var j : cint;
Begin
repeat
Do_Write:=Fpwrite(Handle,pchar(addr),len);
until (do_write<>-1) or ((ErrNo<>ESysEINTR) and (Errno<>ESysEAgain));
j:=geterrno;
until (do_write<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
If Do_Write<0 Then
Begin
Errno2InOutRes;
@ -221,10 +224,14 @@ End;
Function Do_Read(Handle,Addr,Len:Longint):Longint;
var j:cint;
Begin
repeat
Do_Read:=Fpread(Handle,pchar(addr),len);
until (do_read<>-1) or ((ErrNo<>ESysEINTR) and (ErrNo<>ESysEAgain));
j:=geterrno;
until (do_read<>-1) or ((j<>ESysEINTR) and (j<>ESysEAgain));
If Do_Read<0 Then
Begin
Errno2InOutRes;
@ -342,7 +349,7 @@ Begin
{ real open call }
FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
if (FileRec(f).Handle<0) and
(ErrNo=ESysEROFS) and ((OFlags and O_RDWR)<>0) then
(getErrNo=ESysEROFS) and ((OFlags and O_RDWR)<>0) then
begin
Oflags:=Oflags and not(O_RDWR);
FileRec(f).Handle:=Fpopen(p,oflags,MODE_OPEN);
@ -666,7 +673,10 @@ End.
{
$Log$
Revision 1.8 2003-12-21 20:31:50 peter
Revision 1.9 2003-12-30 12:26:21 marco
* FPC_USE_LIBC
Revision 1.8 2003/12/21 20:31:50 peter
* fix getdir when directory contains files that give EACCESS
Revision 1.7 2003/12/14 14:47:02 marco

79
rtl/bsd/ossysc.inc
View File

@ -18,12 +18,17 @@
{$i ostypes.inc}
{$ifdef uselibc}
{$ifdef FPC_USE_LIBC}
{$Linklib c}
// Out of date atm.
{$ifdef FPC_IS_SYSTEM}
{$i oscdeclh.inc}
{$endif}
{$I bunxmacr.inc}
{ var
Errno : cint; external name 'errno';}
Errno : cint; external name 'errno';
function Fptime(tloc:ptime_t): time_t; cdecl; external name 'time';
function Fpopen(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open';
@ -54,7 +59,7 @@
function FpDup(oldd:cint):cint; cdecl; external name 'dup';
function FpDup2(oldd:cint;newd:cint):cint; cdecl; external name 'dup2';
}
{$else}
{*****************************************************************************
@ -466,10 +471,6 @@ begin
Fpdup2:=do_syscall(syscall_nr_dup2,TSysParam(fildes),TSysParam(fildes2));
end;
CONST
{ Constansts for MMAP }
MAP_PRIVATE =2;
MAP_ANONYMOUS =$1000;
Function Fpmunmap(start:pointer;len:size_t):cint; [public, alias :'FPC_SYSC_MUNMAP'];
@ -477,14 +478,6 @@ begin
Fpmunmap:=do_syscall(syscall_nr_munmap,TSysParam(start),Len);
end;
Function sbrk(size : longint) : pointer;
begin
sbrk:=Fpmmap(nil,cardinal(Size),3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
if sbrk=pointer(-1) then
sbrk:=nil
else
errno:=0;
end;
{
Interface to Unix ioctl call.
@ -500,22 +493,6 @@ begin
FpIOCtl:=do_SysCall(syscall_nr_ioctl,handle,Ndx,TSysParam(data));
end;
CONST
IOCtl_TCGETS=$5401;
Function Do_IsDevice(Handle:Longint):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.
}
var
Data : array[0..255] of byte; {Large enough for termios info}
begin
Do_IsDevice:=(Fpioctl(handle,IOCTL_TCGETS,@data)<>-1);
end;
Function FpGetPid:LongInt; [public, alias : 'FPC_SYSC_GETPID'];
{
@ -546,7 +523,7 @@ function FPSigProcMask(how:cint;nset : psigset;oset : psigset):cint; [public, al
begin
FPsigprocmask:=do_syscall(syscall_nr_sigprocmask,longint(how),longint(nset),longint(oset));
end;
{$user BLA!}
Function FpNanoSleep(req : ptimespec;rem : ptimespec) : cint; [public, alias : 'FPC_SYSC_NANOSLEEP'];
begin
{$ifndef darwin}
@ -612,9 +589,45 @@ end;
{$endif}
CONST
IOCtl_TCGETS=$5401;
Function Do_IsDevice(Handle:Longint):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.
}
var
Data : array[0..255] of byte; {Large enough for termios info}
begin
Do_IsDevice:=(Fpioctl(handle,IOCTL_TCGETS,@data)<>-1);
end;
CONST
{ Constansts for MMAP }
MAP_PRIVATE =2;
MAP_ANONYMOUS =$1000;
Function sbrk(size : cint) : pointer;
begin
sbrk:=Fpmmap(nil,cardinal(Size),3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0);
if sbrk=pointer(-1) then
sbrk:=nil
else
seterrno(0);
end;
{
$Log$
Revision 1.15 2003-12-16 19:43:59 marco
Revision 1.16 2003-12-30 12:26:21 marco
* FPC_USE_LIBC
Revision 1.15 2003/12/16 19:43:59 marco
* nil <-> 0 changes
Revision 1.14 2003/10/26 17:01:04 marco

7
rtl/bsd/ossysch.inc
View File

@ -20,6 +20,7 @@
//Function Fpmunmap(start:pointer;len:size_t):cint; external name 'FPC_SYSC_MUNMAP';
//function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; external name 'FPC_SYSC_GETTIMEOFDAY';
{$ifndef FPC_USE_LIBC}
Function FpIOCtl(Handle:cint;Ndx: culong;Data: Pointer):cint; external name 'FPC_SYSC_IOCTL';
Function FpGetPid:LongInt; external name 'FPC_SYSC_GETPID';
//Function FpReadLink(name,linkname:pchar;maxlen:longint):longint; external name 'FPC_SYSC_READLINK';
@ -28,10 +29,14 @@ Function FpNanoSleep (req : ptimespec;rem : ptimespec) : cint; external name 'FP
{ can be used for getdir?}
Function Fpgetcwd (path:pchar; siz:size_t):pchar; external name 'FPC_SYSC_GETCWD';
{$endif}
{
$Log$
Revision 1.6 2003-09-27 13:45:58 peter
Revision 1.7 2003-12-30 12:26:21 marco
* FPC_USE_LIBC
Revision 1.6 2003/09/27 13:45:58 peter
* fpnanosleep exported in baseunix
* fpnanosleep has pointer arguments to be C compliant

21
rtl/bsd/sysctl.pp
View File

@ -18,6 +18,10 @@ Unit sysctl;
Interface
{$ifndef FPC_USE_LIBC}
{$define FPC_USE_SYSCALL}
{$endif}
{$I ptypes.inc}
{$Packrecords C}
@ -81,16 +85,19 @@ function FPsysctlnametomib (Name: pchar; mibp:plongint;sizep:psize_t):cint;
Implementation
{$ifndef FPC_USE_LIBC}
Uses Syscall;
{$ENDIF}
{temporarily}
{$ifdef FPC_USE_LIBC}
function FPsysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint; external name 'sysctl';
function FPsysctlbyname (Name: pchar; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint; external name 'sysctlbyname';
function FPsysctlnametomib (Name: pchar;mibp:plongint;sizep:psize_t):cint; external name 'sysctltomib';
{$else}
{$ifdef FreeBSD}
CONST syscall_nr___sysctl = 202;
{$endif}
{I sysnr.inc}
{I syscallh.inc}
function FPsysctl (Name: pchar; namelen:cuint; oldp:pointer;oldlenp:psize_t; newp:pointer;newlen:size_t):cint;
Begin
@ -135,12 +142,16 @@ Begin
Exit (error);
FPsysctlnametomib:=0;
End;
{$endif}
end.
{
$Log$
Revision 1.5 2003-11-19 17:11:40 marco
Revision 1.6 2003-12-30 12:26:21 marco
* FPC_USE_LIBC
Revision 1.5 2003/11/19 17:11:40 marco
* termio unit
Revision 1.4 2003/01/05 19:01:28 marco

55
rtl/bsd/system.pp
View File

@ -21,25 +21,60 @@
{ If you use an aout system, set the conditional AOUT}
{ $Define AOUT}
{$ifdef BSD}
Unit {$ifdef VER1_0}SysBSD{$else}System{$endif};
{$else}
Unit {$ifdef VER1_0}Syslinux{$else}System{$endif};
{$endif}
Interface
{$I sysunixh.inc}
{$define FPC_USE_SIGPROCMASK}
{$define FPC_USE_SIGALTSTACK}
CONST SIGSTKSZ = 40960;
{$ifndef FPC_USE_LIBC}
{$define FPC_USE_SYSCALL}
{$endif}
{$define FPC_IS_SYSTEM}
{$I sysunixh.inc}
CONST SIGSTKSZ = 40960;
Implementation
Var Errno : longint;
{$ifdef FPC_USE_LIBC}
const clib = 'c';
type libcint=longint;
plibcint=^libcint;
{$ifdef FreeBSD} // tested on x86
function geterrnolocation: Plibcint; cdecl;external clib name '__error';
{$else}
{$ifdef NetBSD} // from a sparc dump.
function geterrnolocation: Plibcint; cdecl;external clib name '__errno';
{$else}
{$endif}
{$endif}
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;
{$else}
{$ifdef ver1_0}
Var
{$else}
threadvar
{$endif}
Errno : longint;
function geterrno:longint; [public, alias: 'FPC_SYS_GETERRNO'];
@ -52,6 +87,7 @@ procedure seterrno(err:longint); [public, alias: 'FPC_SYS_SETERRNO'];
begin
Errno:=err;
end;
{$endif}
{ OS independant parts}
@ -108,7 +144,10 @@ End.
{
$Log$
Revision 1.10 2003-10-26 17:01:04 marco
Revision 1.11 2003-12-30 12:26:21 marco
* FPC_USE_LIBC
Revision 1.10 2003/10/26 17:01:04 marco
* moved sigprocmask to system
Revision 1.9 2003/10/26 16:42:22 marco

20
rtl/bsd/unxsysch.inc
View File

@ -1,3 +1,17 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2003 Marco van de Voort
member of the Free Pascal development team.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY;without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
function fpNice(N:cint):cint;
Function fpGetPriority(Which,Who:cint):cint;
@ -11,3 +25,9 @@ Function Fpmmap(start:pointer;len:size_t;prot:cint;flags:cint;fd:cint;offst:off_
Function Fpmunmap(start:pointer;len:size_t):cint; external name 'FPC_SYSC_MUNMAP';
function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; external name 'FPC_SYSC_GETTIMEOFDAY';
{
$Log$
Revision 1.4 2003-12-30 12:26:21 marco
* FPC_USE_LIBC
}

38
rtl/unix/bunxh.inc
View File

@ -19,18 +19,7 @@ Type TGrpArr = Array [0..0] of TGid; { C style array workarounds}
TFilDes = Array [0..1] of cInt;
pFilDes = ^TFilDes;
Function fpFD_SET (fdno:cint;var nset : TFDSet): cint;
Function fpFD_CLR (fdno:cint;var nset : TFDSet): cint;
Function fpFD_ZERO (var nset : TFDSet):cint;
Function fpFD_ISSET (fdno:cint;const nset : TFDSet): cint;
Function fpfdfillset (var nset : TFDSet):cint;
Function FpsigEmptySet(var nset : TSigSet): cint;
Function FpSigFillSet (var nset : TSigSet): cInt;
Function FpSigAddSet (var nset : TSigSet; signo : cInt): cInt;
Function FpSigDelSet (var nset : TSigSet; signo : cInt): cInt;
Function FpSigIsMember(Const nset : TSigSet; signo : cInt): cInt;
// if you are looking for macro definitions, they are moved to bunxovlh.inc
Function FpSigProcMask(how : cInt; nset : pSigSet; oset : pSigSet): cInt;
Function FpSigProcMask(how : cInt; Const nset : TSigSet; var oset : TSigSet): cInt;
@ -100,29 +89,14 @@ Type TGrpArr = Array [0..0] of TGid; { C style array workarounds}
Function FpNanoSleep (req : ptimespec;rem : ptimespec):cint;
Function FpGetEnv (name : pChar): pChar;
Function FpGetEnv (name : String): pChar;
Function fpS_ISDIR (m : TMode): Boolean;
Function fpS_ISCHR (m : TMode): Boolean;
Function fpS_ISBLK (m : TMode): Boolean;
Function fpS_ISREG (m : TMode): Boolean;
Function fpS_ISFIFO (m : TMode): Boolean;
// The following two are very common, but not POSIX.
Function fpS_ISLNK (m:TMode) : Boolean;
Function fpS_ISSOCK (m:TMode) : Boolean;
Function wifexited (Status : cInt): cInt;
Function wexitStatus (Status : cInt): cInt;
Function wstopsig (Status : cInt): cInt;
Function wifsignaled (Status : cInt): cInt;
Function wtermsig (Status : cInt): cInt;
{$i bunxovlh.inc} // overloads and/or redefs.
// Function FpGetEnv (name : String): pChar; overloaded to bunxovlh.inc
{
$Log$
Revision 1.10 2003-09-27 13:49:41 peter
Revision 1.11 2003-12-30 12:24:01 marco
* FPC_USE_LIBC
Revision 1.10 2003/09/27 13:49:41 peter
* fpnanosleep exported
Revision 1.9 2003/09/27 12:51:33 peter

23
rtl/unix/bunxovl.inc
View File

@ -68,6 +68,7 @@ Begin
FpOpen:=FpOpen(pchar(Path),flags,mode);
End;
Function FpMkdir (path : AnsiString; Mode: TMode):cInt;
Begin
FpMkdir:=FpMkdir(pchar(Path),mode);
@ -132,7 +133,7 @@ begin
sa.sa_flags :=sa.sa_flags or SA_RESTART;
}
FPSigaction(signum,@sa,@osa);
if getErrNo<>0 then
if fpgetErrNo<>0 then
fpsignal:=NIL
else
{$ifdef BSD}
@ -142,8 +143,11 @@ begin
{$endif}
end;
{$ifdef FPC_USE_LIBC} // can't remember why this is the case. Might be legacy.
function xFpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; external name 'read';
{$else}
function xFpread(fd: cint; buf: pchar; nbytes : size_t): ssize_t; external name 'FPC_SYSC_READ';
{$endif}
Function FpRead (fd : cInt;var buf; nbytes : TSize): TSsize;
@ -187,6 +191,14 @@ Begin
FpOpenDir:=FpOpenDir(pchar(dirname));
End;
Function FpOpendir (dirname : shortString): pDir;
Begin
dirname:=dirname+#0;
FpOpenDir:=FpOpenDir(pchar(@dirname[1]));
End;
Function FpStat (path: String; var buf : stat): cInt;
begin
@ -289,7 +301,7 @@ Var
begin
if textrec(t).mode=fmclosed then
begin
SetErrNo(ESysEBADF);
fpSetErrNo(ESysEBADF);
exit(-1);
end;
FpFD_ZERO(f);
@ -319,7 +331,10 @@ end;
{
$Log$
Revision 1.7 2003-10-27 17:12:45 marco
Revision 1.8 2003-12-30 12:24:01 marco
* FPC_USE_LIBC
Revision 1.7 2003/10/27 17:12:45 marco
* fixes for signal handling.
Revision 1.6 2003/10/13 11:37:57 marco

46
rtl/unix/bunxovlh.inc
View File

@ -3,7 +3,9 @@
This file is part of the Free Pascal run time library.
Copyright (c) 2002 by Marco van de Voort
Some generic overloads for stringfunctions in the baseunix unit.
Functions that are not part of the libc<->syscall decision.
- string and file type overloads
- functions that are macro's in C.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -23,6 +25,7 @@ Function FpGetcwd (path:AnsiString; siz:TSize):AnsiString;
Function FpExecve (path : AnsiString; argv : ppchar; envp: ppchar): cInt;
Function FpExecv (path : AnsiString; argv : ppchar): cInt;
Function FpOpendir (dirname : AnsiString): pDir;
Function FpOpendir (dirname : shortString): pDir;
Function FpOpen (path : pChar; flags : cInt):cInt;
Function FpOpen (path : AnsiString; flags : cInt):cInt;
Function FpOpen (path : AnsiString; flags : cInt; Mode: TMode):cInt;
@ -52,15 +55,48 @@ Function FpDup2 (var oldfile,newfile:file):cint;
function fptime :time_t;
Function fpSelect(N:cint;readfds,writefds,exceptfds:pfdset;TimeOut:cint):cint;
Function fpSelect(var T:Text;TimeOut :PTimeval):cint;
Function fpSelect(var T:Text;TimeOut :time_t):cint;
Function fpSelect (N:cint;readfds,writefds,exceptfds:pfdset;TimeOut:cint):cint;
Function fpSelect (var T:Text;TimeOut :PTimeval):cint;
Function fpSelect (var T:Text;TimeOut :time_t):cint;
Function FpGetEnv (name : String): pChar;
// macro's
Function fpFD_SET (fdno:cint;var nset : TFDSet): cint;
Function fpFD_CLR (fdno:cint;var nset : TFDSet): cint;
Function fpFD_ZERO (var nset : TFDSet):cint;
Function fpFD_ISSET (fdno:cint;const nset : TFDSet): cint;
Function fpfdfillset(var nset : TFDSet):cint;
Function FpsigEmptySet(var nset : TSigSet): cint;
Function FpSigFillSet (var nset : TSigSet): cInt;
Function FpSigAddSet (var nset : TSigSet; signo : cInt): cInt;
Function FpSigDelSet (var nset : TSigSet; signo : cInt): cInt;
Function FpSigIsMember(Const nset : TSigSet; signo : cInt): cInt;
Function fpS_ISDIR (m : TMode): Boolean;
Function fpS_ISCHR (m : TMode): Boolean;
Function fpS_ISBLK (m : TMode): Boolean;
Function fpS_ISREG (m : TMode): Boolean;
Function fpS_ISFIFO (m : TMode): Boolean;
// The following two are very common, but not POSIX.
Function fpS_ISLNK (m:TMode) : Boolean;
Function fpS_ISSOCK (m:TMode) : Boolean;
Function wifexited (Status : cInt): cInt;
Function wexitStatus (Status : cInt): cInt;
Function wstopsig (Status : cInt): cInt;
Function wifsignaled (Status : cInt): cInt;
Function wtermsig (Status : cInt): cInt;
{
$Log$
Revision 1.3 2003-09-14 20:15:01 marco
Revision 1.4 2003-12-30 12:24:01 marco
* FPC_USE_LIBC
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/06/01 16:28:41 marco

8
rtl/unix/genfuncs.inc
View File

@ -61,7 +61,7 @@ begin
end;
end;
{$ifndef FPC_USE_LIBC}
Function fpgetenv(name:pchar):pchar;
var
@ -98,6 +98,7 @@ Begin
end;
fpgetenv:=nil;
End;
{$ENDIF}
Function fpgetenv(name:string):Pchar; [public, alias : 'FPC_SYSC_FPGETENV'];
{
@ -113,7 +114,10 @@ end;
{
$Log$
Revision 1.2 2003-09-14 20:15:01 marco
Revision 1.3 2003-12-30 12:24:01 marco
* FPC_USE_LIBC
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 2002/12/18 16:50:39 marco

11
rtl/unix/gensigset.inc
View File

@ -20,7 +20,7 @@ function fpsigaddset(var nset : tsigset;signo:cint): cint;
Begin
if (signo<=0) or (signo > SIG_MAXSIG) Then
Begin
seterrno(ESysEINVAL);
fpseterrno(ESysEINVAL);
exit(-1);
End;
nset[(signo-1) shr ln2bitsinword]:=nset[(signo-1) shr ln2bitsinword] OR (1 shl ((signo-1) and ln2bitmask));
@ -32,7 +32,7 @@ function fpsigdelset(var nset : tsigset;signo:cint): cint;
Begin
if (signo<=0) or (signo > SIG_MAXSIG) Then
Begin
seterrno(ESysEINVAL);
fpseterrno(ESysEINVAL);
exit(-1);
End;
nset[(signo-1) shr ln2bitsinword]:=nset[(signo-1) shr ln2bitsinword] AND NOT (1 shl ((signo-1) and ln2bitmask));
@ -62,7 +62,7 @@ function fpsigismember(const nset : tsigset;signo:cint): cint;
Begin
if (signo<=0) or (signo > SIG_MAXSIG) Then
Begin
seterrno(ESysEINVAL);
fpseterrno(ESysEINVAL);
exit(-1);
End;
if ((nset[(signo-1) shr ln2bitsinword]) and (1 shl ((signo-1) and ln2bitmask)))>0 Then
@ -73,7 +73,10 @@ End;
{
$Log$
Revision 1.3 2003-06-01 16:28:41 marco
Revision 1.4 2003-12-30 12:24:01 marco
* FPC_USE_LIBC
Revision 1.3 2003/06/01 16:28:41 marco
* Enhancements to make the compiler baseunix using.
Revision 1.2 2002/12/18 16:50:39 marco

12
rtl/unix/linuxnew.inc
View File

@ -35,7 +35,7 @@ Type
end;
PSysInfo = ^TSysInfo;
Function Sysinfo(var Info:TSysinfo):Boolean;
Function Sysinfo(var Info:TSysinfo):Boolean; {$ifdef FPC_USE_LIBC} cdecl; external name 'sysinfo'; {$endif}
Const
CSIGNAL = $000000ff; // signal mask to be sent at exit
@ -48,10 +48,11 @@ Const
type
TCloneFunc=function(args:pointer):longint;cdecl;
function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint; {$ifdef FPC_USE_LIBC} cdecl; external name 'clone'; {$endif}
implementation
{$ifndef FPC_USE_LIBC}
Uses Syscall;
Function Sysinfo(var Info:TSysinfo):Boolean;
@ -140,13 +141,16 @@ begin
*)
{$endif cpum68k}
end;
{$endif}
end.
{
$Log$
Revision 1.3 2003-11-17 11:28:08 marco
Revision 1.4 2003-12-30 12:24:01 marco
* FPC_USE_LIBC
Revision 1.3 2003/11/17 11:28:08 marco
* Clone moved to linux, + few small unit unix changes
Revision 1.2 2003/09/15 20:08:49 marco

57
rtl/unix/oscdeclh.inc
View File

@ -20,10 +20,19 @@
{ var
Errno : cint; external name 'errno';}
Type TGrpArr = Array [0..0] of TGid; { C style array workarounds}
pGrpArr = ^TGrpArr;
TFilDes = Array [0..1] of cInt;
pFilDes = ^TFilDes;
function FpAccess (pathname : pchar; amode : cint): cint; cdecl; external name 'access';
function FpChdir (path : pchar): cint; cdecl; external name 'chdir';
function FpClose (fd : cint): cint; cdecl; external name 'close';
function FpClosedir(var dirp : dir): cint; cdecl; external name 'closedir';
{$ifndef FPC_IS_SYSTEM}
Function FpClosedir (var dirp : Dir): cInt; cdecl; external name 'closedir';
{$else}
function FpClosedir (dirp : pdir): cint; cdecl; external name 'closedir';
{$endif}
function FpDup (oldd:cint):cint; cdecl; external name 'dup';
function FpDup2 (oldd:cint;newd:cint):cint; cdecl; external name 'dup2';
function FpExecve (path : pchar; argv : ppchar; envp: ppchar): cint; cdecl; external name 'execve';
@ -35,21 +44,57 @@
function FpOpen (path: pchar; flags : cint; mode: TMode):cint; cdecl; external name 'open';
function FpOpendir (dirname : pchar): pdir; cdecl; external name 'opendir';
function FpRead (fd: cint; buf: pchar; nbytes : TSize): TSSize; cdecl; external name 'read';
function FpReaddir (var dirp : dir) : pdirent;cdecl; external name 'readdir';
{$ifdef FPC_IS_SYSTEM}
function FpReaddir (dirp : pdir) : pdirent;cdecl; external name 'readdir';
{$ELSE}
Function FpReaddir (var dirp : Dir) : pDirent;cdecl; external name 'readdir';
{$endif}
function FpRename (old : pchar; newpath: pchar): cint; cdecl;external name 'rename';
function FpRmdir (path : pchar): cint; cdecl; external name 'rmdir';
function FpSigaction(sig: cint; act : psigactionrec; oact : psigactionrec): cint; cdecl; external name 'sigaction';
function FpStat (path: pchar; var buf : stat): cint; cdecl; external name 'stat';
function FpTime (tloc:ptime_t): time_t; cdecl; external name 'time';
{$ifdef FPC_IS_SYSTEM}
function FpSigaction (sig: cint;var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
{$else}
Function FPSigaction (sig: cInt; act :pSigActionRec;oact:pSigActionRec):cint;cdecl; external name 'sigaction';
{$endif}
{$ifdef BSD}
function FPSigProcMask(how:cint;nset : psigset;oset : psigset):cint; external name 'sigprocmask';
{$endif}
function FpStat (path: pchar; var buf : stat): cint; cdecl; external name 'stat';
{$ifdef FPC_IS_SYSTEM}
function FpTime (tloc:ptime_t): time_t; cdecl; external name 'time';
{$else}
Function FpTime (var tloc : TTime): TTime; cdecl; external name 'time';
{$endif}
function FpUname (var name: utsname): cint; cdecl; external name 'uname';
function FpUnlink (path: pchar): cint; cdecl; external name 'unlink';
function FpWaitpid (pid : TPid; stat_loc : pcint; options: cint): TPid; cdecl; external name 'waitpid';
function FpWrite (fd: cint;buf:pchar; nbytes : TSize): TSSize; cdecl; external name 'write';
procedure FpExit (status : cint); cdecl; external name '_exit';
function fpmmap (addr:pointer;len:size_t;prot:cint;flags:cint;fd:cint;ofs:off_t):pointer; cdecl; external name 'mmap';
function FpIOCtl (Handle:cint;Ndx: culong;Data: Pointer):cint; cdecl; external name 'ioctl';
Function FPSelect (N:cint;readfds,writefds,exceptfds:pfdSet;TimeOut:PTimeVal):cint; cdecl; external name 'select';
function fpgetenv (name : pchar):pchar; cdecl; external name 'getenv';
Function FpKill (pid : TPid; sig: cInt): cInt; cdecl; external name 'kill';
Function FpGetpid : TPid; cdecl;external name 'getpid';
Function FpGetppid : TPid;cdecl;external name 'getppid';
Function FpGetuid : TUid;cdecl;external name 'getuid';
Function FpGeteuid : TUid;cdecl;external name 'geteuid';
Function FpGetgid : TGid;cdecl;external name 'getgid';
Function FpGetegid : TGid;cdecl;external name 'getegid';
Function FpSetuid (uid : TUid): cInt;cdecl;external name 'setuid';
Function FpSetgid (gid : TGid): cInt;cdecl;external name 'setgid';
Function FpGetgroups (gidsetsize : cInt; var grouplist : tgrparr):cint; cdecl;external name 'getgroups';
Function FpGetpgrp : TPid; cdecl;external name 'getpgrp';
Function FpSetsid : TPid; cdecl;external name 'setsid';
Function FpPipe (var fildes : tfildes):cInt; cdecl;external name 'pipe';
{
$Log$
Revision 1.1 2003-06-01 15:23:46 marco
Revision 1.2 2003-12-30 12:24:01 marco
* FPC_USE_LIBC
Revision 1.1 2003/06/01 15:23:46 marco
* Shared for now
Revision 1.1 2002/12/18 16:43:26 marco

1
rtl/unix/syscall.pp
View File

@ -1,6 +1,7 @@
unit syscall;
interface
{$define FPC_USE_SYSCALL}
{$i sysnr.inc}
{$i syscallh.inc}

38
rtl/unix/unix.pp
View File

@ -111,14 +111,16 @@ Function W_STOPCODE (Signal: Integer): Integer;
File Handling
***************************}
{$ifndef FPC_USE_LIBC} // defined using cdecl for libc.
Function fsync (fd : cint) : cint;
Function Flock (fd,mode : cint) : cint ;
//Function StatFS (Path:Pathstr;Var Info:tstatfs):cint; -> to ovlh.inc
Function fStatFS (Fd: cint;Var Info:tstatfs):cint;
{$endif}
Function Flock (var T : text;mode : cint) : cint;
Function Flock (var F : File;mode : cint) : cint;
Function StatFS (Path:Pathstr;Var Info:tstatfs):cint;
Function fStatFS (Fd: cint;Var Info:tstatfs):cint;
Function SelectText (var T:Text;TimeOut :PTimeVal):cint;
Function SelectText (var T:Text;TimeOut :cint):cint;
@ -137,8 +139,8 @@ function TellDir(p:pdir):clong;
Function AssignPipe (var pipe_in,pipe_out:cint):cint;
Function AssignPipe (var pipe_in,pipe_out:text):cint;
Function AssignPipe (var pipe_in,pipe_out:file):cint;
Function PClose (Var F:text) : cint;
Function PClose (Var F:file) : cint;
//Function PClose (Var F:text) : cint;
//Function PClose (Var F:file) : cint;
Function POpen (var F:text;const Prog:String;rw:char):cint;
Function POpen (var F:file;const Prog:String;rw:char):cint;
function AssignStream(Var StreamIn,Streamout:text;Const Prog:String) : cint;
@ -183,25 +185,37 @@ Procedure Globfree (var p:pglob);
procedure SigRaise (sig:integer);
{$ifdef FPC_USE_LIBC}
{$i unxdeclh.inc}
{$else}
{$i unxsysch.inc} // calls used in system and not reexported from baseunix
{$endif}
{******************************************************************************
Implementation
******************************************************************************}
{$i unxovlh.inc}
Implementation
Uses Strings,Syscall;
Uses Strings{$ifndef FPC_USE_LIBC},Syscall{$endif};
{$i unxovl.inc}
{$ifndef FPC_USE_LIBC}
{$i syscallh.inc}
{$i ossysch.inc}
{$i unxsysc.inc}
{$endif}
{ Get the definitions of textrec and filerec }
{$i textrec.inc}
{$i filerec.inc}
{$ifndef FPC_USE_LIBC}
{ Raw System calls are in Syscalls.inc}
{$ifdef Linux} // Linux has more "oldlinux" compability.
{$i sysc11.inc}
@ -209,7 +223,10 @@ Uses Strings,Syscall;
{$i syscalls.inc}
{$endif}
{$i unixsysc.inc} {Syscalls only used in unit Unix/Linux}
{$endif}
{$i unixsysc.inc} {Has platform specific libc part under ifdef, besides
syscalls}
Function getenv(name:string):Pchar; external name 'FPC_SYSC_FPGETENV';
@ -1381,7 +1398,10 @@ End.
{
$Log$
Revision 1.52 2003-12-08 17:16:30 peter
Revision 1.53 2003-12-30 12:24:01 marco
* FPC_USE_LIBC
Revision 1.52 2003/12/08 17:16:30 peter
* fsearch should only find files
Revision 1.51 2003/11/19 17:11:40 marco

45
rtl/unix/unxdeclh.inc Normal file
View File

@ -0,0 +1,45 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
cdecl; definitions needed for unix unit.
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 filedesarray=array[0..1] of cint;
function fpMUnMap (P : Pointer; Size : size_t) : cint; cdecl; external name 'munmap';
Function fStatFS(Fd:Longint;Var Info:tstatfs):cint; cdecl; external name 'fstatfs';
Function Flock (fd,mode : longint) : cint; cdecl; external name 'flock';
Function fsync (fd : cint) : cint; cdecl; external name 'fsync';
Function StatFS (Path:pchar;Var Info:tstatfs):cint; cdecl; external name 'statfs';
function pipe (var fildes: filedesarray):cint; cdecl; external name 'pipe';
function fpNice(N:cint):cint; cdecl; external name 'nice';
Function fpGetPriority(Which,Who:cint):cint; cdecl; external name 'getpriority';
Function fpSetPriority(Which,Who,What:cint):cint; cdecl; external name 'setpriority';
Function fpLstat(path:pchar;Info:pstat):cint; cdecl; external name 'lstat';
Function fpSymlink(oldname,newname:pchar):cint; cdecl; external name 'symlink';
Function fpReadLink(name,linkname:pchar;maxlen:cint):cint; cdecl; external name 'readlink';
function fpgettimeofday(tp: ptimeval;tzp:ptimezone):cint; external name 'gettimeofday';
{
$Log$
Revision 1.1 2003-12-30 12:29:16 marco
* FPC_USE_LIBC
Revision 1.1 2003/06/01 15:23:46 marco
* Shared for now
Revision 1.1 2002/12/18 16:43:26 marco
* new unix rtl, linux part.....
}

42
rtl/unix/unxovl.inc Normal file
View File

@ -0,0 +1,42 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2002 by Marco van de Voort
Some generic overloads for stringfunctions in the unix unit.
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 textrec.inc}
{I filerec.inc}
Function StatFS(Path:Pathstr;Var Info:Tstatfs):cint;
{
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;
statfs:=statfs(pchar(@path[1]),info);
end;
{
$Log$
Revision 1.1 2003-12-30 12:27:44 marco
* FPC_USE_LIBC
}

34
rtl/unix/unxovlh.inc Normal file
View File

@ -0,0 +1,34 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
cdecl; definitions needed for unix unit.
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.
***********************************************************************}
Function PClose(Var F:file) : cint;
Function PClose (Var F:text) : cint;
Function StatFS(Path:Pathstr;Var Info:Tstatfs):cint;
{
$Log$
Revision 1.1 2003-12-30 12:27:44 marco
* FPC_USE_LIBC
Revision 1.1 2003/06/01 15:23:46 marco
* Shared for now
Revision 1.1 2002/12/18 16:43:26 marco
* new unix rtl, linux part.....
}