1.0.45.32: export SB-PCL:+SLOT-UNBOUND+
[sbcl.git] / contrib / sb-posix / interface.lisp
index 0995a1d..5c8a877 100644 (file)
 
   ;; uid, gid
   (define-call "geteuid" uid-t never-fails) ; "always successful", it says
-  (define-call "getresuid" uid-t never-fails)
+#-sunos  (define-call "getresuid" uid-t never-fails)
   (define-call "getuid" uid-t never-fails)
   (define-call "seteuid" int minusp (uid uid-t))
-  (define-call "setfsuid" int minusp (uid uid-t))
+#-sunos  (define-call "setfsuid" int minusp (uid uid-t))
   (define-call "setreuid" int minusp (ruid uid-t) (euid uid-t))
-  (define-call "setresuid" int minusp (ruid uid-t) (euid uid-t) (suid uid-t))
+#-sunos  (define-call "setresuid" int minusp (ruid uid-t) (euid uid-t) (suid uid-t))
   (define-call "setuid" int minusp (uid uid-t))
   (define-call "getegid" gid-t never-fails)
   (define-call "getgid" gid-t never-fails)
-  (define-call "getresgid" gid-t never-fails)
+#-sunos  (define-call "getresgid" gid-t never-fails)
   (define-call "setegid" int minusp (gid gid-t))
-  (define-call "setfsgid" int minusp (gid gid-t))
+#-sunos  (define-call "setfsgid" int minusp (gid gid-t))
   (define-call "setgid" int minusp (gid gid-t))
   (define-call "setregid" int minusp (rgid gid-t) (egid gid-t))
-  (define-call "setresgid" int minusp (rgid gid-t) (egid gid-t) (sgid gid-t))
+#-sunos  (define-call "setresgid" int minusp (rgid gid-t) (egid gid-t) (sgid gid-t))
 
   ;; processes, signals
   (define-call "alarm" int never-fails (seconds unsigned))
 
 
 
+  ;; FIXME this is a lie, of course this can fail, but there's no
+  ;; error handling here yet!
   #+mach-exception-handler
-  (progn
-    ;; FIXME this is a lie, of course this can fail, but there's no
-    ;; error handling here yet!
-    (define-call "setup_mach_exceptions" void never-fails)
-    (define-call ("posix_fork" :c-name "fork") pid-t minusp)
-    (defun fork ()
-      (tagbody
-         (sb-thread::with-all-threads-lock
-           (when (cdr sb-thread::*all-threads*)
-             (go :error))
-           (let ((pid (posix-fork)))
-             (when (= pid 0)
-               (setup-mach-exceptions))
-             (return-from fork pid)))
-       :error
-         (error "Cannot fork with multiple threads running.")))
-    (export 'fork :sb-posix))
-
-  #-mach-exception-handler
-  (define-call "fork" pid-t minusp)
+  (define-call "setup_mach_exceptions" void never-fails)
+  (define-call ("posix_fork" :c-name "fork") pid-t minusp)
+  (defun fork ()
+    "Forks the current process, returning 0 in the new process and the PID of
+the child process in the parent. Forking while multiple threads are running is
+not supported."
+    (tagbody
+       (sb-thread::with-all-threads-lock
+         (when (cdr sb-thread::*all-threads*)
+           (go :error))
+         (let ((pid (posix-fork)))
+           #+mach-exception-handler
+           (when (= pid 0)
+             (setup-mach-exceptions))
+           (return-from fork pid)))
+     :error
+       (error "Cannot fork with multiple threads running.")))
+  (export 'fork :sb-posix)
 
   (define-call "getpgid" pid-t minusp (pid pid-t))
   (define-call "getppid" pid-t never-fails)