[movitz-cvs] CVS update: movitz/image.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz
In directory common-lisp.net:/tmp/cvs-serv16225

Modified Files:
	image.lisp 
Log Message:
Fixed image-memref to work properly. Also, made errorp true by default.

Date: Thu Feb 12 06:30:21 2004
Author: ffjeld

Index: movitz/image.lisp
diff -u movitz/image.lisp:1.14 movitz/image.lisp:1.15
--- movitz/image.lisp:1.14	Wed Feb 11 11:22:38 2004
+++ movitz/image.lisp	Thu Feb 12 06:30:20 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Sun Oct 22 00:22:43 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: image.lisp,v 1.14 2004/02/11 16:22:38 ffjeld Exp $
+;;;; $Id: image.lisp,v 1.15 2004/02/12 11:30:20 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -542,11 +542,14 @@
 		    (image-cons-pointer image) (+ new-ptr size))
 	      new-ptr))))))
 
-(defmethod image-memref ((image symbolic-image) address &optional (errorp nil))
+(defmethod image-memref ((image symbolic-image) address &optional (errorp t))
   (let ((obj (gethash address (image-address-hash image) :nothing)))
-    (when (and errorp (not (typep obj 'movitz-object)))
-      (error "Found non-movitz-object at image-address #x~X: ~A" address obj))
-    obj))
+    (cond
+     ((not (typep obj 'movitz-object))
+      (when errorp
+	(error "Found non-movitz-object at image-address #x~X: ~A" address obj))
+      nil)
+     (t obj))))
 
 (defmethod search-image ((image symbolic-image) address)
   (loop for a downfrom (logand address -8) by 8
@@ -902,7 +905,7 @@
     (loop for p upfrom (- (image-start-address image) (image-ds-segment-base image)) by 8
 	until (>= p (image-cons-pointer image))
 	summing
-	  (let ((obj (image-memref image p)))
+	  (let ((obj (image-memref image p nil)))
 	    (cond
 	     ((not obj) 0)
 	     (t (let ((new-pos (+ p file-start-position