cvsuser 04/01/16 05:52:29
Modified: classes sub.pmc
src packfile.c pmc_freeze.c
t/pmc freeze.t
Log:
freeze-thaw-9
* fix Sub freeze/thaw
* fix NULL PMC issues with thaw/thawfinish
* add thawfinish to fixup the Sub
* test: run a thawed Sub
Revision Changes Path
1.34 +33 -4 parrot/classes/sub.pmc
Index: sub.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sub.pmc,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -w -r1.33 -r1.34
--- sub.pmc 19 Dec 2003 10:01:36 -0000 1.33
+++ sub.pmc 16 Jan 2004 13:52:23 -0000 1.34
@@ -1,7 +1,7 @@
/* Sub.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: sub.pmc,v 1.33 2003/12/19 10:01:36 leo Exp $
+ * $Id: sub.pmc,v 1.34 2004/01/16 13:52:23 leo Exp $
* Overview:
* These are the vtable functions for the Sub (subroutine) base class
* Data Structure and Algorithms:
@@ -98,16 +98,19 @@
* - name of the sub's label: in properties
* - start offset in byte-code segment
* - end offset in byte-code segment
+ * - segment TODO
*/
/*
* if sub addresses are absolute, the flag is set
*/
if (PObj_get_FLAGS(SELF) & PObj_private1_FLAG) {
- ptrdiff_t code = (ptrdiff_t) sub->seg->base.pf->byte_code;
+ ptrdiff_t code = (ptrdiff_t) sub->seg->base.data;
- start_offs = (ptrdiff_t) SELF->cache.struct_val - code;
- end_offs = (ptrdiff_t)sub->end - code;
+ start_offs = ((ptrdiff_t) SELF->cache.struct_val - code) /
+ sizeof(opcode_t*);
+ end_offs = ((ptrdiff_t)sub->end - code) /
+ sizeof(opcode_t*);
}
else {
start_offs = (size_t)SELF->cache.struct_val;
@@ -122,6 +125,7 @@
SUPER(info);
if (info->extra_flags == EXTRA_IS_NULL) {
+ struct Parrot_Sub * sub = (struct Parrot_Sub *)PMC_sub(SELF);
size_t start_offs, end_offs;
/*
* we get relative offsets
@@ -129,6 +133,31 @@
PObj_get_FLAGS(SELF) &= ~PObj_private1_FLAG;
start_offs = (size_t) io->vtable->shift_integer(INTERP, io);
end_offs = (size_t) io->vtable->shift_integer(INTERP, io);
+ SELF->cache.struct_val = (opcode_t*) start_offs;
+ sub->end = (opcode_t*) end_offs;
}
}
+
+ void thawfinish(visit_info *info) {
+ /*
+ * for now do fixup here until packfile issues are sorted out
+ */
+ opcode_t *code;
+ struct Parrot_Sub * sub = (struct Parrot_Sub *)PMC_sub(SELF);
+ opcode_t *start_offs, *end_offs;
+
+ /* its absolute */
+ if (PObj_get_FLAGS(SELF) & PObj_private1_FLAG)
+ return;
+ /*
+ * XXX actually the sub might be in a different code segment
+ */
+ code = INTERP->code->cur_cs->base.data;
+ start_offs = code + (size_t) SELF->cache.struct_val;
+ end_offs = code + (size_t) sub->end;
+ SELF->cache.struct_val = start_offs;
+ sub->end = end_offs;
+ PObj_get_FLAGS(SELF) |= PObj_private1_FLAG;
+ }
+
}
1.130 +2 -1 parrot/src/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/src/packfile.c,v
retrieving revision 1.129
retrieving revision 1.130
diff -u -w -r1.129 -r1.130
--- packfile.c 10 Jan 2004 11:40:20 -0000 1.129
+++ packfile.c 16 Jan 2004 13:52:25 -0000 1.130
@@ -7,7 +7,7 @@
** This program is free software. It is subject to the same
** license as Parrot itself.
**
-** $Id: packfile.c,v 1.129 2004/01/10 11:40:20 mikescott Exp $
+** $Id: packfile.c,v 1.130 2004/01/16 13:52:25 leo Exp $
**
** History:
** Rework by Melvin; new bytecode format, make bytecode portable.
@@ -212,6 +212,7 @@
rel = (INTVAL) sub->end * sizeof(opcode_t);
rel += (INTVAL) self->cur_cs->base.data;
sub->end = (opcode_t *) rel;
+ PObj_get_FLAGS(sub_pmc) |= PObj_private1_FLAG;
break;
}
/* goon */
1.14 +16 -4 parrot/src/pmc_freeze.c
Index: pmc_freeze.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc_freeze.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- pmc_freeze.c 1 Dec 2003 09:30:18 -0000 1.13
+++ pmc_freeze.c 16 Jan 2004 13:52:25 -0000 1.14
@@ -1,7 +1,7 @@
/* pmc_freeze.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: pmc_freeze.c,v 1.13 2003/12/01 09:30:18 leo Exp $
+ * $Id: pmc_freeze.c,v 1.14 2004/01/16 13:52:25 leo Exp $
* Overview:
* Freeze and thaw functionality
* Data Structure and Algorithms:
@@ -834,12 +834,13 @@
}
}
-static void
+static PMC*
visit_loop_todo_list(Parrot_Interp interpreter, PMC *current,
visit_info *info)
{
List *todo = PMC_data(info->todo);
int i, n;
+ PMC *ret = current;
(info->visit_pmc_now)(interpreter, current, info);
/*
@@ -863,12 +864,23 @@
/*
* on thawing call thawfinish for each processed PMC
*/
+ if (!current->vtable) {
+ /* the first created (passed) PMC was NULL -
+ * return a NULL PMC
+ */
+ ret = PMCNULL;
+ }
+ else
+ if (!PMC_IS_NULL(current))
+ VTABLE_thawfinish(interpreter, current, info);
n = (int)list_length(interpreter, todo);
for (i = 0; i < n ; ++i) {
current = *(PMC**)list_get(interpreter, todo, i, enum_type_PMC);
+ if (!PMC_IS_NULL(current))
VTABLE_thawfinish(interpreter, current, info);
}
}
+ return ret;
}
/*
@@ -941,7 +953,7 @@
/*
* run thaw loop
*/
- visit_loop_todo_list(interpreter, n, &info);
+ n = visit_loop_todo_list(interpreter, n, &info);
/*
* thaw does "consume" the image string by incrementing strstart
* and decrementing bufused - restore that
1.6 +21 -1 parrot/t/pmc/freeze.t
Index: freeze.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/freeze.t,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- freeze.t 27 Nov 2003 10:43:37 -0000 1.5
+++ freeze.t 16 Jan 2004 13:52:28 -0000 1.6
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 10;
+use Parrot::Test tests => 11;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a PerlInt");
@@ -286,4 +286,24 @@
PerlArray 2
ok
10
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "freeze/thaw a Sub");
+ find_global P1, "_foo"
+ freeze S0, P1
+
+ thaw P0, S0
+ typeof S10, P0
+ print S10
+ print "\n"
+ invokecc
+ print "back\n"
+ end
+.pcc_sub _foo:
+ print "in sub _foo\n"
+ invoke P1
+CODE
+Sub
+in sub _foo
+back
OUTPUT
