Răsfoiți Sursa

* Fixes from Tuesday.

marco 23 ani în urmă
părinte
comite
3bc109ae66
5 a modificat fișierele cu 124 adăugiri și 12 ștergeri
  1. 73 0
      rtl/bsd/bsdfuncs.inc
  2. 22 5
      rtl/bsd/bsdsysc.inc
  3. 5 0
      rtl/bsd/bsdsysch.inc
  4. 17 6
      rtl/bsd/osposix.inc
  5. 7 1
      rtl/bsd/osposixh.inc

+ 73 - 0
rtl/bsd/bsdfuncs.inc

@@ -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
+
+
+
+}
+
+
+

+ 22 - 5
rtl/bsd/bsdsysc.inc

@@ -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 - 0
rtl/bsd/bsdsysch.inc

@@ -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';

+ 17 - 6
rtl/bsd/osposix.inc

@@ -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.
 
 

+ 7 - 1
rtl/bsd/osposixh.inc

@@ -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