Bring the work on compile time meta-object support so far in line with my latest thinking on how stuff will work. Quite a few little changes.

Author: jnthn

src/HLL/SerializationContextBuilder.pm

@@ -37,10 +37,13 @@ class HLL::Compiler::SerializationContextBuilder::Event {
 }
 
 class HLL::Compiler::SerializationContextBuilder {
-    # The objects that live in or should be built by this context.
-    has @!root_objects;
+    # The serialization context that we're building.
+    has $!sc;
 
-    # Address => slot mapping, we we can quickly look up existing objects
+    # The handle for the context.
+    has $!handle;
+    
+    # Address => slot mapping, so we can quickly look up existing objects
     # in the context.
     has %!addr_to_slot;
     sub addr($obj) {
@@ -51,14 +54,15 @@ class HLL::Compiler::SerializationContextBuilder {
     has @!event_stream;
 
     # XXX Fix BUILD...
-    method new() {
+    method new(:$handle!) {
         my $obj := self.CREATE();
-        $obj.BUILD();
+        $obj.BUILD(:handle($handle));
         $obj
     }
 
-    method BUILD() {
-        @!root_objects := pir::new('ResizablePMCArray');
+    method BUILD(:$handle) {
+        $!sc := pir::nqp_create_sc__PS($handle);
+        $!handle := $handle;
         %!addr_to_slot := pir::new('Hash');
         @!event_stream := pir::new('ResizablePMCArray');
     }
@@ -78,18 +82,18 @@ class HLL::Compiler::SerializationContextBuilder {
     # a constant and we're using the SC as a constants table).
     method get_slot_past_for_object($obj) {
         my $slot := self.slot_for_object($obj);
-        return PAST::Op.new( :pirop('nqp_get_sc_object Pi'), $slot );
+        return PAST::Op.new( :pirop('nqp_get_sc_object Psi'), $!handle, $slot );
     }
 
     # Utility sub to wrap PAST with slot setting.
-    sub set_slot_past($slot, $past_to_set) {
-        return PAST::Op.new( :pirop('nqp_set_sc_object viP'), $slot, $past_to_set );
+    method set_slot_past($slot, $past_to_set) {
+        return PAST::Op.new( :pirop('nqp_set_sc_object vsiP'), $!handle, $slot, $past_to_set );
     }
 
     # Adds an object to the root set, along with a mapping.
     method add_object($obj) {
-        my $idx := +@!root_objects;
-        @!root_objects[$idx] := $obj;
+        my $idx := $!sc.elems();
+        $!sc[$idx] := $obj;
         %!addr_to_slot{addr($obj)} := $idx;
         $idx
     }
@@ -125,7 +129,7 @@ class HLL::Compiler::SerializationContextBuilder {
         if pir::defined($repr) {
             $setup_call.push(PAST::Val.new( :value($repr), :named('repr') ));
         }
-        self.add_event(:deserialize_past(set_slot_past($slot, $setup_call)));
+        self.add_event(:deserialize_past(self.set_slot_past($slot, $setup_call)));
 
         # Result is just the object.
         return $mo;
@@ -154,10 +158,9 @@ class HLL::Compiler::SerializationContextBuilder {
         $obj
     }
 
-    # Gets the root object graph for the serialization context, which can
-    # be attached to the compiled output.
-    method root_objects() {
-        @!root_objects
+    # Gets the built serialization context.
+    method sc() {
+        @!sc
     }
 
     # Generates a series of PAST operations that will build this context if

src/NQP/Grammar.pm

@@ -26,7 +26,9 @@ method TOP() {
     # Serialization context builder - keeps track of objects that
     # cross the compile-time/run-time boundary that are associated
     # with this compilation unit.
-    my $*SC := HLL::Compiler::SerializationContextBuilder.new();
+    my $*SC := HLL::Compiler::SerializationContextBuilder.new(
+        # XXX Need to hash the source, or something.
+        :handle(~pir::time__N()));
 
     my $*SCOPE       := '';
     my $*MULTINESS   := '';

src/metamodel/rakudoobject.h

@@ -156,6 +156,7 @@ typedef struct {
 /* Various handy macros for getting at important stuff. */
 #define STABLE_PMC(o)    (((RakudoObjectCommonalities *)PMC_data(o))->stable)
 #define STABLE(o)        ((STable *)PMC_data(STABLE_PMC(o)))
+#define SC_PMC(o)        (((RakudoObjectCommonalities *)PMC_data(o))->sc)
 #define STABLE_STRUCT(p) ((STable *)PMC_data(p))
 #define REPR_PMC(o)      (STABLE(o)->REPR)
 #define REPR(o)          ((REPRCommonalities *)PMC_data(REPR_PMC(o)))

src/metamodel/serialization_context.c

@@ -1,74 +1,31 @@
 /* This implements a little bit of support for serialization contexts.
- * At the moment, its main role is to let us have a PMC array of objects
- * per Parrot bytecode segment. This gives fast access to them. Note
- * that if this ever made it into core Parrot, we'd hang it off the
- * packfile data structure, or maybe consider whether there's a kind of
- * unification with the "constants" segment. */
+ * At the moment, its main role is to just be a global lookup table for
+ * serialization contexts; it'll need to get much smarter. */
 
 #define PARROT_IN_EXTENSION
 #include "parrot/parrot.h"
 #include "parrot/extend.h"
 
-/* Array of root object arrays, one per SC. */
-static PMC *sc_root_objects = NULL;
+/* Hash of serialization context objects */
+static PMC *scs = NULL;
 
-/* Array of bytecode segment locations. Related to the above array.
- * Just an array of integers. Can be array of bytecode PMCs later. */
-static PMC *sc_index_lookup = NULL;
-
-/* Initializes the stores and register them with the GC. */
+/* Initializes the store and register with the GC. */
 static void setup_sc_stores(PARROT_INTERP) {
-    sc_root_objects = pmc_new(interp, enum_class_ResizablePMCArray);
-    sc_index_lookup = pmc_new(interp, enum_class_ResizableIntegerArray);
-    Parrot_pmc_gc_register(interp, sc_root_objects);
-    Parrot_pmc_gc_register(interp, sc_index_lookup);
+    scs = pmc_new(interp, enum_class_Hash);
+    Parrot_pmc_gc_register(interp, scs);
 }
 
-/* Gets an object from the serialization context associated with the
- * current bytecode segment. */
-PMC * SC_get_sc_object(PARROT_INTERP, INTVAL idx) {
-    /* Locate the SC root list for this bytecode segment. */
-    INTVAL addr = (INTVAL)interp->code;
-    INTVAL scs, i;
-    if (!sc_index_lookup)
+/* Gets the serialization context - if any - associated with the
+ * specified handle. */
+PMC * SC_get_sc(PARROT_INTERP, STRING *handle) {
+    if (!scs)
         setup_sc_stores(interp);
-    scs = VTABLE_elements(interp, sc_index_lookup);
-    for (i = 0; i < scs; i++) {
-        if (VTABLE_get_integer_keyed_int(interp, sc_index_lookup, i) == addr) {
-            /* Found it; grab object we're looking for. */
-            PMC *sc_root = VTABLE_get_pmc_keyed_int(interp, sc_root_objects, i);
-            return VTABLE_get_pmc_keyed_int(interp, sc_root, idx);
-        }
-    }
-    
-    /* None found, just return PMCNULL. */
-    return PMCNULL;
+    return VTABLE_get_pmc_keyed_str(interp, scs, handle);
 }
 
-/* Puts an object into the serialization context associated with the
- * current bytecode segment. */
-void SC_set_sc_object(PARROT_INTERP, INTVAL idx, PMC *object) {
-    /* Locate the SC root list for this bytecode segment. */
-    INTVAL addr    = (INTVAL)interp->code;
-    PMC *  sc_root = PMCNULL;
-    INTVAL scs, i;
-    if (!sc_index_lookup)
+/* Stashes a serialization context with the specified handle. */
+void SC_set_sc(PARROT_INTERP, STRING *handle, PMC *sc) {
+    if (!scs)
         setup_sc_stores(interp);
-    scs = VTABLE_elements(interp, sc_index_lookup);
-    for (i = 0; i < scs; i++) {
-        if (VTABLE_get_integer_keyed_int(interp, sc_index_lookup, i) == addr) {
-            sc_root = VTABLE_get_pmc_keyed_int(interp, sc_root_objects, i);
-            break;
-        }
-    }
-    
-    /* If we found none, add it. */
-    if (PMC_IS_NULL(sc_root)) {
-        sc_root = pmc_new(interp, enum_class_ResizablePMCArray);
-        VTABLE_set_pmc_keyed_int(interp, sc_root_objects, scs, sc_root);
-        VTABLE_set_integer_keyed_int(interp, sc_index_lookup, scs, addr);
-    }
-
-    /* Stash the value in the the SC. */
-    VTABLE_set_pmc_keyed_int(interp, sc_root, idx, object);
+    VTABLE_set_pmc_keyed_str(interp, scs, handle, sc);
 }

src/metamodel/serialization_context.h

@@ -1,7 +1,7 @@
 #ifndef SERIALIZATIONCONTEXT_H_GUARD
 #define SERIALIZATIONCONTEXT_H_GUARD
 
-PMC * SC_get_sc_object(PARROT_INTERP, INTVAL idx);
-void SC_set_sc_object(PARROT_INTERP, INTVAL idx, PMC *object);
+PMC * SC_get_sc(PARROT_INTERP, STRING *handle);
+void SC_set_sc(PARROT_INTERP, STRING *handle, PMC *sc);
 
 #endif

src/ops/nqp.ops

@@ -642,24 +642,67 @@ inline op stable_publish_vtable_mapping(in PMC, in PMC) :base_core {
 
 =item nqp_get_sc_object()
 
-Fetches an object from the current segment's serialization context.
+Fetches an object from the serialization context keyed by handle and index.
 
 =cut
 
 */
-inline op nqp_get_sc_object(out PMC, in INT) :base_core {
-    $1 = SC_get_sc_object(interp, $2);
+inline op nqp_get_sc_object(out PMC, in STR, in INT) :base_core {
+    PMC *sc = SC_get_sc(interp, $2);
+    if (!PMC_IS_NULL(sc))
+        $1 = VTABLE_get_pmc_keyed_int(interp, sc, $3);
+    else
+        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+            "Cannot fetch object from non-existance serialization context %Ss",
+            $2);
+}
+
+/*
+
+=item nqp_get_sc()
+
+Gets the serialization context with the specified handle. Returns
+NULL if it does not exist.
+
+=cut
+
+*/
+inline op nqp_get_sc(out PMC, in STR) {
+    $1 = SC_get_sc(interp, $2);
+}
+
+/*
+
+=item nqp_create_sc()
+
+Creates a serialization context with the specified handle, adds it
+to the registry and returns it.
+
+=cut
+
+*/
+inline op nqp_create_sc(out PMC, in STR) {
+    $1 = pmc_new(interp, pmc_type(interp,
+        Parrot_str_new(interp, "SerializationContext", 0)));
+    VTABLE_set_string_native(interp, $1, $2);
+    SC_set_sc(interp, $2, $1);
 }
 
 /*
 
 =item nqp_set_sc_object()
 
-Stores an object in the current segment's serialization context.
+Stores an object in the serialization context keyed by handle and index.
 
 =cut
 
 */
-inline op nqp_set_sc_object(in INT, in PMC) :base_core {
-    SC_set_sc_object(interp, $1, $2);
+inline op nqp_set_sc_object(in STR, in INT, in PMC) :base_core {
+    PMC *sc = SC_get_sc(interp, $1);
+    if (!PMC_IS_NULL(sc))
+        VTABLE_set_pmc_keyed_int(interp, sc, $2, $3);
+    else
+        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+            "Cannot fetch object from non-existance serialization context %Ss",
+            $1);
 }