src/compiler/fixup.lisp

   1 ;;;; fixups, extracted from codegen.lisp by WHN 19990227 in order
   2 ;;;; to help with cross-compiling bootstrapping
   3
   4 ;;;; This software is part of the SBCL system. See the README file for
   5 ;;;; more information.
   6 ;;;;
   7 ;;;; This software is derived from the CMU CL system, which was
   8 ;;;; written at Carnegie Mellon University and released into the
   9 ;;;; public domain. The software is in the public domain and is
  10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  11 ;;;; files for more information.
  12
  13 (in-package "SB!C")
  14
  15 ;;; FIXUP -- A fixup of some kind.
  16 (defstruct (fixup
  17             (:constructor make-fixup (name flavor &optional offset)))
  18   ;; The name and flavor of the fixup. The assembler makes no assumptions
  19   ;; about the contents of these fields; their semantics are imposed by the
  20   ;; dumper.
  21   name
  22   flavor
  23   ;; OFFSET is an optional offset from whatever external label this fixup
  24   ;; refers to. Or in the case of the :CODE-OBJECT flavor of fixups on the :X86
  25   ;; architecture, NAME is always NIL, so this fixup doesn't refer to an
  26   ;; external label, and OFFSET is an offset from the beginning of the
  27   ;; current code block.
  28   offset)
  29
  30 ;;; were done with another flavor
  31
  32 (def!method print-object ((fixup fixup) stream)
  33   (print-unreadable-object (fixup stream :type t)
  34     (format stream
  35             ":FLAVOR ~S :NAME ~S :OFFSET ~S"
  36             (fixup-flavor fixup)
  37             (fixup-name fixup)
  38             (fixup-offset fixup))))
  39
  40 ;;; KLUDGE: Despite its name, this is not a list of FIXUP objects, but rather a
  41 ;;; list of `(,KIND ,FIXUP ,POSN). Perhaps this non-mnemonicity could be
  42 ;;; reduced by naming what's currently a FIXUP structure a FIXUP-REQUEST, and
  43 ;;; then renaming *FIXUPS* to *NOTED-FIXUPS*.-- WHN 19990905
  44 (defvar *fixups*)
  45
  46 ;;; Setting this variable lets you see what's going on as items are
  47 ;;; being pushed onto *FIXUPS*.
  48 #!+sb-show (defvar *show-fixups-being-pushed-p* nil)
  49
  50 ;;; This function is called by assembler instruction emitters when
  51 ;;; they find themselves trying to deal with a fixup.
  52 (defun note-fixup (segment kind fixup)
  53   (sb!assem:emit-back-patch segment
  54                             0
  55                             (lambda (segment posn)
  56                               (declare (ignore segment))
  57                               ;; Why use EMIT-BACK-PATCH to cause this PUSH to
  58                               ;; be done later, instead of just doing it now?
  59                               ;; I'm not sure. Perhaps there's some concern
  60                               ;; that POSN isn't known accurately now? Perhaps
  61                               ;; there's a desire for all fixing up to go
  62                               ;; through EMIT-BACK-PATCH whether it needs to or
  63                               ;; not? -- WHN 19990905
  64                               (push (list kind fixup posn) *fixups*)))
  65   (values))