From fe8f398cd5effe5a17d3e8c2a82f26491fbd2df9 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Sun, 16 Nov 2014 14:49:08 -0800
Subject: [PATCH] Add more unix stuff.

 * asdf wants unix-rmdir
 * Add some missing structs.
---
 src/code/exports.lisp |  11 +++-
 src/code/unix.lisp    | 140 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 148 insertions(+), 3 deletions(-)

diff --git a/src/code/exports.lisp b/src/code/exports.lisp
index 71f6389f9..e5221ee43 100644
--- a/src/code/exports.lisp
+++ b/src/code/exports.lisp
@@ -224,6 +224,7 @@
 	   "UNIX-GETTIMEOFDAY"
 	   "UNIX-ISATTY"
 	   "UNIX-MKDIR"
+	   "UNIX-RMDIR"
 	   "UNIX-UNLINK"
 	   "UNIX-SETITIMER"
 	   "TIMEZONE"
@@ -269,15 +270,19 @@
 	   "SGTTYB"
 	   "TCHARS"
 	   "UNIX-TTYNAME"
+	   "WINSIZE"
+	   "LTCHARS"
+	   "TIMEVAL"
+	   "CLOSE-DIR"
+	   "OPEN-DIR"
+	   "READ-DIR"
+	   "D-NAMLEN"
 	   ;; Simple streams
 	   "PROT_READ"
 	   "UNIX-MMAP"
 	   "UNIX-MUNMAP"
 	   "UNIX-MSYNC"
 
-	   "CLOSE-DIR"
-	   "OPEN-DIR"
-	   "READ-DIR"
 	   ))
   
 (defpackage "FORMAT")
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 15f0b1e07..1d5965ff7 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -108,6 +108,11 @@
     `(multiple-value-bind (,word ,bit) (floor ,offset 32)
        (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word)))))
 
+(def-alien-type nlink-t
+    #-(or svr4 netbsd) unsigned-short
+    #+netbsd unsigned-long
+    #+svr4 unsigned-long)
+
 (defconstant fd-setsize
   #-(or hpux alpha linux FreeBSD) 256
   #+hpux 2048 #+alpha 4096 #+(or linux FreeBSD) 1024)
@@ -117,6 +122,17 @@
   (struct fd-set
     (fds-bits (array #-alpha unsigned-long #+alpha int #.(/ fd-setsize 32)))))
 
+(def-alien-type nil
+  (struct timeval
+    (tv-sec #-linux time-t #+linux int)		; seconds
+    (tv-usec int)))				; and microseconds
+
+#+(or linux BSD)
+(def-alien-type nil
+  (struct timespec-t
+    (ts-sec time-t)
+    (ts-nsec long)))
+
 ;;; From ioctl.h
 (def-alien-type nil
   (struct tchars
@@ -128,6 +144,17 @@
     #-linux (t-eofc char)			; end-of-file
     (t-brkc char)))			; input delimiter (like nl)
 
+;; not found (semi) linux
+(def-alien-type nil
+  (struct ltchars
+    #+linux (t-werasc char)			; word erase 	  
+    (t-suspc char)			; stop process signal
+    (t-dsuspc char)			; delayed stop process signal
+    (t-rprntc char)			; reprint line
+    (t-flushc char)			; flush output (toggles)
+    #-linux (t-werasc char)			; word erase
+    (t-lnextc char)))			; literal next character
+
 (def-alien-type nil
   (struct sgttyb
     #+linux (sg-flags #+mach short #-mach int) ; mode flags 	  
@@ -140,6 +167,13 @@
     #+linux (t (struct termios))
     #+linux (check int)))
 
+(def-alien-type nil
+  (struct winsize
+    (ws-row unsigned-short)		; rows, in characters
+    (ws-col unsigned-short)		; columns, in characters
+    (ws-xpixel unsigned-short)		; horizontal size, pixels
+    (ws-ypixel unsigned-short)))	; veritical size, pixels
+
 
 ;;;; System calls.
 
@@ -672,6 +706,14 @@
   (void-syscall ("rename" c-string c-string)
 		(%name->file name1) (%name->file name2)))
 
+;;; Unix-rmdir accepts a name and removes the associated directory.
+
+(defun unix-rmdir (name)
+  _N"Unix-rmdir attempts to remove the directory name.  NIL and
+   an error number is returned if an error occured."
+  (declare (type unix-pathname name))
+  (void-syscall ("rmdir" c-string) (%name->file name)))
+
 ;;; Unix-write accepts a file descriptor, a buffer, an offset, and the
 ;;; length to write.  It attempts to write len bytes to the device
 ;;; associated with fd from the buffer starting at offset.  It returns
@@ -929,6 +971,48 @@
   (declare (type (signed-byte 32) code))
   (void-syscall ("exit" int) code))
 
+;;; From sys/dir.h
+;;;
+;;; (For Solaris, this is not struct direct, but struct dirent!)
+#-bsd
+(def-alien-type nil
+  (struct direct
+    #+(and sunos (not svr4)) (d-off long) ; offset of next disk directory entry
+    (d-ino ino-t); inode number of entry
+    #+(or linux svr4) (d-off long)
+    (d-reclen unsigned-short)		; length of this record
+    #-(or linux svr4)
+    (d-namlen unsigned-short)		; length of string in d-name
+    (d-name (array char 256))))		; name must be no longer than this
+
+#+(and bsd (not netbsd))
+(def-alien-type nil
+  (struct direct
+    (d-fileno unsigned-long)
+    (d-reclen unsigned-short)
+    (d-type unsigned-char)
+    (d-namlen unsigned-char)		; length of string in d-name
+    (d-name (array char 256))))		; name must be no longer than this
+
+#+netbsd
+(def-alien-type nil
+  (struct direct
+    (d-fileno ino-t)
+    (d-reclen unsigned-short)
+    (d-namlen unsigned-short)
+    (d-type unsigned-char)
+    (d-name (array char 512))))
+
+;;; The 64-bit version of struct dirent.
+#+solaris
+(def-alien-type nil
+  (struct dirent64
+    (d-ino ino64-t); inode number of entry
+    (d-off off64-t) ; offset of next disk directory entry
+    (d-reclen unsigned-short)		; length of this record
+    (d-name (array char 256))))		; name must be no longer than this
+
+
 #+(and bsd (not netbsd))
 (def-alien-type nil
   (struct stat
@@ -950,6 +1034,29 @@
     (st-lspare  long)
     (st-qspare (array long 4))))
 
+(defmacro extract-stat-results (buf)
+  `(values T
+	   (slot ,buf 'st-dev)
+	   (slot ,buf 'st-ino)
+	   (slot ,buf 'st-mode)
+	   (slot ,buf 'st-nlink)
+	   (slot ,buf 'st-uid)
+	   (slot ,buf 'st-gid)
+	   (slot ,buf 'st-rdev)
+	   (slot ,buf 'st-size)
+	   #-(or svr4 BSD) (slot ,buf 'st-atime)
+	   #+svr4    (slot (slot ,buf 'st-atime) 'tv-sec)
+           #+BSD (slot (slot ,buf 'st-atime) 'ts-sec)
+	   #-(or svr4 BSD)(slot ,buf 'st-mtime)
+	   #+svr4   (slot (slot ,buf 'st-mtime) 'tv-sec)
+           #+BSD(slot (slot ,buf 'st-mtime) 'ts-sec)
+	   #-(or svr4 BSD) (slot ,buf 'st-ctime)
+	   #+svr4   (slot (slot ,buf 'st-ctime) 'tv-sec)
+           #+BSD(slot (slot ,buf 'st-ctime) 'ts-sec)
+	   #+netbsd (slot (slot ,buf 'st-birthtime) 'ts-sec)
+	   (slot ,buf 'st-blksize)
+	   (slot ,buf 'st-blocks)))
+
 (defun unix-stat (name)
   _N"Unix-stat retrieves information about the specified
    file returning them in the form of multiple values.
@@ -1899,6 +2006,35 @@
   (dir "" :type string)
   (shell "" :type string))
 
+;; see <pwd.h>
+#+solaris
+(def-alien-type nil
+    (struct passwd
+	    (pw-name (* char))          ; user's login name
+	    (pw-passwd (* char))        ; no longer used
+	    (pw-uid uid-t)              ; user id
+	    (pw-gid gid-t)              ; group id
+	    (pw-age (* char))           ; password age (not used)
+	    (pw-comment (* char))       ; not used
+	    (pw-gecos (* char))         ; typically user's full name
+	    (pw-dir (* char))           ; user's home directory
+	    (pw-shell (* char))))       ; user's login shell
+
+#+bsd
+(def-alien-type nil
+    (struct passwd
+	    (pw-name (* char))          ; user's login name
+	    (pw-passwd (* char))        ; no longer used
+	    (pw-uid uid-t)              ; user id
+	    (pw-gid gid-t)              ; group id
+            (pw-change int)             ; password change time
+            (pw-class (* char))         ; user access class
+	    (pw-gecos (* char))         ; typically user's full name
+	    (pw-dir (* char))           ; user's home directory
+	    (pw-shell (* char))         ; user's login shell
+            (pw-expire int)             ; account expiration
+            #+(or freebsd darwin)
+	    (pw-fields int)))           ; internal
 
 ;;;; Other random routines.
 (def-alien-routine ("isatty" unix-isatty) boolean
@@ -1921,6 +2057,10 @@
     (it-interval (struct timeval))	; timer interval
     (it-value (struct timeval))))	; current value
 
+(defconstant ITIMER-REAL 0)
+(defconstant ITIMER-VIRTUAL 1)
+(defconstant ITIMER-PROF 2)
+
 (defun unix-setitimer (which int-secs int-usec val-secs val-usec)
   _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of
    three system timers (:real :virtual or :profile). A SIGALRM signal
-- 
GitLab