\f
;;;; ALIEN-TYPE-INFO stuff
-(eval-when (:compile-toplevel :execute :load-toplevel)
+(eval-when (#-sb-xc :compile-toplevel :execute :load-toplevel)
(defstruct (alien-type-class (:copier nil))
(name nil :type symbol)
;;; COMPILER-LET is no longer supported by ANSI or SBCL. Instead, we
;;; follow the suggestion in CLTL2 of using SYMBOL-MACROLET to achieve
;;; a similar effect.
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(defun auxiliary-type-definitions (env)
(multiple-value-bind (result expanded-p)
(sb!xc:macroexpand '&auxiliary-type-definitions& env)
;;;; alien type defining stuff
(def!macro define-alien-type-translator (name lambda-list &body body)
- (let ((whole (gensym "WHOLE"))
- (env (gensym "ENV"))
- (defun-name (symbolicate "ALIEN-" name "-TYPE-TRANSLATOR")))
- (multiple-value-bind (body decls docs)
- (sb!kernel:parse-defmacro lambda-list whole body name
- 'define-alien-type-translator
- :environment env)
- `(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun ,defun-name (,whole ,env)
- (declare (ignorable ,env))
- ,@decls
- (block ,name
- ,body))
- (%define-alien-type-translator ',name #',defun-name ,docs)))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
+ (with-unique-names (whole env)
+ (let ((defun-name (symbolicate "ALIEN-" name "-TYPE-TRANSLATOR")))
+ (multiple-value-bind (body decls docs)
+ (sb!kernel:parse-defmacro lambda-list whole body name
+ 'define-alien-type-translator
+ :environment env)
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun ,defun-name (,whole ,env)
+ (declare (ignorable ,env))
+ ,@decls
+ (block ,name
+ ,body))
+ (%define-alien-type-translator ',name #',defun-name ,docs))))))
+
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(defun %define-alien-type-translator (name translator docs)
(declare (ignore docs))
(setf (info :alien-type :kind name) :primitive)
(deprecation-warning 'def-alien-type 'define-alien-type)
`(define-alien-type ,@rest))
-(eval-when (:compile-toplevel :load-toplevel :execute)
+(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
(defun %def-auxiliary-alien-types (types)
(dolist (info types)
(destructuring-bind (kind name defn) info
(8 'signed-sap-ref-8)
(16 'signed-sap-ref-16)
(32 'signed-sap-ref-32)
- #!+alpha (64 'signed-sap-ref-64))
+ (64 'signed-sap-ref-64))
(case (alien-integer-type-bits type)
(8 'sap-ref-8)
(16 'sap-ref-16)
(32 'sap-ref-32)
- #!+alpha (64 'sap-ref-64)))))
+ (64 'sap-ref-64)))))
(if ref-fun
`(,ref-fun ,sap (/ ,offset sb!vm:n-byte-bits))
(error "cannot extract ~W-bit integers"
(define-alien-type-class (enum :include (integer (bits 32))
:include-args (signed))
name ; name of this enum (if any)
- from ; alist from keywords to integers.
- to ; alist or vector from integers to keywords.
- kind ; Kind of from mapping, :vector or :alist.
- offset) ; Offset to add to value for :vector from mapping.
+ from ; alist from keywords to integers
+ to ; alist or vector from integers to keywords
+ kind ; kind of from mapping, :VECTOR or :ALIST
+ offset) ; offset to add to value for :VECTOR from mapping
(define-alien-type-translator enum (&whole
type name