Raymond Toy pushed to branch rtoy-grand-unix-unification at cmucl / cmucl

Commits: 91b7fea4 by Raymond Toy at 2015-10-18T00:18:17Z Add more missing things from unix-glibc2.

In particular, use the 64-bit versions of most functions.

- - - - - e0835904 by Raymond Toy at 2015-10-18T00:19:24Z Need to export some symbols for linux.

This allows us to build all of cmucl, but the utilities don't yet build completely.

- - - - - dcb8aafc by Raymond Toy at 2015-10-18T12:53:17Z More changes for linux.

o Add :glibc2 to *features*. (Need to simplify that.) o Add define-ioctl-command and constants for linux.

- - - - -

2 changed files:

- src/code/exports.lisp - src/code/unix.lisp

Changes:

===================================== src/code/exports.lisp ===================================== --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -394,6 +394,9 @@ "LTCHARS" "D-NAMLEN"

+ ;; run-program.lisp + "SGTTYB" + ;; Other symbols "BLKCNT-T" "D-INO" "D-OFF" "EADV" "EBADE" "EBADFD" "EBADMSG" "EBADR" "EBADRQC" "EBADSLT" "EBFONT" "ECHRNG" "ECOMM" "EDEADLOCK" "EDOTDOT" @@ -402,7 +405,11 @@ "ENOANO" "ENOCSI" "ENODATA" "ENOLCK" "ENOLINK" "ENOMSG" "ENONET" "ENOPKG" "ENOSR" "ENOSTR" "ENOSYS" "ENOTNAM" "ENOTUNIQ" "EOVERFLOW" "EPROTO" "EREMCHG" "EREMOTEIO" "ERESTART" "ESRMNT" "ESTALE" "ESTRPIPE" "ETIME" - "EUCLEAN" "EUNATCH" "EXFULL" "O_NOCTTY" "SIGSTKFLT" "TTY-IUCLC" + "EUCLEAN" "EUNATCH" "EXFULL" "O_NOCTTY" "SIGSTKFLT" + "SG-FLAGS" + "TIOCGETP" + "TIOCSETP" + "TTY-IUCLC" "TTY-OCRNL" "TTY-OFDEL" "TTY-OFILL" "TTY-OLCUC" "TTY-ONLRET" "TTY-ONOCR" "TTY-XCASE" "UNIX-DUP2" "UNIX-GETITIMER" "UNIX-PID" "UNIX-UNAME" "UTSNAME"

===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -17,6 +17,8 @@ (intl:textdomain "cmucl-unix")

(pushnew :unix *features*) +#+linux +(pushnew :glibc2 *features*)

;; Check the G_BROKEN_FILENAMES environment variable; if set the encoding ;; is locale-dependent...else use :utf-8 on Unicode Lisps. On 8 bit Lisps @@ -37,6 +39,8 @@

;;;; Common machine independent structures. +#+linux +(defconstant +max-u-long+ 4294967295)

(def-alien-type int64-t (signed 64))

@@ -53,6 +57,9 @@ #+alpha unsigned-int #-(or alpha netbsd) unsigned-long)

+#+linux +(def-alien-type ino64-t u-int64-t) + (def-alien-type size-t #-(or linux alpha) long #+linux unsigned-int @@ -488,6 +495,7 @@ (defconstant l_incr 1 _N"increment the file pointer") (defconstant l_xtnd 2 _N"extend the file size")

+#-linux (defun unix-lseek (fd offset whence) _N"Unix-lseek accepts a file descriptor and moves the file pointer ahead a certain offset for that file. Whence can be any of the following: @@ -501,6 +509,24 @@ (type (integer 0 2) whence)) (off-t-syscall ("lseek" (int off-t int)) fd offset whence))

+#+linux +(defun unix-lseek (fd offset whence) + _N"UNIX-LSEEK accepts a file descriptor and moves the file pointer ahead + a certain OFFSET for that file. WHENCE can be any of the following: + + l_set Set the file pointer. + l_incr Increment the file pointer. + l_xtnd Extend the file size. + " + (declare (type unix-fd fd) + (type (signed-byte 64) offset) + (type (integer 0 2) whence)) + (let ((result (alien-funcall + (extern-alien "lseek64" (function off-t int off-t int)) + fd offset whence))) + (if (minusp result) + (values nil (unix-errno)) + (values result 0)))) ;;; Unix-mkdir accepts a name and a mode and attempts to create the ;;; corresponding directory with mode mode.

@@ -606,7 +632,7 @@

(declare (type unix-pathname name) (type unix-file-mode mode)) - (int-syscall (#+solaris "creat64" #-solaris "creat" c-string int) + (int-syscall (#+(or linux solaris) "creat64" #-(or linux solaris) "creat" c-string int) (%name->file name) mode))

;;; Unix-read accepts a file descriptor, a buffer, and the length to read. @@ -1015,27 +1041,55 @@ (defconstant ,name ,(logior (ash (char-code #\t) 8) cmd))))

#+linux -(defmacro define-ioctl-command (name dev cmd arg &optional (parm-type :void)) - (declare (ignore arg parm-type)) - `(eval-when (eval load compile) - (defconstant ,name ,(logior (ash (- (char-code dev) #x20) 8) cmd)))) +(progn + (defconstant iocparm-mask #x3fff) + (defconstant ioc_void #x00000000) + (defconstant ioc_out #x40000000) + (defconstant ioc_in #x80000000) + (defconstant ioc_inout (logior ioc_in ioc_out))) + +#+linux +(defmacro define-ioctl-command (name dev cmd &optional arg parm-type) + _N"Define an ioctl command. If the optional ARG and PARM-TYPE are given + then ioctl argument size and direction are included as for ioctls defined + by _IO, _IOR, _IOW, or _IOWR. If DEV is a character then the ioctl type + is the characters code, else DEV may be an integer giving the type." + (let* ((type (if (characterp dev) + (char-code dev) + dev)) + (code (logior (ash type 8) cmd))) + (when arg + (setf code `(logior (ash (logand (alien-size ,arg :bytes) ,iocparm-mask) + 16) + ,code))) + (when parm-type + (let ((dir (ecase parm-type + (:void ioc_void) + (:in ioc_in) + (:out ioc_out) + (:inout ioc_inout)))) + (setf code `(logior ,dir ,code)))) + `(eval-when (eval load compile) + (defconstant ,name ,code))))

)

;;; TTY ioctl commands.

-(define-ioctl-command TIOCGETP #\t #-linux 8 #+linux #x81 (struct sgttyb) :out) -(define-ioctl-command TIOCSETP #\t #-linux 9 #+linux #x82 (struct sgttyb) :in) -(define-ioctl-command TIOCFLUSH #\t #-linux 16 #+linux #x89 int :in) -(define-ioctl-command TIOCSETC #\t #-linux 17 #+linux #x84 (struct tchars) :in) -(define-ioctl-command TIOCGETC #\t #-linux 18 #+linux #x83 (struct tchars) :out) -(define-ioctl-command TIOCGWINSZ #\t #-hpux 104 #+hpux 107 (struct winsize) - :out) -(define-ioctl-command TIOCSWINSZ #\t #-hpux 103 #+hpux 106 (struct winsize) - :in) - -(define-ioctl-command TIOCNOTTY #\t #-linux 113 #+linux #x22 nil :void) -#-hpux +#-linux +(progn + (define-ioctl-command TIOCGETP #\t #-linux 8 #+linux #x81 (struct sgttyb) :out) + (define-ioctl-command TIOCSETP #\t #-linux 9 #+linux #x82 (struct sgttyb) :in) + (define-ioctl-command TIOCFLUSH #\t #-linux 16 #+linux #x89 int :in) + (define-ioctl-command TIOCSETC #\t #-linux 17 #+linux #x84 (struct tchars) :in) + (define-ioctl-command TIOCGETC #\t #-linux 18 #+linux #x83 (struct tchars) :out) + (define-ioctl-command TIOCGWINSZ #\t #-hpux 104 #+hpux 107 (struct winsize) + :out) + (define-ioctl-command TIOCSWINSZ #\t #-hpux 103 #+hpux 106 (struct winsize) + :in) + + (define-ioctl-command TIOCNOTTY #\t #-linux 113 #+linux #x22 nil :void)) +#-(or hpux linux) (progn (define-ioctl-command TIOCSLTC #\t #-linux 117 #+linux #x84 (struct ltchars) :in) (define-ioctl-command TIOCGLTC #\t #-linux 116 #+linux #x85 (struct ltchars) :out) @@ -1048,9 +1102,19 @@ (define-ioctl-command TIOCSPGRP #\T 29 int :in) (define-ioctl-command TIOCGPGRP #\T 30 int :out) (define-ioctl-command TIOCSIGSEND #\t 93 nil)) +#+linux +(progn + (define-ioctl-command TIOCGWINSZ #\T #x13) + (define-ioctl-command TIOCSWINSZ #\T #x14) + (define-ioctl-command TIOCNOTTY #\T #x22) + (define-ioctl-command TIOCSPGRP #\T #x10) + (define-ioctl-command TIOCGPGRP #\T #x0F))

;;; File ioctl commands. +#-linux (define-ioctl-command FIONREAD #\f #-linux 127 #+linux #x1B int :out) +#+linux +(define-ioctl-command FIONREAD #\T #x1B)

(defun unix-ioctl (fd cmd arg) @@ -1463,7 +1527,8 @@ (when (string= name "") (setf name ".")) (with-alien ((buf (struct stat))) - (syscall (#-netbsd "stat" #+netbsd "__stat50" c-string (* (struct stat))) + (syscall (#+linux "stat64" #+netbsd "__stat50" #-(or linux netbsd) "stat" + c-string (* (struct stat))) (extract-stat-results buf) (%name->file name) (addr buf))))

@@ -1472,7 +1537,8 @@ file must be a symbolic link." (declare (type unix-pathname name)) (with-alien ((buf (struct stat))) - (syscall (#-netbsd "lstat" #+netbsd "__lstat50" c-string (* (struct stat))) + (syscall (#+linux "lstat64" #+netbsd "__lstat50" #-(or linux netbsd) "lstat" + c-string (* (struct stat))) (extract-stat-results buf) (%name->file name) (addr buf))))

@@ -1481,7 +1547,8 @@ by the file descriptor fd." (declare (type unix-fd fd)) (with-alien ((buf (struct stat))) - (syscall (#-netbsd "fstat" #+netbsd "__fstat50" int (* (struct stat))) + (syscall (#+linux "fstat64" #+netbsd "__fstat50" #-(or linux netbsd) "fstat" + int (* (struct stat))) (extract-stat-results buf) fd (addr buf)))) ) @@ -2630,6 +2697,37 @@ :dir (string (cast (slot result 'pw-dir) c-call:c-string)) :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))

+#+linux +(defun unix-getpwuid (uid) + _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found." + (declare (type unix-uid uid)) + (with-alien ((buf (array c-call:char 1024)) + (user-info (struct passwd)) + (result (* (struct passwd)))) + (let ((returned + (alien-funcall + (extern-alien "getpwuid_r" + (function c-call:int + c-call:unsigned-int + (* (struct passwd)) + (* c-call:char) + c-call:unsigned-int + (* (* (struct passwd))))) + uid + (addr user-info) + (cast buf (* c-call:char)) + 1024 + (addr result)))) + (when (zerop returned) + (make-user-info + :name (string (cast (slot result 'pw-name) c-call:c-string)) + :password (string (cast (slot result 'pw-passwd) c-call:c-string)) + :uid (slot result 'pw-uid) + :gid (slot result 'pw-gid) + :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) + :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.

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/ce8ced742daeaed09a4ffd45c...