,@body))))
(:local
(/show0 ":LOCAL case")
- (let* ((var (gensym))
- (initval (if initial-value (gensym)))
+ (let* ((var (sb!xc:gensym "VAR"))
+ (initval (if initial-value (sb!xc:gensym "INITVAL")))
(info (make-local-alien-info :type alien-type))
(inner-body
`((note-local-alien-type ',info ,var)
(let ((stub (alien-fun-type-stub type)))
(unless stub
(setf stub
- (let ((fun (gensym))
+ (let ((fun (sb!xc:gensym "FUN"))
(parms (make-gensym-list (length args))))
(compile nil
`(lambda (,fun ,@parms)
((,lisp-name (function ,result-type ,@(arg-types))
:extern ,alien-name)
,@(alien-vars))
- #-nil
- (values (alien-funcall ,lisp-name ,@(alien-args))
- ,@(results))
- #+nil
- (if (alien-values-type-p result-type)
- ;; FIXME: RESULT-TYPE is a type specifier, so it
- ;; cannot be of type ALIEN-VALUES-TYPE. Also note,
- ;; that if RESULT-TYPE is VOID, then this code
- ;; disagrees with the computation of the return type
- ;; and with all usages of this macro. -- APD,
- ;; 2002-03-02
- (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)))))))))
+ ,@(if (eq 'void result-type)
+ `((alien-funcall ,lisp-name ,@(alien-args))
+ (values nil ,@(results)))
+ `((values (alien-funcall ,lisp-name ,@(alien-args))
+ ,@(results))))))))))
\f
(defun alien-typep (object type)
#!+sb-doc
:local ,(alien-callback-accessor-form
spec 'args-sap offset))
do (incf offset (alien-callback-argument-bytes spec env)))
- ,(flet ((store (spec)
+ ,(flet ((store (spec real-type)
(if spec
`(setf (deref (sap-alien res-sap (* ,spec)))
- (funcall function ,@arguments))
+ ,(if real-type
+ `(the ,real-type
+ (funcall function ,@arguments))
+ `(funcall function ,@arguments)))
`(funcall function ,@arguments))))
(cond ((alien-void-type-p result-type)
- (store nil))
+ (store nil nil))
((alien-integer-type-p result-type)
+ ;; Integer types should be padded out to a full
+ ;; register width, to comply with most ABI calling
+ ;; conventions, but should be typechecked on the
+ ;; declared type width, hence the following:
(if (alien-integer-type-signed result-type)
(store `(signed
- ,(alien-type-word-aligned-bits result-type)))
+ ,(alien-type-word-aligned-bits result-type))
+ `(signed-byte ,(alien-type-bits result-type)))
(store
`(unsigned
- ,(alien-type-word-aligned-bits result-type)))))
+ ,(alien-type-word-aligned-bits result-type))
+ `(unsigned-byte ,(alien-type-bits result-type)))))
(t
- (store (unparse-alien-type result-type)))))))
+ (store (unparse-alien-type result-type) nil))))))
(values))))
(defun invalid-alien-callback (&rest arguments)