3 (define-designator filename c-string
5 (sb-ext:native-namestring
(translate-logical-pathname filename
)
9 (define-designator file-descriptor
(integer 32)
10 (file-stream (sb-sys:fd-stream-fd file-descriptor
))
11 (fixnum file-descriptor
))
13 (define-designator sap-or-nil sb-sys
:system-area-pointer
14 (null (sb-sys:int-sap
0))
15 (sb-sys:system-area-pointer sap-or-nil
))
17 (define-designator alien-pointer-to-anything-or-nil
(* t
)
18 (null (sb-alien:sap-alien
(sb-sys:int-sap
0) (* t
)))
19 ((alien (* t
)) alien-pointer-to-anything-or-nil
))
21 (defun lisp-for-c-symbol (name)
24 (lisp-for-c-symbol (car name
)))
26 (let ((root (if (eql #\_
(char name
0)) (subseq name
1) name
)))
27 (intern (substitute #\-
#\_
(string-upcase root
)) :sb-posix
)))))
29 ;; Note: this variable is set in interface.lisp. defined here for
30 ;; clarity and so the real-c-name compile as desired.
31 (defparameter *c-functions-in-runtime
* nil
)
33 (defun real-c-name (name)
37 (destructuring-bind (name &key c-name options
) name
41 ((or (eql options
:largefile
)
42 (member :largefile options
))
43 (format nil
"~a_largefile" name
))
48 (if (member maybe-name
*c-functions-in-runtime
*
50 (format nil
"_~A" maybe-name
)
53 (defmacro define-call-internally
(lisp-name c-name return-type error-predicate
55 (if (sb-sys:find-foreign-symbol-address c-name
)
57 (declaim (inline ,lisp-name
))
58 (defun ,lisp-name
,(mapcar #'car arguments
)
59 (let ((r (alien-funcall
62 (function ,return-type
73 `(,(intern (symbol-name (cadr x
))
78 (if (,error-predicate r
) (syscall-error) r
))))
79 `(sb-int:style-warn
"Didn't find definition for ~S" ,c-name
)))
81 (defmacro define-call
(name return-type error-predicate
&rest arguments
)
82 (let ((lisp-name (lisp-for-c-symbol name
))
83 (real-c-name (real-c-name name
)))
85 (export ',lisp-name
:sb-posix
)
86 (define-call-internally ,lisp-name
92 (defmacro define-entry-point
(name arglist
&body body
)
93 (let ((lisp-name (lisp-for-c-symbol name
)))
95 (export ',lisp-name
:sb-posix
)
96 (declaim (inline ,lisp-name
))
97 (defun ,lisp-name
,arglist