[movitz-cvs] CVS movitz/losp/muerte

[ffjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv26392

Modified Files:
	inspect.lisp 
Log Message:
Add a recursion limit to objects-equalp.


--- /project/movitz/cvsroot/movitz/losp/muerte/inspect.lisp	2007/03/16 19:50:47	1.58
+++ /project/movitz/cvsroot/movitz/losp/muerte/inspect.lisp	2007/04/07 08:01:41	1.59
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Oct 24 09:50:41 2003
 ;;;;                
-;;;; $Id: inspect.lisp,v 1.58 2007/03/16 19:50:47 ffjeld Exp $
+;;;; $Id: inspect.lisp,v 1.59 2007/04/07 08:01:41 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -268,22 +268,24 @@
     (run-time-context
      (%shallow-copy-object old (movitz-type-word-size 'movitz-run-time-context)))))
 
-(defun objects-equalp (x y)
+(defun objects-equalp (x y &optional (limit 20))
   "Basically, this verifies whether x is a shallow-copy of y, or vice versa."
   (assert (not (with-inline-assembly (:returns :boolean-zf=1)
 		 (:load-lexical (:lexical-binding x) :eax)
 		 (:cmpl #x13 :eax)))
       (x) "Checking illegal ~S for object-equalp." x)
-  (or (eql x y)
+  (or (= 0 (decf limit))
+      (eql x y)
       (cond
-       ((not (objects-equalp (class-of x) (class-of y)))
+       ((not (objects-equalp (class-of x) (class-of y) limit))
 	nil)
        ((not (and (typep x 'pointer)
 		  (typep y 'pointer)))
 	nil)
        (t (macrolet ((test (accessor &rest args)
 		       `(objects-equalp (,accessor x , at args)
-					(,accessor y , at args))))
+					(,accessor y , at args)
+                                        limit)))
 	    (typecase x
 	      (bignum
 	       (= x y))