diff options
author | Andy Wingo <wingo@pobox.com> | 2013-10-26 15:40:49 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-10-26 15:40:49 +0200 |
commit | 4f406fea7e9f85a3fdc3d9a69654475bd6665586 (patch) | |
tree | 1a2b0bfb41c90fb14a6f3401aa2166c9544701b2 | |
parent | d023ae8679654305f9b34bda53c750f91a1acde4 (diff) | |
download | guile-4f406fea7e9f85a3fdc3d9a69654475bd6665586.tar.gz |
Compile variable-ref, variable-set!
* libguile/vm-engine (box-ref, box-set!): Instead of aborting if a box
isn't a var, call out to vm_error_not_a_variable. This makes these
instructions equivalent to variable-ref/variable-set!.
(vector-set!): Rename from vector-set.
* module/language/cps/compile-rtl.scm (emit-rtl-sequence): Add
variable-set! case, and adapt vector-set!.
* module/language/cps/primitives.scm (*rtl-instruction-aliases*): Add
variable-ref / variable-set! aliases to box-ref / box-set!.
-rw-r--r-- | libguile/vm-engine.c | 8 | ||||
-rw-r--r-- | module/language/cps/compile-rtl.scm | 4 | ||||
-rw-r--r-- | module/language/cps/primitives.scm | 3 |
3 files changed, 10 insertions, 5 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 2e362c996..53c719d05 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -1839,7 +1839,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM var; SCM_UNPACK_RTL_12_12 (op, dst, src); var = LOCAL_REF (src); - VM_ASSERT (SCM_VARIABLEP (var), abort ()); + VM_ASSERT (SCM_VARIABLEP (var), + vm_error_not_a_variable ("variable-ref", var)); VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (SCM_FRAME_PROGRAM (fp), var)); LOCAL_SET (dst, VARIABLE_REF (var)); @@ -1856,7 +1857,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) SCM var; SCM_UNPACK_RTL_12_12 (op, dst, src); var = LOCAL_REF (dst); - VM_ASSERT (SCM_VARIABLEP (var), abort ()); + VM_ASSERT (SCM_VARIABLEP (var), + vm_error_not_a_variable ("variable-set!", var)); VARIABLE_SET (var, LOCAL_REF (src)); NEXT (1); } @@ -2906,7 +2908,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_) * * Store SRC into the vector DST at index IDX. */ - VM_DEFINE_OP (92, vector_set, "vector-set", OP1 (U8_U8_U8_U8)) + VM_DEFINE_OP (92, vector_set, "vector-set!", OP1 (U8_U8_U8_U8)) { scm_t_uint8 dst, idx_var, src; SCM vect, idx, val; diff --git a/module/language/cps/compile-rtl.scm b/module/language/cps/compile-rtl.scm index b979a6be9..ea697e2ac 100644 --- a/module/language/cps/compile-rtl.scm +++ b/module/language/cps/compile-rtl.scm @@ -215,7 +215,9 @@ (($ $primcall 'struct-set! (struct index value)) (emit-struct-set! asm (slot struct) (slot index) (slot value))) (($ $primcall 'vector-set! (vector index value)) - (emit-vector-set asm (slot vector) (slot index) (slot value))) + (emit-vector-set! asm (slot vector) (slot index) (slot value))) + (($ $primcall 'variable-set! (var val)) + (emit-box-set! asm (slot var) (slot val))) (($ $primcall 'set-car! (pair value)) (emit-set-car! asm (slot pair) (slot value))) (($ $primcall 'set-cdr! (pair value)) diff --git a/module/language/cps/primitives.scm b/module/language/cps/primitives.scm index 74ff65c88..c25855371 100644 --- a/module/language/cps/primitives.scm +++ b/module/language/cps/primitives.scm @@ -39,7 +39,8 @@ (quotient . quo) (remainder . rem) (modulo . mod) (define! . define) - (vector-set! . vector-set))) + (variable-ref . box-ref) + (variable-set! . box-set!))) (define *macro-instruction-arities* '((cache-current-module! . (0 . 2)) |