cvsuser 05/03/26 05:22:35
Modified: classes fixedpmcarray.pmc key.pmc
t/pmc freeze.t
Log:
key freeze/thaw; complex PMC array keys
* freeze and thaw for Key PMCs
* p[1; 'foo'] for PMCArrays
Revision Changes Path
1.33 +37 -6 parrot/classes/fixedpmcarray.pmc
Index: fixedpmcarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/fixedpmcarray.pmc,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- fixedpmcarray.pmc 24 Mar 2005 14:08:15 -0000 1.32
+++ fixedpmcarray.pmc 26 Mar 2005 13:22:34 -0000 1.33
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: fixedpmcarray.pmc,v 1.32 2005/03/24 14:08:15 leo Exp $
+$Id: fixedpmcarray.pmc,v 1.33 2005/03/26 13:22:34 leo Exp $
=head1 NAME
@@ -286,9 +286,16 @@
*/
INTVAL get_integer_keyed (PMC* key) {
- /* simple int keys only */
INTVAL k = key_integer(INTERP, key);
- return DYNSELF.get_integer_keyed_int(k);
+ PMC *box, *nextkey;
+
+ nextkey = key_next(INTERP, key);
+ if (!nextkey)
+ return DYNSELF.get_integer_keyed_int(k);
+ box = SELF.get_pmc_keyed_int(k);
+ if (box == NULL)
+ box = pmc_new(INTERP, enum_class_Undef);
+ return VTABLE_get_integer_keyed(INTERP, box, nextkey);
}
@@ -319,7 +326,15 @@
FLOATVAL get_number_keyed (PMC* key) {
INTVAL k = key_integer(INTERP, key);
- return DYNSELF.get_number_keyed_int(k);
+ PMC *box, *nextkey;
+
+ nextkey = key_next(INTERP, key);
+ if (!nextkey)
+ return DYNSELF.get_number_keyed_int(k);
+ box = SELF.get_pmc_keyed_int(k);
+ if (box == NULL)
+ box = pmc_new(INTERP, enum_class_Undef);
+ return VTABLE_get_number_keyed(INTERP, box, nextkey);
}
/*
@@ -349,7 +364,15 @@
STRING* get_string_keyed(PMC* key) {
INTVAL k = key_integer(INTERP, key);
- return DYNSELF.get_string_keyed_int(k);
+ PMC *box, *nextkey;
+
+ nextkey = key_next(INTERP, key);
+ if (!nextkey)
+ return DYNSELF.get_string_keyed_int(k);
+ box = SELF.get_pmc_keyed_int(k);
+ if (box == NULL)
+ box = pmc_new(INTERP, enum_class_Undef);
+ return VTABLE_get_string_keyed(INTERP, box, nextkey);
}
@@ -385,7 +408,15 @@
PMC* get_pmc_keyed(PMC* key) {
INTVAL k = key_integer(INTERP, key);
- return DYNSELF.get_pmc_keyed_int(k);
+ PMC *box, *nextkey;
+
+ nextkey = key_next(INTERP, key);
+ if (!nextkey)
+ return DYNSELF.get_pmc_keyed_int(k);
+ box = SELF.get_pmc_keyed_int(k);
+ if (box == NULL)
+ box = pmc_new(INTERP, enum_class_Undef);
+ return VTABLE_get_pmc_keyed(INTERP, box, nextkey);
}
/*
1.28 +97 -3 parrot/classes/key.pmc
Index: key.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/key.pmc,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- key.pmc 12 Jan 2005 11:42:06 -0000 1.27
+++ key.pmc 26 Mar 2005 13:22:34 -0000 1.28
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: key.pmc,v 1.27 2005/01/12 11:42:06 leo Exp $
+$Id: key.pmc,v 1.28 2005/03/26 13:22:34 leo Exp $
=head1 NAME
@@ -23,7 +23,7 @@
static int
is_hash_iter(PMC *agg, PMC *key)
{
- if ((PObj_get_FLAGS(key) & KEY_type_FLAGS) ==
+ if ((PObj_get_FLAGS(key) & KEY_type_FLAGS) ==
KEY_hash_iterator_FLAGS )
return 1;
return 0;
@@ -298,7 +298,7 @@
PObj_get_FLAGS(ret) |= KEY_integer_FLAG;
/*
* KEY_hash_iterator_FLAGS, which is the same as
- * KEY_integer_FLAG | KEY_number_FLAG
+ * KEY_integer_FLAG | KEY_number_FLAG
* indicates a hash iterator operation
* KEY_integer_FLAG alone is an indexed hash lookup
* with an Integer KEY
@@ -342,6 +342,100 @@
}
return ret;
}
+/*
+
+=item C<void visit(visit_info *info)>
+
+This is used by freeze/thaw to visit the contents of the Key.
+
+=item C<void freeze(visit_info *info)>
+
+Archives the Key.
+
+=item C<void thaw(visit_info *info)>
+
+Unarchives the Key.
+
+=item C<void thawfinish(visit_info *info)>
+
+Called after the Key has been thawed: convert last PMC_NULL key to NULL.
+
+=cut
+
+*/
+
+ void visit(visit_info *info) {
+ /*
+ * at end a PMC_NULL is written during thaw,
+ * which should stop visiting the key
+ */
+ PMC **pos = (PMC**)&PMC_data(SELF);
+ info->thaw_ptr = pos;
+ (info->visit_pmc_now)(INTERP, *pos, info);
+ }
+
+ void freeze(visit_info *info) {
+ IMAGE_IO *io = info->image_io;
+ /* write flags */
+ INTVAL flags = (PObj_get_FLAGS(SELF) & KEY_type_FLAGS);
+ /* write the contents of a register - else thaw can't restore
+ * the register state
+ */
+ io->vtable->push_integer(INTERP, io, flags & ~KEY_register_FLAG);
+ /* and contents of this key component */
+ switch (flags) {
+ case KEY_integer_FLAG:
+ case KEY_integer_FLAG|KEY_register_FLAG:
+ io->vtable->push_integer(INTERP, io, key_integer(INTERP,
SELF));
+ break;
+ case KEY_number_FLAG:
+ case KEY_number_FLAG|KEY_register_FLAG:
+ io->vtable->push_float(INTERP, io, key_number(INTERP, SELF));
+ break;
+ case KEY_string_FLAG:
+ case KEY_string_FLAG|KEY_register_FLAG:
+ io->vtable->push_string(INTERP, io, key_string(INTERP,
SELF));
+ break;
+ default:
+ internal_exception(1, "Unsupported key type in Key.freeze");
+ break;
+ }
+ }
+
+ void thaw(visit_info *info) {
+ IMAGE_IO *io = info->image_io;
+ /* get flags */
+ INTVAL flags = io->vtable->shift_integer(INTERP, io);
+ flags &= KEY_type_FLAGS;
+ PObj_get_FLAGS(SELF) |= flags;
+ /* get contents */
+ switch (flags) {
+ case KEY_integer_FLAG:
+ PMC_int_val(SELF) = io->vtable->shift_integer(INTERP, io);
+ break;
+ case KEY_number_FLAG:
+ PMC_num_val(SELF) = io->vtable->shift_float(INTERP, io);
+ break;
+ case KEY_string_FLAG:
+ PMC_str_val(SELF) = io->vtable->shift_string(INTERP, io);
+ break;
+ default:
+ internal_exception(1, "Unsupported key type in Key.freeze");
+ break;
+ }
+ }
+
+ void thawfinish(visit_info *info) {
+ PMC *key = SELF, *next;
+ while (1) {
+ next = PMC_data(key);
+ if (PMC_IS_NULL(next)) {
+ PMC_data(key) = NULL;
+ break;
+ }
+ key = next;
+ }
+ }
}
/*
1.22 +37 -2 parrot/t/pmc/freeze.t
Index: freeze.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/freeze.t,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- freeze.t 2 Jan 2005 11:34:56 -0000 1.21
+++ freeze.t 26 Mar 2005 13:22:35 -0000 1.22
@@ -1,7 +1,7 @@
#! perl -w
# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: freeze.t,v 1.21 2005/01/02 11:34:56 leo Exp $
+# $Id: freeze.t,v 1.22 2005/03/26 13:22:35 leo Exp $
=head1 NAME
@@ -17,7 +17,7 @@
=cut
-use Parrot::Test tests => 24;
+use Parrot::Test tests => 25;
use Test::More;
END { unlink "temp.fpmc"; };
@@ -728,3 +728,38 @@
ok 5
ok 6
OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "freeze Key");
+ new P0, .Hash
+ new P1, .FixedPMCArray
+ set P1, 2
+ set P1[1], P0
+ set P0["foo"], "ok\n"
+ set S0, P1[1; "foo"]
+ print S0
+
+ new P3, .Key
+ set P3, 1
+ new P4, .Key
+ set P4, "foo"
+ push P3, P4
+
+ set S0, P1[P3]
+ print S0
+
+ freeze S0, P3
+ print "ok 1\n"
+ thaw P5, S0
+ print "ok 2\n"
+
+ set S0, P1[P5]
+ print S0
+ end
+CODE
+ok
+ok
+ok 1
+ok 2
+ok
+OUTPUT
+
