summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/vm-i-system.c28
-rw-r--r--module/language/glil/compile-assembly.scm44
2 files changed, 62 insertions, 10 deletions
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index e12217ecc..c2c674d27 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -278,6 +278,16 @@ VM_DEFINE_INSTRUCTION (25, local_ref, "local-ref", 1, 0, 1)
NEXT;
}
+VM_DEFINE_INSTRUCTION (26, long_local_ref, "long-local-ref", 2, 0, 1)
+{
+ unsigned int i = FETCH ();
+ i <<= 8;
+ i += FETCH ();
+ PUSH (LOCAL_REF (i))
+ ASSERT_BOUND (*sp);
+ NEXT;
+}
+
VM_DEFINE_INSTRUCTION (27, variable_ref, "variable-ref", 0, 0, 1)
{
SCM x = *sp;
@@ -354,6 +364,16 @@ VM_DEFINE_INSTRUCTION (30, local_set, "local-set", 1, 1, 0)
NEXT;
}
+VM_DEFINE_INSTRUCTION (31, long_local_set, "long-local-set", 2, 1, 0)
+{
+ unsigned int i = FETCH ();
+ i <<= 8;
+ i += FETCH ();
+ LOCAL_SET (i, *sp);
+ DROP ();
+ NEXT;
+}
+
VM_DEFINE_INSTRUCTION (32, variable_set, "variable-set", 0, 1, 0)
{
VARIABLE_SET (sp[0], sp[-1]);
@@ -1183,6 +1203,14 @@ VM_DEFINE_INSTRUCTION (63, make_closure, "make-closure", 0, 2, 1)
NEXT;
}
+VM_DEFINE_INSTRUCTION (64, make_variable, "make-variable", 0, 0, 1)
+{
+ SYNC_BEFORE_GC ();
+ /* fixme underflow */
+ PUSH (scm_cell (scm_tc7_variable, SCM_UNPACK (SCM_UNDEFINED)));
+ NEXT;
+}
+
/*
(defun renumber-ops ()
diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index c7e26a825..9a5cae04f 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -242,18 +242,42 @@
((<glil-lexical> local? boxed? op index)
(emit-code
- `((,(if local?
- (case op
- ((ref) (if boxed? 'local-boxed-ref 'local-ref))
- ((set) (if boxed? 'local-boxed-set 'local-set))
- ((box) 'box)
- ((empty-box) 'empty-box)
- (else (error "what" op)))
- (case op
+ (if local?
+ (if (< index 256)
+ `((,(case op
+ ((ref) (if boxed? 'local-boxed-ref 'local-ref))
+ ((set) (if boxed? 'local-boxed-set 'local-set))
+ ((box) 'box)
+ ((empty-box) 'empty-box)
+ (else (error "what" op)))
+ ,index))
+ (let ((a (quotient i 256))
+ (b (modulo i 256)))
+ `((,(case op
+ ((ref)
+ (if boxed?
+ `((long-local-ref ,a ,b)
+ (variable-ref))
+ `((long-local-ref ,a ,b))))
+ ((set)
+ (if boxed?
+ `((long-local-ref ,a ,b)
+ (variable-set))
+ `((long-local-set ,a ,b))))
+ ((box)
+ `((make-variable)
+ (variable-set)
+ (long-local-set ,a ,b)))
+ ((empty-box)
+ `((make-variable)
+ (long-local-set ,a ,b)))
+ (else (error "what" op)))
+ ,index))))
+ `((,(case op
((ref) (if boxed? 'free-boxed-ref 'free-ref))
((set) (if boxed? 'free-boxed-set (error "what." glil)))
- (else (error "what" op))))
- ,index))))
+ (else (error "what" op)))
+ ,index)))))
((<glil-toplevel> op name)
(case op