[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 09/16: Add intrinsics for module operations
From: |
Andy Wingo |
Subject: |
[Guile-commits] 09/16: Add intrinsics for module operations |
Date: |
Mon, 14 May 2018 10:48:35 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit fb344a25d5fab1714eb1d5ca66bad96fb4834855
Author: Andy Wingo <address@hidden>
Date: Sun May 13 10:23:28 2018 +0200
Add intrinsics for module operations
* libguile/intrinsics.c (scm_bootstrap_intrinsics):
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS):
* module/system/vm/assembler.scm (resolve-module, lookup): New intrinsics.
* module/language/cps/compile-bytecode: Add cases for primcalls
corresponding to new intrinsics.
---
libguile/intrinsics.c | 38 ++++++++++++++++++++++++++++++++
libguile/intrinsics.h | 2 ++
module/language/cps/compile-bytecode.scm | 4 ++++
module/system/vm/assembler.scm | 7 ++++++
4 files changed, 51 insertions(+)
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index c361e46..64f8d7f 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -220,6 +220,42 @@ numerically_equal_p (SCM a, SCM b)
return scm_is_true (scm_num_eq_p (a, b));
}
+static SCM
+resolve_module (SCM name, scm_t_uint8 public_p)
+{
+ SCM mod;
+
+ if (!scm_module_system_booted_p)
+ return SCM_BOOL_F;
+
+ mod = scm_maybe_resolve_module (name);
+ if (scm_is_false (mod))
+ scm_misc_error (NULL, "Module named ~s does not exist",
+ scm_list_1 (name));
+
+ if (public_p)
+ {
+ mod = scm_module_public_interface (mod);
+
+ if (scm_is_false (mod))
+ scm_misc_error (NULL, "Module named ~s has no public interface",
+ scm_list_1 (name));
+ }
+
+ return mod;
+}
+
+static SCM
+lookup (SCM module, SCM name)
+{
+ /* If MODULE was captured before modules were booted, use the root
+ module. Not so nice, but hey... */
+ if (scm_is_false (module))
+ module = scm_the_root_module ();
+
+ return scm_module_variable (module, name);
+}
+
void
scm_bootstrap_intrinsics (void)
{
@@ -262,6 +298,8 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.heap_numbers_equal_p = scm_i_heap_numbers_equal_p;
scm_vm_intrinsics.less_p = less_p;
scm_vm_intrinsics.numerically_equal_p = numerically_equal_p;
+ scm_vm_intrinsics.resolve_module = resolve_module;
+ scm_vm_intrinsics.lookup = lookup;
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_intrinsics",
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index 9d8010a..9d5bc7d 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -82,6 +82,8 @@ typedef enum scm_compare
(*scm_t_compare_from_scm_scm_intrinsic) (SCM, SCM);
M(bool_from_scm_scm, heap_numbers_equal_p, "heap-numbers-equal?",
HEAP_NUMBERS_EQUAL_P) \
M(compare_from_scm_scm, less_p, "<?", LESS_P) \
M(bool_from_scm_scm, numerically_equal_p, "=?", NUMERICALLY_EQUAL_P) \
+ M(scm_from_scm_uimm, resolve_module, "resolve-module", RESOLVE_MODULE) \
+ M(scm_from_scm_scm, lookup, "lookup", LOOKUP) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic
diff --git a/module/language/cps/compile-bytecode.scm
b/module/language/cps/compile-bytecode.scm
index 88da194..426942c 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -175,6 +175,10 @@
(($ $primcall 'tail-pointer-ref/immediate (annotation . idx) (obj))
(emit-tail-pointer-ref/immediate asm (from-sp dst) (from-sp (slot
obj))
idx))
+ (($ $primcall 'resolve-module public? (name))
+ (emit-resolve-module asm (from-sp dst) (from-sp (slot name)) public?))
+ (($ $primcall 'lookup #f (mod name))
+ (emit-lookup 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))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 5943429..56644fd 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -224,6 +224,8 @@
emit-rsh
emit-lsh/immediate
emit-rsh/immediate
+ emit-resolve-module
+ emit-lookup
emit-call
emit-call-label
@@ -1336,6 +1338,9 @@ returned instead."
(define-syntax-rule (define-scm<-scm-u64-intrinsic name)
(define-macro-assembler (name asm dst a b)
(emit-call-scm<-scm-u64 asm dst a b (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm<-scm-bool-intrinsic name)
+ (define-macro-assembler (name asm dst a b)
+ (emit-call-scm<-scm-uimm asm dst a (if b 1 0) (intrinsic-name->index
'name))))
(define-scm<-scm-scm-intrinsic add)
(define-scm<-scm-uimm-intrinsic add/immediate)
@@ -1373,6 +1378,8 @@ returned instead."
(define-scm<-scm-u64-intrinsic rsh)
(define-scm<-scm-uimm-intrinsic lsh/immediate)
(define-scm<-scm-uimm-intrinsic rsh/immediate)
+(define-scm<-scm-bool-intrinsic resolve-module)
+(define-scm<-scm-scm-intrinsic lookup)
(define-macro-assembler (begin-program asm label properties)
(emit-label asm label)
- [Guile-commits] 06/16: Remove unused macros in VM, (continued)
- [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, 2018/05/14
- [Guile-commits] 09/16: Add intrinsics for module operations,
Andy Wingo <=
- [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