[Sbcl-commits] CVS: sbcl/src/compiler dump.lisp,1.53,1.54 ir1tran.lisp,1.137,1.138

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18172/src/compiler

Modified Files:
	dump.lisp ir1tran.lisp 
Log Message:
0.9.1.38:
	Merge DFL raw-slots patch (sbcl-devel "raw slot changes" 
	2005-05-18)
	... with an amalgam of ths' two mips versions;
	... note in OPTIMIZATIONS about the negative index idea, and the
		disabledness of HPPA


Index: dump.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/dump.lisp,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -d -r1.53 -r1.54
--- dump.lisp	29 Apr 2005 14:37:38 -0000	1.53
+++ dump.lisp	12 Jun 2005 14:02:41 -0000	1.54
@@ -1315,14 +1315,20 @@
       (error "attempt to dump invalid structure:~%  ~S~%How did this happen?"
 	     struct)))
   (note-potential-circularity struct file)
-  (do ((index 0 (1+ index))
-       (length (%instance-length struct))
-       (circ (fasl-output-circularity-table file)))
-      ((= index length)
+  (aver (%instance-ref struct 0))
+  (do* ((length (%instance-length struct))
+	(ntagged (- length (layout-n-untagged-slots (%instance-ref struct 0))))
+	(circ (fasl-output-circularity-table file))
+	;; last slot first on the stack, so that the layout is on top:
+	(index (1- length) (1- index)))
+      ((minusp index)
        (dump-fop* length fop-small-struct fop-struct file))
-    (let* ((obj (%instance-ref struct index))
+    (let* ((obj (if (>= index ntagged)
+		    (%raw-instance-ref/word struct (- length index 1))
+		    (%instance-ref struct index)))
 	   (ref (gethash obj circ)))
       (cond (ref
+	     (aver (not (zerop index)))
 	     (push (make-circularity :type :struct-set
 				     :object struct
 				     :index index
@@ -1347,4 +1353,5 @@
   (sub-dump-object (layout-inherits obj) file)
   (sub-dump-object (layout-depthoid obj) file)
   (sub-dump-object (layout-length obj) file)
+  (sub-dump-object (layout-n-untagged-slots obj) file)
   (dump-fop 'fop-layout file))

Index: ir1tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran.lisp,v
retrieving revision 1.137
retrieving revision 1.138
diff -u -d -r1.137 -r1.138
--- ir1tran.lisp	29 Apr 2005 14:37:39 -0000	1.137
+++ ir1tran.lisp	12 Jun 2005 14:02:41 -0000	1.138
@@ -288,7 +288,10 @@
 		    #+sb-xc-host structure!object
 		    #-sb-xc-host instance
 		    (when (emit-make-load-form value)
-		      (dotimes (i (%instance-length value))
+		      (dotimes (i (- (%instance-length value)
+				     #+sb-xc-host 0
+				     #-sb-xc-host (layout-n-untagged-slots
+						   (%instance-ref value 0))))
 			(grovel (%instance-ref value i)))))
 		   (t
 		    (compiler-error