Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1:/tmp/cvs-serv5449/src/compiler

Modified Files:
	codegen.lisp dump.lisp early-c.lisp fixup.lisp main.lisp 
Log Message:
0.8.6.42:
	Nikodemus Siivola patchery
	... fix FIXME for obscurity of *fixup* structure
	... fix compile with FSHOW defined


Index: codegen.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/codegen.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- codegen.lisp	6 Oct 2001 22:31:21 -0000	1.6
+++ codegen.lisp	20 Dec 2003 12:08:10 -0000	1.7
@@ -123,7 +123,7 @@
 	(*trace-table-info* nil)
 	(*prev-segment* nil)
 	(*prev-vop* nil)
-	(*fixups* nil))
+	(*fixup-notes* nil))
     (let ((label (sb!assem:gen-label)))
       (setf *elsewhere-label* label)
       (sb!assem:assemble (*elsewhere*)
@@ -153,7 +153,7 @@
     (setf *elsewhere* nil)
     (values (sb!assem:finalize-segment *code-segment*)
 	    (nreverse *trace-table-info*)
-	    *fixups*)))
+	    *fixup-notes*)))
 
 (defun emit-label-elsewhere (label)
   (sb!assem:assemble (*elsewhere*)

Index: dump.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/dump.lisp,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -d -r1.39 -r1.40
--- dump.lisp	5 Aug 2003 14:11:39 -0000	1.39
+++ dump.lisp	20 Dec 2003 12:08:10 -0000	1.40
@@ -967,27 +967,18 @@
 ;;;  - code object references: don't need a name.
 (defun dump-fixups (fixups fasl-output)
   (declare (list fixups) (type fasl-output fasl-output))
-  (dolist (info fixups)
-    ;; FIXME: Packing data with LIST in NOTE-FIXUP and unpacking them
-    ;; with FIRST, SECOND, and THIRD here is hard to follow and
-    ;; maintain. Perhaps we could define a FIXUP-INFO structure to use
-    ;; instead, and rename *FIXUPS* to *FIXUP-INFO-LIST*?
-    (let* ((kind (first info))
-	   (fixup (second info))
+  (dolist (note fixups)
+    (let* ((kind (fixup-note-kind note))
+	   (fixup (fixup-note-fixup note))
+	   (position (fixup-note-position note))
 	   (name (fixup-name fixup))
-	   (flavor (fixup-flavor fixup))
-	   (offset (third info)))
-      ;; FIXME: This OFFSET is not what's called OFFSET in the FIXUP
-      ;; structure, it's what's called POSN in NOTE-FIXUP. (As far as
-      ;; I can tell, FIXUP-OFFSET is not actually an offset, it's an
-      ;; internal label used instead of NAME for :CODE-OBJECT fixups.
-      ;; Notice that in the :CODE-OBJECT case, NAME is ignored.)
+	   (flavor (fixup-flavor fixup)))
       (dump-fop 'fop-normal-load fasl-output)
       (let ((*cold-load-dump* t))
 	(dump-object kind fasl-output))
       (dump-fop 'fop-maybe-cold-load fasl-output)
       ;; Depending on the flavor, we may have various kinds of
-      ;; noise before the offset.
+      ;; noise before the position.
       (ecase flavor
 	(:assembly-routine
 	 (aver (symbolp name))
@@ -1007,8 +998,8 @@
 	(:code-object
 	 (aver (null name))
 	 (dump-fop 'fop-code-object-fixup fasl-output)))
-      ;; No matter what the flavor, we'll always dump the offset.
-      (dump-unsigned-32 offset fasl-output)))
+      ;; No matter what the flavor, we'll always dump the position
+      (dump-unsigned-32 position fasl-output)))
   (values))
 
 ;;; Dump out the constant pool and code-vector for component, push the

Index: early-c.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/early-c.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- early-c.lisp	12 Jun 2003 06:41:13 -0000	1.25
+++ early-c.lisp	20 Dec 2003 12:08:10 -0000	1.26
@@ -107,7 +107,7 @@
 (defvar *event-info*)
 (defvar *event-note-threshold*)
 (defvar *failure-p*)
-(defvar *fixups*)
+(defvar *fixup-notes*)
 (defvar *in-pack*)
 (defvar *info-environment*)
 (defvar *lexenv*)

Index: fixup.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/fixup.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- fixup.lisp	2 Mar 2001 23:48:33 -0000	1.3
+++ fixup.lisp	20 Dec 2003 12:08:10 -0000	1.4
@@ -28,11 +28,14 @@
   ;; from the beginning of the current code block.
   offset)
 
-;;; KLUDGE: Despite its name, this is not a list of FIXUP objects, but rather a
-;;; list of `(,KIND ,FIXUP ,POSN). Perhaps this non-mnemonicity could be
-;;; reduced by naming what's currently a FIXUP structure a FIXUP-REQUEST, and
-;;; then renaming *FIXUPS* to *NOTED-FIXUPS*.-- WHN 19990905
-(defvar *fixups*)
+(defstruct (fixup-note
+	     (:constructor make-fixup-note (kind fixup position))
+	     (:copier nil))
+  kind
+  fixup
+  position)
+
+(defvar *fixup-notes*)
 
 ;;; Setting this variable lets you see what's going on as items are
 ;;; being pushed onto *FIXUPS*.
@@ -52,5 +55,8 @@
 			      ;; there's a desire for all fixing up to go
 			      ;; through EMIT-BACK-PATCH whether it needs to or
 			      ;; not? -- WHN 19990905
-			      (push (list kind fixup posn) *fixups*)))
+			      #!+sb-show
+			      (when *show-fixups-being-pushed-p*
+				(/show "PUSHING FIXUP" kind fixup posn))
+			      (push (make-fixup-note kind fixup posn) *fixup-notes*)))
   (values))

Index: main.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/main.lisp,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -d -r1.82 -r1.83
--- main.lisp	16 Sep 2003 07:45:10 -0000	1.82
+++ main.lisp	20 Dec 2003 12:08:10 -0000	1.83
@@ -442,7 +442,7 @@
 	    (describe-ir2-component component *compiler-trace-output*))
 
 	  (maybe-mumble "code ")
-	  (multiple-value-bind (code-length trace-table fixups)
+	  (multiple-value-bind (code-length trace-table fixup-notes)
 	      (generate-code component)
 
             #-sb-xc-host
@@ -459,7 +459,7 @@
 				    *code-segment*
 				    code-length
 				    trace-table
-				    fixups
+				    fixup-notes
 				    *compile-object*))
 	      (core-object
 	       (maybe-mumble "core")
@@ -467,7 +467,7 @@
 				    *code-segment*
 				    code-length
 				    trace-table
-				    fixups
+				    fixup-notes
 				    *compile-object*))
 	      (null))))))