summaryrefslogtreecommitdiff
path: root/libguile/vm-i-scheme.c
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-01-23 16:43:50 +0100
committerLudovic Courtès <ludo@gnu.org>2010-01-23 16:43:50 +0100
commita752c0dc2798fb1af93d56f6f73bea964df12633 (patch)
treeb688e633aa60189b59405289e14c1e1532e7a688 /libguile/vm-i-scheme.c
parent696ac4dfcc4e48c95df8935fc3640377c5df18fb (diff)
downloadguile-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.c76
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"