mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +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)))))))