cvsuser 05/03/26 04:07:30
Modified: classes closure.pmc coroutine.pmc eval.pmc sub.pmc
dynclasses pyfunc.pmc pystaticmeth.pmc
imcc pbc.c
include/parrot sub.h
src global.c packdump.c packfile.c
t/pmc namespace.t
Log:
prepare for PMC constants freeze/thaw
* freeze/thaw of Subs
* new get_name_space method for Subs
* various fixes
Revision Changes Path
1.23 +2 -2 parrot/classes/closure.pmc
Index: closure.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/closure.pmc,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- closure.pmc 31 Jan 2005 12:27:14 -0000 1.22
+++ closure.pmc 26 Mar 2005 12:07:24 -0000 1.23
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: closure.pmc,v 1.22 2005/01/31 12:27:14 leo Exp $
+$Id: closure.pmc,v 1.23 2005/03/26 12:07:24 leo Exp $
=head1 NAME
@@ -22,7 +22,7 @@
#include "parrot/parrot.h"
#include "parrot/method_util.h"
-pmclass Closure extends Sub {
+pmclass Closure extends Sub need_ext {
/*
1.50 +2 -2 parrot/classes/coroutine.pmc
Index: coroutine.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/coroutine.pmc,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- coroutine.pmc 31 Jan 2005 12:27:14 -0000 1.49
+++ coroutine.pmc 26 Mar 2005 12:07:24 -0000 1.50
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: coroutine.pmc,v 1.49 2005/01/31 12:27:14 leo Exp $
+$Id: coroutine.pmc,v 1.50 2005/03/26 12:07:24 leo Exp $
=head1 NAME
@@ -62,7 +62,7 @@
longjmp(exceptions->dest, 1); \
} while(0)
-pmclass Coroutine extends Sub {
+pmclass Coroutine extends Sub need_ext {
/*
1.39 +2 -2 parrot/classes/eval.pmc
Index: eval.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/eval.pmc,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- eval.pmc 25 Mar 2005 10:19:53 -0000 1.38
+++ eval.pmc 26 Mar 2005 12:07:24 -0000 1.39
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: eval.pmc,v 1.38 2005/03/25 10:19:53 leo Exp $
+$Id: eval.pmc,v 1.39 2005/03/26 12:07:24 leo Exp $
=head1 NAME
@@ -51,7 +51,7 @@
}
}
-pmclass Eval extends Closure {
+pmclass Eval extends Closure need_ext {
void init() {
parrot_sub_t sub_data;
1.73 +59 -5 parrot/classes/sub.pmc
Index: sub.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sub.pmc,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -r1.72 -r1.73
--- sub.pmc 31 Jan 2005 12:27:14 -0000 1.72
+++ sub.pmc 26 Mar 2005 12:07:24 -0000 1.73
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: sub.pmc,v 1.72 2005/01/31 12:27:14 leo Exp $
+$Id: sub.pmc,v 1.73 2005/03/26 12:07:24 leo Exp $
=head1 NAME
@@ -83,7 +83,11 @@
print_pbc_location(interpreter);
}
-pmclass Sub {
+/*
+ * A sub now contains more data like name_space, which makes it
+ * effectively a container. Therefore need_ext has to be set
+ */
+pmclass Sub need_ext {
/*
@@ -369,6 +373,10 @@
struct Parrot_sub * sub = PMC_sub(SELF);
if (sub->name)
pobject_lives(INTERP, (PObj *) sub->name);
+ if (!PMC_IS_NULL(sub->name_space))
+ pobject_lives(INTERP, (PObj *) sub->name_space);
+ if (!PMC_IS_NULL(sub->multi_signature))
+ pobject_lives(INTERP, (PObj *) sub->multi_signature);
}
/*
@@ -401,6 +409,10 @@
/*
+=item C<void visit(visit_info *info)>
+
+This is used by freeze/thaw to visit the contents of the sub.
+
=item C<void freeze(visit_info *info)>
Archives the subroutine.
@@ -409,6 +421,16 @@
*/
+ void visit(visit_info *info) {
+ struct Parrot_sub * sub = PMC_sub(SELF);
+
+ info->thaw_ptr = &sub->name_space;
+ (info->visit_pmc_now)(INTERP, sub->name_space, info);
+ info->thaw_ptr = &sub->multi_signature;
+ (info->visit_pmc_now)(INTERP, sub->multi_signature, info);
+ SUPER(info);
+ }
+
void freeze(visit_info *info) {
IMAGE_IO *io = info->image_io;
struct Parrot_sub * sub = PMC_sub(SELF);
@@ -417,12 +439,13 @@
SUPER(info);
/*
* we currently need to write these items:
- * - name of the sub's label
* - start offset in byte-code segment
* - end offset in byte-code segment
- * - segment TODO
+ * - segment TODO ???
* - flags (i.e. @LOAD pragma and such)
- * - namespace constant #
+ * - name of the sub's label
+ * - name_space
+ * - multi_signature
*/
/*
@@ -440,6 +463,9 @@
}
io->vtable->push_integer(INTERP, io, (INTVAL) start_offs);
io->vtable->push_integer(INTERP, io, (INTVAL) end_offs);
+ io->vtable->push_integer(INTERP, io,
+ PObj_get_FLAGS(pmc) & SUB_FLAG_PF_MASK);
+ io->vtable->push_string(INTERP, io, sub->name);
}
/*
@@ -459,6 +485,7 @@
if (info->extra_flags == EXTRA_IS_NULL) {
struct Parrot_sub * sub = PMC_sub(SELF);
size_t start_offs, end_offs;
+ INTVAL flags;
/*
* we get relative offsets
*/
@@ -467,6 +494,9 @@
end_offs = (size_t) io->vtable->shift_integer(INTERP, io);
sub->address = (opcode_t*) start_offs;
sub->end = (opcode_t*) end_offs;
+ flags = io->vtable->shift_integer(INTERP, io);
+ PObj_get_FLAGS(SELF) |= flags & SUB_FLAG_PF_MASK;
+ sub->name = io->vtable->shift_string(INTERP, io);
}
}
@@ -499,6 +529,30 @@
PObj_get_FLAGS(SELF) |= SUB_FLAG_FIXUP_DONE;
}
+/*
+
+=back
+
+=head2 METHODS
+
+=over 4
+
+=item C<METHOD PMC* get_name_space()>
+
+Return the name_space PMC or Undef. The name_space PMC is either a
+String PMC or a Key PMC for a nested name_space.
+
+=cut
+
+*/
+
+ METHOD PMC* get_name_space() {
+ struct Parrot_sub * sub = PMC_sub(SELF);
+
+ return PMC_IS_NULL(sub->name_space) ?
+ pmc_new(INTERP, enum_class_Undef) : sub->name_space;
+ }
+
}
/*
1.16 +3 -3 parrot/dynclasses/pyfunc.pmc
Index: pyfunc.pmc
===================================================================
RCS file: /cvs/public/parrot/dynclasses/pyfunc.pmc,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- pyfunc.pmc 12 Jan 2005 14:40:18 -0000 1.15
+++ pyfunc.pmc 26 Mar 2005 12:07:26 -0000 1.16
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pyfunc.pmc,v 1.15 2005/01/12 14:40:18 rubys Exp $
+$Id: pyfunc.pmc,v 1.16 2005/03/26 12:07:26 leo Exp $
=head1 NAME
@@ -21,7 +21,7 @@
#include "parrot/parrot.h"
#include "pyconsts.h"
-pmclass PyFunc extends Closure dynpmc group python_group {
+pmclass PyFunc extends Closure dynpmc group python_group dynext {
/*
@@ -146,7 +146,7 @@
INTVAL nd = VTABLE_elements(INTERP, func_defaults);
for (j=n-nd; j<n && j<11; j++) {
if (j >= REG_INT(3)) {
- REG_PMC(5+j) = VTABLE_get_pmc_keyed_int(INTERP,
+ REG_PMC(5+j) = VTABLE_get_pmc_keyed_int(INTERP,
func_defaults, j+nd-n);
}
}
1.2 +2 -2 parrot/dynclasses/pystaticmeth.pmc
Index: pystaticmeth.pmc
===================================================================
RCS file: /cvs/public/parrot/dynclasses/pystaticmeth.pmc,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- pystaticmeth.pmc 27 Dec 2004 16:21:18 -0000 1.1
+++ pystaticmeth.pmc 26 Mar 2005 12:07:26 -0000 1.2
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pystaticmeth.pmc,v 1.1 2004/12/27 16:21:18 rubys Exp $
+$Id: pystaticmeth.pmc,v 1.2 2005/03/26 12:07:26 leo Exp $
=head1 NAME
@@ -21,7 +21,7 @@
#include "parrot/parrot.h"
#include "pyconsts.h"
-pmclass PyStaticMeth extends PyFunc dynpmc group python_group {
+pmclass PyStaticMeth extends PyFunc dynpmc group python_group need_ext {
/*
1.113 +25 -13 parrot/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pbc.c,v
retrieving revision 1.112
retrieving revision 1.113
diff -u -r1.112 -r1.113
--- pbc.c 25 Mar 2005 13:18:11 -0000 1.112
+++ pbc.c 26 Mar 2005 12:07:26 -0000 1.113
@@ -593,7 +593,7 @@
static int
add_const_pmc_sub(Interp *interpreter, SymReg *r,
- int offs, int len)
+ int offs, int end)
{
int k;
char buf[256];
@@ -604,7 +604,9 @@
char *real_name;
char *class;
struct PackFile_ConstTable *ct;
+ struct PackFile *pf;
+ pf = interpreter->code;
if (globals.cs->subs->unit->namespace) {
ns = globals.cs->subs->unit->namespace->reg;
if (ns->set == 'K')
@@ -632,15 +634,18 @@
{
INTVAL type;
PMC *name_space;
- PMC *sub;
+ PMC *sub_pmc;
+ struct Parrot_sub *sub;
type = (r->pcc_sub->calls_a_sub & ITPCCYIELD) ?
- enum_class_Sub : enum_class_Coroutine;
+ enum_class_Coroutine : enum_class_Sub;
/* TODO constant - see also src/packfile.c
*/
- sub = pmc_new(interpreter, type);
- PObj_get_FLAGS(sub) |= (r->pcc_sub->pragma & SUB_FLAG_PF_MASK);
- PMC_sub(sub)->name = const_string(interpreter, real_name);
+ sub_pmc = pmc_new(interpreter, type);
+ PObj_get_FLAGS(sub_pmc) |= (r->pcc_sub->pragma & SUB_FLAG_PF_MASK);
+ sub = PMC_sub(sub_pmc);
+ sub->name = string_from_cstring(interpreter, real_name, 0);
+
name_space = NULL;
if (ns_const >= 0 && ns_const < ct->const_count) {
switch (ct->constants[ns_const]->type) {
@@ -651,16 +656,23 @@
name_space = constant_pmc_new(interpreter,
enum_class_String);
PMC_str_val(name_space) =
- ct->constants[ns_const]->u.string;
+ ct->constants[ns_const]->u.string;
break;
}
}
- PMC_sub(sub)->name_space = name_space;
- PMC_sub(sub)->address = (void*)offs;
- PMC_sub(sub)->end = (void*)len;
-
+ sub->name_space = name_space;
+ sub->address = (opcode_t*)(long)offs;
+ sub->end = (opcode_t*)(long)end;
+
+ if (!(r->pcc_sub->pragma & SUB_FLAG_PF_ANON)) {
+ Parrot_store_sub_in_namespace(interpreter, pf,
+ sub_pmc, sub->name, name_space);
+ }
pfc->type = PFC_PMC;
- pfc->u.key = sub;
+ pfc->u.key = sub_pmc;
+ IMCC_debug(interpreter, DEBUG_PBC_CONST,
+ "add_const_pmc_sub '%s' -> '%s' flags %d color %d\n",
+ r->name, real_name, r->pcc_sub->pragma, k);
}
#else
/*
@@ -671,7 +683,7 @@
class = "Sub";
if (r->pcc_sub->calls_a_sub & ITPCCYIELD)
class = "Coroutine";
- sprintf(buf, "%s %s %d %d %d %d", class, real_name, offs, len,
+ sprintf(buf, "%s %s %d %d %d %d", class, real_name, offs, end,
r->pcc_sub->pragma, ns_const);
rc = PackFile_Constant_unpack_pmc(interpreter, ct, pfc, (opcode_t*)buf);
if (!rc)
1.45 +2 -2 parrot/include/parrot/sub.h
Index: sub.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/sub.h,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- sub.h 25 Mar 2005 13:18:12 -0000 1.44
+++ sub.h 26 Mar 2005 12:07:28 -0000 1.45
@@ -1,7 +1,7 @@
/* sub.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: sub.h,v 1.44 2005/03/25 13:18:12 leo Exp $
+ * $Id: sub.h,v 1.45 2005/03/26 12:07:28 leo Exp $
* Overview:
* Data Structure and Algorithms:
* Subroutine, coroutine, closure and continuation structures
@@ -35,7 +35,7 @@
SUB_FLAG_PF_IMMEDIATE = PObj_private6_FLAG,
SUB_FLAG_PF_POSTCOMP = PObj_private7_FLAG,
- SUB_FLAG_PF_MASK = 0xf0 /* main ... postcomp */
+ SUB_FLAG_PF_MASK = 0xf8 /* anon ... postcomp */
} sub_flags_enum;
1.14 +9 -8 parrot/src/global.c
Index: global.c
===================================================================
RCS file: /cvs/public/parrot/src/global.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- global.c 25 Mar 2005 13:18:13 -0000 1.13
+++ global.c 26 Mar 2005 12:07:29 -0000 1.14
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: global.c,v 1.13 2005/03/25 13:18:13 leo Exp $
+$Id: global.c,v 1.14 2005/03/26 12:07:29 leo Exp $
=head1 NAME
@@ -23,6 +23,7 @@
#include "parrot/parrot.h"
#include "global.str"
+#define DEBUG_GLOBAL 0
/*
=item C<PMC *
@@ -54,8 +55,8 @@
* hash lookup duplication
*/
HashBucket *b;
-#ifdef DEBUG_FIND
- PIO_printf(interpreter, "find_global class '%Ss' meth '%Ss\n",
+#if DEBUG_GLOBAL
+ PIO_printf(interpreter, "find_global class '%Ss' meth '%Ss'\n",
class, globalname);
#endif
stash = interpreter->globals->stash_hash;
@@ -248,17 +249,17 @@
PMC *globals = interpreter->globals->stash_hash;
INTVAL type, class_type;
-#if TRACE_PACKFILE_PMC
+#if DEBUG_GLOBAL
fprintf(stderr, "PMC_CONST: store_global: name '%s' ns %s\n",
(char*)sub_name->strstart,
- name_space ? (char*)name_space->strstart : "(none)");
+ name_space ? (char*)PMC_str_val(name_space)->strstart :
"(none)");
#endif
/*
* namespace is either s String or a Key PMC or NULL
*/
- if (!name_space) {
+ if (PMC_IS_NULL(name_space)) {
global_ns:
- VTABLE_set_pmc_keyed_str(interpreter, globals, sub_name, sub_pmc);
+ Parrot_store_global(interpreter, NULL, sub_name, sub_pmc);
}
else {
STRING *names;
@@ -292,7 +293,7 @@
case enum_class_Key:
part = name_space;
/*
- * TODO handle nested keys too with add_method
+ * a nested key can't be handled by add_method
*/
for (; part; part = PMC_data(part)) {
STRING *s = key_string(interpreter, part);
1.25 +20 -13 parrot/src/packdump.c
Index: packdump.c
===================================================================
RCS file: /cvs/public/parrot/src/packdump.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- packdump.c 7 Mar 2005 16:44:24 -0000 1.24
+++ packdump.c 26 Mar 2005 12:07:29 -0000 1.25
@@ -2,7 +2,7 @@
Copyright (C) 2001-2002 Gregor N. Purdy. All rights reserved.
This program is free software. It is subject to the same license as
Parrot itself.
-$Id: packdump.c,v 1.24 2005/03/07 16:44:24 leo Exp $
+$Id: packdump.c,v 1.25 2005/03/26 12:07:29 leo Exp $
=head1 NAME
@@ -106,23 +106,30 @@
{
PMC *pmc = self->u.key;
parrot_sub_t sub;
- INTVAL code_start =
- PTR2INTVAL(interpreter->code->cur_cs->base.data);
+ STRING *a_key = const_string(interpreter, "(keyed)");
+ STRING *null = const_string(interpreter, "(null)");
+ opcode_t *code_start =
+ interpreter->code->cur_cs->base.data;
switch (pmc->vtable->base_type) {
case enum_class_Sub:
- case enum_class_Closure:
- case enum_class_Continuation:
case enum_class_Coroutine:
sub = PMC_sub(pmc);
PIO_printf(interpreter,
- "\tclass => %s, "
- "start_offs => %d, "
- "end_offs => %d, "
- "packed => '%s'\n",
- (char*)pmc->vtable->whoami->strstart,
- PTR2INTVAL(PMC_struct_val(pmc)) - code_start,
- PTR2INTVAL(sub->end) - code_start,
- sub->packed);
+ "\tclass => %Ss,\n"
+ "\tstart_offs => %d,\n"
+ "\tend_offs => %d,\n"
+ "\tname => '%Ss',\n"
+ "\tname_space => '%Ss'\n",
+ pmc->vtable->whoami,
+ sub->address - code_start,
+ sub->end - code_start,
+ sub->name,
+ sub->name_space ?
+ (sub->name_space->vtable->base_type ==
+ enum_class_String ?
+ PMC_str_val(sub->name_space) : a_key) :
+ null
+ );
break;
default:
PIO_printf(interpreter, "\tunknown PMC\n");
1.192 +19 -17 parrot/src/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/src/packfile.c,v
retrieving revision 1.191
retrieving revision 1.192
diff -u -r1.191 -r1.192
--- packfile.c 25 Mar 2005 13:18:13 -0000 1.191
+++ packfile.c 26 Mar 2005 12:07:29 -0000 1.192
@@ -2,7 +2,7 @@
Copyright (C) 2001-2002 Gregor N. Purdy. All rights reserved.
This program is free software. It is subject to the same license as
Parrot itself.
-$Id: packfile.c,v 1.191 2005/03/25 13:18:13 leo Exp $
+$Id: packfile.c,v 1.192 2005/03/26 12:07:29 leo Exp $
=head1 NAME
@@ -661,8 +661,10 @@
/*
* now unpack dir, which unpacks its contents ...
*/
+ Parrot_block_DOD(interpreter);
cursor = PackFile_Segment_unpack(interpreter,
&self->directory.base, cursor);
+ Parrot_unblock_DOD(interpreter);
/* shortcut */
self->byte_code = self->cur_cs->base.data;
/*
@@ -2983,6 +2985,7 @@
struct Parrot_sub *sub;
struct PackFile *pf_save;
int ns_const;
+ PMC *name_space = NULL;
#if TRACE_PACKFILE_PMC
fprintf(stderr, "PMC_CONST '%s'\n", (char*)cursor);
@@ -3037,7 +3040,7 @@
* then set private flags of that PMC
*/
if (flag) {
- PObj_get_FLAGS(sub_pmc) |= (flag & SUB_FLAG_PF_MASK);
+ PObj_get_FLAGS(sub_pmc) |= (flag & SUB_FLAG_PF_MASK);
}
/*
@@ -3048,22 +3051,21 @@
/*
* finally place the sub in the global stash
*/
- if (!(flag & SUB_FLAG_PF_ANON)) {
- PMC *name_space = NULL;
- STRING *ns;
- if (ns_const >= 0 && ns_const < constt->const_count) {
- switch (constt->constants[ns_const]->type) {
- case PFC_KEY:
- name_space = constt->constants[ns_const]->u.key;
- break;
- case PFC_STRING:
- name_space = constant_pmc_new(interpreter,
- enum_class_String);
- PMC_str_val(name_space) =
- constt->constants[ns_const]->u.string;
- break;
- }
+ if (ns_const >= 0 && ns_const < constt->const_count) {
+ switch (constt->constants[ns_const]->type) {
+ case PFC_KEY:
+ name_space = constt->constants[ns_const]->u.key;
+ break;
+ case PFC_STRING:
+ name_space = constant_pmc_new(interpreter,
+ enum_class_String);
+ PMC_str_val(name_space) =
+ constt->constants[ns_const]->u.string;
+ break;
}
+ }
+ sub->name_space = name_space;
+ if (!(flag & SUB_FLAG_PF_ANON)) {
Parrot_store_sub_in_namespace(interpreter, pf,
sub_pmc, sub->name, name_space);
}
1.4 +34 -2 parrot/t/pmc/namespace.t
Index: namespace.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/namespace.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- namespace.t 20 Mar 2005 10:16:51 -0000 1.3
+++ namespace.t 26 Mar 2005 12:07:30 -0000 1.4
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
-# $Id: namespace.t,v 1.3 2005/03/20 10:16:51 leo Exp $
+# $Id: namespace.t,v 1.4 2005/03/26 12:07:30 leo Exp $
=head1 NAME
@@ -16,9 +16,24 @@
=cut
-use Parrot::Test tests => 10;
+use Parrot::Test tests => 12;
use Test::More;
+pir_output_is(<<'CODE', <<'OUTPUT', "find_global bar");
+.sub main @MAIN
+ $P0 = find_global "bar"
+ print "ok\n"
+ $P0()
+.end
+
+.sub bar
+ print "bar\n"
+.end
+CODE
+ok
+bar
+OUTPUT
+
pir_output_is(<<'CODE', <<'OUTPUT', "find_global Foo::bar");
.sub main @MAIN
$P0 = find_global "Foo", "bar"
@@ -35,6 +50,23 @@
bar
OUTPUT
+pir_output_is(<<'CODE', <<'OUTPUT', "get_name_space Foo::bar");
+.sub main @MAIN
+ $P0 = find_global "Foo", "bar"
+ print "ok\n"
+ $P1 = $P0."get_name_space"()
+ print $P1
+ print "\n"
+.end
+
+.namespace ["Foo"]
+.sub bar
+.end
+CODE
+ok
+Foo
+OUTPUT
+
pir_output_is(<<'CODE', <<'OUTPUT', "find_global Foo::bar ns");
.sub main @MAIN
$P0 = find_global "\0Foo"
