cvsuser 03/11/27 02:43:37
Modified: src pmc_freeze.c
t/pmc freeze.t
Log:
freeze-thaw-8
* handle NULL PMCs
* added some comments
Revision Changes Path
1.12 +65 -19 parrot/src/pmc_freeze.c
Index: pmc_freeze.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc_freeze.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- pmc_freeze.c 26 Nov 2003 12:38:34 -0000 1.11
+++ pmc_freeze.c 27 Nov 2003 10:43:34 -0000 1.12
@@ -1,7 +1,7 @@
/* pmc_freeze.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc_freeze.c,v 1.11 2003/11/26 12:38:34 leo Exp $
+ * $Id: pmc_freeze.c,v 1.12 2003/11/27 10:43:34 leo Exp $
* Overview:
* Freeze and thaw functionality
* Data Structure and Algorithms:
@@ -447,8 +447,14 @@
int seen, UINTVAL id)
{
IMAGE_IO *io = info->image_io;
- INTVAL type = pmc->vtable->base_type;
+ INTVAL type;
+ if (PMC_IS_NULL(pmc)) {
+ /* NULL + seen bit */
+ io->vtable->push_pmc(interpreter, io, (PMC*) 1);
+ return;
+ }
+ type = pmc->vtable->base_type;
if (seen) {
if (info->extra_flags) {
id |= 3;
@@ -510,6 +516,7 @@
case VISIT_FREEZE_AT_DESTRUCT:
case VISIT_FREEZE_NORMAL:
freeze_pmc(interpreter, pmc, info, seen, id);
+ if (pmc)
info->visit_action = pmc->vtable->freeze;
break;
default:
@@ -553,6 +560,14 @@
int must_have_seen = thaw_pmc(interpreter, info, &id, &type);
id >>= 2;
+
+ if (!id) {
+ /* got a NULL PMC */
+ pmc = PMCNULL;
+ *info->thaw_ptr = pmc;
+ return pmc;
+ }
+
pos = list_get(interpreter, PMC_data(info->id_list), id, enum_type_PMC);
if (pos == (void*)-1)
pos = NULL;
@@ -597,6 +612,11 @@
return pmc;
}
+/*
+ * create a unique id (tag) for a PMC - this is the object number in
+ * the PMCs arena(s) shifted left by 2
+ * start at 1<<2, 0 is a NULLPMC
+ */
#if ARENA_DOD_FLAGS
static UINTVAL
id_from_pmc(Parrot_Interp interpreter, PMC* pmc)
@@ -686,6 +706,11 @@
UINTVAL *id)
{
int seen = 0;
+ if (PMC_IS_NULL(pmc)) {
+ *id = 0;
+ return 1;
+ }
+
/*
* we can only remember PMCs with a next_for_GC pointer
* which is located in pmc_ext
@@ -715,7 +740,7 @@
list_push(interpreter, PMC_data(info->todo), pmc, enum_type_PMC);
}
/*
- * return true if PMC was seen, else put in on the todo list
+ * return true if PMC was seen, else put it on the todo list
* generate ID (tag) for PMC, offset by 4 as are addresses, lo bits
* are flags
*/
@@ -813,7 +838,7 @@
visit_info *info)
{
List *todo = PMC_data(info->todo);
- int i;
+ int i, n;
(info->visit_pmc_now)(interpreter, current, info);
/*
@@ -825,6 +850,8 @@
current = *(PMC**)list_get(interpreter, todo, i, enum_type_PMC);
VTABLE_visit(interpreter, current, info);
}
+ if (info->what == VISIT_THAW_CONSTANTS ||
+ info->what == VISIT_THAW_NORMAL) {
/*
* if image isn't consumed, there are some extra data to thaw
*/
@@ -835,9 +862,7 @@
/*
* 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);
+ 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);
@@ -852,10 +877,10 @@
create_image(Parrot_Interp interpreter, PMC *pmc, visit_info *info)
{
INTVAL len = FREEZE_BYTES_PER_ITEM;
- if (VTABLE_does(interpreter, pmc,
+ if (!PMC_IS_NULL(pmc) && (VTABLE_does(interpreter, pmc,
string_from_cstring(interpreter, "array", 0)) ||
VTABLE_does(interpreter, pmc,
- string_from_cstring(interpreter, "hash", 0))) {
+ string_from_cstring(interpreter, "hash", 0)))) {
INTVAL items = VTABLE_elements(interpreter, pmc);
/*
* TODO check e.g. first item of aggregate and estimate size
@@ -886,8 +911,15 @@
visit_info info;
PMC *n = NULL;
int dod_block = 0;
+ UINTVAL bufused;
info.image = image;
+ bufused = image->bufused;
+ /*
+ * if we are thawing a lot of PMCs, its cheaper to do
+ * a DOD run first and then block DOD - the limit should be
+ * chosen so that no more then one DOD run would be triggered
+ */
if (string_length(image) > THAW_BLOCK_DOD_SIZE) {
Parrot_do_dod_run(interpreter, 1);
Parrot_block_DOD(interpreter);
@@ -900,8 +932,22 @@
info.visit_pmc_now = visit_todo_list_thaw;
info.visit_pmc_later = add_pmc_todo_list;
+ /*
+ * create first PMC, we want to return it
+ */
n = new_pmc_header(interpreter);
+ info.thaw_ptr = &n;
+ /*
+ * run thaw loop
+ */
visit_loop_todo_list(interpreter, n, &info);
+ /*
+ * thaw does "consume" the image string by incrementing strstart
+ * and decrementing bufused - restore that
+ */
+ LVALUE_CAST(ptrdiff_t, image->strstart) -= bufused;
+ image->bufused = bufused;
+ assert(image->strstart >= image->bufstart);
if (dod_block) {
Parrot_unblock_DOD(interpreter);
@@ -928,6 +974,7 @@
cleanup_next_for_GC(interpreter);
info.what = VISIT_FREEZE_AT_DESTRUCT;
info.mark_ptr = pmc;
+ info.thaw_ptr = NULL;
info.visit_pmc_now = visit_next_for_GC;
info.visit_pmc_later = add_pmc_next_for_GC;
create_image(interpreter, pmc, &info);
@@ -935,7 +982,6 @@
visit_loop_next_for_GC(interpreter, pmc, &info);
- cleanup_next_for_GC(interpreter);
Parrot_unblock_DOD(interpreter);
return info.image;
}
1.5 +46 -1 parrot/t/pmc/freeze.t
Index: freeze.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/freeze.t,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- freeze.t 26 Nov 2003 10:40:26 -0000 1.4
+++ freeze.t 27 Nov 2003 10:43:37 -0000 1.5
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 8;
+use Parrot::Test tests => 10;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a PerlInt");
@@ -241,4 +241,49 @@
666
777
42
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a NULL pmc");
+ null P0
+ freeze S0, P0
+ thaw P10, S0
+ defined I0, P10
+ unless I0, ok
+ print "not "
+ok: print "ok\n"
+ end
+CODE
+ok
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "freeze/thaw array w NULL pmc");
+ new P0, .PerlArray
+ null P1
+ push P0, P1
+ new P1, .PerlInt
+ set P1, 10
+ push P0, P1
+
+ freeze S0, P0
+ thaw P10, S0
+
+ typeof S10, P10
+ print S10
+ print " "
+ set I11, P10
+ print I11
+ print "\n"
+ set P11, P10[0]
+ defined I0, P11
+ unless I0, ok
+ print "not "
+ok: print "ok\n"
+ set P11, P10[1]
+ print P11
+ print "\n"
+ end
+CODE
+PerlArray 2
+ok
+10
OUTPUT
