develooper Front page | perl.perl6.internals | Postings from March 2002

Complete, Mainly-GC Patch

Thread Next
From:
Michel J Lambert
Date:
March 29, 2002 00:25
Subject:
Complete, Mainly-GC Patch
Message ID:
Pine.LNX.4.44.0203290321080.22014-200000@access.mit.edu
Index: parrot/pmc.c
===================================================================
RCS file: /cvs/public/parrot/pmc.c,v
retrieving revision 1.11
diff -u -r1.11 pmc.c
--- parrot/pmc.c	10 Mar 2002 21:19:46 -0000	1.11
+++ parrot/pmc.c	29 Mar 2002 08:09:23 -0000
@@ -39,8 +39,8 @@
         return NULL;
     }
 
-    pmc->flags = 0;
-    pmc->data = 0;
+    /* Ensure the PMC survives DOD during this function */
+    pmc->flags |= PMC_immortal_FLAG;
 
     pmc->vtable = &(Parrot_base_vtables[base_type]);
 
@@ -53,6 +53,9 @@
     }
 
     pmc->vtable->init(interpreter, pmc, 0);
+
+    /* Let the caller track this PMC */
+    pmc->flags &= ~PMC_immortal_FLAG;
     return pmc;
 }
 
@@ -67,8 +70,8 @@
         return NULL;
     }
 
-    pmc->flags = 0;
-    pmc->data = 0;
+    /* Ensure the PMC survives DOD during this function */
+    pmc->flags |= PMC_immortal_FLAG;
 
     pmc->vtable = &(Parrot_base_vtables[base_type]);
 
@@ -81,6 +84,9 @@
     }
 
     pmc->vtable->init(interpreter, pmc, size);
+
+    /* Let the caller track this PMC */
+    pmc->flags &= ~PMC_immortal_FLAG;
     return pmc;
 }
 
Index: parrot/resources.c
===================================================================
RCS file: /cvs/public/parrot/resources.c,v
retrieving revision 1.35
diff -u -r1.35 resources.c
--- parrot/resources.c	26 Mar 2002 16:33:01 -0000	1.35
+++ parrot/resources.c	29 Mar 2002 08:09:23 -0000
@@ -139,6 +139,8 @@
     interpreter->active_PMCs++;
     /* Mark it live */
     return_me->flags = PMC_live_FLAG;
+    /* Don't let it point to garbage memory */
+    return_me->data = NULL;
     /* Return it */
     return return_me;
   }
@@ -242,6 +244,8 @@
     interpreter->active_Buffers++;
     /* Mark it live */
     return_me->flags = BUFFER_live_FLAG;
+    /* Don't let it point to garbage memory */
+    return_me->bufstart = NULL;
     /* Return it */
     return return_me;
   }
@@ -348,6 +352,9 @@
     /* Now put it on the end of the list */
     current_end_of_list->next_for_GC = used_pmc;
 
+    /* Explicitly make the tail of the linked list be self-referential */
+    used_pmc->next_for_GC = used_pmc;
+
     /* return the PMC we were passed as the new end of the list */
     return used_pmc;
 }
@@ -355,20 +362,20 @@
 /* Do a full trace run and mark all the PMCs as active if they are */
 static void
 trace_active_PMCs(struct Parrot_Interp *interpreter) {
-    PMC *last, *current; /* Pointers to the last marked PMC and the
-                            currently being processed PMC. */
+    PMC *last, *current, *prev; /* Pointers to the last marked PMC, the
+                                   currently being processed PMC, and in
+                                   the previously processed PMC in a loop. */
     unsigned int i, j, chunks_traced;
     Stack_chunk *cur_stack, *start_stack;
     struct PRegChunk *cur_chunk;
+
     /* We have to start somewhere, and the global stash is a good
        place */
     last = current = interpreter->perl_stash->stash_hash;
+
     /* mark it as used and get an updated end of list */
     last = mark_used(current, last);
 
-    /* Wipe out the next for gc bit, otherwise we'll never get anywhere */
-    last->next_for_GC = NULL;
-    
     /* Now, go run through the PMC registers and mark them as live */
     /* First mark the current set. */
     for (i=0; i < NUM_REGISTERS; i++) {
@@ -407,7 +414,8 @@
 
     /* 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; current = current->next_for_GC) {
+    prev = NULL;
+    for (; current != prev; current = current->next_for_GC) {
         UINTVAL mask = PMC_is_PMC_ptr_FLAG | PMC_is_buffer_ptr_FLAG;
         UINTVAL bits = current->flags & mask;
 
@@ -420,7 +428,9 @@
             }
             else {
                 if (bits == PMC_is_buffer_ptr_FLAG) {
-                    buffer_lives(current->data);
+                    if (current->data) {
+                        buffer_lives(current->data);
+                    }
                 }
                 else {
                     /* The only thing left is "buffer of PMCs" */
@@ -434,6 +444,7 @@
                 }
             }
         }
+        prev = current;
     }
 }
 
@@ -498,7 +509,7 @@
     PMC *pmc_array = cur_arena->start_PMC;
     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 (!(pmc_array[i].flags & (PMC_live_FLAG |
+      if (!(pmc_array[i].flags & (PMC_live_FLAG | PMC_immortal_FLAG |
                                   PMC_on_free_list_FLAG))) {
         add_pmc_to_free(interpreter,
                         interpreter->arena_base->pmc_pool,
@@ -645,6 +656,8 @@
     interpreter->active_Buffers++;
     /* Mark it live */
     return_me->flags = BUFFER_live_FLAG;
+    /* Don't let it point to garbage memory */
+    return_me->bufstart = NULL;
     /* Return it */
     return return_me;
   }
@@ -826,6 +839,7 @@
   if (NULL == interpreter) {
     return mem_sys_allocate(size);
   }
+
   /* Make sure we round up to a multiple of 16 */
   size += 16;
   size &= ~0x0f;
Index: parrot/stacks.c
===================================================================
RCS file: /cvs/public/parrot/stacks.c,v
retrieving revision 1.25
diff -u -r1.25 stacks.c
--- parrot/stacks.c	22 Mar 2002 20:24:02 -0000	1.25
+++ parrot/stacks.c	29 Mar 2002 08:09:24 -0000
@@ -76,7 +76,7 @@
     }
     else {
         chunk = stack_base->prev;    /* Start at top */
-        while (offset > chunk->used && chunk != stack_base) {
+        while (offset >= chunk->used && chunk != stack_base) {
             offset -= chunk->used;
             chunk  = chunk->prev;
         }
Index: parrot/classes/perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.17
diff -u -r1.17 perlint.pmc
--- parrot/classes/perlint.pmc	10 Mar 2002 21:18:13 -0000	1.17
+++ parrot/classes/perlint.pmc	29 Mar 2002 08:09:25 -0000
@@ -119,27 +119,27 @@
 
     void set_string (PMC * value) {
 	SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
-	SELF->cache.struct_val = value->cache.struct_val;
+	SELF->data = value->cache.struct_val;
     }
 
     void set_string_native (STRING * value) {
 	SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
-	SELF->cache.struct_val = value;
+	SELF->data = value;
     }
 
     void set_string_unicode (STRING * value) {
 	SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
-	SELF->cache.struct_val = value;
+	SELF->data = value;
     }
 
     void set_string_other (STRING * value) {
 	SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
-	SELF->cache.struct_val = value;
+	SELF->data = value;
     }
 
     void set_string_same (PMC * value) {
 	SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
-	SELF->cache.struct_val = value->cache.struct_val;
+	SELF->data = value->cache.struct_val;
     }
 
     void set_value (void* value) {
Index: parrot/classes/perlnum.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlnum.pmc,v
retrieving revision 1.19
diff -u -r1.19 perlnum.pmc
--- parrot/classes/perlnum.pmc	10 Mar 2002 21:18:13 -0000	1.19
+++ parrot/classes/perlnum.pmc	29 Mar 2002 08:09:26 -0000
@@ -117,27 +117,27 @@
 
     void set_string (PMC * value) {
 	SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
-	SELF->cache.struct_val = value->cache.struct_val;
+	SELF->data = value->cache.struct_val;
     }
 
     void set_string_native (STRING * value) {
 	SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
-	SELF->cache.struct_val = value;
+	SELF->data = value;
     }
 
     void set_string_unicode (STRING * value) {
 	SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
-	SELF->cache.struct_val = value;
+	SELF->data = value;
     }
 
     void set_string_other (STRING * value) {
 	SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
-	SELF->cache.struct_val = value;
+	SELF->data = value;
     }
 
     void set_string_same (PMC * value) {
 	SELF->vtable = &(Parrot_base_vtables[enum_class_PerlString]);
-	SELF->cache.struct_val = value->cache.struct_val;
+	SELF->data = value->cache.struct_val;
     }
 
     void set_value (void* value) {
Index: parrot/classes/perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.18
diff -u -r1.18 perlstring.pmc
--- parrot/classes/perlstring.pmc	10 Mar 2002 21:18:13 -0000	1.18
+++ parrot/classes/perlstring.pmc	29 Mar 2002 08:09:26 -0000
@@ -23,12 +23,13 @@
     }
 
     void init (INTVAL size) {
-	SELF->cache.struct_val = string_make(INTERP,NULL,0,NULL,0,NULL);
+	SELF->data = string_make(INTERP,NULL,0,NULL,0,NULL);
+    SELF->flags = PMC_is_buffer_ptr_FLAG;
     }
 
     void clone (PMC* dest) { 
 	dest->vtable = SELF->vtable;
-	dest->cache.struct_val = string_copy(INTERP,SELF->cache.struct_val);
+	dest->data = string_copy(INTERP,SELF->data);
     }
 
     void morph (INTVAL type) {
@@ -43,34 +44,34 @@
     }
 
     void destroy () {
-	string_destroy(SELF->cache.struct_val);
+	string_destroy(SELF->data);
     }
 
     INTVAL get_integer () {
-	STRING* s = (STRING*) SELF->cache.struct_val;
+	STRING* s = (STRING*) SELF->data;
  return string_to_int(s);
     }
 
     FLOATVAL get_number () {
-	STRING* s = (STRING*) SELF->cache.struct_val;
+	STRING* s = (STRING*) SELF->data;
  return string_to_num(s);
     }
 
     STRING* get_string () {
-	return (STRING*)SELF->cache.struct_val;
+	return (STRING*)SELF->data;
     }
 
     BOOLVAL get_bool () {
- return string_bool(SELF->cache.struct_val);
+ return string_bool(SELF->data);
     }
 
     void* get_value () {
-        return &SELF->cache;
+        return &SELF->data;
     }
 
     BOOLVAL is_same (PMC* other) {
-        STRING* s1 = (STRING*)SELF->cache.struct_val;
-        STRING* s2 = (STRING*)other->cache.struct_val;
+        STRING* s1 = (STRING*)SELF->data;
+        STRING* s2 = (STRING*)other->data;
         return (BOOLVAL)( other->vtable == SELF->vtable &&
                           s1->bufused   == s2->bufused  &&
             (memcmp(s1->bufstart,s2->bufstart,(size_t)s1->bufused)==0));
@@ -113,29 +114,29 @@
     }
 
     void set_string (PMC * value) {
-	SELF->cache.struct_val =
-               string_copy(INTERP, (STRING*)value->cache.struct_val);
+	SELF->data =
+               string_copy(INTERP, (STRING*)value->data);
     }
 
     void set_string_native (STRING * value) {
-	SELF->cache.struct_val = string_copy(INTERP, value);
+	SELF->data = string_copy(INTERP, value);
     }
 
     void set_string_unicode (STRING * value) {
-	SELF->cache.struct_val = string_copy(INTERP, value);
+	SELF->data = string_copy(INTERP, value);
     }
 
     void set_string_other (STRING * value) {
-	SELF->cache.struct_val = string_copy(INTERP, value);
+	SELF->data = string_copy(INTERP, value);
     }
 
     void set_string_same (PMC * value) {
-	SELF->cache.struct_val =
-               string_copy(INTERP, (STRING*)value->cache.struct_val);
+	SELF->data =
+               string_copy(INTERP, (STRING*)value->data);
     }
 
     void set_value (void* value) {
-	SELF->cache.struct_val = value;
+	SELF->data = value;
     }
 
     void add (PMC * value, PMC* dest) {
@@ -347,54 +348,54 @@
     }
 
     void concatenate (PMC * value, PMC* dest) {
-	STRING* s = string_copy(INTERP, (STRING*)SELF->cache.struct_val);
-	dest->cache.struct_val =
+	STRING* s = string_copy(INTERP, (STRING*)SELF->data);
+	dest->data =
 	    string_concat(INTERP,
 	                  s,
 			  value->vtable->get_string(INTERP, value),
 			  0
 			 );
-	/* don't destroy s, as it is dest->cache.struct_val */
+	/* don't destroy s, as it is dest->data */
     }
 
     void concatenate_native (STRING * value, PMC* dest) {
-	STRING* s = string_copy(INTERP, (STRING*)SELF->cache.struct_val);
-	dest->cache.struct_val =
+	STRING* s = string_copy(INTERP, (STRING*)SELF->data);
+	dest->data =
 	    string_concat(INTERP,
 			  s,
 			  value,
 			  0
 			 );
-	/* don't destroy s, as it is dest->cache.struct_val */
+	/* don't destroy s, as it is dest->data */
     }
 
     void concatenate_unicode (STRING * value, PMC* dest) {
-	STRING* s = string_copy(INTERP, (STRING*)SELF->cache.struct_val);
-	dest->cache.struct_val =
+	STRING* s = string_copy(INTERP, (STRING*)SELF->data);
+	dest->data =
 	    string_concat(INTERP,
 	          s,
 			  value,
 			  0
 			 );
-            /* don't destroy s, as it is dest->cache.struct_val */
+            /* don't destroy s, as it is dest->data */
     }
 
     void concatenate_other (STRING * value, PMC* dest) {
-	STRING* s = string_copy(INTERP, (STRING*)SELF->cache.struct_val);
-	dest->cache.struct_val =
+	STRING* s = string_copy(INTERP, (STRING*)SELF->data);
+	dest->data =
 	    string_concat(INTERP,
 			  s,
 			  value,
 			  0
 			 );
-	/* don't destroy s, as it is dest->cache.struct_val */
+	/* don't destroy s, as it is dest->data */
     }
 
     void concatenate_same (PMC * value, PMC* dest) {
-	dest->cache.struct_val =
+	dest->data =
 	    string_concat(INTERP,
-			  SELF->cache.struct_val,
-			  value->cache.struct_val,
+			  SELF->data,
+			  value->data,
 			  0
 			 );
     }
@@ -402,7 +403,7 @@
     /* == operation */
     BOOLVAL is_equal (PMC* value) {
         return (BOOLVAL)( 0 == string_compare(INTERP,
-				                     SELF->cache.struct_val,
+				                     SELF->data,
 				                     value->vtable->get_string(INTERP, value)
 				                    ));
     }
@@ -430,40 +431,40 @@
 
     void repeat (PMC * value, PMC* dest) {
 	dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
-	dest->cache.struct_val =
-           string_repeat(INTERP, SELF->cache.struct_val,
+	dest->data =
+           string_repeat(INTERP, SELF->data,
 	                 (UINTVAL)value->vtable->get_integer(INTERP, value), NULL
 	                );
     }
 
     void repeat_native (STRING * value, PMC* dest) {
 	dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
-	dest->cache.struct_val =
-           string_repeat(INTERP, SELF->cache.struct_val,
+	dest->data =
+           string_repeat(INTERP, SELF->data,
                          (UINTVAL)string_to_int(value), NULL
 	                );
     }
 
     void repeat_unicode (STRING * value, PMC* dest) {
 	dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
-	dest->cache.struct_val =
-           string_repeat(INTERP, SELF->cache.struct_val,
+	dest->data =
+           string_repeat(INTERP, SELF->data,
                          (UINTVAL)string_to_int(value), NULL
 	                );
     }
 
     void repeat_other (STRING * value, PMC* dest) {
 	dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
-	dest->cache.struct_val =
-           string_repeat(INTERP, SELF->cache.struct_val,
+	dest->data =
+           string_repeat(INTERP, SELF->data,
                          (UINTVAL)string_to_int(value), NULL
 	                );
     }
 
     void repeat_same (PMC * value, PMC* dest) {
 	dest->vtable = &Parrot_base_vtables[enum_class_PerlString];
-	dest->cache.struct_val =
-           string_repeat(INTERP, SELF->cache.struct_val,
+	dest->data =
+           string_repeat(INTERP, SELF->data,
 	                 (UINTVAL)value->vtable->get_integer(INTERP, value), NULL
 	                );
     }
Index: parrot/include/parrot/pmc.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc.h,v
retrieving revision 1.24
diff -u -r1.24 pmc.h
--- parrot/include/parrot/pmc.h	15 Mar 2002 19:45:00 -0000	1.24
+++ parrot/include/parrot/pmc.h	29 Mar 2002 08:09:27 -0000
@@ -38,6 +38,12 @@
         DPOINTER *struct_val;
     } cache;
     SYNC *synchronize;
+    /* This flag determines the next PMC in the 'used' list during 
+       dead object detection in the GC. It is a linked list, which is 
+       only valid in trace_active_PMCs. Also, the linked list is 
+       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
@@ -98,7 +104,10 @@
     /* Our refcount */
     PMC_refcount_field = 1 << 16 | 1 << 17,
     /* Constant flag */
-    PMC_constant_FLAG = 1 << 18
+    PMC_constant_FLAG = 1 << 18,
+    /* Immortal flag, for ensuring a PMC survives DOD. Used internally
+	 * by the GC: should not be used in PMC code. */
+    PMC_immortal_FLAG = 1 << 19
 } PMC_flags;
 
 /* XXX add various bit test macros once we have need of them */

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About