mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 01:00:20 +02:00
Code Activity

src and meta are fields of $kentry, not $fun

Browse source 
* module/language/cps.scm ($kentry, $fun): Attach "src" and "meta" on
  the $kentry, not the $fun.  This prepares us for $callk to $kentry
  continuations that have no corresponding $fun.

* module/language/cps/arities.scm:
* module/language/cps/closure-conversion.scm:
* module/language/cps/compile-bytecode.scm:
* module/language/cps/constructors.scm:
* module/language/cps/contification.scm:
* module/language/cps/cse.scm:
* module/language/cps/dce.scm:
* module/language/cps/dfg.scm:
* module/language/cps/elide-values.scm:
* module/language/cps/prune-bailouts.scm:
* module/language/cps/prune-top-level-scopes.scm:
* module/language/cps/reify-primitives.scm:
* module/language/cps/renumber.scm:
* module/language/cps/self-references.scm:
* module/language/cps/simplify.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/specialize-primcalls.scm:
* module/language/cps/verify.scm:
* module/language/tree-il/compile-cps.scm: Adapt.
This commit is contained in:
Andy Wingo 2014-04-10 10:50:17 +02:00
parent 1e91d95704
commit 24b611e81c
21 changed files with 160 additions and 154 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -113,10 +113,12 @@
(emit-load-constant asm slot val)
#t)))))
(define (compile-entry meta)
(define (compile-entry)
(let ((label (dfg-min-label dfg)))
(match (lookup-cont label dfg)
(($ $kentry self tail clause)
(($ $kentry src meta self tail clause)
(when src
(emit-source asm src))
(emit-begin-program asm label meta)
(compile-clause (1+ label))
(emit-end-program asm)))))
@ -243,9 +245,9 @@
(emit-load-constant asm dst *unspecified*))
(($ $const exp)
(emit-load-constant asm dst exp))
(($ $fun src meta () ($ $cont k))
(($ $fun () ($ $cont k))
(emit-load-static-procedure asm dst k))
(($ $fun src meta free ($ $cont k))
(($ $fun free ($ $cont k))
(emit-make-closure asm dst k (length free)))
(($ $primcall 'current-module)
(emit-current-module asm dst))
@ -469,18 +471,15 @@
(emit-call-label asm proc-slot nargs k))))))
(match f
(($ $fun src meta free ($ $cont k ($ $kentry self tail clause)))
;; FIXME: src on kentry instead?
(when src
(emit-source asm src))
(compile-entry (or meta '()))))))
(($ $fun free ($ $cont k ($ $kentry src meta self tail clause)))
(compile-entry)))))
(define (visit-funs proc exp)
(match exp
(($ $continue _ _ exp)
(visit-funs proc exp))
(($ $fun src meta free body)
(($ $fun free body)
(proc exp)
(visit-funs proc body))
@ -496,7 +495,7 @@
(when alternate
(visit-funs proc alternate)))
(($ $cont sym ($ $kentry self tail clause))
(($ $cont sym ($ $kentry src meta self tail clause))
(when clause
(visit-funs proc clause)))