- `(defun ,lisp-name ,(lisp-args)
- ,@(docs)
- (with-alien
- ((,lisp-name (function ,result-type ,@(arg-types))
- :extern ,alien-name)
- ,@(alien-vars))
- ,(if (alien-values-type-p result-type)
- (let ((temps (make-gensym-list
- (length
- (alien-values-type-values result-type)))))
- `(multiple-value-bind ,temps
- (alien-funcall ,lisp-name ,@(alien-args))
- (values ,@temps ,@(results))))
- `(values (alien-funcall ,lisp-name ,@(alien-args))
- ,@(results))))))))
+ `(progn
+
+ ;; The theory behind this automatic DECLAIM is that (1) if
+ ;; you're calling C, static typing is what you're doing
+ ;; anyway, and (2) such a declamation can be (especially for
+ ;; alien values) both messy to do by hand and very important
+ ;; for performance of later code which uses the return value.
+ ,(let (;; FIXME: Ideally, we'd actually declare useful types
+ ;; here, so e.g. an alien function of "int" and "char"
+ ;; arguments would get Lisp arg types WORD and CHARACTER
+ ;; or something. Meanwhile, for now we just punt.
+ (lisp-arg-types (mapcar (constantly t) (lisp-args)))
+ ;; KLUDGE: This is a quick hack to solve bug 133,
+ ;; where PROCLAIM trying to translate alien void result
+ ;; types would signal an error here ("cannot use values
+ ;; types here"), and the kludgy SB!ALIEN::*VALUE-TYPE-OKAY*
+ ;; flag to enable values types didn't fit into PROCLAIM
+ ;; in any reasonable way. But there's likely a better
+ ;; way to do this. (If there isn't a suitable utility
+ ;; to systematically translate C return types into
+ ;; Lisp return types, there should be.) -- WHN 2002-01-22
+ (lisp-result-type (if (eql result-type 'void)
+ '(values)
+ `(alien ,result-type))))
+ `(declaim (ftype (function ,lisp-arg-types ,lisp-result-type)
+ ,lisp-name)))
+
+ (defun ,lisp-name ,(lisp-args)
+ ,@(docs)
+ (with-alien
+ ((,lisp-name (function ,result-type ,@(arg-types))
+ :extern ,alien-name)
+ ,@(alien-vars))
+ ,(if (alien-values-type-p result-type)
+ (let ((temps (make-gensym-list
+ (length
+ (alien-values-type-values result-type)))))
+ `(multiple-value-bind ,temps
+ (alien-funcall ,lisp-name ,@(alien-args))
+ (values ,@temps ,@(results))))
+ `(values (alien-funcall ,lisp-name ,@(alien-args))
+ ,@(results)))))))))
+
+(defmacro def-alien-routine (&rest rest)
+ (deprecation-warning 'def-alien-routine 'define-alien-routine)
+ `(define-alien-routine ,@rest))