0.8.6.42:

	Nikodemus Siivola patchery
	... fix FIXME for obscurity of *fixup* structure
	... fix compile with FSHOW defined

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index c8fac48..0e35b09 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -234,7 +234,11 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
               "DEFTRANSFORM" "DERIVE-TYPE"
               "ENTRY-NODE-INFO-NLX-TAG" "ENTRY-NODE-INFO-ST-TOP"
               "PHYSENV-DEBUG-LIVE-TN" "PHYSENV-LIVE-TN"
-              "FAST-SYMBOL-VALUE" "FOLDABLE"
+              "FAST-SYMBOL-VALUE" 
+              "FIXUP-NOTE-KIND"
+              "FIXUP-NOTE-FIXUP"
+              "FIXUP-NOTE-POSITION"
+              "FOLDABLE"
               "FORCE-TN-TO-STACK"
              "FUN-INFO-DERIVE-TYPE" "FUN-INFO-IR2-CONVERT"
              "FUN-INFO-LTN-ANNOTATE" "FUN-INFO-OPTIMIZER"
@@ -249,6 +253,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
              "LOCATION=" "LTN-ANNOTATE"
               "MAKE-ALIAS-TN" "MAKE-CATCH-BLOCK"
               "MAKE-CLOSURE" "MAKE-CONSTANT-TN" "MAKE-FIXNUM"
+              "MAKE-FIXUP-NOTE"
               "MAKE-LOAD-TIME-CONSTANT-TN" "MAKE-N-TNS" "MAKE-NORMAL-TN"
               "MAKE-OTHER-IMMEDIATE-TYPE" "MAKE-RANDOM-TN"
               "MAKE-REPRESENTATION-TN" "MAKE-RESTRICTED-TN" "MAKE-SC-OFFSET"

diff --git a/src/assembly/assemfile.lisp b/src/assembly/assemfile.lisp
index dd2cabf..191df4e 100644 (file)
--- a/src/assembly/assemfile.lisp
+++ b/src/assembly/assemfile.lisp
@@ -40,7 +40,7 @@
         (*code-segment* nil)
         (*elsewhere* nil)
         (*assembly-optimize* nil)
-        (*fixups* nil))
+        (*fixup-notes* nil))
     (unwind-protect
        (let ((*features* (cons :sb-assembling *features*)))
          (init-assembler)
@@ -53,7 +53,7 @@
          (let ((length (sb!assem:finalize-segment *code-segment*)))
            (dump-assembler-routines *code-segment*
                                     length
-                                    *fixups*
+                                    *fixup-notes*
                                     *entry-points*
                                     lap-fasl-output))
          (setq won t))

diff --git a/src/compiler/codegen.lisp b/src/compiler/codegen.lisp
index 3b51f49..7a17680 100644 (file)
--- a/src/compiler/codegen.lisp
+++ b/src/compiler/codegen.lisp
@@ -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*)

diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp
index 4959995..eaf4ab8 100644 (file)
--- a/src/compiler/dump.lisp
+++ b/src/compiler/dump.lisp
@@ -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

diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp
index 6f2fe93..f3c7319 100644 (file)
--- a/src/compiler/early-c.lisp
+++ b/src/compiler/early-c.lisp
@@ -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*)

diff --git a/src/compiler/fixup.lisp b/src/compiler/fixup.lisp
index 6fd06ca..1a5e064 100644 (file)
--- a/src/compiler/fixup.lisp
+++ b/src/compiler/fixup.lisp
@@ -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))

diff --git a/src/compiler/generic/core.lisp b/src/compiler/generic/core.lisp
index 4fa0787..7e03a24 100644 (file)
--- a/src/compiler/generic/core.lisp
+++ b/src/compiler/generic/core.lisp
@@ -42,14 +42,14 @@
   (values))
 
 ;;; Do "load-time" fixups on the code vector.
-(defun do-core-fixups (code fixups)
-  (declare (list fixups))
-  (dolist (info fixups)
-    (let* ((kind (first info))
-          (fixup (second info))
+(defun do-core-fixups (code fixup-notes)
+  (declare (list fixup-notes))
+  (dolist (note fixup-notes)
+    (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))
           (value (ecase flavor
                    (:assembly-routine
                     (aver (symbolp name))
@@ -63,7 +63,7 @@
                    (:code-object
                     (aver (null name))
                     (values (get-lisp-obj-address code) t)))))
-      (sb!vm:fixup-code-object code offset value kind))))
+      (sb!vm:fixup-code-object code position value kind))))
 
 ;;; Stick a reference to the function FUN in CODE-OBJECT at index I. If the
 ;;; function hasn't been compiled yet, make a note in the patch table.

diff --git a/src/compiler/generic/target-core.lisp b/src/compiler/generic/target-core.lisp
index 025e376..c4e021d 100644 (file)
--- a/src/compiler/generic/target-core.lisp
+++ b/src/compiler/generic/target-core.lisp
@@ -35,11 +35,11 @@
 
 ;;; Dump a component to core. We pass in the assembler fixups, code
 ;;; vector and node info.
-(defun make-core-component (component segment length trace-table fixups object)
+(defun make-core-component (component segment length trace-table fixup-notes object)
   (declare (type component component)
           (type sb!assem:segment segment)
           (type index length)
-          (list trace-table fixups)
+          (list trace-table fixup-notes)
           (type core-object object))
   (without-gcing
     (let* ((2comp (component-info component))
@@ -71,7 +71,7 @@
         (copy-byte-vector-to-system-area v fill-ptr)
         (setf fill-ptr (sap+ fill-ptr (length v)))))
 
-      (do-core-fixups code-obj fixups)
+      (do-core-fixups code-obj fixup-notes)
 
       (dolist (entry (ir2-component-entries 2comp))
        (make-fun-entry entry code-obj object))

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 6a2d2bf..137f74d 100644 (file)
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -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))))))
 

diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c
index e87c3f5..aecee17 100644 (file)
--- a/src/runtime/interrupt.c
+++ b/src/runtime/interrupt.c
@@ -817,8 +817,8 @@ install_handler(int signal, void handler(int, siginfo_t*, void*))
     sigemptyset(&new);
     sigaddset_blockable(&new);
 
-    FSHOW((stderr, "/interrupt_low_level_handlers[signal]=%d\n",
-          interrupt_low_level_handlers[signal]));
+    FSHOW((stderr, "/data->interrupt_low_level_handlers[signal]=%d\n",
+          data->interrupt_low_level_handlers[signal]));
     if (data->interrupt_low_level_handlers[signal]==0) {
        if (ARE_SAME_HANDLER(handler, SIG_DFL) ||
            ARE_SAME_HANDLER(handler, SIG_IGN)) {

diff --git a/version.lisp-expr b/version.lisp-expr
index 18b5dd3..c006de0 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.6.41"
+"0.8.6.42"