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

Add new lookup, lookup-bound intrinsics

Browse source 
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS):
* libguile/intrinsics.c (lookup, lookup_bound):
* libguile/intrinsics.c (scm_bootstrap_intrinsics): New intrinsics.
* module/language/cps/reify-primitives.scm (reify-primitives):
* module/language/cps/effects-analysis.scm (current-module):
* module/language/cps/compile-bytecode.scm (compile-function):
* module/system/vm/assembler.scm: Add compiler support.
This commit is contained in:
Andy Wingo 2020-05-11 10:00:30 +02:00
parent d6b6392cfb
commit 4274d615cc
6 changed files with 42 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -189,6 +189,12 @@
(($ $primcall 'module-variable #f (mod name))
(emit-module-variable asm (from-sp dst) (from-sp (slot mod))
(from-sp (slot name))))
(($ $primcall 'lookup #f (mod name))
(emit-lookup asm (from-sp dst) (from-sp (slot mod))
(from-sp (slot name))))
(($ $primcall 'lookup-bound #f (mod name))
(emit-lookup-bound asm (from-sp dst) (from-sp (slot mod))
(from-sp (slot name))))
(($ $primcall 'add/immediate y (x))
(emit-add/immediate asm (from-sp dst) (from-sp (slot x)) y))
(($ $primcall 'sub/immediate y (x))

2
module/language/cps/effects-analysis.scm
View file

@ -486,6 +486,8 @@ the LABELS that are clobbered by the effects of LABEL."
((resolve name) (&read-object &module) &type-check)
((resolve-module mod) (&read-object &module) &type-check)
((module-variable mod name) (&read-object &module) &type-check)
((lookup mod name) (&read-object &module) &type-check)
((lookup-bound mod name) (&read-object &module) &type-check)
((cached-toplevel-box) &type-check)
((cached-module-box) &type-check)
((define! mod name) (&read-object &module)))

3
module/language/cps/reify-primitives.scm
View file

@ -354,7 +354,8 @@
push-dynamic-state pop-dynamic-state
lsh rsh lsh/immediate rsh/immediate
cache-ref cache-set!
resolve-module module-variable define! current-module))
current-module resolve-module
module-variable lookup lookup-bound define!))
(let ((table (make-hash-table)))
(for-each
(match-lambda ((inst . _) (hashq-set! table inst #t)))

4
module/system/vm/assembler.scm
View file

@ -257,6 +257,8 @@
emit-rsh/immediate
emit-resolve-module
emit-module-variable
emit-lookup
emit-lookup-bound
emit-define!
emit-current-module
@ -1494,6 +1496,8 @@ returned instead."
(define-scm<-scm-uimm-intrinsic rsh/immediate)
(define-scm<-scm-bool-intrinsic resolve-module)
(define-scm<-scm-scm-intrinsic module-variable)
(define-scm<-scm-scm-intrinsic lookup)
(define-scm<-scm-scm-intrinsic lookup-bound)
(define-scm<-scm-scm-intrinsic define!)
(define-scm<-thread-intrinsic current-module)