X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ffixup.lisp;h=2e98849674e6185bd33984fade7872b414509c8b;hb=0f3a5f2e8886d18d0b4f6485c38a42be629422ae;hp=a92188e2e9e2fee055abbdb48f6a9dac758bd073;hpb=cea4896b2482b7b2b429c1631d774b4cfbc0efba;p=sbcl.git

diff --git a/src/compiler/fixup.lisp b/src/compiler/fixup.lisp
index a92188e..2e98849 100644
--- a/src/compiler/fixup.lisp
+++ b/src/compiler/fixup.lisp
@@ -12,36 +12,30 @@
 
 (in-package "SB!C")
 
-;;; FIXUP -- A fixup of some kind.
+;;; a fixup of some kind
 (defstruct (fixup
-	    (:constructor make-fixup (name flavor &optional offset)))
-  ;; The name and flavor of the fixup. The assembler makes no assumptions
-  ;; about the contents of these fields; their semantics are imposed by the
-  ;; dumper.
+            (:constructor make-fixup (name flavor &optional offset))
+            (:copier nil))
+  ;; the name and flavor of the fixup. The assembler makes no
+  ;; assumptions about the contents of these fields; their semantics
+  ;; are imposed by the dumper.
   name
   flavor
-  ;; OFFSET is an optional offset from whatever external label this fixup
-  ;; refers to. Or in the case of the :CODE-OBJECT flavor of fixups on the :X86
-  ;; architecture, NAME is always NIL, so this fixup doesn't refer to an
-  ;; external label, and OFFSET is an offset from the beginning of the
-  ;; current code block.
+  ;; OFFSET is an optional offset from whatever external label this
+  ;; fixup refers to. Or in the case of the :CODE-OBJECT flavor of
+  ;; fixups on the :X86 architecture, NAME is always NIL, so this
+  ;; fixup doesn't refer to an external label, and OFFSET is an offset
+  ;; from the beginning of the current code block.
   offset)
 
-;;; were done with another flavor
+(defstruct (fixup-note
+             (:constructor make-fixup-note (kind fixup position))
+             (:copier nil))
+  kind
+  fixup
+  position)
 
-(def!method print-object ((fixup fixup) stream)
-  (print-unreadable-object (fixup stream :type t)
-    (format stream
-	    ":FLAVOR ~S :NAME ~S :OFFSET ~S"
-	    (fixup-flavor fixup)
-	    (fixup-name fixup)
-	    (fixup-offset fixup))))
-
-;;; 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*)
+(defvar *fixup-notes*)
 
 ;;; Setting this variable lets you see what's going on as items are
 ;;; being pushed onto *FIXUPS*.
@@ -51,15 +45,18 @@
 ;;; they find themselves trying to deal with a fixup.
 (defun note-fixup (segment kind fixup)
   (sb!assem:emit-back-patch segment
-			    0
-			    (lambda (segment posn)
-			      (declare (ignore segment))
-			      ;; Why use EMIT-BACK-PATCH to cause this PUSH to
-			      ;; be done later, instead of just doing it now?
-			      ;; I'm not sure. Perhaps there's some concern
-			      ;; that POSN isn't known accurately now? Perhaps
-			      ;; 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*)))
+                            0
+                            (lambda (segment posn)
+                              (declare (ignore segment))
+                              ;; Why use EMIT-BACK-PATCH to cause this PUSH to
+                              ;; be done later, instead of just doing it now?
+                              ;; I'm not sure. Perhaps there's some concern
+                              ;; that POSN isn't known accurately now? Perhaps
+                              ;; there's a desire for all fixing up to go
+                              ;; through EMIT-BACK-PATCH whether it needs to or
+                              ;; not? -- WHN 19990905
+                              #!+sb-show
+                              (when *show-fixups-being-pushed-p*
+                                (/show "PUSHING FIXUP" kind fixup posn))
+                              (push (make-fixup-note kind fixup posn) *fixup-notes*)))
   (values))