1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 08:20:20 +02:00

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'.
This commit is contained in:
Ludovic Courtès 2010-01-23 16:43:50 +01:00
parent 696ac4dfcc
commit a752c0dc27
3 changed files with 79 additions and 3 deletions

View file

@ -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"

View file

@ -118,6 +118,8 @@
((variable-set . 2) . variable-set)
((struct? . 1) . struct?)
((struct-vtable . 1) . struct-vtable)
((struct-ref . 2) . struct-ref)
((struct-set! . 3) . struct-set)
(make-struct . make-struct)
;; hack for javascript

View file

@ -58,7 +58,7 @@
variable-ref variable-set!
;; args of variable-set are switched; it needs special help
struct? struct-vtable make-struct
struct? struct-vtable make-struct struct-ref struct-set!
bytevector-u8-ref bytevector-u8-set!
bytevector-s8-ref bytevector-s8-set!
@ -112,7 +112,7 @@
caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
vector-ref
struct? struct-vtable make-struct
struct? struct-vtable make-struct struct-ref
bytevector-u8-ref bytevector-s8-ref
bytevector-u16-ref bytevector-u16-native-ref
bytevector-s16-ref bytevector-s16-native-ref