X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-posix%2Finterface.lisp;h=07ac6f5ade356af226ae7f57442761e05cbf18e3;hb=9b6bef920da10d33e6fcd43c1bc06cf528f4f507;hp=349c74d3eb75407237f58f4ba87efbf053b6b2a8;hpb=d2193d89db7a93de9874115a6f4481d0aba99c60;p=sbcl.git

diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp
index 349c74d..07ac6f5 100644
--- a/contrib/sb-posix/interface.lisp
+++ b/contrib/sb-posix/interface.lisp
@@ -70,6 +70,15 @@
   (declare (ignore args))
   nil)
 
+;;; Some systems may need C-level wrappers, which can live in the
+;;; runtime (so that save-lisp-and-die can produce standalone
+;;; executables).  See REAL-C-NAME in macros.lisp for the use of this
+;;; variable.
+(eval-when (:compile-toplevel :load-toplevel)
+  (setf *c-functions-in-runtime*
+        '`(#+netbsd ,@("stat" "lstat" "fstat" "readdir" "opendir"))))
+
+
 ;;; filesystem access
 (defmacro define-call* (name &rest arguments)
   #-win32 `(define-call ,name ,@arguments)
@@ -106,8 +115,10 @@
 (define-call "rename" int minusp (oldpath filename) (newpath filename))
 (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" :options :largefile) (* dirent)
+(define-call #-netbsd "opendir" #+netbsd "_opendir"
+    (* t) null-alien (pathname filename))
+(define-call (#-netbsd "readdir" #+netbsd "_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).
@@ -235,7 +246,30 @@
   (define-call "setpgid" int minusp (pid pid-t) (pgid pid-t))
   (define-call "setpgrp" int minusp))
 
-;;(define-call "readlink" int minusp (path filename) (buf (* t)) (len int))
+#-win32
+(progn
+  (export 'readlink :sb-posix)
+  (defun readlink (pathspec)
+    (flet ((%readlink (path buf length)
+             (alien-funcall
+              (extern-alien "readlink" (function int c-string (* t) int))
+              path buf length)))
+      (loop for size = 128 then (* 2 size)
+            for buf = (make-alien c-string size)
+            do (unwind-protect
+                    (let ((count (%readlink (filename pathspec) buf size)))
+                      (cond ((minusp count)
+                             (syscall-error))
+                            ((< 0 count size)
+                             (setf (sb-sys:sap-ref-8 (sb-alien:alien-sap buf)
+                                                     count)
+                                   0)
+                             (return
+                               (sb-alien::c-string-to-string
+                                (sb-alien:alien-sap buf)
+                                (sb-impl::default-external-format)
+                                'character)))))
+                 (free-alien buf))))))
 
 #-win32
 (progn
@@ -325,6 +359,11 @@
 (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 ()
+  ((sec :initarg :tv-sec :accessor timeval-sec)
+   (usec :initarg :tv-usec :accessor timeval-usec)))
+
 (define-protocol-class stat alien-stat ()
   ((mode :initarg :mode :accessor stat-mode)
    (ino :initarg :ino :accessor stat-ino)
@@ -354,15 +393,12 @@
               (syscall-error))
             (alien-to-stat a-stat stat)))))))
 
-;; Note: _stat, _lstat, and _fstat for NetBSD are provided in
-;; src/runtime/bsd-os.c.  See comments in that file
-;; for an explanation. -- RMK 2006-10-15
-(define-stat-call #-(or win32 netbsd) "stat" #+(or win32 netbsd) "_stat"
+(define-stat-call #-win32 "stat" #+win32 "_stat"
                   pathname filename
                   (function int c-string (* alien-stat)))
 
 #-win32
-(define-stat-call #-netbsd "lstat" #+netbsd "_lstat"
+(define-stat-call "lstat"
                   pathname filename
                   (function int c-string (* alien-stat)))
 ;;; No symbolic links on Windows, so use stat
@@ -372,7 +408,7 @@
   (export (defun lstat (filename &optional stat)
             (if stat (stat filename stat) (stat filename)))))
 
-(define-stat-call #-(or win32 netbsd) "fstat" #+(or win32 netbsd) "_fstat"
+(define-stat-call #-win32 "fstat" #+win32 "_fstat"
                   fd file-descriptor
                   (function int int (* alien-stat)))
 
@@ -552,3 +588,24 @@
     (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))