[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 11/16: Instruction explosion for cached-module-box
From: |
Andy Wingo |
Subject: |
[Guile-commits] 11/16: Instruction explosion for cached-module-box |
Date: |
Mon, 14 May 2018 10:48:36 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 3edf02cbe539d5c53dc93b81aeb17103ac677ce0
Author: Andy Wingo <address@hidden>
Date: Mon May 14 11:54:29 2018 +0200
Instruction explosion for cached-module-box
* module/language/cps/reify-primitives.scm (reify-lookup):
(reify-resolve-module): New helpers.
(cached-module-box): Explode.
---
module/language/cps/reify-primitives.scm | 67 ++++++++++++++++++++++++++++++++
1 file changed, 67 insertions(+)
diff --git a/module/language/cps/reify-primitives.scm
b/module/language/cps/reify-primitives.scm
index 0426ccd..29b1585 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -208,6 +208,73 @@
(define-ephemeral (slsh/immediate cps k src param a)
(wrap-unary cps k src 's64->u64 'u64->s64 'ulsh/immediate param a))
+(define (reify-lookup cps src mod-var name assert-bound? have-var)
+ (define (%lookup cps kbad k src mod-var name-var var assert-bound?)
+ (if assert-bound?
+ (with-cps cps
+ (letv val)
+ (letk kcheck
+ ($kargs ('val) (val)
+ ($branch k kbad src 'undefined? #f (val))))
+ (letk kref
+ ($kargs () ()
+ ($continue kcheck src
+ ($primcall 'scm-ref/immediate '(box . 1) (var)))))
+ ($ (%lookup kbad kref src mod-var name-var var #f)))
+ (with-cps cps
+ (letk kres
+ ($kargs ('var) (var)
+ ($branch kbad k src 'heap-object? #f (var))))
+ (build-term
+ ($continue kres src
+ ($primcall 'lookup #f (mod-var name-var)))))))
+ (define %unbound
+ #(unbound-variable #f "Unbound variable: ~S"))
+ (with-cps cps
+ (letv name-var var)
+ (let$ good (have-var var))
+ (letk kgood ($kargs () () ,good))
+ (letk kbad ($kargs () () ($throw src 'throw/value %unbound (name-var))))
+ (let$ body (%lookup kbad kgood src mod-var name-var var assert-bound?))
+ (letk klookup ($kargs ('name) (name-var) ,body))
+ (build-term ($continue klookup src ($const name)))))
+
+(define (reify-resolve-module cps k src module public?)
+ (with-cps cps
+ (letv mod-name)
+ (letk kresolve
+ ($kargs ('mod-name) (mod-name)
+ ($continue k src
+ ($primcall 'resolve-module public? (mod-name)))))
+ (build-term
+ ($continue kresolve src ($const module)))))
+
+(define-ephemeral (cached-module-box cps k src param)
+ (match param
+ ((module name public? bound?)
+ (let ((cache-key (cons module name)))
+ (with-cps cps
+ (letv mod cached)
+ (let$ lookup
+ (reify-lookup
+ src mod name bound?
+ (lambda (cps var)
+ (with-cps cps
+ (letk k* ($kargs () () ($continue k src ($values (var)))))
+ (build-term
+ ($continue k* src
+ ($primcall 'cache-set! cache-key (var))))))))
+ (letk kmod ($kargs ('mod) (mod) ,lookup))
+ (let$ module (reify-resolve-module kmod src module public?))
+ (letk kinit ($kargs () () ,module))
+ (letk kok ($kargs () () ($continue k src ($values (cached)))))
+ (letk ktest
+ ($kargs ('cached) (cached)
+ ($branch kinit kok src 'heap-object? #f (cached))))
+ (build-term
+ ($continue ktest src
+ ($primcall 'cache-ref cache-key ()))))))))
+
;; FIXME: Instead of having to check this, instead every primcall that's
;; not ephemeral should be handled by compile-bytecode.
(define (compute-known-primitives)
- [Guile-commits] 04/16: VM calls "<?" through intrinsic., (continued)
- [Guile-commits] 04/16: VM calls "<?" through intrinsic., Andy Wingo, 2018/05/14
- [Guile-commits] 06/16: Remove unused macros in VM, Andy Wingo, 2018/05/14
- [Guile-commits] 08/16: Add scm_maybe_resolve_module, Andy Wingo, 2018/05/14
- [Guile-commits] 07/16: Mark call-scm<-scm-u64 as defining a result, Andy Wingo, 2018/05/14
- [Guile-commits] 12/16: Instruction explosion for cache-current-module, cached-toplevel-box, Andy Wingo, 2018/05/14
- [Guile-commits] 10/16: Add cache-ref, cache-set! macro-instructions, Andy Wingo, 2018/05/14
- [Guile-commits] 03/16: VM calls out to heap-numbers-equal? through intrinsics, Andy Wingo, 2018/05/14
- [Guile-commits] 15/16: Use intrinsics for top-level refs outside captured scopes, Andy Wingo, 2018/05/14
- [Guile-commits] 16/16: Remove implementations of now-unused toplevel-box et al instructions, Andy Wingo, 2018/05/14
- [Guile-commits] 13/16: Remove backend support for cached-module-box et al., Andy Wingo, 2018/05/14
- [Guile-commits] 11/16: Instruction explosion for cached-module-box,
Andy Wingo <=
- [Guile-commits] 09/16: Add intrinsics for module operations, Andy Wingo, 2018/05/14
- [Guile-commits] 01/16: lsh, rsh etc are intrinsics, Andy Wingo, 2018/05/14
- [Guile-commits] 14/16: Compile "define!" via intrinsic, Andy Wingo, 2018/05/14