From: Juho Snellman Date: Mon, 23 Jun 2008 01:01:38 +0000 (+0000) Subject: 1.0.17.41: Implement setsid, mlockall and mlockall in sb-posix X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=4043155e2cccdd0872b6cc59570010c0e20d5e00;p=sbcl.git 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 --- 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 --- 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 --- 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 --- 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 --- 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"