3 (define-designator filename c-string
5 (sb-ext:native-namestring
(translate-logical-pathname filename
)))
8 (define-designator file-descriptor
(integer 32)
9 (file-stream (sb-sys:fd-stream-fd file-descriptor
))
10 (fixnum file-descriptor
))
12 (define-designator sap-or-nil sb-sys
:system-area-pointer
13 (null (sb-sys:int-sap
0))
14 (sb-sys:system-area-pointer sap-or-nil
))
16 (define-designator alien-pointer-to-anything-or-nil
(* t
)
17 (null (sb-alien:sap-alien
(sb-sys:int-sap
0) (* t
)))
18 ((alien (* t
)) alien-pointer-to-anything-or-nil
))
20 (defun lisp-for-c-symbol (name)
23 (lisp-for-c-symbol (car name
)))
25 (let ((root (if (eql #\_
(char name
0)) (subseq name
1) name
)))
26 (intern (substitute #\-
#\_
(string-upcase root
)) :sb-posix
)))))
28 ;; Note: this variable is set in interface.lisp. defined here for
29 ;; clarity and so the real-c-name compile as desired.
30 (defparameter *c-functions-in-runtime
* nil
)
32 (defun real-c-name (name)
36 (destructuring-bind (name &key c-name options
) name
40 ((or (eql options
:largefile
)
41 (member :largefile options
))
42 (format nil
"~a_largefile" name
))
47 (if (member maybe-name
*c-functions-in-runtime
*
49 (format nil
"_~A" maybe-name
)
52 (defmacro define-call-internally
(lisp-name c-name return-type error-predicate
54 (if (sb-sys:find-foreign-symbol-address c-name
)
56 (declaim (inline ,lisp-name
))
57 (defun ,lisp-name
,(mapcar #'car arguments
)
58 (let ((r (alien-funcall
61 (function ,return-type
72 `(,(intern (symbol-name (cadr x
))
77 (if (,error-predicate r
) (syscall-error) r
))))
78 `(sb-int:style-warn
"Didn't find definition for ~S" ,c-name
)))
80 (defmacro define-call
(name return-type error-predicate
&rest arguments
)
81 (let ((lisp-name (lisp-for-c-symbol name
))
82 (real-c-name (real-c-name name
)))
84 (export ',lisp-name
:sb-posix
)
85 (define-call-internally ,lisp-name
91 (defmacro define-entry-point
(name arglist
&body body
)
92 (let ((lisp-name (lisp-for-c-symbol name
)))
94 (export ',lisp-name
:sb-posix
)
95 (declaim (inline ,lisp-name
))
96 (defun ,lisp-name
,arglist