diff options
author | Ludovic Courtès <ludo@gnu.org> | 2010-01-23 16:43:50 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2010-01-23 16:43:50 +0100 |
commit | a752c0dc2798fb1af93d56f6f73bea964df12633 (patch) | |
tree | b688e633aa60189b59405289e14c1e1532e7a688 /libguile/vm-i-scheme.c | |
parent | 696ac4dfcc4e48c95df8935fc3640377c5df18fb (diff) | |
download | guile-a752c0dc2798fb1af93d56f6f73bea964df12633.tar.gz |
Add `struct-ref' and `struct-set' VM opcodes.
* libguile/vm-i-scheme.c (make_struct): Optimize the
`SCM_VTABLE_FLAG_SIMPLE' case.
(struct_ref, struct_set): New opcodes.
* module/language/tree-il/compile-glil.scm (*primcall-ops*): Add
`struct-ref' and `struct-set!'.
* module/language/tree-il/primitives.scm
(*interesting-primitive-names*): Likewise.
(*effect-free-primitives*): Add `struct-ref'.
Diffstat (limited to 'libguile/vm-i-scheme.c')
-rw-r--r-- | libguile/vm-i-scheme.c | 76 |
1 files changed, 75 insertions, 1 deletions
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c index 02dbd5fc8..e5e73dd99 100644 --- a/libguile/vm-i-scheme.c +++ b/libguile/vm-i-scheme.c @@ -645,12 +645,32 @@ VM_DEFINE_INSTRUCTION (176, make_struct, "make-struct", 2, -1, 1) { unsigned h = FETCH (); unsigned l = FETCH (); - int n_args = ((h << 8U) + l); + scm_t_bits n_args = ((h << 8U) + l); SCM vtable = sp[1 - n_args], n_tail = sp[2 - n_args]; const SCM *inits = sp - n_args + 3; sp -= n_args - 1; + if (SCM_LIKELY (SCM_STRUCTP (vtable) + && SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE) + && SCM_I_INUMP (n_tail))) + { + scm_t_bits n_inits, len; + + n_inits = SCM_I_INUM (n_tail) + n_args - 2; + len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size); + + if (SCM_LIKELY (n_inits == len)) + { + SCM obj; + + obj = scm_i_alloc_struct (SCM_STRUCT_DATA (vtable), n_inits); + memcpy (SCM_STRUCT_DATA (obj), inits, n_inits * sizeof (SCM)); + + RETURN (obj); + } + } + SYNC_REGISTER (); RETURN (scm_c_make_structv (vtable, scm_to_size_t (n_tail), n_args - 2, (scm_t_bits *) inits)); @@ -672,6 +692,60 @@ VM_DEFINE_INSTRUCTION (177, make_array, "make-array", 3, -1, 1) NEXT; } +VM_DEFINE_FUNCTION (178, struct_ref, "struct-ref", 2) +{ + ARGS2 (obj, pos); + + if (SCM_LIKELY (SCM_STRUCTP (obj) + && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, + SCM_VTABLE_FLAG_SIMPLE) + && SCM_I_INUMP (pos))) + { + SCM vtable; + scm_t_bits index, len; + + index = SCM_I_INUM (pos); + vtable = SCM_STRUCT_VTABLE (obj); + len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size); + + if (SCM_LIKELY (index < len)) + { + scm_t_bits *data = SCM_STRUCT_DATA (obj); + RETURN (SCM_PACK (data[index])); + } + } + + RETURN (scm_struct_ref (obj, pos)); +} + +VM_DEFINE_FUNCTION (179, struct_set, "struct-set", 3) +{ + ARGS3 (obj, pos, val); + + if (SCM_LIKELY (SCM_STRUCTP (obj) + && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, + SCM_VTABLE_FLAG_SIMPLE) + && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj, + SCM_VTABLE_FLAG_SIMPLE_RW) + && SCM_I_INUMP (pos))) + { + SCM vtable; + scm_t_bits index, len; + + index = SCM_I_INUM (pos); + vtable = SCM_STRUCT_VTABLE (obj); + len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size); + if (SCM_LIKELY (index < len)) + { + scm_t_bits *data = SCM_STRUCT_DATA (obj); + data[index] = SCM_UNPACK (val); + RETURN (val); + } + } + + RETURN (scm_struct_set_x (obj, pos, val)); +} + /* (defun renumber-ops () "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences" |