diff --git a/code/alieneval.lisp b/code/alieneval.lisp
index 9587d2d0fe1a403d2af91ec327f04c4534a76599..260e2f82f47cc1a74f8c53432d9e064ad463cd9f 100644
--- a/code/alieneval.lisp
+++ b/code/alieneval.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.19 1992/02/28 15:12:20 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.20 1992/03/04 09:05:53 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -221,19 +221,19 @@
 
 ;;;; Type parsing and unparsing.
 
+(defvar *auxiliary-type-definitions* nil)
+(defvar *new-auxiliary-types*)
 
-(defvar *additional-type-definitions*)
-
-(defmacro with-additional-alien-types ((symbol) &body body)
-  `(let ((*additional-type-definitions*
-	  (if (boundp '*additional-type-definitions*)
-	      *additional-type-definitions*
-	      nil)))
-     (symbol-macrolet ((,symbol *additional-type-definitions*))
-       ,@body)))
-
-(defmacro locally-introduce-additional-types ((additional-types) &body body)
-  `(compiler-let ((*additional-type-definitions* ',additional-types))
+;;; WITH-AUXILIARY-ALIEN-TYPES -- internal.
+;;;
+;;; Process stuff in a new scope.
+;;;
+(defmacro with-auxiliary-alien-types (&body body)
+  `(let ((*auxiliary-type-definitions*
+	  (if (boundp '*new-auxiliary-types*)
+	      (append *new-auxiliary-types* *auxiliary-type-definitions*)
+	      *auxiliary-type-definitions*))
+	 (*new-auxiliary-types* nil))
      ,@body))
 
 ;;; PARSE-ALIEN-TYPE -- public
@@ -241,9 +241,9 @@
 (defun parse-alien-type (type)
   "Parse the list structure TYPE as an alien type specifier and return
    the resultant alien-type structure."
-  (if (boundp '*additional-type-definitions*)
+  (if (boundp '*new-auxiliary-types*)
       (%parse-alien-type type)
-      (let ((*additional-type-definitions* nil))
+      (let ((*new-auxiliary-types* nil))
 	(%parse-alien-type type))))
 
 (defun %parse-alien-type (type)
@@ -265,27 +265,45 @@
 	 (error "Unknown alien type: ~S" type)))))
 
 (defun auxiliary-alien-type (kind name)
-  (let ((in-additionals (find-if #'(lambda (x)
-				     (and (eq (first x) kind)
-					  (eq (second x) name)))
-				 *additional-type-definitions*)))
-    (if in-additionals
-	(values (third in-additionals) t)
-	(ecase kind
-	  (:struct
-	   (info alien-type struct name))
-	  (:union
-	   (info alien-type union name))
-	  (:enum
-	   (info alien-type enum name))))))
+  (flet ((aux-defn-matches (x)
+	   (and (eq (first x) kind) (eq (second x) name))))
+    (let ((in-auxiliaries
+	   (or (find-if #'aux-defn-matches *new-auxiliary-types*)
+	       (find-if #'aux-defn-matches *auxiliary-type-definitions*))))
+      (if in-auxiliaries
+	  (values (third in-auxiliaries) t)
+	  (ecase kind
+	    (:struct
+	     (info alien-type struct name))
+	    (:union
+	     (info alien-type union name))
+	    (:enum
+	     (info alien-type enum name)))))))
 
 (defun %set-auxiliary-alien-type (kind name defn)
-  (push (list kind name defn)
-	*additional-type-definitions*)
+  (flet ((aux-defn-matches (x)
+	   (and (eq (first x) kind) (eq (second x) name))))
+    (when (find-if #'aux-defn-matches *new-auxiliary-types*)
+      (error "Attempt to multiple define ~A ~S." kind name))
+    (when (find-if #'aux-defn-matches *auxiliary-type-definitions*)
+      (error "Attempt to shadow definition of ~A ~S." kind name)))
+  (push (list kind name defn) *new-auxiliary-types*)
   defn)
 
 (defsetf auxiliary-alien-type %set-auxiliary-alien-type)
 
+(defun verify-local-auxiliaries-okay ()
+  (dolist (info *new-auxiliary-types*)
+    (destructuring-bind (kind name defn) info
+      (declare (ignore defn))
+      (when (ecase kind
+	      (:struct
+	       (info alien-type struct name))
+	      (:union
+	       (info alien-type union name))
+	      (:enum
+	       (info alien-type enum name)))
+	(error "Attempt to shadow definition of ~A ~S." kind name)))))
 
 ;;; *record-type-already-unparsed* -- internal
 ;;;
@@ -346,24 +364,27 @@
 
 (defmacro def-alien-type (name type)
   "Define the alien type NAME to be equivalent to TYPE."
-  (with-additional-alien-types (additional-types)
+  (with-auxiliary-alien-types
     (let ((alien-type (parse-alien-type type)))
       `(eval-when (compile load eval)
-	 ,@(when additional-types
-	     `((%def-additional-alien-types ',additional-types)))
+	 ,@(when *new-auxiliary-types*
+	     `((%def-auxiliary-alien-types ',*new-auxiliary-types*)))
 	 ,@(when name
 	     `((%def-alien-type ',name ',alien-type)))))))
 
-(defun %def-additional-alien-types (types)
+(defun %def-auxiliary-alien-types (types)
   (dolist (info types)
     (destructuring-bind (kind name defn) info
-      (ecase kind
-	(:struct
-	 (setf (info alien-type struct name) defn))
-	(:union
-	 (setf (info alien-type union name) defn))
-	(:enum
-	 (setf (info alien-type enum name) defn))))))
+      (macrolet ((frob (kind)
+		   `(let ((old (info alien-type ,kind name)))
+		      (unless (or (null old) (alien-type-= old defn))
+			(warn "Redefining ~A ~S to be:~%  ~S,~%was:~%  ~S"
+			      kind name defn old))
+		      (setf (info alien-type ,kind name) defn))))
+	(ecase kind
+	  (:struct (frob struct))
+	  (:union (frob union))
+	  (:enum (frob enum)))))))
 
 (defun %def-alien-type (name new)
   (ecase (info alien-type kind name)
@@ -929,15 +950,21 @@
   (parse-alien-record-type :union name fields))
 
 (defun parse-alien-record-type (kind name fields)
-  (let ((result
-	 (if name
-	     (or (auxiliary-alien-type kind name)
-		 (setf (auxiliary-alien-type kind name)
-		       (make-alien-record-type :name name :kind kind)))
-	     (make-alien-record-type :kind kind))))
-    (when fields
-      (parse-alien-record-fields result fields))
-    result))
+  (if fields
+      (let* ((old (and name (auxiliary-alien-type kind name)))
+	     (result (if (or (null old)
+			     (alien-record-type-fields old))
+			 (make-alien-record-type :name name :kind kind)
+			 old)))
+	(when (and name (not (eq old result)))
+	  (setf (auxiliary-alien-type kind name) result))
+	(parse-alien-record-fields result fields)
+	result)
+      (if name
+	  (or (auxiliary-alien-type kind name)
+	      (setf (auxiliary-alien-type kind name)
+		    (make-alien-record-type :name name :kind kind)))
+	  (make-alien-record-type :kind kind))))
 
 ;;; PARSE-ALIEN-RECORD-FIELDS -- internal
 ;;;
@@ -976,8 +1003,7 @@
 	    (:union
 	     (setf total-bits (max total-bits bits)))))))
     (let ((new (nreverse parsed-fields)))
-      (unless (record-fields-match (alien-record-type-fields result) new)
-	(setf (alien-record-type-fields result) new)))
+      (setf (alien-record-type-fields result) new))
     (setf (alien-record-type-alignment result) overall-alignment)
     (setf (alien-record-type-bits result)
 	  (align-offset total-bits overall-alignment))))
@@ -1172,11 +1198,11 @@
   (multiple-value-bind
       (lisp-name alien-name)
       (pick-lisp-and-alien-names name)
-    (with-additional-alien-types (additional-types)
+    (with-auxiliary-alien-types
       (let ((alien-type (parse-alien-type type)))
 	`(eval-when (compile load eval)
-	   ,@(when additional-types
-	       `((%def-additional-alien-types ',additional-types)))
+	   ,@(when *new-auxiliary-types*
+	       `((%def-auxiliary-alien-types ',*new-auxiliary-types*)))
 	   (%def-alien-variable ',lisp-name
 				',alien-name
 				',alien-type))))))
@@ -1221,7 +1247,7 @@
      :EXTERN
        No alien is allocated, but VAR is established as a local name for
        the external alien given by EXTERNAL-NAME."
-  (with-additional-alien-types (additional-types)
+  (with-auxiliary-alien-types
     (dolist (binding (reverse bindings))
       (destructuring-bind
 	  (symbol type &optional (opt1 nil opt1p) (opt2 nil opt2p))
@@ -1258,25 +1284,28 @@
 				  :sap-form `(foreign-symbol-address
 					      ',initial-value))))
 		       `((symbol-macrolet
-			     ((,symbol (%heap-alien ',info)))
-			   ,@body))))
+			  ((,symbol (%heap-alien ',info)))
+			  ,@body))))
 		    (:local
 		     (let ((var (gensym))
 			   (initval (if initial-value (gensym)))
 			   (info (make-local-alien-info
-				  :type (parse-alien-type type))))
+				  :type alien-type)))
 		       `((let ((,var (make-local-alien ',info))
 			       ,@(when initial-value
 				   `((,initval ,initial-value))))
 			   (note-local-alien-type ',info ,var)
 			   (multiple-value-prog1
 			       (symbol-macrolet
-				   ((,symbol (local-alien ',info ,var)))
-				 ,@(when initial-value
-				     `((setq ,symbol ,initval)))
-				 ,@body)
+				((,symbol (local-alien ',info ,var)))
+				,@(when initial-value
+				    `((setq ,symbol ,initval)))
+				,@body)
 			     (dispose-local-alien ',info ,var))))))))))))
-    `(locally-introduce-additional-types (,additional-types)
+    (verify-local-auxiliaries-okay)
+    `(compiler-let (*auxiliary-type-definitions*
+		    ',(append *new-auxiliary-types*
+			      *auxiliary-type-definitions*))
        ,@body)))
 
 
@@ -1394,7 +1423,8 @@
 ;;; 
 (defun slot (alien slot)
   (declare (type alien-value alien)
-	   (type symbol slot))
+	   (type symbol slot)
+	   (optimize (inhibit-warnings 3)))
   (let ((type (alien-value-type alien)))
     (etypecase type
       (alien-pointer-type
@@ -1413,7 +1443,8 @@
 ;;; 
 (defun %set-slot (alien slot value)
   (declare (type alien-value alien)
-	   (type symbol slot))
+	   (type symbol slot)
+	   (optimize (inhibit-warnings 3)))
   (let ((type (alien-value-type alien)))
     (etypecase type
       (alien-pointer-type
@@ -1433,7 +1464,8 @@
 ;;; 
 (defun %slot-addr (alien slot)
   (declare (type alien-value alien)
-	   (type symbol slot))
+	   (type symbol slot)
+	   (optimize (inhibit-warnings 3)))
   (let ((type (alien-value-type alien)))
     (etypecase type
       (alien-pointer-type
@@ -1496,7 +1528,8 @@
 ;;; 
 (defun deref (alien &rest indices)
   (declare (type alien-value alien)
-	   (type list indices))
+	   (type list indices)
+	   (optimize (inhibit-warnings 3)))
   (multiple-value-bind
       (target-type offset)
       (deref-guts alien indices)
@@ -1508,7 +1541,8 @@
 ;;; 
 (defun %set-deref (alien value &rest indices)
   (declare (type alien-value alien)
-	   (type list indices))
+	   (type list indices)
+	   (optimize (inhibit-warnings 3)))
   (multiple-value-bind
       (target-type offset)
       (deref-guts alien indices)
@@ -1524,7 +1558,8 @@
 ;;;
 (defun %deref-addr (alien &rest indices)
   (declare (type alien-value alien)
-	   (type list indices))
+	   (type list indices)
+	   (optimize (inhibit-warnings 3)))
   (multiple-value-bind
       (target-type offset)
       (deref-guts alien indices)
@@ -1535,13 +1570,15 @@
 ;;;; Accessing heap alien variables.
 
 (defun %heap-alien (info)
-  (declare (type heap-alien-info info))
+  (declare (type heap-alien-info info)
+	   (optimize (inhibit-warnings 3)))
   (extract-alien-value (eval (heap-alien-info-sap-form info))
 		       0
 		       (heap-alien-info-type info)))
 
 (defun %set-heap-alien (info value)
-  (declare (type heap-alien-info info))
+  (declare (type heap-alien-info info)
+	   (optimize (inhibit-warnings 3)))
   (deposit-alien-value (eval (heap-alien-info-sap-form info))
 		       0
 		       (heap-alien-info-type info)
@@ -1550,7 +1587,8 @@
 (defsetf %heap-alien %set-heap-alien)
 
 (defun %heap-alien-addr (info)
-  (declare (type heap-alien-info info))
+  (declare (type heap-alien-info info)
+	   (optimize (inhibit-warnings 3)))
   (%sap-alien (eval (heap-alien-info-sap-form info))
 	      (make-alien-pointer-type :to (heap-alien-info-type info))))
 
@@ -1647,7 +1685,9 @@
   `(%cast ,alien ',(parse-alien-type type)))
 
 (defun %cast (alien target-type)
-  (declare (type alien-value alien) (type alien-type target-type))
+  (declare (type alien-value alien)
+	   (type alien-type target-type)
+	   (optimize (inhibit-warnings 3)))
   (if (or (alien-pointer-type-p target-type)
 	  (alien-array-type-p target-type)
 	  (alien-function-type-p target-type))