X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Finterface.lisp;h=6d6d72c0b5c8b89e3cc3b000a67cd0f24c1fc627;hb=6c849ec3769e576fdc8b15caeb7c1fda6d7a651b;hp=daaae9b3ce9285b396d752b83b7f617f4a1089a9;hpb=9ca04e5fe7bc37286c120bc84cfd4abf05e51327;p=sbcl.git

diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index daaae9b..6d6d72c 100644
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -87,7 +87,7 @@
 (define-call* "dup" int minusp (oldfd file-descriptor))
 (define-call* "dup2" int minusp (oldfd file-descriptor)
               (newfd file-descriptor))
-(define-call* ("lseek" :largefile)
+(define-call* ("lseek" :options :largefile)
     off-t minusp (fd file-descriptor) (offset off-t)
     (whence int))
 (define-call* "mkdir" int minusp (pathname filename) (mode mode-t))
@@ -107,7 +107,7 @@
 (define-call* "rmdir" int minusp (pathname filename))
 (define-call* "unlink" int minusp (pathname filename))
 (define-call "opendir" (* t) null-alien (pathname filename))
-(define-call ("readdir" :largefile) (* dirent)
+(define-call ("readdir" :options :largefile) (* dirent)
   ;; readdir() has the worst error convention in the world.  It's just
   ;; too painful to support.  (return is NULL _and_ errno "unchanged"
   ;; is not an error, it's EOF).
@@ -126,9 +126,9 @@
   (define-call "fchdir" int minusp (fd file-descriptor))
   (define-call "fchmod" int minusp (fd file-descriptor) (mode mode-t))
   (define-call "fchown" int minusp (fd file-descriptor)
-             (owner uid-t)  (group gid-t))
+               (owner uid-t)  (group gid-t))
   (define-call "fdatasync" int minusp (fd file-descriptor))
-  (define-call ("ftruncate" :largefile)
+  (define-call ("ftruncate" :options :largefile)
       int minusp (fd file-descriptor) (length off-t))
   (define-call "fsync" int minusp (fd file-descriptor))
   (define-call "lchown" int minusp (pathname filename)
@@ -137,11 +137,28 @@
   (define-call "mkfifo" int minusp (pathname filename) (mode mode-t))
   (define-call "symlink" int minusp (oldpath filename) (newpath filename))
   (define-call "sync" void never-fails)
-  (define-call ("truncate" :largefile)
+  (define-call ("truncate" :options :largefile)
       int minusp (pathname filename) (length off-t))
   ;; FIXME: Windows does have _mktemp, which has a slightlty different
   ;; interface
-  (define-call "mkstemp" int minusp (template c-string))
+  (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*))))))
   (define-call-internally ioctl-without-arg "ioctl" int minusp
                           (fd file-descriptor) (cmd int))
   (define-call-internally ioctl-with-int-arg "ioctl" int minusp
@@ -189,7 +206,25 @@
 
   ;; processes, signals
   (define-call "alarm" int never-fails (seconds unsigned))
+
+
+
+  #+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 ()
+      (let ((pid (posix-fork)))
+        (when (= pid 0)
+          (setup-mach-exceptions))
+        pid))
+    (export 'fork :sb-posix))
+
+  #-mach-exception-handler
   (define-call "fork" pid-t minusp)
+
   (define-call "getpgid" pid-t minusp (pid pid-t))
   (define-call "getppid" pid-t never-fails)
   (define-call "getpgrp" pid-t never-fails)
@@ -245,7 +280,7 @@
 ;;; mmap, msync
 #-win32
 (progn
- (define-call ("mmap" :largefile) sb-sys:system-area-pointer
+ (define-call ("mmap" :options :largefile) sb-sys:system-area-pointer
    (lambda (res)
      (= (sb-sys:sap-int res) #.(1- (expt 2 sb-vm::n-machine-word-bits))))
    (addr sap-or-nil) (length unsigned) (prot unsigned)
@@ -312,7 +347,7 @@
         (declare (type (or null (sb-alien:alien (* alien-stat))) stat))
         (with-alien-stat a-stat ()
           (let ((r (alien-funcall
-                    (extern-alien ,(real-c-name (list name :largefile)) ,type)
+                    (extern-alien ,(real-c-name (list name :options :largefile)) ,type)
                     (,designator-fun ,arg)
                     a-stat)))
             (when (minusp r)
@@ -517,3 +552,25 @@
     (unless (null-alien r)
       (cast r c-string))))
 (define-call "putenv" int minusp (string c-string))
+
+;;; syslog
+#-win32
+(progn
+  (export 'openlog :sb-posix)
+  (export 'syslog :sb-posix)
+  (export 'closelog :sb-posix)
+  (defun openlog (ident options &optional (facility log-user))
+    (alien-funcall (extern-alien
+                    "openlog" (function void c-string int int))
+                   ident options facility))
+  (defun syslog (priority format &rest args)
+    "Send a message to the syslog facility, with severity level
+PRIORITY.  The message will be formatted as by CL:FORMAT (rather
+than C's printf) with format string FORMAT and arguments ARGS."
+    (flet ((syslog1 (priority message)
+             (alien-funcall (extern-alien
+                             "syslog" (function void int c-string c-string))
+                            priority "%s" message)))
+      (syslog1 priority (apply #'format nil format args))))
+  (define-call "closelog" void never-fails))
+