Add opcodes for struct?', struct-vtable', and `make-struct'.

* libguile/vm-engine.c (VM_NAME)[vm_error_not_a_struct]: New label.

* libguile/vm-i-scheme.c (VM_VALIDATE_STRUCT): New macro.
  (struct_p, struct_vtable, make_struct): New instructions.

* module/language/tree-il/compile-glil.scm (*primcall-ops*): Add
  `struct?', `struct-vtable', and `make-struct'.

* module/language/tree-il/primitives.scm (*interesting-primitive-names*,
  *effect-free-primitives*): Likewise.

libguile/vm-engine.c

@@ -206,6 +206,12 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
     /* shouldn't get here */
     goto vm_error;
 
+  vm_error_not_a_struct:
+    SYNC_ALL ();
+    scm_wrong_type_arg_msg (FUNC_NAME, 1, finish_args, "struct");
+    /* shouldn't get here */
+    goto vm_error;
+
   vm_error_no_values:
     err_msg  = scm_from_locale_string ("Zero values returned to single-valued continuation");
     finish_args = SCM_EOL;

libguile/vm-i-scheme.c

@@ -621,6 +621,40 @@ BV_FLOAT_SET (f64, ieee_double, double, 8)
 #undef BV_INT_SET
 #undef BV_FLOAT_SET
 
+#define VM_VALIDATE_STRUCT(obj)			\
+  if (SCM_UNLIKELY (!SCM_STRUCTP (obj)))	\
+    {						\
+      finish_args = (obj);			\
+      goto vm_error_not_a_struct;		\
+    }
+
+VM_DEFINE_FUNCTION (174, struct_p, "struct?", 1)
+{
+  ARGS1 (obj);
+  RETURN (scm_from_bool (SCM_STRUCTP (obj)));
+}
+
+VM_DEFINE_FUNCTION (175, struct_vtable, "struct-vtable", 1)
+{
+  ARGS1 (obj);
+  VM_VALIDATE_STRUCT (obj);
+  RETURN (SCM_STRUCT_VTABLE (obj));
+}
+
+VM_DEFINE_INSTRUCTION (176, make_struct, "make-struct", 2, -1, 1)
+{
+  unsigned h = FETCH ();
+  unsigned l = FETCH ();
+  int 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;
+
+  RETURN (scm_c_make_structv (vtable, scm_to_size_t (n_tail),
+			      n_args - 2, (scm_t_bits *) inits));
+}
+
 /*
 (defun renumber-ops ()
   "start from top of buffer and renumber 'VM_DEFINE_FOO (\n' sequences"

module/language/tree-il/compile-glil.scm

@@ -115,6 +115,9 @@
    ((variable-ref . 1) . variable-ref)
    ;; nb, *not* variable-set! -- the args are switched
    ((variable-set . 2) . variable-set)
+   ((struct? . 1) . struct?)
+   ((struct-vtable . 1) . struct-vtable)
+   (make-struct . make-struct)
 
    ;; hack for javascript
    ((return . 1) return)

module/language/tree-il/primitives.scm

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