From b4ccc20df7644d7d3b601a22059d796e8f23c9af Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Wed, 5 Mar 2003 14:13:05 +0000 Subject: [PATCH] 0.7.13.14: * New blocks are inserted into the end of component in the direct order; * TRANSFORM-CALL inserts new lambda immediately after the call; * MAKE-COMPONENT is a BOA-constructor. --- BUGS | 3 --- src/compiler/ir1opt.lisp | 15 +++++++++------ src/compiler/ir1util.lisp | 44 +++++++++++++++++++++++--------------------- src/compiler/macros.lisp | 13 +++++++++++++ src/compiler/node.lisp | 20 ++++++++++++-------- version.lisp-expr | 2 +- 6 files changed, 58 insertions(+), 39 deletions(-) diff --git a/BUGS b/BUGS index 1b6c03909..6f0011c28 100644 --- a/BUGS +++ b/BUGS @@ -1203,9 +1203,6 @@ WORKAROUND: (+ x 2))) (foo 1d0 5) => segmentation violation -234: - (fixed in sbcl-0.7.10.36) - 235: "type system and inline expansion" a. (declaim (ftype (function (cons) number) acc)) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index c28977e0a..62b0b1f11 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -1168,21 +1168,24 @@ ;;; possible to do this starting from debug names as well as source ;;; names, but as of sbcl-0.7.1.5, there was no need for this ;;; generality, since source names are always known to our callers.) -(defun transform-call (node res source-name) - (declare (type combination node) (list res)) +(defun transform-call (call res source-name) + (declare (type combination call) (list res)) (aver (and (legal-fun-name-p source-name) (not (eql source-name '.anonymous.)))) - (with-ir1-environment-from-node node + (node-ends-block call) + (with-ir1-environment-from-node call + (with-component-last-block (*current-component* + (block-next (node-block call))) (let ((new-fun (ir1-convert-inline-lambda res :debug-name (debug-namify "LAMBDA-inlined ~A" (as-debug-name source-name "")))) - (ref (continuation-use (combination-fun node)))) + (ref (continuation-use (combination-fun call)))) (change-ref-leaf ref new-fun) - (setf (combination-kind node) :full) - (locall-analyze-component *current-component*))) + (setf (combination-kind call) :full) + (locall-analyze-component *current-component*)))) (values)) ;;; Replace a call to a foldable function of constant arguments with diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index c6c4ac44d..946c32b4a 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -37,17 +37,19 @@ (type (or cleanup null) cleanup)) (setf (component-reanalyze (block-component block1)) t) (with-ir1-environment-from-node node - (let* ((start (make-continuation)) - (block (continuation-starts-block start)) - (cont (make-continuation)) - (*lexenv* (if cleanup - (make-lexenv :cleanup cleanup) - *lexenv*))) - (change-block-successor block1 block2 block) - (link-blocks block block2) - (ir1-convert start cont form) - (setf (block-last block) (continuation-use cont)) - block))) + (with-component-last-block (*current-component* + (block-next (component-head *current-component*))) + (let* ((start (make-continuation)) + (block (continuation-starts-block start)) + (cont (make-continuation)) + (*lexenv* (if cleanup + (make-lexenv :cleanup cleanup) + *lexenv*))) + (change-block-successor block1 block2 block) + (link-blocks block block2) + (ir1-convert start cont form) + (setf (block-last block) (continuation-use cont)) + block)))) ;;;; continuation use hacking @@ -190,16 +192,16 @@ (ecase (continuation-kind cont) (:unused (aver (not (continuation-block cont))) - (let* ((head (component-head *current-component*)) - (next (block-next head)) - (new-block (make-block cont))) + (let* ((next (component-last-block *current-component*)) + (prev (block-prev next)) + (new-block (make-block cont))) (setf (block-next new-block) next - (block-prev new-block) head - (block-prev next) new-block - (block-next head) new-block - (continuation-block cont) new-block - (continuation-use cont) nil - (continuation-kind cont) :block-start) + (block-prev new-block) prev + (block-prev next) new-block + (block-next prev) new-block + (continuation-block cont) new-block + (continuation-use cont) nil + (continuation-kind cont) :block-start) new-block)) (:block-start (continuation-block cont)))) @@ -559,7 +561,7 @@ (defun make-empty-component () (let* ((head (make-block-key :start nil :component nil)) (tail (make-block-key :start nil :component nil)) - (res (make-component :head head :tail tail))) + (res (make-component head tail))) (setf (block-flag head) t) (setf (block-flag tail) t) (setf (block-component head) res) diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp index 2a7fb523b..f6e4fb0b5 100644 --- a/src/compiler/macros.lisp +++ b/src/compiler/macros.lisp @@ -687,6 +687,19 @@ (defmacro with-continuation-type-assertion ((cont ctype context) &body body) `(let ((*lexenv* (ir1ize-the-or-values ,ctype ,cont *lexenv* ,context))) ,@body)) + +(defmacro with-component-last-block ((component block) &body body) + (let ((old-last-block (gensym "OLD-LAST-BLOCK"))) + (once-only ((component component) + (block block)) + `(let ((,old-last-block (component-last-block ,component))) + (unwind-protect + (progn (setf (component-last-block ,component) + ,block) + ,@body) + (setf (component-last-block ,component) + ,old-last-block)))))) + ;;;; the EVENT statistics/trace utility diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index 7d1cc76d0..83b342122 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -330,7 +330,9 @@ ;;; size of flow analysis problems, this allows back-end data ;;; structures to be reclaimed after the compilation of each ;;; component. -(defstruct (component (:copier nil)) +(defstruct (component (:copier nil) + (:constructor + make-component (head tail &aux (last-block tail)))) ;; unique ID for debugging #!+sb-show (id (new-object-id) :read-only t) ;; the kind of component @@ -364,13 +366,15 @@ ;; the blocks that are the dummy head and tail of the DFO ;; ;; Entry/exit points have these blocks as their - ;; predecessors/successors. Null temporarily. The start and return - ;; from each non-deleted function is linked to the component head - ;; and tail. Until physical environment analysis links NLX entry - ;; stubs to the component head, every successor of the head is a - ;; function start (i.e. begins with a BIND node.) - (head nil :type (or null cblock)) - (tail nil :type (or null cblock)) + ;; predecessors/successors. The start and return from each + ;; non-deleted function is linked to the component head and + ;; tail. Until physical environment analysis links NLX entry stubs + ;; to the component head, every successor of the head is a function + ;; start (i.e. begins with a BIND node.) + (head (missing-arg) :type cblock) + (tail (missing-arg) :type cblock) + ;; New blocks are inserted before this. + (last-block (missing-arg) :type cblock) ;; This becomes a list of the CLAMBDA structures for all functions ;; in this component. OPTIONAL-DISPATCHes are represented only by ;; their XEP and other associated lambdas. This doesn't contain any diff --git a/version.lisp-expr b/version.lisp-expr index a2acd7f78..58662fd88 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.13.13" +"0.7.13.14" -- 2.11.4.GIT