Implement primitives to read and write type/datum of object in memory.

diff --git a/src/microcode/prim.c b/src/microcode/prim.c
index c7417a373068dc28e6b1c9a5c9a1d4f996d0719d..916a123205b04c6462328be46f5f118ac08ed3b1 100644 (file)
--- a/src/microcode/prim.c
+++ b/src/microcode/prim.c
@@ -163,11 +163,35 @@ INDEX must be an unsigned integer.\n\
 Fetches the object at offset INDEX in OBJECT.")
 {
   PRIMITIVE_HEADER (2);
-  SCHEME_OBJECT * address = arg_address (1);
+  SCHEME_OBJECT * address = (arg_address (1));
   unsigned long index = (arg_ulong_integer (2));
   PRIMITIVE_RETURN (address[index]);
 }
 
+DEFINE_PRIMITIVE ("PRIMITIVE-TYPE-REF", Prim_prim_type_ref, 2, 2,
+  "(OBJECT INDEX)\n\
+OBJECT must be a pointer type.\n\
+INDEX must be an unsigned integer.\n\
+Fetches the type of the object at offset INDEX in OBJECT.")
+{
+  PRIMITIVE_HEADER (2);
+  SCHEME_OBJECT * address = (arg_address (1));
+  unsigned long index = (arg_ulong_integer (2));
+  PRIMITIVE_RETURN (ulong_to_integer (OBJECT_TYPE (address[index])));
+}
+
+DEFINE_PRIMITIVE ("PRIMITIVE-DATUM-REF", Prim_prim_datum_ref, 2, 2,
+  "(OBJECT INDEX)\n\
+OBJECT must be a pointer type.\n\
+INDEX must be an unsigned integer.\n\
+Fetches the datum of the object at offset INDEX in OBJECT.")
+{
+  PRIMITIVE_HEADER (2);
+  SCHEME_OBJECT * address = (arg_address (1));
+  unsigned long index = (arg_ulong_integer (2));
+  PRIMITIVE_RETURN (ulong_to_integer (OBJECT_DATUM (address[index])));
+}
+
 DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-SET!", Prim_prim_obj_set, 3, 3,
 "(OBJECT INDEX VALUE)\n\
 OBJECT must be a pointer type.\n\
@@ -180,6 +204,36 @@ Stores VALUE at offset INDEX in OBJECT.")
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
 
+DEFINE_PRIMITIVE ("PRIMITIVE-TYPE-SET!", Prim_prim_type_set, 3, 3,
+"(OBJECT INDEX TYPE)\n\
+OBJECT must be a pointer type.\n\
+INDEX must be an unsigned integer.\n\
+TYPE must be a type code.\n\
+Sets the type of the object at offset INDEX in OBJECT to TYPE.")
+{
+  PRIMITIVE_HEADER (3);
+  SCHEME_OBJECT * address = (arg_address (1));
+  unsigned long index = (arg_ulong_integer (2));
+  unsigned long type = (arg_type (3));
+  (address[index]) = (OBJECT_NEW_TYPE (type, (address[index])));
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("PRIMITIVE-DATUM-SET!", Prim_prim_datum_set, 3, 3,
+"(OBJECT INDEX DATUM)\n\
+OBJECT must be a pointer type.\n\
+INDEX must be an unsigned integer.\n\
+DATUM must be a datum value.\n\
+Sets the datum of the object at offset INDEX in OBJECT to DATUM.")
+{
+  PRIMITIVE_HEADER (3);
+  SCHEME_OBJECT * address = (arg_address (1));
+  unsigned long index = (arg_ulong_integer (2));
+  unsigned long datum = (arg_datum (3));
+  (address[index]) = (OBJECT_NEW_DATUM ((address[index]), datum));
+  PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
 DEFINE_PRIMITIVE ("PRIMITIVE-BYTE-REF", Prim_prim_byte_ref, 2, 2,
   "(OBJECT INDEX)\n\
 OBJECT must be a pointer type.\n\