Simplify module variable lookup slow-path

* libguile/intrinsics.h:
* libguile/intrinsics.c (lookup_bound_public, lookup_bound_private): Two
new intrinsics.
(scm_bootstrap_intrinsics): Wire them up.
* libguile/jit.c (compile_call_scm_from_scmn_scmn):
(compile_call_scm_from_scmn_scmn_slow):
(COMPILE_X8_S24__N32__N32__C32): Add JIT support for new instruction
kind.
* libguile/vm-engine.c (call-scm<-scmn-scmn): New instruction, takes
arguments as non-immediate offsets, to avoid needless loads and register
pressure.
* module/language/cps/effects-analysis.scm: Add cases for new
primcalls.
* module/language/cps/compile-bytecode.scm (compile-function): Add new
primcalls.
* module/language/cps/reify-primitives.scm (cached-module-box): If the
variable is bound, call lookup-bound-public / lookup-bound-private as
appropriate instead of separately resolving the module, name, and doing
the bound check.
* module/language/tree-il/compile-bytecode.scm (emit-cached-module-box):
Use new instructions.
* module/system/vm/assembler.scm (define-scm<-scmn-scmn-intrinsic):
(lookup-bound-public, lookup-bound-private): Add assembler support.

1 files changed, 11 insertions, 0 deletions

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index c94cec3af..8a6ca4e47 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -254,6 +254,8 @@
             emit-module-variable
             emit-lookup
             emit-lookup-bound
+            emit-lookup-bound-public
+            emit-lookup-bound-private
             emit-define!
             emit-current-module
 
@@ -1495,6 +1497,13 @@ returned instead."
 (define-syntax-rule (define-scm-scm-scm-intrinsic name)
   (define-macro-assembler (name asm a b c)
     (emit-call-scm-scm-scm asm a b c (intrinsic-name->index 'name))))
+(define-syntax-rule (define-scm<-scmn-scmn-intrinsic name)
+  (define-macro-assembler (name asm dst a b)
+    (unless (statically-allocatable? a) (error "not statically allocatable" a))
+    (unless (statically-allocatable? b) (error "not statically allocatable" b))
+    (let ((a (intern-constant asm a))
+          (b (intern-constant asm b)))
+      (emit-call-scm<-scmn-scmn asm dst a b (intrinsic-name->index 'name)))))
 
 (define-scm<-scm-scm-intrinsic add)
 (define-scm<-scm-uimm-intrinsic add/immediate)
@@ -1559,6 +1568,8 @@ returned instead."
 (define-scm<-scm-scm-intrinsic module-variable)
 (define-scm<-scm-scm-intrinsic lookup)
 (define-scm<-scm-scm-intrinsic lookup-bound)
+(define-scm<-scmn-scmn-intrinsic lookup-bound-public)
+(define-scm<-scmn-scmn-intrinsic lookup-bound-private)
 (define-scm<-scm-scm-intrinsic define!)
 (define-scm<-thread-intrinsic current-module)