Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1:/tmp/cvs-serv5449/src/compiler
Modified Files:
codegen.lisp dump.lisp early-c.lisp fixup.lisp main.lisp
Log Message:
0.8.6.42:
Nikodemus Siivola patchery
... fix FIXME for obscurity of *fixup* structure
... fix compile with FSHOW defined
Index: codegen.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/codegen.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- codegen.lisp 6 Oct 2001 22:31:21 -0000 1.6
+++ codegen.lisp 20 Dec 2003 12:08:10 -0000 1.7
@@ -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*)
Index: dump.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/dump.lisp,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -d -r1.39 -r1.40
--- dump.lisp 5 Aug 2003 14:11:39 -0000 1.39
+++ dump.lisp 20 Dec 2003 12:08:10 -0000 1.40
@@ -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
Index: early-c.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/early-c.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- early-c.lisp 12 Jun 2003 06:41:13 -0000 1.25
+++ early-c.lisp 20 Dec 2003 12:08:10 -0000 1.26
@@ -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*)
Index: fixup.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/fixup.lisp,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- fixup.lisp 2 Mar 2001 23:48:33 -0000 1.3
+++ fixup.lisp 20 Dec 2003 12:08:10 -0000 1.4
@@ -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))
Index: main.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/main.lisp,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -d -r1.82 -r1.83
--- main.lisp 16 Sep 2003 07:45:10 -0000 1.82
+++ main.lisp 20 Dec 2003 12:08:10 -0000 1.83
@@ -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))))))
|