mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

Prefer "receive" over "receive-values"+"reset-frame"

Browse source 
* module/language/cps/compile-bytecode.scm (compile-fun): Attempt to
  emit "receive" instead of "receive-values"+"reset-frame" where
  possible.
This commit is contained in:
Andy Wingo 2013-12-22 11:14:13 -05:00
parent 4dfcb36006
commit e4fa7d403a
1 changed files with 22 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -466,17 +466,28 @@
(lookup-parallel-moves label allocation)) (lookup-parallel-moves label allocation))
(for-each maybe-load-constant arg-slots (cons proc args)) (for-each maybe-load-constant arg-slots (cons proc args))
(emit-call asm proc-slot nargs) (emit-call asm proc-slot nargs)
;; FIXME: Only allow more values if there is a rest arg. (cond
;; Express values truncation by the presence of an ((and (= 1 nreq) (and rest-var) (not (maybe-slot rest-var))
;; unused rest arg instead of implicitly. (match (lookup-parallel-moves k allocation)
(unless (zero? nreq) ((((? (lambda (src) (= src (1+ proc-slot))) src)
(emit-receive-values asm proc-slot #t nreq)) . dst)) dst)
(when (and rest-var (maybe-slot rest-var)) (_ #f)))
(emit-bind-rest asm (+ proc-slot 1 nreq))) ;; The usual case: one required live return value, ignoring
(for-each (match-lambda ;; any additional values.
((src . dst) (emit-mov asm dst src))) => (lambda (dst)
(lookup-parallel-moves k allocation)) (emit-receive asm dst proc-slot nlocals)))
(emit-reset-frame asm nlocals))))) (else
;; FIXME: Only allow more values if there is a rest arg.
;; Express values truncation by the presence of an unused
;; rest arg instead of implicitly.
(unless (zero? nreq)
(emit-receive-values asm proc-slot #t nreq))
(when (and rest-var (maybe-slot rest-var))
(emit-bind-rest asm (+ proc-slot 1 nreq)))
(for-each (match-lambda
((src . dst) (emit-mov asm dst src)))
(lookup-parallel-moves k allocation))
(emit-reset-frame asm nlocals)))))))
(match f (match f
(($ $fun src meta free ($ $cont k ($ $kentry self tail clauses))) (($ $fun src meta free ($ $cont k ($ $kentry self tail clauses)))