X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Ffixup.lisp;h=1a5e064482e7db04b116265986ba28c809a9be24;hb=dc33d6a6b84f8338e603759cec8e25da29055d50;hp=d789bbf96459ba02dbf928632113dc61ad3bf025;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/compiler/fixup.lisp b/src/compiler/fixup.lisp index d789bbf..1a5e064 100644 --- a/src/compiler/fixup.lisp +++ b/src/compiler/fixup.lisp @@ -12,39 +12,30 @@ (in-package "SB!C") -(file-comment - "$Header$") - -;;; 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 - -(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)))) +(defstruct (fixup-note + (:constructor make-fixup-note (kind fixup position)) + (:copier nil)) + kind + fixup + position) -;;; 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*. @@ -64,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))