# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #22337]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=22337 >


The next stage for getting faster DOD runs:

The relevant DOD flags are moved into an extra buffer per arena. Parrot
objects get allocated memalign-ed, so that the arena can be calculated
from the object address.

The major drawback of this is: the arenas have to be all equally sized
and - as we want to deal with many objecs too - rather big. So there
is a slight penalty for very short/small programs. The slowest part
here seems to be the clearing of the memalign'ed memory - I didn't
test yet, if this is necessary. It could at least be moved to
add_to_free_list(), where the memory is likely to be touched after
anyway.

To get around the initial big count of total_objects they are put on
the free_list not at once but in increasing parts for the first arena.

CVS has about 2 Million L2-Cache misses on the stress.pasm test
acounting for ~0.5 seconds on my Athlon 800 (estimated 1 miss = 200
cycles).
With ARENA_DOD_FLAGS enabled the miss count gets halfed (and half of 
these misses are due to the memset of the aligned memory)

It's equally fast compared to the previous patch and should get faster
on faster CPUs because the cache misses do hurt more then.

The usage of ARENA_DOD_FLAGS can be toggled in include/parrot/pobj.h
line 19.

Please give it a try and compare CVS, ARENA_DOD_FLAGS 0 and 1.

And of course ARENA_DOD_FLAGS = 1 needs a real memalign function, not
the dummy, that currently is inserted during config, when no memalign
is detected.

Thanks,
leo


-- attachment  1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/58274/43300/3a1627/dod-flags.patch

--- parrot/classes/default.pmc  Mon May 19 15:07:49 2003
+++ parrot-leo/classes/default.pmc      Sun May 25 14:12:25 2003
@@ -48,7 +48,7 @@
 
     PMC* getprop(STRING* key) {
         PMC* p_key = key_new_string(interpreter, key);
-       if (SELF->metadata) {
+       if (SELF->pmc_ext && SELF->metadata) {
          return (VTABLE_get_pmc_keyed(interpreter, SELF->metadata, p_key));
        } else {
          PMC* undef = pmc_new(INTERP, enum_class_PerlUndef);
@@ -59,11 +59,13 @@
 
     void setprop(STRING* key, PMC* value) {
         PMC* p_key;
-       if (SELF->metadata) {
+       if (SELF->pmc_ext && SELF->metadata) {
           p_key = key_new_string(interpreter, key);
          VTABLE_set_pmc_keyed(interpreter,
                          SELF->metadata, p_key, value, NULL);
        } else {
+          if (!SELF->pmc_ext)
+              add_pmc_ext(INTERP, SELF);
           /* first make new hash */
          SELF->metadata = pmc_new_noinit(interpreter, enum_class_PerlHash);
          VTABLE_init(interpreter, SELF->metadata);
@@ -76,7 +78,7 @@
     }
 
     void delprop(STRING* key) {
-       if (SELF->metadata) {
+       if (SELF->pmc_ext && SELF->metadata) {
           PMC* p_key = key_new_string(interpreter, key);
          VTABLE_delete_keyed(interpreter, SELF->metadata, p_key);
        }
@@ -84,6 +86,8 @@
     }
 
     PMC* getprops() {
+        if (!SELF->pmc_ext)
+             add_pmc_ext(INTERP, SELF);
        if (!SELF->metadata) {
          SELF->metadata = pmc_new_noinit(interpreter, enum_class_PerlHash);
          VTABLE_init(interpreter, SELF->metadata);
--- parrot/dod.c        Wed May 21 16:59:10 2003
+++ parrot-leo/dod.c    Tue May 27 13:26:03 2003
@@ -17,7 +17,7 @@
 #include <assert.h>
 
 /* set this to 1 for tracing the system stack and processor registers */
-#define TRACE_SYSTEM_AREAS 1
+#define TRACE_SYSTEM_AREAS 0
 
 /* set this to 1 and above to zero to see if unanchored objects
  * are found in system areas. Please note: these objects might be bogus
@@ -31,6 +31,37 @@
 
 static size_t find_common_mask(size_t val1, size_t val2);
 
+#if ARENA_DOD_FLAGS
+
+void pobject_lives(struct Parrot_Interp *interpreter, PObj *obj)
+{
+
+    struct Small_Object_Arena *arena = GET_ARENA(obj);
+    size_t n = GET_OBJ_N(arena, obj);
+    size_t ns = n >> ARENA_FLAG_SHIFT;
+    UINTVAL nm = (n & ARENA_FLAG_MASK) << 2;
+    UINTVAL *dod_flags = arena->dod_flags + ns;
+    if (*dod_flags & ((PObj_on_free_list_FLAG | PObj_live_FLAG) << nm))
+        return;
+    ++arena->live_objects;
+    *dod_flags |= PObj_live_FLAG << nm;
+
+    if (*dod_flags & (PObj_is_special_PMC_FLAG << nm)) {
+        if (((PMC*)obj)->pmc_ext) {
+            /* put it on the end of the list */
+            interpreter->mark_ptr->next_for_GC = (PMC *)obj;
+            /* Explicitly make the tail of the linked list be
+             * self-referential */
+            interpreter->mark_ptr = ((PMC*)obj)->next_for_GC = (PMC *)obj;
+        }
+        else if (PObj_custom_mark_TEST(obj))
+            VTABLE_mark(interpreter, (PMC *) obj);
+        return;
+    }
+}
+
+#else
+
 /* Tag a buffer header as alive. Used by the GC system when tracing
  * the root set, and used by the PMC GC handling routines to tag their
  * individual pieces if they have private ones */
@@ -55,16 +86,16 @@
     /* if object is a PMC and contains buffers or PMCs, then attach
      * the PMC to the chained mark list
      */
-    if (PObj_is_PMC_TEST(obj)) {
-        UINTVAL mask = PObj_is_PMC_ptr_FLAG | PObj_is_buffer_ptr_FLAG
-            | PObj_custom_mark_FLAG;
-        if ( (PObj_get_FLAGS(obj) & mask) || ((PMC*)obj)->metadata) {
+    if (PObj_is_special_PMC_TEST(obj)) {
+        if (((PMC*)obj)->pmc_ext) {
             /* put it on the end of the list */
             interpreter->mark_ptr->next_for_GC = (PMC *)obj;
             /* Explicitly make the tail of the linked list be
              * self-referential */
             interpreter->mark_ptr = ((PMC*)obj)->next_for_GC = (PMC *)obj;
         }
+        else if (PObj_custom_mark_TEST(obj))
+            VTABLE_mark(interpreter, (PMC *) obj);
         return;
     }
 #if GC_VERBOSE
@@ -79,6 +110,8 @@
 #endif
 }
 
+#endif
+
 
 /* Do a full trace run and mark all the PMCs as active if they are */
 static void
@@ -154,7 +187,7 @@
 
     /* Okay, we've marked the whole root set, and should have a good-sized
      * list 'o things to look at. Run through it */
-    for (; current != prev; current = current->next_for_GC) {
+    for (; current && current != prev; current = current->next_for_GC) {
         UINTVAL bits = PObj_get_FLAGS(current) & mask;
 
         /* mark properties */
@@ -317,6 +350,17 @@
 }
 #endif /* GC_IS_MALLOC */
 
+#if ARENA_DOD_FLAGS
+static void
+clear_live_counter(struct Parrot_Interp *interpreter,
+        struct Small_Object_Pool *pool)
+{
+    struct Small_Object_Arena *arena;
+    for (arena = pool->last_Arena; arena; arena = arena->prev)
+        arena->live_objects = 0;
+}
+#endif
+
 /* Put any buffers/PMCs that are now unused, on to the pools free list.
  * If GC_IS_MALLOC bufstart gets freed too if possible.
  * Avoid buffers that are immune from collection (ie, constant) */
@@ -336,13 +380,39 @@
     for (cur_arena = pool->last_Arena;
             NULL != cur_arena; cur_arena = cur_arena->prev) {
         Buffer *b = cur_arena->start_objects;
+        /* TODO -lt:
+         * count free objects per arena
+         * - if we find more then one totally unused arena
+        *   free all but one arena - this is the only possibility to
+        *   reduce the amount of free objects
+        */
 
+#if ARENA_DOD_FLAGS
+        UINTVAL * dod_flags = cur_arena->dod_flags - 1;
+        if (cur_arena->live_objects == cur_arena->used) {
+            for (i = 0; i < cur_arena->used; i+= (ARENA_FLAG_MASK+1))
+                *++dod_flags &= ~0x11111111;    /* FIXME live_flags */
+            *++dod_flags &= ~0x11111111;    /* FIXME live_flags */
+            total_used += cur_arena->used;
+            continue;
+        }
+
+#endif
         for (i = 0; i < cur_arena->used; i++) {
             /* If it's not live or on the free list, put it on the free list.
              * Note that it is technically possible to have a Buffer be both
              * on_free_list and live, because of our conservative stack-walk
              * collection. We must be wary of this case. */
-            if (!PObj_is_live_or_free_TESTALL(b)) {
+#if ARENA_DOD_FLAGS
+            size_t nm = (i & ARENA_FLAG_MASK) << 2;
+            if (! (i & ARENA_FLAG_MASK))
+                ++dod_flags;
+            if (! (*dod_flags &
+                        ( (PObj_live_FLAG|PObj_on_free_list_FLAG) << nm)) )
+#else
+                if (!PObj_is_live_or_free_TESTALL(b))
+#endif
+                {
 #if GC_VERBOSE
                 if (GC_DEBUG(interpreter) && PObj_report_TEST(b))
                     fprintf(stderr, "Freeing pobject %p -> %p\n",
@@ -355,12 +425,19 @@
                      */
                     if (PObj_active_destroy_TEST(b))
                         VTABLE_destroy(interpreter, (PMC *)b);
+                            if (PObj_is_PMC_EXT_TEST(b)) {
+                                struct Small_Object_Pool *ext_pool =
+                                    interpreter->arena_base->pmc_ext_pool;
+                                ext_pool->add_free_object(interpreter, ext_pool,
+                                        ((PMC *)b)->pmc_ext);
+                            }
                 }
                 /* else object is a buffer(like) */
                 else if (PObj_sysmem_TEST(b) && b->bufstart) {
                     /* has sysmem allocated, e.g. string_pin */
                     mem_sys_free(b->bufstart);
                     memset(b + 1, 0, wash_size);
+                        b->buflen = 0;
                 }
                 else {
 #ifdef GC_IS_MALLOC
@@ -392,16 +469,30 @@
                      * PMC specific data members
                      */
                     memset(b + 1, 0, wash_size);
+                        b->buflen = 0;
                 }
+#if ARENA_DOD_FLAGS
+                    *dod_flags |= PObj_on_free_list_FLAG << nm;
+#endif
                 pool->add_free_object(interpreter, pool, b);
             }
-            else if (!PObj_on_free_list_TEST(b)) {
+#if ARENA_DOD_FLAGS
+                else if (! (*dod_flags & (PObj_on_free_list_FLAG << nm)))
+#else
+                else if (!PObj_on_free_list_TEST(b))
+#endif
+                {
                 /* should be live then */
                 total_used++;
+#if ARENA_DOD_FLAGS
+                    *dod_flags &= ~(PObj_live_FLAG << nm);
+                    if ((*dod_flags & (PObj_is_impatient_FLAG << nm)))
+                        interpreter->impatient_things = 1;
+#else
                 PObj_live_CLEAR(b);
-                if (PObj_is_impatient_TEST(b)) {
-                    interpreter->impatient_things++;
-                }
+                    if (PObj_is_impatient_TEST(b))
+                        interpreter->impatient_things = 1;
+#endif
             }
             b = (Buffer *)((char *)b + object_size);
         }
@@ -503,6 +594,14 @@
     }
     Parrot_block_DOD(interpreter);
 
+#if ARENA_DOD_FLAGS
+    clear_live_counter(interpreter, interpreter->arena_base->pmc_pool);
+    for (j = 0; j < (INTVAL)interpreter->arena_base->num_sized; j++) {
+        header_pool = interpreter->arena_base->sized_header_pools[j];
+        if (header_pool)
+            clear_live_counter(interpreter, header_pool);
+    }
+#endif
     /* Now go trace the PMCs */
     trace_active_PMCs(interpreter);
 
--- parrot/headers.c    Mon Jan 13 18:05:14 2003
+++ parrot-leo/headers.c        Tue May 27 13:19:42 2003
@@ -39,8 +39,7 @@
     /* clear flags, set is_PMC_FLAG */
     PObj_flags_SETTO(pmc, PObj_is_PMC_FLAG);
     ((PMC *)pmc)->data = NULL;
-    ((PMC *)pmc)->metadata = NULL;
-    ((PMC *)pmc)->synchronize = NULL;
+    ((PMC *)pmc)->pmc_ext = NULL;
     return pmc;
 }
 
@@ -169,6 +168,24 @@
     return get_free_pmc(interpreter, interpreter->arena_base->pmc_pool);
 }
 
+
+PMC_EXT *
+new_pmc_ext(struct Parrot_Interp *interpreter)
+{
+    struct Small_Object_Pool *pool = interpreter->arena_base->pmc_ext_pool;
+    void *ptr = get_free_object(interpreter, pool);
+    memset(ptr, 0, sizeof(PMC_EXT));
+    return ptr;
+}
+
+void
+add_pmc_ext(struct Parrot_Interp *interpreter, PMC *pmc)
+{
+    pmc->pmc_ext = new_pmc_ext(interpreter);
+    PObj_is_PMC_EXT_SET(pmc);
+}
+
+
 STRING *
 new_string_header(struct Parrot_Interp *interpreter, UINTVAL flags)
 {
@@ -308,6 +325,8 @@
     /* Init the constant string header pool */
     interpreter->arena_base->constant_string_header_pool =
             new_string_pool(interpreter, 1);
+    interpreter->arena_base->constant_string_header_pool->name =
+        "constant_string_header";
 
 
     /* Init the buffer header pool
@@ -317,13 +336,21 @@
      * here for faster access in new_*_header
      */
     interpreter->arena_base->buffer_header_pool = new_buffer_pool(interpreter);
+    interpreter->arena_base->buffer_header_pool->name = "buffer_header";
 
     /* Init the string header pool */
     interpreter->arena_base->string_header_pool =
             new_string_pool(interpreter, 0);
+    interpreter->arena_base->string_header_pool->name = "string_header";
 
     /* Init the PMC header pool */
     interpreter->arena_base->pmc_pool = new_pmc_pool(interpreter);
+    interpreter->arena_base->pmc_pool->name = "pmc";
+    interpreter->arena_base->pmc_ext_pool =
+        new_small_object_pool(interpreter, sizeof(struct PMC_EXT), 1024);
+    interpreter->arena_base->pmc_ext_pool->more_objects =
+        alloc_objects;
+    interpreter->arena_base->pmc_ext_pool->name = "pmc_ext";
     interpreter->arena_base->constant_pmc_pool = new_pmc_pool(interpreter);
     interpreter->arena_base->constant_pmc_pool->objects_per_alloc =
        CONSTANT_PMC_HEADERS_PER_ALLOC;
@@ -338,6 +365,7 @@
 
     /* const/non const COW strings live in different pools * so in first pass
      * * * * COW refcount is done, in 2. refcounting * in 3rd freeing */
+    return; /* XXX */
 #ifdef GC_IS_MALLOC
     start = 0;
 #else
@@ -372,7 +400,9 @@
             if (i == 2 && pool) {
                 for (cur_arena = pool->last_Arena; cur_arena;) {
                     next = cur_arena->prev;
+#if ! ARENA_DOD_FLAGS
                     mem_sys_free(cur_arena->start_objects);
+#endif
                     mem_sys_free(cur_arena);
                     cur_arena = next;
                 }
@@ -381,6 +411,16 @@
 
         }
     }
+    pool = interpreter->arena_base->pmc_ext_pool;
+    for (cur_arena = pool->last_Arena; cur_arena;) {
+        next = cur_arena->prev;
+#if ! ARENA_DOD_FLAGS
+        mem_sys_free(cur_arena->start_objects);
+#endif
+        mem_sys_free(cur_arena);
+        cur_arena = next;
+    }
+    mem_sys_free(interpreter->arena_base->pmc_ext_pool);
     mem_sys_free(interpreter->arena_base->sized_header_pools);
 }
 
--- parrot/include/parrot/headers.h     Mon Dec 30 11:47:26 2002
+++ parrot-leo/include/parrot/headers.h Mon May 26 14:13:04 2003
@@ -23,8 +23,6 @@
 /** Header Management Functions **/
 
 /* pmc header small-object methods */
-void add_free_pmc(struct Parrot_Interp *interpreter,
-                  struct Small_Object_Pool *pool, void *pmc);
 void *get_free_pmc(struct Parrot_Interp *interpreter,
                    struct Small_Object_Pool *pool);
 void alloc_pmcs(struct Parrot_Interp *interpreter,
@@ -46,6 +44,8 @@
 struct Small_Object_Pool *make_bufferlike_pool(struct Parrot_Interp *interpreter, 
size_t unit_size);
 /* header creation functions */
 PMC *new_pmc_header(struct Parrot_Interp *interpreter);
+PMC_EXT *new_pmc_ext(struct Parrot_Interp *interpreter);
+void add_pmc_ext(struct Parrot_Interp *interpreter, PMC *pmc);
 STRING *new_string_header(struct Parrot_Interp *interpreter, UINTVAL flags);
 Buffer *new_buffer_header(struct Parrot_Interp *interpreter);
 void *new_bufferlike_header(struct Parrot_Interp *interpreter, size_t size);
--- parrot/include/parrot/pobj.h        Fri May 23 10:02:42 2003
+++ parrot-leo/include/parrot/pobj.h    Tue May 27 11:44:48 2003
@@ -15,6 +15,11 @@
 
 #include "parrot/config.h"
 
+/*
+ * live, on_free_list, special_PMC are kept in the pools arenas
+ */
+#define ARENA_DOD_FLAGS 1
+
 typedef union UnionVal {
     INTVAL int_val;             /* PMC unionval members */
     FLOATVAL num_val;
@@ -68,7 +73,11 @@
     pobj_t obj;
     VTABLE *vtable;
     DPOINTER *data;
-    PMC *metadata;
+    struct PMC_EXT *pmc_ext;
+};
+
+struct PMC_EXT {
+    PMC *metadata;      /* properties */
 
     SYNC *synchronize;
     /* This flag determines the next PMC in the 'used' list during
@@ -77,24 +86,26 @@
        guaranteed to have the tail element's next_for_GC point to itself,
        which makes much of the logic and checks simpler. We then have to
        check for PMC->next_for_GC == PMC to find the end of list. */
-    PMC *next_for_GC;         /* Yeah, the GC data should be out of
-                                 band, but that makes things really
-                                 slow when actually marking things for
-                                 the GC runs. Unfortunately putting
-                                 this here makes marking things clear
-                                 for the GC pre-run slow as well, as
-                                 we need to touch all the PMC
-                                 structs. (Though we will for flag
-                                 setting anyway) We can potentially
-                                 make this a pointer to the real GC
-                                 stuff, which'd merit an extra
-                                 dereference when setting, but let us
-                                 memset the actual GC data in a big
-                                 block */
+    PMC *next_for_GC;
+
+    /* Yeah, the GC data should be out of
+       band, but that makes things really slow when actually marking
+       things for the GC runs. Unfortunately putting this here makes
+       marking things clear for the GC pre-run slow as well, as we need
+       to touch all the PMC structs. (Though we will for flag setting
+       anyway) We can potentially make this a pointer to the real GC
+       stuff, which'd merit an extra dereference when setting, but let
+       us memset the actual GC data in a big block
+    */
 };
 
+typedef struct PMC_EXT PMC_EXT;
+
 /* macro for accessing union data */
 #define cache obj.u
+#define metadata pmc_ext->metadata
+#define next_for_GC pmc_ext->next_for_GC
+#define synchronize pmc_ext->synchronize
 
 /* PObj flags */
 typedef enum PObj_enum {
@@ -117,7 +128,7 @@
     PObj_is_string_FLAG = 1 << 8,
     /* PObj is a PMC */
     PObj_is_PMC_FLAG = 1 << 9,
-    PObj_is_reserved1_FLAG = 1 << 10,
+    PObj_is_PMC_EXT_FLAG = 1 << 10,
     PObj_is_reserved2_FLAG = 1 << 11,
 
     /* Memory management FLAGs */
@@ -140,9 +151,9 @@
     PObj_constant_FLAG = 1 << 17,
     /* Private flag for the GC system. Set if the PObj's in use as
      * far as the GC's concerned */
-    PObj_live_FLAG = 1 << 18,
+    b_PObj_live_FLAG = 1 << 18,
     /* Mark the object as on the free list */
-    PObj_on_free_list_FLAG = 1 << 19,
+    b_PObj_on_free_list_FLAG = 1 << 19,
 
     /* DOD/GC FLAGS */
 
@@ -172,9 +183,9 @@
      * - is_buffer_ptr_FLAG
      * - custom_mark_FLAG
      */
-    PObj_is_special_PMC_FLAG = 1 << 26,
+    b_PObj_is_special_PMC_FLAG = 1 << 26,
 
-    PObj_is_impatient_FLAG = 1 << 27
+    b_PObj_is_impatient_FLAG = 1 << 27
 
 } PObj_flags;
 
@@ -184,6 +195,75 @@
  * these macros
  */
 
+#if ARENA_DOD_FLAGS
+/*
+ * these 4 flags are kept in one nibble
+ */
+#  define d_PObj_live_FLAG              0x01
+#  define d_PObj_on_free_list_FLAG      0x02
+#  define d_PObj_is_special_PMC_FLAG    0x04
+#  define d_PObj_is_impatient_FLAG      0x08
+
+/*
+ * arenas are constant sized ~32 byte object size, ~64K objects
+ */
+# define ARENA_SIZE (32*1024*64)
+# define ARENA_ALIGN ARENA_SIZE
+# define ARENA_MASK (~ (ARENA_SIZE-1) )
+#if INTVAL_SIZE == 4
+# define ARENA_FLAG_SHIFT 3
+# define ARENA_FLAG_MASK 0x7
+#elif INTVAL_SIZE == 8
+# define ARENA_FLAG_SHIFT 4
+# define ARENA_FLAG_MASK 0x0f
+#else
+# error Unsupported INTVAL_SIZE
+#endif
+# define ARENA_OBJECTS(_pool) ( ARENA_SIZE / _pool->object_size )
+# define ARENA_FLAG_SIZE(_pool) \
+     (4*sizeof(INTVAL) + sizeof(INTVAL) * \
+      ((ARENA_OBJECTS(_pool) >> ARENA_FLAG_SHIFT )) )
+
+# define GET_ARENA(o) \
+     ((struct Small_Object_Arena *) (PTR2UINTVAL(o) & ARENA_MASK))
+# define GET_OBJ_N(arena, o) \
+     ((PTR2UINTVAL(o) - PTR2UINTVAL((arena)->start_objects)) \
+          / (arena)->object_size)
+
+# define DOD_flag_SET(flag, o) \
+  do { \
+      struct Small_Object_Arena *_arena = GET_ARENA(o); \
+      size_t _n = GET_OBJ_N(_arena, o); \
+      _arena->dod_flags[ _n >> ARENA_FLAG_SHIFT ] |= \
+         ((d_PObj_ ## flag ## _FLAG << (( _n & ARENA_FLAG_MASK ) << 2))); \
+  } \
+  while (0)
+# define DOD_flag_CLEAR(flag, o) \
+  do { \
+      struct Small_Object_Arena *_arena = GET_ARENA(o); \
+      size_t _n = GET_OBJ_N(_arena, o); \
+      _arena->dod_flags[ _n >> ARENA_FLAG_SHIFT ] &= \
+         ~((d_PObj_ ## flag ## _FLAG << (( _n & ARENA_FLAG_MASK ) << 2))); \
+  } \
+  while (0)
+
+#  define PObj_live_FLAG              d_PObj_live_FLAG
+#  define PObj_on_free_list_FLAG      d_PObj_on_free_list_FLAG
+#  define PObj_is_special_PMC_FLAG    d_PObj_is_special_PMC_FLAG
+#  define PObj_is_impatient_FLAG      d_PObj_is_impatient_FLAG
+
+#else
+
+#  define PObj_live_FLAG              b_PObj_live_FLAG
+#  define PObj_on_free_list_FLAG      b_PObj_on_free_list_FLAG
+#  define PObj_is_special_PMC_FLAG    b_PObj_is_special_PMC_FLAG
+#  define PObj_is_impatient_FLAG      b_PObj_is_impatient_FLAG
+
+#  define DOD_flag_TEST(flag, o)      PObj_flag_TEST(flag, o)
+#  define DOD_flag_SET(flag, o)       PObj_flag_SET(flag, o)
+#  define DOD_flag_CLEAR(flag, o)     PObj_flag_CLEAR(flag, o)
+
+#endif
 
 #define PObj_get_FLAGS(o) ((o)->obj.flags)
 
@@ -214,13 +294,13 @@
 #define PObj_report_SET(o) PObj_flag_SET(report, o)
 #define PObj_report_CLEAR(o) PObj_flag_CLEAR(report, o)
 
-#define PObj_on_free_list_TEST(o) PObj_flag_TEST(on_free_list, o)
-#define PObj_on_free_list_SET(o) PObj_flag_SET(on_free_list, o)
-#define PObj_on_free_list_CLEAR(o) PObj_flag_CLEAR(on_free_list, o)
-
-#define PObj_live_TEST(o) PObj_flag_TEST(live, o)
-#define PObj_live_SET(o) PObj_flag_SET(live, o)
-#define PObj_live_CLEAR(o) PObj_flag_CLEAR(live, o)
+#define PObj_on_free_list_TEST(o) DOD_flag_TEST(on_free_list, o)
+#define PObj_on_free_list_SET(o) DOD_flag_SET(on_free_list, o)
+#define PObj_on_free_list_CLEAR(o) DOD_flag_CLEAR(on_free_list, o)
+
+#define PObj_live_TEST(o) DOD_flag_TEST(live, o)
+#define PObj_live_SET(o) DOD_flag_SET(live, o)
+#define PObj_live_CLEAR(o) DOD_flag_CLEAR(live, o)
 
 #define PObj_is_string_TEST(o) PObj_flag_TEST(is_string, o)
 #define PObj_is_string_SET(o) PObj_flag_SET(is_string, o)
@@ -234,40 +314,43 @@
 #define PObj_sysmem_SET(o) PObj_flag_SET(sysmem, o)
 #define PObj_sysmem_CLEAR(o) PObj_flag_CLEAR(sysmem, o)
 
-#define PObj_is_impatient_TEST(o) PObj_flag_TEST(is_impatient, o)
-#define PObj_is_impatient_SET(o) PObj_flag_SET(is_impatient, o)
-#define PObj_is_impatient_CLEAR(o) PObj_flag_CLEAR(is_impatient, o)
+#define PObj_is_impatient_TEST(o) DOD_flag_TEST(is_impatient, o)
+#define PObj_is_impatient_SET(o) DOD_flag_SET(is_impatient, o)
+#define PObj_is_impatient_CLEAR(o) DOD_flag_CLEAR(is_impatient, o)
 
 #define PObj_special_SET(flag, o) do { \
     PObj_flag_SET(flag, o); \
-    PObj_flag_SET(is_special_PMC, o); \
+    DOD_flag_SET(is_special_PMC, o); \
 } while(0)
 #define PObj_special_CLEAR(flag, o) do { \
     PObj_flag_CLEAR(flag, o); \
-    if ((PObj_get_FLAGS(o) & (PObj_active_destroy_FLAG | PObj_is_PMC_ptr_FLAG | \
+    if ((PObj_get_FLAGS(o) & \
+                (PObj_active_destroy_FLAG | PObj_is_PMC_ptr_FLAG | \
                 PObj_is_buffer_ptr_FLAG)) || \
-            (PObj_is_PMC_TEST(o) && ((struct PMC*)(o))->metadata)) \
-        PObj_flag_SET(is_special_PMC, o); \
+            (PObj_is_PMC_TEST(o) && \
+             ((struct PMC*)(o))->pmc_ext && \
+             ((struct PMC*)(o))->metadata)) \
+        DOD_flag_SET(is_special_PMC, o); \
     else \
-        PObj_flag_CLEAR(is_special_PMC, o); \
+        DOD_flag_CLEAR(is_special_PMC, o); \
 } while (0)
-#define PObj_is_special_PMC_TEST(o) PObj_flag_TEST(is_special_PMC, o)
-#define PObj_is_special_PMC_SET(o) PObj_flag_SET(is_special_PMC, o)
+#define PObj_is_special_PMC_TEST(o) DOD_flag_TEST(is_special_PMC, o)
+#define PObj_is_special_PMC_SET(o) DOD_flag_SET(is_special_PMC, o)
 
 #define PObj_is_buffer_ptr_SET(o) PObj_special_SET(is_buffer_ptr, o)
 #define PObj_is_buffer_ptr_CLEAR(o) PObj_special_CLEAR(is_buffer_ptr, o)
 
 #define PObj_custom_mark_SET(o)   PObj_special_SET(custom_mark, o)
 #define PObj_custom_mark_CLEAR(o)   PObj_special_CLEAR(custom_mark, o)
+#define PObj_custom_mark_TEST(o)   PObj_flag_TEST(custom_mark, o)
 
 #define PObj_active_destroy_SET(o) PObj_flag_SET(active_destroy, o)
 #define PObj_active_destroy_TEST(o) PObj_flag_TEST(active_destroy, o)
 #define PObj_active_destroy_CLEAR(o) PObj_flag_CLEAR(active_destroy, o)
 
 #define PObj_is_PMC_TEST(o) PObj_flag_TEST(is_PMC, o)
-#define PObj_is_SPMC_TEST(o) PObj_flag_TEST(is_SPMC, o)
-#define PObj_is_any_PMC_TESTALL(o) (PObj_get_FLAGS(o) & \
-            (PObj_is_PMC_FLAG|PObj_is_SPMC_FLAG))
+#define PObj_is_PMC_EXT_TEST(o) PObj_flag_TEST(is_PMC_EXT, o)
+#define PObj_is_PMC_EXT_SET(o) PObj_special_SET(is_PMC_EXT, o)
 
 
 /* some combinations */
@@ -291,7 +374,7 @@
         (PObj_live_FLAG | PObj_on_free_list_FLAG))
 
 #define PObj_is_movable_TESTALL(o) (!(PObj_get_FLAGS(o) & \
-        (PObj_immobile_FLAG | PObj_on_free_list_FLAG | \
+        (PObj_immobile_FLAG |  \
          PObj_constant_FLAG | PObj_external_FLAG)))
 
 #define PObj_custom_mark_destroy_SETALL(o) do { \
--- parrot/include/parrot/resources.h   Sat Jan 11 12:01:03 2003
+++ parrot-leo/include/parrot/resources.h       Sat May 24 10:17:10 2003
@@ -56,6 +56,7 @@
     struct Memory_Pool *constant_string_pool;
     struct Small_Object_Pool *string_header_pool;
     struct Small_Object_Pool *pmc_pool;
+    struct Small_Object_Pool *pmc_ext_pool;
     struct Small_Object_Pool *constant_pmc_pool;
     struct Small_Object_Pool *buffer_header_pool;
     struct Small_Object_Pool *constant_string_header_pool;
--- parrot/include/parrot/smallobject.h Sat Dec 21 11:08:08 2002
+++ parrot-leo/include/parrot/smallobject.h     Tue May 27 08:51:57 2003
@@ -6,6 +6,12 @@
 struct Small_Object_Arena {
     size_t used;
     size_t total_objects;
+#if ARENA_DOD_FLAGS
+    size_t object_size;     /* size in bytes of an individual pool item */
+    UINTVAL * dod_flags;
+    struct Small_Object_Pool * pool;
+    size_t live_objects;
+#endif
     struct Small_Object_Arena *prev;
     struct Small_Object_Arena *next;
     void *start_objects;
@@ -18,6 +24,7 @@
     size_t objects_per_alloc;
     size_t total_objects;
     size_t num_free_objects;    /* number of resources in the free pool */
+    int skip;
     size_t replenish_level;
     void *free_list;
     UINTVAL align_1;    /* alignment (must be power of 2) minus one */
@@ -36,7 +43,7 @@
     void *mem_pool;
     size_t start_arena_memory;
     size_t end_arena_memory;
-    STRING* name;
+    const char *name;
 };
 
 INTVAL contained_in_pool(struct Parrot_Interp *,
--- parrot/jit_debug.c  Thu May  1 10:06:05 2003
+++ parrot-leo/jit_debug.c      Sat May 24 11:40:44 2003
@@ -148,8 +148,10 @@
             i + 3, BIT_OFFSET(PMC, vtable), BIT_SIZE(void*));
     fprintf(stabs, "data:(0,14),%d,%d;",
             BIT_OFFSET(PMC, data), BIT_SIZE(void*));
+#if 0
     fprintf(stabs, "metadata:*(0,%d),%d,%d;",
             i, BIT_OFFSET(PMC, metadata), BIT_SIZE(void*));
+#endif
     fprintf(stabs, ";\"");
     fprintf(stabs, "," N_LSYM ",0,0,0\n");
 
--- parrot/pmc.c        Mon May 19 15:07:49 2003
+++ parrot-leo/pmc.c    Tue May 27 13:19:42 2003
@@ -73,8 +73,22 @@
 PMC *
 pmc_new_noinit(struct Parrot_Interp *interpreter, INTVAL base_type)
 {
-    return get_new_pmc_header(interpreter, base_type,
+    PMC *pmc = get_new_pmc_header(interpreter, base_type,
             interpreter->arena_base->pmc_pool);
+    switch (base_type) {
+        case enum_class_PerlInt:
+        case enum_class_PerlNum:
+        case enum_class_PerlString:
+        case enum_class_PerlUndef:
+            break;
+        default:
+            /* TODO optimize this, mainly only aggregates need
+             * the extra header part
+             */
+            add_pmc_ext(interpreter, pmc);
+            break;
+    }
+    return pmc;
 }
 
 /*=for api pmc constant_pmc_new_noinit
--- parrot/resources.c  Mon Feb 10 17:08:48 2003
+++ parrot-leo/resources.c      Mon May 26 09:46:19 2003
@@ -213,7 +213,7 @@
 
             for (i = 0; i < cur_buffer_arena->used; i++) {
                 /* ! (immobile | on_free_list | constant | external) */
-                if (b->bufstart && PObj_is_movable_TESTALL(b)) {
+                if (b->buflen && PObj_is_movable_TESTALL(b)) {
                     struct Buffer_Tail *tail =
                             (struct Buffer_Tail *)((char *)b->bufstart +
                             b->buflen);
--- parrot/smallobject.c        Mon Jan 13 18:05:14 2003
+++ parrot-leo/smallobject.c    Tue May 27 13:19:42 2003
@@ -13,6 +13,7 @@
  */
 
 #include "parrot/parrot.h"
+#include <assert.h>
 
 #define GC_DEBUG_REPLENISH_LEVEL_FACTOR 0.0
 #define GC_DEBUG_UNITS_PER_ALLOC_GROWTH_FACTOR 1
@@ -45,10 +46,17 @@
 more_traceable_objects(struct Parrot_Interp *interpreter,
         struct Small_Object_Pool *pool)
 {
+    if (pool->skip)
+        pool->skip = 0;
+    else {
     Parrot_do_dod_run(interpreter);
+        if (pool->num_free_objects <= pool->replenish_level)
+            pool->skip = 1;
+    }
+
     /* requires that num_free_objects be updated in Parrot_do_dod_run. If dod
      * is disabled, then we must check the free list directly. */
-    if (!pool->free_list || pool->num_free_objects <= pool->replenish_level) {
+    if (!pool->free_list) {
         (*pool->alloc_objects) (interpreter, pool);
     }
 }
@@ -66,7 +74,9 @@
 add_free_object(struct Parrot_Interp *interpreter,
         struct Small_Object_Pool *pool, void *to_add)
 {
+#if ! ARENA_DOD_FLAGS
     PObj_flags_SETTO((PObj *)to_add, PObj_on_free_list_FLAG);
+#endif
     *(void **)to_add = pool->free_list;
     pool->free_list = to_add;
     pool->num_free_objects++;
@@ -84,6 +94,9 @@
         (*pool->more_objects) (interpreter, pool);
 
     ptr = pool->free_list;
+#if ARENA_DOD_FLAGS
+    PObj_on_free_list_CLEAR( (PObj *) ptr);
+#endif
     pool->free_list = *(void **)ptr;
     pool->num_free_objects--;
 #if ! DISABLE_GC_DEBUG
@@ -93,6 +106,45 @@
     return ptr;
 }
 
+
+static void
+add_to_free_list(struct Parrot_Interp *interpreter,
+        struct Small_Object_Pool *pool,
+        struct Small_Object_Arena *arena,
+        UINTVAL start,
+        UINTVAL end)
+{
+#if ARENA_DOD_FLAGS
+    UINTVAL *dod_flags;
+#endif
+    UINTVAL i;
+    void *object;
+
+    pool->total_objects += end - start;
+    arena->used = end;
+
+    /* Move all the new objects into the free list */
+    object = (void *)((char *)arena->start_objects +
+            start * pool->object_size);
+#if ARENA_DOD_FLAGS
+    dod_flags = arena->dod_flags + (start >> ARENA_FLAG_SHIFT);
+#endif
+    for (i = start; i < end; i++) {
+#if ARENA_DOD_FLAGS
+        if (! (i & ARENA_FLAG_MASK)) {
+            *dod_flags = 0x22222222;        /* FIXME */
+            ++dod_flags;
+        }
+#endif
+        pool->add_free_object (interpreter, pool, object);
+        object = (void *)((char *)object + pool->object_size);
+    }
+#if ARENA_DOD_FLAGS
+    /* set last */
+    *dod_flags = 0x22222222;        /* FIXME */
+#endif
+}
+
 /* We have no more headers on the free header pool. Go allocate more
  * and put them on */
 void
@@ -100,14 +152,47 @@
         struct Small_Object_Pool *pool)
 {
     struct Small_Object_Arena *new_arena;
-    void *object;
-    UINTVAL i;
-    size_t size = pool->object_size * pool->objects_per_alloc;
-
-    new_arena = mem_sys_allocate(sizeof(struct Small_Object_Arena));
+    size_t size;
+    UINTVAL start, end;
 
     /* Setup memory for the new objects */
+#if ARENA_DOD_FLAGS
+    size_t offset;
+
+    /* check old arena first */
+    if (pool->last_Arena &&
+            pool->last_Arena->used < pool->last_Arena->total_objects) {
+        start = pool->last_Arena->used;
+        end = start << 2;
+        if (end > pool->last_Arena->total_objects)
+            end = pool->last_Arena->total_objects;
+        add_to_free_list(interpreter, pool, pool->last_Arena, start, end);
+        return;
+    }
+
+    size = ARENA_SIZE;
+    new_arena = Parrot_memalign(ARENA_ALIGN, size);
+    /* offset in bytes of whole Objects */
+    offset = ( 1 + sizeof(struct Small_Object_Arena) / pool->object_size) *
+        pool->object_size;
+    new_arena->start_objects = (char *)new_arena + offset;
+    size -= offset;
+    pool->objects_per_alloc = size / pool->object_size;
+    new_arena->object_size = pool->object_size;
+    memset(new_arena->start_objects, 0, size);
+
+    new_arena->dod_flags = mem_sys_allocate(ARENA_FLAG_SIZE(pool));
+#if 0
+    printf("pool %s\t n %d flags %d\n",
+            pool->name ?: "null", (int)pool->objects_per_alloc,
+            (int)ARENA_FLAG_SIZE(pool));
+#endif
+    new_arena->pool = pool;
+#else
+    new_arena = mem_sys_allocate(sizeof(struct Small_Object_Arena));
+    size = pool->object_size * pool->objects_per_alloc;
     new_arena->start_objects = mem_sys_allocate_zeroed(size);
+#endif
 
     /* Maintain the *_arena_memory invariant for stack walking code. Set it
      * regardless if we're the first pool to be added. */
@@ -120,7 +205,21 @@
         pool->end_arena_memory = (size_t)new_arena->start_objects + size;
 
     /* Hook up the new object block into the object pool */
-    new_arena->used = pool->objects_per_alloc;
+#if ARENA_DOD_FLAGS
+    /* not the first one - put all on free list */
+    if (pool->last_Arena) {
+        start = 0;
+        end = pool->objects_per_alloc;
+    }
+    else {
+        /* first arena, start with e.g. 64 objects */
+        start = 0;
+        end = 64;
+    }
+#else
+    start = 0;
+    end = pool->objects_per_alloc;
+#endif
     new_arena->total_objects = pool->objects_per_alloc;
     new_arena->next = NULL;
     new_arena->prev = pool->last_Arena;
@@ -130,14 +229,11 @@
     pool->last_Arena = new_arena;
     interpreter->header_allocs_since_last_collect++;
 
-    /* Move all the new objects into the free list */
-    object = new_arena->start_objects;
-    for (i = 0; i < pool->objects_per_alloc; i++) {
-        add_free_object (interpreter, pool, object);
-        object = (void *)((char *)object + pool->object_size);
-    }
-    pool->total_objects += pool->objects_per_alloc;
+    add_to_free_list(interpreter, pool, new_arena, start, end);
+    pool->replenish_level =
+                (size_t)(pool->total_objects * REPLENISH_LEVEL_FACTOR);
 
+#if ! ARENA_DOD_FLAGS
     /* Allocate more next time */
     if (GC_DEBUG(interpreter)) {
         pool->objects_per_alloc *= GC_DEBUG_UNITS_PER_ALLOC_GROWTH_FACTOR;
@@ -156,6 +252,7 @@
     if (size > POOL_MAX_BYTES) {
         pool->objects_per_alloc = POOL_MAX_BYTES / pool->object_size;
     }
+#endif
 }
 
 struct Small_Object_Pool *

Reply via email to