X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fhost-alieneval.lisp;h=413bebaa30a2188e3eb4d1a6de7ff5cdb628d37b;hb=22b819c0cd0ca0ea5be52ba280b9e9e0b8e86210;hp=e2f17572290c4acbe3a75a693fac055689d8afcf;hpb=ac955573b3c4115511244304047add6158430395;p=sbcl.git

diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp
index e2f1757..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)
@@ -85,7 +85,8 @@
 
 ;;; We define a keyword "BOA" constructor so that we can reference the
 ;;; slot names in init forms.
-(def!macro def-alien-type-class ((name &key include include-args) &rest slots)
+(def!macro define-alien-type-class ((name &key include include-args)
+				    &rest slots)
   (let ((defstruct-name (symbolicate "ALIEN-" name "-TYPE")))
     (multiple-value-bind (include include-defstruct overrides)
 	(etypecase include
@@ -106,7 +107,7 @@
 	   (create-alien-type-class-if-necessary ',name ',(or include 'root)))
 	 (def!struct (,defstruct-name
 			(:include ,include-defstruct
-				  (:class ',name)
+				  (class ',name)
 				  ,@overrides)
 			(:constructor
 			 ,(symbolicate "MAKE-" defstruct-name)
@@ -114,10 +115,12 @@
 			       ,@(mapcar (lambda (x)
 					   (if (atom x) x (car x)))
 					 slots)
-			       ,@include-args)))
+			       ,@include-args
+			       ;; KLUDGE
+			       &aux (alignment (or alignment (guess-alignment bits))))))
 	   ,@slots)))))
 
-(def!macro def-alien-type-method ((class method) lambda-list &rest body)
+(def!macro define-alien-type-method ((class method) lambda-list &rest body)
   (let ((defun-name (symbolicate class "-" method "-METHOD")))
     `(progn
        (defun ,defun-name ,lambda-list
@@ -144,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)
@@ -241,24 +244,23 @@
 
 ;;;; alien type defining stuff
 
-(def!macro def-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
-				  'def-alien-type-translator
-				  :environment env)
-      `(eval-when (:compile-toplevel :load-toplevel :execute)
-	 (defun ,defun-name (,whole ,env)
-	   (declare (ignorable ,env))
-	   ,@decls
-	   (block ,name
-	     ,body))
-	 (%def-alien-type-translator ',name #',defun-name ,docs)))))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun %def-alien-type-translator (name translator docs)
+(def!macro define-alien-type-translator (name lambda-list &body body)
+  (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)
     (setf (info :alien-type :translator name) translator)
@@ -267,7 +269,7 @@
     (setf (fdocumentation name 'alien-type) docs)
     name))
 
-(def!macro def-alien-type (name type &environment env)
+(def!macro define-alien-type (name type &environment env)
   #!+sb-doc
   "Define the alien type NAME to be equivalent to TYPE. Name may be NIL for
    STRUCT and UNION types, in which case the name is taken from the type
@@ -278,9 +280,12 @@
 	 ,@(when *new-auxiliary-types*
 	     `((%def-auxiliary-alien-types ',*new-auxiliary-types*)))
 	 ,@(when name
-	     `((%def-alien-type ',name ',alien-type)))))))
+	     `((%define-alien-type ',name ',alien-type)))))))
+(def!macro def-alien-type (&rest rest)
+  (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
@@ -295,7 +300,7 @@
 	    (:struct (frob :struct))
 	    (:union (frob :union))
 	    (:enum (frob :enum)))))))
-  (defun %def-alien-type (name new)
+  (defun %define-alien-type (name new)
     (ecase (info :alien-type :kind name)
       (:primitive
        (error "~S is a built-in alien type." name))
@@ -318,59 +323,60 @@
 
 (def!struct (alien-type
 	     (:make-load-form-fun sb!kernel:just-dump-it-normally)
-	     (:constructor make-alien-type (&key class bits alignment)))
+	     (:constructor make-alien-type (&key class bits alignment
+					    &aux (alignment (or alignment (guess-alignment bits))))))
   (class 'root :type symbol)
   (bits nil :type (or null unsigned-byte))
-  (alignment (guess-alignment bits) :type (or null unsigned-byte)))
+  (alignment nil :type (or null unsigned-byte)))
 (def!method print-object ((type alien-type) stream)
   (print-unreadable-object (type stream :type t)
     (prin1 (unparse-alien-type type) stream)))
 
 ;;;; the SAP type
 
-(def-alien-type-class (system-area-pointer))
+(define-alien-type-class (system-area-pointer))
 
-(def-alien-type-translator system-area-pointer ()
+(define-alien-type-translator system-area-pointer ()
   (make-alien-system-area-pointer-type
-   :bits #!-alpha sb!vm:word-bits #!+alpha 64))
+   :bits #!-alpha sb!vm:n-word-bits #!+alpha 64))
 
-(def-alien-type-method (system-area-pointer :unparse) (type)
+(define-alien-type-method (system-area-pointer :unparse) (type)
   (declare (ignore type))
   'system-area-pointer)
 
-(def-alien-type-method (system-area-pointer :lisp-rep) (type)
+(define-alien-type-method (system-area-pointer :lisp-rep) (type)
   (declare (ignore type))
   'system-area-pointer)
 
-(def-alien-type-method (system-area-pointer :alien-rep) (type)
+(define-alien-type-method (system-area-pointer :alien-rep) (type)
   (declare (ignore type))
   'system-area-pointer)
 
-(def-alien-type-method (system-area-pointer :naturalize-gen) (type alien)
+(define-alien-type-method (system-area-pointer :naturalize-gen) (type alien)
   (declare (ignore type))
   alien)
 
-(def-alien-type-method (system-area-pointer :deport-gen) (type object)
+(define-alien-type-method (system-area-pointer :deport-gen) (type object)
   (declare (ignore type))
   (/noshow "doing alien type method SYSTEM-AREA-POINTER :DEPORT-GEN" object)
   object)
 
-(def-alien-type-method (system-area-pointer :extract-gen) (type sap offset)
+(define-alien-type-method (system-area-pointer :extract-gen) (type sap offset)
   (declare (ignore type))
-  `(sap-ref-sap ,sap (/ ,offset sb!vm:byte-bits)))
+  `(sap-ref-sap ,sap (/ ,offset sb!vm:n-byte-bits)))
 
 ;;;; the ALIEN-VALUE type
 
-(def-alien-type-class (alien-value :include system-area-pointer))
+(define-alien-type-class (alien-value :include system-area-pointer))
 
-(def-alien-type-method (alien-value :lisp-rep) (type)
+(define-alien-type-method (alien-value :lisp-rep) (type)
   (declare (ignore type))
   nil)
 
-(def-alien-type-method (alien-value :naturalize-gen) (type alien)
+(define-alien-type-method (alien-value :naturalize-gen) (type alien)
   `(%sap-alien ,alien ',type))
 
-(def-alien-type-method (alien-value :deport-gen) (type value)
+(define-alien-type-method (alien-value :deport-gen) (type value)
   (declare (ignore type))
   (/noshow "doing alien type method ALIEN-VALUE :DEPORT-GEN" value)
   `(alien-sap ,value))
@@ -381,10 +387,10 @@
 (def!struct (heap-alien-info
 	     (:make-load-form-fun sb!kernel:just-dump-it-normally))
   ;; The type of this alien.
-  (type (required-argument) :type alien-type)
+  (type (missing-arg) :type alien-type)
   ;; The form to evaluate to produce the SAP pointing to where in the heap
   ;; it is.
-  (sap-form (required-argument)))
+  (sap-form (missing-arg)))
 (def!method print-object ((info heap-alien-info) stream)
   (print-unreadable-object (info stream :type t)
     (funcall (formatter "~S ~S")
@@ -461,90 +467,90 @@
 
 ;;;; default methods
 
-(def-alien-type-method (root :unparse) (type)
+(define-alien-type-method (root :unparse) (type)
   `(<unknown-alien-type> ,(type-of type)))
 
-(def-alien-type-method (root :type=) (type1 type2)
+(define-alien-type-method (root :type=) (type1 type2)
   (declare (ignore type1 type2))
   t)
 
-(def-alien-type-method (root :subtypep) (type1 type2)
+(define-alien-type-method (root :subtypep) (type1 type2)
   (alien-type-= type1 type2))
 
-(def-alien-type-method (root :lisp-rep) (type)
+(define-alien-type-method (root :lisp-rep) (type)
   (declare (ignore type))
   nil)
 
-(def-alien-type-method (root :alien-rep) (type)
+(define-alien-type-method (root :alien-rep) (type)
   (declare (ignore type))
   '*)
 
-(def-alien-type-method (root :naturalize-gen) (type alien)
+(define-alien-type-method (root :naturalize-gen) (type alien)
   (declare (ignore alien))
   (error "cannot represent ~S typed aliens" type))
 
-(def-alien-type-method (root :deport-gen) (type object)
+(define-alien-type-method (root :deport-gen) (type object)
   (declare (ignore object))
   (error "cannot represent ~S typed aliens" type))
 
-(def-alien-type-method (root :extract-gen) (type sap offset)
+(define-alien-type-method (root :extract-gen) (type sap offset)
   (declare (ignore sap offset))
   (error "cannot represent ~S typed aliens" type))
 
-(def-alien-type-method (root :deposit-gen) (type sap offset value)
+(define-alien-type-method (root :deposit-gen) (type sap offset value)
   `(setf ,(invoke-alien-type-method :extract-gen type sap offset) ,value))
 
-(def-alien-type-method (root :arg-tn) (type state)
+(define-alien-type-method (root :arg-tn) (type state)
   (declare (ignore state))
   (error "Aliens of type ~S cannot be passed as arguments to CALL-OUT."
 	 (unparse-alien-type type)))
 
-(def-alien-type-method (root :result-tn) (type state)
+(define-alien-type-method (root :result-tn) (type state)
   (declare (ignore state))
   (error "Aliens of type ~S cannot be returned from CALL-OUT."
 	 (unparse-alien-type type)))
 
 ;;;; the INTEGER type
 
-(def-alien-type-class (integer)
+(define-alien-type-class (integer)
   (signed t :type (member t nil)))
 
-(def-alien-type-translator signed (&optional (bits sb!vm:word-bits))
+(define-alien-type-translator signed (&optional (bits sb!vm:n-word-bits))
   (make-alien-integer-type :bits bits))
 
-(def-alien-type-translator integer (&optional (bits sb!vm:word-bits))
+(define-alien-type-translator integer (&optional (bits sb!vm:n-word-bits))
   (make-alien-integer-type :bits bits))
 
-(def-alien-type-translator unsigned (&optional (bits sb!vm:word-bits))
+(define-alien-type-translator unsigned (&optional (bits sb!vm:n-word-bits))
   (make-alien-integer-type :bits bits :signed nil))
 
-(def-alien-type-method (integer :unparse) (type)
+(define-alien-type-method (integer :unparse) (type)
   (list (if (alien-integer-type-signed type) 'signed 'unsigned)
 	(alien-integer-type-bits type)))
 
-(def-alien-type-method (integer :type=) (type1 type2)
+(define-alien-type-method (integer :type=) (type1 type2)
   (and (eq (alien-integer-type-signed type1)
 	   (alien-integer-type-signed type2))
        (= (alien-integer-type-bits type1)
 	  (alien-integer-type-bits type2))))
 
-(def-alien-type-method (integer :lisp-rep) (type)
+(define-alien-type-method (integer :lisp-rep) (type)
   (list (if (alien-integer-type-signed type) 'signed-byte 'unsigned-byte)
 	(alien-integer-type-bits type)))
 
-(def-alien-type-method (integer :alien-rep) (type)
+(define-alien-type-method (integer :alien-rep) (type)
   (list (if (alien-integer-type-signed type) 'signed-byte 'unsigned-byte)
 	(alien-integer-type-bits type)))
 
-(def-alien-type-method (integer :naturalize-gen) (type alien)
+(define-alien-type-method (integer :naturalize-gen) (type alien)
   (declare (ignore type))
   alien)
 
-(def-alien-type-method (integer :deport-gen) (type value)
+(define-alien-type-method (integer :deport-gen) (type value)
   (declare (ignore type))
   value)
 
-(def-alien-type-method (integer :extract-gen) (type sap offset)
+(define-alien-type-method (integer :extract-gen) (type sap offset)
   (declare (type alien-integer-type type))
   (let ((ref-fun
 	 (if (alien-integer-type-signed type)
@@ -559,45 +565,45 @@
 	    (32 'sap-ref-32)
 	    #!+alpha (64 'sap-ref-64)))))
     (if ref-fun
-	`(,ref-fun ,sap (/ ,offset sb!vm:byte-bits))
-	(error "cannot extract ~D bit integers"
+	`(,ref-fun ,sap (/ ,offset sb!vm:n-byte-bits))
+	(error "cannot extract ~W-bit integers"
 	       (alien-integer-type-bits type)))))
 
 ;;;; the BOOLEAN type
 
-(def-alien-type-class (boolean :include integer :include-args (signed)))
+(define-alien-type-class (boolean :include integer :include-args (signed)))
 
 ;;; FIXME: Check to make sure that we aren't attaching user-readable
 ;;; stuff to CL:BOOLEAN in any way which impairs ANSI compliance.
-(def-alien-type-translator boolean (&optional (bits sb!vm:word-bits))
+(define-alien-type-translator boolean (&optional (bits sb!vm:n-word-bits))
   (make-alien-boolean-type :bits bits :signed nil))
 
-(def-alien-type-method (boolean :unparse) (type)
+(define-alien-type-method (boolean :unparse) (type)
   `(boolean ,(alien-boolean-type-bits type)))
 
-(def-alien-type-method (boolean :lisp-rep) (type)
+(define-alien-type-method (boolean :lisp-rep) (type)
   (declare (ignore type))
   `(member t nil))
 
-(def-alien-type-method (boolean :naturalize-gen) (type alien)
+(define-alien-type-method (boolean :naturalize-gen) (type alien)
   (declare (ignore type))
   `(not (zerop ,alien)))
 
-(def-alien-type-method (boolean :deport-gen) (type value)
+(define-alien-type-method (boolean :deport-gen) (type value)
   (declare (ignore type))
   `(if ,value 1 0))
 
 ;;;; the ENUM type
 
-(def-alien-type-class (enum :include (integer (:bits 32))
-			    :include-args (signed))
+(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
 
-(def-alien-type-translator enum (&whole
+(define-alien-type-translator enum (&whole
 				 type name
 				 &rest mappings
 				 &environment env)
@@ -669,122 +675,123 @@
        (t
 	(make-alien-enum-type :name name :signed signed
 			      :from from-alist
-			      :to (mapcar #'(lambda (x) (cons (cdr x) (car x)))
+			      :to (mapcar (lambda (x) (cons (cdr x) (car x)))
 					  from-alist)
 			      :kind :alist))))))
 
-(def-alien-type-method (enum :unparse) (type)
+(define-alien-type-method (enum :unparse) (type)
   `(enum ,(alien-enum-type-name type)
 	 ,@(let ((prev -1))
-	     (mapcar #'(lambda (mapping)
-			 (let ((sym (car mapping))
-			       (value (cdr mapping)))
-			   (prog1
-			       (if (= (1+ prev) value)
-				   sym
-				   `(,sym ,value))
-			     (setf prev value))))
+	     (mapcar (lambda (mapping)
+		       (let ((sym (car mapping))
+			     (value (cdr mapping)))
+			 (prog1
+			     (if (= (1+ prev) value)
+				 sym
+				 `(,sym ,value))
+			   (setf prev value))))
 		     (alien-enum-type-from type)))))
 
-(def-alien-type-method (enum :type=) (type1 type2)
+(define-alien-type-method (enum :type=) (type1 type2)
   (and (eq (alien-enum-type-name type1)
 	   (alien-enum-type-name type2))
        (equal (alien-enum-type-from type1)
 	      (alien-enum-type-from type2))))
 
-(def-alien-type-method (enum :lisp-rep) (type)
+(define-alien-type-method (enum :lisp-rep) (type)
   `(member ,@(mapcar #'car (alien-enum-type-from type))))
 
-(def-alien-type-method (enum :naturalize-gen) (type alien)
+(define-alien-type-method (enum :naturalize-gen) (type alien)
   (ecase (alien-enum-type-kind type)
     (:vector
      `(svref ',(alien-enum-type-to type)
 	     (+ ,alien ,(alien-enum-type-offset type))))
     (:alist
      `(ecase ,alien
-	,@(mapcar #'(lambda (mapping)
-		      `(,(car mapping) ,(cdr mapping)))
+	,@(mapcar (lambda (mapping)
+		    `(,(car mapping) ,(cdr mapping)))
 		  (alien-enum-type-to type))))))
 
-(def-alien-type-method (enum :deport-gen) (type value)
+(define-alien-type-method (enum :deport-gen) (type value)
   `(ecase ,value
-     ,@(mapcar #'(lambda (mapping)
-		   `(,(car mapping) ,(cdr mapping)))
+     ,@(mapcar (lambda (mapping)
+		 `(,(car mapping) ,(cdr mapping)))
 	       (alien-enum-type-from type))))
 
 ;;;; the FLOAT types
 
-(def-alien-type-class (float)
-  (type (required-argument) :type symbol))
+(define-alien-type-class (float)
+  (type (missing-arg) :type symbol))
 
-(def-alien-type-method (float :unparse) (type)
+(define-alien-type-method (float :unparse) (type)
   (alien-float-type-type type))
 
-(def-alien-type-method (float :lisp-rep) (type)
+(define-alien-type-method (float :lisp-rep) (type)
   (alien-float-type-type type))
 
-(def-alien-type-method (float :alien-rep) (type)
+(define-alien-type-method (float :alien-rep) (type)
   (alien-float-type-type type))
 
-(def-alien-type-method (float :naturalize-gen) (type alien)
+(define-alien-type-method (float :naturalize-gen) (type alien)
   (declare (ignore type))
   alien)
 
-(def-alien-type-method (float :deport-gen) (type value)
+(define-alien-type-method (float :deport-gen) (type value)
   (declare (ignore type))
   value)
 
-(def-alien-type-class (single-float :include (float (:bits 32))
-				    :include-args (type)))
+(define-alien-type-class (single-float :include (float (bits 32))
+				       :include-args (type)))
 
-(def-alien-type-translator single-float ()
+(define-alien-type-translator single-float ()
   (make-alien-single-float-type :type 'single-float))
 
-(def-alien-type-method (single-float :extract-gen) (type sap offset)
+(define-alien-type-method (single-float :extract-gen) (type sap offset)
   (declare (ignore type))
-  `(sap-ref-single ,sap (/ ,offset sb!vm:byte-bits)))
+  `(sap-ref-single ,sap (/ ,offset sb!vm:n-byte-bits)))
 
-(def-alien-type-class (double-float :include (float (:bits 64))
-				    :include-args (type)))
+(define-alien-type-class (double-float :include (float (bits 64))
+				       :include-args (type)))
 
-(def-alien-type-translator double-float ()
+(define-alien-type-translator double-float ()
   (make-alien-double-float-type :type 'double-float))
 
-(def-alien-type-method (double-float :extract-gen) (type sap offset)
+(define-alien-type-method (double-float :extract-gen) (type sap offset)
   (declare (ignore type))
-  `(sap-ref-double ,sap (/ ,offset sb!vm:byte-bits)))
+  `(sap-ref-double ,sap (/ ,offset sb!vm:n-byte-bits)))
 
 #!+long-float
-(def-alien-type-class (long-float :include (float (:bits #!+x86 96
-							  #!+sparc 128))
-				  :include-args (type)))
+(define-alien-type-class (long-float :include (float (bits #!+x86 96
+							   #!+sparc 128))
+				     :include-args (type)))
 
 #!+long-float
-(def-alien-type-translator long-float ()
+(define-alien-type-translator long-float ()
   (make-alien-long-float-type :type 'long-float))
 
 #!+long-float
-(def-alien-type-method (long-float :extract-gen) (type sap offset)
+(define-alien-type-method (long-float :extract-gen) (type sap offset)
   (declare (ignore type))
-  `(sap-ref-long ,sap (/ ,offset sb!vm:byte-bits)))
+  `(sap-ref-long ,sap (/ ,offset sb!vm:n-byte-bits)))
 
 ;;;; the POINTER type
 
-(def-alien-type-class (pointer :include (alien-value (:bits
-						      #!-alpha sb!vm:word-bits
-						      #!+alpha 64)))
+(define-alien-type-class (pointer :include (alien-value (bits
+							 #!-alpha
+							 sb!vm:n-word-bits
+							 #!+alpha 64)))
   (to nil :type (or alien-type null)))
 
-(def-alien-type-translator * (to &environment env)
+(define-alien-type-translator * (to &environment env)
   (make-alien-pointer-type :to (if (eq to t) nil (parse-alien-type to env))))
 
-(def-alien-type-method (pointer :unparse) (type)
+(define-alien-type-method (pointer :unparse) (type)
   (let ((to (alien-pointer-type-to type)))
     `(* ,(if to
 	     (%unparse-alien-type to)
 	     t))))
 
-(def-alien-type-method (pointer :type=) (type1 type2)
+(define-alien-type-method (pointer :type=) (type1 type2)
   (let ((to1 (alien-pointer-type-to type1))
 	(to2 (alien-pointer-type-to type2)))
     (if to1
@@ -793,7 +800,7 @@
 	    nil)
 	(null to2))))
 
-(def-alien-type-method (pointer :subtypep) (type1 type2)
+(define-alien-type-method (pointer :subtypep) (type1 type2)
   (and (alien-pointer-type-p type2)
        (let ((to1 (alien-pointer-type-to type1))
 	     (to2 (alien-pointer-type-to type2)))
@@ -803,7 +810,7 @@
 		 t)
 	     (null to2)))))
 
-(def-alien-type-method (pointer :deport-gen) (type value)
+(define-alien-type-method (pointer :deport-gen) (type value)
   (/noshow "doing alien type method POINTER :DEPORT-GEN" type value)
   (values
    ;; FIXME: old version, highlighted a bug in xc optimization
@@ -827,13 +834,13 @@
 
 ;;;; the MEM-BLOCK type
 
-(def-alien-type-class (mem-block :include alien-value))
+(define-alien-type-class (mem-block :include alien-value))
 
-(def-alien-type-method (mem-block :extract-gen) (type sap offset)
+(define-alien-type-method (mem-block :extract-gen) (type sap offset)
   (declare (ignore type))
-  `(sap+ ,sap (/ ,offset sb!vm:byte-bits)))
+  `(sap+ ,sap (/ ,offset sb!vm:n-byte-bits)))
 
-(def-alien-type-method (mem-block :deposit-gen) (type sap offset value)
+(define-alien-type-method (mem-block :deposit-gen) (type sap offset value)
   (let ((bits (alien-mem-block-type-bits type)))
     (unless bits
       (error "can't deposit aliens of type ~S (unknown size)" type))
@@ -841,29 +848,17 @@
 
 ;;;; the ARRAY type
 
-(def-alien-type-class (array :include mem-block)
-  (element-type (required-argument) :type alien-type)
-  (dimensions (required-argument) :type list))
-
-(def-alien-type-translator array (ele-type &rest dims &environment env)
+(define-alien-type-class (array :include mem-block)
+  (element-type (missing-arg) :type alien-type)
+  (dimensions (missing-arg) :type list))
 
-  ;; This declaration is a workaround for bug 119, which causes the
-  ;; EVERY #'INTEGERP expression below to be compiled incorrectly
-  ;; by the byte compiler. Since as of sbcl-0.pre7.x we are using
-  ;; the byte compiler to do all the tricky stuff for the 'interpreter',
-  ;; and since we use 'interpreted' definitions of these type translators
-  ;; at cross-compilation time, this means that cross-compilation
-  ;; doesn't work properly unless we force this function to be
-  ;; native compiled instead of byte-compiled.
-  ;;
-  ;; FIXME: So, when bug 119 is fixed, this declaration can go away.
-  (declare (optimize (speed 2))) ; i.e. not byte-compiled
+(define-alien-type-translator array (ele-type &rest dims &environment env)
 
   (when dims
     (unless (typep (first dims) '(or index null))
       (error "The first dimension is not a non-negative fixnum or NIL: ~S"
 	     (first dims)))
-    (let ((loser (find-if-not #'(lambda (x) (typep x 'index))
+    (let ((loser (find-if-not (lambda (x) (typep x 'index))
 			      (rest dims))))
       (when loser
 	(error "A dimension is not a non-negative fixnum: ~S" loser))))
@@ -879,17 +874,17 @@
 				(alien-type-alignment parsed-ele-type))
 		  (reduce #'* dims))))))
 
-(def-alien-type-method (array :unparse) (type)
+(define-alien-type-method (array :unparse) (type)
   `(array ,(%unparse-alien-type (alien-array-type-element-type type))
 	  ,@(alien-array-type-dimensions type)))
 
-(def-alien-type-method (array :type=) (type1 type2)
+(define-alien-type-method (array :type=) (type1 type2)
   (and (equal (alien-array-type-dimensions type1)
 	      (alien-array-type-dimensions type2))
        (alien-type-= (alien-array-type-element-type type1)
 		     (alien-array-type-element-type type2))))
 
-(def-alien-type-method (array :subtypep) (type1 type2)
+(define-alien-type-method (array :subtypep) (type1 type2)
   (and (alien-array-type-p type2)
        (let ((dim1 (alien-array-type-dimensions type1))
 	     (dim2 (alien-array-type-dimensions type2)))
@@ -905,8 +900,8 @@
 
 (def!struct (alien-record-field
 	     (:make-load-form-fun sb!kernel:just-dump-it-normally))
-  (name (required-argument) :type symbol)
-  (type (required-argument) :type alien-type)
+  (name (missing-arg) :type symbol)
+  (type (missing-arg) :type alien-type)
   (bits nil :type (or unsigned-byte null))
   (offset 0 :type unsigned-byte))
 (def!method print-object ((field alien-record-field) stream)
@@ -917,15 +912,15 @@
 	    (alien-record-field-name field)
 	    (alien-record-field-bits field))))
 
-(def-alien-type-class (record :include mem-block)
+(define-alien-type-class (record :include mem-block)
   (kind :struct :type (member :struct :union))
   (name nil :type (or symbol null))
   (fields nil :type list))
 
-(def-alien-type-translator struct (name &rest fields &environment env)
+(define-alien-type-translator struct (name &rest fields &environment env)
   (parse-alien-record-type :struct name fields env))
 
-(def-alien-type-translator union (name &rest fields &environment env)
+(define-alien-type-translator union (name &rest fields &environment env)
   (parse-alien-record-type :union name fields env))
 
 (defun parse-alien-record-type (kind name fields env)
@@ -998,7 +993,7 @@
     (setf (alien-record-type-bits result)
 	  (align-offset total-bits overall-alignment))))
 
-(def-alien-type-method (record :unparse) (type)
+(define-alien-type-method (record :unparse) (type)
   `(,(case (alien-record-type-kind type)
        (:struct 'struct)
        (:union 'union)
@@ -1006,11 +1001,11 @@
     ,(alien-record-type-name type)
     ,@(unless (member type *record-types-already-unparsed* :test #'eq)
 	(push type *record-types-already-unparsed*)
-	(mapcar #'(lambda (field)
-		    `(,(alien-record-field-name field)
-		      ,(%unparse-alien-type (alien-record-field-type field))
-		      ,@(if (alien-record-field-bits field)
-			    (list (alien-record-field-bits field)))))
+	(mapcar (lambda (field)
+		  `(,(alien-record-field-name field)
+		    ,(%unparse-alien-type (alien-record-field-type field))
+		    ,@(if (alien-record-field-bits field)
+			  (list (alien-record-field-bits field)))))
 		(alien-record-type-fields type)))))
 
 ;;; Test the record fields. The depth is limiting in case of cyclic
@@ -1065,7 +1060,7 @@
 		       (type-= field1 field2 (1+ depth))))
 	  (return nil))))))
 
-(def-alien-type-method (record :type=) (type1 type2)
+(define-alien-type-method (record :type=) (type1 type2)
   (and (eq (alien-record-type-name type1)
 	   (alien-record-type-name type2))
        (eq (alien-record-type-kind type1)
@@ -1075,41 +1070,48 @@
        (record-fields-match (alien-record-type-fields type1)
 			    (alien-record-type-fields type2) 0)))
 
-;;;; the FUNCTION and VALUES types
+;;;; the FUNCTION and VALUES alien types
 
+;;; not documented in CMU CL:-(
+;;;
+;;; reverse engineering observations:
+;;;   * seems to be set when translating return values
+;;;   * seems to enable the translation of (VALUES), which is the
+;;;     Lisp idiom for C's return type "void" (which is likely
+;;;     why it's set when when translating return values)
 (defvar *values-type-okay* nil)
 
-(def-alien-type-class (function :include mem-block)
-  (result-type (required-argument) :type alien-type)
-  (arg-types (required-argument) :type list)
+(define-alien-type-class (fun :include mem-block)
+  (result-type (missing-arg) :type alien-type)
+  (arg-types (missing-arg) :type list)
   (stub nil :type (or null function)))
 
-(def-alien-type-translator function (result-type &rest arg-types
-						 &environment env)
-  (make-alien-function-type
+(define-alien-type-translator function (result-type &rest arg-types
+						    &environment env)
+  (make-alien-fun-type
    :result-type (let ((*values-type-okay* t))
 		  (parse-alien-type result-type env))
    :arg-types (mapcar (lambda (arg-type) (parse-alien-type arg-type env))
 		      arg-types)))
 
-(def-alien-type-method (function :unparse) (type)
-  `(function ,(%unparse-alien-type (alien-function-type-result-type type))
+(define-alien-type-method (fun :unparse) (type)
+  `(function ,(%unparse-alien-type (alien-fun-type-result-type type))
 	     ,@(mapcar #'%unparse-alien-type
-		       (alien-function-type-arg-types type))))
+		       (alien-fun-type-arg-types type))))
 
-(def-alien-type-method (function :type=) (type1 type2)
-  (and (alien-type-= (alien-function-type-result-type type1)
-		     (alien-function-type-result-type type2))
-       (= (length (alien-function-type-arg-types type1))
-	  (length (alien-function-type-arg-types type2)))
+(define-alien-type-method (fun :type=) (type1 type2)
+  (and (alien-type-= (alien-fun-type-result-type type1)
+		     (alien-fun-type-result-type type2))
+       (= (length (alien-fun-type-arg-types type1))
+	  (length (alien-fun-type-arg-types type2)))
        (every #'alien-type-=
-	      (alien-function-type-arg-types type1)
-	      (alien-function-type-arg-types type2))))
+	      (alien-fun-type-arg-types type1)
+	      (alien-fun-type-arg-types type2))))
 
-(def-alien-type-class (values)
-  (values (required-argument) :type list))
+(define-alien-type-class (values)
+  (values (missing-arg) :type list))
 
-(def-alien-type-translator values (&rest values &environment env)
+(define-alien-type-translator values (&rest values &environment env)
   (unless *values-type-okay*
     (error "cannot use values types here"))
   (let ((*values-type-okay* nil))
@@ -1117,11 +1119,11 @@
      :values (mapcar (lambda (alien-type) (parse-alien-type alien-type env))
 		     values))))
 
-(def-alien-type-method (values :unparse) (type)
+(define-alien-type-method (values :unparse) (type)
   `(values ,@(mapcar #'%unparse-alien-type
 		     (alien-values-type-values type))))
 
-(def-alien-type-method (values :type=) (type1 type2)
+(define-alien-type-method (values :type=) (type1 type2)
   (and (= (length (alien-values-type-values type1))
 	  (length (alien-values-type-values type2)))
        (every #'alien-type-=
@@ -1137,13 +1139,15 @@
 (def!struct (local-alien-info
 	     (:make-load-form-fun sb!kernel:just-dump-it-normally)
 	     (:constructor make-local-alien-info
-			   (&key type force-to-memory-p)))
+			   (&key type force-to-memory-p
+			    &aux (force-to-memory-p (or force-to-memory-p
+							(alien-array-type-p type)
+							(alien-record-type-p type))))))
   ;; the type of the local alien
-  (type (required-argument) :type alien-type)
-  ;; T if this local alien must be forced into memory. Using the ADDR macro
+  (type (missing-arg) :type alien-type)
+  ;; Must this local alien be forced into memory? Using the ADDR macro
   ;; on a local alien will set this.
-  (force-to-memory-p (or (alien-array-type-p type) (alien-record-type-p type))
-		     :type (member t nil)))
+  (force-to-memory-p nil :type (member t nil)))
 (def!method print-object ((info local-alien-info) stream)
   (print-unreadable-object (info stream :type t)
     (format stream