1.0.28.38: undefined warning and compilation unit summary tweaking
[sbcl.git] / contrib / sb-posix / interface.lisp
index 155d84d..1da9d8f 100644 (file)
 (defun syscall-error ()
   (error 'sb-posix:syscall-error :errno (get-errno)))
 
+(defun unsupported-error (lisp-name c-name)
+  (error "~S is unsupported by SBCL on this platform due to lack of ~A()."
+         lisp-name c-name))
+
+(defun unsupported-warning (lisp-name c-name)
+  (warn "~S is unsupported by SBCL on this platform due to lack of ~A()."
+        lisp-name c-name))
+
 (declaim (inline never-fails))
 (defun never-fails (&rest args)
   (declare (ignore args))
   (define-call "sync" void never-fails)
   (define-call ("truncate" :options :largefile)
       int minusp (pathname filename) (length off-t))
-  ;; FIXME: Windows does have _mktemp, which has a slightlty different
-  ;; interface
-  (defun mkstemp (template)
-    ;; we are emulating sb-alien's charset conversion for strings
-    ;; here, to accommodate for the call-by-reference nature of
-    ;; mkstemp's template strings.
-    (let ((arg (sb-ext:string-to-octets
-                (filename template)
-                :external-format sb-alien::*default-c-string-external-format*)))
-      (sb-sys:with-pinned-objects (arg)
-        (let ((result (alien-funcall (extern-alien "mkstemp"
-                                                   (function int c-string))
-                                     (sap-alien (sb-alien::vector-sap arg)
-                                                (* char)))))
-          (when (minusp result)
-            (syscall-error))
-          (values result
-                  (sb-ext:octets-to-string
-                   arg
-                   :external-format sb-alien::*default-c-string-external-format*))))))
+  #-win32
+  (macrolet ((def-mk*temp (lisp-name c-name result-type errorp dirp values)
+               (declare (ignore dirp))
+               (if (sb-sys:find-foreign-symbol-address c-name)
+                   `(progn
+                      (defun ,lisp-name (template)
+                        (let* ((external-format sb-alien::*default-c-string-external-format*)
+                               (arg (sb-ext:string-to-octets
+                                     (filename template)
+                                     :external-format external-format
+                                     :null-terminate t)))
+                          (sb-sys:with-pinned-objects (arg)
+                            ;; accommodate for the call-by-reference
+                            ;; nature of mks/dtemp's template strings.
+                            (let ((result (alien-funcall (extern-alien ,c-name
+                                                                       (function ,result-type system-area-pointer))
+                                                         (sb-alien::vector-sap arg))))
+                              (when (,errorp result)
+                                (syscall-error))
+                              ;; FIXME: We'd rather return pathnames, but other
+                              ;; SB-POSIX functions like this return strings...
+                              (let ((pathname (sb-ext:octets-to-string
+                                               arg :external-format external-format
+                                               :end (1- (length arg)))))
+                                ,(if values
+                                     '(values result pathname)
+                                     'pathname))))))
+                      (export ',lisp-name))
+                   `(progn
+                      (defun ,lisp-name (template)
+                        (declare (ignore template))
+                        (unsupported-error ',lisp-name ,c-name))
+                      (define-compiler-macro ,lisp-name (&whole form template)
+                        (declare (ignore template))
+                        (unsupported-warning ',lisp-name ,c-name)
+                        form)
+                      (export ',lisp-name)))))
+    (def-mk*temp mktemp "mktemp" (* char) null-alien nil nil)
+    ;; FIXME: Windows does have _mktemp, which has a slightly different
+    ;; interface
+    (def-mk*temp mkstemp "mkstemp" int minusp nil t)
+    ;; FIXME: What about Windows?
+    (def-mk*temp mkdtemp "mkdtemp" (* char) null-alien t nil))
   (define-call-internally ioctl-without-arg "ioctl" int minusp
                           (fd file-descriptor) (cmd int))
   (define-call-internally ioctl-with-int-arg "ioctl" int minusp
   (define-call-internally fcntl-with-pointer-arg "fcntl" int minusp
                           (fd file-descriptor) (cmd int)
                           (arg alien-pointer-to-anything-or-nil))
+  (define-protocol-class flock alien-flock ()
+   ((type :initarg :type :accessor flock-type
+          :documentation "Type of lock; F_RDLCK, F_WRLCK, F_UNLCK.")
+    (whence :initarg :whence :accessor flock-whence
+            :documentation "Flag for starting offset.")
+    (start :initarg :start :accessor flock-start
+           :documentation "Relative offset in bytes.")
+    (len :initarg :len :accessor flock-len
+         :documentation "Size; if 0 then until EOF.")
+    ;; Note: PID isn't initable, and is read-only.  But other stuff in
+    ;; SB-POSIX right now loses when a protocol-class slot is unbound,
+    ;; so we initialize it to 0.
+    (pid :initform 0 :reader flock-pid
+         :documentation
+         "Process ID of the process holding the lock; returned with F_GETLK."))
+   (:documentation "Class representing locks used in fcntl(2)."))
   (define-entry-point "fcntl" (fd cmd &optional (arg nil argp))
     (if argp
         (etypecase arg
           ((alien int) (fcntl-with-int-arg fd cmd arg))
-          ((or (alien (* t)) null) (fcntl-with-pointer-arg fd cmd arg)))
+          ((or (alien (* t)) null) (fcntl-with-pointer-arg fd cmd arg))
+          (flock (with-alien-flock a-flock ()
+                   (flock-to-alien arg a-flock)
+                   (let ((r (fcntl-with-pointer-arg fd cmd a-flock)))
+                     (alien-to-flock a-flock arg)
+                     r))))
         (fcntl-without-arg fd cmd)))
 
   ;; uid, gid
   (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)
 (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
   (:documentation "Instances of this class represent entries in
                    the system's user database."))
 
-(defmacro define-pw-call (name arg type)
+;;; group database
+#-win32
+(define-protocol-class group alien-group ()
+  ((name :initarg :name :accessor group-name)
+   (passwd :initarg :passwd :accessor group-passwd)
+   (gid :initarg :gid :accessor group-gid)))
+
+(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)))
       (declaim (inline ,lisp-name))
       (defun ,lisp-name (,arg)
         (let ((r (alien-funcall (extern-alien ,name ,type) ,arg)))
-          (if (null r)
-              r
-              (alien-to-passwd r)))))))
+          (if (null-alien r)
+              nil
+              (,conv r)))))))
+
+(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)
 
-(define-pw-call "getpwnam" login-name (function (* alien-passwd) c-string))
-(define-pw-call "getpwuid" uid (function (* alien-passwd) uid-t))
 
 #-win32
 (define-protocol-class timeval alien-timeval ()