mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 20:30:28 +02:00
Code Activity

Re-mark "throw" et al as not having fallthrough

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2017-12-05 16:53:04 +01:00
parent f84474ef39
commit dd8bf6a98c
2 changed files with 7 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

1
module/system/vm/disassembler.scm
View file

@ -527,6 +527,7 @@ address of that offset."
;; the non-fallthrough-set currently to allow the ;; the non-fallthrough-set currently to allow the
;; frame parser to be able to compute the stack ;; frame parser to be able to compute the stack
;; size for following code. ;; size for following code.
throw throw/value throw/value+data
tail-call tail-call-label tail-call/shuffle tail-call tail-call-label tail-call/shuffle
return-values return-values
subr-call foreign-call continuation-call subr-call foreign-call continuation-call

10
module/system/vm/frame.scm
View file

@ -126,7 +126,7 @@
(else (error "bad target" target))))))) (else (error "bad target" target)))))))
(when (< n (vector-length parsed)) (when (< n (vector-length parsed))
(let* ((in (vector-ref in-sizes n)) (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) (vector-set! out-sizes n out)
(when out (when out
(when (instruction-has-fallthrough? code pos) (when (instruction-has-fallthrough? code pos)
@ -205,9 +205,11 @@
(for-each (lambda (slot) (for-each (lambda (slot)
(when (< slot (vector-length defs-by-slot)) (when (< slot (vector-length defs-by-slot))
(kill-slot! n slot))) (kill-slot! n slot)))
(instruction-slot-clobbers code pos (let ((in (vector-ref in-sizes n))
(vector-ref in-sizes n) (out (vector-ref out-sizes n)))
(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))))) (lp (1+ n) (+ pos (vector-ref parsed n)))))
killv)) killv))