1.0.17.41: Implement setsid, mlockall and mlockall in sb-posix

        * Also refactor some code
        * Patch by Travis Cross

diff --git a/NEWS b/NEWS
index 48a7754..7c8d8f5 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -31,6 +31,8 @@ changes in sbcl-1.0.18 relative to 1.0.17:
     (reported by Yoshinori Tahara)
   * bug fix: more accurate disassembly annotations of foreign function
     calls.  (thanks to Andy Hefner)
+  * new feature: SB-POSIX bindings for mlockall, munlockall, and setsid.
+    (thanks to Travis Cross)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** NIL is a valid function name (regression at 1.0.13.38)
     ** FILL on lists was missing its return value (regression at 1.0.12.27)

diff --git a/contrib/sb-posix/TODO b/contrib/sb-posix/TODO
index c6249c1..6764657 100644 (file)
--- a/contrib/sb-posix/TODO
+++ b/contrib/sb-posix/TODO
@@ -8,22 +8,22 @@ in this list does _not_ imply we've definitely decided something needs
 adding.
 
 FD_CLR FD_ISSET FD_SET FD_ZERO accept acct adjtime adjtimex bdflush
-bind break brk cacheflush capget capset chroot clone connect
+bind break brk cacheflush capget capset clone connect
 create_module delete_module execve exit flock
 fstatfs ftime getcontext getdents getdomainname
 getdtablesize getgroups gethostid gethostname getitimer 
 getpeername getpriority getrlimit getrusage getsockname getsockopt
 gettimeofday gtty idle init_module ioctl_list ioperm iopl listen
-llseek lock madvise mincore mknod mlock mlockall 
+llseek lock madvise mincore mknod mlock
 modify_ldt mount mprotect mpx mremap msgctl msgget msgop msgrcv msgsnd
-munlock munlockall nanosleep nice pause poll
+munlock nanosleep nice pause poll
 prctl pread prof profil pselect ptrace pwrite query_module quotactl
-read readlink readv reboot recv recvfrom recvmsg
+read readv reboot recv recvfrom recvmsg
 sbrk sched_get_priority_max sched_get_priority_min sched_getparam
 sched_getscheduler sched_rr_get_interval sched_setparam
 sched_setscheduler sched_yield select semctl semget semop send
 sendfile sendmsg sendto setcontext setdomainname setgroups sethostid
-sethostname setitimer setpgrp setpriority setrlimit setsid setsockopt
+sethostname setitimer setpriority setrlimit setsockopt
 settimeofday sgetmask shmat shmctl shmdt shmget shmop shutdown
 sigaction sigaltstack sigblock siggetmask sigmask signal sigpause
 sigpending sigprocmask sigreturn sigsetmask sigsuspend sigvec socket

diff --git a/contrib/sb-posix/constants.lisp b/contrib/sb-posix/constants.lisp
index 7c52c67..0e2e283 100644 (file)
--- a/contrib/sb-posix/constants.lisp
+++ b/contrib/sb-posix/constants.lisp
@@ -262,6 +262,10 @@
  (:integer ms-invalidate "MS_INVALIDATE"
            #+sb-doc "msync: invalidate all cached data" t)
 
+ ;; mlockall()
+ (:integer mcl-current "MCL_CURRENT" #+sb-doc "mlockall: lock all pages which are currently mapped into the address space of the process." t)
+ (:integer mcl-future "MCL_FUTURE" #+sb-doc "mlockall: lock all pages which will become mapped into the address space of the process in the future." t)
+
  ;; opendir()
  (:structure dirent
              (#+(and linux largefile) "struct dirent64"

diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index 110a4ea..c111e76 100644 (file)
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -296,7 +296,8 @@
   (define-call "killpg" int minusp (pgrp int) (signal int))
   (define-call "pause" int minusp)
   (define-call "setpgid" int minusp (pid pid-t) (pgid pid-t))
-  (define-call "setpgrp" int minusp))
+  (define-call "setpgrp" int minusp)
+  (define-call "setsid" pid-t minusp))
 
 (defmacro with-growing-c-string ((buffer size) &body body)
   (sb-int:with-unique-names (c-string-block)
@@ -408,6 +409,10 @@
 (define-call "msync" int minusp
   (addr sb-sys:system-area-pointer) (length unsigned) (flags int)))
 
+;;; mlockall, munlockall
+(define-call "mlockall" int minusp (flags int))
+(define-call "munlockall" int minusp)
+
 #-win32
 (define-call "getpagesize" int minusp)
 #+win32
@@ -438,22 +443,6 @@
   (:documentation "Instances of this class represent entries in
                    the system's user database."))
 
-(defmacro define-pw-call (name arg type)
-  #-win32
-  ;; FIXME: this isn't the documented way of doing this, surely?
-  (let ((lisp-name (intern (string-upcase name) :sb-posix)))
-    `(progn
-      (export ',lisp-name :sb-posix)
-      (declaim (inline ,lisp-name))
-      (defun ,lisp-name (,arg)
-        (let ((r (alien-funcall (extern-alien ,name ,type) ,arg)))
-          (if (null-alien r)
-              nil
-              (alien-to-passwd r)))))))
-
-(define-pw-call "getpwnam" login-name (function (* alien-passwd) c-string))
-(define-pw-call "getpwuid" uid (function (* alien-passwd) uid-t))
-
 ;;; group database
 #-win32
 (define-protocol-class group alien-group ()
@@ -461,7 +450,7 @@
    (passwd :initarg :passwd :accessor group-passwd)
    (gid :initarg :gid :accessor group-gid)))
 
-(defmacro define-gr-call (name arg type)
+(defmacro define-obj-call (name arg type conv)
   #-win32
   ;; FIXME: this isn't the documented way of doing this, surely?
   (let ((lisp-name (intern (string-upcase name) :sb-posix)))
@@ -472,10 +461,12 @@
         (let ((r (alien-funcall (extern-alien ,name ,type) ,arg)))
           (if (null-alien r)
               nil
-              (alien-to-group r)))))))
+              (,conv r)))))))
 
-(define-gr-call "getgrnam" login-name (function (* alien-group) c-string))
-(define-gr-call "getgrgid" gid (function (* alien-group) gid-t))
+(define-obj-call "getpwnam" login-name (function (* alien-passwd) c-string) alien-to-passwd)
+(define-obj-call "getpwuid" uid (function (* alien-passwd) uid-t) alien-to-passwd)
+(define-obj-call "getgrnam" login-name (function (* alien-group) c-string) alien-to-group)
+(define-obj-call "getgrgid" gid (function (* alien-group) gid-t) alien-to-group)
 
 
 #-win32

diff --git a/version.lisp-expr b/version.lisp-expr
index ace191b..d47865f 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.17.40"
+"1.0.17.41"