mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Fix stack effect/clobber parsing for calls

Browse source 
* module/system/vm/disassembler.scm (define-stack-effect-parser)
  (define-clobber-parser):
* module/system/vm/frame.scm (compute-frame-sizes, compute-killv):
  Fix bug introduced in dd8bf6a98c whereby
  a call would clobber all locals, leaving the backtrace much less
  useful than it should be.
This commit is contained in:
Andy Wingo 2017-12-27 15:00:08 +01:00
parent da7144d93c
commit a5dfbf5d0a
2 changed files with 9 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -566,13 +566,13 @@ address of that offset."
(define (stack-effect-parser name)
(case name
((push)
#'(lambda (code pos size) (+ size 1)))
#'(lambda (code pos size) (and size (+ size 1))))
((pop)
#'(lambda (code pos size) (- size 1)))
#'(lambda (code pos size) (and size (- size 1))))
((drop)
#'(lambda (code pos size)
(let ((count (ash (bytevector-u32-native-ref code pos) -8)))
(- size count))))
(and size (- size count)))))
((alloc-frame reset-frame)
#'(lambda (code pos size)
(let ((nlocals (ash (bytevector-u32-native-ref code pos) -8)))
@ -632,7 +632,7 @@ address of that offset."
(match elt
((_ proc . _)
(let lp ((slot (- proc 2)))
(if (< slot nslots-in)
(if (and nslots-in (< slot nslots-in))
(cons slot (lp (1+ slot)))
'())))))))))
(vector-set! clobber-parsers opcode parse)))
@ -650,7 +650,9 @@ address of that offset."
((X8_F24 X8_F12_F12)
#'(list dst))
(else
#'(list (- nslots-out 1 dst)))))))))))
#'(if nslots-out
(list (- nslots-out 1 dst))
'()))))))))))
(vector-set! clobber-parsers opcode parse)))
(else (error "unexpected instruction kind" #'kind)))))))

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

@ -126,7 +126,7 @@
(else (error "bad target" target)))))))
(when (< n (vector-length parsed))
(let* ((in (vector-ref in-sizes n))
(out (and in (instruction-stack-size-after code pos in))))
(out (instruction-stack-size-after code pos in)))
(vector-set! out-sizes n out)
(when out
(when (instruction-has-fallthrough? code pos)
@ -207,9 +207,7 @@
(kill-slot! n slot)))
(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)))))
(instruction-slot-clobbers code pos in out)))
(lp (1+ n) (+ pos (vector-ref parsed n)))))
killv))