<html lang='en'>
<head>
<meta content='text/html; charset=utf-8' http-equiv='Content-Type'>
<title>
GitLab
</title>
</meta>
</head>
<style>
  img {
    max-width: 100%;
    height: auto;
  }
  p.details {
    font-style:italic;
    color:#777
  }
  .footer p {
    font-size:small;
    color:#777
  }
  pre.commit-message {
    white-space: pre-wrap;
  }
  .file-stats a {
    text-decoration: none;
  }
  .file-stats .new-file {
    color: #090;
  }
  .file-stats .deleted-file {
    color: #B00;
  }
</style>
<body>
<div class='content'>
<h3>Raymond Toy pushed to branch rtoy-grand-unix-unification at <a href="https://gitlab.common-lisp.net/cmucl/cmucl">cmucl / cmucl</a></h3>
<h4>
Commits:
</h4>
<ul>
<li>
<strong><a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/91b7fea462eaa6e4ce8884c47e0ebfb8bce890c9">91b7fea4</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2015-10-18T00:18:17Z</i>
</div>
<pre class='commit-message'>Add more missing things from unix-glibc2.

In particular, use the 64-bit versions of most functions.</pre>
</li>
<li>
<strong><a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/e0835904af35149ff4cfe8e72db57f3c245c31e2">e0835904</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2015-10-18T00:19:24Z</i>
</div>
<pre class='commit-message'>Need to export some symbols for linux.

This allows us to build all of cmucl, but the utilities don't yet
build completely.</pre>
</li>
<li>
<strong><a href="https://gitlab.common-lisp.net/cmucl/cmucl/commit/dcb8aafc94cc6b92e6f58fe84b65ca7107cdc5cc">dcb8aafc</a></strong>
<div>
<span>by Raymond Toy</span>
<i>at 2015-10-18T12:53:17Z</i>
</div>
<pre class='commit-message'>More changes for linux.

o Add :glibc2 to *features*.  (Need to simplify that.)
o Add define-ioctl-command and constants for linux.</pre>
</li>
</ul>
<h4>2 changed files:</h4>
<ul>
<li class='file-stats'>
<a href='#diff-0'>
src/code/exports.lisp
</a>
</li>
<li class='file-stats'>
<a href='#diff-1'>
src/code/unix.lisp
</a>
</li>
</ul>
<h4>Changes:</h4>
<li id='diff-0'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/compare/ce8ced742daeaed09a4ffd45c813908b514860bd...dcb8aafc94cc6b92e6f58fe84b65ca7107cdc5cc#diff-0'>
<strong>
src/code/exports.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/src/code/exports.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/src/code/exports.lisp
</span><span style="color: #aaaaaa">@@ -394,6 +394,9 @@
</span>      "LTCHARS"
           "D-NAMLEN"
 
<span style="color: #000000;background-color: #ddffdd">+           ;; run-program.lisp
+          "SGTTYB"
+
</span>      ;; Other symbols
           "BLKCNT-T" "D-INO" "D-OFF" "EADV" "EBADE" "EBADFD" "EBADMSG" "EBADR"
           "EBADRQC" "EBADSLT" "EBFONT" "ECHRNG" "ECOMM" "EDEADLOCK" "EDOTDOT"
<span style="color: #aaaaaa">@@ -402,7 +405,11 @@
</span>      "ENOANO" "ENOCSI" "ENODATA" "ENOLCK" "ENOLINK" "ENOMSG" "ENONET" "ENOPKG"
           "ENOSR" "ENOSTR" "ENOSYS" "ENOTNAM" "ENOTUNIQ" "EOVERFLOW" "EPROTO"
           "EREMCHG" "EREMOTEIO" "ERESTART" "ESRMNT" "ESTALE" "ESTRPIPE" "ETIME"
<span style="color: #000000;background-color: #ffdddd">-           "EUCLEAN" "EUNATCH" "EXFULL" "O_NOCTTY" "SIGSTKFLT" "TTY-IUCLC"
</span><span style="color: #000000;background-color: #ddffdd">+      "EUCLEAN" "EUNATCH" "EXFULL" "O_NOCTTY" "SIGSTKFLT"
+          "SG-FLAGS"
+          "TIOCGETP"
+          "TIOCSETP"
+          "TTY-IUCLC"
</span>      "TTY-OCRNL" "TTY-OFDEL" "TTY-OFILL" "TTY-OLCUC" "TTY-ONLRET" "TTY-ONOCR"
           "TTY-XCASE" "UNIX-DUP2" "UNIX-GETITIMER" "UNIX-PID" "UNIX-UNAME"
           "UTSNAME"
</code></pre>

<br>
</li>
<li id='diff-1'>
<a href='https://gitlab.common-lisp.net/cmucl/cmucl/compare/ce8ced742daeaed09a4ffd45c813908b514860bd...dcb8aafc94cc6b92e6f58fe84b65ca7107cdc5cc#diff-1'>
<strong>
src/code/unix.lisp
</strong>
</a>
<hr>
<pre class="highlight"><code><span style="color: #000000;background-color: #ffdddd">--- a/src/code/unix.lisp
</span><span style="color: #000000;background-color: #ddffdd">+++ b/src/code/unix.lisp
</span><span style="color: #aaaaaa">@@ -17,6 +17,8 @@
</span> (intl:textdomain "cmucl-unix")
 
 (pushnew :unix *features*)
<span style="color: #000000;background-color: #ddffdd">+#+linux
+(pushnew :glibc2 *features*)
</span> 
 ;; 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
<span style="color: #aaaaaa">@@ -37,6 +39,8 @@
</span> 
 
 ;;;; Common machine independent structures.
<span style="color: #000000;background-color: #ddffdd">+#+linux
+(defconstant +max-u-long+ 4294967295)
</span> 
 (def-alien-type int64-t (signed 64))
 
<span style="color: #aaaaaa">@@ -53,6 +57,9 @@
</span>     #+alpha unsigned-int
     #-(or alpha netbsd) unsigned-long)
 
<span style="color: #000000;background-color: #ddffdd">+#+linux
+(def-alien-type ino64-t u-int64-t)
+
</span> (def-alien-type size-t
     #-(or linux alpha) long
     #+linux unsigned-int 
<span style="color: #aaaaaa">@@ -488,6 +495,7 @@
</span> (defconstant l_incr 1 _N"increment the file pointer")
 (defconstant l_xtnd 2 _N"extend the file size")
 
<span style="color: #000000;background-color: #ddffdd">+#-linux
</span> (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:
<span style="color: #aaaaaa">@@ -501,6 +509,24 @@
</span>      (type (integer 0 2) whence))
   (off-t-syscall ("lseek" (int off-t int)) fd offset whence))
 
<span style="color: #000000;background-color: #ddffdd">+#+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))))
</span> ;;; Unix-mkdir accepts a name and a mode and attempts to create the
 ;;; corresponding directory with mode mode.
 
<span style="color: #aaaaaa">@@ -606,7 +632,7 @@
</span>   
   (declare (type unix-pathname name)
           (type unix-file-mode mode))
<span style="color: #000000;background-color: #ffdddd">-  (int-syscall (#+solaris "creat64" #-solaris "creat" c-string int)
</span><span style="color: #000000;background-color: #ddffdd">+  (int-syscall (#+(or linux solaris) "creat64" #-(or linux solaris) "creat" c-string int)
</span>          (%name->file name) mode))
 
 ;;; Unix-read accepts a file descriptor, a buffer, and the length to read.
<span style="color: #aaaaaa">@@ -1015,27 +1041,55 @@
</span>      (defconstant ,name ,(logior (ash (char-code #\t) 8) cmd))))
 
 #+linux
<span style="color: #000000;background-color: #ffdddd">-(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))))
</span><span style="color: #000000;background-color: #ddffdd">+(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))))
</span> 
 )
 
 ;;; TTY ioctl commands.
 
<span style="color: #000000;background-color: #ffdddd">-(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
</span><span style="color: #000000;background-color: #ddffdd">+#-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)
</span> (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)
<span style="color: #aaaaaa">@@ -1048,9 +1102,19 @@
</span>   (define-ioctl-command TIOCSPGRP #\T 29 int :in)
   (define-ioctl-command TIOCGPGRP #\T 30 int :out)
   (define-ioctl-command TIOCSIGSEND #\t 93 nil))
<span style="color: #000000;background-color: #ddffdd">+#+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))
</span> 
 ;;; File ioctl commands.
<span style="color: #000000;background-color: #ddffdd">+#-linux
</span> (define-ioctl-command FIONREAD #\f #-linux 127 #+linux #x1B int :out)
<span style="color: #000000;background-color: #ddffdd">+#+linux
+(define-ioctl-command FIONREAD #\T #x1B)
</span> 
 
 (defun unix-ioctl (fd cmd arg)
<span style="color: #aaaaaa">@@ -1463,7 +1527,8 @@
</span>   (when (string= name "")
     (setf name "."))
   (with-alien ((buf (struct stat)))
<span style="color: #000000;background-color: #ffdddd">-    (syscall (#-netbsd "stat" #+netbsd "__stat50" c-string (* (struct stat)))
</span><span style="color: #000000;background-color: #ddffdd">+    (syscall (#+linux "stat64" #+netbsd "__stat50" #-(or linux netbsd) "stat"
+             c-string (* (struct stat)))
</span>        (extract-stat-results buf)
             (%name->file name) (addr buf))))
 
<span style="color: #aaaaaa">@@ -1472,7 +1537,8 @@
</span>    file must be a symbolic link."
   (declare (type unix-pathname name))
   (with-alien ((buf (struct stat)))
<span style="color: #000000;background-color: #ffdddd">-    (syscall (#-netbsd "lstat" #+netbsd "__lstat50" c-string (* (struct stat)))
</span><span style="color: #000000;background-color: #ddffdd">+    (syscall (#+linux "lstat64" #+netbsd "__lstat50" #-(or linux netbsd) "lstat"
+              c-string (* (struct stat)))
</span>        (extract-stat-results buf)
             (%name->file name) (addr buf))))
 
<span style="color: #aaaaaa">@@ -1481,7 +1547,8 @@
</span>    by the file descriptor fd."
   (declare (type unix-fd fd))
   (with-alien ((buf (struct stat)))
<span style="color: #000000;background-color: #ffdddd">-    (syscall (#-netbsd "fstat" #+netbsd "__fstat50" int (* (struct stat)))
</span><span style="color: #000000;background-color: #ddffdd">+    (syscall (#+linux "fstat64" #+netbsd "__fstat50" #-(or linux netbsd) "fstat" 
+              int (* (struct stat)))
</span>        (extract-stat-results buf)
             fd (addr buf))))
 )
<span style="color: #aaaaaa">@@ -2630,6 +2697,37 @@
</span>        :dir (string (cast (slot result 'pw-dir) c-call:c-string))
        :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))
 
<span style="color: #000000;background-color: #ddffdd">+#+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)))))))
+
</span> ;;; 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.
</code></pre>

<br>
</li>

</div>
<div class='footer' style='margin-top: 10px;'>
<p>

<br>
<a href="https://gitlab.common-lisp.net/cmucl/cmucl/compare/ce8ced742daeaed09a4ffd45c813908b514860bd...dcb8aafc94cc6b92e6f58fe84b65ca7107cdc5cc">View it on GitLab</a>
<script type="application/ld+json">{"@context":"http://schema.org","@type":"EmailMessage","action":{"@type":"ViewAction","name":["merge_requests","issues","commit"],"url":"https://gitlab.common-lisp.net/cmucl/cmucl/compare/ce8ced742daeaed09a4ffd45c813908b514860bd...dcb8aafc94cc6b92e6f58fe84b65ca7107cdc5cc"}}</script>
</p>
</div>
</body>
</html>