[perl #19622] [PATCH] compact_pool

[via RT]

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


I did write:

[1] which BTW seems bogus to me: pool_compact() may be called (when 
there is enough reclaimable space), without having a DOD run immediately 
before it. So e.g. the on_free_list flag might not reflect current usage 
of a buffer.

Here is a program showing more problems with the current implementation:

        set S0, "abcdefghij"
        set I0, 0
lp: 
repeat S1, S0, 5000
        ne S0, "abcdefghij", nok
        substr S2, S1, 1, 1
        ne S2, "b", nok
        inc I0
        lt I0, 1000, lp
        print "ok\n"
        end
nok: 
print "nok\n"
        print S0
        print " - "
        print S1
        print "\n"
        end

The substr makes a COW reference of S1, which doesn't set 
pool->guaranteed_reclaimable, so when above is run without --gc-debug, 
pool->compact gets nether called and the program dies with SIGSEGV - the 
real reason is a NULL pointer returned from malloc().

--gc-debug does a DOD run + an unconditional compact_pool, so the 
program runs fine.

A proposed change could look like attached patch:
- die when malloc returns zero (IMHO we can't recover)
- always call do_dod_run before compact_pool
- when possibly_reclaimable reaches a certain amount, always compact the 
pool - the reclaim_factor (currently 20%) doesn't really matter, it just 
allows that the pool gets compacted sooner or later - it is used now as 
a probablity meaning 20% of COWed strings might be reclaimable.

leo


-- attachment  1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/46630/36629/d8ca8a/resources.c.patch


--- resources.c Fri Dec 27 10:34:28 2002
+++ /home/lt/src/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;
             }
         }