cvsuser 03/11/26 02:40:26
Modified: classes array.pmc default.pmc perlhash.pmc perlint.pmc
docs/dev pmc_freeze.pod
include/parrot pmc_freeze.h
src hash.c pmc_freeze.c
t/pmc freeze.t
Log:
freeze-thaw-7
* freeze/thaw PMC properties
Revision Changes Path
1.74 +5 -3 parrot/classes/array.pmc
Index: array.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/array.pmc,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -w -r1.73 -r1.74
--- array.pmc 24 Nov 2003 17:11:23 -0000 1.73
+++ array.pmc 26 Nov 2003 10:40:03 -0000 1.74
@@ -1,7 +1,7 @@
/* array.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: array.pmc,v 1.73 2003/11/24 17:11:23 leo Exp $
+ * $Id: array.pmc,v 1.74 2003/11/26 10:40:03 leo Exp $
* Overview:
* These are the vtable functions for the Array base class
* Data Structure and Algorithms:
@@ -537,18 +537,20 @@
}
void visit(visit_info *info) {
- SUPER(info);
list_visit(INTERP, (List *) PMC_data(SELF), info);
+ SUPER(info);
}
void freeze(visit_info *info) {
IMAGE_IO *io = info->image_io;
+ SUPER(info);
io->vtable->push_integer(INTERP, io, VTABLE_elements(INTERP, SELF));
}
void thaw(visit_info *info) {
IMAGE_IO *io = info->image_io;
SUPER(info);
+ if (info->extra_flags == EXTRA_IS_NULL)
DYNSELF.set_integer_native(io->vtable->shift_integer(INTERP, io));
}
}
1.75 +20 -3 parrot/classes/default.pmc
Index: default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -w -r1.74 -r1.75
--- default.pmc 25 Nov 2003 13:20:21 -0000 1.74
+++ default.pmc 26 Nov 2003 10:40:03 -0000 1.75
@@ -1,6 +1,6 @@
/* default.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
- * CVS Info $Id: default.pmc,v 1.74 2003/11/25 13:20:21 leo Exp $
+ * CVS Info $Id: default.pmc,v 1.75 2003/11/26 10:40:03 leo Exp $
* Overview:
* These are the vtable functions for the default PMC class
* Data Structure and Algorithms:
@@ -318,7 +318,17 @@
}
void visit(visit_info *info) {
- /* default - no action */
+ /* default - mark prop hash */
+ if (SELF->pmc_ext && SELF->metadata &&
+ info->extra_flags != EXTRA_IS_PROP_HASH) {
+ info->extra_flags = EXTRA_IS_PROP_HASH;
+ info->extra = SELF->metadata;
+ /* place escape mark */
+ (info->visit_pmc_now)(interpreter, SELF, info);
+ /* place and the prop hash */
+ (info->visit_pmc_now)(interpreter, SELF->metadata, info);
+ }
+
}
void freeze(visit_info *info) {
@@ -327,6 +337,13 @@
void thaw(visit_info *info) {
/* default - initialize the PMC */
+ if (info->extra_flags == EXTRA_IS_PROP_HASH) {
+ if (!SELF->pmc_ext)
+ add_pmc_ext(INTERP, SELF);
+ info->thaw_ptr = &SELF->metadata;
+ (info->visit_pmc_now)(interpreter, SELF->metadata, info);
+ }
+ else
DYNSELF.init();
}
1.62 +6 -3 parrot/classes/perlhash.pmc
Index: perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -w -r1.61 -r1.62
--- perlhash.pmc 25 Nov 2003 13:20:21 -0000 1.61
+++ perlhash.pmc 26 Nov 2003 10:40:03 -0000 1.62
@@ -1,7 +1,7 @@
/* perlhash.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perlhash.pmc,v 1.61 2003/11/25 13:20:21 leo Exp $
+ * $Id: perlhash.pmc,v 1.62 2003/11/26 10:40:03 leo Exp $
* Overview:
* These are the vtable functions for the PerlHash base class
* Data Structure and Algorithms:
@@ -291,8 +291,8 @@
}
void visit(visit_info *info) {
- SUPER(info);
hash_visit(INTERP, (Hash*)PMC_ptr1v(SELF), info);
+ SUPER(info);
}
void freeze(visit_info *info) {
@@ -304,6 +304,9 @@
void thaw(visit_info *info) {
IMAGE_IO *io = info->image_io;
SUPER(info);
+ if (info->extra_flags == EXTRA_IS_NULL) {
+ info->extra_flags = EXTRA_IS_COUNT;
info->extra = (void *)io->vtable->shift_integer(INTERP, io);
+ }
}
}
1.53 +3 -2 parrot/classes/perlint.pmc
Index: perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -w -r1.52 -r1.53
--- perlint.pmc 25 Nov 2003 13:20:21 -0000 1.52
+++ perlint.pmc 26 Nov 2003 10:40:03 -0000 1.53
@@ -1,7 +1,7 @@
/* perlint.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: perlint.pmc,v 1.52 2003/11/25 13:20:21 leo Exp $
+ * $Id: perlint.pmc,v 1.53 2003/11/26 10:40:03 leo Exp $
* Overview:
* These are the vtable functions for the PerlInt base class
* Data Structure and Algorithms:
@@ -477,6 +477,7 @@
void thaw(visit_info *info) {
IMAGE_IO *io = info->image_io;
SUPER(info);
+ if (info->extra_flags == EXTRA_IS_NULL)
SELF->cache.int_val = io->vtable->shift_integer(INTERP, io);
}
}
1.5 +17 -8 parrot/docs/dev/pmc_freeze.pod
Index: pmc_freeze.pod
===================================================================
RCS file: /cvs/public/parrot/docs/dev/pmc_freeze.pod,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- pmc_freeze.pod 25 Nov 2003 13:20:31 -0000 1.4
+++ pmc_freeze.pod 26 Nov 2003 10:40:08 -0000 1.5
@@ -2,6 +2,11 @@
pmc_freeze.c - design notes
+=head1 VERSION
+
+This document describes freeze/thaw internals version 0.1. This is not
+the final implementation.
+
=head1 Overview
Freezing or serializing arbitrary PMCs is an interesting problem.
@@ -262,17 +267,21 @@
0xdf5 ... id of array itself with lo bit set
The escape flag marks places in the image, where additional data will
-follow. Used as an initial PMC B<id> means, that a property hash will
-follow. Used inside the PMC stream allows a PMC to insert additional
-information into the image. During B<thaw> the PMCs vtable is called
-again, to restore these data.
+follow. After the escape flag is an int defining the kind of the
+follwing data, passed on in B<extra_flags>. During B<thaw> the PMCs
+vtable is called again, to restore these data. So a PMCs B<thaw>
+vtable has to check B<extra_flags> if normal or extra data have to be
+shifted from the image.
+
+This is e.g. needed for PMC properties or arrays containing sparse
+holes, to set the array index of the following data.
-This is e.g. needed for arrays containing sparse holes, to set the
-array index of the following data.
+A PerlInt(666) with a property hash ("answer"=>42) thus looks like:
-A PMC with a property hash thus looks like:
+ 0xdfc 33 666 0xdff 2 0xdf4 32 1 answer 0xdf8 33 42
- <id+0x3><type><id-prop><pmc-data><prop-data>
+B<0xdff> is the escape mark for the PMC B<0xdfc> followed by the
+constant B<EXTRA_IS_PROP_HASH>.
[ To be continued ]
1.4 +8 -1 parrot/include/parrot/pmc_freeze.h
Index: pmc_freeze.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/pmc_freeze.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- pmc_freeze.h 25 Nov 2003 13:20:35 -0000 1.3
+++ pmc_freeze.h 26 Nov 2003 10:40:11 -0000 1.4
@@ -1,7 +1,7 @@
/* pmc_freeze.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc_freeze.h,v 1.3 2003/11/25 13:20:35 leo Exp $
+ * $Id: pmc_freeze.h,v 1.4 2003/11/26 10:40:11 leo Exp $
* Overview:
* PMC freeze and thaw interface
* Data Structure and Algorithms:
@@ -53,6 +53,12 @@
image_funcs *vtable;
} image_io;
+typedef enum {
+ EXTRA_IS_NULL,
+ EXTRA_IS_COUNT,
+ EXTRA_IS_PROP_HASH
+} extra_flags_enum;
+
typedef struct _visit_info {
visit_f visit_pmc_now;
visit_f visit_pmc_later;
@@ -67,6 +73,7 @@
PMC* id_list; /* seen list used by thaw */
UINTVAL id; /* freze ID of PMC */
void* extra; /* PMC specific */
+ extra_flags_enum extra_flags; /* concerning to extra */
IMAGE_IO *image_io;
} visit_info;
1.65 +2 -1 parrot/src/hash.c
Index: hash.c
===================================================================
RCS file: /cvs/public/parrot/src/hash.c,v
retrieving revision 1.64
retrieving revision 1.65
diff -u -w -r1.64 -r1.65
--- hash.c 25 Nov 2003 13:20:37 -0000 1.64
+++ hash.c 26 Nov 2003 10:40:16 -0000 1.65
@@ -1,7 +1,7 @@
/* hash.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: hash.c,v 1.64 2003/11/25 13:20:37 leo Exp $
+ * $Id: hash.c,v 1.65 2003/11/26 10:40:16 leo Exp $
* Overview:
* Data Structure and Algorithms:
* A hashtable contains an array of bucket indexes. Buckets
@@ -322,6 +322,7 @@
switch (info->what) {
case VISIT_THAW_NORMAL:
case VISIT_THAW_CONSTANTS:
+ assert(info->extra_flags == EXTRA_IS_COUNT);
n = (size_t) info->extra;
for (i = 0; i < n; ++i) {
key = io->vtable->shift_string(interpreter, io);
1.10 +29 -6 parrot/src/pmc_freeze.c
Index: pmc_freeze.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc_freeze.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- pmc_freeze.c 25 Nov 2003 13:20:37 -0000 1.9
+++ pmc_freeze.c 26 Nov 2003 10:40:16 -0000 1.10
@@ -1,7 +1,7 @@
/* pmc_freeze.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc_freeze.c,v 1.9 2003/11/25 13:20:37 leo Exp $
+ * $Id: pmc_freeze.c,v 1.10 2003/11/26 10:40:16 leo Exp $
* Overview:
* Freeze and thaw functionality
* Data Structure and Algorithms:
@@ -37,7 +37,7 @@
/*
* define this to 1 for testing
*/
-#define FREEZE_ASCII 0
+#define FREEZE_ASCII 1
/*
* normal freeze can use next_for_GC ptrs or a seen hash
@@ -409,6 +409,7 @@
info->last_type = -1;
info->id_list = pmc_new(interpreter, enum_class_Array);
info->id = 0;
+ info->extra_flags = EXTRA_IS_NULL;
}
static void visit_todo_list(Parrot_Interp, PMC*, visit_info* info);
@@ -449,6 +450,12 @@
INTVAL type = pmc->vtable->base_type;
if (seen) {
+ if (info->extra_flags) {
+ id |= 3;
+ io->vtable->push_pmc(interpreter, io, (PMC*)id);
+ io->vtable->push_integer(interpreter, io, info->extra_flags);
+ return;
+ }
id |= 1; /* mark bit 0 if this PMC is known */
}
else if (type == info->last_type) {
@@ -469,9 +476,13 @@
IMAGE_IO *io = info->image_io;
int seen = 0;
- info->extra = NULL;
+ info->extra_flags = EXTRA_IS_NULL;
n = io->vtable->shift_pmc(interpreter, io);
- if ( (UINTVAL) n & 1) { /* seen PMCs have bit 0 set */
+ if ( ((UINTVAL) n & 3) == 3) {
+ /* pmc has extra data */
+ info->extra_flags = io->vtable->shift_integer(interpreter, io);
+ }
+ else if ( (UINTVAL) n & 1) { /* seen PMCs have bit 0 set */
seen = 1;
}
else if ( (UINTVAL) n & 2) { /* prev PMC was same type */
@@ -505,7 +516,6 @@
internal_exception(1, "Illegal action %d", info->what);
break;
}
- info->extra = NULL;
}
PARROT_INLINE static PMC*
@@ -553,6 +563,10 @@
}
if (pos) {
*seen = 1;
+ if (info->extra_flags) {
+ VTABLE_thaw(interpreter, pmc, info);
+ return pmc;
+ }
#if FREEZE_USE_NEXT_FOR_GC
/*
* the next_for_GC method doesn't keep track of repeated scalars
@@ -805,9 +819,18 @@
/*
* can't cache upper limit, visit may append items
*/
- for (i = 0; i < (int)list_length(interpreter, todo); ++i) {
+ i = 0;
+again:
+ for (; i < (int)list_length(interpreter, todo); ++i) {
current = *(PMC**)list_get(interpreter, todo, i, enum_type_PMC);
VTABLE_visit(interpreter, current, info);
+ }
+ /*
+ * if image isn't consumed, there are some extra data to thaw
+ */
+ if (info->image->bufused > 0) {
+ (info->visit_pmc_now)(interpreter, NULL, info);
+ goto again;
}
/*
* on thawing call thawfinish for each processed PMC
1.4 +63 -1 parrot/t/pmc/freeze.t
Index: freeze.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/freeze.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- freeze.t 24 Nov 2003 17:11:41 -0000 1.3
+++ freeze.t 26 Nov 2003 10:40:26 -0000 1.4
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 6;
+use Parrot::Test tests => 8;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a PerlInt");
@@ -179,4 +179,66 @@
PerlHash 2
666
777
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a PerlInt with prop");
+ new P1, .PerlInt
+ set P1, 666
+ new P2, .PerlInt
+ set P2, 42
+ setprop P1, "answer", P2
+ freeze S0, P1
+
+ thaw P10, S0
+ typeof S10, P10
+ print S10
+ print " "
+ set I11, P10
+ print I11
+ print "\n"
+ getprop P12, "answer", P10
+ print P12
+ print "\n"
+ end
+CODE
+PerlInt 666
+42
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "freeze/thaw Array w PerlInt with prop");
+ new P0, .PerlArray
+ new P1, .PerlInt
+ set P1, 666
+ push P0, P1
+ new P2, .PerlInt
+ set P2, 777
+ push P0, P2
+ new P3, .PerlInt
+ set P3, 42
+ setprop P1, "answer", P3
+
+ freeze S0, P0
+
+ thaw P10, S0
+ typeof S10, P10
+ print S10
+ print " "
+ set I11, P10
+ print I11
+ print "\n"
+ set P12, P10[0]
+ print P12
+ print "\n"
+ set P13, P10[1]
+ print P13
+ print "\n"
+ getprop P12, "answer", P12
+ print P12
+ print "\n"
+ end
+CODE
+PerlArray 2
+666
+777
+42
OUTPUT
