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