Ok, this is now obsolete. I was too slow, I guess. :-) The following
patch (1) is no longer needed because Peter's new version has already
been committed, and (2) fails to pass a stacks.t test. But in case we
want to keep the neonate counters, here's an updated version of
Peter's original neonate flag patch. The message I would have sent:
===================
On Sat, May 18, 2002 at 06:58:40PM -0400, Dan Sugalski wrote:
> At 11:05 PM +0200 5/18/02, Peter Gibbs wrote:
> >Unrelated subject: I see that Steve has modified string.c to get around the
> >problem with the temporary transcoded strings - I believe we need to
> >finalise a standard way of handling these situations soon. If anybody is
> >interested, I will resync my previous 'neonate' patch - it needs a bit of
> >work to fit with the latest changes to resources.c
>
> Did we get the "temporarily alive" bit patch in? If not, lets do that for
> now.
Ok. I snagged Peter's old neonate patch and updated it a bit. Note
that it does not add the op for clearing all occurrences of the flag;
instead, it explicitly unsets the flag in the handful of places it is
used. At the moment, this will never leak because even exceptions
leave through the same exit point. But eventually we'll need the op.
Any comments on/objections to the patch before I commit it? Would
BUFFER_temp_FLAG be more meaningful than BUFFER_neonate_FLAG? Any
other suggestions for a name?
patch follows
Index: interpreter.c
===================================================================
RCS file: /home/perlcvs/parrot/interpreter.c,v
retrieving revision 1.86
diff -u -r1.86 interpreter.c
--- interpreter.c 15 May 2002 05:01:15 -0000 1.86
+++ interpreter.c 20 May 2002 19:43:17 -0000
@@ -510,6 +510,9 @@
interpreter->memory_collected = 0;
interpreter->DOD_block_level = 1;
interpreter->GC_block_level = 1;
+ interpreter->neonate_strings = 0;
+ interpreter->neonate_buffers = 0;
+ interpreter->neonate_PMCs = 0;
/* Set up the memory allocation system */
mem_setup_allocator(interpreter);
Index: resources.c
===================================================================
RCS file: /home/perlcvs/parrot/resources.c,v
retrieving revision 1.55
diff -u -r1.55 resources.c
--- resources.c 20 May 2002 00:51:13 -0000 1.55
+++ resources.c 20 May 2002 19:43:22 -0000
@@ -502,6 +502,25 @@
}
}
+/* A buffer may be placed on the free list if all of:
+ * 1. It is vulnerable to collection (immune flag unset)
+ * 2. It is no longer alive (live flag unset)
+ * 3. It isn't already on the free list (on_free_list unset)
+ * 4. It is not marked neonate (temporary)
+ * 5. It is either not a constant, or it is a constant but it isn't being
+ * COW shared by another buffer.
+ */
+static INLINE int buffer_freeable(Buffer* b)
+{
+ UINTVAL flags = b->flags;
+ return !(flags & (BUFFER_immune_FLAG |
+ BUFFER_live_FLAG |
+ BUFFER_on_free_list_FLAG |
+ BUFFER_neonate_FLAG)) &&
+ (!(flags & BUFFER_constant_FLAG) ||
+ (flags & BUFFER_COW_FLAG));
+}
+
/* Put any free buffers that aren't on the free list on the free list
* Free means: not 'live' and not immune */
static void
@@ -518,10 +537,7 @@
Buffer *b = cur_arena->start_Buffer;
for (i = 0; i < cur_arena->used; i++) {
/* If it's not live or on the free list, put it on the free list */-
if (!(b->flags & (BUFFER_immune_FLAG | BUFFER_live_FLAG |
- BUFFER_on_free_list_FLAG)) &&
- (!(b->flags & BUFFER_constant_FLAG) ||
- (b->flags & BUFFER_COW_FLAG))) {
+ if (buffer_freeable(b)) {
interpreter->active_Buffers--;
b->flags = BUFFER_on_free_list_FLAG;
add_to_free_pool(interpreter, pool, b);
@@ -842,9 +858,7 @@
for (i = 0; i < cur_arena->used; i++) {
/* Is the string live, and can we move it? */
- if (!(s->flags & (BUFFER_on_free_list_FLAG |
- BUFFER_constant_FLAG | BUFFER_immobile_FLAG))
- && s->bufstart) {
+ if (s->bufstart && buffer_freeable((Buffer*) s)) {
memcpy(cur_spot, s->bufstart, s->buflen);
s->bufstart = cur_spot;
cur_size = s->buflen;
Index: string.c
===================================================================
RCS file: /home/perlcvs/parrot/string.c,v
retrieving revision 1.77
diff -u -r1.77 string.c
--- string.c 18 May 2002 02:38:13 -0000 1.77
+++ string.c 20 May 2002 19:43:27 -0000
@@ -15,6 +15,25 @@
static const CHARTYPE *string_native_type;
static const CHARTYPE *string_unicode_type;
+/* Mark a string as temporary. Temporary strings are immune from garbage
+ * collection as long as the neonate flag is on. Call release_temp() to
+ * return a temporary to the chopping block. */
+static INLINE void make_temp(Interp *interpreter, STRING *s)
+{
+ if (!(s->flags & BUFFER_neonate_FLAG)) {
+ s->flags |= BUFFER_neonate_FLAG;
+ interpreter->neonate_strings++;
+ }
+}
+
+static INLINE void release_temp(Interp *interpreter, STRING *s)
+{
+ if (s->flags & BUFFER_neonate_FLAG) {
+ s->flags &= ~BUFFER_neonate_FLAG;
+ interpreter->neonate_strings--;
+ }
+}
+
/* Basic string stuff - creation, enlargement, destruction, etc. */
/*=for api string string_init
@@ -269,14 +288,10 @@
if (a != NULL && a->strlen != 0) {
if (b != NULL && b->strlen != 0) {
/* transcode first so we know the length and avoid infanticide */
- /* XXX But it doesn't avoid anything. string_transcode
- * returns a copy that isn't anchored to the root set. For
- * now, I'll just block DOD (collection is ok, because b
- * is marked live.) */
- interpreter->DOD_block_level++;
if (a->type != b->type || a->encoding != b->encoding) {
b = string_transcode(interpreter, b, a->encoding, a->type,
NULL);
+ make_temp(interpreter, b);
}
result = string_make(interpreter, NULL, a->bufused + b->bufused,
a->encoding, 0, a->type);
@@ -285,7 +300,7 @@
b->bufstart, b->bufused);
result->strlen = a->strlen + b->strlen;
result->bufused = a->bufused + b->bufused;
- interpreter->DOD_block_level--;
+ release_temp(interpreter, b);
}
else {
return string_copy(interpreter, a);
@@ -431,8 +446,10 @@
true_offset = (UINTVAL)offset;
true_length = (UINTVAL)length;
- if(rep->encoding != src->encoding || rep->type != src->type)
+ if(rep->encoding != src->encoding || rep->type != src->type) {
rep = string_transcode(interpreter, rep, src->encoding, src->type, NULL);
+ make_temp(interpreter, rep);
+ }
/* abs(-offset) may not be > strlen-1 */
if (offset < 0) {
@@ -521,6 +538,8 @@
(void)string_compute_strlen(src);
}
+ release_temp(interpreter, rep);
+
/* src is modified, now return the original substring */
return dest;
}
@@ -577,8 +596,10 @@
if (s1->type != s2->type || s1->encoding != s2->encoding) {
s1 = string_transcode(interpreter, s1, NULL, string_unicode_type,
NULL);
+ make_temp(interpreter, s1);
s2 = string_transcode(interpreter, s2, NULL, string_unicode_type,
NULL);
+ make_temp(interpreter, s2);
}
s1start = s1->bufstart;
@@ -600,6 +621,9 @@
cmp = 1;
if (cmp == 0 && s2start < s2end)
cmp = -1;
+
+ release_temp(interpreter, s1);
+ release_temp(interpreter, s2);
return cmp;
}
Index: include/parrot/interpreter.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/interpreter.h,v
retrieving revision 1.45
diff -u -r1.45 interpreter.h
--- include/parrot/interpreter.h 15 May 2002 07:25:37 -0000 1.45
+++ include/parrot/interpreter.h 20 May 2002 19:43:28 -0000
@@ -162,6 +162,9 @@
requests are there? */
UINTVAL GC_block_level; /* How many outstanding GC block
requests are there? */
+ UINTVAL neonate_strings; /* How many protected newborn strings ? */
+ UINTVAL neonate_buffers; /* How many protected newborn buffers ? */
+ UINTVAL neonate_PMCs; /* How many protected newborn PMCs ? */
} Interp;
#define PCONST(i) PF_CONST(interpreter->code, (i))
Index: include/parrot/string.h
===================================================================
RCS file: /home/perlcvs/parrot/include/parrot/string.h,v
retrieving revision 1.40
diff -u -r1.40 string.h
--- include/parrot/string.h 20 May 2002 00:45:40 -0000 1.40
+++ include/parrot/string.h 20 May 2002 19:43:28 -0000
@@ -67,8 +67,8 @@
/* Private flag for the GC system. Set if the buffer's in use as
* far as the GC's concerned */
BUFFER_live_FLAG = 1 << 12,
- /* Mark the bufffer as needing GC */
- BUFFER_needs_GC_FLAG = 1 << 13,
+ /* Mark the buffer as newborn, for protection from infant death */
+ BUFFER_neonate_FLAG = 1 << 13,
/* Mark the buffer as on the free list */
BUFFER_on_free_list_FLAG = 1 << 14,
/* This is a constant--don't kill it! */
