[Guile-commits] 04/08: Re-mark "throw" et al as not having fallthrough

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit dd8bf6a98cfd852c4a6981337eb0df11dd427415
Author: Andy Wingo <address@hidden>
Date:   Tue Dec 5 16:53:04 2017 +0100

    Re-mark "throw" et al as not having fallthrough
    
    * module/system/vm/disassembler.scm (instruction-has-fallthrough?):
      Re-add throw, etc.
    * module/system/vm/frame.scm (compute-frame-sizes, compute-killv): Allow
      for unreachable code.
---
 module/system/vm/disassembler.scm |  1 +
 module/system/vm/frame.scm        | 10 ++++++----
 2 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/module/system/vm/disassembler.scm 
b/module/system/vm/disassembler.scm
index a4c539b..8f17b3f 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -527,6 +527,7 @@ address of that offset."
                        ;; the non-fallthrough-set currently to allow the
                        ;; frame parser to be able to compute the stack
                        ;; size for following code.
+                       throw throw/value throw/value+data
                        tail-call tail-call-label tail-call/shuffle
                        return-values
                        subr-call foreign-call continuation-call
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index b699590..a5cb9db 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -126,7 +126,7 @@
                (else (error "bad target" target)))))))
       (when (< n (vector-length parsed))
         (let* ((in (vector-ref in-sizes n))
-               (out (instruction-stack-size-after code pos in)))
+               (out (and in (instruction-stack-size-after code pos in))))
           (vector-set! out-sizes n out)
           (when out
             (when (instruction-has-fallthrough? code pos)
@@ -205,9 +205,11 @@
         (for-each (lambda (slot)
                     (when (< slot (vector-length defs-by-slot))
                       (kill-slot! n slot)))
-                  (instruction-slot-clobbers code pos
-                                             (vector-ref in-sizes n)
-                                             (vector-ref out-sizes n)))
+                  (let ((in (vector-ref in-sizes n))
+                        (out (vector-ref out-sizes n)))
+                    (if out
+                        (instruction-slot-clobbers code pos in out)
+                        (iota (or in 0)))))
         (lp (1+ n) (+ pos (vector-ref parsed n)))))
     killv))