mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 21:40:33 +02:00
Replace return primcalls with $values
* module/language/cps/compile-bytecode.scm: * module/language/cps/contification.scm: * module/language/cps/slot-allocation.scm: * module/language/cps/type-fold.scm: * module/language/cps/verify.scm: * module/language/tree-il/compile-cps.scm: Never generate a return primcall. Instead use $values.
This commit is contained in:
parent
7c9e477b82
commit
2f08838cd6
6 changed files with 7 additions and 17 deletions
|
@ -136,9 +136,7 @@
|
||||||
(for-each (match-lambda
|
(for-each (match-lambda
|
||||||
((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
|
((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
|
||||||
(lookup-parallel-moves label allocation))
|
(lookup-parallel-moves label allocation))
|
||||||
(emit-return-values asm (1+ (length args))))
|
(emit-return-values asm (1+ (length args))))))
|
||||||
(($ $primcall 'return (arg))
|
|
||||||
(emit-return asm (from-sp (slot arg))))))
|
|
||||||
|
|
||||||
(define (compile-value label exp dst)
|
(define (compile-value label exp dst)
|
||||||
(match exp
|
(match exp
|
||||||
|
|
|
@ -415,12 +415,9 @@ function set."
|
||||||
,(match (intmap-ref conts k*)
|
,(match (intmap-ref conts k*)
|
||||||
(($ $kreceive)
|
(($ $kreceive)
|
||||||
(match exp
|
(match exp
|
||||||
(($ $primcall 'return (val))
|
|
||||||
(build-exp ($primcall 'values (val))))
|
|
||||||
(($ $call) exp)
|
(($ $call) exp)
|
||||||
;; Except for 'return, a primcall that can continue
|
;; A primcall that can continue to $ktail can also
|
||||||
;; to $ktail can also continue to $kreceive. TODO:
|
;; continue to $kreceive.
|
||||||
;; replace 'return with 'values, for consistency.
|
|
||||||
(($ $primcall) exp)
|
(($ $primcall) exp)
|
||||||
(($ $values vals)
|
(($ $values vals)
|
||||||
(build-exp ($primcall 'values vals)))))
|
(build-exp ($primcall 'values vals)))))
|
||||||
|
|
|
@ -660,9 +660,6 @@ are comparable with eqv?. A tmp slot may be used."
|
||||||
(call-size label (1+ (length args)) size))
|
(call-size label (1+ (length args)) size))
|
||||||
(($ $values args)
|
(($ $values args)
|
||||||
(shuffle-size (get-shuffles label) size))
|
(shuffle-size (get-shuffles label) size))
|
||||||
(($ $primcall 'return (arg))
|
|
||||||
;; Return will shuffle arg into fp-relative slot 1.
|
|
||||||
(max size 2))
|
|
||||||
(_ size)))))
|
(_ size)))))
|
||||||
(($ $kreceive)
|
(($ $kreceive)
|
||||||
(values frame-sizes clause
|
(values frame-sizes clause
|
||||||
|
|
|
@ -276,7 +276,7 @@
|
||||||
(with-cps cps
|
(with-cps cps
|
||||||
(letv bool)
|
(letv bool)
|
||||||
(letk kbool ($kargs (#f) (bool)
|
(letk kbool ($kargs (#f) (bool)
|
||||||
($continue k src ($primcall 'return (bool)))))
|
($continue k src ($values (bool)))))
|
||||||
($ (convert-to-logtest kbool)))))
|
($ (convert-to-logtest kbool)))))
|
||||||
(with-cps cps #f))))
|
(with-cps cps #f))))
|
||||||
|
|
||||||
|
|
|
@ -258,9 +258,7 @@ definitions that are available at LABEL."
|
||||||
(when (false-if-exception (prim-arity name))
|
(when (false-if-exception (prim-arity name))
|
||||||
(error "primitive should continue to $kargs, not $kreceive" name)))
|
(error "primitive should continue to $kargs, not $kreceive" name)))
|
||||||
(($ $ktail)
|
(($ $ktail)
|
||||||
(unless (eq? name 'return)
|
(error "primitive should continue to $kargs, not $ktail" name))))
|
||||||
(when (false-if-exception (prim-arity name))
|
|
||||||
(error "primitive should continue to $kargs, not $ktail" name))))))
|
|
||||||
(($ $prompt escape? tag handler)
|
(($ $prompt escape? tag handler)
|
||||||
(assert-nullary)
|
(assert-nullary)
|
||||||
(match (intmap-ref conts handler)
|
(match (intmap-ref conts handler)
|
||||||
|
|
|
@ -249,7 +249,7 @@
|
||||||
(with-cps cps
|
(with-cps cps
|
||||||
(let$ body (with-cps-constants ((unspecified *unspecified*))
|
(let$ body (with-cps-constants ((unspecified *unspecified*))
|
||||||
(build-term
|
(build-term
|
||||||
($continue k src ($primcall 'return (unspecified))))))
|
($continue k src ($values (unspecified))))))
|
||||||
(letk kvoid ($kargs () () ,body))
|
(letk kvoid ($kargs () () ,body))
|
||||||
kvoid))
|
kvoid))
|
||||||
(($ $kreceive arity kargs)
|
(($ $kreceive arity kargs)
|
||||||
|
@ -287,7 +287,7 @@
|
||||||
(with-cps cps
|
(with-cps cps
|
||||||
(letv val)
|
(letv val)
|
||||||
(letk kval ($kargs ('val) (val)
|
(letk kval ($kargs ('val) (val)
|
||||||
($continue k src ($primcall 'return (val)))))
|
($continue k src ($values (val)))))
|
||||||
kval))
|
kval))
|
||||||
(($ $kreceive arity kargs)
|
(($ $kreceive arity kargs)
|
||||||
(match arity
|
(match arity
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue