(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)
(define-call "lchown" int minusp (pathname filename)
(owner uid-t) (group gid-t))
(define-call "link" int minusp (oldpath filename) (newpath filename))
+ (define-call "lockf" int minusp (fd file-descriptor) (cmd int) (len off-t))
(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 "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))
+(defmacro with-growing-c-string ((buffer size) &body body)
+ (sb-int:with-unique-names (c-string-block)
+ `(block ,c-string-block
+ (let (,buffer)
+ (flet ((,buffer (&optional (size-incl-null))
+ (when size-incl-null
+ (setf (sb-sys:sap-ref-8 (sb-alien:alien-sap ,buffer) size-incl-null)
+ 0))
+ (return-from ,c-string-block
+ (sb-alien::c-string-to-string
+ (sb-alien:alien-sap ,buffer)
+ (sb-impl::default-external-format)
+ 'character))))
+ (loop for ,size = 128 then (* 2 ,size)
+ do (unwind-protect
+ (progn
+ (setf ,buffer (make-alien c-string ,size))
+ ,@body)
+ (when ,buffer
+ (free-alien ,buffer)))))))))
+
+#-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)))
+ (with-growing-c-string (buf size)
+ (let ((count (%readlink (filename pathspec) buf size)))
+ (cond ((minusp count)
+ (syscall-error))
+ ((< 0 count size)
+ (buf count))))))))
+
+(progn
+ (export 'getcwd :sb-posix)
+ (defun getcwd ()
+ (flet ((%getcwd (buffer size)
+ (alien-funcall
+ (extern-alien #-win32 "getcwd"
+ #+win32 "_getcwd" (function c-string (* t) int))
+ buffer size)))
+ (with-growing-c-string (buf size)
+ (let ((result (%getcwd buf size)))
+ (cond (result
+ (buf))
+ ((/= (get-errno) sb-posix:erange)
+ (syscall-error))))))))
#-win32
(progn
(defun wait (&optional statusptr)
(declare (type (or null (simple-array (signed-byte 32) (1))) statusptr))
(let* ((ptr (or statusptr (make-array 1 :element-type '(signed-byte 32))))
- (pid (alien-funcall
- (extern-alien "wait" (function pid-t (* int)))
- (sb-sys:vector-sap ptr))))
+ (pid (sb-sys:with-pinned-objects (ptr)
+ (alien-funcall
+ (extern-alien "wait" (function pid-t (* int)))
+ (sb-sys:vector-sap ptr)))))
(if (minusp pid)
(syscall-error)
(values pid (aref ptr 0))))))
(type (sb-alien:alien int) options)
(type (or null (simple-array (signed-byte 32) (1))) statusptr))
(let* ((ptr (or statusptr (make-array 1 :element-type '(signed-byte 32))))
- (pid (alien-funcall
- (extern-alien "waitpid" (function pid-t
- pid-t (* int) int))
- pid (sb-sys:vector-sap ptr) options)))
+ (pid (sb-sys:with-pinned-objects (ptr)
+ (alien-funcall
+ (extern-alien "waitpid" (function pid-t
+ pid-t (* int) int))
+ pid (sb-sys:vector-sap ptr) options))))
(if (minusp pid)
(syscall-error)
(values pid (aref ptr 0)))))
(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)
(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
(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)))
(declare (type (or null (simple-array (signed-byte 32) (2))) filedes2))
(unless filedes2
(setq filedes2 (make-array 2 :element-type '(signed-byte 32))))
- (let ((r (alien-funcall
- ;; FIXME: (* INT)? (ARRAY INT 2) would be better
- (extern-alien "pipe" (function int (* int)))
- (sb-sys:vector-sap filedes2))))
+ (let ((r (sb-sys:with-pinned-objects (filedes2)
+ (alien-funcall
+ ;; FIXME: (* INT)? (ARRAY INT 2) would be better
+ (extern-alien "pipe" (function int (* int)))
+ (sb-sys:vector-sap filedes2)))))
(when (minusp r)
(syscall-error)))
(values (aref filedes2 0) (aref filedes2 1))))
priority "%s" message)))
(syslog1 priority (apply #'format nil format args))))
(define-call "closelog" void never-fails))
-
projects / sbcl.git / blobdiff