[perl #19668] [PATCH] infant mortality #1

[via RT]

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


Attached patch changes a view places, which cause problems running w/o 
trace_system_areas().

With this all parrot tests pass here (i386/linux) with or without 
--gc-debug. Some perl6 tests related to try/catch are failing.

Please check this on different platforms, TIA.

leo



-- attachment  1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/46715/36710/7ee026/infant-mort-1.patch


--- parrot/classes/default.pmc  Mon Dec 30 18:38:57 2002
+++ parrot-leo/classes/default.pmc      Thu Jan  2 12:44:10 2003
@@ -65,7 +65,8 @@
                          SELF->metadata, p_key, value, NULL);
        } else {
           /* first make new hash */
-         SELF->metadata = pmc_new(interpreter, enum_class_PerlHash);
+         SELF->metadata = pmc_new_noinit(interpreter, enum_class_PerlHash);
+         SELF->metadata->vtable->init(interpreter, SELF->metadata);
          /* then the key, else it vanishes with --gc-debug */
           p_key = key_new_string(interpreter, key);
          SELF->metadata->vtable->set_pmc_keyed(interpreter,
--- parrot/dod.c        Mon Dec 30 11:47:25 2002
+++ parrot-leo/dod.c    Thu Jan  2 12:18:40 2003
@@ -22,8 +22,6 @@
 #endif
 
 static size_t find_common_mask(size_t val1, size_t val2);
-static void trace_system_stack(struct Parrot_Interp *);
-
 
 void pobject_lives(struct Parrot_Interp *interpreter, PObj *obj)
 {
@@ -93,7 +91,7 @@
 #if ! DISABLE_GC_DEBUG
     CONSERVATIVE_POINTER_CHASING = 1;
 #endif
-    trace_system_areas(interpreter);
+    /* trace_system_areas(interpreter); */
 #if ! DISABLE_GC_DEBUG
     CONSERVATIVE_POINTER_CHASING = 0;
 #endif
--- parrot/hash.c       Fri Dec 27 10:34:28 2002
+++ parrot-leo/hash.c   Thu Jan  2 12:34:27 2003
@@ -418,6 +418,8 @@
 hash_clone(struct Parrot_Interp *interp, HASH *hash, HASH **dest)
 {
     HashIndex i;
+
+    Parrot_block_DOD(interp);
     new_hash(interp, dest);
     for (i = 0; i <= hash->max_chain; i++) {
         BucketIndex bi = lookupBucketIndex(hash, i);
@@ -456,6 +458,7 @@
             bi = b->next;
         }
     }
+    Parrot_unblock_DOD(interp);
 }
 
 /*
--- parrot/resources.c  Fri Dec 27 10:34:28 2002
+++ parrot-leo/resources.c      Tue Dec 31 14:26:26 2002
@@ -45,6 +45,8 @@
     new_block = mem_sys_allocate_zeroed(sizeof(struct Memory_Block) +
             alloc_size + 32);
     if (!new_block) {
+        fprintf(stderr, "out of mem allocsize = %d\n", (int)alloc_size+32);
+        exit(1);
         return NULL;
     }
 
@@ -110,25 +112,25 @@
         }
     }
     if (pool->top_block->free < size) {
+        Parrot_do_dod_run(interpreter);
         /* Compact the pool if allowed and worthwhile */
         if (pool->compact) {
             /* don't bother reclaiming if its just chicken feed */
-            if ((pool->possibly_reclaimable + pool->guaranteed_reclaimable) / 2
-                    > (size_t)(pool->total_allocated * pool->reclaim_factor)
+            if (pool->possibly_reclaimable * pool->reclaim_factor
+                    > size
                     /* don't bother reclaiming if it won't even be enough */
-                    && (pool->guaranteed_reclaimable > size)
+                    || (pool->guaranteed_reclaimable > size)
                     ) {
                 (*pool->compact) (interpreter, pool);
             }
-            else {
-                Parrot_do_dod_run(interpreter);
-            }
 
         }
         if (pool->top_block->free < size) {
             alloc_new_block(interpreter, size, pool);
             interpreter->mem_allocs_since_last_collect++;
             if (pool->top_block->free < size) {
+                fprintf(stderr, "out of mem\n");
+                exit(1);
                 return NULL;
             }
         }
--- parrot/spf_render.c Tue Dec 17 08:30:55 2002
+++ parrot-leo/spf_render.c     Thu Jan  2 12:28:59 2003
@@ -228,6 +228,7 @@
     char tc[PARROT_SPRINTF_BUFFER_SIZE];
 
 
+    Parrot_block_DOD(interpreter);
     for (i = old = len = 0; i < (INTVAL) string_length(pat); i++) {
         if (string_ord(pat, i) == '%') {        /* % */
             if (len) {
@@ -663,6 +664,7 @@
         string_append(interpreter, targ, substr, 0);
     }
 
+    Parrot_unblock_DOD(interpreter);
     return targ;
 }
 
--- parrot/string.c     Thu Dec 26 12:32:35 2002
+++ parrot-leo/string.c Thu Jan  2 12:41:12 2003
@@ -244,7 +244,12 @@
         PObj_bufstart_external_SET(s);
     }
     else {
+        /* allocate_string can trigger DOD, which destroys above allocated
+         * string header w/o stack_walk
+         */
+        Parrot_block_DOD(interpreter);
         Parrot_allocate_string(interpreter, s, len);
+        Parrot_unblock_DOD(interpreter);
     }
     s->encoding = encoding;
     s->type = type;