cvsuser 03/11/25 05:20:43
Modified: classes default.pmc perlhash.pmc perlint.pmc
docs/dev pmc_freeze.pod
include/parrot pmc_freeze.h
src hash.c list.c pmc_freeze.c
. vtable.tbl
Log:
freeze-thaw-6
* add thawfinish vtable and default implementaion
* add add_pmc_to_todo callbacks
* renamed callbacks
Revision Changes Path
1.74 +8 -1 parrot/classes/default.pmc
Index: default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -w -r1.73 -r1.74
--- default.pmc 19 Nov 2003 15:43:20 -0000 1.73
+++ default.pmc 25 Nov 2003 13:20:21 -0000 1.74
@@ -1,6 +1,6 @@
/* default.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
- * CVS Info $Id: default.pmc,v 1.73 2003/11/19 15:43:20 dan Exp $
+ * CVS Info $Id: default.pmc,v 1.74 2003/11/25 13:20:21 leo Exp $
* Overview:
* These are the vtable functions for the default PMC class
* Data Structure and Algorithms:
@@ -318,12 +318,19 @@
}
void visit(visit_info *info) {
+ /* default - no action */
}
void freeze(visit_info *info) {
+ /* default - no action */
}
void thaw(visit_info *info) {
+ /* default - initialize the PMC */
DYNSELF.init();
+ }
+
+ void thawfinish(visit_info *info) {
+ /* default - no action */
}
}
1.61 +2 -1 parrot/classes/perlhash.pmc
Index: perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.60
retrieving revision 1.61
diff -u -w -r1.60 -r1.61
--- perlhash.pmc 24 Nov 2003 17:11:23 -0000 1.60
+++ perlhash.pmc 25 Nov 2003 13:20:21 -0000 1.61
@@ -1,7 +1,7 @@
/* perlhash.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perlhash.pmc,v 1.60 2003/11/24 17:11:23 leo Exp $
+ * $Id: perlhash.pmc,v 1.61 2003/11/25 13:20:21 leo Exp $
* Overview:
* These are the vtable functions for the PerlHash base class
* Data Structure and Algorithms:
@@ -297,6 +297,7 @@
void freeze(visit_info *info) {
IMAGE_IO *io = info->image_io;
+ SUPER(info);
io->vtable->push_integer(INTERP, io, VTABLE_elements(INTERP, SELF));
}
1.52 +2 -1 parrot/classes/perlint.pmc
Index: perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -w -r1.51 -r1.52
--- perlint.pmc 19 Nov 2003 15:43:20 -0000 1.51
+++ perlint.pmc 25 Nov 2003 13:20:21 -0000 1.52
@@ -1,7 +1,7 @@
/* perlint.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perlint.pmc,v 1.51 2003/11/19 15:43:20 dan Exp $
+ * $Id: perlint.pmc,v 1.52 2003/11/25 13:20:21 leo Exp $
* Overview:
* These are the vtable functions for the PerlInt base class
* Data Structure and Algorithms:
@@ -470,6 +470,7 @@
void freeze(visit_info *info) {
IMAGE_IO *io = info->image_io;
+ SUPER(info);
io->vtable->push_integer(INTERP, io, SELF->cache.int_val);
}
1.4 +13 -6 parrot/docs/dev/pmc_freeze.pod
Index: pmc_freeze.pod
===================================================================
RCS file: /cvs/public/parrot/docs/dev/pmc_freeze.pod,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- pmc_freeze.pod 20 Nov 2003 14:57:49 -0000 1.3
+++ pmc_freeze.pod 25 Nov 2003 13:20:31 -0000 1.4
@@ -107,26 +107,30 @@
=head2 Putting items on the todo list
This is done by a callback function inside the B<visit_info> structure
-called B<visit_child_function>. It gets called initially to put the
+called B<visit_pmc_now>. It gets called initially to put the
first item on the list and is called thereafter from all PMCs for
contained PMCs inside the B<visit> vtable method.
+There is another callback B<visit_pmc_later> which adds PMCs to the
+todo list for later processing, but doesn't do any action on these
+immediately.
+
=head2 The visit() vtable
The general scheme above shows that this method is called for all
items on the B<todo_list>. B<visit> has to call
-B<visit_child_function> for all contained PMCs, which then get
+B<visit_pmc_now> for all contained PMCs, which then get
visited until all is done.
-=head2 The visit_child_function() callback
+=head2 The visit_pmc_now() callback
The basic operation is:
(seen, id) = was_already_seen(pmc)
do_specific_action(pmc, seen, id)
if (!seen)
- pmc->visit_function()
+ pmc->visit_action()
=head2 Avoiding duplicates
@@ -189,8 +193,7 @@
desired functionality. First the PMC-specific part is done inside
F<pmc_freeze.c> then the specific vtable method B<freeze>, B<thaw>,
whatever, is called, again via a function pointer called
-B<visit_function> (albeit B<action_function> might be a better name
-for it).
+B<visit_action>.
=head1 Freeze and thaw
@@ -272,6 +275,10 @@
<id+0x3><type><id-prop><pmc-data><prop-data>
[ To be continued ]
+
+=head1 FILES
+
+F<src/pmc_freeze.c>, F<pf/pf_items.c>
=head1 Author
1.3 +5 -5 parrot/include/parrot/pmc_freeze.h
Index: pmc_freeze.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc_freeze.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- pmc_freeze.h 24 Nov 2003 17:11:26 -0000 1.2
+++ pmc_freeze.h 25 Nov 2003 13:20:35 -0000 1.3
@@ -1,7 +1,7 @@
/* pmc_freeze.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc_freeze.h,v 1.2 2003/11/24 17:11:26 leo Exp $
+ * $Id: pmc_freeze.h,v 1.3 2003/11/25 13:20:35 leo Exp $
* Overview:
* PMC freeze and thaw interface
* Data Structure and Algorithms:
@@ -14,7 +14,6 @@
#define PARROT_PMC_FREEZE_H_GUARD
struct _visit_info;
-typedef void (*visit_child_f)(Parrot_Interp, PMC*, struct _visit_info*);
typedef void (*visit_f)(Parrot_Interp, PMC*, struct _visit_info*);
typedef enum {
@@ -55,8 +54,9 @@
} image_io;
typedef struct _visit_info {
- visit_child_f visit_child_function;
- visit_f visit_function; /* freeze, thaw ... */
+ visit_f visit_pmc_now;
+ visit_f visit_pmc_later;
+ visit_f visit_action; /* freeze, thaw ... */
visit_enum_type what;
STRING* image;
PMC* mark_ptr;
@@ -64,7 +64,7 @@
INTVAL last_type;
PMC* seen; /* seen hash */
PMC* todo; /* todo list */
- PMC* id_list; /* used by thaw */
+ PMC* id_list; /* seen list used by thaw */
UINTVAL id; /* freze ID of PMC */
void* extra; /* PMC specific */
IMAGE_IO *image_io;
1.64 +3 -3 parrot/src/hash.c
Index: hash.c
===================================================================
RCS file: /cvs/public/parrot/src/hash.c,v
retrieving revision 1.63
retrieving revision 1.64
diff -u -w -r1.63 -r1.64
--- hash.c 24 Nov 2003 17:11:38 -0000 1.63
+++ hash.c 25 Nov 2003 13:20:37 -0000 1.64
@@ -1,7 +1,7 @@
/* hash.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: hash.c,v 1.63 2003/11/24 17:11:38 leo Exp $
+ * $Id: hash.c,v 1.64 2003/11/25 13:20:37 leo Exp $
* Overview:
* Data Structure and Algorithms:
* A hashtable contains an array of bucket indexes. Buckets
@@ -327,7 +327,7 @@
key = io->vtable->shift_string(interpreter, io);
b = hash_put(interpreter, hash, key, NULL);
info->thaw_ptr = (PMC**)&b->value;
- (info->visit_child_function)(interpreter, NULL, info);
+ (info->visit_pmc_now)(interpreter, NULL, info);
}
break;
default:
@@ -336,7 +336,7 @@
while (b) {
if (freezing)
io->vtable->push_string(interpreter, io, b->key);
- (info->visit_child_function)(interpreter, b->value, info);
+ (info->visit_pmc_now)(interpreter, b->value, info);
b = getBucket(hash, b->next);
}
}
1.41 +2 -2 parrot/src/list.c
Index: list.c
===================================================================
RCS file: /cvs/public/parrot/src/list.c,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -w -r1.40 -r1.41
--- list.c 24 Nov 2003 17:11:38 -0000 1.40
+++ list.c 25 Nov 2003 13:20:37 -0000 1.41
@@ -3,7 +3,7 @@
* Copyright: (c) 2002 Leopold Toetsch <[EMAIL PROTECTED]>
* License: Artistic/GPL, see README and LICENSES for details
* CVS Info
- * $Id: list.c,v 1.40 2003/11/24 17:11:38 leo Exp $
+ * $Id: list.c,v 1.41 2003/11/25 13:20:37 leo Exp $
* Overview:
* list aka array routines for Parrot
* History:
@@ -1177,7 +1177,7 @@
for (i = 0; i < chunk->items && idx < n; i++, idx++) {
pos = ((PMC **)chunk->data.bufstart) + i;
info->thaw_ptr = pos;
- (info->visit_child_function)(interpreter, *pos, info);
+ (info->visit_pmc_now)(interpreter, *pos, info);
}
}
/*
1.9 +64 -25 parrot/src/pmc_freeze.c
Index: pmc_freeze.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc_freeze.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -w -r1.8 -r1.9
--- pmc_freeze.c 24 Nov 2003 17:11:38 -0000 1.8
+++ pmc_freeze.c 25 Nov 2003 13:20:37 -0000 1.9
@@ -1,7 +1,7 @@
/* pmc_freeze.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc_freeze.c,v 1.8 2003/11/24 17:11:38 leo Exp $
+ * $Id: pmc_freeze.c,v 1.9 2003/11/25 13:20:37 leo Exp $
* Overview:
* Freeze and thaw functionality
* Data Structure and Algorithms:
@@ -412,12 +412,14 @@
}
static void visit_todo_list(Parrot_Interp, PMC*, visit_info* info);
+static void add_pmc_todo_list(Parrot_Interp, PMC*, visit_info* info);
static void
todo_list_init(Parrot_Interp interpreter, visit_info *info)
{
Hash *hash;
- info->visit_child_function = visit_todo_list;
+ info->visit_pmc_now = visit_todo_list;
+ info->visit_pmc_later = add_pmc_todo_list;
/* we must use PMCs here, so that they get marked properly */
info->todo = pmc_new(interpreter, enum_class_Array);
info->seen = pmc_new_noinit(interpreter, enum_class_PerlHash);
@@ -480,7 +482,7 @@
if (*type <= 0 || *type >= enum_class_max)
internal_exception(1, "Unknown PMC type to thaw %d", (int) *type);
}
- *id = (UINTVAL) n & ~3;
+ *id = (UINTVAL) n;
return seen;
}
@@ -497,7 +499,7 @@
case VISIT_FREEZE_AT_DESTRUCT:
case VISIT_FREEZE_NORMAL:
freeze_pmc(interpreter, pmc, info, seen, id);
- info->visit_function = pmc->vtable->freeze;
+ info->visit_action = pmc->vtable->freeze;
break;
default:
internal_exception(1, "Illegal action %d", info->what);
@@ -537,19 +539,19 @@
{
UINTVAL id;
INTVAL type;
- PMC ** b;
+ PMC ** pos;
int must_have_seen = thaw_pmc(interpreter, info, &id, &type);
- b = list_get(interpreter, PMC_data(info->id_list), id >> 2,
- enum_type_PMC);
- if (b == (void*)-1)
- b = NULL;
- else if (b) {
- pmc = *(PMC**)b;
+ id >>= 2;
+ pos = list_get(interpreter, PMC_data(info->id_list), id, enum_type_PMC);
+ if (pos == (void*)-1)
+ pos = NULL;
+ else if (pos) {
+ pmc = *(PMC**)pos;
if (!pmc)
- b = NULL;
+ pos = NULL;
}
- if (b) {
+ if (pos) {
*seen = 1;
#if FREEZE_USE_NEXT_FOR_GC
/*
@@ -573,9 +575,8 @@
*seen = 0;
pmc = thaw_create_pmc(interpreter, pmc, info, type);
- info->visit_function = pmc->vtable->thaw;
- list_assign(interpreter, PMC_data(info->id_list), id >> 2, pmc,
- enum_type_PMC);
+ info->visit_action = pmc->vtable->thaw;
+ list_assign(interpreter, PMC_data(info->id_list), id, pmc, enum_type_PMC);
/* remember nested aggregates depth first */
if (pmc->pmc_ext)
list_push(interpreter, PMC_data(info->todo), pmc, enum_type_PMC);
@@ -649,8 +650,20 @@
#endif
/*
+ * remember pmc for later processing
+ */
+static void
+add_pmc_next_for_GC(Parrot_Interp interpreter, PMC *pmc, visit_info *info)
+{
+ if (pmc->pmc_ext) {
+ info->mark_ptr->next_for_GC = pmc;
+ info->mark_ptr = pmc->next_for_GC = pmc;
+ }
+}
+
+/*
* remember next child to visit via the next_for_GC pointer
- * generate a unique ID per PMC and freeze the ID not the PMC addr
+ * generate a unique ID per PMC and freeze the ID (not the PMC addr)
* so thaw the hash-lookup can be replaced by an array lookup then
* which is a lot faster
*/
@@ -680,6 +693,14 @@
}
/*
+ * remember pmc to be processed later
+ */
+static void
+add_pmc_todo_list(Parrot_Interp interpreter, PMC *pmc, visit_info *info)
+{
+ list_push(interpreter, PMC_data(info->todo), pmc, enum_type_PMC);
+}
+/*
* return true if PMC was seen, else put in on the todo list
* generate ID (tag) for PMC, offset by 4 as are addresses, lo bits
* are flags
@@ -723,7 +744,7 @@
* callback is there.
*/
if (!seen)
- (info->visit_function)(interpreter, pmc, info);
+ (info->visit_action)(interpreter, pmc, info);
}
/*
@@ -736,7 +757,7 @@
int seen = todo_list_seen(interpreter, pmc, info, &id);
do_action(interpreter, pmc, info, seen, id);
if (!seen)
- (info->visit_function)(interpreter, pmc, info);
+ (info->visit_action)(interpreter, pmc, info);
}
/*
@@ -749,7 +770,7 @@
int seen;
PMC* pmc = do_thaw(interpreter, old, info, &seen);
if (!seen)
- (info->visit_function)(interpreter, pmc, info);
+ (info->visit_action)(interpreter, pmc, info);
}
/*
@@ -778,11 +799,27 @@
visit_info *info)
{
List *todo = PMC_data(info->todo);
- (info->visit_child_function)(interpreter, current, info);
- while (list_length(interpreter, todo)) {
- current = *(PMC**)list_shift(interpreter, todo, enum_type_PMC);
+ int i;
+
+ (info->visit_pmc_now)(interpreter, current, info);
+ /*
+ * can't cache upper limit, visit may append items
+ */
+ for (i = 0; i < (int)list_length(interpreter, todo); ++i) {
+ current = *(PMC**)list_get(interpreter, todo, i, enum_type_PMC);
VTABLE_visit(interpreter, current, info);
}
+ /*
+ * on thawing call thawfinish for each processed PMC
+ */
+ if (info->what == VISIT_THAW_CONSTANTS ||
+ info->what == VISIT_THAW_NORMAL) {
+ int n = (int)list_length(interpreter, todo);
+ for (i = 0; i < n ; ++i) {
+ current = *(PMC**)list_get(interpreter, todo, i, enum_type_PMC);
+ VTABLE_thawfinish(interpreter, current, info);
+ }
+ }
}
/*
@@ -837,7 +874,8 @@
info.what = what; /* _NORMAL or _CONSTANTS */
todo_list_init(interpreter, &info);
- info.visit_child_function = visit_todo_list_thaw;
+ info.visit_pmc_now = visit_todo_list_thaw;
+ info.visit_pmc_later = add_pmc_todo_list;
n = new_pmc_header(interpreter);
visit_loop_todo_list(interpreter, n, &info);
@@ -867,7 +905,8 @@
cleanup_next_for_GC(interpreter);
info.what = VISIT_FREEZE_AT_DESTRUCT;
info.mark_ptr = pmc;
- info.visit_child_function = visit_next_for_GC;
+ info.visit_pmc_now = visit_next_for_GC;
+ info.visit_pmc_later = add_pmc_next_for_GC;
create_image(interpreter, pmc, &info);
ft_init(interpreter, &info);
1.50 +2 -1 parrot/vtable.tbl
Index: vtable.tbl
===================================================================
RCS file: /cvs/public/parrot/vtable.tbl,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -w -r1.49 -r1.50
--- vtable.tbl 19 Nov 2003 15:43:17 -0000 1.49
+++ vtable.tbl 25 Nov 2003 13:20:43 -0000 1.50
@@ -1,4 +1,4 @@
-# $Id: vtable.tbl,v 1.49 2003/11/19 15:43:17 dan Exp $
+# $Id: vtable.tbl,v 1.50 2003/11/25 13:20:43 leo Exp $
# [MAIN] #default section name
void init()
@@ -286,4 +286,5 @@
void freeze(visit_info* info)
void thaw (visit_info* info)
+void thawfinish (visit_info* info)
void visit (visit_info* info)
