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

@@ -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))

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
 						 "<unknown function>"))))
-	    (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

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)

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
 

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

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"