mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Fix bug in which codegen accessed data beyond end of stack

Browse source 
* module/language/cps/compile-bytecode.scm (compile-function): When
  shuffling return values, we need to reset the frame after any "extra"
  values are read and before any "extra" values may be set.
This commit is contained in:
Andy Wingo 2019-08-18 22:09:38 +02:00
parent b16ad94667
commit 4bb5834d75
1 changed files with 20 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

28
module/language/cps/compile-bytecode.scm
View file

@ -380,6 +380,24 @@
(#('throw/value+data param (val)) (#('throw/value+data param (val))
(emit-throw/value+data asm (from-sp (slot val)) param)))) (emit-throw/value+data asm (from-sp (slot val)) param))))
(define (emit-parallel-moves-after-return-and-reset-frame label nlocals)
(let lp ((moves (lookup-parallel-moves label allocation))
(reset-frame? #f))
(cond
((and (not reset-frame?)
(and-map (match-lambda
((src . dst)
(and (< src nlocals) (< dst nlocals))))
moves))
(emit-reset-frame asm nlocals)
(lp moves #t))
(else
(match moves
(() #t)
(((src . dst) . moves)
(emit-fmov asm dst src)
(lp moves reset-frame?)))))))
(define (compile-prompt label k kh escape? tag) (define (compile-prompt label k kh escape? tag)
(match (intmap-ref cps kh) (match (intmap-ref cps kh)
(($ $kreceive ($ $arity req () rest () #f) khandler-body) (($ $kreceive ($ $arity req () rest () #f) khandler-body)
@ -397,10 +415,7 @@
(($ $kargs names (_ ... rest)) (($ $kargs names (_ ... rest))
(maybe-slot rest)))) (maybe-slot rest))))
(emit-bind-rest asm (+ proc-slot nreq))) (emit-bind-rest asm (+ proc-slot nreq)))
(for-each (match-lambda (emit-parallel-moves-after-return-and-reset-frame kh frame-size)
((src . dst) (emit-fmov asm dst src)))
(lookup-parallel-moves kh allocation))
(emit-reset-frame asm frame-size)
(emit-j asm (forward-label khandler-body)))))) (emit-j asm (forward-label khandler-body))))))
(define (compile-values label exp syms) (define (compile-values label exp syms)
@ -544,10 +559,7 @@
(emit-receive-values asm proc-slot (->bool rest-var) nreq)) (emit-receive-values asm proc-slot (->bool rest-var) nreq))
(when (and rest-var (maybe-slot rest-var)) (when (and rest-var (maybe-slot rest-var))
(emit-bind-rest asm (+ proc-slot nreq))) (emit-bind-rest asm (+ proc-slot nreq)))
(for-each (match-lambda (emit-parallel-moves-after-return-and-reset-frame k frame-size)))))
((src . dst) (emit-fmov asm dst src)))
(lookup-parallel-moves k allocation))
(emit-reset-frame asm frame-size)))))
(match exp (match exp
(($ $call proc args) (($ $call proc args)
(do-call proc args (do-call proc args