# 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;
