diff options
-rw-r--r-- | libguile/vm-i-system.c | 28 | ||||
-rw-r--r-- | module/language/glil/compile-assembly.scm | 44 |
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 |