diff options
author | Andy Wingo <wingo@pobox.com> | 2018-05-14 11:13:58 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2018-05-14 14:04:59 +0200 |
commit | f6de1b062041dd61a79157e48eb5376e85b42484 (patch) | |
tree | 41cf8af87d40d5e184ccd774c7a7055753d35d9f | |
parent | fb344a25d5fab1714eb1d5ca66bad96fb4834855 (diff) | |
download | guile-f6de1b062041dd61a79157e48eb5376e85b42484.tar.gz |
Add cache-ref, cache-set! macro-instructions
* module/system/vm/assembler.scm (<cache-cell>): Remove "scope" member.
Just be an opaque key comparable with equal?.
(intern-cache-cell): Remove scope arg.
(intern-module-cache-cell): Remove; callers use intern-cache-cell now.
(cache-current-module!, cached-toplevel-box, cached-module-box): Create
cache keys that by construction won't collide between types.
(cache-ref, cache-set!): Add new macro assemblers.
* module/language/cps/reify-primitives.scm:
* module/language/cps/compile-bytecode.scm: Add cases for new macro
instructions.
-rw-r--r-- | module/language/cps/compile-bytecode.scm | 4 | ||||
-rw-r--r-- | module/language/cps/reify-primitives.scm | 3 | ||||
-rw-r--r-- | module/system/vm/assembler.scm | 29 |
3 files changed, 22 insertions, 14 deletions
diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm index 426942c21..fdf9953a5 100644 --- a/module/language/cps/compile-bytecode.scm +++ b/module/language/cps/compile-bytecode.scm @@ -175,6 +175,8 @@ (($ $primcall 'tail-pointer-ref/immediate (annotation . idx) (obj)) (emit-tail-pointer-ref/immediate asm (from-sp dst) (from-sp (slot obj)) idx)) + (($ $primcall 'cache-ref key ()) + (emit-cache-ref asm (from-sp dst) key)) (($ $primcall 'resolve-module public? (name)) (emit-resolve-module asm (from-sp dst) (from-sp (slot name)) public?)) (($ $primcall 'lookup #f (mod name)) @@ -285,6 +287,8 @@ (($ $values ()) #f) (($ $primcall 'cache-current-module! (scope) (mod)) (emit-cache-current-module! asm (from-sp (slot mod)) scope)) + (($ $primcall 'cache-set! key (val)) + (emit-cache-set! asm key (from-sp (slot val)))) (($ $primcall 'scm-set! annotation (obj idx val)) (emit-scm-set! asm (from-sp (slot obj)) (from-sp (slot idx)) (from-sp (slot val)))) diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm index eec757bce..0426ccd95 100644 --- a/module/language/cps/reify-primitives.scm +++ b/module/language/cps/reify-primitives.scm @@ -239,7 +239,8 @@ wind unwind push-fluid pop-fluid fluid-ref fluid-set! push-dynamic-state pop-dynamic-state - lsh rsh lsh/immediate rsh/immediate)) + lsh rsh lsh/immediate rsh/immediate + cache-ref cache-set!)) (let ((table (make-hash-table))) (for-each (match-lambda ((inst . _) (hashq-set! table inst #t))) diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm index 56644fdf4..4c4eec463 100644 --- a/module/system/vm/assembler.scm +++ b/module/system/vm/assembler.scm @@ -227,6 +227,9 @@ emit-resolve-module emit-lookup + emit-cache-ref + emit-cache-set! + emit-call emit-call-label emit-tail-call @@ -1121,9 +1124,8 @@ immediate, and @code{#f} otherwise." (element-size uniform-vector-backing-store-element-size)) (define-record-type <cache-cell> - (make-cache-cell scope key) + (make-cache-cell key) cache-cell? - (scope cache-cell-scope) (key cache-cell-key)) (define (simple-vector? obj) @@ -1232,16 +1234,11 @@ label." (error "expected a non-immediate" obj)) (intern-constant asm obj)) -(define (intern-cache-cell asm scope key) +(define (intern-cache-cell asm key) "Intern a cache cell into the constant table, and return its label. If there is already a cache cell with the given scope and key, it is returned instead." - (intern-constant asm (make-cache-cell scope key))) - -;; Return the label of the cell that holds the module for a scope. -(define (intern-module-cache-cell asm scope) - "Intern a cache cell for a module, and return its label." - (intern-cache-cell asm scope #t)) + (intern-constant asm (make-cache-cell key))) @@ -1499,20 +1496,26 @@ returned instead." (set-arity-definitions! arity (cons def (arity-definitions arity))))) (define-macro-assembler (cache-current-module! asm module scope) - (let ((mod-label (intern-module-cache-cell asm scope))) + (let ((mod-label (intern-cache-cell asm scope))) (emit-static-set! asm module mod-label 0))) +(define-macro-assembler (cache-ref asm dst key) + (emit-static-ref asm dst (intern-cache-cell asm key))) + +(define-macro-assembler (cache-set! asm key val) + (emit-static-set! asm val (intern-cache-cell asm key) 0)) + (define-macro-assembler (cached-toplevel-box asm dst scope sym bound?) (let ((sym-label (intern-non-immediate asm sym)) - (mod-label (intern-module-cache-cell asm scope)) - (cell-label (intern-cache-cell asm scope sym))) + (mod-label (intern-cache-cell asm scope)) + (cell-label (intern-cache-cell asm (cons scope sym)))) (emit-toplevel-box asm dst cell-label mod-label sym-label bound?))) (define-macro-assembler (cached-module-box asm dst module-name sym public? bound?) (let* ((sym-label (intern-non-immediate asm sym)) (key (cons public? module-name)) (mod-name-label (intern-constant asm key)) - (cell-label (intern-cache-cell asm key sym))) + (cell-label (intern-cache-cell asm (acons public? module-name sym)))) (emit-module-box asm dst cell-label mod-name-label sym-label bound?))) (define-macro-assembler (slot-map asm proc-slot slot-map) |