diff --git a/code/alieneval.lisp b/code/alieneval.lisp
index a6d90f7aec3dcc1885c549ec70ca83dff2c01512..59314b009d615c903cdbc07197ff8224c77f6191 100644
--- a/code/alieneval.lisp
+++ b/code/alieneval.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.57 2003/05/19 16:13:58 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/alieneval.lisp,v 1.58 2004/05/06 13:19:53 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1129,67 +1129,55 @@
 			    (list (alien-record-field-bits field)))))
 		(alien-record-type-fields type)))))
 
-;;; Test the record fields. The depth is limiting in case of cyclic
-;;; pointers.
-(defun record-fields-match (fields1 fields2 depth)
-  (declare (type list fields1 fields2)
-	   (type (mod 64) depth))
-  (labels ((record-type-= (type1 type2 depth)
-	     (and (eq (alien-record-type-name type1)
-		      (alien-record-type-name type2))
-		  (eq (alien-record-type-kind type1)
-		      (alien-record-type-kind type2))
-		  (= (length (alien-record-type-fields type1))
-		     (length (alien-record-type-fields type2)))
-		  (record-fields-match (alien-record-type-fields type1)
-				       (alien-record-type-fields type2)
-				       (1+ depth))))
-	   (pointer-type-= (type1 type2 depth)
-	     (let ((to1 (alien-pointer-type-to type1))
-		   (to2 (alien-pointer-type-to type2)))
-	       (if to1
-		   (if to2
-		       (type-= to1 to2 (1+ depth))
-		       nil)
-		   (null to2))))
-	   (type-= (type1 type2 depth)
-	     (cond ((and (alien-pointer-type-p type1)
-			 (alien-pointer-type-p type2))
-		    (or (> depth 10)
-			(pointer-type-= type1 type2 depth)))
-		   ((and (alien-record-type-p type1)
-			 (alien-record-type-p type2))
-		    (record-type-= type1 type2 depth))
-		   (t
-		    (alien-type-= type1 type2)))))
-    (do ((fields1-rem fields1 (rest fields1-rem))
-	 (fields2-rem fields2 (rest fields2-rem)))
-	((or (eq fields1-rem fields2-rem)
-	     (endp fields1-rem) (endp fields2-rem))
-	 (eq fields1-rem fields2-rem))
-      (let ((field1 (first fields1-rem))
-	    (field2 (first fields2-rem)))
-	(declare (type alien-record-field field1 field2))
-	(unless (and (eq (alien-record-field-name field1)
-			 (alien-record-field-name field2))
-		     (eql (alien-record-field-bits field1)
-			  (alien-record-field-bits field2))
-		     (eql (alien-record-field-offset field1)
-			  (alien-record-field-offset field2))
-		     (let ((field1 (alien-record-field-type field1))
-			   (field2 (alien-record-field-type field2)))
-		       (type-= field1 field2 (1+ depth))))
-	  (return nil))))))
+
+;;; Test the record fields. Keep a hashtable table of already compared
+;;; types to detect cycles.
+
+(defun record-fields-match-p (field1 field2)
+  (and (eq (alien-record-field-name field1)
+	   (alien-record-field-name field2))
+       (eql (alien-record-field-bits field1)
+	    (alien-record-field-bits field2))
+       (eql (alien-record-field-offset field1)
+	    (alien-record-field-offset field2))
+       (alien-type-= (alien-record-field-type field1)
+		     (alien-record-field-type field2))))
+
+(defvar *match-history* nil
+  "A hashtable used to detect cycles while comparing record types.")
+
+(defun in-match-history-or (type1 type2 alternative)
+  "Test if TYPE1 and TYPE2 are in the *MATCH-HISTORY*.
+If so return true; otherwise call ALTERNATIVE."
+  (cond (*match-history*
+	 (let ((list (gethash type1 *match-history*)))
+	   (cond ((memq type2 list)
+		  t)
+		 (t 
+		  (setf (gethash type1 *match-history*) (cons type2 list))
+		  (funcall alternative)))))
+	(t
+	 (let ((*match-history* (make-hash-table :test #'eq)))
+	   (setf (gethash type1 *match-history*) (list type2))
+	   (funcall alternative)))))
 
 (def-alien-type-method (record :type=) (type1 type2)
-  (and (eq (alien-record-type-name type1)
+  (and (eq (alien-record-type-name type1) 
 	   (alien-record-type-name type2))
-       (eq (alien-record-type-kind type1)
+       (eq (alien-record-type-kind type1) 
 	   (alien-record-type-kind type2))
+       (eql (alien-type-bits type1) 
+	    (alien-type-bits type2))
+       (eql (alien-type-alignment type1) 
+	    (alien-type-alignment type2))
        (= (length (alien-record-type-fields type1))
 	  (length (alien-record-type-fields type2)))
-       (record-fields-match (alien-record-type-fields type1)
-			    (alien-record-type-fields type2) 0)))
+       (in-match-history-or 
+	type1 type2
+	(lambda ()
+	  (every #'record-fields-match-p 
+		 (alien-record-type-fields type1)
+		 (alien-record-type-fields type2))))))
 
 
 ;;;; The FUNCTION and VALUES types.