From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 17 Apr 2017 01:47:37 +0000 (-0700)
Subject: Implement primitives to read and write type/datum of object in memory.
X-Git-Tag: mit-scheme-pucked-9.2.12~158^2~41
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4ca3ad252f426207b070f7881071e25dc2191e89;p=mit-scheme.git

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 c7417a373..916a12320 100644
--- 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\