implement PBC backrefs in constant tables

Objects previously seen in the object graphs of other constants in the same
constant table are now stored as backreferences in stead of being duplicated.
This is significant improvement for a number of common cases including, but not
limited to: namespaces, outer subs, and lexpads.

opsc.pbc, by virtue of being created using nqp, makes heavy use of all of the
above mentioned features and is now 15% smaller.

compilers/imcc/imcparser.c

@@ -11,8 +11,6 @@
 /* HEADERIZER STOP */
 /* A Bison parser, made by GNU Bison 2.4.3.  */
 
-/* A Bison parser, made by GNU Bison 2.4.1.  */
-
 /* Skeleton implementation for Bison's Yacc-like parsers in C
    
       Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006,

compilers/imcc/imcparser.h

@@ -11,8 +11,6 @@
 /* HEADERIZER STOP */
 /* A Bison parser, made by GNU Bison 2.4.3.  */
 
-/* A Bison parser, made by GNU Bison 2.4.1.  */
-
 /* Skeleton interface for Bison's Yacc-like parsers in C
    
       Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006,

include/parrot/imageio.h

@@ -18,8 +18,9 @@
 #define FREEZE_BYTES_PER_ITEM 9
 
 enum {
-    enum_PackID_normal     = 0,
-    enum_PackID_seen       = 1
+    enum_PackID_normal      = 0,
+    enum_PackID_seen        = 1,
+    enum_PackID_pbc_backref = 2
 };
 
 #endif /* PARROT_IMAGEIO_H_GUARD */

include/parrot/packfile.h

@@ -228,8 +228,9 @@ typedef struct PackFile_ConstTable {
         opcode_t        const_count;
         PMC           **constants;
     } pmc;
-    PackFile_ByteCode  *code;  /* where this segment belongs to */
-    Hash               *string_hash; /* Hash for lookup strings and numbers */
+    PackFile_ByteCode  *code;        /* where this segment belongs to */
+    Hash               *string_hash; /* Hash for lookup of string indices */
+    Hash               *pmc_hash;    /* Hash for lookup of pmc indices */
 } PackFile_ConstTable;
 
 typedef struct PackFile_ByteCode_OpMappingEntry {
@@ -1113,6 +1114,20 @@ int PackFile_ConstTable_rlookup_num(PARROT_INTERP,
         __attribute__nonnull__(1)
         __attribute__nonnull__(2);
 
+PARROT_EXPORT
+int PackFile_ConstTable_rlookup_pmc(PARROT_INTERP,
+    ARGIN(PackFile_ConstTable *ct),
+    ARGIN(PMC *v),
+    ARGOUT(INTVAL *constno),
+    ARGOUT(INTVAL *idx))
+        __attribute__nonnull__(1)
+        __attribute__nonnull__(2)
+        __attribute__nonnull__(3)
+        __attribute__nonnull__(4)
+        __attribute__nonnull__(5)
+        FUNC_MODIFIES(*constno)
+        FUNC_MODIFIES(*idx);
+
 PARROT_EXPORT
 int PackFile_ConstTable_rlookup_str(PARROT_INTERP,
     ARGIN(const PackFile_ConstTable *ct),
@@ -1148,6 +1163,13 @@ opcode_t PackFile_pack_size(PARROT_INTERP, ARGMOD(PackFile *self))
      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp) \
     , PARROT_ASSERT_ARG(ct))
+#define ASSERT_ARGS_PackFile_ConstTable_rlookup_pmc \
+     __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+       PARROT_ASSERT_ARG(interp) \
+    , PARROT_ASSERT_ARG(ct) \
+    , PARROT_ASSERT_ARG(v) \
+    , PARROT_ASSERT_ARG(constno) \
+    , PARROT_ASSERT_ARG(idx))
 #define ASSERT_ARGS_PackFile_ConstTable_rlookup_str \
      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp) \

include/parrot/pmc_freeze.h

@@ -124,20 +124,26 @@ PARROT_CAN_RETURN_NULL
 opcode_t * Parrot_freeze_pbc(PARROT_INTERP,
     ARGIN(PMC *pmc),
     ARGIN(const PackFile_ConstTable *pf),
-    ARGIN(opcode_t *cursor))
+    ARGIN(opcode_t *cursor),
+    ARGOUT(Hash **seen))
         __attribute__nonnull__(1)
         __attribute__nonnull__(2)
         __attribute__nonnull__(3)
-        __attribute__nonnull__(4);
+        __attribute__nonnull__(4)
+        __attribute__nonnull__(5)
+        FUNC_MODIFIES(*seen);
 
 PARROT_EXPORT
 PARROT_WARN_UNUSED_RESULT
 UINTVAL Parrot_freeze_pbc_size(PARROT_INTERP,
     ARGIN(PMC *pmc),
-    ARGIN(const PackFile_ConstTable *pf))
+    ARGIN(const PackFile_ConstTable *pf),
+    ARGOUT(Hash **seen))
         __attribute__nonnull__(1)
         __attribute__nonnull__(2)
-        __attribute__nonnull__(3);
+        __attribute__nonnull__(3)
+        __attribute__nonnull__(4)
+        FUNC_MODIFIES(*seen);
 
 PARROT_EXPORT
 PARROT_WARN_UNUSED_RESULT
@@ -175,14 +181,6 @@ void Parrot_pf_verify_image_string(PARROT_INTERP, ARGIN(STRING *image))
         __attribute__nonnull__(1)
         __attribute__nonnull__(2);
 
-void Parrot_visit_loop_thawfinish(PARROT_INTERP, ARGIN(PMC *info))
-        __attribute__nonnull__(1)
-        __attribute__nonnull__(2);
-
-void Parrot_visit_loop_visit(PARROT_INTERP, ARGIN(PMC *info))
-        __attribute__nonnull__(1)
-        __attribute__nonnull__(2);
-
 #define ASSERT_ARGS_Parrot_clone __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp) \
     , PARROT_ASSERT_ARG(pmc))
@@ -193,11 +191,13 @@ void Parrot_visit_loop_visit(PARROT_INTERP, ARGIN(PMC *info))
        PARROT_ASSERT_ARG(interp) \
     , PARROT_ASSERT_ARG(pmc) \
     , PARROT_ASSERT_ARG(pf) \
-    , PARROT_ASSERT_ARG(cursor))
+    , PARROT_ASSERT_ARG(cursor) \
+    , PARROT_ASSERT_ARG(seen))
 #define ASSERT_ARGS_Parrot_freeze_pbc_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp) \
     , PARROT_ASSERT_ARG(pmc) \
-    , PARROT_ASSERT_ARG(pf))
+    , PARROT_ASSERT_ARG(pf) \
+    , PARROT_ASSERT_ARG(seen))
 #define ASSERT_ARGS_Parrot_freeze_strings __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp) \
     , PARROT_ASSERT_ARG(pmc))
@@ -214,12 +214,6 @@ void Parrot_visit_loop_visit(PARROT_INTERP, ARGIN(PMC *info))
 #define ASSERT_ARGS_Parrot_pf_verify_image_string __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp) \
     , PARROT_ASSERT_ARG(image))
-#define ASSERT_ARGS_Parrot_visit_loop_thawfinish __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
-       PARROT_ASSERT_ARG(interp) \
-    , PARROT_ASSERT_ARG(info))
-#define ASSERT_ARGS_Parrot_visit_loop_visit __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
-       PARROT_ASSERT_ARG(interp) \
-    , PARROT_ASSERT_ARG(info))
 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 /* HEADERIZER END: src/packfile/object_serialization.c */
 

src/packfile/api.c

@@ -3562,6 +3562,19 @@ PackFile_ConstTable_unpack(PARROT_INTERP, ARGIN(PackFile_Segment *seg),
     for (i = 0; i < self->pmc.const_count; i++)
         self->pmc.constants[i] = PackFile_Constant_unpack_pmc(interp, self, &cursor);
 
+    for (i = 0; i < self->pmc.const_count; i++) {
+        /* XXX unpack returned the lists of all objects in the object graph
+         * must dereference the first object into the constant slot */
+        PMC             *pmc  = self->pmc.constants[i]
+                              = VTABLE_get_pmc_keyed_int(interp, self->pmc.constants[i], 0);
+        STRING          *_sub = CONST_STRING(interp, "Sub");
+
+        /* magically place subs into namespace stashes
+         * XXX make this explicit with :load subs in PBC */
+        if (VTABLE_isa(interp, pmc, _sub))
+            Parrot_ns_store_sub(interp, pmc);
+    }
+
     return cursor;
 
   err:
@@ -3632,18 +3645,11 @@ PackFile_Constant_unpack_pmc(PARROT_INTERP, ARGIN(PackFile_ConstTable *constt),
 {
     ASSERT_ARGS(PackFile_Constant_unpack_pmc)
     PackFile * const pf         = constt->base.pf;
-    STRING          *_sub       = CONST_STRING(interp, "Sub");
     PMC             *pmc;
     /* thawing the PMC needs the real packfile in place */
     PackFile_ByteCode * const cs_save = interp->code;
     interp->code                      = pf->cur_cs;
     pmc                               = Parrot_thaw_pbc(interp, constt, cursor);
-
-    /* finally place the sub into some namespace stash
-     * XXX place this code in Sub.thaw ?  */
-    if (VTABLE_isa(interp, pmc, _sub))
-        Parrot_ns_store_sub(interp, pmc);
-
     /* restore code */
     interp->code = cs_save;
 

src/packfile/object_serialization.c

@@ -62,7 +62,7 @@ Parrot_freeze(PARROT_INTERP, ARGIN(PMC *pmc))
 /*
 
 =item C<opcode_t * Parrot_freeze_pbc(PARROT_INTERP, PMC *pmc, const
-PackFile_ConstTable *pf, opcode_t *cursor)>
+PackFile_ConstTable *pf, opcode_t *cursor, Hash **seen)>
 
 Freezes a PMC to a PackFile.
 
@@ -75,7 +75,7 @@ PARROT_WARN_UNUSED_RESULT
 PARROT_CAN_RETURN_NULL
 opcode_t *
 Parrot_freeze_pbc(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(const PackFile_ConstTable *pf),
-    ARGIN(opcode_t *cursor))
+    ARGIN(opcode_t *cursor), ARGOUT(Hash **seen))
 {
     ASSERT_ARGS(Parrot_freeze_pbc)
     PMC    *visitor;
@@ -88,6 +88,7 @@ Parrot_freeze_pbc(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(const PackFile_ConstTabl
     VTABLE_set_pmc(interp, visitor, pmc);
 
     image  = VTABLE_get_string(interp, visitor);
+    *seen  = (Hash *)VTABLE_get_pointer(interp, VTABLE_get_pmc(interp, visitor));
     cursor = PF_store_buf(cursor, image);
 
     return cursor;
@@ -97,7 +98,7 @@ Parrot_freeze_pbc(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(const PackFile_ConstTabl
 /*
 
 =item C<UINTVAL Parrot_freeze_pbc_size(PARROT_INTERP, PMC *pmc, const
-PackFile_ConstTable *pf)>
+PackFile_ConstTable *pf, Hash **seen)>
 
 Gets the size of an image if it were created using C<Parrot_freeze_pbc>.
 
@@ -108,7 +109,8 @@ Gets the size of an image if it were created using C<Parrot_freeze_pbc>.
 PARROT_EXPORT
 PARROT_WARN_UNUSED_RESULT
 UINTVAL
-Parrot_freeze_pbc_size(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(const PackFile_ConstTable *pf))
+Parrot_freeze_pbc_size(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(const PackFile_ConstTable *pf),
+        ARGOUT(Hash **seen))
 {
     ASSERT_ARGS(Parrot_freeze_pbc_size)
     PMC *pf_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
@@ -122,6 +124,7 @@ Parrot_freeze_pbc_size(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(const PackFile_Cons
     VTABLE_set_pmc(interp, visitor, pmc);
 
     pmc_result = VTABLE_get_pmc(interp, visitor);
+    *seen      = VTABLE_get_pointer(interp, visitor);
     return VTABLE_get_integer(interp, pmc_result);
 }
 

src/packfile/output.c

@@ -25,6 +25,18 @@ This file implements various functions for creating and writing packfiles.
 
 /* HEADERIZER HFILE: include/parrot/packfile.h */
 /* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
+
+PARROT_INLINE
+static void update_backref_hash(PARROT_INTERP,
+    PackFile_ConstTable *ct,
+    Hash *seen,
+    INTVAL constno)
+        __attribute__nonnull__(1);
+
+#define ASSERT_ARGS_update_backref_hash __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+       PARROT_ASSERT_ARG(interp))
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 /* HEADERIZER END: static */
 
 /*
@@ -143,6 +155,23 @@ PackFile_pack(PARROT_INTERP, ARGMOD(PackFile *self), ARGOUT(opcode_t *cursor))
     }
 }
 
+PARROT_INLINE
+static void
+update_backref_hash(PARROT_INTERP, PackFile_ConstTable *ct, Hash *seen, INTVAL constno)
+{
+    ASSERT_ARGS(update_backref_hash)
+    parrot_hash_iterate(seen, {
+        PMC *k = (PMC *)_bucket->key;
+        if (!Parrot_hash_get(interp, ct->pmc_hash, k)) {
+            UINTVAL idx = (UINTVAL)_bucket->value;
+            PMC *rec = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, 2);
+            VTABLE_set_integer_keyed_int(interp, rec, 0, constno);
+            VTABLE_set_integer_keyed_int(interp, rec, 1, idx);
+            Parrot_hash_put(interp, ct->pmc_hash, k, rec);
+        }
+    });
+}
+
 /*
 
 =item C<size_t PackFile_ConstTable_pack_size(PARROT_INTERP, PackFile_Segment
@@ -169,10 +198,15 @@ PackFile_ConstTable_pack_size(PARROT_INTERP, ARGIN(PackFile_Segment *seg))
     for (i = 0; i < self->str.const_count; i++)
         size += PF_size_string(self->str.constants[i]);
 
+    self->pmc_hash = Parrot_hash_create(interp, enum_type_PMC, Hash_key_type_PMC_ptr);
     for (i = 0; i < self->pmc.const_count; i++) {
+        Hash *seen;
         PMC *c = self->pmc.constants[i];
-        size += PF_size_strlen(Parrot_freeze_pbc_size(interp, c, self)) - 1;
+        size += PF_size_strlen(Parrot_freeze_pbc_size(interp, c, self, &seen)) - 1;
+        update_backref_hash(interp, self, seen, i);
     }
+    Parrot_hash_destroy(interp, self->pmc_hash);
+    self->pmc_hash = NULL;
 
     return size;
 }
@@ -215,10 +249,15 @@ PackFile_ConstTable_pack(PARROT_INTERP,
     for (i = 0; i < self->str.const_count; i++)
         cursor = PF_store_string(cursor, self->str.constants[i]);
 
+    self->pmc_hash = Parrot_hash_create(interp, enum_type_PMC, Hash_key_type_PMC_ptr);
     for (i = 0; i < self->pmc.const_count; i++) {
-        PMC *c = self->pmc.constants[i];
-        cursor   = Parrot_freeze_pbc(interp, c, self, cursor);
+        Hash *seen;
+        PMC  *c = self->pmc.constants[i];
+        cursor  = Parrot_freeze_pbc(interp, c, self, cursor, &seen);
+        update_backref_hash(interp, self, seen, i);
     }
+    Parrot_hash_destroy(interp, self->pmc_hash);
+    self->pmc_hash = NULL;
 
     return cursor;
 }
@@ -231,6 +270,9 @@ PackFile_ConstTable *ct, FLOATVAL n)>
 =item C<int PackFile_ConstTable_rlookup_str(PARROT_INTERP, const
 PackFile_ConstTable *ct, STRING *s)>
 
+=item C<int PackFile_ConstTable_rlookup_pmc(PARROT_INTERP, PackFile_ConstTable
+*ct, PMC *v, INTVAL *constno, INTVAL *idx)>
+
 Reverse lookup a constant in the constant table.
 
 =cut
@@ -260,7 +302,7 @@ PackFile_ConstTable_rlookup_str(PARROT_INTERP,
     ARGIN(const PackFile_ConstTable *ct), ARGIN(STRING *s))
 {
     ASSERT_ARGS(PackFile_ConstTable_rlookup_str)
-    int      i;
+    int i;
 
     if (ct->string_hash) {
         HashBucket *bucket = Parrot_hash_get_bucket(interp, ct->string_hash, s);
@@ -283,6 +325,28 @@ PackFile_ConstTable_rlookup_str(PARROT_INTERP,
     return -1;
 }
 
+PARROT_EXPORT
+int
+PackFile_ConstTable_rlookup_pmc(PARROT_INTERP,
+        ARGIN(PackFile_ConstTable *ct), ARGIN(PMC *v),
+        ARGOUT(INTVAL *constno), ARGOUT(INTVAL *idx))
+{
+    // ASSERT_ARGS(PackFile_ConstTable_rlookup_pmc)
+    PMC *rec;
+
+    PARROT_ASSERT(ct->pmc_hash);
+
+    rec = (PMC *)Parrot_hash_get(interp, ct->pmc_hash, v);
+    if (rec) {
+        *constno = VTABLE_get_integer_keyed_int(interp, rec, 0);
+        *idx     = VTABLE_get_integer_keyed_int(interp, rec, 1);
+        return 1;
+    }
+
+    return 0;
+}
+
+
 /*
 
 =back