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'.

diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 02dbd5f..e5e73dd 100644 (file)
--- 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"

diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index bfa57a1..8a72e93 100644 (file)
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -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

diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 848aa8d..83bfc0e 100644 (file)
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -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