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@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))