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(a)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 ,@args)
- (,accessor y ,@args))))
+ (,accessor y ,@args)
+ limit)))
(typecase x
(bignum
(= x y))
