From 5e9825374b74df450d8cfb2c005e6bef30197734 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sat, 20 Dec 2003 12:08:09 +0000 Subject: [PATCH] 0.8.6.42: Nikodemus Siivola patchery ... fix FIXME for obscurity of *fixup* structure ... fix compile with FSHOW defined --- package-data-list.lisp-expr | 7 ++++++- src/assembly/assemfile.lisp | 4 ++-- src/compiler/codegen.lisp | 4 ++-- src/compiler/dump.lisp | 25 ++++++++----------------- src/compiler/early-c.lisp | 2 +- src/compiler/fixup.lisp | 18 ++++++++++++------ src/compiler/generic/core.lisp | 14 +++++++------- src/compiler/generic/target-core.lisp | 6 +++--- src/compiler/main.lisp | 6 +++--- src/runtime/interrupt.c | 4 ++-- version.lisp-expr | 2 +- 11 files changed, 47 insertions(+), 45 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index c8fac48..0e35b09 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4