X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fhost-alieneval.lisp;h=413bebaa30a2188e3eb4d1a6de7ff5cdb628d37b;hb=860543cc7ba0266e41e1d41ac9b6a208f3795f1a;hp=647dc3975be2c43ee15c4436a387ccbc10b2f7e7;hpb=86210c4e406c1b2ff10cc3bac0e71435867db48b;p=sbcl.git

diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp
index 647dc39..413beba 100644
--- a/src/code/host-alieneval.lisp
+++ b/src/code/host-alieneval.lisp
@@ -30,7 +30,7 @@
 
 ;;;; 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)
@@ -147,7 +147,7 @@
 ;;; 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)
@@ -245,22 +245,21 @@
 ;;;; 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)
@@ -286,7 +285,7 @@
   (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
@@ -599,10 +598,10 @@
 (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