[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/13: Compile current-module as intrinsic call
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/13: Compile current-module as intrinsic call |
Date: |
Wed, 27 Jun 2018 14:00:11 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 8918165c4050766dd920b66df9fdad33eb3f42d7
Author: Andy Wingo <address@hidden>
Date: Wed Jun 27 14:57:51 2018 +0200
Compile current-module as intrinsic call
* libguile/fluids.c (scm_i_fluid_ref): New internal function.
(scm_fluid_ref): Use scm_i_fluid_ref.
* libguile/intrinsics.h:
* libguile/intrinsics.c (current_module): New intrinsic.
* libguile/modules.c (scm_i_current_module): New internal function.
(scm_current_module): Use new internal function.
* module/language/cps/reify-primitives.scm (compute-known-primitives):
Add current-module as an intrinsic primitive.
* module/system/vm/assembler.scm (define-scm<-thread-intrinsic):
(current-module): Arrange to compile to intrinsic call.
---
libguile/fluids.c | 17 ++++++++++++-----
libguile/fluids.h | 2 ++
libguile/intrinsics.c | 7 +++++++
libguile/intrinsics.h | 2 ++
libguile/modules.c | 15 +++++++++++----
libguile/modules.h | 1 +
module/language/cps/reify-primitives.scm | 2 +-
module/system/vm/assembler.scm | 6 +++++-
8 files changed, 41 insertions(+), 11 deletions(-)
diff --git a/libguile/fluids.c b/libguile/fluids.c
index db14f17..f626933 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -370,6 +370,17 @@ fluid_ref (scm_t_dynamic_state *dynamic_state, SCM fluid)
return val;
}
+SCM
+scm_i_fluid_ref (scm_thread *thread, SCM fluid)
+{
+ SCM ret = fluid_ref (thread->dynamic_state, fluid);
+
+ if (SCM_UNBNDP (ret))
+ scm_misc_error ("fluid-ref", "unbound fluid: ~S", scm_list_1 (fluid));
+
+ return ret;
+}
+
SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
(SCM fluid),
"Return the value associated with @var{fluid} in the current\n"
@@ -377,12 +388,8 @@ SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
"its default value.")
#define FUNC_NAME s_scm_fluid_ref
{
- SCM ret;
SCM_VALIDATE_FLUID (1, fluid);
- ret = fluid_ref (SCM_I_CURRENT_THREAD->dynamic_state, fluid);
- if (SCM_UNBNDP (ret))
- scm_misc_error ("fluid-ref", "unbound fluid: ~S", scm_list_1 (fluid));
- return ret;
+ return scm_i_fluid_ref (SCM_I_CURRENT_THREAD, fluid);
}
#undef FUNC_NAME
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 1d4f1af..ffcb489 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -66,6 +66,8 @@ SCM_API SCM scm_fluid_set_x (SCM fluid, SCM value);
SCM_API SCM scm_fluid_unset_x (SCM fluid);
SCM_API SCM scm_fluid_bound_p (SCM fluid);
+SCM_INTERNAL SCM scm_i_fluid_ref (scm_thread *thread, SCM fluid);
+
SCM_INTERNAL void scm_swap_fluid (SCM fluid, SCM value_box,
scm_t_dynamic_state *dynamic_state);
diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index cc8cd2b..59192d1 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -340,6 +340,12 @@ allocate_words (scm_thread *thread, uint64_t n)
return SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, n));
}
+static SCM
+current_module (scm_thread *thread)
+{
+ return scm_i_current_module (thread);
+}
+
void
scm_bootstrap_intrinsics (void)
@@ -394,6 +400,7 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.error_not_enough_values = error_not_enough_values;
scm_vm_intrinsics.error_wrong_number_of_values =
error_wrong_number_of_values;
scm_vm_intrinsics.allocate_words = allocate_words;
+ scm_vm_intrinsics.current_module = current_module;
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_intrinsics",
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index 02045f3..7a122d9 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -63,6 +63,7 @@ typedef void (*scm_t_noreturn_intrinsic) (void) SCM_NORETURN;
typedef void (*scm_t_scm_noreturn_intrinsic) (SCM) SCM_NORETURN;
typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) SCM_NORETURN;
typedef SCM (*scm_t_scm_from_thread_u64_intrinsic) (scm_thread*, uint64_t);
+typedef SCM (*scm_t_scm_from_thread_intrinsic) (scm_thread*);
#define SCM_FOR_ALL_VM_INTRINSICS(M) \
M(scm_from_scm_scm, add, "add", ADD) \
@@ -127,6 +128,7 @@ typedef SCM (*scm_t_scm_from_thread_u64_intrinsic)
(scm_thread*, uint64_t);
M(u32_noreturn, error_wrong_number_of_values, "wrong-number-of-values",
ERROR_WRONG_NUMBER_OF_VALUES) \
M(thread, apply_non_program, "apply-non-program", APPLY_NON_PROGRAM) \
M(scm_from_thread_u64, allocate_words, "allocate-words", ALLOCATE_WORDS) \
+ M(scm_from_thread, current_module, "current-module", CURRENT_MODULE) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic
diff --git a/libguile/modules.c b/libguile/modules.c
index 871d87f..751d907 100644
--- a/libguile/modules.c
+++ b/libguile/modules.c
@@ -38,6 +38,7 @@
#include "smob.h"
#include "struct.h"
#include "symbols.h"
+#include "threads.h"
#include "variable.h"
#include "vectors.h"
@@ -81,15 +82,21 @@ scm_the_root_module (void)
return SCM_BOOL_F;
}
+SCM
+scm_i_current_module (scm_thread *thread)
+{
+ if (scm_module_system_booted_p)
+ return scm_i_fluid_ref (thread, the_module);
+ else
+ return SCM_BOOL_F;
+}
+
SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
(),
"Return the current module.")
#define FUNC_NAME s_scm_current_module
{
- if (scm_module_system_booted_p)
- return scm_fluid_ref (the_module);
- else
- return SCM_BOOL_F;
+ return scm_i_current_module (SCM_I_CURRENT_THREAD);
}
#undef FUNC_NAME
diff --git a/libguile/modules.h b/libguile/modules.h
index dbd5f0c..34edb32 100644
--- a/libguile/modules.h
+++ b/libguile/modules.h
@@ -65,6 +65,7 @@ SCM_API scm_t_bits scm_module_tag;
SCM_API SCM scm_current_module (void);
+SCM_INTERNAL SCM scm_i_current_module (scm_thread *thread);
SCM_API SCM scm_the_root_module (void);
SCM_API SCM scm_interaction_environment (void);
SCM_API SCM scm_set_current_module (SCM module);
diff --git a/module/language/cps/reify-primitives.scm
b/module/language/cps/reify-primitives.scm
index e3dfee8..6ec9029 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -331,7 +331,7 @@
push-dynamic-state pop-dynamic-state
lsh rsh lsh/immediate rsh/immediate
cache-ref cache-set!
- resolve-module lookup define!))
+ resolve-module lookup define! current-module))
(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 650156d..e57e1ba 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -227,6 +227,7 @@
emit-resolve-module
emit-lookup
emit-define!
+ emit-current-module
emit-cache-ref
emit-cache-set!
@@ -250,7 +251,6 @@
emit-bind-kwargs
emit-bind-rest
emit-load-label
- emit-current-module
emit-resolve
emit-prompt
emit-current-thread
@@ -1336,6 +1336,9 @@ returned instead."
(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-syntax-rule (define-scm<-thread-intrinsic name)
+ (define-macro-assembler (name asm dst)
+ (emit-call-scm<-thread asm dst (intrinsic-name->index 'name))))
(define-scm<-scm-scm-intrinsic add)
(define-scm<-scm-uimm-intrinsic add/immediate)
@@ -1376,6 +1379,7 @@ returned instead."
(define-scm<-scm-bool-intrinsic resolve-module)
(define-scm<-scm-scm-intrinsic lookup)
(define-scm<-scm-scm-intrinsic define!)
+(define-scm<-thread-intrinsic current-module)
(define-macro-assembler (begin-program asm label properties)
(emit-label asm label)
- [Guile-commits] branch master updated (7883290 -> 593e2db), Andy Wingo, 2018/06/27
- [Guile-commits] 01/13: allocate-words intrinsic, Andy Wingo, 2018/06/27
- [Guile-commits] 04/13: Intrinsic for "prompt", Andy Wingo, 2018/06/27
- [Guile-commits] 07/13: Refactor handling of active VM registers, Andy Wingo, 2018/06/27
- [Guile-commits] 05/13: bind-rest inst uses cons-rest intrinsic, Andy Wingo, 2018/06/27
- [Guile-commits] 11/13: Minor optimizations to debug hook dispatch, Andy Wingo, 2018/06/27
- [Guile-commits] 02/13: Compile current-module as intrinsic call,
Andy Wingo <=
- [Guile-commits] 12/13: Microoptimizations to hook dispatch, Andy Wingo, 2018/06/27
- [Guile-commits] 13/13: Refactor hook dispatch in VM, Andy Wingo, 2018/06/27
- [Guile-commits] 09/13: Intrinsics take registers from thread, Andy Wingo, 2018/06/27
- [Guile-commits] 06/13: Use CALL_INTRINSICS helper in VM, Andy Wingo, 2018/06/27
- [Guile-commits] 08/13: Minor scm_thread refactoring, Andy Wingo, 2018/06/27
- [Guile-commits] 03/13: Remove dedicated current-module instruction., Andy Wingo, 2018/06/27
- [Guile-commits] 10/13: Remove "resume" arg from vm engine, Andy Wingo, 2018/06/27