1 (in-package :sb-posix-internal
)
3 ;;; some explanation may be necessary. The namestring "[foo]"
4 ;;; denotes a wild pathname. When there's a file on the disk whose
5 ;;; Unix name is "[foo]", the appropriate CL namestring for it is
6 ;;; "\\[foo]". So, don't call NAMESTRING, instead call a function
7 ;;; that gets us the Unix name
8 (defun native-filename (pathname)
9 (let ((directory (pathname-directory pathname
))
10 (name (pathname-name pathname
))
11 (type (pathname-type pathname
)))
12 (with-output-to-string (s nil
:element-type
'base-char
)
14 (string (write-string directory s
))
16 (when (eq (car directory
) :absolute
)
18 (dolist (piece (cdr directory
))
20 (string (write-string piece s
) (write-char #\
/ s
))))))
23 (string (write-string name s
)))
26 (string (write-char #\. s
) (write-string type s
))))))
28 (define-designator filename c-string
30 (native-filename (translate-logical-pathname filename
)))
33 (define-designator file-descriptor
(integer 32)
34 (sb-impl::file-stream
(sb-impl::fd-stream-fd file-descriptor
))
35 (fixnum file-descriptor
))
37 (define-designator sap-or-nil sb-sys
:system-area-pointer
38 (null (sb-sys:int-sap
0))
39 (sb-sys:system-area-pointer sap-or-nil
))
41 (defun lisp-for-c-symbol (s)
42 (intern (substitute #\-
#\_
(string-upcase s
)) :sb-posix
))
44 (defmacro define-call
(name return-type error-predicate
&rest arguments
)
45 (let ((lisp-name (lisp-for-c-symbol name
)))
46 (if (sb-fasl::foreign-symbol-address-as-integer-or-nil name
)
48 (export ',lisp-name
:sb-posix
)
49 (declaim (inline ,lisp-name
))
50 (defun ,lisp-name
,(mapcar #'car arguments
)
51 (let ((r (alien-funcall
54 (function ,return-type
57 (gethash (cadr x
) *designator-types
* (cadr x
)))
60 (if (nth-value 1 (gethash (cadr x
) *designator-types
*))
61 `(,(intern (symbol-name (cadr x
)) :sb-posix
)
65 (if (,error-predicate r
) (syscall-error) r
))))
67 (export ',lisp-name
:sb-posix
)
68 (sb-int:style-warn
"Didn't find definition for ~S" ,name
)))))