[Guile-commits] 01/16: Fix stack effect/clobber parsing for calls

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit a5dfbf5d0a81f7d5ec99fea3fe6830ecb1992eb2
Author: Andy Wingo <address@hidden>
Date:   Wed Dec 27 15:00:08 2017 +0100

    Fix stack effect/clobber parsing for calls
    
    * 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 dd8bf6a98cfd852c4a6981337eb0df11dd427415 whereby
      a call would clobber all locals, leaving the backtrace much less
      useful than it should be.
---
 module/system/vm/disassembler.scm | 12 +++++++-----
 module/system/vm/frame.scm        |  6 ++----
 2 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/module/system/vm/disassembler.scm 
b/module/system/vm/disassembler.scm
index 8f17b3f..62f3d08 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -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)))))))
 
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index a5cb9db..1fa7e99 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 (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))