X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=contrib%2Fsb-posix%2Finterface.lisp;h=5806754e81f14b6774c45c1de5d3a31c5dbb2f55;hb=4d8b3b1da4d960a6ff768c9e6ee8f99bf270b631;hp=6d6d72c0b5c8b89e3cc3b000a67cd0f24c1fc627;hpb=6c849ec3769e576fdc8b15caeb7c1fda6d7a651b;p=sbcl.git diff --git a/contrib/sb-posix/interface.lisp b/contrib/sb-posix/interface.lisp index 6d6d72c..5806754 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 @@ -354,15 +388,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 +403,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))) @@ -573,4 +604,3 @@ than C's printf) with format string FORMAT and arguments ARGS." priority "%s" message))) (syslog1 priority (apply #'format nil format args)))) (define-call "closelog" void never-fails)) -