cvsuser 04/11/08 02:37:50
Modified: classes fixedpmcarray.pmc
src pmc_freeze.c trace.c
t/pmc freeze.t
Log:
freeze/thaw for fixedpmcarray
* better trace output for nullish PMCs
Revision Changes Path
1.25 +48 -1 parrot/classes/fixedpmcarray.pmc
Index: fixedpmcarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/fixedpmcarray.pmc,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- fixedpmcarray.pmc 28 Oct 2004 11:24:32 -0000 1.24
+++ fixedpmcarray.pmc 8 Nov 2004 10:37:49 -0000 1.25
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: fixedpmcarray.pmc,v 1.24 2004/10/28 11:24:32 leo Exp $
+$Id: fixedpmcarray.pmc,v 1.25 2004/11/08 10:37:49 leo Exp $
=head1 NAME
@@ -700,6 +700,53 @@
PMC_int_val(key) = -1;
return iter;
}
+
+/*
+
+=item C<void visit(visit_info *info)>
+
+This is used by freeze/thaw to visit the contents of the array.
+
+C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
+
+=item C<void freeze(visit_info *info)>
+
+Used to archive the array.
+
+=item C<void thaw(visit_info *info)>
+
+Used to unarchive the array.
+
+=cut
+
+*/
+
+ void visit(visit_info *info) {
+ INTVAL i, n;
+ PMC **pos;
+
+ n = VTABLE_elements(INTERP, SELF);
+ pos = (PMC **)PMC_data(SELF);
+ for (i = 0; i < n; ++i, ++pos) {
+ info->thaw_ptr = pos;
+ (info->visit_pmc_now)(interpreter, *pos, 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.27 +2 -2 parrot/src/pmc_freeze.c
Index: pmc_freeze.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc_freeze.c,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -r1.26 -r1.27
--- pmc_freeze.c 20 Aug 2004 08:41:39 -0000 1.26
+++ pmc_freeze.c 8 Nov 2004 10:37:49 -0000 1.27
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pmc_freeze.c,v 1.26 2004/08/20 08:41:39 leo Exp $
+$Id: pmc_freeze.c,v 1.27 2004/11/08 10:37:49 leo Exp $
=head1 NAME
@@ -908,7 +908,7 @@
thaw_create_pmc(Parrot_Interp interpreter, PMC *pmc, visit_info *info,
INTVAL type)
{
- if (pmc) { /* first thawed PMC - just attach vtable */
+ if (!PMC_IS_NULL(pmc)) { /* first thawed PMC - just attach vtable */
pmc->vtable = Parrot_base_vtables[type];
pmc_add_ext(interpreter, pmc);
}
1.68 +65 -63 parrot/src/trace.c
Index: trace.c
===================================================================
RCS file: /cvs/public/parrot/src/trace.c,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -r1.67 -r1.68
--- trace.c 30 Oct 2004 11:32:23 -0000 1.67
+++ trace.c 8 Nov 2004 10:37:49 -0000 1.68
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: trace.c,v 1.67 2004/10/30 11:32:23 leo Exp $
+$Id: trace.c,v 1.68 2004/11/08 10:37:49 leo Exp $
=head1 NAME
@@ -54,72 +54,74 @@
trace_pmc_dump(Interp *interpreter, PMC* pmc)
{
char *escaped;
- if (pmc && pmc != PMCNULL) {
- if(pmc->vtable) {
- if (pmc->vtable->data == pmc) {
- STRING *name = trace_class_name(interpreter, pmc);
- PIO_eprintf(interpreter, "%S=%Ss:PMC(%#p)",
- VTABLE_name(interpreter, pmc), name, pmc);
- }
- else if (pmc->vtable->base_type == enum_class_PerlString) {
- STRING *s = VTABLE_get_string(interpreter, pmc);
- if (!s)
- PIO_eprintf(interpreter, "%S=PMC(%#p Str:(NULL))",
- VTABLE_name(interpreter, pmc), pmc);
- else {
- escaped = PDB_escape(s->strstart, s->strlen);
- PIO_eprintf(interpreter, "%S=PMC(%#p Str:\"%s\")",
- VTABLE_name(interpreter, pmc), pmc,
- escaped ? escaped : "(null)");
- if (escaped)
- mem_sys_free(escaped);
- }
- }
- else if (pmc->vtable->base_type == enum_class_Boolean) {
- PIO_eprintf(interpreter, "Boolean=PMC(%#p: %d",
- pmc, PMC_int_val(pmc));
- }
- else if (pmc->vtable->base_type == enum_class_BigInt) {
- STRING *s = VTABLE_get_string(interpreter, pmc);
- PIO_eprintf(interpreter, "BigInt=PMC(%#p: %Ss",
- pmc, s);
- }
- else if (pmc->vtable->base_type == enum_class_Complex) {
- STRING *s = VTABLE_get_string(interpreter, pmc);
- PIO_eprintf(interpreter, "Complex=PMC(%#p: (%Ss)",
- pmc, s);
- }
- else if (pmc->vtable->base_type == enum_class_PerlUndef
- || pmc->vtable->base_type == enum_class_PerlInt
- || pmc->vtable->base_type == enum_class_PerlNum) {
- PIO_eprintf(interpreter, "%S=PMC(%#p Num:%Pg Int:%Pd)",
- VTABLE_name(interpreter, pmc), pmc, pmc, pmc);
- }
- else if (pmc->vtable->base_type == enum_class_RetContinuation
- || pmc->vtable->base_type == enum_class_Continuation
- || pmc->vtable->base_type == enum_class_Sub) {
- PIO_eprintf(interpreter, "%S=PMC(%#p Adr:%#p)",
- VTABLE_name(interpreter, pmc), pmc,
- VTABLE_get_pointer(interpreter, pmc));
- }
- else if (PObj_is_object_TEST(pmc)) {
- PIO_eprintf(interpreter, "Object(%Ss)=PMC(%#p)",
- VTABLE_name(interpreter, pmc), pmc);
- }
- else if (pmc->vtable->base_type == enum_class_delegate) {
- PIO_eprintf(interpreter, "delegate=PMC(%#p)", pmc);
- }
- else {
- PIO_eprintf(interpreter, "%S=PMC(%#p)",
- VTABLE_name(interpreter, pmc), pmc);
- }
- }
+ if (!pmc) {
+ PIO_eprintf(interpreter, "(null)");
+ return;
+ }
+ if (pmc == PMCNULL) {
+ PIO_eprintf(interpreter, "PMCNULL");
+ return;
+ }
+ if (!pmc->vtable) {
+ PIO_eprintf(interpreter, "<!!no vtable!!>");
+ return;
+ }
+ if (pmc->vtable->data == pmc) {
+ STRING *name = trace_class_name(interpreter, pmc);
+ PIO_eprintf(interpreter, "%S=%Ss:PMC(%#p)",
+ VTABLE_name(interpreter, pmc), name, pmc);
+ }
+ else if (pmc->vtable->base_type == enum_class_PerlString) {
+ STRING *s = VTABLE_get_string(interpreter, pmc);
+ if (!s)
+ PIO_eprintf(interpreter, "%S=PMC(%#p Str:(NULL))",
+ VTABLE_name(interpreter, pmc), pmc);
else {
- PIO_eprintf(interpreter, "PMC(NULL)");
+ escaped = PDB_escape(s->strstart, s->strlen);
+ PIO_eprintf(interpreter, "%S=PMC(%#p Str:\"%s\")",
+ VTABLE_name(interpreter, pmc), pmc,
+ escaped ? escaped : "(null)");
+ if (escaped)
+ mem_sys_free(escaped);
}
}
+ else if (pmc->vtable->base_type == enum_class_Boolean) {
+ PIO_eprintf(interpreter, "Boolean=PMC(%#p: %d",
+ pmc, PMC_int_val(pmc));
+ }
+ else if (pmc->vtable->base_type == enum_class_BigInt) {
+ STRING *s = VTABLE_get_string(interpreter, pmc);
+ PIO_eprintf(interpreter, "BigInt=PMC(%#p: %Ss",
+ pmc, s);
+ }
+ else if (pmc->vtable->base_type == enum_class_Complex) {
+ STRING *s = VTABLE_get_string(interpreter, pmc);
+ PIO_eprintf(interpreter, "Complex=PMC(%#p: (%Ss)",
+ pmc, s);
+ }
+ else if (pmc->vtable->base_type == enum_class_PerlUndef
+ || pmc->vtable->base_type == enum_class_PerlInt
+ || pmc->vtable->base_type == enum_class_PerlNum) {
+ PIO_eprintf(interpreter, "%S=PMC(%#p Num:%Pg Int:%Pd)",
+ VTABLE_name(interpreter, pmc), pmc, pmc, pmc);
+ }
+ else if (pmc->vtable->base_type == enum_class_RetContinuation
+ || pmc->vtable->base_type == enum_class_Continuation
+ || pmc->vtable->base_type == enum_class_Sub) {
+ PIO_eprintf(interpreter, "%S=PMC(%#p Adr:%#p)",
+ VTABLE_name(interpreter, pmc), pmc,
+ VTABLE_get_pointer(interpreter, pmc));
+ }
+ else if (PObj_is_object_TEST(pmc)) {
+ PIO_eprintf(interpreter, "Object(%Ss)=PMC(%#p)",
+ VTABLE_name(interpreter, pmc), pmc);
+ }
+ else if (pmc->vtable->base_type == enum_class_delegate) {
+ PIO_eprintf(interpreter, "delegate=PMC(%#p)", pmc);
+ }
else {
- PIO_eprintf(interpreter, "NULL");
+ PIO_eprintf(interpreter, "%S=PMC(%#p)",
+ VTABLE_name(interpreter, pmc), pmc);
}
}
1.12 +86 -3 parrot/t/pmc/freeze.t
Index: freeze.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/freeze.t,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- freeze.t 1 Oct 2004 21:16:52 -0000 1.11
+++ freeze.t 8 Nov 2004 10:37:50 -0000 1.12
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: freeze.t,v 1.11 2004/10/01 21:16:52 jrieks Exp $
+# $Id: freeze.t,v 1.12 2004/11/08 10:37:50 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 13;
+use Parrot::Test tests => 15;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a PerlInt");
@@ -55,7 +55,7 @@
new P1, .PerlNum
set P1, 3.14159
freeze S0, P1
-
+
thaw P10, S0
typeof S10, P10
print S10
@@ -355,3 +355,86 @@
in sub _foo
back
OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a FixedPMCArray");
+ new P0, .FixedPMCArray
+ set P0, 3
+ new P1, .PerlInt
+ set P1, 666
+ set P0[0], P1
+ new P2, .PerlInt
+ set P2, 777
+ set P0[1], P2
+ new P1, .PerlInt
+ set P1, 666
+ set P0[2], P1
+ freeze S0, P0
+
+ thaw P10, S0
+ typeof S10, P10 # type
+ print S10
+ print " "
+ set I11, P10 # elements
+ print I11
+ print "\n"
+ set P12, P10[0]
+ print P12
+ print "\n"
+ set P13, P10[1]
+ print P13
+ print "\n"
+ set P14, P10[2]
+ print P14
+ print "\n"
+ ne_addr P12, P14, ok
+ print "not "
+ok: print "ok diff\n"
+ end
+CODE
+FixedPMCArray 3
+666
+777
+666
+ok diff
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a FixedPMCArray");
+ new P0, .FixedPMCArray
+ set P0, 3
+ new P1, .PerlInt
+ set P1, 666
+ set P0[0], P1
+ new P2, .PerlInt
+ set P2, 777
+ set P0[1], P2
+ set P0[2], P1
+ freeze S0, P0
+
+ thaw P10, S0
+ typeof S10, P10 # type
+ print S10
+ print " "
+ set I11, P10 # elements
+ print I11
+ print "\n"
+ set P12, P10[0]
+ print P12
+ print "\n"
+ set P13, P10[1]
+ print P13
+ print "\n"
+ set P14, P10[2]
+ print P14
+ print "\n"
+ eq_addr P12, P14, ok
+ print "not "
+ok: print "ok same\n"
+ end
+CODE
+FixedPMCArray 3
+666
+777
+666
+ok same
+OUTPUT
+
