cvsuser 04/11/09 00:43:11
Modified: classes parrotclass.pmc
src pmc_freeze.c
t/pmc freeze.t
Log:
freeze_thaw a class 1 - classname
Revision Changes Path
1.25 +73 -1 parrot/classes/parrotclass.pmc
Index: parrotclass.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotclass.pmc,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- parrotclass.pmc 16 Jul 2004 12:15:27 -0000 1.24
+++ parrotclass.pmc 9 Nov 2004 08:43:08 -0000 1.25
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: parrotclass.pmc,v 1.24 2004/07/16 12:15:27 leo Exp $
+$Id: parrotclass.pmc,v 1.25 2004/11/09 08:43:08 leo Exp $
=head1 NAME
@@ -131,6 +131,78 @@
PMC* get_class() {
return SELF;
}
+
+/*
+
+=item C<void visit(visit_info *info)>
+
+This is used by freeze/thaw to visit the contents of the class.
+
+C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
+
+=item C<void freeze(visit_info *info)>
+
+Used to archive the class.
+
+=item C<void thaw(visit_info *info)>
+
+Used to unarchive the class.
+
+=cut
+
+*/
+
+ void visit(visit_info *info) {
+ INTVAL i, n;
+ PMC **class_data, **pos;
+
+ class_data = (PMC **)PMC_data(SELF);
+
+ /* 2) direct parents array */
+ pos = class_data + PCD_PARENTS;
+ info->thaw_ptr = pos;
+ (info->visit_pmc_now)(interpreter, *pos, info);
+ /* 3) attributes */
+ pos = class_data + PCD_ATTRIBUTES;
+ info->thaw_ptr = pos;
+ (info->visit_pmc_now)(interpreter, *pos, info);
+ SUPER(info);
+ }
+
+ void freeze(visit_info *info) {
+ IMAGE_IO *io = info->image_io;
+ PMC **class_data, **pos;
+
+ SUPER(info);
+ class_data = (PMC **)PMC_data(SELF);
+ /* 1) freeze class name */
+ pos = class_data + PCD_CLASS_NAME;
+ io->vtable->push_string(INTERP, io,
+ VTABLE_get_string(INTERP, *pos));
+ }
+
+ void thaw(visit_info *info) {
+ IMAGE_IO *io = info->image_io;
+ SUPER(info);
+ if (info->extra_flags == EXTRA_IS_NULL) {
+ STRING *class_name;
+ INTVAL new_type;
+ /* thaw class name */
+ class_name = io->vtable->shift_string(INTERP, io);
+ /* if class exists in this interpreter, check if the
+ * thawed class is the same, if not bail out, if yes
+ * ignore the class, consume the byte string
+ */
+ new_type = pmc_type(INTERP, class_name);
+ if (new_type > enum_type_undef) {
+ /* TODO */
+ }
+ else {
+ Parrot_new_class(INTERP, *info->thaw_ptr, class_name);
+ }
+ }
+ }
+
}
/*
1.28 +6 -2 parrot/src/pmc_freeze.c
Index: pmc_freeze.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc_freeze.c,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -r1.27 -r1.28
--- pmc_freeze.c 8 Nov 2004 10:37:49 -0000 1.27
+++ pmc_freeze.c 9 Nov 2004 08:43:09 -0000 1.28
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pmc_freeze.c,v 1.27 2004/11/08 10:37:49 leo Exp $
+$Id: pmc_freeze.c,v 1.28 2004/11/09 08:43:09 leo Exp $
=head1 NAME
@@ -853,8 +853,12 @@
}
else { /* type follows */
info->last_type = *type = io->vtable->shift_integer(interpreter, io);
- if (*type <= 0 || *type >= enum_class_max)
+ if (*type <= 0)
internal_exception(1, "Unknown PMC type to thaw %d", (int)
*type);
+ if (*type >= enum_class_max) {
+ /* that ought to be a class */
+ *type = enum_class_ParrotClass;
+ }
}
*id = (UINTVAL) n;
return seen;
1.13 +46 -2 parrot/t/pmc/freeze.t
Index: freeze.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/freeze.t,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- freeze.t 8 Nov 2004 10:37:50 -0000 1.12
+++ freeze.t 9 Nov 2004 08:43:11 -0000 1.13
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: freeze.t,v 1.12 2004/11/08 10:37:50 leo Exp $
+# $Id: freeze.t,v 1.13 2004/11/09 08:43:11 leo Exp $
=head1 NAME
@@ -16,9 +16,11 @@
=cut
-use Parrot::Test tests => 15;
+use Parrot::Test tests => 17;
use Test::More;
+END { unlink "temp.fpmc"; };
+
output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a PerlInt");
new P1, .PerlInt
set P1, 777
@@ -438,3 +440,45 @@
ok same
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "freeze class");
+ newclass P10, "Foo"
+ classname S10, P10
+ print S10
+ print "\n"
+ freeze S11, P10
+ print "ok 1\n"
+ open P3, "temp.fpmc", ">"
+ print P3, S11
+ close P3
+ print "ok 2\n"
+ end
+CODE
+Foo
+ok 1
+ok 2
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "thaw class into new interpreter");
+ set S3, "temp.fpmc"
+ .include "stat.pasm"
+ stat I0, S3, .STAT_FILESIZE
+ gt I0, 1, ok1
+ print "stat failed\n"
+ exit 1
+ok1:
+ open P3, S3, "<"
+ read S3, P3, I0
+ close P3
+ print "ok 1\n"
+ thaw P4, S3
+ print "ok 2\n"
+ classname S10, P4
+ print S10
+ print "\n"
+ end
+CODE
+ok 1
+ok 2
+Foo
+OUTPUT
+
