Raymond Toy pushed to branch rtoy-unix-core at cmucl / cmucl Commits: a08b9be0 by Raymond Toy at 2015-05-16T22:16:15Z Remove utsname and unix-uname. - - - - - 68001f49 by Raymond Toy at 2015-05-17T07:45:18Z Add some comments from unix/unix.lisp. - - - - - a85043ac by Raymond Toy at 2015-05-17T07:45:34Z Remove items that are in code/unix.lisp - - - - - 2 changed files: - src/code/unix.lisp - src/contrib/unix/unix.lisp Changes: ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -2435,6 +2435,9 @@ :dir (string (cast (slot result 'pw-dir) c-call:c-string)) :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))) +;;; Getrusage is not provided in the C library on Solaris 2.4, and is +;;; rather slow on later versions so the "times" system call is +;;; provided. #+(and sparc svr4) (progn (def-alien-type nil @@ -2458,6 +2461,8 @@ (slot usage 'tms-cstime)))) ) ; end progn +;; Requires call to tzset() in main. +;; Don't use this now: we #+(or linux svr4) (progn (def-alien-variable ("daylight" unix-daylight) int) @@ -2512,4 +2517,3 @@ (cast (slot names 'machine) c-string)) #+freebsd 256 (addr names)))) - ===================================== src/contrib/unix/unix.lisp ===================================== --- a/src/contrib/unix/unix.lisp +++ b/src/contrib/unix/unix.lisp @@ -221,20 +221,8 @@ (def-alien-type ino64-t u-int64-t) (def-alien-type blkcnt64-t u-int64-t)) -(def-alien-type nlink-t - #-(or svr4 netbsd) unsigned-short - #+netbsd unsigned-long - #+svr4 unsigned-long) - ;;; From sys/time.h -#+(or linux svr4) -; High-res time. Actually posix definition under svr4 name. -(def-alien-type nil - (struct timestruc-t - (tv-sec time-t) - (tv-nsec long))) - ;;; From ioctl.h @@ -287,61 +275,6 @@ (st-gen unsigned-long) (st-spare (array unsigned-long 2)))) -#+(or linux svr4) -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-pad1 #-linux (array long 3) #+linux unsigned-short) - (st-ino ino-t) - (st-mode #-linux unsigned-long #+linux unsigned-short) - (st-nlink #-linux short #+linux unsigned-short) - (st-uid #-linux uid-t #+linux unsigned-short) - (st-gid #-linux gid-t #+linux unsigned-short) - (st-rdev dev-t) - (st-pad2 #-linux (array long 2) #+linux unsigned-short) - (st-size off-t) - #-linux (st-pad3 long) - #+linux (st-blksize unsigned-long) - #+linux (st-blocks unsigned-long) - #-linux (st-atime (struct timestruc-t)) - #+linux (st-atime unsigned-long) - #+linux (unused-1 unsigned-long) - #-linux (st-mtime (struct timestruc-t)) - #+linux (st-mtime unsigned-long) - #+linux (unused-2 unsigned-long) - #-linux (st-ctime (struct timestruc-t)) - #+linux (st-ctime unsigned-long) - #+linux (unused-3 unsigned-long) - #+linux (unused-4 unsigned-long) - #+linux (unused-5 unsigned-long) - #-linux(st-blksize long) - #-linux (st-blocks long) - #-linux (st-fstype (array char 16)) - #-linux (st-pad4 (array long 8)))) - -;;; 64-bit stat for Solaris -#+solaris -(def-alien-type nil - (struct stat64 - (st-dev dev-t) - (st-pad1 (array long 3)) ; Pad so ino is 64-bit aligned - (st-ino ino64-t) - (st-mode unsigned-long) - (st-nlink short) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-pad2 (array long 3)) ; Pad so size is 64-bit aligned - (st-size off64-t) - (st-atime (struct timestruc-t)) - (st-mtime (struct timestruc-t)) - (st-ctime (struct timestruc-t)) - (st-blksize long) - (st-pad3 (array long 1)) ; Pad so blocks is 64-bit aligned - (st-blocks blkcnt64-t) - (st-fstype (array char 16)) - (st-pad4 (array long 8)))) - ;;; From sys/resource.h (def-alien-type nil @@ -642,107 +575,6 @@ siocspgrp (alien:alien-sap (alien:addr alien-pgrp))))) -;;; STAT and friends. - -;;; 64-bit versions of stat and friends -#+solaris -(progn -(defun unix-stat (name) - _N"Unix-stat retrieves information about the specified - file returning them in the form of multiple values. - See the UNIX Programmer's Manual for a description - of the values returned. If the call fails, then NIL - and an error number is returned instead." - (declare (type unix-pathname name)) - (when (string= name "") - (setf name ".")) - (with-alien ((buf (struct stat64))) - (syscall ("stat64" c-string (* (struct stat64))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -(defun unix-lstat (name) - _N"Unix-lstat is similar to unix-stat except the specified - file must be a symbolic link." - (declare (type unix-pathname name)) - (with-alien ((buf (struct stat64))) - (syscall ("lstat64" c-string (* (struct stat64))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -(defun unix-fstat (fd) - _N"Unix-fstat is similar to unix-stat except the file is specified - by the file descriptor fd." - (declare (type unix-fd fd)) - (with-alien ((buf (struct stat64))) - (syscall ("fstat64" int (* (struct stat64))) - (extract-stat-results buf) - fd (addr buf)))) -) - - -;;; Getrusage is not provided in the C library on Solaris 2.4, and is -;;; rather slow on later versions so the "times" system call is -;;; provided. -#+(and sparc svr4) -(progn -(def-alien-type nil - (struct tms - (tms-utime #-alpha long #+alpha int) ; user time used - (tms-stime #-alpha long #+alpha int) ; system time used. - (tms-cutime #-alpha long #+alpha int) ; user time, children - (tms-cstime #-alpha long #+alpha int))) ; system time, children - -(declaim (inline unix-times)) -(defun unix-times () - _N"Unix-times returns information about the cpu time usage of the process - and its children." - (with-alien ((usage (struct tms))) - (alien-funcall (extern-alien "times" (function int (* (struct tms)))) - (addr usage)) - (values t - (slot usage 'tms-utime) - (slot usage 'tms-stime) - (slot usage 'tms-cutime) - (slot usage 'tms-cstime)))) -) ; end progn - -;; Requires call to tzset() in main. -;; Don't use this now: we -#+(or linux svr4) -(progn - (def-alien-variable ("daylight" unix-daylight) int) - (def-alien-variable ("timezone" unix-timezone) time-t) - (def-alien-variable ("altzone" unix-altzone) time-t) - #-irix (def-alien-variable ("tzname" unix-tzname) (array c-string 2)) - #+irix (defvar unix-tzname-addr nil) - #+irix (pushnew #'(lambda () (setq unix-tzname-addr nil)) - ext:*after-save-initializations*) - #+irix (declaim (notinline fakeout-compiler)) - #+irix (defun fakeout-compiler (name dst) - (unless unix-tzname-addr - (setf unix-tzname-addr (system:foreign-symbol-address - name - :flavor :data))) - (deref (sap-alien unix-tzname-addr (array c-string 2)) dst)) - (def-alien-routine get-timezone c-call:void - (when c-call:long :in) - (minutes-west c-call:int :out) - (daylight-savings-p alien:boolean :out)) - (defun unix-get-minutes-west (secs) - (multiple-value-bind (ignore minutes dst) (get-timezone secs) - (declare (ignore ignore) (ignore dst)) - (values minutes)) - ) - (defun unix-get-timezone (secs) - (multiple-value-bind (ignore minutes dst) (get-timezone secs) - (declare (ignore ignore) (ignore minutes)) - (values #-irix (deref unix-tzname (if dst 1 0)) - #+irix (fakeout-compiler "tzname" (if dst 1 0))) - ) ) -) - - ;;; Unix-setreuid sets the real and effective user-id's of the current ;;; process to the arguments "ruid" and "euid", respectively. Usage is ;;; restricted for anyone but the super-user. Setting either "ruid" or @@ -1181,28 +1013,6 @@ :dir (string (cast (slot result 'pw-dir) c-call:c-string)) :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) -(def-alien-type nil - (struct utsname - (sysname (array char #+svr4 257 #+bsd 256)) - (nodename (array char #+svr4 257 #+bsd 256)) - (release (array char #+svr4 257 #+bsd 256)) - (version (array char #+svr4 257 #+bsd 256)) - (machine (array char #+svr4 257 #+bsd 256)))) - -(defun unix-uname () - (with-alien ((names (struct utsname))) - (syscall* (#-(or freebsd (and x86 solaris)) "uname" - #+(and x86 solaris) "nuname" ; See /usr/include/sys/utsname.h - #+freebsd "__xuname" #+freebsd int - (* (struct utsname))) - (values (cast (slot names 'sysname) c-string) - (cast (slot names 'nodename) c-string) - (cast (slot names 'release) c-string) - (cast (slot names 'version) c-string) - (cast (slot names 'machine) c-string)) - #+freebsd 256 - (addr names)))) - #+(and solaris svr4) (export '(unix-sysinfo si-sysname si-hostname si-release si-version si-machine View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/c076d5501e7c12e8c9dcebbc3...