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

* Fixes from Tuesday.

Browse Source
This commit is contained in:
marco 2002-08-21 07:03:16 +00:00
parent 82f9961048
commit 3bc109ae66
5 changed files with 124 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
rtl/bsd/bsdfuncs.inc Normal file
View File

@ -0,0 +1,73 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
An *BSD implementation of Uname and in the future some more
calls.
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 sys_uname(var name:utsname):cint;
Var
mib : array[0..1] of cint;
rval : cint;
len : size_t;
i : longint;
oerrno : cint;
procedure Doone(pz:pchar;pzsize:cint;val1,val2:cint);
Begin
mib[0] := val1;
mib[1] := val2;
len := pzsize;
oerrno := geterrno;
if (sys_sysctl(@mib, 2, pz, @len, NIL, 0) = -1) Then
Begin
if (geterrno = sys_ENOMEM) Then
seterrno(oerrno)
else
rval := -1;
End;
pz[pzsize- 1] := #0;
End;
Begin
rval := 0;
DoOne(@name.sysname,sizeof(name.sysname),CTL_KERN,KERN_OSTYPE);
DoOne(@name.nodename,sizeof(name.nodename),CTL_KERN,KERN_HOSTNAME);
DoOne(@name.release,sizeof(name.release),CTL_KERN,KERN_OSRELEASE);
{ The version may have newlines in it, turn them into spaces. }
DoOne(@name.version,sizeof(name.version),CTL_KERN,KERN_VERSION);
For I:=0 to sizeof(name.sysname)-2 Do
If (name.version[i]=#13) or (name.version[i]=#9) Then
name.version[i]:=' ';
DoOne(@name.machine,sizeof(name.machine),CTL_HW,HW_MACHINE);
sys_Uname:=rval;
end;
{
$Log$
Revision 1.1 2002-08-21 07:03:16 marco
* Fixes from Tuesday.
Revision 1.1 2002/08/08 11:39:30 marco
* Initial versions, to allow support for uname in posix.pp
}

27
rtl/bsd/bsdsysc.inc
View File

@ -42,8 +42,8 @@
function sys_mkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
function sys_rmdir(const path : pchar): cint; cdecl; external name 'rmdir';
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_readdir(var dirp : dir) : pdirent;cdecl; external name 'readdir';
function sys_closedir(var dirp : dir): cint; cdecl; external name 'closedir';
procedure sys_exit(status : cint); cdecl; external name '_exit';
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
function sys_ftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
@ -54,12 +54,11 @@
function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; cdecl; external name 'waitpid';
function sys_access(const pathname : pchar; amode : cint): cint; cdecl; external name 'access';
// function sys_uname(var name: utsname): cint; cdecl; external name 'uname';
function sys_uname(var name: utsname): cint; cdecl; external name 'uname';
function sys_Dup(oldd:cint):cint; cdecl; external name 'dup';
function sys_Dup2(oldd:cint;newd:cint):cint; cdecl; external name 'dup2';
{$else}
{*****************************************************************************
@ -507,13 +506,31 @@ begin
Do_IsDevice:=(sys_ioctl(handle,IOCTL_TCGETS,@data)<>-1);
end;
Function sys_GetPid:LongInt; [public, alias : 'FPC_SYSC_GETPID'];
{
Get Process ID.
}
begin
sys_GetPID:=do_syscall(syscall_nr_getpid);
end;
Function Sys_ReadLink(name,linkname:pchar;maxlen:longint):longint; [public, alias : 'FPC_SYSC_READLINK'];
begin
sys_readlink:=do_syscall(syscall_nr_readlink, longint(name),longint(linkname),maxlen);
end;
{$endif}
{
$Log$
Revision 1.1 2002-08-19 12:29:11 marco
Revision 1.2 2002-08-21 07:03:16 marco
* Fixes from Tuesday.
Revision 1.1 2002/08/19 12:29:11 marco
* First working POSIX *BSD system unit.

5
rtl/bsd/bsdsysch.inc Normal file
View File

@ -0,0 +1,5 @@
Function Sys_mmap(adr,len,prot,flags,fdes,off:longint):longint; external name 'FPC_SYSC_MMAP';
Function Sys_IOCtl(Handle,Ndx: Longint;Data: Pointer):LongInt; external name 'FPC_SYSC_IOCTL';
Function sys_GetPid:LongInt; external name 'FPC_SYSC_GETPID';
Function Sys_ReadLink(name,linkname:pchar;maxlen:longint):longint; external name 'FPC_SYSC_READLINK';

23
rtl/bsd/osposix.inc
View File

@ -26,7 +26,9 @@
****************************************************************************
}
{$I bsdstruct.inc}
Uses Sysctl;
{$I bsdtypes.inc}
{$I bsdmacro.inc}
{$ifdef uselibc}
@ -48,8 +50,8 @@
function sys_mkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
function sys_rmdir(const path : pchar): cint; cdecl; external name 'rmdir';
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_readdir(var dirp : dir) : pdirent;cdecl; external name 'readdir';
function sys_closedir(var dirp : dir): cint; cdecl; external name 'closedir';
procedure sys_exit(status : cint); cdecl; external name '_exit';
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
function sys_ftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
@ -85,8 +87,8 @@ function sys_chdir(const path : pchar): cint; external name 'FPC_SYSC_CHDIR';
function sys_mkdir(const path : pchar; mode: mode_t):cint; external name 'FPC_SYSC_MKDIR';
function sys_rmdir(const path : pchar): cint; external name 'FPC_SYSC_RMDIR';
function sys_opendir(const dirname : pchar): pdir; external name 'FPC_SYSC_OPENDIR';
function sys_closedir(dirp : pdir): cint; external name 'FPC_SYSC_CLOSEDIR';
function sys_readdir(dirp : pdir) : pdirent; external name 'FPC_SYSC_READDIR';
function sys_closedir(var dirp : dir): cint; external name 'FPC_SYSC_CLOSEDIR';
function sys_readdir(var dirp : dir) : pdirent; external name 'FPC_SYSC_READDIR';
procedure sys_exit(status : cint); external name 'FPC_SYSC_EXIT';
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; external name 'FPC_SYSC_SIGACTION';
function sys_ftruncate(fd : cint; flength : off_t): cint; external name 'FPC_SYSC_FTRUNCATE';
@ -97,12 +99,21 @@ function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; ex
function sys_access(const pathname : pchar; amode : cint): cint;external name 'FPC_SYSC_ACCESS';
function sys_Dup(oldd:cint):cint; external name 'FPC_SYSC_DUP';
function sys_Dup2(oldd:cint;newd:cint):cint; external name 'FPC_SYSC_DUP2';
function geterrno:longint; external name 'FPC_SYS_GETERRNO';
procedure seterrno (i:longint); external name 'FPC_SYS_SETERRNO';
{$endif}
{$I bsdfuncs.inc}
{
$Log$
Revision 1.3 2002-08-19 12:29:11 marco
Revision 1.4 2002-08-21 07:03:16 marco
* Fixes from Tuesday.
Revision 1.3 2002/08/19 12:29:11 marco
* First working POSIX *BSD system unit.

8
rtl/bsd/osposixh.inc
View File

@ -137,9 +137,15 @@ CONST
{$i signal.inc}
// function geterrno:longint;
// procedure seterrno(i:longint);
{
$Log$
Revision 1.2 2002-08-19 12:29:11 marco
Revision 1.3 2002-08-21 07:03:16 marco
* Fixes from Tuesday.
Revision 1.2 2002/08/19 12:29:11 marco
* First working POSIX *BSD system unit.
Revision 1.1 2002/08/03 19:34:19 marco