Fix `unfold-and-reverse-rib' so that it properly handles both kinds of

dummy compiler reductions.  Previously it was only handling those that
were generated by `New_Compiler_Subproblem' in the microcode.

diff --git a/v7/src/runtime/histry.scm b/v7/src/runtime/histry.scm
index 8373f9a7316e225e40ecf7fab4785e1c3ff00492..f60f3368ea6b87927acc4ca4d981600c45c6539c 100644 (file)
--- a/v7/src/runtime/histry.scm
+++ b/v7/src/runtime/histry.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/histry.scm,v 13.46 1987/06/02 11:26:07 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/histry.scm,v 13.47 1987/06/04 21:08:49 cph Rel $
 ;;;
 ;;;    Copyright (c) 1987 Massachusetts Institute of Technology
 ;;;
@@ -212,26 +212,27 @@
                           (loop next)))))
              '()))))
 
-(define (dummy-compiler-reduction? reduction)
-  (and (marked-reduction? reduction)
-       (null? (reduction-expression reduction))
-       (eq? return-address-pop-from-compiled-code
-           (reduction-environment reduction))))
-
 (define (unfold-and-reverse-rib rib)
   (let loop ((current (next-reduction rib)) (output 'WRAP-AROUND))
     (let ((step
-          (if (dummy-compiler-reduction? current)
-              '()
-              (cons (list (reduction-expression current)
-                          (reduction-environment current))
-                    (if (marked-reduction? current)
-                        '()
-                        output)))))
+          (let ((tail
+                 (if (marked-reduction? current)
+                     '()
+                     output)))
+            (if (dummy-compiler-reduction? current)
+                tail
+                (cons (list (reduction-expression current)
+                            (reduction-environment current))
+                      tail)))))
       (if (eq? current rib)
          step
          (loop (next-reduction current) step)))))
 
+(define (dummy-compiler-reduction? reduction)
+  (and (null? (reduction-expression reduction))
+       (eq? return-address-pop-from-compiled-code
+           (reduction-environment reduction))))
+
 (define the-empty-history
   (cons (vector-ref (get-fixed-objects-vector)
                    (fixed-objects-vector-slot 'DUMMY-HISTORY))