[svn:parrot] r41024 - in branches/kill_parrot_cont: . compilers/imcc compilers/pct/src/PAST compilers/pct/src/POST config/auto/sizes config/gen/crypto config/gen/makefiles docs docs/book/draft docs/book/pct docs/dev docs/pdds docs/project examples/embed examples/languages/abc examples/languages/squaak examples/pge include/parrot lib/Parrot lib/Parrot/OpTrans lib/Parrot/Ops2c lib/Parrot/Pmc2c ports/cpan ports/cygwin ports/debian ports/fedora ports/mandriva ports/suse runtime/parrot/languages runtime/parrot/library/Math src src/call src/dynpmc src/gc src/interp src/jit/amd64 src/jit/i386 src/jit/ppc src/jit/sun4 src/ops src/pmc src/runcore src/string/charset t/compilers/pge t/compilers/pge/perl6regex t/compilers/tge t/native_pbc t/oo t/op t/pmc t/src tools/dev tools/util
whiteknight at svn.parrot.org
whiteknight at svn.parrot.org
Sun Sep 6 00:20:18 UTC 2009
Author: whiteknight
Date: Sun Sep 6 00:20:10 2009
New Revision: 41024
URL: https://trac.parrot.org/parrot/changeset/41024
Log:
[kill_parrot_cont] merge -r40900:41020. Dumps core while builing PGE
Added:
branches/kill_parrot_cont/include/parrot/context.h
- copied unchanged from r41020, trunk/include/parrot/context.h
branches/kill_parrot_cont/src/call/context.c
- copied unchanged from r41020, trunk/src/call/context.c
branches/kill_parrot_cont/src/pmc/context.pmc
- copied unchanged from r41020, trunk/src/pmc/context.pmc
branches/kill_parrot_cont/t/pmc/context.t
- copied unchanged from r41020, trunk/t/pmc/context.t
branches/kill_parrot_cont/t/pmc/namespace-old.t
- copied unchanged from r41020, trunk/t/pmc/namespace-old.t
Replaced:
branches/kill_parrot_cont/t/pmc/namespace.t
- copied unchanged from r41020, trunk/t/pmc/namespace.t
Modified:
branches/kill_parrot_cont/ (props changed)
branches/kill_parrot_cont/CREDITS
branches/kill_parrot_cont/MANIFEST
branches/kill_parrot_cont/compilers/imcc/imcc.y
branches/kill_parrot_cont/compilers/imcc/imcparser.c
branches/kill_parrot_cont/compilers/imcc/parser_util.c
branches/kill_parrot_cont/compilers/imcc/pbc.c
branches/kill_parrot_cont/compilers/pct/src/PAST/Compiler.pir
branches/kill_parrot_cont/compilers/pct/src/POST/Compiler.pir
branches/kill_parrot_cont/config/auto/sizes/intval_maxmin_c.in (props changed)
branches/kill_parrot_cont/config/gen/crypto/digest_pmc.in
branches/kill_parrot_cont/config/gen/makefiles/root.in
branches/kill_parrot_cont/docs/book/draft/README (props changed)
branches/kill_parrot_cont/docs/book/draft/appa_glossary.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/appb_patch_submission.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/appc_command_line_options.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/appd_build_options.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/appe_source_code.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/ch01_introduction.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/ch02_getting_started.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/ch07_dynpmcs.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/ch08_dynops.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/ch10_opcode_reference.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/ch11_directive_reference.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/ch12_operator_reference.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/chXX_hlls.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/chXX_library.pod (props changed)
branches/kill_parrot_cont/docs/book/draft/chXX_testing_and_debugging.pod (props changed)
branches/kill_parrot_cont/docs/book/pct/ch01_introduction.pod (props changed)
branches/kill_parrot_cont/docs/book/pct/ch02_getting_started.pod (props changed)
branches/kill_parrot_cont/docs/book/pct/ch03_compiler_tools.pod (props changed)
branches/kill_parrot_cont/docs/book/pct/ch04_pge.pod (props changed)
branches/kill_parrot_cont/docs/book/pct/ch05_nqp.pod (props changed)
branches/kill_parrot_cont/docs/dev/c_functions.pod (props changed)
branches/kill_parrot_cont/docs/embed.pod
branches/kill_parrot_cont/docs/memory_internals.pod
branches/kill_parrot_cont/docs/pdds/pdd09_gc.pod
branches/kill_parrot_cont/docs/pdds/pdd28_strings.pod
branches/kill_parrot_cont/docs/pdds/pdd30_install.pod (props changed)
branches/kill_parrot_cont/docs/pmc.pod
branches/kill_parrot_cont/docs/project/support_policy.pod
branches/kill_parrot_cont/docs/vtables.pod
branches/kill_parrot_cont/examples/embed/cotorra.c (props changed)
branches/kill_parrot_cont/examples/languages/abc/ (props changed)
branches/kill_parrot_cont/examples/languages/squaak/ (props changed)
branches/kill_parrot_cont/examples/pge/demo.pir (props changed)
branches/kill_parrot_cont/include/parrot/call.h (contents, props changed)
branches/kill_parrot_cont/include/parrot/gc_api.h (contents, props changed)
branches/kill_parrot_cont/include/parrot/interpreter.h
branches/kill_parrot_cont/include/parrot/pobj.h
branches/kill_parrot_cont/include/parrot/register.h
branches/kill_parrot_cont/include/parrot/runcore_api.h (props changed)
branches/kill_parrot_cont/include/parrot/runcore_trace.h (props changed)
branches/kill_parrot_cont/include/parrot/sub.h
branches/kill_parrot_cont/include/parrot/warnings.h
branches/kill_parrot_cont/lib/Parrot/Op.pm
branches/kill_parrot_cont/lib/Parrot/OpTrans/C.pm
branches/kill_parrot_cont/lib/Parrot/OpTrans/CGP.pm
branches/kill_parrot_cont/lib/Parrot/OpTrans/CGoto.pm
branches/kill_parrot_cont/lib/Parrot/OpTrans/CPrederef.pm
branches/kill_parrot_cont/lib/Parrot/OpTrans/CSwitch.pm
branches/kill_parrot_cont/lib/Parrot/Ops2c/Utils.pm
branches/kill_parrot_cont/lib/Parrot/Pmc2c/PCCMETHOD.pm
branches/kill_parrot_cont/ports/cpan/pause_guide.pod (props changed)
branches/kill_parrot_cont/ports/cygwin/parrot-1.0.0-1.cygport (props changed)
branches/kill_parrot_cont/ports/debian/libparrot-dev.install.in (props changed)
branches/kill_parrot_cont/ports/debian/libparrot.install.in (props changed)
branches/kill_parrot_cont/ports/debian/parrot-doc.install.in (props changed)
branches/kill_parrot_cont/ports/debian/parrot.install.in (props changed)
branches/kill_parrot_cont/ports/fedora/parrot.spec.fedora (props changed)
branches/kill_parrot_cont/ports/mandriva/parrot.spec.mandriva (props changed)
branches/kill_parrot_cont/ports/suse/parrot.spec.suse (props changed)
branches/kill_parrot_cont/runtime/parrot/languages/ (props changed)
branches/kill_parrot_cont/runtime/parrot/library/Math/Rand.pir (props changed)
branches/kill_parrot_cont/src/call/ops.c (contents, props changed)
branches/kill_parrot_cont/src/call/pcc.c (contents, props changed)
branches/kill_parrot_cont/src/debug.c
branches/kill_parrot_cont/src/dynpmc/gdbmhash.pmc
branches/kill_parrot_cont/src/dynpmc/rational.pmc
branches/kill_parrot_cont/src/embed.c
branches/kill_parrot_cont/src/exceptions.c
branches/kill_parrot_cont/src/extend.c
branches/kill_parrot_cont/src/gc/alloc_memory.c (props changed)
branches/kill_parrot_cont/src/gc/alloc_register.c (contents, props changed)
branches/kill_parrot_cont/src/gc/alloc_resources.c (props changed)
branches/kill_parrot_cont/src/gc/api.c (contents, props changed)
branches/kill_parrot_cont/src/gc/generational_ms.c (contents, props changed)
branches/kill_parrot_cont/src/gc/incremental_ms.c (props changed)
branches/kill_parrot_cont/src/gc/malloc.c (props changed)
branches/kill_parrot_cont/src/gc/malloc_trace.c (props changed)
branches/kill_parrot_cont/src/gc/mark_sweep.c (contents, props changed)
branches/kill_parrot_cont/src/gc/system.c (props changed)
branches/kill_parrot_cont/src/global.c
branches/kill_parrot_cont/src/global_setup.c
branches/kill_parrot_cont/src/hash.c
branches/kill_parrot_cont/src/hll.c
branches/kill_parrot_cont/src/interp/inter_cb.c (contents, props changed)
branches/kill_parrot_cont/src/interp/inter_create.c (contents, props changed)
branches/kill_parrot_cont/src/interp/inter_misc.c (contents, props changed)
branches/kill_parrot_cont/src/jit.c
branches/kill_parrot_cont/src/jit/amd64/jit_defs.c
branches/kill_parrot_cont/src/jit/i386/core.jit
branches/kill_parrot_cont/src/jit/i386/jit_defs.c
branches/kill_parrot_cont/src/jit/ppc/core.jit
branches/kill_parrot_cont/src/jit/ppc/jit_emit.h
branches/kill_parrot_cont/src/jit/sun4/jit_emit.h
branches/kill_parrot_cont/src/misc.c
branches/kill_parrot_cont/src/multidispatch.c
branches/kill_parrot_cont/src/oo.c
branches/kill_parrot_cont/src/ops/core.ops
branches/kill_parrot_cont/src/ops/debug.ops
branches/kill_parrot_cont/src/ops/object.ops
branches/kill_parrot_cont/src/ops/ops.num
branches/kill_parrot_cont/src/ops/pic.ops
branches/kill_parrot_cont/src/ops/set.ops
branches/kill_parrot_cont/src/ops/var.ops
branches/kill_parrot_cont/src/packdump.c
branches/kill_parrot_cont/src/packfile.c
branches/kill_parrot_cont/src/pic.c
branches/kill_parrot_cont/src/pmc.c
branches/kill_parrot_cont/src/pmc/bigint.pmc
branches/kill_parrot_cont/src/pmc/bignum.pmc
branches/kill_parrot_cont/src/pmc/class.pmc
branches/kill_parrot_cont/src/pmc/continuation.pmc
branches/kill_parrot_cont/src/pmc/coroutine.pmc
branches/kill_parrot_cont/src/pmc/eventhandler.pmc
branches/kill_parrot_cont/src/pmc/exception.pmc
branches/kill_parrot_cont/src/pmc/exporter.pmc
branches/kill_parrot_cont/src/pmc/filehandle.pmc
branches/kill_parrot_cont/src/pmc/fixedbooleanarray.pmc
branches/kill_parrot_cont/src/pmc/fixedfloatarray.pmc
branches/kill_parrot_cont/src/pmc/fixedintegerarray.pmc
branches/kill_parrot_cont/src/pmc/hash.pmc
branches/kill_parrot_cont/src/pmc/hashiteratorkey.pmc
branches/kill_parrot_cont/src/pmc/lexinfo.pmc
branches/kill_parrot_cont/src/pmc/lexpad.pmc
branches/kill_parrot_cont/src/pmc/managedstruct.pmc
branches/kill_parrot_cont/src/pmc/nci.pmc
branches/kill_parrot_cont/src/pmc/object.pmc
branches/kill_parrot_cont/src/pmc/packfileannotation.pmc
branches/kill_parrot_cont/src/pmc/packfileconstanttable.pmc
branches/kill_parrot_cont/src/pmc/packfilefixuptable.pmc
branches/kill_parrot_cont/src/pmc/packfilerawsegment.pmc
branches/kill_parrot_cont/src/pmc/parrotinterpreter.pmc
branches/kill_parrot_cont/src/pmc/parrotlibrary.pmc
branches/kill_parrot_cont/src/pmc/parrotrunningthread.pmc
branches/kill_parrot_cont/src/pmc/resizablebooleanarray.pmc
branches/kill_parrot_cont/src/pmc/resizableintegerarray.pmc
branches/kill_parrot_cont/src/pmc/retcontinuation.pmc
branches/kill_parrot_cont/src/pmc/role.pmc
branches/kill_parrot_cont/src/pmc/scheduler.pmc
branches/kill_parrot_cont/src/pmc/sockaddr.pmc
branches/kill_parrot_cont/src/pmc/string.pmc
branches/kill_parrot_cont/src/pmc/sub.pmc
branches/kill_parrot_cont/src/pmc/timer.pmc
branches/kill_parrot_cont/src/runcore/cores.c (contents, props changed)
branches/kill_parrot_cont/src/runcore/main.c (contents, props changed)
branches/kill_parrot_cont/src/runcore/trace.c (props changed)
branches/kill_parrot_cont/src/scheduler.c
branches/kill_parrot_cont/src/string/charset/unicode.c
branches/kill_parrot_cont/src/sub.c
branches/kill_parrot_cont/src/warnings.c
branches/kill_parrot_cont/t/compilers/pge/06-grammar.t
branches/kill_parrot_cont/t/compilers/pge/perl6regex/rx_quantifiers
branches/kill_parrot_cont/t/compilers/tge/NoneGrammar.tg (props changed)
branches/kill_parrot_cont/t/native_pbc/annotations.pbc
branches/kill_parrot_cont/t/native_pbc/integer_1.pbc
branches/kill_parrot_cont/t/native_pbc/number_1.pbc
branches/kill_parrot_cont/t/native_pbc/string_1.pbc
branches/kill_parrot_cont/t/oo/root_new.t (props changed)
branches/kill_parrot_cont/t/op/annotate.t
branches/kill_parrot_cont/t/op/box.t
branches/kill_parrot_cont/t/op/lexicals.t
branches/kill_parrot_cont/t/op/string.t
branches/kill_parrot_cont/t/pmc/exceptionhandler.t
branches/kill_parrot_cont/t/pmc/fixedpmcarray.t
branches/kill_parrot_cont/t/pmc/packfiledirectory.t
branches/kill_parrot_cont/t/pmc/packfilerawsegment.t
branches/kill_parrot_cont/t/pmc/string.t
branches/kill_parrot_cont/t/pmc/threads.t
branches/kill_parrot_cont/t/src/embed.t (props changed)
branches/kill_parrot_cont/tools/dev/fetch_languages.pl (props changed)
branches/kill_parrot_cont/tools/dev/mk_gitignore.pl (props changed)
branches/kill_parrot_cont/tools/dev/mk_inno_language.pl
branches/kill_parrot_cont/tools/dev/mk_language_shell.pl
branches/kill_parrot_cont/tools/util/perlcritic-cage.conf (props changed)
Modified: branches/kill_parrot_cont/CREDITS
==============================================================================
--- branches/kill_parrot_cont/CREDITS Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/CREDITS Sun Sep 6 00:20:10 2009 (r41024)
@@ -481,6 +481,10 @@
D: Whatever
S: Seattle, WA
+N: Jesse Taylor
+U: jrtayloriv
+E: jrtayloriv at gmail.com
+
N: Jesse Vincent
U: jesse
E: jesse at fsck.com
Modified: branches/kill_parrot_cont/MANIFEST
==============================================================================
--- branches/kill_parrot_cont/MANIFEST Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/MANIFEST Sun Sep 6 00:20:10 2009 (r41024)
@@ -951,6 +951,7 @@
include/parrot/cclass.h [main]include
include/parrot/charset.h [main]include
include/parrot/compiler.h [main]include
+include/parrot/context.h [main]include
include/parrot/core_types.h [main]include
include/parrot/datatypes.h [main]include
include/parrot/debugger.h [main]include
@@ -1242,6 +1243,7 @@
src/atomic/gcc_x86.c []
src/atomic/sparc_v9.s []
src/byteorder.c []
+src/call/context.c []
src/call/ops.c []
src/call/pcc.c []
src/datatypes.c []
@@ -1392,6 +1394,7 @@
src/pmc/class.pmc [devel]src
src/pmc/codestring.pmc [devel]src
src/pmc/complex.pmc [devel]src
+src/pmc/context.pmc [devel]src
src/pmc/continuation.pmc [devel]src
src/pmc/coroutine.pmc [devel]src
src/pmc/cpointer.pmc [devel]src
@@ -1845,6 +1848,7 @@
t/pmc/codestring.t [test]
t/pmc/complex.t [test]
t/pmc/config.t [test]
+t/pmc/context.t [test]
t/pmc/continuation.t [test]
t/pmc/coroutine.t [test]
t/pmc/cpointer.t [test]
@@ -1882,6 +1886,7 @@
t/pmc/multidispatch.t [test]
t/pmc/multisub.t [test]
t/pmc/namespace.t [test]
+t/pmc/namespace-old.t [test]
t/pmc/nci.t [test]
t/pmc/null.t [test]
t/pmc/object-meths.t [test]
Modified: branches/kill_parrot_cont/compilers/imcc/imcc.y
==============================================================================
--- branches/kill_parrot_cont/compilers/imcc/imcc.y Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/compilers/imcc/imcc.y Sun Sep 6 00:20:10 2009 (r41024)
@@ -1210,8 +1210,8 @@
HLL STRINGC
{
STRING * const hll_name = Parrot_str_unescape(interp, $2 + 1, '"', NULL);
- CONTEXT(interp)->current_HLL =
- Parrot_register_HLL(interp, hll_name);
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp),
+ Parrot_register_HLL(interp, hll_name));
IMCC_INFO(interp)->cur_namespace = NULL;
mem_sys_free($2);
Modified: branches/kill_parrot_cont/compilers/imcc/imcparser.c
==============================================================================
--- branches/kill_parrot_cont/compilers/imcc/imcparser.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/compilers/imcc/imcparser.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -3318,8 +3318,8 @@
#line 1211 "compilers/imcc/imcc.y"
{
STRING * const hll_name = Parrot_str_unescape(interp, (yyvsp[(2) - (2)].s) + 1, '"', NULL);
- CONTEXT(interp)->current_HLL =
- Parrot_register_HLL(interp, hll_name);
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp),
+ Parrot_register_HLL(interp, hll_name));
IMCC_INFO(interp)->cur_namespace = NULL;
mem_sys_free((yyvsp[(2) - (2)].s));
Modified: branches/kill_parrot_cont/compilers/imcc/parser_util.c
==============================================================================
--- branches/kill_parrot_cont/compilers/imcc/parser_util.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/compilers/imcc/parser_util.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -626,7 +626,7 @@
struct _imc_info_t *imc_info = NULL;
struct parser_state_t *next;
void *yyscanner;
- Parrot_Context *ignored;
+ PMC *ignored;
INTVAL regs_used[4] = {3, 3, 3, 3};
INTVAL eval_number;
@@ -869,10 +869,10 @@
* Continuations (this happens when something is the target of a :outer)
* trying to return values using them when invoked. (See TT#500 for the
* report of the bug this fixes). */
- opcode_t *save_results = CONTEXT(interp)->current_results;
- CONTEXT(interp)->current_results = NULL;
+ opcode_t *save_results = Parrot_pcc_get_results(interp, CURRENT_CONTEXT(interp));
+ Parrot_pcc_set_results(interp, CURRENT_CONTEXT(interp), NULL);
sub = imcc_compile(interp, s, 0, &error_message);
- CONTEXT(interp)->current_results = save_results;
+ Parrot_pcc_set_results(interp, CURRENT_CONTEXT(interp), save_results);
if (sub)
return sub;
@@ -904,7 +904,7 @@
const char *ext;
FILE *fp;
STRING *fs;
- Parrot_Context *ignored;
+ PMC *ignored;
/* need at least 3 regs for compilation of constant math e.g.
* add_i_ic_ic - see also IMCC_subst_constants() */
Modified: branches/kill_parrot_cont/compilers/imcc/pbc.c
==============================================================================
--- branches/kill_parrot_cont/compilers/imcc/pbc.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/compilers/imcc/pbc.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -1280,9 +1280,9 @@
}
/* could be eval too; check if :outer is the current sub */
- current = CONTEXT(interp)->current_sub;
+ current = Parrot_pcc_get_sub(interp, CURRENT_CONTEXT(interp));
- if (!current)
+ if (PMC_IS_NULL(current))
IMCC_fatal(interp, 1, "Undefined :outer sub '%s'.\n",
unit->outer->name);
@@ -1434,7 +1434,7 @@
sub->namespace_name = ns_pmc;
sub->start_offs = offs;
sub->end_offs = end;
- sub->HLL_id = CONTEXT(interp)->current_HLL;
+ sub->HLL_id = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp));
for (i = 0; i < 4; ++i)
sub->n_regs_used[i] = unit->n_regs_used[i];
Modified: branches/kill_parrot_cont/compilers/pct/src/PAST/Compiler.pir
==============================================================================
--- branches/kill_parrot_cont/compilers/pct/src/PAST/Compiler.pir Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/compilers/pct/src/PAST/Compiler.pir Sun Sep 6 00:20:10 2009 (r41024)
@@ -989,6 +989,8 @@
unless $I0 goto have_lvalue
$P0 = node[0]
if null $P0 goto have_lvalue
+ $I1 = exists $P0['lvalue']
+ if $I1 goto have_lvalue
$P0.'lvalue'($I0)
have_lvalue:
Modified: branches/kill_parrot_cont/compilers/pct/src/POST/Compiler.pir
==============================================================================
--- branches/kill_parrot_cont/compilers/pct/src/POST/Compiler.pir Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/compilers/pct/src/POST/Compiler.pir Sun Sep 6 00:20:10 2009 (r41024)
@@ -82,6 +82,8 @@
pos = cpost['pos']
if null pos goto done_subline
source = cpost['source']
+ $I0 = can source, 'lineof'
+ unless $I0 goto done_subline
line = source.'lineof'(pos)
inc line
done_subline:
Modified: branches/kill_parrot_cont/config/gen/crypto/digest_pmc.in
==============================================================================
--- branches/kill_parrot_cont/config/gen/crypto/digest_pmc.in Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/config/gen/crypto/digest_pmc.in Sun Sep 6 00:20:10 2009 (r41024)
@@ -36,7 +36,7 @@
@TEMP_md_guard@
@TEMP_md_ctx@ *c = mem_allocate_zeroed_typed(@TEMP_md_ctx@);
PMC_data(SELF) = c;
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
#else
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ILL_INHERIT,
"@TEMP_md_name@ is disabled");
@@ -75,7 +75,7 @@
memcpy(c, PMC_data(SELF), sizeof (@TEMP_md_ctx@));
PMC_data(retval) = c;
- PObj_active_destroy_SET(retval);
+ PObj_custom_destroy_SET(retval);
return retval;
#else
return NULL;
Modified: branches/kill_parrot_cont/config/gen/makefiles/root.in
==============================================================================
--- branches/kill_parrot_cont/config/gen/makefiles/root.in Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/config/gen/makefiles/root.in Sun Sep 6 00:20:10 2009 (r41024)
@@ -441,6 +441,7 @@
$(SRC_DIR)/interp/inter_create$(O) \
$(SRC_DIR)/interp/inter_misc$(O) \
$(SRC_DIR)/call/ops$(O) \
+ $(SRC_DIR)/call/context$(O) \
$(SRC_DIR)/key$(O) \
$(SRC_DIR)/library$(O) \
$(SRC_DIR)/list$(O) \
Modified: branches/kill_parrot_cont/docs/embed.pod
==============================================================================
--- branches/kill_parrot_cont/docs/embed.pod Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/docs/embed.pod Sun Sep 6 00:20:10 2009 (r41024)
@@ -1853,7 +1853,7 @@
=item C<pmc_type>
-=item C<PObj_active_destroy_SET>
+=item C<PObj_custom_destroy_SET>
=item C<PObj_custom_mark_SET>
Modified: branches/kill_parrot_cont/docs/memory_internals.pod
==============================================================================
--- branches/kill_parrot_cont/docs/memory_internals.pod Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/docs/memory_internals.pod Sun Sep 6 00:20:10 2009 (r41024)
@@ -1,4 +1,4 @@
-# Copyright (C) 2001-2004, Parrot Foundation.
+# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
=head1 NAME
@@ -117,18 +117,16 @@
=head2 General structure of a buffer-like item
struct parrot_object_t {
- UnionVal cache;
unsigned flags;
...
} PObj;
-This does not totally reflect the current implementation, but is the spirit of
-the abstraction of current objects. The C<UnionVal cache> field is a C<union>
-that contains a variety of pointer and data configurations. The flags field
-may contain a series of flags which indicate the type, status, configuration,
-and special requirements of each item. Buffers, C<PMC>s, and C<PObj>s all
-have these basic fields in common, although they also contain a variety of
-other data fields, depending on type.
+The flags field may contain a series of flags which indicate the type, status,
+configuration, and special requirements of each item. C<Buffer>s, C<PMC>s, and
+C<PObj>s all have this basic field in common.
+
+C<PMC>s and C<Buffer>s each have an additional field which contain a pointer
+to a block of data.
=head2 GC-related PObj flags
@@ -279,5 +277,3 @@
=head1 VERSION
0.1.1 June 2008
-
-
Modified: branches/kill_parrot_cont/docs/pdds/pdd09_gc.pod
==============================================================================
--- branches/kill_parrot_cont/docs/pdds/pdd09_gc.pod Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/docs/pdds/pdd09_gc.pod Sun Sep 6 00:20:10 2009 (r41024)
@@ -1,4 +1,4 @@
-# Copyright (C) 2001-2008, Parrot Foundation.
+# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
=head1 PDD 9: Garbage Collection Subsystem
@@ -560,7 +560,7 @@
=over 4
-=item PObj_active_destroy_FLAG
+=item PObj_custom_destroy_FLAG
The PMC has some sort of active destructor, and will have that destructor
called when the PMC is destroyed. The destructor is typically called from
@@ -620,6 +620,9 @@
=head2 References
+"Uniprocessor Garbage Collection Techniques"
+http://www.cs.rice.edu/~javaplt/311/Readings/wilson92uniprocessor.pdf
+
"A unified theory of garbage collection":
http://portal.acm.org/citation.cfm?id=1028982
Modified: branches/kill_parrot_cont/docs/pdds/pdd28_strings.pod
==============================================================================
--- branches/kill_parrot_cont/docs/pdds/pdd28_strings.pod Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/docs/pdds/pdd28_strings.pod Sun Sep 6 00:20:10 2009 (r41024)
@@ -257,30 +257,29 @@
Parrot's internal strings (C<STRING>s) have the following structure:
- struct parrot_string_t {
- UnionVal cache;
- Parrot_UInt flags;
- UINTVAL bufused;
- UINTVAL strlen;
- UINTVAL hashval;
- const struct _encoding *encoding;
- const struct _charset *charset;
- const struct _normalization *normalization;
- };
+ struct parrot_string_t {
+ Parrot_UInt flags;
+ void * _bufstart;
+ size_t _buflen;
+ char *strstart;
+ UINTVAL bufused;
+ UINTVAL strlen;
+ UINTVAL hashval;
+ const struct _encoding *encoding;
+ const struct _charset *charset;
+};
The fields are:
=over 4
-=item cache
+=item _bufstart
-A structure that holds the buffer for the string data and the size of the
-buffer in bytes.
+A pointer to the buffer for the string data.
-{{ NOTE: this is currently called "cache" for compatibility with PMC
-structures. As we eliminate the cache from PMCs, we will flatten out this
-union value in the string structure to two members: a string buffer and the
-size of the buffer used. }}
+=item _buflen
+
+The size of the buffer in bytes.
=item flags
@@ -320,13 +319,6 @@
The charset structure specifies the character set (by index number and by
name) and provides functions for transcoding to and from that character set.
-=item normalization
-
-What normalization form the string data is in, one of the four Unicode
-normalization forms or NFG. This structure stores the current normalization
-form, function pointers for composition and decomposition for the current
-normalization form, and a pointer to the grapheme table for NFG.
-
=back
{{DEPRECATION NOTE: the enum C<parrot_string_representation_t> will be removed
Modified: branches/kill_parrot_cont/docs/pmc.pod
==============================================================================
--- branches/kill_parrot_cont/docs/pmc.pod Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/docs/pmc.pod Sun Sep 6 00:20:10 2009 (r41024)
@@ -42,7 +42,7 @@
C<PMC_data> in the PMC's C<init()> and C<init_pmc()> VTABLE functions (if used)
and it must be destroyed in the C<destroy()> VTABLE function. PMCs with ATTRs
also need to indicate that they need active destruction by calling
-C<PObj_active_destroy_SET()> or C<PObj_custom_mark_destroy_SETALL()>.
+C<PObj_custom_destroy_SET()> or C<PObj_custom_mark_destroy_SETALL()>.
If your PMC only needs to store a single pointer, it can use C<PMC_data> directly.
Note that this may make maintaining your PMC difficult, should more data ever
@@ -80,10 +80,10 @@
VTABLE function must call B<Parrot_gc_mark_PObj_alive()> on all B<PObj>s which your PMC
contains.
-=item PObj_active_destroy_FLAG
+=item PObj_custom_destroy_FLAG
If your PMC allocates any memory or opens any resources during its lifetime, it
-must set B<PObj_active_destroy> and implement the B<destroy()> VTABLE function to
+must set B<PObj_custom_destroy> and implement the B<destroy()> VTABLE function to
free those resources.
=item PObj_needs_early_gc_FLAG
Modified: branches/kill_parrot_cont/docs/project/support_policy.pod
==============================================================================
--- branches/kill_parrot_cont/docs/project/support_policy.pod Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/docs/project/support_policy.pod Sun Sep 6 00:20:10 2009 (r41024)
@@ -164,10 +164,27 @@
=item * bytecode changes (opcode or core PMC removals, renames)
-=item * PARROT_API function changes
+=item * C<PARROT_API> function changes
=item * PIR or PASM syntax changes
=item * API changes in the compiler tools
=back
+
+Please note that these features I<do not> require deprecation notices:
+
+=over 4
+
+=item * Parrot functions I<not> marked with C<PARROT_API>
+
+=item * The layout of Parrot's internal data structures
+
+=item * Parrot internals hidden behind a public API
+
+=back
+
+Note that all pointers passed to and returned from functions marked with
+C<PARROT_API> are considered opaque. We do not guarantee backwards
+compatibility between monthly releases for the layout of these pointers;
+dereference them at your own risk.
Modified: branches/kill_parrot_cont/docs/vtables.pod
==============================================================================
--- branches/kill_parrot_cont/docs/vtables.pod Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/docs/vtables.pod Sun Sep 6 00:20:10 2009 (r41024)
@@ -211,7 +211,7 @@
=item C<destroy>
Do any data shut-down and finalization you need to do. To have this method
-called, you must set the C<Pobj_active_destroy_FLAG>.
+called, you must set the C<Pobj_custom_destroy_FLAG>.
=item C<get_integer>
Modified: branches/kill_parrot_cont/include/parrot/call.h
==============================================================================
--- branches/kill_parrot_cont/include/parrot/call.h Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/include/parrot/call.h Sun Sep 6 00:20:10 2009 (r41024)
@@ -16,6 +16,23 @@
#ifndef PARROT_INTER_CALL_H_GUARD
#define PARROT_INTER_CALL_H_GUARD
+#include "parrot/context.h"
+
+/* Wrap the jump buffer in a struct, to make it a linked list. Jump buffers are
+ * used to resume execution at a point in the runloop where an exception
+ * handler can be run. Ultimately this information should be part of
+ * Parrot_Context, but at this point a new context isn't created for every
+ * runloop ID, so it still needs to be a separate stack for a while longer. */
+
+typedef struct parrot_runloop_t {
+ Parrot_jump_buff resume; /* jmp_buf */
+ struct parrot_runloop_t *prev; /* interpreter's runloop
+ * jump buffer stack */
+ opcode_t *handler_start; /* Used in exception handling */
+} parrot_runloop_t;
+
+typedef parrot_runloop_t Parrot_runloop;
+
typedef enum call_state_mode {
/* argument fetching/putting modes */
CALL_STATE_SIG = 0x100, /* runops, nci. In case we're interfacing with
@@ -51,7 +68,7 @@
} op;
} u;
- Parrot_Context *ctx; /* the source or destination context */
+ PMC *ctx; /* the source or destination context */
INTVAL used; /* src: whether this argument has been consumed
* (or: whether the previous arg has?) */
INTVAL i; /* number of args/params already processed */
@@ -131,7 +148,7 @@
PARROT_EXPORT
int Parrot_init_arg_indexes_and_sig_pmc(PARROT_INTERP,
- ARGIN(Parrot_Context *ctx),
+ ARGIN(PMC *ctx),
ARGIN_NULLOK(opcode_t *indexes),
ARGIN_NULLOK(PMC *sig_pmc),
ARGMOD(call_state_item *sti))
@@ -151,7 +168,7 @@
PARROT_EXPORT
int Parrot_init_arg_op(PARROT_INTERP,
- ARGIN(Parrot_Context *ctx),
+ ARGIN(PMC *ctx),
ARGIN_NULLOK(opcode_t *pc),
ARGIN(call_state_item *sti))
__attribute__nonnull__(1)
@@ -160,7 +177,7 @@
PARROT_EXPORT
int Parrot_init_arg_sig(PARROT_INTERP,
- ARGIN(Parrot_Context *ctx),
+ ARGIN(PMC *ctx),
ARGIN(const char *sig),
ARGIN_NULLOK(void *ap),
ARGMOD(call_state_item *sti))
@@ -181,8 +198,8 @@
PARROT_EXPORT
void parrot_pass_args(PARROT_INTERP,
- ARGMOD(Parrot_Context *src_ctx),
- ARGMOD(Parrot_Context *dest_ctx),
+ ARGMOD(PMC *src_ctx),
+ ARGMOD(PMC *dest_ctx),
ARGMOD_NULLOK(opcode_t *src_indexes),
ARGMOD_NULLOK(opcode_t *dest_indexes),
arg_pass_t param_or_result)
@@ -254,7 +271,8 @@
FUNC_MODIFIES(*st);
PARROT_EXPORT
-int Parrot_store_arg(SHIM_INTERP, ARGIN(const call_state *st))
+int Parrot_store_arg(PARROT_INTERP, ARGIN(const call_state *st))
+ __attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_CANNOT_RETURN_NULL
@@ -262,7 +280,7 @@
opcode_t * parrot_pass_args_fromc(PARROT_INTERP,
ARGIN(const char *sig),
ARGMOD(opcode_t *dest),
- ARGIN(Parrot_Context *old_ctxp),
+ ARGIN(PMC *old_ctxp),
va_list ap)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
@@ -272,29 +290,27 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-void * set_retval(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
+void * set_retval(PARROT_INTERP, int sig_ret, ARGIN(PMC *ctx))
__attribute__nonnull__(1)
__attribute__nonnull__(3);
-FLOATVAL set_retval_f(PARROT_INTERP,
- int sig_ret,
- ARGIN(Parrot_Context *ctx))
+FLOATVAL set_retval_f(PARROT_INTERP, int sig_ret, ARGIN(PMC *ctx))
__attribute__nonnull__(1)
__attribute__nonnull__(3);
-INTVAL set_retval_i(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
+INTVAL set_retval_i(PARROT_INTERP, int sig_ret, ARGIN(PMC *ctx))
__attribute__nonnull__(1)
__attribute__nonnull__(3);
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
-PMC* set_retval_p(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
+PMC* set_retval_p(PARROT_INTERP, int sig_ret, ARGIN(PMC *ctx))
__attribute__nonnull__(1)
__attribute__nonnull__(3);
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
-STRING* set_retval_s(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
+STRING* set_retval_s(PARROT_INTERP, int sig_ret, ARGIN(PMC *ctx))
__attribute__nonnull__(1)
__attribute__nonnull__(3);
@@ -362,7 +378,8 @@
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(st)
#define ASSERT_ARGS_Parrot_store_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(st)
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(st)
#define ASSERT_ARGS_parrot_pass_args_fromc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(sig) \
@@ -495,7 +512,7 @@
PARROT_EXPORT
PARROT_IGNORABLE_RESULT
PARROT_CANNOT_RETURN_NULL
-Parrot_Context * Parrot_runops_fromc(PARROT_INTERP, ARGIN(PMC *sub))
+PMC * Parrot_runops_fromc(PARROT_INTERP, ARGIN(PMC *sub))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
@@ -669,9 +686,11 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: src/call/ops.c */
-#define ASSERT_SIG_PMC(sig) \
+#define ASSERT_SIG_PMC(sig) do {\
+ PARROT_ASSERT(!PMC_IS_NULL(sig)); \
PARROT_ASSERT(PObj_is_PMC_TEST(sig)); \
- PARROT_ASSERT((sig)->vtable->base_type == enum_class_FixedIntegerArray)
+ PARROT_ASSERT((sig)->vtable->base_type == enum_class_FixedIntegerArray); \
+} while (0)
/* XXX Remove interp from this */
#define ADD_OP_VAR_PART(interp, seg, pc, n) do { \
@@ -684,6 +703,449 @@
} \
} while (0)
+/* Context manipulating functions */
+
+/* HEADERIZER BEGIN: src/call/context.c */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+struct PackFile_Constant ** Parrot_pcc_constants(PARROT_INTERP,
+ ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+UINTVAL Parrot_pcc_dec_recursion_depth(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_errors_off(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_errors_on(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+UINTVAL Parrot_pcc_errors_test(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ UINTVAL flags)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC* Parrot_pcc_get_caller_ctx(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+Parrot_Context* Parrot_pcc_get_context_struct(PARROT_INTERP,
+ ARGIN_NULLOK(PMC *ctx))
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC* Parrot_pcc_get_continuation(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC* Parrot_pcc_get_handlers(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+INTVAL Parrot_pcc_get_HLL(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+INTVAL Parrot_pcc_get_int_constant(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ INTVAL idx)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PMC* Parrot_pcc_get_lex_pad(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC* Parrot_pcc_get_namespace(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+FLOATVAL Parrot_pcc_get_num_constant(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ INTVAL idx)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC* Parrot_pcc_get_object(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC* Parrot_pcc_get_outer_ctx(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+opcode_t* Parrot_pcc_get_pc(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC* Parrot_pcc_get_pmc_constant(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+size_t Parrot_pcc_get_pred_offset(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+UINTVAL Parrot_pcc_get_recursion_depth(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+opcode_t* Parrot_pcc_get_results(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC* Parrot_pcc_get_results_signature(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+STRING* Parrot_pcc_get_string_constant(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ INTVAL idx)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC* Parrot_pcc_get_sub(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+UINTVAL Parrot_pcc_inc_recursion_depth(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_set_caller_ctx(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN(PMC *caller_ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+void Parrot_pcc_set_constants(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN_NULLOK(struct PackFile_Constant **constants))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_set_continuation(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN_NULLOK(PMC *_continuation))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_set_handers(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN(PMC *handlers))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+void Parrot_pcc_set_HLL(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL hll)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_set_lex_pad(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN(PMC *lex_pad))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+void Parrot_pcc_set_namespace(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN_NULLOK(PMC *_namespace))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_set_object(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN_NULLOK(PMC *object))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_set_outer_ctx(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN(PMC *outer_ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+void Parrot_pcc_set_pc(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN_NULLOK(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_set_pred_offset(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ size_t pred_offset)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_set_results(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN_NULLOK(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_set_results_signature(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN_NULLOK(PMC *sig))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_set_sub(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN_NULLOK(PMC *sub))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_trace_flags_off(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ UINTVAL flags)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_trace_flags_on(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ UINTVAL flags)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+UINTVAL Parrot_pcc_trace_flags_test(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ UINTVAL flags)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+void Parrot_pcc_warnings_off(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+UINTVAL Parrot_pcc_warnings_on(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ UINTVAL flags)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+UINTVAL Parrot_pcc_warnings_test(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ UINTVAL flags)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+#define ASSERT_ARGS_Parrot_pcc_constants __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_dec_recursion_depth \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_errors_off __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_errors_on __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_errors_test __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_caller_ctx __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_context_struct __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_pcc_get_continuation __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_handlers __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_HLL __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_int_constant __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_lex_pad __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_namespace __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_num_constant __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_object __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_outer_ctx __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_pc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_pmc_constant __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_pred_offset __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_recursion_depth \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_results __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_results_signature \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_string_constant \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_inc_recursion_depth \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_caller_ctx __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx) \
+ || PARROT_ASSERT_ARG(caller_ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_constants __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_continuation __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_handers __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx) \
+ || PARROT_ASSERT_ARG(handlers)
+#define ASSERT_ARGS_Parrot_pcc_set_HLL __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_lex_pad __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx) \
+ || PARROT_ASSERT_ARG(lex_pad)
+#define ASSERT_ARGS_Parrot_pcc_set_namespace __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_object __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_outer_ctx __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx) \
+ || PARROT_ASSERT_ARG(outer_ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_pc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_pred_offset __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_results __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_results_signature \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_trace_flags_off __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_trace_flags_on __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_trace_flags_test __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_warnings_off __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_warnings_on __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_warnings_test __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: src/call/context.c */
#endif /* PARROT_INTER_CALL_H_GUARD */
Copied: branches/kill_parrot_cont/include/parrot/context.h (from r41020, trunk/include/parrot/context.h)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/kill_parrot_cont/include/parrot/context.h Sun Sep 6 00:20:10 2009 (r41024, copy of r41020, trunk/include/parrot/context.h)
@@ -0,0 +1,74 @@
+/* context.h
+ * Copyright (C) 2009, Parrot Foundation.
+ * SVN Info
+ * $Id$
+ * Overview:
+ * Context
+ */
+
+#ifndef PARROT_CONTEXT_H_GUARD
+#define PARROT_CONTEXT_H_GUARD
+
+struct PackFile_Constant;
+
+typedef union {
+ PMC **regs_p;
+ STRING **regs_s;
+} Regs_ps;
+
+typedef union {
+ FLOATVAL *regs_n;
+ INTVAL *regs_i;
+} Regs_ni;
+
+struct Parrot_Context {
+ PMC *caller_ctx; /* caller context */
+ Regs_ni bp; /* pointers to FLOATVAL & INTVAL */
+ Regs_ps bp_ps; /* pointers to PMC & STR */
+
+ /* end common header */
+ INTVAL n_regs_used[4]; /* INSP in PBC points to Sub */
+ PMC *lex_pad; /* LexPad PMC */
+ PMC *outer_ctx; /* outer context, if a closure */
+
+ /* new call scheme and introspective variables */
+ PMC *current_sub; /* the Sub we are executing */
+
+ /* for now use a return continuation PMC */
+ PMC *handlers; /* local handlers for the context */
+ PMC *current_cont; /* the return continuation PMC */
+ PMC *current_object; /* current object if a method call */
+ PMC *current_namespace; /* The namespace we're currently in */
+ PMC *results_signature; /* non-const results signature PMC */
+ opcode_t *current_pc; /* program counter of Sub invocation */
+ opcode_t *current_results; /* ptr into code with get_results opcode */
+
+ /* deref the constants - we need it all the time */
+ struct PackFile_Constant **constants;
+
+ INTVAL current_HLL; /* see also src/hll.c */
+
+ UINTVAL warns; /* Keeps track of what warnings
+ * have been activated */
+ UINTVAL errors; /* fatals that can be turned off */
+ UINTVAL trace_flags;
+ UINTVAL recursion_depth; /* Sub call recursion depth */
+
+ /* code->prederefed.code - code->base.data in opcodes
+ * to simplify conversion between code ptrs in e.g. invoke */
+ size_t pred_offset;
+};
+
+typedef struct Parrot_Context Parrot_Context;
+
+#define PMC_context(pmc) Parrot_cx_get_context(interp, (pmc))
+
+
+#endif /* PARROT_CONTEXT_H_GUARD */
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/kill_parrot_cont/include/parrot/gc_api.h
==============================================================================
--- branches/kill_parrot_cont/include/parrot/gc_api.h Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/include/parrot/gc_api.h Sun Sep 6 00:20:10 2009 (r41024)
@@ -21,9 +21,9 @@
to allocate these things using mem_sys_allocate instead */
/* Disabled on Windows platforms until problems get fixed, TT #940 */
#if defined(_WIN32) || defined(_WIN64)
-# define GC_USE_FIXED_SIZE_ALLOCATOR 0
+# define GC_USE_FIXED_SIZE_ALLOCATOR 1
#else
-# define GC_USE_FIXED_SIZE_ALLOCATOR 0
+# define GC_USE_FIXED_SIZE_ALLOCATOR 1
#endif
/*
@@ -248,10 +248,10 @@
void Parrot_gc_free_fixed_size_storage(PARROT_INTERP,
size_t size,
- ARGMOD(void * data))
+ ARGMOD(void *data))
__attribute__nonnull__(1)
__attribute__nonnull__(3)
- FUNC_MODIFIES(* data);
+ FUNC_MODIFIES(*data);
void Parrot_gc_free_pmc_attributes(PARROT_INTERP,
ARGMOD(PMC *pmc),
Modified: branches/kill_parrot_cont/include/parrot/interpreter.h
==============================================================================
--- branches/kill_parrot_cont/include/parrot/interpreter.h Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/include/parrot/interpreter.h Sun Sep 6 00:20:10 2009 (r41024)
@@ -124,9 +124,9 @@
#define Interp_debug_CLEAR(interp, flag) ((interp)->debug_flags &= ~(flag))
#define Interp_debug_TEST(interp, flag) ((interp)->debug_flags & (flag))
-#define Interp_trace_SET(interp, flag) (CONTEXT(interp)->trace_flags |= (flag))
-#define Interp_trace_CLEAR(interp, flag) (CONTEXT(interp)->trace_flags &= ~(flag))
-#define Interp_trace_TEST(interp, flag) (CONTEXT(interp)->trace_flags & (flag))
+#define Interp_trace_SET(interp, flag) Parrot_pcc_trace_flags_on(interp, interp->ctx, (flag))
+#define Interp_trace_CLEAR(interp, flag) Parrot_pcc_trace_flags_off(interp, interp->ctx, (flag))
+#define Interp_trace_TEST(interp, flag) Parrot_pcc_trace_flags_test(interp, interp->ctx, (flag))
#define Interp_core_SET(interp, core) ((interp)->run_core = (core))
#define Interp_core_TEST(interp, core) ((interp)->run_core == (core))
@@ -140,6 +140,7 @@
#include "parrot/debugger.h"
#include "parrot/multidispatch.h"
+#include "parrot/call.h"
typedef struct warnings_t {
Warnings_classes classes;
@@ -176,64 +177,6 @@
* defined in imcc/imc.h */
struct _imc_info_t;
-typedef union {
- PMC **regs_p;
- STRING **regs_s;
-} Regs_ps;
-
-typedef union {
- FLOATVAL *regs_n;
- INTVAL *regs_i;
-} Regs_ni;
-
-/* If CTX_LEAK_DEBUG is enabled, then turning on PARROT_CTX_DESTROY_DEBUG_FLAG
- will print tons of detail about when Parrot_Context structures are allocated
- and deallocated to stderr. If CTX_LEAK_DEBUG is disabled, then all of the
- relevant code is omitted, and PARROT_CTX_DESTROY_DEBUG_FLAG has no effect.
- */
-#define CTX_LEAK_DEBUG 1
-
-struct Parrot_Context {
- /* common header with Interp_Context */
- struct Parrot_Context *caller_ctx; /* caller context */
- Regs_ni bp; /* pointers to FLOATVAL & INTVAL */
- Regs_ps bp_ps; /* pointers to PMC & STR */
-
- /* end common header */
- INTVAL n_regs_used[4]; /* INSP in PBC points to Sub */
- PMC *lex_pad; /* LexPad PMC */
- struct Parrot_Context *outer_ctx; /* outer context, if a closure */
-
- /* new call scheme and introspective variables */
- PMC *current_sub; /* the Sub we are executing */
-
- /* for now use a return continuation PMC */
- PMC *handlers; /* local handlers for the context */
- PMC *current_cont; /* the return continuation PMC */
- PMC *current_object; /* current object if a method call */
- PMC *current_namespace; /* The namespace we're currently in */
- PMC *results_signature; /* non-const results signature PMC */
- opcode_t *current_pc; /* program counter of Sub invocation */
- opcode_t *current_results; /* ptr into code with get_results opcode */
-
- /* deref the constants - we need it all the time */
- struct PackFile_Constant **constants;
-
- INTVAL current_HLL; /* see also src/hll.c */
- size_t regs_mem_size; /* memory occupied by registers */
- int ref_count; /* how often refered to */
- int gc_mark; /* marked in gc run */
-
- UINTVAL warns; /* Keeps track of what warnings
- * have been activated */
- UINTVAL errors; /* fatals that can be turned off */
- UINTVAL trace_flags;
- UINTVAL recursion_depth; /* Sub call recursion depth */
-
- /* code->prederefed.code - code->base.data in opcodes
- * to simplify conversion between code ptrs in e.g. invoke */
- size_t pred_offset;
-};
struct _Thread_data; /* in thread.h */
struct _Caches; /* caches .h */
@@ -250,61 +193,31 @@
size_t n_allocated; /* allocated size of it */
} Prederef;
+/*
+ * Get Context from interpeter.
+ */
+#define CONTEXT(interp) Parrot_pcc_get_context_struct((interp), (interp)->ctx)
/*
- * This is an 'inlined' copy of the first 3 Context items for
- * faster access of registers mainly
- * During a context switch a 3 pointers are set
+ * Helper macros to fetch fields from context.
+ *
+ * Not considered as part of public API. Should be replaced with proper accessor
+ * functions to manipulate Context.
*/
-typedef struct Interp_Context {
- /* common header */
- struct Parrot_Context *state; /* context */
- Regs_ni bp; /* pointers to FLOATVAL & INTVAL */
- Regs_ps bp_ps; /* pointers to PMC & STR */
- /* end common header */
-} Interp_Context;
-
-#define CONTEXT(interp) ((interp)->ctx.state)
-
-#define CHUNKED_CTX_MEM 0 /* no longer works, but will be reinstated
- * some day; see src/register.c for details.
- */
+#define CURRENT_CONTEXT(interp) ((interp)->ctx)
+
typedef struct _context_mem {
-#if CHUNKED_CTX_MEM
- char *data; /* ctx + register store */
- char *free; /* free to allocate */
- char *threshold; /* continuation threshold */
- struct _context_mem *prev; /* previous allocated area */
-#else
void **free_list; /* array of free-lists, per size free slots */
int n_free_slots; /* amount of allocated */
-#endif
-
} context_mem;
-/* Wrap the jump buffer in a struct, to make it a linked list. Jump buffers are
- * used to resume execution at a point in the runloop where an exception
- * handler can be run. Ultimately this information should be part of
- * Parrot_Context, but at this point a new context isn't created for every
- * runloop ID, so it still needs to be a separate stack for a while longer. */
-
-typedef struct parrot_runloop_t {
- Parrot_jump_buff resume; /* jmp_buf */
- struct parrot_runloop_t *prev; /* interpreter's runloop
- * jump buffer stack */
- opcode_t *handler_start; /* Used in exception handling */
-} parrot_runloop_t;
-
-typedef parrot_runloop_t Parrot_runloop;
-
struct _handler_node_t; /* forward def - exit.h */
/* The actual interpreter structure */
struct parrot_interp_t {
- struct Interp_Context ctx;
- context_mem ctx_mem; /* ctx memory managment */
+ PMC *ctx; /* current Context */
struct Arenas *arena_base; /* Pointer to this interpreter's
* arena */
@@ -707,12 +620,6 @@
PARROT_EXPORT void disable_event_checking(PARROT_INTERP);
PARROT_EXPORT void enable_event_checking(PARROT_INTERP);
-#if CTX_LEAK_DEBUG
-# define Parrot_context_ref(a, b) Parrot_context_ref_trace((a), (b), __FILE__, __LINE__)
-#else /* !CTX_LEAK_DEBUG */
-# define Parrot_context_ref(a, b) (((b)->ref_count++), (b))
-#endif /* CTX_LEAK_DEBUG */
-
#else /* !PARROT_IN_CORE */
typedef void * *(*native_func_t)(PARROT_INTERP,
Modified: branches/kill_parrot_cont/include/parrot/pobj.h
==============================================================================
--- branches/kill_parrot_cont/include/parrot/pobj.h Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/include/parrot/pobj.h Sun Sep 6 00:20:10 2009 (r41024)
@@ -38,9 +38,8 @@
v v
The actual set-up is more involved because of padding. obj->bufstart must
-be suitably aligned for any UnionVal. (Perhaps it should be a Buffer
-there instead.) The start of the memory region (as returned by malloc()
-is also suitably aligned for any use. If, for example, malloc() returns
+be suitably aligned. The start of the memory region (as returned by malloc())
+is suitably aligned for any use. If, for example, malloc() returns
objects aligned on 8-byte boundaries, and obj->bufstart is also aligned
on 8-byte boundaries, then there should be 4 bytes of padding. It is
handled differently in the two files alloc_resources.c and res_lea.c.
@@ -192,7 +191,7 @@
/* Mark the buffer as needing GC */
PObj_custom_GC_FLAG = POBJ_FLAG(21),
/* Set if the PObj has a destroy method that must be called */
- PObj_active_destroy_FLAG = POBJ_FLAG(22),
+ PObj_custom_destroy_FLAG = POBJ_FLAG(22),
/* For debugging, report when this buffer gets moved around */
PObj_report_FLAG = POBJ_FLAG(23),
@@ -290,7 +289,7 @@
#define PObj_special_CLEAR(flag, o) do { \
PObj_flag_CLEAR(flag, o); \
if ((PObj_get_FLAGS(o) & \
- (PObj_active_destroy_FLAG | \
+ (PObj_custom_destroy_FLAG | \
PObj_custom_mark_FLAG | \
PObj_needs_early_gc_FLAG))) \
gc_flag_SET(is_special_PMC, o); \
@@ -313,9 +312,17 @@
#define PObj_custom_mark_CLEAR(o) PObj_special_CLEAR(custom_mark, o)
#define PObj_custom_mark_TEST(o) PObj_flag_TEST(custom_mark, o)
-#define PObj_active_destroy_SET(o) PObj_flag_SET(active_destroy, o)
-#define PObj_active_destroy_TEST(o) PObj_flag_TEST(active_destroy, o)
-#define PObj_active_destroy_CLEAR(o) PObj_flag_CLEAR(active_destroy, o)
+#define PObj_custom_destroy_SET(o) PObj_flag_SET(custom_destroy, o)
+#define PObj_custom_destroy_TEST(o) PObj_flag_TEST(custom_destroy, o)
+#define PObj_custom_destroy_CLEAR(o) PObj_flag_CLEAR(custom_destroy, o)
+
+/*******************************************************
+ * DEPRECATED -- use PObj_custom_destroy_FOO() instead *
+ *******************************************************/
+#define PObj_active_destroy_FLAG PObj_custom_destroy_FLAG
+#define PObj_active_destroy_SET(o) PObj_flag_SET(custom_destroy, o)
+#define PObj_active_destroy_TEST(o) PObj_flag_TEST(custom_destroy, o)
+#define PObj_active_destroy_CLEAR(o) PObj_flag_CLEAR(custom_destroy, o)
#define PObj_is_class_SET(o) PObj_flag_SET(is_class, o)
#define PObj_is_class_TEST(o) PObj_flag_TEST(is_class, o)
@@ -357,7 +364,7 @@
#define PObj_custom_mark_destroy_SETALL(o) do { \
PObj_custom_mark_SET(o); \
- PObj_active_destroy_SET(o); \
+ PObj_custom_destroy_SET(o); \
} while (0)
#endif /* PARROT_POBJ_H_GUARD */
Modified: branches/kill_parrot_cont/include/parrot/register.h
==============================================================================
--- branches/kill_parrot_cont/include/parrot/register.h Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/include/parrot/register.h Sun Sep 6 00:20:10 2009 (r41024)
@@ -15,20 +15,21 @@
#include "parrot/string.h"
#include "parrot/compiler.h"
+#include "parrot/context.h" /* Parrot_Context */
/*
* Macros to make accessing registers more convenient/readable.
*/
-#define CTX_REG_NUM(ctx, x) (ctx)->bp.regs_n[-1L-(x)]
-#define CTX_REG_INT(ctx, x) (ctx)->bp.regs_i[x]
-#define CTX_REG_PMC(ctx, x) (ctx)->bp_ps.regs_p[-1L-(x)]
-#define CTX_REG_STR(ctx, x) (ctx)->bp_ps.regs_s[x]
-
-#define REG_NUM(interp, x) CTX_REG_NUM(&(interp)->ctx, (x))
-#define REG_INT(interp, x) CTX_REG_INT(&(interp)->ctx, (x))
-#define REG_PMC(interp, x) CTX_REG_PMC(&(interp)->ctx, (x))
-#define REG_STR(interp, x) CTX_REG_STR(&(interp)->ctx, (x))
+#define CTX_REG_NUM(p, x) (*Parrot_pcc_get_FLOATVAL_reg(interp, (p), (x)))
+#define CTX_REG_INT(p, x) (*Parrot_pcc_get_INTVAL_reg(interp, (p), (x)))
+#define CTX_REG_PMC(p, x) (*Parrot_pcc_get_PMC_reg(interp, (p), (x)))
+#define CTX_REG_STR(p, x) (*Parrot_pcc_get_STRING_reg(interp, (p), (x)))
+
+#define REG_NUM(interp, x) (*Parrot_pcc_get_FLOATVAL_reg((interp), (interp)->ctx, (x)))
+#define REG_INT(interp, x) (*Parrot_pcc_get_INTVAL_reg((interp), (interp)->ctx, (x)))
+#define REG_PMC(interp, x) (*Parrot_pcc_get_PMC_reg((interp), (interp)->ctx, (x)))
+#define REG_STR(interp, x) (*Parrot_pcc_get_STRING_reg((interp), (interp)->ctx, (x)))
/*
* and a set of macros to access a register by offset, used
@@ -43,7 +44,7 @@
#define REGNO_STR 2
#define REGNO_PMC 3
-#define __CTX interp->ctx.state
+#define __CTX Parrot_pcc_get_context_struct(interp, interp->ctx)
#define _SIZEOF_INTS (sizeof (INTVAL) * __CTX->n_regs_used[REGNO_INT])
#define _SIZEOF_NUMS (sizeof (FLOATVAL) * __CTX->n_regs_used[REGNO_NUM])
#define _SIZEOF_PMCS (sizeof (PMC*) * __CTX->n_regs_used[REGNO_PMC])
@@ -56,8 +57,6 @@
#define REG_OFFS_STR(x) (sizeof (STRING*) * (x) + _SIZEOF_INTS + _SIZEOF_PMCS)
-typedef struct Parrot_Context Parrot_Context; /* parrot/interpreter.h */
-
/* HEADERIZER BEGIN: src/gc/alloc_register.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
@@ -79,26 +78,76 @@
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
-Parrot_Context * Parrot_context_ref_trace(PARROT_INTERP,
- ARGMOD(Parrot_Context *ctx),
- ARGIN(const char *file),
- int line)
+FLOATVAL * Parrot_pcc_get_FLOATVAL_reg(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ INTVAL idx)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+INTVAL * Parrot_pcc_get_INTVAL_reg(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ INTVAL idx)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PMC ** Parrot_pcc_get_PMC_reg(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+Regs_ni* Parrot_pcc_get_regs_ni(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+Regs_ps* Parrot_pcc_get_regs_ps(PARROT_INTERP, ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+int Parrot_pcc_get_regs_used(PARROT_INTERP, ARGIN(PMC *ctx), int type)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+STRING ** Parrot_pcc_get_STRING_reg(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ INTVAL idx)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+void Parrot_pcc_set_regs_ni(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN(Regs_ni *bp))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*ctx);
+ __attribute__nonnull__(3);
PARROT_EXPORT
-void Parrot_free_context(PARROT_INTERP,
- ARGMOD(Parrot_Context *ctx),
- int deref)
+PARROT_CANNOT_RETURN_NULL
+void Parrot_pcc_set_regs_ps(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ ARGIN(Regs_ps *bp_ps))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
- FUNC_MODIFIES(*ctx);
+ __attribute__nonnull__(3);
PARROT_EXPORT
-void parrot_gc_context(PARROT_INTERP)
- __attribute__nonnull__(1);
+void Parrot_pcc_set_regs_used(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ int type,
+ INTVAL num)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
PARROT_EXPORT
void Parrot_pop_context(PARROT_INTERP)
@@ -107,31 +156,24 @@
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
-Parrot_Context * Parrot_push_context(PARROT_INTERP,
- ARGIN(const INTVAL *n_regs_used))
+PMC * Parrot_push_context(PARROT_INTERP, ARGIN(const INTVAL *n_regs_used))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
-PARROT_EXPORT
-void Parrot_set_context_threshold(SHIM_INTERP, SHIM(Parrot_Context *ctx));
-
void create_initial_context(PARROT_INTERP)
__attribute__nonnull__(1);
-void destroy_context(PARROT_INTERP)
- __attribute__nonnull__(1);
-
PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
-Parrot_Context * Parrot_alloc_context(PARROT_INTERP,
+PMC * Parrot_alloc_context(PARROT_INTERP,
ARGIN(const INTVAL *number_regs_used),
- ARGIN_NULLOK(Parrot_Context *old))
+ ARGIN_NULLOK(PMC *old))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
-Parrot_Context * Parrot_set_new_context(PARROT_INTERP,
+PMC * Parrot_set_new_context(PARROT_INTERP,
ARGIN(const INTVAL *number_regs_used))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
@@ -144,25 +186,45 @@
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_Parrot_clear_s __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_context_ref_trace __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+#define ASSERT_ARGS_Parrot_pcc_get_FLOATVAL_reg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_INTVAL_reg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_PMC_reg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_regs_ni __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_regs_ps __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_regs_used __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_get_STRING_reg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_Parrot_pcc_set_regs_ni __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(ctx) \
- || PARROT_ASSERT_ARG(file)
-#define ASSERT_ARGS_Parrot_free_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ || PARROT_ASSERT_ARG(bp)
+#define ASSERT_ARGS_Parrot_pcc_set_regs_ps __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx) \
+ || PARROT_ASSERT_ARG(bp_ps)
+#define ASSERT_ARGS_Parrot_pcc_set_regs_used __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(ctx)
-#define ASSERT_ARGS_parrot_gc_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_Parrot_pop_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_Parrot_push_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(n_regs_used)
-#define ASSERT_ARGS_Parrot_set_context_threshold __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
#define ASSERT_ARGS_create_initial_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_destroy_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_Parrot_alloc_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(number_regs_used)
Modified: branches/kill_parrot_cont/include/parrot/sub.h
==============================================================================
--- branches/kill_parrot_cont/include/parrot/sub.h Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/include/parrot/sub.h Sun Sep 6 00:20:10 2009 (r41024)
@@ -178,7 +178,7 @@
PARROT_EXPORT
int Parrot_Context_get_info(PARROT_INTERP,
- ARGIN(const Parrot_Context *ctx),
+ ARGIN(PMC *ctx),
ARGOUT(Parrot_Context_info *info))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
@@ -188,8 +188,7 @@
PARROT_EXPORT
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
-STRING* Parrot_Context_infostr(PARROT_INTERP,
- ARGIN(const Parrot_Context *ctx))
+STRING* Parrot_Context_infostr(PARROT_INTERP, ARGIN(PMC *ctx))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
@@ -217,11 +216,6 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(*cont);
-void mark_context(PARROT_INTERP, ARGMOD(Parrot_Context* ctx))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(* ctx);
-
void mark_context_start(void);
void Parrot_capture_lex(PARROT_INTERP, ARGMOD(PMC *sub_pmc))
__attribute__nonnull__(1)
@@ -238,9 +232,18 @@
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
+PMC* Parrot_find_dynamic_pad(PARROT_INTERP,
+ ARGIN(STRING *lex_name),
+ ARGIN(PMC *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_CAN_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
PMC* Parrot_find_pad(PARROT_INTERP,
ARGIN(STRING *lex_name),
- ARGIN(const Parrot_Context *ctx))
+ ARGIN(PMC *ctx))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
@@ -266,9 +269,6 @@
#define ASSERT_ARGS_invalidate_retc_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(cont)
-#define ASSERT_ARGS_mark_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx)
#define ASSERT_ARGS_mark_context_start __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
#define ASSERT_ARGS_Parrot_capture_lex __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
@@ -280,6 +280,10 @@
__attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pmc)
+#define ASSERT_ARGS_Parrot_find_dynamic_pad __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(lex_name) \
+ || PARROT_ASSERT_ARG(ctx)
#define ASSERT_ARGS_Parrot_find_pad __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(lex_name) \
Modified: branches/kill_parrot_cont/include/parrot/warnings.h
==============================================================================
--- branches/kill_parrot_cont/include/parrot/warnings.h Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/include/parrot/warnings.h Sun Sep 6 00:20:10 2009 (r41024)
@@ -35,19 +35,13 @@
/* &end_gen */
-#define PARROT_WARNINGS_on(interp, flag) do { \
- CONTEXT((interp))->warns |= (flag); } while (0)
-#define PARROT_WARNINGS_off(interp, flag) do { \
- CONTEXT((interp))->warns &= ~(flag); } while (0)
-#define PARROT_WARNINGS_test(interp, flag) \
- (CONTEXT((interp))->warns & (flag))
-
-#define PARROT_ERRORS_on(interp, flag) do { \
- CONTEXT((interp))->errors |= (flag); } while (0)
-#define PARROT_ERRORS_off(interp, flag) do { \
- CONTEXT((interp))->errors &= ~(flag); } while (0)
-#define PARROT_ERRORS_test(interp, flag) \
- (CONTEXT((interp))->errors & (flag))
+#define PARROT_WARNINGS_on(interp, flag) Parrot_pcc_warnings_on((interp), (interp)->ctx, (flag))
+#define PARROT_WARNINGS_off(interp, flag) Parrot_pcc_warnings_off((interp), (interp)->ctx, (flag))
+#define PARROT_WARNINGS_test(interp, flag) Parrot_pcc_warnings_test((interp), (interp)->ctx, (flag))
+
+#define PARROT_ERRORS_on(interp, flag) Parrot_pcc_errors_on((interp), (interp)->ctx, (flag))
+#define PARROT_ERRORS_off(interp, flag) Parrot_pcc_errors_off((interp), (interp)->ctx, (flag))
+#define PARROT_ERRORS_test(interp, flag) Parrot_pcc_errors_test((interp), (interp)->ctx, (flag))
#if defined(PARROT_IN_CORE)
Modified: branches/kill_parrot_cont/lib/Parrot/Op.pm
==============================================================================
--- branches/kill_parrot_cont/lib/Parrot/Op.pm Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/lib/Parrot/Op.pm Sun Sep 6 00:20:10 2009 (r41024)
@@ -393,7 +393,11 @@
return qq{PANIC(interp, "How did you do that");\n};
}
- return $self->rewrite_body( $self->full_body, $trans );
+ my $prelude = $trans->can( 'add_body_prelude' )
+ ? $trans->add_body_prelude()
+ : '';
+
+ return $self->rewrite_body( $prelude . $self->full_body, $trans );
}
=item C<size()>
Modified: branches/kill_parrot_cont/lib/Parrot/OpTrans/C.pm
==============================================================================
--- branches/kill_parrot_cont/lib/Parrot/OpTrans/C.pm Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/lib/Parrot/OpTrans/C.pm Sun Sep 6 00:20:10 2009 (r41024)
@@ -56,14 +56,19 @@
#undef CONST
#define REL_PC ((size_t)(cur_opcode - (opcode_t *)interp->code->base.data))
#define CUR_OPCODE cur_opcode
-#define IREG(i) REG_INT(interp, cur_opcode[i])
-#define NREG(i) REG_NUM(interp, cur_opcode[i])
-#define PREG(i) REG_PMC(interp, cur_opcode[i])
-#define SREG(i) REG_STR(interp, cur_opcode[i])
-#define CONST(i) CONTEXT(interp)->constants[cur_opcode[i]]
+#define IREG(i) (CUR_CTX->bp.regs_i[cur_opcode[i]])
+#define NREG(i) (CUR_CTX->bp.regs_n[-1L - cur_opcode[i]])
+#define PREG(i) (CUR_CTX->bp_ps.regs_p[-1L - cur_opcode[i]])
+#define SREG(i) (CUR_CTX->bp_ps.regs_s[cur_opcode[i]])
+#define CONST(i) Parrot_pcc_constants(interp, interp->ctx)[cur_opcode[i]]
END
}
+sub add_body_prelude {
+ my ($self) = @_;
+ return " Parrot_Context const * const CUR_CTX = Parrot_pcc_get_context_struct(interp, interp->ctx);\n";
+}
+
=item C<gen_goto($where)>
Reimplements the superclass method so that C<$where> is suitably cast.
Modified: branches/kill_parrot_cont/lib/Parrot/OpTrans/CGP.pm
==============================================================================
--- branches/kill_parrot_cont/lib/Parrot/OpTrans/CGP.pm Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/lib/Parrot/OpTrans/CGP.pm Sun Sep 6 00:20:10 2009 (r41024)
@@ -68,7 +68,7 @@
return $pred_def . <<END;
/* defines - $0 -> $type */
# define opcode_to_prederef(i, op) \\
- (opcode_t *) (op - CONTEXT(i)->pred_offset)
+ (opcode_t *) (op - Parrot_pcc_get_pred_offset(interp, i->ctx))
END
}
@@ -91,7 +91,7 @@
return "if ($addr == 0)
return 0;
Parrot_cx_handle_tasks(interp, interp->scheduler);
- _reg_base = (char*)interp->ctx.bp.regs_i;
+ _reg_base = (char*)Parrot_pcc_get_regs_ni(interp, CURRENT_CONTEXT(interp))->regs_i;
goto **(void **)(cur_opcode = opcode_to_prederef(interp, $addr))";
}
}
@@ -107,7 +107,7 @@
my ( $self, $offset ) = @_;
# this must be a single expression, in case it's in a single-statement if
- return "do {\nCONTEXT(interp)->current_pc = CUR_OPCODE + $offset;\n"
+ return "do {\nParrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), CUR_OPCODE + $offset);\n"
. "goto **(void **)(cur_opcode += $offset);\n} while (1)";
}
Modified: branches/kill_parrot_cont/lib/Parrot/OpTrans/CGoto.pm
==============================================================================
--- branches/kill_parrot_cont/lib/Parrot/OpTrans/CGoto.pm Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/lib/Parrot/OpTrans/CGoto.pm Sun Sep 6 00:20:10 2009 (r41024)
@@ -72,7 +72,7 @@
#define NREG(i) REG_NUM(interp, cur_opcode[i])
#define PREG(i) REG_PMC(interp, cur_opcode[i])
#define SREG(i) REG_STR(interp, cur_opcode[i])
-#define CONST(i) CONTEXT(interp)->constants[cur_opcode[i]]
+#define CONST(i) Parrot_pcc_constants(interp, interp->ctx)[cur_opcode[i]]
END
}
Modified: branches/kill_parrot_cont/lib/Parrot/OpTrans/CPrederef.pm
==============================================================================
--- branches/kill_parrot_cont/lib/Parrot/OpTrans/CPrederef.pm Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/lib/Parrot/OpTrans/CPrederef.pm Sun Sep 6 00:20:10 2009 (r41024)
@@ -38,7 +38,7 @@
/* defines - $0 -> $type */
#define REL_PC ((size_t)(cur_opcode - (opcode_t*)interp->code->prederef.code))
#define CUR_OPCODE \\
- ((opcode_t*)cur_opcode + CONTEXT(interp)->pred_offset)
+ ((opcode_t*)cur_opcode + Parrot_pcc_get_pred_offset(interp, CURRENT_CONTEXT(interp)))
#define OP_AS_OFFS(o) (_reg_base + ((opcode_t*)cur_opcode)[o])
END
Modified: branches/kill_parrot_cont/lib/Parrot/OpTrans/CSwitch.pm
==============================================================================
--- branches/kill_parrot_cont/lib/Parrot/OpTrans/CSwitch.pm Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/lib/Parrot/OpTrans/CSwitch.pm Sun Sep 6 00:20:10 2009 (r41024)
@@ -76,7 +76,7 @@
return $pred_def . <<END;
/* defines - $0 -> $type */
# define opcode_to_prederef(i, op) (op ? \\
- (opcode_t*) (op - CONTEXT(i)->pred_offset) : (opcode_t*)NULL)
+ (opcode_t*) (op - Parrot_pcc_get_pred_offset(interp, i->ctx)) : (opcode_t*)NULL)
END
}
@@ -154,7 +154,7 @@
#endif
SWITCH_RELOAD:
- _reg_base = (char*)interp->ctx.bp.regs_i;
+ _reg_base = (char*)Parrot_pcc_get_regs_ni(interp, CURRENT_CONTEXT(interp))->regs_i;
do {
SWITCH_AGAIN:
Parrot_cx_handle_tasks(interp, interp->scheduler);
Modified: branches/kill_parrot_cont/lib/Parrot/Ops2c/Utils.pm
==============================================================================
--- branches/kill_parrot_cont/lib/Parrot/Ops2c/Utils.pm Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/lib/Parrot/Ops2c/Utils.pm Sun Sep 6 00:20:10 2009 (r41024)
@@ -685,7 +685,7 @@
__asm__ ("jmp *4(%ebp)"); /* jump to ret addr, used by JIT */
# endif
#endif
- _reg_base = (char*)interp->ctx.bp.regs_i;
+ _reg_base = (char*)Parrot_pcc_get_regs_ni(interp, CURRENT_CONTEXT(interp))->regs_i;
goto **(void **)cur_opcode;
END_C
Modified: branches/kill_parrot_cont/lib/Parrot/Pmc2c/PCCMETHOD.pm
==============================================================================
--- branches/kill_parrot_cont/lib/Parrot/Pmc2c/PCCMETHOD.pm Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/lib/Parrot/Pmc2c/PCCMETHOD.pm Sun Sep 6 00:20:10 2009 (r41024)
@@ -394,16 +394,16 @@
PMC * const _param_sig = pmc_new(interp, enum_class_FixedIntegerArray);
PMC *_return_sig = PMCNULL;
- Parrot_Context *_caller_ctx = CONTEXT(interp);
- PMC * const _ret_cont = new_ret_continuation_pmc(interp, NULL);
- Parrot_Context *_ctx = Parrot_push_context(interp, _n_regs_used);
- PMC *_ccont = PMCNULL;
+ PMC *_caller_ctx = interp->ctx;
+ PMC * const _ret_cont = new_ret_continuation_pmc(interp, NULL);
+ PMC *_ctx = Parrot_push_context(interp, _n_regs_used);
+ PMC *_ccont = PMCNULL;
$set_params
UNUSED(_return_indexes);
if (_caller_ctx) {
- _ccont = _caller_ctx->current_cont;
+ _ccont = Parrot_pcc_get_continuation(interp, _caller_ctx);
}
else {
/* there is no point calling Parrot_ex_throw_from_c_args here, because
@@ -411,11 +411,11 @@
exit_fatal(1, "No caller_ctx for continuation \%p.", _ccont);
}
- _ctx->current_cont = _ret_cont;
- PARROT_CONTINUATION(_ret_cont)->from_ctx = _ctx;
+ Parrot_pcc_set_continuation(interp, _ctx, _ret_cont);
+ PARROT_CONTINUATION(_ret_cont)->from_ctx = _ctx;
- _current_args = interp->current_args;
- interp->current_args = NULL;
+ _current_args = interp->current_args;
+ interp->current_args = NULL;
END
$e->emit(<<"END");
@@ -429,9 +429,8 @@
if (PObj_get_FLAGS(_ccont) & SUB_FLAG_TAILCALL) {
PObj_get_FLAGS(_ccont) &= ~SUB_FLAG_TAILCALL;
- --_ctx->recursion_depth;
- _ctx->caller_ctx = _caller_ctx->caller_ctx;
- Parrot_free_context(interp, _caller_ctx, 1);
+ Parrot_pcc_dec_recursion_depth(interp, _ctx);
+ Parrot_pcc_set_caller_ctx(interp, _ctx, Parrot_pcc_get_caller_ctx(interp, _caller_ctx));
interp->current_args = NULL;
}
/* BEGIN PARMS SCOPE */
@@ -466,7 +465,7 @@
interp->returns_signature = _return_sig;
parrot_pass_args(interp, _ctx, _caller_ctx, _return_indexes,
- _caller_ctx->current_results, PARROT_PASS_RESULTS);
+ Parrot_pcc_get_results(interp, _caller_ctx), PARROT_PASS_RESULTS);
END
}
$e_post->emit( <<"END", __FILE__, __LINE__ + 1 );
Copied: branches/kill_parrot_cont/src/call/context.c (from r41020, trunk/src/call/context.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/kill_parrot_cont/src/call/context.c Sun Sep 6 00:20:10 2009 (r41024, copy of r41020, trunk/src/call/context.c)
@@ -0,0 +1,954 @@
+/*
+Copyright (C) 2009, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/context.c - Parrot_Context functions.
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "parrot/call.h"
+
+
+/* HEADERIZER HFILE: include/parrot/call.h */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+/*
+
+=item C<void Parrot_pcc_set_constants(PARROT_INTERP, PMC *ctx, struct
+PackFile_Constant **constants)>
+
+Get string constant from context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+void
+Parrot_pcc_set_constants(PARROT_INTERP, ARGIN(PMC *ctx),
+ ARGIN_NULLOK(struct PackFile_Constant **constants))
+{
+ ASSERT_ARGS(Parrot_pcc_set_constants)
+ Parrot_Context * c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->constants = constants;
+}
+
+/*
+
+=item C<INTVAL Parrot_pcc_get_int_constant(PARROT_INTERP, PMC *ctx, INTVAL idx)>
+
+Get FLOATVAL constant from context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+INTVAL
+Parrot_pcc_get_int_constant(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
+{
+ ASSERT_ARGS(Parrot_pcc_get_int_constant)
+ Parrot_Context const * c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->constants[idx]->u.integer;
+}
+
+/*
+
+=item C<FLOATVAL Parrot_pcc_get_num_constant(PARROT_INTERP, PMC *ctx, INTVAL
+idx)>
+
+Get PMC constant from context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+FLOATVAL
+Parrot_pcc_get_num_constant(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
+{
+ ASSERT_ARGS(Parrot_pcc_get_num_constant)
+ Parrot_Context const * c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->constants[idx]->u.number;
+}
+
+/*
+
+=item C<STRING* Parrot_pcc_get_string_constant(PARROT_INTERP, PMC *ctx, INTVAL
+idx)>
+
+Get string constant from context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+STRING*
+Parrot_pcc_get_string_constant(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
+{
+ ASSERT_ARGS(Parrot_pcc_get_string_constant)
+ Parrot_Context const * c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->constants[idx]->u.string;
+}
+
+
+/*
+
+=item C<PMC* Parrot_pcc_get_pmc_constant(PARROT_INTERP, PMC *ctx, INTVAL idx)>
+
+Get PMC constant from context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC*
+Parrot_pcc_get_pmc_constant(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
+{
+ ASSERT_ARGS(Parrot_pcc_get_pmc_constant)
+ Parrot_Context const * c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->constants[idx]->u.key;
+}
+
+
+/*
+
+=item C<struct PackFile_Constant ** Parrot_pcc_constants(PARROT_INTERP, PMC
+*ctx)>
+
+Get reference to constants.
+
+=cut
+
+*/
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+struct PackFile_Constant **
+Parrot_pcc_constants(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_constants)
+ return ((Parrot_Context*)(VTABLE_get_pointer(interp, ctx)))->constants;
+}
+
+
+
+/*
+
+=item C<Parrot_Context* Parrot_pcc_get_context_struct(PARROT_INTERP, PMC *ctx)>
+
+Fetch Parrot_Context from Context PMC.
+
+=cut
+
+*/
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+Parrot_Context*
+Parrot_pcc_get_context_struct(PARROT_INTERP, ARGIN_NULLOK(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_context_struct)
+
+ if (PMC_IS_NULL(ctx))
+ return NULL;
+
+ /* temporarily violate encapsulation; big speedup here */
+ return PMC_data_typed(ctx, Parrot_Context *);
+}
+
+/*
+
+=item C<UINTVAL Parrot_pcc_get_recursion_depth(PARROT_INTERP, PMC *ctx)>
+
+Get recursion depth from context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+UINTVAL
+Parrot_pcc_get_recursion_depth(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_recursion_depth)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->recursion_depth;
+}
+
+/*
+
+=item C<UINTVAL Parrot_pcc_inc_recursion_depth(PARROT_INTERP, PMC *ctx)>
+
+Increase recurtion depth. Returns previous recursion_depth value.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+UINTVAL
+Parrot_pcc_inc_recursion_depth(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_inc_recursion_depth)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->recursion_depth++;
+}
+
+/*
+
+=item C<UINTVAL Parrot_pcc_dec_recursion_depth(PARROT_INTERP, PMC *ctx)>
+
+Decrease recurtion depth. Returns new recursion_depth value.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+UINTVAL
+Parrot_pcc_dec_recursion_depth(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_dec_recursion_depth)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return --c->recursion_depth;
+}
+
+/*
+
+=item C<PMC* Parrot_pcc_get_caller_ctx(PARROT_INTERP, PMC *ctx)>
+
+Get caller Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC*
+Parrot_pcc_get_caller_ctx(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_caller_ctx)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->caller_ctx;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_caller_ctx(PARROT_INTERP, PMC *ctx, PMC
+*caller_ctx)>
+
+Set caller Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_caller_ctx(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN(PMC *caller_ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_set_caller_ctx)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->caller_ctx = caller_ctx;
+}
+
+/*
+
+=item C<PMC* Parrot_pcc_get_outer_ctx(PARROT_INTERP, PMC *ctx)>
+
+Get outer Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC*
+Parrot_pcc_get_outer_ctx(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_outer_ctx)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->outer_ctx;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_outer_ctx(PARROT_INTERP, PMC *ctx, PMC *outer_ctx)>
+
+Set outer Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_outer_ctx(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN(PMC *outer_ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_set_outer_ctx)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->outer_ctx = outer_ctx;
+}
+
+/*
+
+=item C<PMC* Parrot_pcc_get_lex_pad(PARROT_INTERP, PMC *ctx)>
+
+Get LexPad.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PMC*
+Parrot_pcc_get_lex_pad(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_lex_pad)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->lex_pad;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_lex_pad(PARROT_INTERP, PMC *ctx, PMC *lex_pad)>
+
+Set LexPad.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_lex_pad(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN(PMC *lex_pad))
+{
+ ASSERT_ARGS(Parrot_pcc_set_lex_pad)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->lex_pad = lex_pad;
+}
+
+/*
+
+=item C<PMC* Parrot_pcc_get_namespace(PARROT_INTERP, PMC *ctx)>
+
+Get namespace of Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC*
+Parrot_pcc_get_namespace(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_namespace)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->current_namespace;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_namespace(PARROT_INTERP, PMC *ctx, PMC *_namespace)>
+
+Set namespace of Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_namespace(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *_namespace))
+{
+ ASSERT_ARGS(Parrot_pcc_set_namespace)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->current_namespace = _namespace;
+}
+
+/*
+
+=item C<INTVAL Parrot_pcc_get_HLL(PARROT_INTERP, PMC *ctx)>
+
+Get HLL of Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+INTVAL
+Parrot_pcc_get_HLL(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_HLL)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->current_HLL;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_HLL(PARROT_INTERP, PMC *ctx, INTVAL hll)>
+
+Set HLL of Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_HLL(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL hll)
+{
+ ASSERT_ARGS(Parrot_pcc_set_HLL)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->current_HLL = hll;
+}
+
+/*
+
+=item C<PMC* Parrot_pcc_get_handlers(PARROT_INTERP, PMC *ctx)>
+
+Get scheduler handlers.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC*
+Parrot_pcc_get_handlers(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_handlers)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->handlers;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_handers(PARROT_INTERP, PMC *ctx, PMC *handlers)>
+
+Set scheduler handlers.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_handers(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN(PMC *handlers))
+{
+ ASSERT_ARGS(Parrot_pcc_set_handers)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->handlers = handlers;
+}
+
+/*
+
+=item C<PMC* Parrot_pcc_get_continuation(PARROT_INTERP, PMC *ctx)>
+
+Get continuation of Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC*
+Parrot_pcc_get_continuation(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_continuation)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->current_cont;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_continuation(PARROT_INTERP, PMC *ctx, PMC
+*_continuation)>
+
+Set continuation of Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_continuation(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *_continuation))
+{
+ ASSERT_ARGS(Parrot_pcc_set_continuation)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->current_cont = _continuation;
+}
+
+/*
+
+=item C<PMC* Parrot_pcc_get_object(PARROT_INTERP, PMC *ctx)>
+
+Get object of Context (in method call).
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC*
+Parrot_pcc_get_object(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_object)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->current_object;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_object(PARROT_INTERP, PMC *ctx, PMC *object)>
+
+Set object of Context (in method call).
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_object(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *object))
+{
+ ASSERT_ARGS(Parrot_pcc_set_object)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->current_object = object;
+}
+
+/*
+
+=item C<PMC* Parrot_pcc_get_sub(PARROT_INTERP, PMC *ctx)>
+
+Get Sub executed inside Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC*
+Parrot_pcc_get_sub(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_sub)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->current_sub;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_sub(PARROT_INTERP, PMC *ctx, PMC *sub)>
+
+Set Sub executed inside Context.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_sub(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *sub))
+{
+ ASSERT_ARGS(Parrot_pcc_set_sub)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->current_sub = sub;
+}
+
+/*
+
+=item C<opcode_t* Parrot_pcc_get_pc(PARROT_INTERP, PMC *ctx)>
+
+Get program counter of Sub invocation.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+opcode_t*
+Parrot_pcc_get_pc(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_pc)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->current_pc;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_pc(PARROT_INTERP, PMC *ctx, opcode_t *pc)>
+
+Set program counter of Sub invocation.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_pc(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(opcode_t *pc))
+{
+ ASSERT_ARGS(Parrot_pcc_set_pc)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->current_pc = pc;
+}
+
+/*
+
+=item C<opcode_t* Parrot_pcc_get_results(PARROT_INTERP, PMC *ctx)>
+
+Set ptr into code with get_results opcode.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+opcode_t*
+Parrot_pcc_get_results(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_results)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->current_results;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_results(PARROT_INTERP, PMC *ctx, opcode_t *pc)>
+
+Set ptr into code with get_results opcode.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_results(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(opcode_t *pc))
+{
+ ASSERT_ARGS(Parrot_pcc_set_results)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->current_results = pc;
+}
+
+/*
+
+=item C<PMC* Parrot_pcc_get_results_signature(PARROT_INTERP, PMC *ctx)>
+
+Set ptr into code with get_results opcode.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CAN_RETURN_NULL
+PMC*
+Parrot_pcc_get_results_signature(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_results_signature)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->results_signature;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_results_signature(PARROT_INTERP, PMC *ctx, PMC
+*sig)>
+
+Set ptr into code with get_results opcode.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_results_signature(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN_NULLOK(PMC *sig))
+{
+ ASSERT_ARGS(Parrot_pcc_set_results_signature)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->results_signature = sig;
+}
+
+
+/*
+
+=item C<size_t Parrot_pcc_get_pred_offset(PARROT_INTERP, PMC *ctx)>
+
+Get pred_offset
+
+=cut
+
+*/
+
+PARROT_EXPORT
+size_t
+Parrot_pcc_get_pred_offset(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_pred_offset)
+ Parrot_Context const *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->pred_offset;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_set_pred_offset(PARROT_INTERP, PMC *ctx, size_t
+pred_offset)>
+
+Set pred_offset
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_set_pred_offset(PARROT_INTERP, ARGIN(PMC *ctx), size_t pred_offset)
+{
+ ASSERT_ARGS(Parrot_pcc_set_pred_offset)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->pred_offset = pred_offset;
+}
+
+
+/*
+
+=item C<UINTVAL Parrot_pcc_warnings_on(PARROT_INTERP, PMC *ctx, UINTVAL flags)>
+
+Set warnings flags.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+UINTVAL
+Parrot_pcc_warnings_on(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+{
+ ASSERT_ARGS(Parrot_pcc_warnings_on)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->warns |= flags;
+ return c->warns;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_warnings_off(PARROT_INTERP, PMC *ctx, UINTVAL flags)>
+
+Clear warnings flags.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_warnings_off(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+{
+ ASSERT_ARGS(Parrot_pcc_warnings_off)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->warns &= ~flags;
+}
+
+
+/*
+
+=item C<UINTVAL Parrot_pcc_warnings_test(PARROT_INTERP, PMC *ctx, UINTVAL
+flags)>
+
+Test warnings flags.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+UINTVAL
+Parrot_pcc_warnings_test(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+{
+ ASSERT_ARGS(Parrot_pcc_warnings_test)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->warns & flags;
+}
+
+/*
+
+=item C<void Parrot_pcc_errors_on(PARROT_INTERP, PMC *ctx, UINTVAL flags)>
+
+Set errors flags.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_errors_on(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+{
+ ASSERT_ARGS(Parrot_pcc_errors_on)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->errors |= flags;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_errors_off(PARROT_INTERP, PMC *ctx, UINTVAL flags)>
+
+Clear errors flags.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_errors_off(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+{
+ ASSERT_ARGS(Parrot_pcc_errors_off)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->errors &= ~flags;
+}
+
+
+/*
+
+=item C<UINTVAL Parrot_pcc_errors_test(PARROT_INTERP, PMC *ctx, UINTVAL flags)>
+
+Test errors flags.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+UINTVAL
+Parrot_pcc_errors_test(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+{
+ ASSERT_ARGS(Parrot_pcc_errors_test)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->errors & flags;
+}
+
+/*
+
+=item C<void Parrot_pcc_trace_flags_on(PARROT_INTERP, PMC *ctx, UINTVAL flags)>
+
+Set trace flags.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_trace_flags_on(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+{
+ ASSERT_ARGS(Parrot_pcc_trace_flags_on)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->trace_flags |= flags;
+}
+
+
+/*
+
+=item C<void Parrot_pcc_trace_flags_off(PARROT_INTERP, PMC *ctx, UINTVAL flags)>
+
+Clear trace flags.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pcc_trace_flags_off(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+{
+ ASSERT_ARGS(Parrot_pcc_trace_flags_off)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ c->trace_flags &= ~flags;
+}
+
+
+/*
+
+=item C<UINTVAL Parrot_pcc_trace_flags_test(PARROT_INTERP, PMC *ctx, UINTVAL
+flags)>
+
+Test trace flags.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+UINTVAL
+Parrot_pcc_trace_flags_test(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL flags)
+{
+ ASSERT_ARGS(Parrot_pcc_trace_flags_test)
+ Parrot_Context *c = Parrot_pcc_get_context_struct(interp, ctx);
+ return c->trace_flags & flags;
+}
+
+/*
+
+=back
+
+*/
+
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/kill_parrot_cont/src/call/ops.c
==============================================================================
--- branches/kill_parrot_cont/src/call/ops.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/call/ops.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -28,7 +28,7 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
-static Parrot_Context * runops_args(PARROT_INTERP,
+static PMC * runops_args(PARROT_INTERP,
ARGIN(PMC *sub),
ARGIN_NULLOK(PMC *obj),
SHIM(STRING *meth),
@@ -134,7 +134,7 @@
/*
-=item C<Parrot_Context * Parrot_runops_fromc(PARROT_INTERP, PMC *sub)>
+=item C<PMC * Parrot_runops_fromc(PARROT_INTERP, PMC *sub)>
Runs the Parrot ops, called from C code. The function arguments are
already setup according to Parrot calling conventions, the C<sub> argument
@@ -147,12 +147,12 @@
PARROT_EXPORT
PARROT_IGNORABLE_RESULT
PARROT_CANNOT_RETURN_NULL
-Parrot_Context *
+PMC *
Parrot_runops_fromc(PARROT_INTERP, ARGIN(PMC *sub))
{
ASSERT_ARGS(Parrot_runops_fromc)
opcode_t offset, *dest;
- Parrot_Context *ctx;
+ PMC *ctx;
/* we need one return continuation with a NULL offset */
PMC * const ret_c = new_ret_continuation_pmc(interp, NULL);
@@ -169,7 +169,7 @@
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"Subroutine returned a NULL address");
- ctx = CONTEXT(interp);
+ ctx = CURRENT_CONTEXT(interp);
offset = dest - interp->code->base.data;
runops(interp, offset);
return ctx;
@@ -178,8 +178,8 @@
/*
-=item C<static Parrot_Context * runops_args(PARROT_INTERP, PMC *sub, PMC *obj,
-STRING *meth, const char *sig, va_list ap)>
+=item C<static PMC * runops_args(PARROT_INTERP, PMC *sub, PMC *obj, STRING
+*meth, const char *sig, va_list ap)>
Calls the PMC subroutine C<sub> with optional name C<meth>. If PMC object
C<obj> is provided, the call is treated as a method call on that object.
@@ -202,17 +202,17 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
-static Parrot_Context *
+static PMC *
runops_args(PARROT_INTERP, ARGIN(PMC *sub), ARGIN_NULLOK(PMC *obj),
SHIM(STRING *meth), ARGIN(const char *sig), va_list ap)
{
ASSERT_ARGS(runops_args)
opcode_t offset, *dest;
- Parrot_Context *ctx;
+ PMC *ctx;
char new_sig[10];
const char *sig_p;
- Parrot_Context * const old_ctx = CONTEXT(interp);
+ PMC * const old_ctx = CURRENT_CONTEXT(interp);
interp->current_cont = new_ret_continuation_pmc(interp, NULL);
interp->current_object = obj;
@@ -264,7 +264,7 @@
"no get_params in sub");
*/
- ctx = Parrot_context_ref(interp, CONTEXT(interp));
+ ctx = CURRENT_CONTEXT(interp);
offset = dest - interp->code->base.data;
runops(interp, offset);
return ctx;
@@ -293,7 +293,7 @@
Parrot_run_meth_fromc(PARROT_INTERP, ARGIN(PMC *sub), ARGIN_NULLOK(PMC *obj), SHIM(STRING *meth))
{
ASSERT_ARGS(Parrot_run_meth_fromc)
- Parrot_Context *ctx;
+ PMC *ctx;
opcode_t offset, *dest;
interp->current_cont = new_ret_continuation_pmc(interp, NULL);
@@ -304,7 +304,7 @@
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"Subroutine returned a NULL address");
- ctx = CONTEXT(interp);
+ ctx = CURRENT_CONTEXT(interp);
offset = dest - interp->code->base.data;
runops(interp, offset);
return set_retval(interp, 0, ctx);
@@ -331,14 +331,13 @@
{
ASSERT_ARGS(Parrot_runops_fromc_args)
va_list args;
- Parrot_Context *ctx;
+ PMC *ctx;
PMC *retval;
va_start(args, sig);
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
retval = (PMC *)set_retval(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
@@ -364,7 +363,7 @@
{
ASSERT_ARGS(Parrot_runops_fromc_args_event)
va_list args;
- Parrot_Context *ctx;
+ PMC *ctx;
void *retval;
/*
* running code from event handlers isn't fully reentrant due to
@@ -380,7 +379,6 @@
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
retval = set_retval(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
interp->current_args = cargs;
interp->current_params = params;
@@ -410,14 +408,13 @@
{
ASSERT_ARGS(Parrot_runops_fromc_args_reti)
va_list args;
- Parrot_Context *ctx;
+ PMC *ctx;
INTVAL retval;
va_start(args, sig);
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
retval = set_retval_i(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
@@ -441,15 +438,14 @@
ARGIN(const char *sig), ...)
{
ASSERT_ARGS(Parrot_runops_fromc_args_retf)
- va_list args;
- Parrot_Context *ctx;
+ va_list args;
+ PMC *ctx;
FLOATVAL retval;
va_start(args, sig);
ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
va_end(args);
retval = set_retval_f(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
@@ -475,14 +471,13 @@
{
ASSERT_ARGS(Parrot_run_meth_fromc_args)
va_list args;
- Parrot_Context *ctx;
- void* retval;
+ PMC *ctx;
+ void *retval;
va_start(args, sig);
ctx = runops_args(interp, sub, obj, meth, sig, args);
va_end(args);
retval = set_retval(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
@@ -507,14 +502,13 @@
{
ASSERT_ARGS(Parrot_run_meth_fromc_args_reti)
va_list args;
- Parrot_Context *ctx;
- INTVAL retval;
+ PMC *ctx;
+ INTVAL retval;
va_start(args, sig);
ctx = runops_args(interp, sub, obj, meth, sig, args);
va_end(args);
retval = set_retval_i(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
@@ -539,14 +533,13 @@
{
ASSERT_ARGS(Parrot_run_meth_fromc_args_retf)
va_list args;
- Parrot_Context *ctx;
+ PMC *ctx;
FLOATVAL retval;
va_start(args, sig);
ctx = runops_args(interp, sub, obj, meth, sig, args);
va_end(args);
retval = set_retval_f(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
@@ -571,10 +564,9 @@
ARGIN(const char *sig), va_list args)
{
ASSERT_ARGS(Parrot_runops_fromc_arglist)
- Parrot_Context * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
+ PMC * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
void * const retval = set_retval(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
@@ -598,10 +590,9 @@
ARGIN(const char *sig), va_list args)
{
ASSERT_ARGS(Parrot_runops_fromc_arglist_reti)
- Parrot_Context * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
+ PMC * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
const INTVAL retval = set_retval_i(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
@@ -625,10 +616,9 @@
ARGIN(const char *sig), va_list args)
{
ASSERT_ARGS(Parrot_runops_fromc_arglist_retf)
- Parrot_Context * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
+ PMC * const ctx = runops_args(interp, sub, PMCNULL, NULL, sig, args);
const FLOATVAL retval = set_retval_f(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
@@ -653,10 +643,9 @@
ARGIN(STRING *meth), ARGIN(const char *sig), va_list args)
{
ASSERT_ARGS(Parrot_run_meth_fromc_arglist)
- Parrot_Context * const ctx = runops_args(interp, sub, obj, meth, sig, args);
+ PMC * const ctx = runops_args(interp, sub, obj, meth, sig, args);
void * const retval = set_retval(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
@@ -682,10 +671,9 @@
ARGIN(STRING *meth), ARGIN(const char *sig), va_list args)
{
ASSERT_ARGS(Parrot_run_meth_fromc_arglist_reti)
- Parrot_Context * const ctx = runops_args(interp, sub, obj, meth, sig, args);
+ PMC * const ctx = runops_args(interp, sub, obj, meth, sig, args);
const INTVAL retval = set_retval_i(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
@@ -710,10 +698,9 @@
ARGIN(STRING *meth), ARGIN(const char *sig), va_list args)
{
ASSERT_ARGS(Parrot_run_meth_fromc_arglist_retf)
- Parrot_Context * const ctx = runops_args(interp, sub, obj, meth, sig, args);
+ PMC * const ctx = runops_args(interp, sub, obj, meth, sig, args);
const FLOATVAL retval = set_retval_f(interp, *sig, ctx);
- Parrot_free_context(interp, ctx, 1);
return retval;
}
Modified: branches/kill_parrot_cont/src/call/pcc.c
==============================================================================
--- branches/kill_parrot_cont/src/call/pcc.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/call/pcc.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -52,7 +52,7 @@
int seen_arrow,
ARGIN(PMC * const *sigs),
ARGMOD(opcode_t **indexes),
- ARGMOD(Parrot_Context *ctx),
+ ARGMOD(PMC *ctx),
ARGIN_NULLOK(PMC *pmc),
ARGIN(va_list *list))
__attribute__nonnull__(1)
@@ -72,7 +72,7 @@
int seen_arrow,
ARGIN(PMC * const *sigs),
ARGMOD(opcode_t **indexes),
- ARGMOD(Parrot_Context *ctx),
+ ARGMOD(PMC *ctx),
ARGIN(PMC *sig_obj))
__attribute__nonnull__(1)
__attribute__nonnull__(4)
@@ -105,7 +105,7 @@
FUNC_MODIFIES(*st);
PARROT_CANNOT_RETURN_NULL
-static Parrot_Context * count_signature_elements(PARROT_INTERP,
+static PMC * count_signature_elements(PARROT_INTERP,
ARGIN(const char *signature),
ARGMOD(PMC *args_sig),
ARGMOD(PMC *results_sig),
@@ -156,7 +156,7 @@
ARGMOD(INTVAL *n_regs_used),
ARGMOD(PMC **sigs),
ARGMOD(opcode_t **indexes),
- ARGMOD(Parrot_Context *ctx),
+ ARGMOD(PMC *ctx),
ARGMOD(PMC *sig_obj))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
@@ -172,7 +172,7 @@
FUNC_MODIFIES(*sig_obj);
static void set_context_sig_returns(PARROT_INTERP,
- ARGMOD(Parrot_Context *ctx),
+ ARGMOD(PMC *ctx),
ARGMOD(opcode_t **indexes),
ARGIN_NULLOK(const char *ret_x),
ARGMOD(PMC *result_list))
@@ -185,7 +185,7 @@
FUNC_MODIFIES(*result_list);
static void set_context_sig_returns_varargs(PARROT_INTERP,
- ARGMOD(Parrot_Context *ctx),
+ ARGMOD(PMC *ctx),
ARGMOD(opcode_t **indexes),
ARGIN(const char *ret_x),
va_list returns)
@@ -198,7 +198,7 @@
static int set_retval_util(PARROT_INTERP,
ARGIN(const char *sig),
- ARGIN(Parrot_Context *ctx),
+ ARGIN(PMC *ctx),
ARGMOD(call_state *st))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
@@ -214,8 +214,11 @@
__attribute__nonnull__(3)
FUNC_MODIFIES(*st);
-static void store_arg(ARGIN(const call_state *st), INTVAL idx)
- __attribute__nonnull__(1);
+static void store_arg(PARROT_INTERP,
+ ARGIN(const call_state *st),
+ INTVAL idx)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
static void too_few(PARROT_INTERP,
ARGIN(const call_state *st),
@@ -319,7 +322,8 @@
|| PARROT_ASSERT_ARG(st) \
|| PARROT_ASSERT_ARG(p_arg)
#define ASSERT_ARGS_store_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(st)
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(st)
#define ASSERT_ARGS_too_few __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(st) \
@@ -335,16 +339,6 @@
/* Make sure we don't conflict with any other MAX() macros defined elsewhere */
#define PARROT_MAX(a, b) (((a)) > (b) ? (a) : (b))
-#define SAVE_OFF_REGS(orig, next, save) \
- (save).bp = (orig).bp;\
- (save).bp_ps = (orig).bp_ps;\
- (orig).bp = (next).bp;\
- (orig).bp_ps = (next).bp_ps;
-
-#define RESTORE_REGS(orig, save) \
- (orig).bp = (save).bp;\
- (orig).bp_ps = (save).bp_ps;
-
/*
=item C<PMC* Parrot_pcc_build_sig_object_from_varargs(PARROT_INTERP, PMC* obj,
@@ -484,13 +478,13 @@
init_call_stats(st);
if (PMC_IS_NULL(interp->args_signature))
- Parrot_init_arg_op(interp, CONTEXT(interp), interp->current_args,
+ Parrot_init_arg_op(interp, CURRENT_CONTEXT(interp), interp->current_args,
&st->src);
else
- Parrot_init_arg_indexes_and_sig_pmc(interp, CONTEXT(interp),
+ Parrot_init_arg_indexes_and_sig_pmc(interp, CURRENT_CONTEXT(interp),
interp->current_args, interp->args_signature, &st->src);
- Parrot_init_arg_sig(interp, CONTEXT(interp), sig, NULL, &st->dest);
+ Parrot_init_arg_sig(interp, CURRENT_CONTEXT(interp), sig, NULL, &st->dest);
}
@@ -511,8 +505,8 @@
Parrot_init_ret_nci(PARROT_INTERP, ARGOUT(call_state *st), ARGIN(const char *sig))
{
ASSERT_ARGS(Parrot_init_ret_nci)
- Parrot_Context *ctx = CONTEXT(interp);
- PMC * const current_cont = ctx->current_cont;
+ PMC *ctx = CURRENT_CONTEXT(interp);
+ PMC * const current_cont = Parrot_pcc_get_continuation(interp, ctx);
/* if this NCI call was a taicall, return results to caller's get_results
* this also means that we pass the caller's register base pointer */
@@ -520,23 +514,24 @@
ctx = PARROT_CONTINUATION(current_cont)->to_ctx;
/* TODO simplify all */
- Parrot_init_arg_sig(interp, CONTEXT(interp), sig, NULL, &st->src);
+ Parrot_init_arg_sig(interp, CURRENT_CONTEXT(interp), sig, NULL, &st->src);
/* Non-constant signatures are stored in ctx->results_signature instead of
* in the constants table. */
- if (ctx->results_signature)
+ if (Parrot_pcc_get_results_signature(interp, ctx))
Parrot_init_arg_indexes_and_sig_pmc(interp, ctx,
- ctx->current_results, ctx->results_signature, &st->dest);
+ Parrot_pcc_get_results(interp, ctx),
+ Parrot_pcc_get_results_signature(interp, ctx), &st->dest);
else
- Parrot_init_arg_op(interp, ctx, ctx->current_results, &st->dest);
+ Parrot_init_arg_op(interp, ctx, Parrot_pcc_get_results(interp, ctx), &st->dest);
}
/*
-=item C<int Parrot_init_arg_indexes_and_sig_pmc(PARROT_INTERP, Parrot_Context
-*ctx, opcode_t *indexes, PMC *sig_pmc, call_state_item *sti)>
+=item C<int Parrot_init_arg_indexes_and_sig_pmc(PARROT_INTERP, PMC *ctx,
+opcode_t *indexes, PMC *sig_pmc, call_state_item *sti)>
Initializes argument transfer with given context registers, register indexes,
and a signature PMC.
@@ -552,14 +547,14 @@
PARROT_EXPORT
int
-Parrot_init_arg_indexes_and_sig_pmc(PARROT_INTERP, ARGIN(Parrot_Context *ctx),
+Parrot_init_arg_indexes_and_sig_pmc(PARROT_INTERP, ARGIN(PMC *ctx),
ARGIN_NULLOK(opcode_t *indexes), ARGIN_NULLOK(PMC *sig_pmc),
ARGMOD(call_state_item *sti))
{
ASSERT_ARGS(Parrot_init_arg_indexes_and_sig_pmc)
- if (!sig_pmc && indexes) {
+ if (PMC_IS_NULL(sig_pmc) && indexes) {
++indexes;
- sig_pmc = ctx->constants[*indexes]->u.key;
+ sig_pmc = Parrot_pcc_get_pmc_constant(interp, ctx, *indexes);
ASSERT_SIG_PMC(sig_pmc);
++indexes;
}
@@ -589,7 +584,7 @@
/*
-=item C<int Parrot_init_arg_op(PARROT_INTERP, Parrot_Context *ctx, opcode_t *pc,
+=item C<int Parrot_init_arg_op(PARROT_INTERP, PMC *ctx, opcode_t *pc,
call_state_item *sti)>
Initializes argument transfer with given context registers and opcode location
@@ -601,7 +596,7 @@
PARROT_EXPORT
int
-Parrot_init_arg_op(PARROT_INTERP, ARGIN(Parrot_Context *ctx),
+Parrot_init_arg_op(PARROT_INTERP, ARGIN(PMC *ctx),
ARGIN_NULLOK(opcode_t *pc), ARGIN(call_state_item *sti))
{
ASSERT_ARGS(Parrot_init_arg_op)
@@ -609,7 +604,7 @@
if (pc) {
++pc;
- sig_pmc = ctx->constants[*pc]->u.key;
+ sig_pmc = Parrot_pcc_get_pmc_constant(interp, ctx, *pc);
ASSERT_SIG_PMC(sig_pmc);
++pc;
}
@@ -620,8 +615,8 @@
/*
-=item C<int Parrot_init_arg_sig(PARROT_INTERP, Parrot_Context *ctx, const char
-*sig, void *ap, call_state_item *sti)>
+=item C<int Parrot_init_arg_sig(PARROT_INTERP, PMC *ctx, const char *sig, void
+*ap, call_state_item *sti)>
Initializes argument transfer with given code segment (holding the
const_table), registers, function signature, and arguments.
@@ -632,7 +627,7 @@
PARROT_EXPORT
int
-Parrot_init_arg_sig(PARROT_INTERP, ARGIN(Parrot_Context *ctx),
+Parrot_init_arg_sig(PARROT_INTERP, ARGIN(PMC *ctx),
ARGIN(const char *sig), ARGIN_NULLOK(void *ap),
ARGMOD(call_state_item *sti))
{
@@ -775,7 +770,7 @@
break;
case PARROT_ARG_PMC:
if (st->src.u.sig.sig[st->src.i] == 'O')
- UVal_pmc(st->val) = CONTEXT(interp)->current_object;
+ UVal_pmc(st->val) = Parrot_pcc_get_object(interp, CURRENT_CONTEXT(interp));
else {
UVal_pmc(st->val) = va_arg(*ap, PMC *);
}
@@ -831,18 +826,18 @@
/* ensure that callees don't modify constant caller strings */
if (constant)
UVal_str(st->val) = Parrot_str_new_COW(interp,
- st->src.ctx->constants[idx]->u.string);
+ Parrot_pcc_get_string_constant(interp, st->src.ctx, idx));
else
UVal_str(st->val) = CTX_REG_STR(st->src.ctx, idx);
break;
}
case PARROT_ARG_FLOATVAL:
- UVal_num(st->val) = constant ? st->src.ctx->constants[idx]->u.number
+ UVal_num(st->val) = constant ? Parrot_pcc_get_num_constant(interp, st->src.ctx, idx)
: CTX_REG_NUM(st->src.ctx, idx);
break;
case PARROT_ARG_PMC:
- UVal_pmc(st->val) = constant ? st->src.ctx->constants[idx]->u.key
+ UVal_pmc(st->val) = constant ? Parrot_pcc_get_pmc_constant(interp, st->src.ctx, idx)
: CTX_REG_PMC(st->src.ctx, idx);
if (st->src.sig & PARROT_ARG_FLATTEN) {
@@ -1199,12 +1194,23 @@
for (; key; key = VTABLE_shift_pmc(interp, key)) {
/* register keys have to be cloned */
if (PObj_get_FLAGS(key) & KEY_register_FLAG) {
- Parrot_Context temp_ctx;
+ Regs_ni bp;
+ Regs_ps bp_ps;
/* clone sets key values according to refered register items */
- SAVE_OFF_REGS(interp->ctx, (*(st->src.ctx)), temp_ctx)
+ bp = *Parrot_pcc_get_regs_ni(interp, CURRENT_CONTEXT(interp));
+ bp_ps = *Parrot_pcc_get_regs_ps(interp, CURRENT_CONTEXT(interp));
+
+ Parrot_pcc_set_regs_ni(interp, CURRENT_CONTEXT(interp),
+ Parrot_pcc_get_regs_ni(interp, st->src.ctx));
+ Parrot_pcc_set_regs_ps(interp, CURRENT_CONTEXT(interp),
+ Parrot_pcc_get_regs_ps(interp, st->src.ctx));
+
UVal_pmc(st->val) = VTABLE_clone(interp, key);
- RESTORE_REGS(interp->ctx, temp_ctx)
+
+ Parrot_pcc_set_regs_ni(interp, CURRENT_CONTEXT(interp), &bp);
+ Parrot_pcc_set_regs_ps(interp, CURRENT_CONTEXT(interp), &bp_ps);
+
return;
}
}
@@ -1308,7 +1314,7 @@
n_named++;
idx = st->dest.u.op.pc[i];
param = PARROT_ARG_CONSTANT_ISSET(st->dest.sig)
- ? st->dest.ctx->constants[idx]->u.string
+ ? Parrot_pcc_get_string_constant(interp, st->dest.ctx, idx)
: CTX_REG_STR(st->dest.ctx, idx);
if (st->name == param || Parrot_str_equal(interp, st->name, param)) {
@@ -1334,7 +1340,7 @@
/*
-=item C<static void store_arg(const call_state *st, INTVAL idx)>
+=item C<static void store_arg(PARROT_INTERP, const call_state *st, INTVAL idx)>
Stores the next argument in the destination register appropriately.
@@ -1343,7 +1349,7 @@
*/
static void
-store_arg(ARGIN(const call_state *st), INTVAL idx)
+store_arg(PARROT_INTERP, ARGIN(const call_state *st), INTVAL idx)
{
ASSERT_ARGS(store_arg)
switch (st->dest.sig & PARROT_ARG_TYPE_MASK) {
@@ -1379,7 +1385,7 @@
PARROT_EXPORT
int
-Parrot_store_arg(SHIM_INTERP, ARGIN(const call_state *st))
+Parrot_store_arg(PARROT_INTERP, ARGIN(const call_state *st))
{
ASSERT_ARGS(Parrot_store_arg)
INTVAL idx;
@@ -1389,7 +1395,7 @@
PARROT_ASSERT(st->dest.mode & CALL_STATE_OP);
idx = st->dest.u.op.pc[st->dest.i];
PARROT_ASSERT(idx >= 0);
- store_arg(st, idx);
+ store_arg(interp, st, idx);
return 1;
}
@@ -1544,7 +1550,7 @@
INTVAL idx;
null_val(arg_sig, st);
idx = st->dest.u.op.pc[i];
- store_arg(st, idx);
+ store_arg(interp, st, idx);
/* Don't walk off the end of the array */
if (i+1 >= st->dest.n)
@@ -1561,7 +1567,7 @@
else {
const INTVAL idx = st->dest.u.op.pc[last_name_pos];
STRING * const param = PARROT_ARG_CONSTANT_ISSET(sig)
- ? st->dest.ctx->constants[idx]->u.string
+ ? Parrot_pcc_get_string_constant(interp, st->dest.ctx, idx)
: CTX_REG_STR(st->dest.ctx, idx);
Parrot_ex_throw_from_c_args(interp, NULL,
@@ -1673,7 +1679,7 @@
/* actually store the argument */
idx = st->dest.u.op.pc[st->dest.i];
PARROT_ASSERT(idx >= 0);
- store_arg(st, idx);
+ store_arg(interp, st, idx);
check_for_opt_flag(interp, st, 0);
@@ -1718,7 +1724,7 @@
/* actually store the argument */
idx = st->dest.u.op.pc[st->dest.i];
PARROT_ASSERT(idx >= 0);
- store_arg(st, idx);
+ store_arg(interp, st, idx);
/* if we're at an :optional argument, check for an :opt_flag */
if (dest->sig & PARROT_ARG_OPTIONAL)
@@ -1843,9 +1849,8 @@
/*
-=item C<void parrot_pass_args(PARROT_INTERP, Parrot_Context *src_ctx,
-Parrot_Context *dest_ctx, opcode_t *src_indexes, opcode_t *dest_indexes,
-arg_pass_t param_or_result)>
+=item C<void parrot_pass_args(PARROT_INTERP, PMC *src_ctx, PMC *dest_ctx,
+opcode_t *src_indexes, opcode_t *dest_indexes, arg_pass_t param_or_result)>
Main argument passing routine.
@@ -1865,7 +1870,7 @@
PARROT_EXPORT
void
parrot_pass_args(PARROT_INTERP,
- ARGMOD(Parrot_Context *src_ctx), ARGMOD(Parrot_Context *dest_ctx),
+ ARGMOD(PMC *src_ctx), ARGMOD(PMC *dest_ctx),
ARGMOD_NULLOK(opcode_t *src_indexes), ARGMOD_NULLOK(opcode_t *dest_indexes),
arg_pass_t param_or_result)
{
@@ -1881,9 +1886,9 @@
}
else /* (param_or_result == PARROT_PASS_RESULTS) */ {
src_signature = interp->returns_signature;
- dest_signature = dest_ctx->results_signature;
+ dest_signature = Parrot_pcc_get_results_signature(interp, dest_ctx);
interp->returns_signature = NULL;
- dest_ctx->results_signature = NULL;
+ Parrot_pcc_set_results_signature(interp, dest_ctx, NULL);
}
memset(&st, 0, sizeof st);
@@ -1904,7 +1909,7 @@
/*
=item C<opcode_t * parrot_pass_args_fromc(PARROT_INTERP, const char *sig,
-opcode_t *dest, Parrot_Context *old_ctxp, va_list ap)>
+opcode_t *dest, PMC *old_ctxp, va_list ap)>
Passes arguments from C code with given signature to a Parrot Sub.
Prerequisites are like above.
@@ -1917,12 +1922,12 @@
PARROT_WARN_UNUSED_RESULT
opcode_t *
parrot_pass_args_fromc(PARROT_INTERP, ARGIN(const char *sig),
- ARGMOD(opcode_t *dest), ARGIN(Parrot_Context *old_ctxp), va_list ap)
+ ARGMOD(opcode_t *dest), ARGIN(PMC *old_ctxp), va_list ap)
{
ASSERT_ARGS(parrot_pass_args_fromc)
call_state st;
- Parrot_init_arg_op(interp, CONTEXT(interp), dest, &st.dest);
+ Parrot_init_arg_op(interp, CURRENT_CONTEXT(interp), dest, &st.dest);
Parrot_init_arg_sig(interp, old_ctxp, sig, PARROT_VA_TO_VAPTR(ap), &st.src);
Parrot_process_args(interp, &st, PARROT_PASS_PARAMS);
return dest + st.dest.n + 2;
@@ -1931,8 +1936,8 @@
/*
-=item C<static int set_retval_util(PARROT_INTERP, const char *sig,
-Parrot_Context *ctx, call_state *st)>
+=item C<static int set_retval_util(PARROT_INTERP, const char *sig, PMC *ctx,
+call_state *st)>
Adds the current return parameter to the current context, and fetches
the next return parameter from the call state object.
@@ -1943,7 +1948,7 @@
static int
set_retval_util(PARROT_INTERP, ARGIN(const char *sig),
- ARGIN(Parrot_Context *ctx), ARGMOD(call_state *st))
+ ARGIN(PMC *ctx), ARGMOD(call_state *st))
{
ASSERT_ARGS(set_retval_util)
opcode_t * const src_pc = interp->current_returns;
@@ -1952,7 +1957,7 @@
interp->current_returns = NULL;
if (todo) {
- todo = Parrot_init_arg_sig(interp, CONTEXT(interp), sig, NULL,
+ todo = Parrot_init_arg_sig(interp, CURRENT_CONTEXT(interp), sig, NULL,
&st->dest);
if (todo) {
@@ -1968,7 +1973,7 @@
/*
-=item C<void * set_retval(PARROT_INTERP, int sig_ret, Parrot_Context *ctx)>
+=item C<void * set_retval(PARROT_INTERP, int sig_ret, PMC *ctx)>
Handles void and pointer (PMC *, STRING *) return values. Returns a PMC,
STRING, or NULL pointer as appropriate.
@@ -1980,7 +1985,7 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
void *
-set_retval(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
+set_retval(PARROT_INTERP, int sig_ret, ARGIN(PMC *ctx))
{
ASSERT_ARGS(set_retval)
call_state st;
@@ -2005,7 +2010,7 @@
/*
-=item C<INTVAL set_retval_i(PARROT_INTERP, int sig_ret, Parrot_Context *ctx)>
+=item C<INTVAL set_retval_i(PARROT_INTERP, int sig_ret, PMC *ctx)>
Handles an INTVAL return value, returning its value if present and 0 otherwise.
@@ -2014,7 +2019,7 @@
*/
INTVAL
-set_retval_i(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
+set_retval_i(PARROT_INTERP, int sig_ret, ARGIN(PMC *ctx))
{
ASSERT_ARGS(set_retval_i)
call_state st;
@@ -2032,7 +2037,7 @@
/*
-=item C<FLOATVAL set_retval_f(PARROT_INTERP, int sig_ret, Parrot_Context *ctx)>
+=item C<FLOATVAL set_retval_f(PARROT_INTERP, int sig_ret, PMC *ctx)>
Handles a FLOATVAL return value, returning its value if present and 0.0
otherwise.
@@ -2042,7 +2047,7 @@
*/
FLOATVAL
-set_retval_f(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
+set_retval_f(PARROT_INTERP, int sig_ret, ARGIN(PMC *ctx))
{
ASSERT_ARGS(set_retval_f)
call_state st;
@@ -2060,7 +2065,7 @@
/*
-=item C<STRING* set_retval_s(PARROT_INTERP, int sig_ret, Parrot_Context *ctx)>
+=item C<STRING* set_retval_s(PARROT_INTERP, int sig_ret, PMC *ctx)>
Handles a STRING return value, returning its pointer if present and NULL
otherwise.
@@ -2072,7 +2077,7 @@
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
STRING*
-set_retval_s(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
+set_retval_s(PARROT_INTERP, int sig_ret, ARGIN(PMC *ctx))
{
ASSERT_ARGS(set_retval_s)
call_state st;
@@ -2090,7 +2095,7 @@
/*
-=item C<PMC* set_retval_p(PARROT_INTERP, int sig_ret, Parrot_Context *ctx)>
+=item C<PMC* set_retval_p(PARROT_INTERP, int sig_ret, PMC *ctx)>
Handles a PMC return value, returning the PMC pointer if present and NULL
otherwise.
@@ -2102,7 +2107,7 @@
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
PMC*
-set_retval_p(PARROT_INTERP, int sig_ret, ARGIN(Parrot_Context *ctx))
+set_retval_p(PARROT_INTERP, int sig_ret, ARGIN(PMC *ctx))
{
ASSERT_ARGS(set_retval_p)
call_state st;
@@ -2121,8 +2126,8 @@
/*
=item C<static void commit_last_arg(PARROT_INTERP, int index, int cur, opcode_t
-*n_regs_used, int seen_arrow, PMC * const *sigs, opcode_t **indexes,
-Parrot_Context *ctx, PMC *pmc, va_list *list)>
+*n_regs_used, int seen_arrow, PMC * const *sigs, opcode_t **indexes, PMC *ctx,
+PMC *pmc, va_list *list)>
Called by C<Parrot_PCCINVOKE> when it reaches the end of each arg in the arg
signature. See C<Parrot_PCCINVOKE> for signature syntax.
@@ -2134,7 +2139,7 @@
static void
commit_last_arg(PARROT_INTERP, int index, int cur,
ARGMOD(opcode_t *n_regs_used), int seen_arrow, ARGIN(PMC * const *sigs),
- ARGMOD(opcode_t **indexes), ARGMOD(Parrot_Context *ctx),
+ ARGMOD(opcode_t **indexes), ARGMOD(PMC *ctx),
ARGIN_NULLOK(PMC *pmc), ARGIN(va_list *list))
{
ASSERT_ARGS(commit_last_arg)
@@ -2187,8 +2192,8 @@
/*
-=item C<static Parrot_Context * count_signature_elements(PARROT_INTERP, const
-char *signature, PMC *args_sig, PMC *results_sig, int flag)>
+=item C<static PMC * count_signature_elements(PARROT_INTERP, const char
+*signature, PMC *args_sig, PMC *results_sig, int flag)>
Counts the number of each type of register in a signature object. Returns
the total number of parameter arguments, the total number of result
@@ -2200,7 +2205,7 @@
*/
PARROT_CANNOT_RETURN_NULL
-static Parrot_Context *
+static PMC *
count_signature_elements(PARROT_INTERP, ARGIN(const char *signature),
ARGMOD(PMC *args_sig), ARGMOD(PMC *results_sig), int flag)
{
@@ -2300,7 +2305,7 @@
=item C<static void commit_last_arg_sig_object(PARROT_INTERP, int index, int
cur, opcode_t *n_regs_used, int seen_arrow, PMC * const *sigs, opcode_t
-**indexes, Parrot_Context *ctx, PMC *sig_obj)>
+**indexes, PMC *ctx, PMC *sig_obj)>
Called by Parrot_pcc_invoke_from_sig_object when it reaches the end of each
arg in the arg signature. See C<Parrot_pcc_invoke_from_sig_object> for
@@ -2313,7 +2318,7 @@
static void
commit_last_arg_sig_object(PARROT_INTERP, int index, int cur,
ARGMOD(opcode_t *n_regs_used), int seen_arrow, ARGIN(PMC * const *sigs),
- ARGMOD(opcode_t **indexes), ARGMOD(Parrot_Context *ctx),
+ ARGMOD(opcode_t **indexes), ARGMOD(PMC *ctx),
ARGIN(PMC *sig_obj))
{
ASSERT_ARGS(commit_last_arg_sig_object)
@@ -2384,8 +2389,8 @@
/*
-=item C<static void set_context_sig_returns(PARROT_INTERP, Parrot_Context *ctx,
-opcode_t **indexes, const char *ret_x, PMC *result_list)>
+=item C<static void set_context_sig_returns(PARROT_INTERP, PMC *ctx, opcode_t
+**indexes, const char *ret_x, PMC *result_list)>
Sets the subroutine return arguments in the context C<ctx>. Takes a C string
for the return signature C<ret_x> and a list of return parameters C<result_list>.
@@ -2396,7 +2401,7 @@
static void
set_context_sig_returns(PARROT_INTERP,
- ARGMOD(Parrot_Context *ctx), ARGMOD(opcode_t **indexes),
+ ARGMOD(PMC *ctx), ARGMOD(opcode_t **indexes),
ARGIN_NULLOK(const char *ret_x), ARGMOD(PMC *result_list))
{
ASSERT_ARGS(set_context_sig_returns)
@@ -2453,8 +2458,8 @@
/*
-=item C<static void set_context_sig_returns_varargs(PARROT_INTERP,
-Parrot_Context *ctx, opcode_t **indexes, const char *ret_x, va_list returns)>
+=item C<static void set_context_sig_returns_varargs(PARROT_INTERP, PMC *ctx,
+opcode_t **indexes, const char *ret_x, va_list returns)>
Sets the subroutine return arguments in the context C<ctx>. Takes a C string
for the return signature C<ret_x> and a varargs list of return parameters C<returns>.
@@ -2469,7 +2474,7 @@
*/
static void
-set_context_sig_returns_varargs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx),
+set_context_sig_returns_varargs(PARROT_INTERP, ARGMOD(PMC *ctx),
ARGMOD(opcode_t **indexes), ARGIN(const char *ret_x), va_list returns)
{
ASSERT_ARGS(set_context_sig_returns_varargs)
@@ -2519,8 +2524,8 @@
/*
=item C<static const char * set_context_sig_params(PARROT_INTERP, const char
-*signature, INTVAL *n_regs_used, PMC **sigs, opcode_t **indexes, Parrot_Context
-*ctx, PMC *sig_obj)>
+*signature, INTVAL *n_regs_used, PMC **sigs, opcode_t **indexes, PMC *ctx, PMC
+*sig_obj)>
Sets the subroutine arguments in the C<ctx> context, according to the
signature string C<signature>. Currently this function is only called
@@ -2537,7 +2542,7 @@
static const char *
set_context_sig_params(PARROT_INTERP, ARGIN(const char *signature),
ARGMOD(INTVAL *n_regs_used), ARGMOD(PMC **sigs),
- ARGMOD(opcode_t **indexes), ARGMOD(Parrot_Context *ctx),
+ ARGMOD(opcode_t **indexes), ARGMOD(PMC *ctx),
ARGMOD(PMC *sig_obj))
{
ASSERT_ARGS(set_context_sig_params)
@@ -2621,8 +2626,8 @@
interp->current_args = indexes[0];
interp->args_signature = sigs[0];
- ctx->current_results = indexes[1];
- ctx->results_signature = sigs[1];
+ Parrot_pcc_set_results(interp, ctx, indexes[1]);
+ Parrot_pcc_set_results_signature(interp, ctx, sigs[1]);
return ret_x;
}
@@ -2731,12 +2736,12 @@
PMC * const results_sig = pmc_new(interp, enum_class_FixedIntegerArray);
PMC * const ret_cont = new_ret_continuation_pmc(interp, NULL);
- Parrot_Context *ctx; /* The newly created context */
- PMC *pccinvoke_meth;
+ PMC *ctx; /* The newly created context */
+ PMC *pccinvoke_meth;
- opcode_t *save_current_args;
- PMC *save_args_signature;
- PMC *save_current_object;
+ opcode_t *save_current_args;
+ PMC *save_args_signature;
+ PMC *save_current_object;
/* temporary state vars for building PCC index and PCC signature arrays. */
@@ -2856,15 +2861,16 @@
interp->current_args = arg_indexes;
interp->args_signature = args_sig;
- ctx->current_results = result_indexes;
- ctx->results_signature = results_sig;
+ Parrot_pcc_set_results(interp, ctx, result_indexes);
+ Parrot_pcc_set_results_signature(interp, ctx, results_sig);
/* arg_accessors assigned in loop above */
interp->current_object = pmc;
interp->current_cont = NEED_CONTINUATION;
- ctx->current_cont = ret_cont;
- PARROT_CONTINUATION(ret_cont)->from_ctx = Parrot_context_ref(interp, ctx);
+ Parrot_pcc_set_continuation(interp, ctx, ret_cont);
+ PARROT_CONTINUATION(ret_cont)->from_ctx = ctx;
+
pccinvoke_meth = VTABLE_find_method(interp, pmc, method_name);
if (PMC_IS_NULL(pccinvoke_meth))
@@ -2961,11 +2967,11 @@
PMC * const ret_cont = new_ret_continuation_pmc(interp, NULL);
PMC * const result_list = VTABLE_get_attr_str(interp, sig_obj, CONST_STRING(interp, "returns"));
- Parrot_Context *ctx;
- opcode_t *dest;
- opcode_t *save_current_args;
- PMC *save_args_signature;
- PMC *save_current_object;
+ PMC *ctx;
+ opcode_t *dest;
+ opcode_t *save_current_args;
+ PMC *save_args_signature;
+ PMC *save_current_object;
/* temporary state vars for building PCC index and PCC signature arrays. */
@@ -3005,9 +3011,10 @@
else {
interp->current_object = PMCNULL;
}
- interp->current_cont = NEED_CONTINUATION;
- ctx->current_cont = ret_cont;
- PARROT_CONTINUATION(ret_cont)->from_ctx = Parrot_context_ref(interp, ctx);
+
+ interp->current_cont = NEED_CONTINUATION;
+ Parrot_pcc_set_continuation(interp, ctx, ret_cont);
+ PARROT_CONTINUATION(ret_cont)->from_ctx = ctx;
/* Invoke the function */
dest = VTABLE_invoke(interp, sub_obj, NULL);
Modified: branches/kill_parrot_cont/src/debug.c
==============================================================================
--- branches/kill_parrot_cont/src/debug.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/debug.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -2211,7 +2211,7 @@
PDB_check_condition(PARROT_INTERP, ARGIN(const PDB_condition_t *condition))
{
ASSERT_ARGS(PDB_check_condition)
- Parrot_Context *ctx = CONTEXT(interp);
+ PMC *ctx = CURRENT_CONTEXT(interp);
TRACEDEB_MSG("PDB_check_condition");
@@ -2219,7 +2219,7 @@
if (condition->type & PDB_cond_int) {
INTVAL i, j;
- if (condition->reg >= ctx->n_regs_used[REGNO_INT])
+ if (condition->reg >= Parrot_pcc_get_regs_used(interp, ctx, REGNO_INT))
return 0;
i = CTX_REG_INT(ctx, condition->reg);
@@ -2241,7 +2241,7 @@
else if (condition->type & PDB_cond_num) {
FLOATVAL k, l;
- if (condition->reg >= ctx->n_regs_used[REGNO_NUM])
+ if (condition->reg >= Parrot_pcc_get_regs_used(interp, ctx, REGNO_NUM))
return 0;
k = CTX_REG_NUM(ctx, condition->reg);
@@ -2263,7 +2263,7 @@
else if (condition->type & PDB_cond_str) {
STRING *m, *n;
- if (condition->reg >= ctx->n_regs_used[REGNO_STR])
+ if (condition->reg >= Parrot_pcc_get_regs_used(interp, ctx, REGNO_STR))
return 0;
m = CTX_REG_STR(ctx, condition->reg);
@@ -2294,7 +2294,7 @@
else if (condition->type & PDB_cond_pmc) {
PMC *m;
- if (condition->reg >= ctx->n_regs_used[REGNO_PMC])
+ if (condition->reg >= Parrot_pcc_get_regs_used(interp, ctx, REGNO_PMC))
return 0;
m = CTX_REG_PMC(ctx, condition->reg);
@@ -3511,8 +3511,8 @@
int rec_level = 0;
/* information about the current sub */
- PMC *sub = interpinfo_p(interp, CURRENT_SUB);
- Parrot_Context *ctx = CONTEXT(interp);
+ PMC *sub = interpinfo_p(interp, CURRENT_SUB);
+ PMC *ctx = CURRENT_CONTEXT(interp);
if (!PMC_IS_NULL(sub)) {
str = Parrot_Context_infostr(interp, ctx);
@@ -3520,7 +3520,7 @@
Parrot_io_eprintf(interp, "%Ss", str);
if (interp->code->annotations) {
PMC *annot = PackFile_Annotations_lookup(interp, interp->code->annotations,
- ctx->current_pc - interp->code->base.data + 1, NULL);
+ Parrot_pcc_get_pc(interp, ctx) - interp->code->base.data + 1, NULL);
if (!PMC_IS_NULL(annot)) {
PMC *pfile = VTABLE_get_pmc_keyed_str(interp, annot,
Parrot_str_new_constant(interp, "file"));
@@ -3540,9 +3540,9 @@
/* backtrace: follow the continuation chain */
while (1) {
Parrot_Continuation_attributes *sub_cont;
- sub = ctx->current_cont;
+ sub = Parrot_pcc_get_continuation(interp, ctx);
- if (!sub)
+ if (PMC_IS_NULL(sub))
break;
sub_cont = PARROT_CONTINUATION(sub);
@@ -3557,10 +3557,10 @@
/* recursion detection */
if (!PMC_IS_NULL(old) && PARROT_CONTINUATION(old) &&
- PARROT_CONTINUATION(old)->to_ctx->current_pc ==
- PARROT_CONTINUATION(sub)->to_ctx->current_pc &&
- PARROT_CONTINUATION(old)->to_ctx->current_sub ==
- PARROT_CONTINUATION(sub)->to_ctx->current_sub) {
+ Parrot_pcc_get_pc(interp, PARROT_CONTINUATION(old)->to_ctx) ==
+ Parrot_pcc_get_pc(interp, PARROT_CONTINUATION(sub)->to_ctx) &&
+ Parrot_pcc_get_sub(interp, PARROT_CONTINUATION(old)->to_ctx) ==
+ Parrot_pcc_get_sub(interp, PARROT_CONTINUATION(sub)->to_ctx)) {
++rec_level;
}
else if (rec_level != 0) {
@@ -3573,7 +3573,9 @@
Parrot_io_eprintf(interp, "%Ss", str);
if (interp->code->annotations) {
PMC *annot = PackFile_Annotations_lookup(interp, interp->code->annotations,
- sub_cont->to_ctx->current_pc - interp->code->base.data + 1, NULL);
+ Parrot_pcc_get_pc(interp, sub_cont->to_ctx) - interp->code->base.data + 1,
+ NULL);
+
if (!PMC_IS_NULL(annot)) {
PMC *pfile = VTABLE_get_pmc_keyed_str(interp, annot,
Parrot_str_new_constant(interp, "file"));
@@ -3632,7 +3634,7 @@
ASSERT_ARGS(GDB_print_reg)
char * string;
- if (n >= 0 && n < CONTEXT(interp)->n_regs_used[t]) {
+ if (n >= 0 && n < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), t)) {
switch (t) {
case REGNO_INT:
return Parrot_str_from_int(interp, IREG(n))->strstart;
@@ -3697,7 +3699,7 @@
}
if (! s[1]) {
/* Print all registers of this type. */
- const int max_reg = CONTEXT(interp)->n_regs_used[t];
+ const int max_reg = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), t);
int n;
for (n = 0; n < max_reg; n++) {
Modified: branches/kill_parrot_cont/src/dynpmc/gdbmhash.pmc
==============================================================================
--- branches/kill_parrot_cont/src/dynpmc/gdbmhash.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/dynpmc/gdbmhash.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -105,7 +105,7 @@
attrs->db_handle = mem_allocate_zeroed_typed(GDBM_FH);
PMC_data(SELF) = attrs;
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
VTABLE void destroy() {
@@ -214,13 +214,16 @@
if (!dbf) return;
keystr = make_hash_key(interp, key);
- key_gdbm.dsize = keystr->strlen;
- key_gdbm.dptr = keystr->strstart;
- val_gdbm.dsize = value->strlen;
- val_gdbm.dptr = value->strstart;
+ key_gdbm.dptr = Parrot_str_to_cstring(interp, keystr);
+ key_gdbm.dsize = strlen(key_gdbm.dptr);
+ val_gdbm.dptr = Parrot_str_to_cstring(interp, value);
+ val_gdbm.dsize = strlen(val_gdbm.dptr);
gdbm_store(dbf, key_gdbm, val_gdbm, GDBM_REPLACE);
+ Parrot_str_free_cstring(key_gdbm.dptr);
+ Parrot_str_free_cstring(val_gdbm.dptr);
+
return;
}
@@ -247,11 +250,12 @@
keystr = make_hash_key(interp, key);
- key_gdbm.dsize = keystr->strlen;
- key_gdbm.dptr = keystr->strstart;
+ key_gdbm.dptr = Parrot_str_to_cstring(interp, keystr);
+ key_gdbm.dsize = strlen(key_gdbm.dptr);
val_gdbm = gdbm_fetch(dbf, key_gdbm);
val = Parrot_str_new(interp, val_gdbm.dptr, val_gdbm.dsize);
+ Parrot_str_free_cstring(key_gdbm.dptr);
free(val_gdbm.dptr);
return val;
Modified: branches/kill_parrot_cont/src/dynpmc/rational.pmc
==============================================================================
--- branches/kill_parrot_cont/src/dynpmc/rational.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/dynpmc/rational.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -269,7 +269,7 @@
PMC_data(SELF) = attrs;
PMC_rational(SELF) = (RATIONAL *)malloc(sizeof (RATIONAL));
mpq_init(RT(SELF));
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
#endif
}
Modified: branches/kill_parrot_cont/src/embed.c
==============================================================================
--- branches/kill_parrot_cont/src/embed.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/embed.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -234,7 +234,7 @@
void
Parrot_set_trace(PARROT_INTERP, UINTVAL flag)
{
- CONTEXT(interp)->trace_flags |= flag;
+ Parrot_pcc_trace_flags_on(interp, interp->ctx, flag);
Interp_core_SET(interp, PARROT_SLOW_CORE);
}
@@ -289,7 +289,7 @@
void
Parrot_clear_trace(PARROT_INTERP, UINTVAL flag)
{
- CONTEXT(interp)->trace_flags &= ~flag;
+ Parrot_pcc_trace_flags_off(interp, interp->ctx, flag);
}
@@ -343,7 +343,7 @@
UINTVAL
Parrot_test_trace(PARROT_INTERP, UINTVAL flag)
{
- return CONTEXT(interp)->trace_flags & flag;
+ return Parrot_pcc_trace_flags_test(interp, interp->ctx, flag);
}
@@ -910,8 +910,8 @@
const size_t offs = sub->start_offs;
if (offs == interp->resume_offset) {
- CONTEXT(interp)->current_sub = sub_pmc;
- CONTEXT(interp)->current_HLL = sub->HLL_id;
+ Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), sub_pmc);
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), sub->HLL_id);
return sub_pmc;
}
@@ -925,7 +925,7 @@
sub_pmc = pmc_new(interp, enum_class_Sub);
PMC_get_sub(interp, sub_pmc, sub_pmc_sub);
sub_pmc_sub->start_offs = 0;
- CONTEXT(interp)->current_sub = sub_pmc;
+ Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), sub_pmc);
return sub_pmc;
}
@@ -970,15 +970,15 @@
Parrot_on_exit(interp, print_profile, NULL);
/* Let's kick the tires and light the fires--call interpreter.c:runops. */
- main_sub = CONTEXT(interp)->current_sub;
+ main_sub = Parrot_pcc_get_sub(interp, CURRENT_CONTEXT(interp));
/* if no sub was marked being :main, we create a dummy sub with offset 0 */
if (!main_sub)
main_sub = set_current_sub(interp);
- CONTEXT(interp)->current_sub = NULL;
- CONTEXT(interp)->constants = interp->code->const_table->constants;
+ Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), NULL);
+ Parrot_pcc_set_constants(interp, interp->ctx, interp->code->const_table->constants);
Parrot_runops_fromc_args(interp, main_sub, "vP", userargv);
}
@@ -1247,7 +1247,7 @@
run_native = func;
if (interp->code && interp->code->const_table)
- CONTEXT(interp)->constants = interp->code->const_table->constants;
+ Parrot_pcc_set_constants(interp, interp->ctx, interp->code->const_table->constants);
runops(interp, interp->resume_offset);
}
Modified: branches/kill_parrot_cont/src/exceptions.c
==============================================================================
--- branches/kill_parrot_cont/src/exceptions.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/exceptions.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -41,7 +41,7 @@
static opcode_t * pass_exception_args(PARROT_INTERP,
ARGIN(const char *sig),
ARGIN(opcode_t *dest),
- ARGIN(Parrot_Context * old_ctx),
+ ARGIN(PMC * old_ctx),
...)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
@@ -253,7 +253,7 @@
/* Set up the continuation context of the handler in the interpreter. */
else if (PARROT_CONTINUATION(handler)->current_results)
address = pass_exception_args(interp, "P", address,
- CONTEXT(interp), exception);
+ CURRENT_CONTEXT(interp), exception);
if (PObj_get_FLAGS(handler) & SUB_FLAG_C_HANDLER) {
/* it's a C exception handler */
@@ -268,7 +268,7 @@
/*
=item C<static opcode_t * pass_exception_args(PARROT_INTERP, const char *sig,
-opcode_t *dest, Parrot_Context * old_ctx, ...)>
+opcode_t *dest, PMC * old_ctx, ...)>
Passes arguments to the exception handler routine. These are retrieved with
the .get_results() directive in PIR code.
@@ -280,7 +280,7 @@
PARROT_CAN_RETURN_NULL
static opcode_t *
pass_exception_args(PARROT_INTERP, ARGIN(const char *sig),
- ARGIN(opcode_t *dest), ARGIN(Parrot_Context * old_ctx), ...)
+ ARGIN(opcode_t *dest), ARGIN(PMC * old_ctx), ...)
{
ASSERT_ARGS(pass_exception_args)
va_list ap;
@@ -389,7 +389,8 @@
/* Note the thrower.
* XXX TT#596 - pass in current context instead when we have context PMCs. */
- VTABLE_set_attr_str(interp, exception, CONST_STRING(interp, "thrower"), CONTEXT(interp)->current_cont);
+ /* Don't split line. It will break CONST_STRING handling */
+ VTABLE_set_attr_str(interp, exception, CONST_STRING(interp, "thrower"), Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp)));
/* it's a C exception handler */
if (PObj_get_FLAGS(handler) & SUB_FLAG_C_HANDLER) {
@@ -402,7 +403,7 @@
address = VTABLE_invoke(interp, handler, NULL);
if (PARROT_CONTINUATION(handler)->current_results)
address = pass_exception_args(interp, "P", address,
- CONTEXT(interp), exception);
+ CURRENT_CONTEXT(interp), exception);
PARROT_ASSERT(return_point->handler_start == NULL);
return_point->handler_start = address;
longjmp(return_point->resume, 2);
Modified: branches/kill_parrot_cont/src/extend.c
==============================================================================
--- branches/kill_parrot_cont/src/extend.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/extend.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -1046,7 +1046,7 @@
va_start(ap, signature);
PMC_get_sub(interp, sub_pmc, sub);
- CONTEXT(interp)->constants = sub->seg->const_table->constants;
+ Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), sub->seg->const_table->constants);
result = Parrot_runops_fromc_arglist(interp, sub_pmc, signature, ap);
va_end(ap);
@@ -1079,7 +1079,7 @@
va_start(ap, signature);
PMC_get_sub(interp, sub_pmc, sub);
- CONTEXT(interp)->constants = sub->seg->const_table->constants;
+ Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), sub->seg->const_table->constants);
result = Parrot_runops_fromc_arglist_reti(interp, sub_pmc, signature, ap);
va_end(ap);
@@ -1112,7 +1112,7 @@
va_start(ap, signature);
PMC_get_sub(interp, sub_pmc, sub);
- CONTEXT(interp)->constants = sub->seg->const_table->constants;
+ Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), sub->seg->const_table->constants);
result = Parrot_runops_fromc_arglist_retf(interp, sub_pmc, signature, ap);
va_end(ap);
Modified: branches/kill_parrot_cont/src/gc/alloc_register.c
==============================================================================
--- branches/kill_parrot_cont/src/gc/alloc_register.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/gc/alloc_register.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -37,24 +37,24 @@
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-static void clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx))
+static void clear_regs(PARROT_INTERP, ARGMOD(PMC *pmcctx))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
- FUNC_MODIFIES(*ctx);
+ FUNC_MODIFIES(*pmcctx);
static void init_context(PARROT_INTERP,
- ARGMOD(Parrot_Context *ctx),
- ARGIN_NULLOK(const Parrot_Context *old))
+ ARGMOD(PMC *pmcctx),
+ ARGIN_NULLOK(PMC *pmcold))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
- FUNC_MODIFIES(*ctx);
+ FUNC_MODIFIES(*pmcctx);
#define ASSERT_ARGS_clear_regs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx)
+ || PARROT_ASSERT_ARG(pmcctx)
#define ASSERT_ARGS_init_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx)
+ || PARROT_ASSERT_ARG(pmcctx)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
@@ -78,34 +78,6 @@
*/
-/*
-=head2 Context and register frame allocation
-
-There are two allocation strategies: chunked memory and malloced with a free
-list.
-
- CHUNKED_CTX_MEM = 1
-
-C<ctx_mem.data> is a pointer to an allocated chunk of memory. The pointer
-C<ctx_mem.free> holds the next usable location. With (full) continuations the
-C<ctx_mem.free> pointer can't be moved below the C<ctx_mem.threshold>, which is
-the highest context pointer of all active continuations.
-
-[the code for this is incomplete; it had suffered some bit-rot and was
-getting in the way of maintaining the other case. -- rgr, 4-Feb-06.]
-
-RT #46177 GC has to lower this threshold when collecting continuations.
-
- CHUNKED_CTX_MEM = 0
-
-Context/register memory is malloced. C<ctx_mem.free> is used as a free list of
-reusable items.
-
-=cut
-
-*/
-
-#define CTX_ALLOC_SIZE 0x20000
#define ALIGNED_CTX_SIZE (((sizeof (Parrot_Context) + NUMVAL_SIZE - 1) \
/ NUMVAL_SIZE) * NUMVAL_SIZE)
@@ -130,10 +102,6 @@
/ SLOT_CHUNK_SIZE) * SLOT_CHUNK_SIZE)
#define CALCULATE_SLOT_NUM(size) ((size) / SLOT_CHUNK_SIZE)
-#if CHUNKED_CTX_MEM
- # error "Non-working code removed."
-#endif
-
/*
=head2 Context and Register Allocation Functions
@@ -144,48 +112,6 @@
*/
-/*
-
-=item C<void destroy_context(PARROT_INTERP)>
-
-Frees allocated context memory.
-
-=cut
-
-*/
-
-void
-destroy_context(PARROT_INTERP)
-{
- ASSERT_ARGS(destroy_context)
- Parrot_Context *context = CONTEXT(interp);
- int slot;
-
- while (context) {
- Parrot_Context * const prev = context->caller_ctx;
-
- /* always collect the parentmost context in the parentmost interp*/
- if (!prev && !interp->parent_interpreter)
- context->ref_count = 1;
-
- Parrot_free_context(interp, context, 1);
-
- context = prev;
- }
-
- /* clear freed contexts */
- for (slot = 0; slot < interp->ctx_mem.n_free_slots; ++slot) {
- void *ptr = interp->ctx_mem.free_list[slot];
- while (ptr) {
- void * const next = *(void **) ptr;
- mem_sys_free(ptr);
- ptr = next;
- }
- interp->ctx_mem.free_list[slot] = NULL;
- }
- mem_sys_free(interp->ctx_mem.free_list);
-}
-
/*
@@ -202,14 +128,11 @@
{
ASSERT_ARGS(create_initial_context)
static INTVAL num_regs[] = {32, 32, 32, 32};
- Parrot_Context *ignored;
+ PMC *ignored;
/* Create some initial free_list slots. */
#define INITIAL_FREE_SLOTS 8
- interp->ctx_mem.n_free_slots = INITIAL_FREE_SLOTS;
- interp->ctx_mem.free_list = mem_allocate_n_zeroed_typed(INITIAL_FREE_SLOTS, void *);
-
/* For now create context with 32 regs each. Some src tests (and maybe
* other extenders) assume the presence of these registers */
ignored = Parrot_set_new_context(interp, num_regs);
@@ -219,37 +142,7 @@
/*
-=item C<void parrot_gc_context(PARROT_INTERP)>
-
-Cleans up dead context memory; called by the garbage collector. This only
-applies in the chunked context memory scheme.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-parrot_gc_context(PARROT_INTERP)
-{
- ASSERT_ARGS(parrot_gc_context)
-#if CHUNKED_CTX_MEM
- Parrot_Context ctx;
- ASSERT_ARGS(parrot_gc_context)
-
- if (!interp->ctx_mem.threshold)
- return;
- LVALUE_CAST(char *, ctx.bp) = interp->ctx_mem.threshold
- - sizeof (parrot_regs_t);
-#else
- UNUSED(interp);
-#endif
-}
-
-
-/*
-
-=item C<static void clear_regs(PARROT_INTERP, Parrot_Context *ctx)>
+=item C<static void clear_regs(PARROT_INTERP, PMC *pmcctx)>
Clears all registers in a context. PMC and STRING registers contain PMCNULL
and NULL, respectively. Integer and float registers contain negative flag
@@ -260,10 +153,11 @@
*/
static void
-clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx))
+clear_regs(PARROT_INTERP, ARGMOD(PMC *pmcctx))
{
ASSERT_ARGS(clear_regs)
int i;
+ Parrot_Context *ctx = Parrot_pcc_get_context_struct(interp, pmcctx);
/* NULL out registers - P/S have to be NULL for GC
*
@@ -271,20 +165,20 @@
*/
for (i = 0; i < ctx->n_regs_used[REGNO_PMC]; i++) {
- CTX_REG_PMC(ctx, i) = PMCNULL;
+ CTX_REG_PMC(pmcctx, i) = PMCNULL;
}
for (i = 0; i < ctx->n_regs_used[REGNO_STR]; i++) {
- CTX_REG_STR(ctx, i) = NULL;
+ CTX_REG_STR(pmcctx, i) = NULL;
}
if (Interp_debug_TEST(interp, PARROT_REG_DEBUG_FLAG)) {
/* depending on -D40 we set int and num to be identifiable garbage values */
for (i = 0; i < ctx->n_regs_used[REGNO_INT]; i++) {
- CTX_REG_INT(ctx, i) = -999;
+ CTX_REG_INT(pmcctx, i) = -999;
}
for (i = 0; i < ctx->n_regs_used[REGNO_NUM]; i++) {
- CTX_REG_NUM(ctx, i) = -99.9;
+ CTX_REG_NUM(pmcctx, i) = -99.9;
}
}
}
@@ -292,8 +186,7 @@
/*
-=item C<static void init_context(PARROT_INTERP, Parrot_Context *ctx, const
-Parrot_Context *old)>
+=item C<static void init_context(PARROT_INTERP, PMC *pmcctx, PMC *pmcold)>
Initializes a freshly allocated or recycled context.
@@ -302,12 +195,13 @@
*/
static void
-init_context(PARROT_INTERP, ARGMOD(Parrot_Context *ctx),
- ARGIN_NULLOK(const Parrot_Context *old))
+init_context(PARROT_INTERP, ARGMOD(PMC *pmcctx),
+ ARGIN_NULLOK(PMC *pmcold))
{
ASSERT_ARGS(init_context)
- ctx->ref_count = 0;
- ctx->gc_mark = 0;
+ Parrot_Context *ctx = Parrot_pcc_get_context_struct(interp, pmcctx);
+ Parrot_Context *old = Parrot_pcc_get_context_struct(interp, pmcold);
+
ctx->current_results = NULL;
ctx->results_signature = NULL;
ctx->lex_pad = PMCNULL;
@@ -341,14 +235,13 @@
}
/* other stuff is set inside Sub.invoke */
- clear_regs(interp, ctx);
+ clear_regs(interp, pmcctx);
}
/*
-=item C<Parrot_Context * Parrot_push_context(PARROT_INTERP, const INTVAL
-*n_regs_used)>
+=item C<PMC * Parrot_push_context(PARROT_INTERP, const INTVAL *n_regs_used)>
Creates and sets the current context to a new context, remembering the old
context in C<caller_ctx>. Suitable to use with C<Parrot_pop_context>.
@@ -360,17 +253,17 @@
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
-Parrot_Context *
+PMC *
Parrot_push_context(PARROT_INTERP, ARGIN(const INTVAL *n_regs_used))
{
ASSERT_ARGS(Parrot_push_context)
- Parrot_Context * const old = CONTEXT(interp);
- Parrot_Context * const ctx = Parrot_set_new_context(interp, n_regs_used);
+ PMC * const old = CURRENT_CONTEXT(interp);
+ PMC * const ctx = Parrot_set_new_context(interp, n_regs_used);
- ctx->caller_ctx = old;
+ Parrot_pcc_set_caller_ctx(interp, ctx, old);
/* doesn't change */
- ctx->current_sub = old->current_sub;
+ Parrot_pcc_set_sub(interp, ctx, Parrot_pcc_get_sub(interp, old));
/* copy more ? */
return ctx;
@@ -393,30 +286,18 @@
Parrot_pop_context(PARROT_INTERP)
{
ASSERT_ARGS(Parrot_pop_context)
- Parrot_Context * const ctx = CONTEXT(interp);
- Parrot_Context * const old = ctx->caller_ctx;
-
-#if CTX_LEAK_DEBUG
- if (ctx->ref_count > 0 &&
- Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
- fprintf(stderr, "[force recycle of context %p (%d refs)]\n",
- (void *)ctx, ctx->ref_count);
- }
-#endif
- ctx->ref_count = 0;
- Parrot_free_context(interp, ctx, 0);
+ PMC * const ctx = CURRENT_CONTEXT(interp);
+ PMC * const old = Parrot_pcc_get_caller_ctx(interp, ctx);
/* restore old, set cached interpreter base pointers */
- CONTEXT(interp) = old;
- interp->ctx.bp = old->bp;
- interp->ctx.bp_ps = old->bp_ps;
+ CURRENT_CONTEXT(interp) = old;
}
/*
-=item C<Parrot_Context * Parrot_alloc_context(PARROT_INTERP, const INTVAL
-*number_regs_used, Parrot_Context *old)>
+=item C<PMC * Parrot_alloc_context(PARROT_INTERP, const INTVAL
+*number_regs_used, PMC *old)>
Allocates and returns a new context. Does not set this new context as the
current context. Note that the register usage C<n_regs_used> is copied. Use
@@ -429,11 +310,12 @@
PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
-Parrot_Context *
+PMC *
Parrot_alloc_context(PARROT_INTERP, ARGIN(const INTVAL *number_regs_used),
- ARGIN_NULLOK(Parrot_Context *old))
+ ARGIN_NULLOK(PMC *old))
{
ASSERT_ARGS(Parrot_alloc_context)
+ PMC *pmcctx;
Parrot_Context *ctx;
void *p;
@@ -445,57 +327,15 @@
const size_t size_nip = size_n + size_i + size_p;
const size_t all_regs_size = size_n + size_i + size_p + size_s;
const size_t reg_alloc = ROUND_ALLOC_SIZE(all_regs_size);
- const int slot = CALCULATE_SLOT_NUM(reg_alloc);
-
- /*
- * If slot is beyond the end of the allocated list, extend the list to
- * allocate more slots.
- */
- if (slot >= interp->ctx_mem.n_free_slots) {
- const int extend_size = slot + 1;
- int i;
-
- mem_realloc_n_typed(interp->ctx_mem.free_list, extend_size, void *);
- for (i = interp->ctx_mem.n_free_slots; i < extend_size; ++i)
- interp->ctx_mem.free_list[i] = NULL;
- interp->ctx_mem.n_free_slots = extend_size;
- }
- /*
- * The free_list contains a linked list of pointers for each size (slot
- * index). Pop off an available context of the desired size from free_list.
- * If no contexts of the desired size are available, allocate a new one.
- */
- ctx = (Parrot_Context *)interp->ctx_mem.free_list[slot];
-
- if (ctx) {
- /*
- * Store the next pointer from the linked list for this size (slot
- * index) in free_list. On "*(void **) ctx", C won't dereference a void
- * * pointer (untyped), so type cast ctx to void ** (a dereference-able
- * type) then dereference it to get a void *. Store the dereferenced
- * value (the next pointer in the linked list) in free_list.
- */
- interp->ctx_mem.free_list[slot] = *(void **)ctx;
- }
- else {
- const size_t to_alloc = reg_alloc + ALIGNED_CTX_SIZE;
- ctx = (Parrot_Context *)mem_sys_allocate(to_alloc);
- }
+ const size_t to_alloc = reg_alloc + ALIGNED_CTX_SIZE;
+ ctx = (Parrot_Context *)mem_sys_allocate(to_alloc);
ctx->n_regs_used[REGNO_INT] = number_regs_used[REGNO_INT];
ctx->n_regs_used[REGNO_NUM] = number_regs_used[REGNO_NUM];
ctx->n_regs_used[REGNO_STR] = number_regs_used[REGNO_STR];
ctx->n_regs_used[REGNO_PMC] = number_regs_used[REGNO_PMC];
-#if CTX_LEAK_DEBUG
- if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
- fprintf(stderr, "[alloc ctx %p]\n", ctx);
- }
-#endif
-
- ctx->regs_mem_size = reg_alloc;
-
/* regs start past the context */
p = (void *) ((char *)ctx + ALIGNED_CTX_SIZE);
@@ -505,15 +345,18 @@
/* ctx.bp_ps points to S0, which has Px on the left */
ctx->bp_ps.regs_s = (STRING **)((char *)p + size_nip);
- init_context(interp, ctx, old);
+ pmcctx = pmc_new(interp, enum_class_Context);
+ VTABLE_set_pointer(interp, pmcctx, ctx);
- return ctx;
+ init_context(interp, pmcctx, old);
+
+ return pmcctx;
}
/*
-=item C<Parrot_Context * Parrot_set_new_context(PARROT_INTERP, const INTVAL
+=item C<PMC * Parrot_set_new_context(PARROT_INTERP, const INTVAL
*number_regs_used)>
Allocates and returns a new context as the current context. Note that the
@@ -525,16 +368,14 @@
PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
-Parrot_Context *
+PMC *
Parrot_set_new_context(PARROT_INTERP, ARGIN(const INTVAL *number_regs_used))
{
ASSERT_ARGS(Parrot_set_new_context)
- Parrot_Context *old = CONTEXT(interp);
- Parrot_Context *ctx = Parrot_alloc_context(interp, number_regs_used, old);
+ PMC *old = CURRENT_CONTEXT(interp);
+ PMC *ctx = Parrot_alloc_context(interp, number_regs_used, old);
- CONTEXT(interp) = ctx;
- interp->ctx.bp.regs_i = ctx->bp.regs_i;
- interp->ctx.bp_ps.regs_s = ctx->bp_ps.regs_s;
+ CURRENT_CONTEXT(interp) = ctx;
return ctx;
}
@@ -542,11 +383,17 @@
/*
-=item C<void Parrot_free_context(PARROT_INTERP, Parrot_Context *ctx, int deref)>
+=back
+
+=head2 Register Stack Functions
+
+=over 4
+
+=cut
-Frees the context if its reference count is zero. If C<deref>
-is true, then reduce the reference count prior to determining
-if the context should be freed.
+=item C<void Parrot_clear_i(PARROT_INTERP)>
+
+Sets all integer registers in the current context to 0.
=cut
@@ -554,141 +401,62 @@
PARROT_EXPORT
void
-Parrot_free_context(PARROT_INTERP, ARGMOD(Parrot_Context *ctx), int deref)
+Parrot_clear_i(PARROT_INTERP)
{
- ASSERT_ARGS(Parrot_free_context)
- /*
- * The context structure has a reference count, initially 0.
- * This field is incremented when something outside of the normal
- * calling chain (such as a continuation or outer scope) wants to
- * preserve the context. The field is decremented when
- * Parrot_free_context is called with the C<deref> flag set true.
- * To trace context handling and check for leaks,
- * (a) disable NDEBUG, (b) enable CTX_LEAK_DEBUG in interpreter.h,
- * and (c) execute "debug 0x80" in a (preferably small) test case.
- *
- */
- if (deref) {
-#if CTX_LEAK_DEBUG
- if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
- fprintf(stderr, "[reference to context %p released]\n", (void*)ctx);
- }
-#endif
- ctx->ref_count--;
- }
-
- if (ctx->ref_count <= 0) {
- void *ptr;
- int slot;
-
-#ifndef NDEBUG
- if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)
- && ctx->current_sub) {
- /* can't probably Parrot_io_eprintf here */
- Parrot_Sub_attributes *doomed;
- PMC_get_sub(interp, ctx->current_sub, doomed);
-
- if (doomed) {
- fprintf(stderr, "[free ctx %p of sub '%s']\n",
- (void *)ctx,
- (doomed->name == (void*)0xdeadbeef
- ? "???"
- : (char*)doomed->name->strstart));
- }
- else {
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "NULL doomed sub detected in Parrot_free_context");
- }
- }
-#endif
-
- if (ctx->outer_ctx)
- Parrot_free_context(interp, ctx->outer_ctx, 1);
-
- ctx->n_regs_used[REGNO_INT] = 0;
- ctx->n_regs_used[REGNO_NUM] = 0;
- ctx->n_regs_used[REGNO_STR] = 0;
- ctx->n_regs_used[REGNO_PMC] = 0;
-
-#if CTX_LEAK_DEBUG_FULL
- /* for debugging, poison the freed context in case anything
- * tries to use it later. */
- ctx->current_results = (opcode_t *)0xbeefcafe;
- ctx->results_signature = (PMC *)0xbeefcafe;
- ctx->lex_pad = (PMC *)0xbeefcafe;
- ctx->outer_ctx = (Parrot_Context *)0xbeefcafe;
- ctx->current_cont = (PMC *)0xbeefcafe;
- ctx->current_object = (PMC *)0xbeefcafe;
- ctx->current_HLL = -1;
- ctx->handlers = (PMC *)0xbeefcafe;
- ctx->constants = (struct PackFile_Constant **)0xbeefcafe;
- ctx->current_namespace = (PMC *)0xbeefcafe;
-#endif
-
- /* don't put the same context on the free list multiple times; we don't
- * have the re-use versus multiple ref count semantics right yet */
- if (ctx->ref_count < 0)
- return;
-
- /* force the reference count negative to indicate a dead context
- * so mark_context (src/sub.c) can report it */
- ctx->ref_count--;
-
- ptr = ctx;
- slot = CALCULATE_SLOT_NUM(ctx->regs_mem_size);
-
-#if CTX_LEAK_DEBUG_FULL
- slot = 0;
-#endif
-
- PARROT_ASSERT(slot < interp->ctx_mem.n_free_slots);
- *(void **)ptr = interp->ctx_mem.free_list[slot];
- interp->ctx_mem.free_list[slot] = ptr;
- }
+ ASSERT_ARGS(Parrot_clear_i)
+ int i;
+ for (i = 0; i < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_INT); ++i)
+ REG_INT(interp, i) = 0;
}
/*
-=item C<Parrot_Context * Parrot_context_ref_trace(PARROT_INTERP, Parrot_Context
-*ctx, const char *file, int line)>
+=item C<void Parrot_clear_s(PARROT_INTERP)>
-Helper function to trace references when CTX_LEAK_DEBUG is set.
+Sets all STRING registers in the current context to NULL.
=cut
*/
PARROT_EXPORT
-PARROT_CANNOT_RETURN_NULL
-Parrot_Context *
-Parrot_context_ref_trace(PARROT_INTERP, ARGMOD(Parrot_Context *ctx),
- ARGIN(const char *file), int line)
+void
+Parrot_clear_s(PARROT_INTERP)
{
- ASSERT_ARGS(Parrot_context_ref_trace)
- if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
- const char *name = "unknown";
+ ASSERT_ARGS(Parrot_clear_s)
+ int i;
+ for (i = 0; i < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_STR); ++i)
+ REG_STR(interp, i) = NULL;
+}
- if (ctx->current_sub) {
- Parrot_Sub_attributes *sub;
- PMC_get_sub(interp, ctx->current_sub, sub);
- name = (char *)(sub->name->strstart);
- }
- fprintf(stderr, "[reference to context %p ('%s') taken at %s:%d]\n",
- (void *)ctx, name, file, line);
- }
+/*
- ctx->ref_count++;
- return ctx;
+=item C<void Parrot_clear_p(PARROT_INTERP)>
+
+Sets all PMC registers in the current context to NULL.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_clear_p(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_clear_p)
+ int i;
+ for (i = 0; i < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_PMC); ++i)
+ REG_PMC(interp, i) = PMCNULL;
}
/*
-=item C<void Parrot_set_context_threshold(PARROT_INTERP, Parrot_Context *ctx)>
+=item C<void Parrot_clear_n(PARROT_INTERP)>
-Marks the context as possible threshold.
+Sets all number registers in the current context to 0.0.
=cut
@@ -696,104 +464,198 @@
PARROT_EXPORT
void
-Parrot_set_context_threshold(SHIM_INTERP, SHIM(Parrot_Context *ctx))
+Parrot_clear_n(PARROT_INTERP)
{
- ASSERT_ARGS(Parrot_set_context_threshold)
- /* nothing to do */
+ ASSERT_ARGS(Parrot_clear_n)
+ int i;
+ for (i = 0; i < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_NUM); ++i)
+ REG_NUM(interp, i) = 0.0;
}
/*
-=back
-
-=head2 Register Stack Functions
+=item C<INTVAL * Parrot_pcc_get_INTVAL_reg(PARROT_INTERP, PMC *ctx, INTVAL idx)>
-=over 4
+Get pointer to INTVAL register.
=cut
-=item C<void Parrot_clear_i(PARROT_INTERP)>
+*/
-Sets all integer registers in the current context to 0.
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+INTVAL *
+Parrot_pcc_get_INTVAL_reg(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
+{
+ ASSERT_ARGS(Parrot_pcc_get_INTVAL_reg)
+ return &(Parrot_pcc_get_context_struct(interp, ctx)->bp.regs_i[idx]);
+}
+
+/*
+
+=item C<FLOATVAL * Parrot_pcc_get_FLOATVAL_reg(PARROT_INTERP, PMC *ctx, INTVAL
+idx)>
+
+Get pointer to FLOATVAL register.
=cut
*/
PARROT_EXPORT
-void
-Parrot_clear_i(PARROT_INTERP)
+PARROT_CANNOT_RETURN_NULL
+FLOATVAL *
+Parrot_pcc_get_FLOATVAL_reg(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
{
- ASSERT_ARGS(Parrot_clear_i)
- int i;
- for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_INT]; ++i)
- REG_INT(interp, i) = 0;
+ ASSERT_ARGS(Parrot_pcc_get_FLOATVAL_reg)
+ return &(Parrot_pcc_get_context_struct(interp, ctx)->bp.regs_n[-1L - idx]);
}
-
/*
-=item C<void Parrot_clear_s(PARROT_INTERP)>
+=item C<STRING ** Parrot_pcc_get_STRING_reg(PARROT_INTERP, PMC *ctx, INTVAL
+idx)>
-Sets all STRING registers in the current context to NULL.
+Get pointer to STRING register.
=cut
*/
PARROT_EXPORT
-void
-Parrot_clear_s(PARROT_INTERP)
+PARROT_CANNOT_RETURN_NULL
+STRING **
+Parrot_pcc_get_STRING_reg(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
{
- ASSERT_ARGS(Parrot_clear_s)
- int i;
- for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_STR]; ++i)
- REG_STR(interp, i) = NULL;
+ ASSERT_ARGS(Parrot_pcc_get_STRING_reg)
+ return &(Parrot_pcc_get_context_struct(interp, ctx)->bp_ps.regs_s[idx]);
}
+/*
+
+=item C<PMC ** Parrot_pcc_get_PMC_reg(PARROT_INTERP, PMC *ctx, INTVAL idx)>
+
+Get pointer to PMC register.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PMC **
+Parrot_pcc_get_PMC_reg(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
+{
+ ASSERT_ARGS(Parrot_pcc_get_PMC_reg)
+ return &(Parrot_pcc_get_context_struct(interp, ctx)->bp_ps.regs_p[-1L - idx]);
+}
/*
-=item C<void Parrot_clear_p(PARROT_INTERP)>
+=item C<int Parrot_pcc_get_regs_used(PARROT_INTERP, PMC *ctx, int type)>
-Sets all PMC registers in the current context to NULL.
+Return number of used registers of particular type.
=cut
*/
+PARROT_EXPORT
+int
+Parrot_pcc_get_regs_used(PARROT_INTERP, ARGIN(PMC *ctx), int type)
+{
+ ASSERT_ARGS(Parrot_pcc_get_regs_used)
+ return Parrot_pcc_get_context_struct(interp, ctx)->n_regs_used[type];
+}
+
+/*
+
+=item C<void Parrot_pcc_set_regs_used(PARROT_INTERP, PMC *ctx, int type, INTVAL
+num)>
+
+Set number of used registers of particular type.
+
+=cut
+*/
PARROT_EXPORT
void
-Parrot_clear_p(PARROT_INTERP)
+Parrot_pcc_set_regs_used(PARROT_INTERP, ARGIN(PMC *ctx), int type, INTVAL num)
{
- ASSERT_ARGS(Parrot_clear_p)
- int i;
- for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_PMC]; ++i)
- REG_PMC(interp, i) = PMCNULL;
+ ASSERT_ARGS(Parrot_pcc_set_regs_used)
+ Parrot_pcc_get_context_struct(interp, ctx)->n_regs_used[type] = num;
}
-
/*
-=item C<void Parrot_clear_n(PARROT_INTERP)>
+=item C<Regs_ni* Parrot_pcc_get_regs_ni(PARROT_INTERP, PMC *ctx)>
-Sets all number registers in the current context to 0.0.
+Get pointer to FLOANFAL and INTVAL registers.
=cut
*/
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+Regs_ni*
+Parrot_pcc_get_regs_ni(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_regs_ni)
+ return &(Parrot_pcc_get_context_struct(interp, ctx)->bp);
+}
+
+/*
+
+=item C<void Parrot_pcc_set_regs_ni(PARROT_INTERP, PMC *ctx, Regs_ni *bp)>
+Copy Regs_ni into Context.
+
+=cut
+
+*/
PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
void
-Parrot_clear_n(PARROT_INTERP)
+Parrot_pcc_set_regs_ni(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN(Regs_ni *bp))
{
- ASSERT_ARGS(Parrot_clear_n)
- int i;
- for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_NUM]; ++i)
- REG_NUM(interp, i) = 0.0;
+ ASSERT_ARGS(Parrot_pcc_set_regs_ni)
+ Parrot_pcc_get_context_struct(interp, ctx)->bp = *bp;
}
+/*
+
+=item C<Regs_ps* Parrot_pcc_get_regs_ps(PARROT_INTERP, PMC *ctx)>
+
+Get pointer to PMC and STRING registers.
+=cut
+
+*/
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+Regs_ps*
+Parrot_pcc_get_regs_ps(PARROT_INTERP, ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_pcc_get_regs_ps)
+ return &(Parrot_pcc_get_context_struct(interp, ctx)->bp_ps);
+}
+
+/*
+
+=item C<void Parrot_pcc_set_regs_ps(PARROT_INTERP, PMC *ctx, Regs_ps *bp_ps)>
+
+Copy Regs_ps into Context.
+
+=cut
+
+*/
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+void
+Parrot_pcc_set_regs_ps(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN(Regs_ps *bp_ps))
+{
+ ASSERT_ARGS(Parrot_pcc_set_regs_ps)
+ Parrot_pcc_get_context_struct(interp, ctx)->bp_ps = *bp_ps;
+}
/*
=back
Modified: branches/kill_parrot_cont/src/gc/api.c
==============================================================================
--- branches/kill_parrot_cont/src/gc/api.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/gc/api.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -406,10 +406,13 @@
Parrot_gc_add_pmc_sync(PARROT_INTERP, ARGMOD(PMC *pmc))
{
ASSERT_ARGS(Parrot_gc_add_pmc_sync)
+
+ /* This mutex already exists, leave it alone. */
if (PMC_sync(pmc))
- /* This mutex already exists, leave it alone. */
return;
+
PMC_sync(pmc) = mem_allocate_typed(Sync);
+
if (!PMC_sync(pmc))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ALLOCATION_ERROR,
"Parrot VM: PMC Sync allocation failed!\n");
@@ -790,7 +793,6 @@
{
ASSERT_ARGS(Parrot_gc_mark_and_sweep)
interp->arena_base->do_gc_mark(interp, flags);
- parrot_gc_context(interp);
}
/*
@@ -1627,10 +1629,11 @@
{
ASSERT_ARGS(Parrot_gc_free_pmc_attributes)
void * const data = PMC_data(pmc);
- /* const size_t size = pmc->vtable->attr_size; */
- const size_t size = item_size;
- if (data != NULL) {
- PMC_Attribute_Pool * const pool = Parrot_gc_get_attribute_pool(interp, size);
+
+ if (data) {
+ PMC_Attribute_Pool **pools = interp->arena_base->attrib_pools;
+ const size_t idx = item_size - sizeof (void *);
+ PMC_Attribute_Pool * const pool = pools[idx];
Parrot_gc_free_attributes_from_pool(interp, pool, data);
PMC_data(pmc) = NULL;
}
@@ -1658,18 +1661,20 @@
/*
=item C<void Parrot_gc_free_fixed_size_storage(PARROT_INTERP, size_t size, void
-* data)>
+*data)>
EXPERIMENTAL!!! See above.
*/
void
-Parrot_gc_free_fixed_size_storage(PARROT_INTERP, size_t size, ARGMOD(void * data))
+Parrot_gc_free_fixed_size_storage(PARROT_INTERP, size_t size, ARGMOD(void *data))
{
ASSERT_ARGS(Parrot_gc_free_fixed_size_storage)
- PMC_Attribute_Pool * const pool = Parrot_gc_get_attribute_pool(interp,
- size);
+ PMC_Attribute_Pool **pools = interp->arena_base->attrib_pools;
+ const size_t idx = size - sizeof (void *);
+ PMC_Attribute_Pool * const pool = pools[idx];
+
Parrot_gc_free_attributes_from_pool(interp, pool, data);
}
@@ -1679,7 +1684,7 @@
=head1 SEE ALSO
-F<include/parrot/gc_api.h>, F<src/cpu_dep.c> and F<docs/pdds/pdd09_gc.pod>.
+F<include/parrot/gc_api.h>, F<src/gc/system.c> and F<docs/pdds/pdd09_gc.pod>.
=head1 HISTORY
Modified: branches/kill_parrot_cont/src/gc/generational_ms.c
==============================================================================
--- branches/kill_parrot_cont/src/gc/generational_ms.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/gc/generational_ms.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -606,7 +606,7 @@
=item C<static void gc_gms_chain_objects(PARROT_INTERP, Small_Object_Pool *pool,
Small_Object_Arena *new_arena, size_t real_size)>
-TODO: interfere active_destroy and put these items into a
+TODO: interfere custom_destroy and put these items into a
separate white area, so that a sweep has just to run through these
objects
@@ -1691,7 +1691,7 @@
PMC * const obj = (PMC*)GMSH_to_PObj(h);
if (PObj_needs_early_gc_TEST(obj))
--arena_base->num_early_gc_PMCs;
- if (PObj_active_destroy_TEST(obj))
+ if (PObj_custom_destroy_TEST(obj))
VTABLE_destroy(interp, (PMC *)obj);
}
pool->free_list = pool->white;
Modified: branches/kill_parrot_cont/src/gc/mark_sweep.c
==============================================================================
--- branches/kill_parrot_cont/src/gc/mark_sweep.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/gc/mark_sweep.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -169,9 +169,8 @@
Parrot_gc_trace_root(PARROT_INTERP, Parrot_gc_trace_type trace)
{
ASSERT_ARGS(Parrot_gc_trace_root)
- Arenas * const arena_base = interp->arena_base;
- Parrot_Context *ctx;
- PObj *obj;
+ Arenas * const arena_base = interp->arena_base;
+ PObj *obj;
/* note: adding locals here did cause increased GC runs */
mark_context_start();
@@ -200,8 +199,7 @@
Parrot_gc_mark_PObj_alive(interp, obj);
/* mark the current context. */
- ctx = CONTEXT(interp);
- mark_context(interp, ctx);
+ Parrot_gc_mark_PObj_alive(interp, (PObj*)CURRENT_CONTEXT(interp));
/* mark the dynamic environment. */
Parrot_gc_mark_PObj_alive(interp, (PObj*)interp->dynamic_env);
@@ -1171,15 +1169,17 @@
{
ASSERT_ARGS(Parrot_gc_get_attributes_from_pool)
PMC_Attribute_Free_List *item;
-
if (pool->top_arena == NULL
+
#if GC_USE_LAZY_ALLOCATOR
|| (pool->newfree == NULL && pool->free_list == NULL))
#else
+
|| pool->free_list == NULL)
#endif
Parrot_gc_allocate_new_attributes_arena(interp, pool);
+
#if GC_USE_LAZY_ALLOCATOR
if (pool->newfree) {
item = pool->newfree;
@@ -1193,6 +1193,7 @@
pool->free_list = item->next;
}
#else
+
item = pool->free_list;
pool->free_list = item->next;
#endif
@@ -1248,14 +1249,17 @@
Parrot_gc_get_attribute_pool(PARROT_INTERP, size_t attrib_size)
{
ASSERT_ARGS(Parrot_gc_get_attribute_pool)
- Arenas * const arenas = interp->arena_base;
- PMC_Attribute_Pool ** pools = arenas->attrib_pools;
- const size_t size = (attrib_size < sizeof (void *))?(sizeof (void *)):(attrib_size);
- const size_t idx = size - sizeof (void *);
+
+ Arenas * const arenas = interp->arena_base;
+ PMC_Attribute_Pool **pools = arenas->attrib_pools;
+ const size_t size = (attrib_size < sizeof (void *))
+ ? sizeof (void *)
+ : attrib_size;
+ const size_t idx = size - sizeof (void *);
if (pools == NULL) {
const size_t total_length = idx + GC_ATTRIB_POOLS_HEADROOM;
- const size_t total_size = total_length * sizeof (void *);
+ const size_t total_size = (total_length + 1) * sizeof (void *);
/* Allocate more then we strictly need, hoping that we can reduce the
number of resizes. 8 is just an arbitrary number */
pools = (PMC_Attribute_Pool **)mem_internal_allocate(total_size);
@@ -1263,7 +1267,7 @@
arenas->attrib_pools = pools;
arenas->num_attribs = total_length;
}
- if (arenas->num_attribs < idx) {
+ if (arenas->num_attribs <= idx) {
const size_t total_length = idx + GC_ATTRIB_POOLS_HEADROOM;
const size_t total_size = total_length * sizeof (void *);
const size_t current_size = arenas->num_attribs;
Modified: branches/kill_parrot_cont/src/global.c
==============================================================================
--- branches/kill_parrot_cont/src/global.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/global.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -375,10 +375,10 @@
ASSERT_ARGS(Parrot_make_namespace_autobase)
PMC *base_ns;
if (VTABLE_isa(interp, key, CONST_STRING(interp, "String")))
- base_ns = CONTEXT(interp)->current_namespace;
+ base_ns = Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp));
else
base_ns = VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace,
- CONTEXT(interp)->current_HLL);
+ Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
return Parrot_make_namespace_keyed(interp, base_ns, key);
}
@@ -531,7 +531,7 @@
Parrot_find_global_cur(PARROT_INTERP, ARGIN_NULLOK(STRING *globalname))
{
ASSERT_ARGS(Parrot_find_global_cur)
- PMC * const ns = CONTEXT(interp)->current_namespace;
+ PMC * const ns = Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp));
return Parrot_find_global_n(interp, ns, globalname);
}
@@ -678,7 +678,7 @@
Parrot_find_name_op(PARROT_INTERP, ARGIN(STRING *name), SHIM(void *next))
{
ASSERT_ARGS(Parrot_find_name_op)
- Parrot_Context * const ctx = CONTEXT(interp);
+ PMC * const ctx = CURRENT_CONTEXT(interp);
PMC * const lex_pad = Parrot_find_pad(interp, name, ctx);
PMC *g;
@@ -788,7 +788,7 @@
Parrot_store_sub_in_namespace(PARROT_INTERP, ARGIN(PMC *sub_pmc))
{
ASSERT_ARGS(Parrot_store_sub_in_namespace)
- const INTVAL cur_id = CONTEXT(interp)->current_HLL;
+ const INTVAL cur_id = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp));
PMC *ns;
Parrot_Sub_attributes *sub;
@@ -798,7 +798,7 @@
/* store relative to HLL namespace */
PMC_get_sub(interp, sub_pmc, sub);
- CONTEXT(interp)->current_HLL = sub->HLL_id;
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), sub->HLL_id);
ns = get_namespace_pmc(interp, sub_pmc);
@@ -824,7 +824,7 @@
}
/* restore HLL_id */
- CONTEXT(interp)->current_HLL = cur_id;
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_id);
Parrot_unblock_GC_mark(interp);
}
Modified: branches/kill_parrot_cont/src/global_setup.c
==============================================================================
--- branches/kill_parrot_cont/src/global_setup.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/global_setup.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -209,12 +209,14 @@
PMC *classname_hash, *iglobals;
int i;
+ create_initial_context(interp);
+
/* create the namespace root stash */
interp->root_namespace = pmc_new(interp, enum_class_NameSpace);
Parrot_init_HLL(interp);
- CONTEXT(interp)->current_namespace =
- VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace, 0);
+ Parrot_pcc_set_namespace(interp, CURRENT_CONTEXT(interp),
+ VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace, 0));
/* We need a class hash */
interp->class_hash = classname_hash = pmc_new(interp, enum_class_NameSpace);
Modified: branches/kill_parrot_cont/src/hash.c
==============================================================================
--- branches/kill_parrot_cont/src/hash.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/hash.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -206,7 +206,7 @@
return 1;
/* COWed strings */
- if (s1->strstart == s2->strstart && s1->bufused == s2->bufused)
+ if (Buffer_bufstart(s1) == Buffer_bufstart(s2) && s1->bufused == s2->bufused)
return 0;
return CHARSET_COMPARE(interp, s1, s2);
Modified: branches/kill_parrot_cont/src/hll.c
==============================================================================
--- branches/kill_parrot_cont/src/hll.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/hll.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -53,7 +53,7 @@
#define END_READ_HLL_INFO(interp, hll_info)
#define START_WRITE_HLL_INFO(interp, hll_info) \
do { \
- if (PMC_sync((interp)->HLL_info)) { \
+ if (PObj_is_PMC_shared_TEST(hll_info) && PMC_sync((interp)->HLL_info)) { \
(hll_info) = (interp)->HLL_info = \
Parrot_clone((interp), (interp)->HLL_info); \
if (PMC_sync((interp)->HLL_info)) \
@@ -362,8 +362,8 @@
"no such HLL ID (%vd)", hll_id);
/* the type might already be registered in a non-conflicting way, in which
- * case we can avoid copying */
- if (PMC_sync(hll_info)) {
+ * ca se we can avoid copying */
+ if (PObj_is_PMC_shared_TEST(hll_info) && PMC_sync(hll_info)) {
if (hll_type == Parrot_get_HLL_type(interp, hll_id, core_type))
return;
}
@@ -446,7 +446,7 @@
Parrot_get_ctx_HLL_type(PARROT_INTERP, INTVAL core_type)
{
ASSERT_ARGS(Parrot_get_ctx_HLL_type)
- const INTVAL hll_id = CONTEXT(interp)->current_HLL;
+ const INTVAL hll_id = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp));
return Parrot_get_HLL_type(interp, hll_id, core_type);
}
@@ -468,7 +468,7 @@
Parrot_get_ctx_HLL_namespace(PARROT_INTERP)
{
ASSERT_ARGS(Parrot_get_ctx_HLL_namespace)
- return Parrot_get_HLL_namespace(interp, CONTEXT(interp)->current_HLL);
+ return Parrot_get_HLL_namespace(interp, Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
}
/*
Modified: branches/kill_parrot_cont/src/interp/inter_cb.c
==============================================================================
--- branches/kill_parrot_cont/src/interp/inter_cb.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/interp/inter_cb.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -79,6 +79,7 @@
int type;
char * sig_str;
STRING *sc;
+ char * const signature = Parrot_str_to_cstring(interp, cb_signature);
/*
* we stuff all the information into the user_data PMC and pass that
* on to the external sub
@@ -92,11 +93,13 @@
sc = CONST_STRING(interp, "_sub");
VTABLE_setprop(interp, user_data, sc, sub);
/* only ASCII signatures are supported */
- sig_str = cb_signature->strstart;
+ sig_str = signature;
- if (strlen(sig_str) != 3)
+ if (strlen(sig_str) != 3) {
+ mem_sys_free(signature);
Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "unhandled signature '%s' in make_cb", cb_signature->strstart);
+ "unhandled signature '%Ss' in make_cb", cb_signature);
+ }
++sig_str; /* Skip callback return type */
@@ -109,11 +112,13 @@
type = 'C';
}
else {
+ mem_sys_free(signature);
Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "unhandled signature '%s' in make_cb", cb_signature->strstart);
+ "unhandled signature '%Ss' in make_cb", cb_signature);
}
}
+ mem_sys_free(signature);
cb_sig = pmc_new(interp, enum_class_String);
VTABLE_set_string_native(interp, cb_sig, cb_signature);
sc = CONST_STRING(interp, "_signature");
@@ -294,6 +299,8 @@
PMC *sub;
STRING *sig_str;
char *p;
+ char ch;
+ char *sig_cstr;
char pasm_sig[4];
INTVAL i_param;
PMC *p_param;
@@ -306,7 +313,8 @@
signature = VTABLE_getprop(interp, user_data, sc);
sig_str = VTABLE_get_string(interp, signature);
- p = sig_str->strstart;
+ sig_cstr = Parrot_str_to_cstring(interp, sig_str);
+ p = sig_cstr;
++p; /* Skip return type */
pasm_sig[0] = 'v'; /* no return value supported yet */
@@ -362,9 +370,12 @@
param = Parrot_str_new(interp, external_data, 0);
break;
default:
+ ch = *p;
+ Parrot_str_free_cstring(sig_cstr);
Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "unhandled signature char '%c' in run_cb", *p);
+ "unhandled signature char '%c' in run_cb", ch);
}
+ Parrot_str_free_cstring(sig_cstr);
pasm_sig[3] = '\0';
Parrot_runops_fromc_args_event(interp, sub, pasm_sig,
user_data, param);
Modified: branches/kill_parrot_cont/src/interp/inter_create.c
==============================================================================
--- branches/kill_parrot_cont/src/interp/inter_create.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/interp/inter_create.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -152,11 +152,9 @@
Parrot_block_GC_mark(interp);
Parrot_block_GC_sweep(interp);
- create_initial_context(interp);
+ interp->ctx = PMCNULL;
interp->resume_flag = RESUME_INITIAL;
- /* main is called as a Sub too - this will get depth 0 then */
- CONTEXT(interp)->recursion_depth = (UINTVAL)-1;
interp->recursion_limit = RECURSION_LIMIT;
/* PANIC will fail until this is done */
@@ -211,10 +209,12 @@
PARROT_ERRORS_on(interp, PARROT_ERRORS_RESULT_COUNT_FLAG);
#endif
+ create_initial_context(interp);
+
/* clear context introspection vars */
- CONTEXT(interp)->current_sub = NULL;
- CONTEXT(interp)->current_cont = NULL;
- CONTEXT(interp)->current_object = NULL;
+ Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), NULL);
+ Parrot_pcc_set_continuation(interp, CURRENT_CONTEXT(interp), NULL); /* TODO Use PMCNULL */
+ Parrot_pcc_set_object(interp, CURRENT_CONTEXT(interp), NULL);
/* Load the core op func and info tables */
interp->op_lib = PARROT_CORE_OPLIB_INIT(1);
@@ -418,7 +418,6 @@
interp->profile = NULL;
}
- destroy_context(interp);
destroy_runloop_jump_points(interp);
if (interp->evc_func_table) {
Modified: branches/kill_parrot_cont/src/interp/inter_misc.c
==============================================================================
--- branches/kill_parrot_cont/src/interp/inter_misc.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/interp/inter_misc.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -282,19 +282,19 @@
ASSERT_ARGS(interpinfo_p)
switch (what) {
case CURRENT_SUB:
- return CONTEXT(interp)->current_sub;
+ return Parrot_pcc_get_sub(interp, CURRENT_CONTEXT(interp));
case CURRENT_CONT:
{
- PMC * const cont = CONTEXT(interp)->current_cont;
+ PMC * const cont = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
if (!PMC_IS_NULL(cont) && cont->vtable->base_type ==
enum_class_RetContinuation)
return VTABLE_clone(interp, cont);
return cont;
}
case CURRENT_OBJECT:
- return CONTEXT(interp)->current_object;
+ return Parrot_pcc_get_object(interp, CURRENT_CONTEXT(interp));
case CURRENT_LEXPAD:
- return CONTEXT(interp)->lex_pad;
+ return Parrot_pcc_get_lex_pad(interp, CURRENT_CONTEXT(interp));
default: /* or a warning only? */
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
"illegal argument in interpinfo");
Modified: branches/kill_parrot_cont/src/jit.c
==============================================================================
--- branches/kill_parrot_cont/src/jit.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/jit.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -287,7 +287,7 @@
int arg_type;
PMC *sig;
if (argn >= args) {
- sig = CONTEXT(interp)->constants[cur_op[1]]->u.key;
+ sig = Parrot_pcc_get_pmc_constant(interp, CURRENT_CONTEXT(interp), cur_op[1]);
arg_type = VTABLE_get_integer_keyed_int(interp,
sig, argn - args);
arg_type &= (PARROT_ARG_TYPE_MASK | PARROT_ARG_CONSTANT);
@@ -396,8 +396,10 @@
{
int typ;
- cur_section->ru[0].registers_used = CONTEXT(interp)->n_regs_used[REGNO_INT];
- cur_section->ru[3].registers_used = CONTEXT(interp)->n_regs_used[REGNO_NUM];
+ cur_section->ru[0].registers_used = Parrot_pcc_get_regs_used(interp,
+ CURRENT_CONTEXT(interp), REGNO_INT);
+ cur_section->ru[3].registers_used = Parrot_pcc_get_regs_used(interp,
+ CURRENT_CONTEXT(interp), REGNO_NUM);
cur_section->ru[1].registers_used = cur_section->ru[2].registers_used = 0;
for (typ = 0; typ < 4; typ++) {
@@ -1304,7 +1306,8 @@
if (offs >= sub->start_offs && offs < sub->end_offs) {
for (i = 0; i < 4; i++)
- CONTEXT(interp)->n_regs_used[i] = sub->n_regs_used[i];
+ Parrot_pcc_set_regs_used(interp, CURRENT_CONTEXT(interp),
+ i, sub->n_regs_used[i]);
return;
}
@@ -1425,7 +1428,7 @@
/* remember register usage */
for (i = 0; i < 4; i++)
- n_regs_used[i] = CONTEXT(interp)->n_regs_used[i];
+ n_regs_used[i] = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), i);
set_reg_usage(interp, code_start);
@@ -1679,7 +1682,7 @@
/* restore register usage */
for (i = 0; i < 4; i++)
- CONTEXT(interp)->n_regs_used[i] = n_regs_used[i];
+ Parrot_pcc_set_regs_used(interp, CURRENT_CONTEXT(interp), i, n_regs_used[i]);
/* Do fixups before converting offsets */
(arch_info->jit_dofixup)(jit_info, interp);
Modified: branches/kill_parrot_cont/src/jit/amd64/jit_defs.c
==============================================================================
--- branches/kill_parrot_cont/src/jit/amd64/jit_defs.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/jit/amd64/jit_defs.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -153,7 +153,9 @@
#endif
}
/* Base pointer */
- emit_mov_r_mr(jit_info->native_ptr, RBX, INTERP, (long)offsetof(Interp, ctx.bp));
+ emit_mov_r_mr(jit_info->native_ptr, RBX, INTERP, (long)offsetof(Interp, ctx));
+ emit_mov_r_mr(jit_info->native_ptr, RBX, RBX, (long)offsetof(PMC, data));
+ emit_mov_r_mr(jit_info->native_ptr, RBX, RBX, (long)offsetof(Parrot_Context, bp));
#ifdef USE_OP_MAP_AND_CODE_START
emit_jmp_r_r(jit_info->native_ptr, RAX, OP_MAP);
Modified: branches/kill_parrot_cont/src/jit/i386/core.jit
==============================================================================
--- branches/kill_parrot_cont/src/jit/i386/core.jit Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/jit/i386/core.jit Sun Sep 6 00:20:10 2009 (r41024)
@@ -1453,21 +1453,18 @@
Parrot_pic_callr___pc {
int offset, here, op_i;
- PackFile_Constant ** constants;
PMC *sig_params, *sig_result;
opcode_t *params;
int skip;
- constants = CONTEXT(interp)->constants;
params = jit_info->optimizer->sections->begin;
- sig_params = constants[params[1]]->u.key;
+ sig_params = Parrot_pcc_get_pmc_constant(interp, CURRENT_CONTEXT(interp), params[1]);
op_i = 2 + VTABLE_elements(interp, sig_params);
offset = jit_info->arena.op_map[op_i].offset;
/* TODO preserve necessary regs */
assert(*CUR_OPCODE == PARROT_OP_get_results_pc);
- constants = CONTEXT(interp)->constants;
- sig_result = constants[CUR_OPCODE[1]]->u.key;
+ sig_result = Parrot_pcc_get_pmc_constant(interp, CURRENT_CONTEXT(interp), CUR_OPCODE[1]);
if (!VTABLE_elements(interp, sig_result))
skip = -1;
else
@@ -1492,16 +1489,16 @@
if (jit_info->code_type == JIT_CODE_FILE) {
Parrot_jit_emit_get_INTERP(interp, jit_info->native_ptr, emit_EAX);
emitm_movl_m_r(interp, NATIVECODE, emit_EAX, emit_EAX, emit_None, 1,
- offsetof(Interp, ctx.state));
+ offsetof(Interp, ctx));
+ emitm_movl_m_r(interp, NATIVECODE, emit_EAX, emit_EAX, emit_None, 1,
+ offsetof(PMC, data));
emitm_movl_i_m(NATIVECODE, jit_info->cur_op, emit_EAX, emit_None, 1,
offsetof(Parrot_Context, current_results));
}
else {
- PackFile_Constant ** constants;
- PMC *sig_result;
+ PMC *sig_result = Parrot_pcc_get_pmc_constant(interp,
+ CURRENT_CONTEXT(interp), CUR_OPCODE[1]);
- constants = CONTEXT(interp)->constants;
- sig_result = constants[CUR_OPCODE[1]]->u.key;
if (!VTABLE_elements(interp, sig_result))
return;
if (VTABLE_get_integer_keyed_int(interp, sig_result, 0) ==
Modified: branches/kill_parrot_cont/src/jit/i386/jit_defs.c
==============================================================================
--- branches/kill_parrot_cont/src/jit/i386/jit_defs.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/jit/i386/jit_defs.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -872,7 +872,11 @@
#endif
/* get base pointer */
emitm_movl_m_r(interp, jit_info->native_ptr, emit_EBX, emit_EBX, 0, 1,
- offsetof(Interp, ctx.bp));
+ offsetof(Interp, ctx));
+ emitm_movl_m_r(interp, jit_info->native_ptr, emit_EBX, emit_EBX, 0, 1,
+ offsetof(PMC, data));
+ emitm_movl_m_r(interp, jit_info->native_ptr, emit_EBX, emit_EBX, 0, 1,
+ offsetof(Parrot_Context, bp));
/* This jumps to the address in op_map[EDX + sizeof (void *) * INDEX] */
emitm_jumpm(jit_info->native_ptr, emit_EDX, emit_EAX,
@@ -1231,7 +1235,7 @@
PMC *sig_pmc;
INTVAL *sig_bits, i, n;
- sig_pmc = CONTEXT(interp)->constants[CUR_OPCODE[1]]->u.key;
+ sig_pmc = Parrot_pcc_get_pmc_constant(interp, CURRENT_CONTEXT(interp), CUR_OPCODE[1]);
GETATTR_FixedIntegerArray_int_array(interp, sig_pmc, sig_bits);
n = VTABLE_elements(interp, sig_pmc);
jit_info->n_args = n;
@@ -1267,7 +1271,7 @@
int i, used_i, save_i;
const jit_arch_regs *reg_info;
- used_i = CONTEXT(interp)->n_regs_used[REGNO_INT];
+ used_i = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_INT);
reg_info = &jit_info->arch_info->regs[jit_info->code_type];
save_i = reg_info->n_preserved_I;
for (i = save_i; i < used_i; ++i) {
@@ -1283,7 +1287,7 @@
int i, used_i, save_i;
const jit_arch_regs *reg_info;
- used_i = CONTEXT(interp)->n_regs_used[REGNO_INT];
+ used_i = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_INT);
reg_info = &jit_info->arch_info->regs[jit_info->code_type];
save_i = reg_info->n_preserved_I;
/* note - reversed order of jit_save_regs */
@@ -1307,8 +1311,8 @@
int i, used_i, used_n;
const jit_arch_regs *reg_info;
- used_i = CONTEXT(interp)->n_regs_used[REGNO_INT];
- used_n = CONTEXT(interp)->n_regs_used[REGNO_NUM];
+ used_i = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_INT);
+ used_n = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_NUM);
jit_emit_sub_ri_i(interp, jit_info->native_ptr, emit_ESP,
(used_i * sizeof (INTVAL) + used_n * sizeof (FLOATVAL)));
reg_info = &jit_info->arch_info->regs[jit_info->code_type];
@@ -1338,8 +1342,8 @@
int i, used_i, used_n;
const jit_arch_regs *reg_info;
- used_i = CONTEXT(interp)->n_regs_used[REGNO_INT];
- used_n = CONTEXT(interp)->n_regs_used[REGNO_NUM];
+ used_i = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_INT);
+ used_n = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_NUM);
reg_info = &jit_info->arch_info->regs[jit_info->code_type];
for (i = 0; i < used_i; ++i) {
@@ -1368,7 +1372,7 @@
PMC *sig_pmc;
INTVAL *sig_bits, sig;
- sig_pmc = CONTEXT(interp)->constants[CUR_OPCODE[1]]->u.key;
+ sig_pmc = Parrot_pcc_get_pmc_constant(interp, CURRENT_CONTEXT(interp), CUR_OPCODE[1]);
if (!VTABLE_elements(interp, sig_pmc))
return;
GETATTR_FixedIntegerArray_int_array(interp, sig_pmc, sig_bits);
@@ -1428,7 +1432,6 @@
{
PMC *sig_args, *sig_params, *sig_result;
INTVAL *sig_bits, sig, i, n;
- PackFile_Constant ** constants;
opcode_t *params, *result;
char params_map;
int skip, used_n;
@@ -1442,13 +1445,12 @@
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"set_args_jit - can't do that yet ");
- constants = CONTEXT(interp)->constants;
- sig_args = constants[CUR_OPCODE[1]]->u.key;
+ sig_args = Parrot_pcc_get_pmc_constant(interp, CURRENT_CONTEXT(interp), CUR_OPCODE[1]);
if (!VTABLE_elements(interp, sig_args))
return;
params = jit_info->optimizer->sections->begin;
- sig_params = constants[params[1]]->u.key;
+ sig_params = Parrot_pcc_get_pmc_constant(interp, CURRENT_CONTEXT(interp), params[1]);
ASSERT_SIG_PMC(sig_params);
GETATTR_FixedIntegerArray_int_array(interp, sig_args, sig_bits);
n = VTABLE_elements(interp, sig_args);
@@ -1458,7 +1460,7 @@
*/
result = CUR_OPCODE + 2 + n + 3; /* set_args, set_p_pc */
PARROT_ASSERT(*result == PARROT_OP_get_results_pc);
- sig_result = constants[result[1]]->u.key;
+ sig_result = Parrot_pcc_get_pmc_constant(interp, CURRENT_CONTEXT(interp), result[1]);
ASSERT_SIG_PMC(sig_result);
if (!VTABLE_elements(interp, sig_result))
@@ -1738,7 +1740,6 @@
*/
if (jit_info->flags & JIT_CODE_RECURSIVE) {
char * L1;
- PackFile_Constant ** constants;
PMC *sig_result;
opcode_t *result;
@@ -1747,9 +1748,8 @@
L1 = NATIVECODE;
emitm_calll(NATIVECODE, 0);
/* check type of return value */
- constants = CONTEXT(interp)->constants;
- result = CONTEXT(interp)->current_results;
- sig_result = constants[result[1]]->u.key;
+ result = Parrot_pcc_get_results(interp, CURRENT_CONTEXT(interp));
+ sig_result = Parrot_pcc_get_pmc_constant(interp, CURRENT_CONTEXT(interp), result[1]);
if (!VTABLE_elements(interp, sig_result))
goto no_result;
/* fetch args to %edx */
@@ -2084,8 +2084,9 @@
const int ST_SIZE_OF = 124;
const int JIT_ALLOC_SIZE = 1024;
+ char *signature_str = Parrot_str_to_cstring(interp, signature);
/* skip over the result */
- char *sig = (char *)signature->strstart + 1;
+ char *sig = signature_str + 1;
size_t stack_space_needed = calc_signature_needs(sig,
&string_buffer_count);
@@ -2240,6 +2241,7 @@
case '4':
case 'V':
mem_free_executable(jit_info.native_ptr, JIT_ALLOC_SIZE);
+ Parrot_str_free_cstring(signature_str);
return NULL;
break;
default:
@@ -2250,6 +2252,7 @@
* cleanup and try nci.c
*/
mem_free_executable(jit_info.native_ptr, JIT_ALLOC_SIZE);
+ Parrot_str_free_cstring(signature_str);
return NULL;
}
args_offset +=4;
@@ -2294,7 +2297,7 @@
/* now place return value in registers */
/* first in signature is the return value */
- sig = (char *)signature->strstart; /* the result */
+ sig = signature_str; /* the result */
switch (*sig) {
/* I have no idea how to handle these */
case '2':
@@ -2393,6 +2396,7 @@
* oops unknown signature:
* cleanup and try nci.c
*/
+ Parrot_str_free_cstring(signature_str);
mem_free_executable(jit_info.native_ptr, JIT_ALLOC_SIZE);
return NULL;
}
@@ -2410,9 +2414,10 @@
emitm_ret(pc);
PARROT_ASSERT(pc - jit_info.arena.start <= JIT_ALLOC_SIZE);
/* could shrink arena.start here to used size */
- PObj_active_destroy_SET(pmc_nci);
+ PObj_custom_destroy_SET(pmc_nci);
if (sizeptr)
*sizeptr = JIT_ALLOC_SIZE;
+ Parrot_str_free_cstring(signature_str);
return (void *)D2FPTR(jit_info.arena.start);
}
Modified: branches/kill_parrot_cont/src/jit/ppc/core.jit
==============================================================================
--- branches/kill_parrot_cont/src/jit/ppc/core.jit Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/jit/ppc/core.jit Sun Sep 6 00:20:10 2009 (r41024)
@@ -1223,8 +1223,8 @@
; or just JIT (TODO) the 2 easy ones
Parrot_set_args_pc {
if (jit_info->code_type == JIT_CODE_FILE) {
- jit_emit_mov_ri_i(NATIVECODE, ISR1, jit_info->cur_op);
- jit_emit_stw(NATIVECODE, ISR1, offsetof(Interp, current_args), r16);
+ jit_emit_mov_ri_i(NATIVECODE, ISR1, jit_info->cur_op);
+ jit_emit_stw(NATIVECODE, ISR1, offsetof(Interp, current_args), r16);
}
else {
jit_set_args_pc(jit_info, interp,
@@ -1294,10 +1294,11 @@
Parrot_get_results_pc {
if (jit_info->code_type == JIT_CODE_FILE) {
- jit_emit_mov_ri_i(NATIVECODE, ISR1, jit_info->cur_op);
- jit_emit_lwz(NATIVECODE, ISR2, offsetof(Interp, ctx.state), r16);
- jit_emit_stw(NATIVECODE, ISR1,
- offsetof(Parrot_Context, current_results), ISR2);
+ jit_emit_mov_ri_i(NATIVECODE, ISR1, jit_info->cur_op);
+ jit_emit_lwz(NATIVECODE, ISR2, offsetof(Interp, ctx), r16);
+ jit_emit_lwz(NATIVECODE, ISR2, offsetof(PMC, data), ISR2);
+ jit_emit_stw(NATIVECODE, ISR1,
+ offsetof(Parrot_Context, current_results), ISR2);
}
else {
PackFile_Constant **constants = CONTEXT(interp)->constants;
Modified: branches/kill_parrot_cont/src/jit/ppc/jit_emit.h
==============================================================================
--- branches/kill_parrot_cont/src/jit/ppc/jit_emit.h Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/jit/ppc/jit_emit.h Sun Sep 6 00:20:10 2009 (r41024)
@@ -675,7 +675,9 @@
jit_emit_lwz((pc), r15, offsetof(PackFile_Segment, data), ISR1)
# define jit_emit_branch_to_opcode(pc, D) \
- jit_emit_lwz((pc), r13, offsetof(Interp, ctx.bp), r16); \
+ jit_emit_lwz((pc), r13, offsetof(Interp, ctx), r16); \
+ jit_emit_lwz((pc), r13, offsetof(PMC, data), r13); \
+ jit_emit_lwz((pc), r13, offsetof(Parrot_Context, bp), r13); \
jit_emit_sub_rrr(jit_info->native_ptr, ISR1, (D), r15); \
jit_emit_lwzx(jit_info->native_ptr, ISR1, ISR1, r14); \
jit_emit_mtctr(jit_info->native_ptr, ISR1); \
Modified: branches/kill_parrot_cont/src/jit/sun4/jit_emit.h
==============================================================================
--- branches/kill_parrot_cont/src/jit/sun4/jit_emit.h Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/jit/sun4/jit_emit.h Sun Sep 6 00:20:10 2009 (r41024)
@@ -413,8 +413,12 @@
emitm_jumpl_i(jit_info->native_ptr, XSR1, 0, XSR1);
/* fixup where we have the Parrot registers - context switches */
- emitm_ld_i(jit_info->native_ptr, Parrot_jit_intrp, offsetof(Interp, ctx.bp),
- Parrot_jit_regbase);
+ emitm_ld_i(jit_info->native_ptr, Parrot_jit_intrp, offsetof(Interp, ctx),
+ Parrot_jit_intrp);
+ emitm_ld_i(jit_info->native_ptr, Parrot_jit_intrp, offsetof(PMC, data),
+ Parrot_jit_intrp);
+ emitm_ld_i(jit_info->native_ptr, Parrot_jit_intrp,
+ offsetof(Parrot_Context, bp), Parrot_jit_intrp);
}
/* Generate conditional branch to offset from current parrot op */
Modified: branches/kill_parrot_cont/src/misc.c
==============================================================================
--- branches/kill_parrot_cont/src/misc.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/misc.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -112,6 +112,8 @@
size_t len, ARGIN(const char *pat), va_list args)
{
ASSERT_ARGS(Parrot_vsnprintf)
+ char *str_ret;
+ size_t str_len;
if (len == 0)
return;
len--;
@@ -119,12 +121,15 @@
const STRING * const ret = Parrot_vsprintf_c(interp, pat, args);
/* string_transcode(interp, ret, NULL, NULL, &ret); */
- if (len > ret->bufused) {
- len = ret->bufused;
+ str_ret = Parrot_str_to_cstring(interp, ret);
+ str_len = strlen(str_ret);
+ if (len > str_len) {
+ len = str_len;
}
if (len)
- memcpy(targ, ret->strstart, len);
+ memcpy(targ, str_ret, len);
+ Parrot_str_free_cstring(str_ret);
}
targ[len] = 0;
}
Modified: branches/kill_parrot_cont/src/multidispatch.c
==============================================================================
--- branches/kill_parrot_cont/src/multidispatch.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/multidispatch.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -1229,7 +1229,8 @@
{
ASSERT_ARGS(mmd_add_multi_to_namespace)
PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp,
- interp->HLL_namespace, CONTEXT(interp)->current_HLL);
+ interp->HLL_namespace,
+ Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
PMC * const ns = Parrot_make_namespace_keyed_str(interp, hll_ns, ns_name);
PMC *multi_sub = Parrot_get_global(interp, ns, sub_name);
Modified: branches/kill_parrot_cont/src/oo.c
==============================================================================
--- branches/kill_parrot_cont/src/oo.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/oo.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -209,7 +209,7 @@
{
PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp,
interp->HLL_namespace,
- CONTEXT(interp)->current_HLL);
+ Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
PMC * const ns = Parrot_get_namespace_keyed(interp,
hll_ns, key);
@@ -286,7 +286,7 @@
/* Set custom GC mark and destroy on the object. */
PObj_custom_mark_SET(cloned);
- PObj_active_destroy_SET(cloned);
+ PObj_custom_destroy_SET(cloned);
/* Flag that it is an object */
PObj_is_object_SET(cloned);
@@ -421,7 +421,7 @@
/* First check in current HLL namespace */
PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace,
- CONTEXT(interp)->current_HLL);
+ Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
PMC * const ns = Parrot_get_namespace_keyed_str(interp, hll_ns, name);
PMC * const _class = PMC_IS_NULL(ns)
? PMCNULL : VTABLE_get_class(interp, ns);
Modified: branches/kill_parrot_cont/src/ops/core.ops
==============================================================================
--- branches/kill_parrot_cont/src/ops/core.ops Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/ops/core.ops Sun Sep 6 00:20:10 2009 (r41024)
@@ -447,7 +447,7 @@
inline op yield() :flow {
opcode_t *dest = expr NEXT();
- PMC * const p = CONTEXT(interp)->current_sub;
+ PMC * const p = Parrot_pcc_get_sub(interp, CURRENT_CONTEXT(interp));
dest = (opcode_t *)p->vtable->invoke(interp, p, dest);
goto ADDRESS(dest);
}
@@ -456,14 +456,14 @@
opcode_t *dest;
PMC * const p = $1;
dest = expr NEXT();
- interp->current_cont = CONTEXT(interp)->current_cont;
+ interp->current_cont = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
PObj_get_FLAGS(interp->current_cont) |= SUB_FLAG_TAILCALL;
dest = (opcode_t *)p->vtable->invoke(interp, p, dest);
goto ADDRESS(dest);
}
inline op returncc() :flow {
- PMC * const p = CONTEXT(interp)->current_cont;
+ PMC * const p = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
opcode_t * const dest = (opcode_t *)p->vtable->invoke(interp,
p, expr NEXT());
goto ADDRESS(dest);
@@ -527,24 +527,24 @@
PMC * const signature = $1;
INTVAL argc;
- CONTEXT(interp)->current_results = _this;
+ Parrot_pcc_set_results(interp, CURRENT_CONTEXT(interp), _this);
argc = VTABLE_elements(interp, signature);
goto OFFSET(argc + 2);
}
op get_params(inconst PMC) :flow {
opcode_t * const _this = CUR_OPCODE;
- Parrot_Context *caller_ctx, *ctx;
+ PMC *caller_ctx, *ctx;
PMC * ccont;
PMC * const signature = $1;
INTVAL argc;
opcode_t *src_indexes, *dst_indexes;
interp->current_params = _this;
- ctx = CONTEXT(interp);
- ccont = ctx->current_cont;
+ ctx = CURRENT_CONTEXT(interp);
+ ccont = Parrot_pcc_get_continuation(interp, ctx);
- caller_ctx = ctx->caller_ctx;
+ caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
src_indexes = interp->current_args;
dst_indexes = interp->current_params;
@@ -553,13 +553,11 @@
interp->current_params = NULL;
parrot_pass_args(interp, caller_ctx, ctx, src_indexes, dst_indexes, PARROT_PASS_PARAMS);
+ /* TODO Factor out with Sub.invoke */
if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
- --ctx->recursion_depth;
- ctx->caller_ctx = caller_ctx->caller_ctx;
- /* ordinarily, this will free the context immediately, but not if the
- sub created a closure (or continuation, or . . .). */
- Parrot_free_context(interp, caller_ctx, 1);
+ Parrot_pcc_dec_recursion_depth(interp, ctx);
+ Parrot_pcc_set_caller_ctx(interp, ctx, Parrot_pcc_get_caller_ctx(interp, caller_ctx));
interp->current_args = NULL;
}
argc = VTABLE_elements(interp, signature);
@@ -568,37 +566,38 @@
op set_returns(inconst PMC) :flow {
opcode_t * const _this = CUR_OPCODE;
- Parrot_Context *ctx;
+ PMC *ctx, *caller_ctx;
PMC *ccont;
PMC *signature = $1;
INTVAL argc;
opcode_t *src_indexes, *dest_indexes;
interp->current_returns = _this;
- ctx = CONTEXT(interp);
- ccont = ctx->current_cont;
+ ctx = CURRENT_CONTEXT(interp);
+ caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
+ ccont = Parrot_pcc_get_continuation(interp, ctx);
if (PARROT_CONTINUATION(ccont)->address) {
/* Call is from runops_fromc */
- Parrot_Context * const caller_ctx = PARROT_CONTINUATION(ccont)->to_ctx;
- if (! caller_ctx) {
+ caller_ctx = PARROT_CONTINUATION(ccont)->to_ctx;
+ if (PMC_IS_NULL(caller_ctx)) {
/* there is no point calling Parrot_ex_throw_..., because
PDB_backtrace can't deal with a missing to_ctx either. */
exit_fatal(1, "No caller_ctx for continuation %p.", ccont);
}
- src_indexes = interp->current_returns;
- dest_indexes = caller_ctx->current_results;
+ src_indexes = interp->current_returns;
+ dest_indexes = Parrot_pcc_get_results(interp, caller_ctx);
interp->current_returns = NULL;
/* does this need to be here */
interp->current_args = NULL;
parrot_pass_args(interp, ctx, caller_ctx, src_indexes, dest_indexes, PARROT_PASS_RESULTS);
}
- else if (ctx->caller_ctx->results_signature) {
+ else if (Parrot_pcc_get_results_signature(interp, caller_ctx)) {
/* We have a dynamic result signature, from pcc_invoke */
- parrot_pass_args(interp, ctx, ctx->caller_ctx, interp->current_returns,
- ctx->caller_ctx->current_results, PARROT_PASS_RESULTS);
+ parrot_pass_args(interp, ctx, caller_ctx, interp->current_returns,
+ Parrot_pcc_get_results(interp, caller_ctx), PARROT_PASS_RESULTS);
}
argc = VTABLE_elements(interp, signature);
goto OFFSET(argc + 2);
@@ -615,11 +614,11 @@
inline op result_info(out PMC) {
/* Get context of callee from return continuation. */
- PMC * const cc = CONTEXT(interp)->current_cont;
+ PMC * const cc = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
PMC *sig = NULL;
if (cc && PARROT_CONTINUATION(cc)->to_ctx) {
/* caller context has results */
- opcode_t * const results = PARROT_CONTINUATION(cc)->to_ctx->current_results;
+ opcode_t * const results = Parrot_pcc_get_results(interp, PARROT_CONTINUATION(cc)->to_ctx);
if (results) {
/* get results PMC index and get PMC. */
sig = PF_CONST(PARROT_CONTINUATION(cc)->seg, results[1])->u.key;
@@ -803,11 +802,7 @@
except = Parrot_ex_build_exception(interp, EXCEPT_fatal,
EXCEPTION_UNIMPLEMENTED,
Parrot_str_new_constant(interp, "Not a throwable object"));
- /*
- * We might return here after handling the exception, so mark the
- * current context appropriately.
- */
- Parrot_context_ref(interp, CONTEXT(interp));
+
VTABLE_set_attr_str(interp, except, Parrot_str_new_constant(interp, "resume"), resume);
dest = Parrot_ex_throw_from_op(interp, except, ret);
goto ADDRESS(dest);
@@ -1471,3 +1466,5 @@
* End:
* vim: expandtab shiftwidth=4:
*/
+
+
Modified: branches/kill_parrot_cont/src/ops/debug.ops
==============================================================================
--- branches/kill_parrot_cont/src/ops/debug.ops Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/ops/debug.ops Sun Sep 6 00:20:10 2009 (r41024)
@@ -121,7 +121,7 @@
inline op getline(out INT) {
Parrot_Context_info info;
- Parrot_Context_get_info(interp, CONTEXT(interp), &info);
+ Parrot_Context_get_info(interp, CURRENT_CONTEXT(interp), &info);
$1 = info.line;
}
@@ -133,7 +133,7 @@
inline op getfile(out STR) {
Parrot_Context_info info;
- Parrot_Context_get_info(interp, CONTEXT(interp), &info);
+ Parrot_Context_get_info(interp, CURRENT_CONTEXT(interp), &info);
$1 = info.file;
}
Modified: branches/kill_parrot_cont/src/ops/object.ops
==============================================================================
--- branches/kill_parrot_cont/src/ops/object.ops Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/ops/object.ops Sun Sep 6 00:20:10 2009 (r41024)
@@ -142,7 +142,7 @@
VTABLE_get_string(interp, VTABLE_get_class(interp, object)));
}
else {
- interp->current_cont = CONTEXT(interp)->current_cont;
+ interp->current_cont = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
PObj_get_FLAGS(interp->current_cont) |= SUB_FLAG_TAILCALL;
interp->current_object = object;
dest = (opcode_t *)VTABLE_invoke(interp, method_pmc, next);
@@ -157,7 +157,7 @@
opcode_t *dest;
- interp->current_cont = CONTEXT(interp)->current_cont;
+ interp->current_cont = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
PObj_get_FLAGS(interp->current_cont) |= SUB_FLAG_TAILCALL;
interp->current_object = object;
dest = (opcode_t *)VTABLE_invoke(interp, method_pmc, next);
Modified: branches/kill_parrot_cont/src/ops/ops.num
==============================================================================
--- branches/kill_parrot_cont/src/ops/ops.num Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/ops/ops.num Sun Sep 6 00:20:10 2009 (r41024)
@@ -1275,3 +1275,7 @@
find_name_p_sc 1251
find_sub_not_null_p_s 1252
find_sub_not_null_p_sc 1253
+store_dynamic_lex_s_p 1254
+store_dynamic_lex_sc_p 1255
+find_dynamic_lex_p_s 1256
+find_dynamic_lex_p_sc 1257
Modified: branches/kill_parrot_cont/src/ops/pic.ops
==============================================================================
--- branches/kill_parrot_cont/src/ops/pic.ops Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/ops/pic.ops Sun Sep 6 00:20:10 2009 (r41024)
@@ -132,18 +132,18 @@
PMC *sig, *ccont;
opcode_t *src_pc;
void **src_pred;
- Parrot_Context *caller_ctx, *ctx;
+ PMC *caller_ctx, *ctx;
int n;
/* avoid load dependencies - intermix derefs
* - yes, confusing but faster
*/
- ctx = CONTEXT(interp);
- src_pc = interp->current_args;
- mic = (Parrot_MIC *) cur_opcode[1];
- caller_ctx = ctx->caller_ctx;
+ ctx = CURRENT_CONTEXT(interp);
+ src_pc = interp->current_args;
+ mic = (Parrot_MIC *) cur_opcode[1];
+ caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
if (src_pc) {
- src_pred = (void**) src_pc - caller_ctx->pred_offset;
+ src_pred = (void**) src_pc - Parrot_pcc_get_pred_offset(interp, caller_ctx);
sig = (PMC*)(src_pred[1]);
}
else {
@@ -154,17 +154,17 @@
if (lru->u.signature == sig) {
if (sig) {
n = ((arg_pass_f)lru->f.real_function)(interp, sig,
- (char*)caller_ctx->bp.regs_i, src_pred,
+ (char*)Parrot_pcc_get_regs_ni(interp, caller_ctx)->regs_i, src_pred,
_reg_base, (void**)cur_opcode);
}
else
n = 2;
- ccont = ctx->current_cont;
+ ccont = Parrot_pcc_get_continuation(interp, ctx);
if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
- --ctx->recursion_depth;
- ctx->caller_ctx = caller_ctx->caller_ctx;
- Parrot_free_context(interp, caller_ctx, 1);
+ Parrot_pcc_dec_recursion_depth(interp, ctx);
+ Parrot_pcc_set_caller_ctx(interp, ctx,
+ Parrot_pcc_get_caller_ctx(interp, caller_ctx));
interp->current_args = NULL;
}
@@ -183,14 +183,15 @@
PMC *sig, *ccont;
opcode_t *dest_pc;
void **dest_pred;
- Parrot_Context *caller_ctx, *ctx;
+ PMC *caller_ctx, *ctx;
Parrot_Continuation_attributes *cc;
int n;
- ctx = CONTEXT(interp);
- mic = (Parrot_MIC *) cur_opcode[1];
- ccont = ctx->current_cont;
+ ctx = CURRENT_CONTEXT(interp);
+ mic = (Parrot_MIC *) cur_opcode[1];
+ ccont = Parrot_pcc_get_continuation(interp, ctx);
cc = PARROT_CONTINUATION(ccont);
+
if (!cc->address) {
interp->current_returns = CUR_OPCODE;
n = VTABLE_get_integer(interp, mic->m.sig);
@@ -198,9 +199,9 @@
}
caller_ctx = cc->to_ctx;
interp->current_args = NULL;
- dest_pc = caller_ctx->current_results;
+ dest_pc = Parrot_pcc_get_results(interp, caller_ctx);
if (dest_pc) {
- dest_pred = (void**) dest_pc - caller_ctx->pred_offset;
+ dest_pred = (void**) dest_pc - Parrot_pcc_get_pred_offset(interp, caller_ctx);
sig = (PMC*)(dest_pred[1]);
}
else {
@@ -212,7 +213,7 @@
if (sig) {
n = ((arg_pass_f)lru->f.real_function)(interp, mic->m.sig,
_reg_base, (void**)cur_opcode,
- (char*)caller_ctx->bp.regs_i, dest_pred);
+ (char*)Parrot_pcc_get_regs_ni(interp, caller_ctx)->regs_i, dest_pred);
}
else
n = 2;
@@ -239,18 +240,18 @@
Parrot_MIC *mic;
Parrot_PIC_lru *lru;
void *args[6]; /* RT#42355 ARG_MAX */
- Parrot_Context *ctx;
+ PMC *ctx;
opcode_t *pc;
void **pred_pc;
INTVAL i, n_args, *sig_bits;
PMC *sig;
- ctx = CONTEXT(interp);
+ ctx = CURRENT_CONTEXT(interp);
mic = (Parrot_MIC *) cur_opcode[1];
/* get_results */
- pc = ctx->current_results;
+ pc = Parrot_pcc_get_results(interp, ctx);
if (pc) {
- pred_pc = (void**) pc - ctx->pred_offset;
+ pred_pc = (void**) pc - Parrot_pcc_get_pred_offset(interp, ctx);
sig = (PMC*)(pred_pc[1]);
ASSERT_SIG_PMC(sig);
PARROT_ASSERT(VTABLE_elements(interp, sig) <= 1);
Modified: branches/kill_parrot_cont/src/ops/set.ops
==============================================================================
--- branches/kill_parrot_cont/src/ops/set.ops Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/ops/set.ops Sun Sep 6 00:20:10 2009 (r41024)
@@ -25,7 +25,10 @@
=cut
inline op clone(out STR, in STR) :base_mem {
- $1 = Parrot_str_copy(interp, $2);
+ /* cloning a NULL STRING produces an empty STRING; TT #964 */
+ $1 = $2
+ ? Parrot_str_copy(interp, $2)
+ : Parrot_str_new(interp, NULL, 0);
}
@@ -508,10 +511,10 @@
/* don't let the clone's destruction destroy the destination's data */
PObj_active_destroy_CLEAR(clone);
- PMC_data(clone) = NULL;
- PMC_metadata(clone) = NULL;
+ PMC_data(clone) = NULL;
+ PMC_sync(clone) = NULL;
+ PMC_metadata(clone) = NULL;
PMC_next_for_GC(clone) = NULL;
- PMC_sync(clone) = NULL;
/* Restore metadata. */
if (!PMC_IS_NULL(meta)) {
Modified: branches/kill_parrot_cont/src/ops/var.ops
==============================================================================
--- branches/kill_parrot_cont/src/ops/var.ops Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/ops/var.ops Sun Sep 6 00:20:10 2009 (r41024)
@@ -37,9 +37,9 @@
=cut
op store_lex(in STR, invar PMC) {
- Parrot_Context * const ctx = CONTEXT(interp);
- STRING * const lex_name = $1;
- PMC * const lex_pad = Parrot_find_pad(interp, lex_name, ctx);
+ PMC * const ctx = CURRENT_CONTEXT(interp);
+ STRING * const lex_name = $1;
+ PMC * const lex_pad = Parrot_find_pad(interp, lex_name, ctx);
if (PMC_IS_NULL(lex_pad)) {
opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, NULL,
@@ -52,6 +52,35 @@
########################################
+=item B<store_dynamic_lex>(in STR, invar PMC)
+
+Search caller lexpads for lexical symbol $1 and store object $2
+there. Throws an exception if no caller lexpad claims the
+lexical symbol. (To store a value in the current lexpad,
+use C<store_lex> above.)
+
+=cut
+
+op store_dynamic_lex(in STR, invar PMC) {
+ STRING * const lex_name = $1;
+ PMC * const ctx =
+ Parrot_pcc_get_caller_ctx(interp, CURRENT_CONTEXT(interp));
+ PMC * const lex_pad =
+ PMC_IS_NULL(ctx)
+ ? PMCNULL
+ : Parrot_find_dynamic_pad(interp, lex_name, ctx);
+
+ if (PMC_IS_NULL(lex_pad)) {
+ opcode_t * const handler = Parrot_ex_throw_from_op_args(interp, NULL,
+ EXCEPTION_LEX_NOT_FOUND,
+ "Lexical '%Ss' not found in dynamic scope", lex_name);
+ goto ADDRESS(handler);
+ }
+ VTABLE_set_pmc_keyed_str(interp, lex_pad, lex_name, $2);
+}
+
+########################################
+
=item B<find_lex>(out PMC, in STR)
Find the lexical variable named $2 and store it in $1. This
@@ -62,9 +91,9 @@
=cut
op find_lex(out PMC, in STR) {
- Parrot_Context * const ctx = CONTEXT(interp);
- STRING * const lex_name = $2;
- PMC * const lex_pad = Parrot_find_pad(interp, lex_name, ctx);
+ PMC * const ctx = CURRENT_CONTEXT(interp);
+ STRING * const lex_name = $2;
+ PMC * const lex_pad = Parrot_find_pad(interp, lex_name, ctx);
PMC * const result =
PMC_IS_NULL(lex_pad)
@@ -81,21 +110,48 @@
########################################
+=item B<find_dynamic_lex>(out PMC, in STR)
+
+Search through caller lexpads for a lexical variable named $2
+and store it in $1. Return a Null PMC if the lexical variable
+is not found. (To search the current lexpad, use C<find_lex>
+above.)
+
+=cut
+
+op find_dynamic_lex(out PMC, in STR) {
+ STRING * const lex_name = $2;
+ PMC * const ctx =
+ Parrot_pcc_get_caller_ctx(interp, CURRENT_CONTEXT(interp));
+ PMC * const lex_pad =
+ PMC_IS_NULL(ctx)
+ ? PMCNULL
+ : Parrot_find_dynamic_pad(interp, lex_name, ctx);
+ PMC * const result =
+ PMC_IS_NULL(lex_pad)
+ ? PMCNULL
+ : VTABLE_get_pmc_keyed_str(interp, lex_pad, lex_name);
+ $1 = result;
+}
+
+########################################
+
=item B<find_caller_lex>(out PMC, in STR)
-Like find_lex above, but searches through callers' lexical
-scopes (scanning up the dynamic chain) instead of the current
-lexical scope. Note that the I<current> lexical scope is not
-included in the search (use C<find_lex> above for that).
+Like find_dynamic_lex above, but also searches caller's
+outer scopes in addition to the lexpads.
=cut
op find_caller_lex(out PMC, in STR) {
- STRING * const lex_name = $2;
- Parrot_Context * ctx = CONTEXT(interp);
- PMC * result = PMCNULL;
-
- for (ctx = ctx->caller_ctx; ctx && PMC_IS_NULL(result); ctx = ctx->caller_ctx) {
+ STRING * const lex_name = $2;
+ PMC * ctx = CURRENT_CONTEXT(interp);
+ PMC * result = PMCNULL;
+
+ for (ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
+ !PMC_IS_NULL(ctx) && PMC_IS_NULL(result);
+ ctx = Parrot_pcc_get_caller_ctx(interp, ctx))
+ {
PMC * const lex_pad = Parrot_find_pad(interp, lex_name, ctx);
if (!PMC_IS_NULL(lex_pad)) {
result = VTABLE_get_pmc_keyed_str(interp, lex_pad, lex_name);
@@ -127,12 +183,12 @@
=cut
op get_namespace(out PMC) {
- PMC * const cur_ns = CONTEXT(interp)->current_namespace;
+ PMC * const cur_ns = Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp));
$1 = cur_ns;
}
op get_namespace(out PMC, in PMC) {
- PMC * const cur_ns = CONTEXT(interp)->current_namespace;
+ PMC * const cur_ns = Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp));
PMC * const ns = Parrot_get_namespace_keyed(interp, cur_ns, $2);
$1 = PMC_IS_NULL(ns) ? PMCNULL : ns;
@@ -215,12 +271,12 @@
=cut
op get_global(out PMC, in STR) {
- PMC * const cur_ns = CONTEXT(interp)->current_namespace;
+ PMC * const cur_ns = Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp));
$1 = Parrot_find_global_op(interp, cur_ns, $2, expr NEXT());
}
op get_global(out PMC, in PMC, in STR) {
- PMC * const cur_ns = CONTEXT(interp)->current_namespace;
+ PMC * const cur_ns = Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp));
if (PMC_IS_NULL(cur_ns)) {
$1 = PMCNULL;
}
@@ -319,12 +375,12 @@
=cut
op set_global(in STR, invar PMC) {
- PMC * const cur_ns = CONTEXT(interp)->current_namespace;
+ PMC * const cur_ns = Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp));
Parrot_set_global(interp, cur_ns, $1, $2);
}
op set_global(in PMC, in STR, invar PMC) {
- PMC * const cur_ns = CONTEXT(interp)->current_namespace;
+ PMC * const cur_ns = Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp));
PMC * const ns = Parrot_make_namespace_keyed(interp, cur_ns, $1);
Parrot_set_global(interp, ns, $2, $3);
Modified: branches/kill_parrot_cont/src/packdump.c
==============================================================================
--- branches/kill_parrot_cont/src/packdump.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/packdump.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -111,7 +111,7 @@
"on_free_list",
"custom_mark",
"custom_GC",
- "active_destroy",
+ "custom_destroy",
"report",
"data_is_PMC_array",
"need_finalize",
@@ -224,9 +224,8 @@
ct_index = PackFile_find_in_const(interp, ct, key, PFC_STRING);
Parrot_io_printf(interp, " PFC_OFFSET => %ld\n", ct_index);
detail = ct->constants[ct_index];
- Parrot_io_printf(interp, " DATA => '%.*s'\n",
- (int)detail->u.string->bufused,
- (char *)detail->u.string->strstart);
+ Parrot_io_printf(interp, " DATA => '%Ss'\n",
+ detail->u.string);
Parrot_io_printf(interp, " },\n");
}
break;
Modified: branches/kill_parrot_cont/src/packfile.c
==============================================================================
--- branches/kill_parrot_cont/src/packfile.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/packfile.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -682,7 +682,8 @@
&& interp->run_core != PARROT_FAST_CORE)
interp->run_core = PARROT_FAST_CORE;
- CONTEXT(interp)->constants = interp->code->const_table->constants;
+ Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp),
+ interp->code->const_table->constants);
retval = (PMC *)Parrot_runops_fromc_args(interp, sub_pmc, "P");
interp->run_core = old;
@@ -760,7 +761,7 @@
/ sizeof (opcode_t *);
PObj_get_FLAGS(sub_pmc) &= ~SUB_FLAG_PF_MAIN;
- CONTEXT(interp)->current_sub = sub_pmc;
+ Parrot_pcc_set_sub(interp, CURRENT_CONTEXT(interp), sub_pmc);
}
else {
Parrot_warn(interp, PARROT_WARNINGS_ALL_FLAG,
@@ -3084,13 +3085,13 @@
}
interp->code = new_cs;
- CONTEXT(interp)->constants = really
+ Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), really
? find_constants(interp, new_cs->const_table)
- : new_cs->const_table->constants;
+ : new_cs->const_table->constants);
/* new_cs->const_table->constants; */
- CONTEXT(interp)->pred_offset =
- new_cs->base.data - (opcode_t*) new_cs->prederef.code;
+ Parrot_pcc_set_pred_offset(interp, CURRENT_CONTEXT(interp),
+ new_cs->base.data - (opcode_t*) new_cs->prederef.code);
if (really)
prepare_for_run(interp);
Modified: branches/kill_parrot_cont/src/pic.c
==============================================================================
--- branches/kill_parrot_cont/src/pic.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pic.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -694,24 +694,24 @@
is_pic_param(PARROT_INTERP, ARGIN(void **pc), ARGOUT(Parrot_MIC *mic), opcode_t op)
{
ASSERT_ARGS(is_pic_param)
- PMC *sig2;
- Parrot_Context *caller_ctx;
- opcode_t *args;
- PMC * const sig1 = (PMC *)(pc[1]);
- const Parrot_Context * const ctx = CONTEXT(interp);
- int type = 0;
+ PMC *sig2;
+ PMC *caller_ctx;
+ opcode_t *args;
+ PMC * const sig1 = (PMC *)(pc[1]);
+ PMC *ctx = CURRENT_CONTEXT(interp);
+ int type = 0;
/* check params */
if (op == PARROT_OP_set_returns_pc) {
- PMC * const ccont = ctx->current_cont;
+ PMC * const ccont = Parrot_pcc_get_continuation(interp, ctx);
if (!PARROT_CONTINUATION(ccont)->address)
return 0;
caller_ctx = PARROT_CONTINUATION(ccont)->to_ctx;
- args = caller_ctx->current_results;
+ args = Parrot_pcc_get_results(interp, caller_ctx);
}
else {
- caller_ctx = ctx->caller_ctx;
+ caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
args = interp->current_args;
}
@@ -720,7 +720,7 @@
int n;
/* check current_args signature */
- sig2 = caller_ctx->constants[const_nr]->u.key;
+ sig2 = Parrot_pcc_get_pmc_constant(interp, caller_ctx, const_nr);
n = parrot_pic_check_sig(interp, sig1, sig2, &type);
if (n == -1)
@@ -799,14 +799,14 @@
opcode_t *op, n;
int flags;
- Parrot_Context * const ctx = CONTEXT(interp);
- PMC * const sig_args = (PMC *)(pc[1]);
+ PMC * const ctx = CURRENT_CONTEXT(interp);
+ PMC * const sig_args = (PMC *)(pc[1]);
ASSERT_SIG_PMC(sig_args);
n = VTABLE_elements(interp, sig_args);
- interp->current_args = (opcode_t*)pc + ctx->pred_offset;
+ interp->current_args = (opcode_t*)pc + Parrot_pcc_get_pred_offset(interp, ctx);
pc += 2 + n;
- op = (opcode_t*)pc + ctx->pred_offset;
+ op = (opcode_t*)pc + Parrot_pcc_get_pred_offset(interp, ctx);
if (*op != PARROT_OP_set_p_pc)
return 0;
@@ -820,7 +820,7 @@
return 0;
pc += 3; /* results */
- op = (opcode_t *)pc + ctx->pred_offset;
+ op = (opcode_t *)pc + Parrot_pcc_get_pred_offset(interp, ctx);
if (*op != PARROT_OP_get_results_pc)
return 0;
@@ -829,7 +829,7 @@
sig_results = (PMC *)(pc[1]);
ASSERT_SIG_PMC(sig_results);
- ctx->current_results = (opcode_t *)pc + ctx->pred_offset;
+ Parrot_pcc_set_results(interp, ctx, (opcode_t *)pc + Parrot_pcc_get_pred_offset(interp, ctx));
if (!parrot_pic_is_safe_to_jit(interp, sub, sig_args, sig_results, &flags))
return 0;
Modified: branches/kill_parrot_cont/src/pmc.c
==============================================================================
--- branches/kill_parrot_cont/src/pmc.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -109,16 +109,17 @@
{
ASSERT_ARGS(Parrot_pmc_destroy)
- if (PObj_active_destroy_TEST(pmc)) {
+ if (PObj_custom_destroy_TEST(pmc)) {
VTABLE_destroy(interp, pmc);
/* Prevent repeated calls. */
- PObj_active_destroy_CLEAR(pmc);
+ PObj_custom_destroy_CLEAR(pmc);
}
PObj_custom_mark_CLEAR(pmc);
PObj_live_CLEAR(pmc);
- Parrot_gc_free_pmc_sync(interp, pmc);
+ if (PObj_is_PMC_shared_TEST(pmc) && PMC_sync(pmc))
+ Parrot_gc_free_pmc_sync(interp, pmc);
if (pmc->vtable->attr_size) {
if (PMC_data(pmc)) {
@@ -894,7 +895,7 @@
/* anchor at parent, aka current_namespace, that is 'parrot' */
VTABLE_set_pmc_keyed_str(interp,
- CONTEXT(interp)->current_namespace, class_name, ns);
+ Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp)), class_name, ns);
}
_class = vtable->pmc_class;
Modified: branches/kill_parrot_cont/src/pmc/bigint.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/bigint.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/bigint.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -627,7 +627,7 @@
VTABLE void init() {
bigint_init(INTERP, SELF);
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
VTABLE PMC *clone() {
Modified: branches/kill_parrot_cont/src/pmc/bignum.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/bignum.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/bignum.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -841,7 +841,7 @@
VTABLE void init() {
bignum_init(INTERP, SELF);
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
VTABLE PMC *clone() {
Modified: branches/kill_parrot_cont/src/pmc/class.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/class.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/class.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -197,7 +197,7 @@
}
else {
PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp,
- interp->HLL_namespace, CONTEXT(interp)->current_HLL);
+ interp->HLL_namespace, Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp)));
new_namespace = Parrot_make_namespace_keyed(interp, hll_ns, name_arg);
}
@@ -1168,13 +1168,13 @@
/* Check that we have all methods listed in resolve list. */
const int resolve_count = VTABLE_elements(interp,
_class->resolve_method);
- const INTVAL cur_hll = CONTEXT(interp)->current_HLL;
+ const INTVAL cur_hll = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp));
const INTVAL num_parents = VTABLE_elements(interp, _class->parents);
INTVAL mro_length;
int i;
/* don't use HLL mappings for internal-only data */
- CONTEXT(interp)->current_HLL = 0;
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), 0);
for (i = 0; i < resolve_count; i++) {
STRING * const check_meth =
@@ -1211,7 +1211,7 @@
}
}
- CONTEXT(interp)->current_HLL = cur_hll;
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_hll);
}
/* Set instantiated flag. */
@@ -1222,7 +1222,7 @@
/* Set custom GC mark and destroy on the object. */
PObj_custom_mark_SET(object);
- PObj_active_destroy_SET(object);
+ PObj_custom_destroy_SET(object);
/* Flag that it is an object */
PObj_is_object_SET(object);
Copied: branches/kill_parrot_cont/src/pmc/context.pmc (from r41020, trunk/src/pmc/context.pmc)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/kill_parrot_cont/src/pmc/context.pmc Sun Sep 6 00:20:10 2009 (r41024, copy of r41020, trunk/src/pmc/context.pmc)
@@ -0,0 +1,165 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/pmc/context.pmc - Interpreter Context.
+
+=head1 DESCRIPTION
+
+Stores context of execution. Currently we store pointer to Parrot_Context
+structure in PMC_data.
+
+=head2 Vtable Functions
+
+=over 4
+
+=cut
+
+*/
+
+
+#include "parrot/packfile.h"
+
+pmclass Context {
+
+/*
+
+=item C<void init()>
+
+Initialize new Context. See C<Parrot_alloc_context>.
+
+=cut
+
+*/
+
+ VTABLE void init() {
+ PMC_data(SELF) = NULL;
+ PObj_custom_mark_destroy_SETALL(SELF);
+ }
+
+
+/*
+
+=item C<void mark()>
+
+Mark Context as alive.
+
+=cut
+
+*/
+
+ VTABLE void mark()
+ {
+ Parrot_Context * const ctx = PMC_data_typed(SELF, Parrot_Context*);
+ PObj *obj;
+ int i;
+
+ /* If Context wasn't initialised just return */
+ if (!ctx)
+ return;
+
+ obj = (PObj *)ctx->caller_ctx;
+ if (obj)
+ Parrot_gc_mark_PObj_alive(interp, obj);
+
+ obj = (PObj *)ctx->lex_pad;
+ if (obj)
+ Parrot_gc_mark_PObj_alive(interp, obj);
+
+ obj = (PObj *)ctx->outer_ctx;
+ if (obj)
+ Parrot_gc_mark_PObj_alive(interp, obj);
+
+ obj = (PObj *)ctx->current_sub;
+ if (obj)
+ Parrot_gc_mark_PObj_alive(interp, obj);
+
+ obj = (PObj *)ctx->handlers;
+ if (obj)
+ Parrot_gc_mark_PObj_alive(interp, obj);
+
+ obj = (PObj *)ctx->current_cont;
+ if (obj && !PObj_live_TEST(obj))
+ Parrot_gc_mark_PObj_alive(interp, obj);
+
+ obj = (PObj *)ctx->current_object;
+ if (obj)
+ Parrot_gc_mark_PObj_alive(interp, obj);
+
+ obj = (PObj *)ctx->current_namespace;
+ if (obj)
+ Parrot_gc_mark_PObj_alive(interp, obj);
+
+ obj = (PObj *)ctx->results_signature;
+ if (obj)
+ Parrot_gc_mark_PObj_alive(interp, obj);
+
+ if (!ctx->n_regs_used)
+ return;
+
+ for (i = 0; i < ctx->n_regs_used[REGNO_PMC]; ++i) {
+ /* Original code from CTX_REG_PMC */
+ obj = (PObj *)ctx->bp_ps.regs_p[-1L-(i)];
+ if (obj)
+ Parrot_gc_mark_PObj_alive(interp, obj);
+ }
+
+ for (i = 0; i < ctx->n_regs_used[REGNO_STR]; ++i) {
+ obj = (PObj *) ctx->bp_ps.regs_s[i];
+ if (obj)
+ Parrot_gc_mark_PObj_alive(interp, obj);
+ }
+ }
+
+/*
+
+=item C<void destroy()>
+
+Destroy Context and memory allocated by C<Parrot_alloc_context>.
+
+=cut
+
+*/
+
+ VTABLE void destroy() {
+ /* We own this pointer */
+ Parrot_Context * const ctx = PMC_data_typed(SELF, Parrot_Context*);
+ mem_sys_free(ctx);
+ }
+
+/*
+
+=item C<void *get_pointer()>
+
+Return pointer to underlying Parrot_Context structure.
+
+=cut
+
+*/
+
+ VTABLE void *get_pointer() {
+ return PMC_data(SELF);
+ }
+
+/*
+
+=item C<void set_pointer(void *)>
+
+Set new Parrot_Context structure.
+
+=cut
+
+*/
+ VTABLE void set_pointer(void *context) {
+ PMC_data(SELF) = context;
+ }
+}
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/kill_parrot_cont/src/pmc/continuation.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/continuation.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/continuation.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -49,9 +49,9 @@
/* continuation destination */
ATTR PackFile_ByteCode *seg; /* bytecode segment */
ATTR opcode_t *address; /* start of bytecode, addr to continue */
- ATTR Parrot_Context *to_ctx; /* pointer to dest context */
+ ATTR PMC *to_ctx; /* pointer to dest context */
/* a Continuation keeps the from_ctx alive */
- ATTR Parrot_Context *from_ctx; /* sub, this cont is returning from */
+ ATTR PMC *from_ctx; /* sub, this cont is returning from */
ATTR opcode_t *current_results; /* ptr into code with get_results opcode
full continuation only */
ATTR int runloop_id; /* id of the creating runloop. */
@@ -69,12 +69,12 @@
VTABLE void init() {
Parrot_Continuation_attributes *attrs = PARROT_CONTINUATION(SELF);
- attrs->to_ctx = CONTEXT(interp);
- attrs->from_ctx = Parrot_context_ref(interp, CONTEXT(interp));
- attrs->runloop_id = 0;
- attrs->seg = interp->code;
- attrs->address = NULL;
- attrs->current_results = attrs->to_ctx->current_results;
+ attrs->to_ctx = CURRENT_CONTEXT(interp);
+ attrs->from_ctx = CURRENT_CONTEXT(interp);
+ attrs->runloop_id = 0;
+ attrs->seg = interp->code;
+ attrs->address = NULL;
+ attrs->current_results = Parrot_pcc_get_results(interp, attrs->to_ctx);
PObj_active_destroy_SET(SELF);
PObj_custom_mark_destroy_SETALL(SELF);
@@ -93,12 +93,12 @@
VTABLE void init_pmc(PMC *values) {
Parrot_Continuation_attributes *attrs = PARROT_CONTINUATION(SELF);
- attrs->to_ctx = PARROT_CONTINUATION(values)->to_ctx;
- attrs->from_ctx = Parrot_context_ref(interp, CONTEXT(interp));
- attrs->runloop_id = 0;
- attrs->seg = PARROT_CONTINUATION(values)->seg;
- attrs->address = PARROT_CONTINUATION(values)->address;
- attrs->current_results = attrs->to_ctx->current_results;
+ attrs->to_ctx = PARROT_CONTINUATION(values)->to_ctx;
+ attrs->from_ctx = CURRENT_CONTEXT(interp);
+ attrs->runloop_id = 0;
+ attrs->seg = PARROT_CONTINUATION(values)->seg;
+ attrs->address = PARROT_CONTINUATION(values)->address;
+ attrs->current_results = Parrot_pcc_get_results(interp, attrs->to_ctx);
PObj_active_destroy_SET(SELF);
PObj_custom_mark_destroy_SETALL(SELF);
@@ -132,9 +132,9 @@
Parrot_gc_mark_PObj_alive(interp, (PObj *)cc->seg);
if (cc->to_ctx)
- mark_context(INTERP, cc->to_ctx);
+ Parrot_gc_mark_PObj_alive(INTERP, (PObj *) cc->to_ctx);
if (cc->from_ctx)
- mark_context(INTERP, cc->from_ctx);
+ Parrot_gc_mark_PObj_alive(INTERP, (PObj *) cc->from_ctx);
}
/*
@@ -149,18 +149,8 @@
VTABLE void destroy() {
Parrot_Continuation_attributes * const cc = PARROT_CONTINUATION(SELF);
- if (cc) {
-#if CTX_LEAK_DEBUG
- if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
- fprintf(stderr,
- "[destroy cont %p, to_ctx %p, from_ctx %p]\n",
- (void *)SELF, (void *)cc->to_ctx, (void *)cc->from_ctx);
- }
-
-#endif
- if (cc->from_ctx)
- Parrot_free_context(interp, cc->from_ctx, 1);
- }
+ if (cc)
+ mem_sys_free(cc);
}
/*
@@ -173,11 +163,7 @@
*/
VTABLE PMC *clone() {
-
PMC * ret = pmc_new_init(interp, enum_class_Continuation, SELF);
-
- /* free ret's PMC_cont */
- Parrot_free_context(interp, PARROT_CONTINUATION(ret)->from_ctx, 1);
return ret;
}
@@ -265,19 +251,20 @@
*/
VTABLE opcode_t *invoke(void *next) {
- Parrot_Context *from_ctx = CONTEXT(interp);
- Parrot_Context *to_ctx = PARROT_CONTINUATION(SELF)->to_ctx;
- opcode_t *pc = PARROT_CONTINUATION(SELF)->address;
+ Parrot_cont *cc = PMC_cont(SELF);
+ PMC *from_ctx = CURRENT_CONTEXT(interp);
+ PMC *to_ctx = cc->to_ctx;
+ opcode_t *pc = cc->address;
UNUSED(next)
Parrot_continuation_check(interp, SELF);
Parrot_continuation_rewind_environment(interp, SELF);
/* pass args to where caller wants result */
- if (PARROT_CONTINUATION(SELF)->current_results)
- to_ctx->current_results = PARROT_CONTINUATION(SELF)->current_results;
+ if (cc->current_results)
+ Parrot_pcc_set_results(interp, to_ctx, cc->current_results);
- if (to_ctx->current_results && INTERP->current_args) {
+ if (Parrot_pcc_get_results(interp, to_ctx) && INTERP->current_args) {
/*
* the register pointer is already switched back
* to the caller, therefore the registers of the
@@ -286,7 +273,7 @@
* therefore we have to block GC
*/
opcode_t *src_indexes = interp->current_args;
- opcode_t *dest_indexes = to_ctx->current_results;
+ opcode_t *dest_indexes = Parrot_pcc_get_results(interp, to_ctx);
interp->current_args = NULL;
Parrot_block_GC_mark(INTERP);
@@ -330,7 +317,7 @@
METHOD caller() {
Parrot_Continuation_attributes *cc = PARROT_CONTINUATION(SELF);
- PMC *caller = cc->to_ctx->current_sub;
+ PMC *caller = Parrot_pcc_get_sub(interp, cc->to_ctx);
Parrot_Sub_attributes *sub;
if (!caller)
@@ -356,7 +343,7 @@
METHOD continuation() {
Parrot_Continuation_attributes *cc = PARROT_CONTINUATION(SELF);
- PMC *cont = cc->to_ctx->current_cont;
+ PMC *cont = Parrot_pcc_get_continuation(interp, cc->to_ctx);
if (cont)
RETURN(PMC *cont);
Modified: branches/kill_parrot_cont/src/pmc/coroutine.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/coroutine.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/coroutine.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -49,7 +49,7 @@
if (co->ctx && (PObj_get_FLAGS(sub_pmc) & SUB_FLAG_CORO_FF)) {
Parrot_io_eprintf(tracer, " to '%Ss'",
Parrot_full_sub_name(interp,
- co->ctx->caller_ctx->current_sub));
+ Parrot_pcc_get_sub(interp, Parrot_pcc_get_caller_ctx(interp, co->ctx))));
}
Parrot_io_eprintf(tracer, "\n# ");
@@ -128,8 +128,8 @@
print_sub_name(INTERP, SELF);
if (!co->ctx) {
- Parrot_Context *caller_ctx;
- Parrot_Context *ctx;
+ PMC *caller_ctx;
+ PMC *ctx;
PMC *ccont;
ccont = INTERP->current_cont;
@@ -143,27 +143,27 @@
"tail call to coro not allowed");
/* first time set current sub, cont, object */
- caller_ctx = CONTEXT(interp);
+ caller_ctx = CURRENT_CONTEXT(interp);
ctx = Parrot_set_new_context(INTERP, co->n_regs_used);
- co->ctx = Parrot_context_ref(interp, ctx);
+ co->ctx = ctx;
- ctx->caller_ctx = caller_ctx;
+ Parrot_pcc_set_caller_ctx(INTERP, ctx, caller_ctx);
PARROT_CONTINUATION(ccont)->from_ctx = ctx;
- ctx->current_sub = SELF;
- ctx->current_HLL = co->HLL_id;
- ctx->current_namespace = co->namespace_stash;
- ctx->current_cont = ccont;
- ctx->current_object = NULL;
- INTERP->current_object = NULL;
- INTERP->current_cont = NULL;
+ Parrot_pcc_set_sub(INTERP, ctx, SELF);
+ Parrot_pcc_set_HLL(interp, ctx, co->HLL_id);
+ Parrot_pcc_set_namespace(INTERP, ctx, co->namespace_stash);
+ Parrot_pcc_set_continuation(INTERP, ctx, ccont);
+ Parrot_pcc_set_object(interp, ctx, NULL);
+ INTERP->current_object = NULL;
+ INTERP->current_cont = NULL;
/* create pad if needed */
if (!PMC_IS_NULL(co->lex_info)) {
- ctx->lex_pad = pmc_new_init(INTERP,
+ Parrot_pcc_set_lex_pad(INTERP, ctx, pmc_new_init(INTERP,
Parrot_get_ctx_HLL_type(interp, enum_class_LexPad),
- co->lex_info);
- VTABLE_set_pointer(INTERP, ctx->lex_pad, ctx);
+ co->lex_info));
+ VTABLE_set_pointer(INTERP, Parrot_pcc_get_lex_pad(INTERP, ctx), ctx);
}
PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF;
@@ -175,7 +175,7 @@
/* if calling the Coro we need the segment of the Coro */
else if (!(PObj_get_FLAGS(SELF) & SUB_FLAG_CORO_FF)) {
PMC *ccont;
- Parrot_Context *ctx;
+ PMC *ctx;
PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF;
wanted_seg = co->seg;
@@ -185,24 +185,22 @@
ctx = co->ctx;
/* and the recent call context */
- ccont = ctx->current_cont;
- ctx->caller_ctx = PARROT_CONTINUATION(ccont)->to_ctx
- = CONTEXT(interp);
+ ccont = Parrot_pcc_get_continuation(INTERP, ctx);
+ PMC_cont(ccont)->to_ctx = CURRENT_CONTEXT(interp);
+ Parrot_pcc_set_caller_ctx(interp, ctx, CURRENT_CONTEXT(interp));
/* set context to coro context */
- CONTEXT(interp) = ctx;
- INTERP->ctx.bp = ctx->bp;
- INTERP->ctx.bp_ps = ctx->bp_ps;
+ CURRENT_CONTEXT(interp) = ctx;
}
else {
PMC *ccont;
- Parrot_Context *ctx;
+ PMC *ctx;
PObj_get_FLAGS(SELF) &= ~SUB_FLAG_CORO_FF;
/* switch back to last remembered code seg and context */
wanted_seg = co->caller_seg;
- ccont = co->ctx->current_cont;
+ ccont = Parrot_pcc_get_continuation(INTERP, co->ctx);
ctx = PARROT_CONTINUATION(ccont)->to_ctx;
if (! ctx) {
@@ -215,9 +213,7 @@
"Cannot resume dead coroutine.");
}
- CONTEXT(interp) = ctx;
- INTERP->ctx.bp = ctx->bp;
- INTERP->ctx.bp_ps = ctx->bp_ps;
+ CURRENT_CONTEXT(interp) = ctx;
}
/* toggle address */
Modified: branches/kill_parrot_cont/src/pmc/eventhandler.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/eventhandler.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/eventhandler.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -39,7 +39,7 @@
VTABLE void init() {
PObj_custom_mark_SET(SELF);
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
@@ -101,7 +101,7 @@
INTERP->iglobals, IGLOBALS_INTERPRETER);
PObj_custom_mark_SET(SELF);
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
e->type = type;
e->code = code;
Modified: branches/kill_parrot_cont/src/pmc/exception.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/exception.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/exception.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -65,8 +65,8 @@
ATTR PMC *backtrace; /* The backtrace of an exception. */
ATTR INTVAL handled; /* Whether the exception has been handled. */
ATTR PMC *handler_iter; /* An iterator of handlers (for rethrow). */
- ATTR Parrot_Context *handler_ctx; /* A stored context for handler iterator. */
- ATTR Parrot_Context *thrower; /* The position we were at when thrown. */
+ ATTR PMC *handler_ctx; /* A stored context for handler iterator. */
+ ATTR PMC *thrower; /* The position we were at when thrown. */
/*
@@ -84,7 +84,7 @@
VTABLE void init() {
/* Set flags for custom GC mark and destroy. */
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
PObj_custom_mark_SET(SELF);
SET_ATTR_severity(INTERP, SELF, EXCEPT_error);
@@ -124,7 +124,7 @@
}
/* Set flags for custom GC mark. */
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
PObj_custom_mark_SET(SELF);
/* Set up the core struct and default values for the exception object. */
@@ -161,22 +161,10 @@
Parrot_gc_mark_PObj_alive(interp, (PObj *)core_struct->backtrace);
if (core_struct->handler_iter)
Parrot_gc_mark_PObj_alive(interp, (PObj *)core_struct->handler_iter);
- }
-
-/*
-
-=item C<void destroy()>
-
-Destroys the exception.
-
-=cut
-
-*/
-
- VTABLE void destroy() {
- Parrot_Exception_attributes * const core_struct = PARROT_EXCEPTION(SELF);
- if (core_struct && core_struct->thrower)
- Parrot_free_context(interp, core_struct->thrower, 1);
+ if (core_struct->handler_ctx)
+ Parrot_gc_mark_PObj_alive(interp, (PObj *)core_struct->handler_ctx);
+ if (core_struct->thrower)
+ Parrot_gc_mark_PObj_alive(interp, (PObj *)core_struct->thrower);
}
/*
@@ -495,11 +483,7 @@
VTABLE void set_pointer(void *context) {
Parrot_Exception_attributes * const core_struct = PARROT_EXCEPTION(SELF);
- /* contexts are refcounted; increment and decrement appropriately */
- if (core_struct->handler_ctx)
- Parrot_free_context(interp, core_struct->handler_ctx, 1);
- core_struct->handler_ctx = Parrot_context_ref(interp,
- (Parrot_Context *)context);
+ core_struct->handler_ctx = (PMC*)context;
}
/*
@@ -657,15 +641,11 @@
SET_ATTR_handler_iter(interp, SELF, value);
}
else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "thrower"))) {
- /* Ensure it's a ret cont, and extract the from_ctx.
- * XXX TT#596 - when we have Context PMCs, just take and set that. */
-
+ /* Ensure it's a ret cont, and extract the from_ctx. */
if (!PMC_IS_NULL(value) && VTABLE_isa(interp, value, CONST_STRING(interp, "Continuation"))) {
- Parrot_Context *ctx = PARROT_CONTINUATION(value)->from_ctx;
- if (ctx) {
- Parrot_context_ref(interp, ctx);
+ PMC *ctx = PARROT_CONTINUATION(value)->from_ctx;
+ if (!PMC_IS_NULL(ctx))
SET_ATTR_thrower(interp, SELF, ctx);
- }
}
}
else {
@@ -761,7 +741,7 @@
METHOD backtrace() {
PMC *result = pmc_new(interp, enum_class_ResizablePMCArray);
PMC *resume;
- Parrot_Context *cur_ctx;
+ PMC *cur_ctx;
Parrot_Continuation_attributes *cont;
/* Get starting context, then loop over them. */
@@ -785,7 +765,7 @@
Parrot_Sub_attributes *sub;
/* Get sub and put it in the hash. */
- PMC *sub_pmc = cur_ctx->current_sub;
+ PMC *sub_pmc = Parrot_pcc_get_sub(interp, cur_ctx);
if (!sub_pmc)
sub_pmc = PMCNULL;
@@ -800,7 +780,7 @@
PackFile_ByteCode *seg = sub->seg;
opcode_t *pc = cont && cur_ctx == cont->to_ctx
? cont->address
- : cur_ctx->current_pc;
+ : Parrot_pcc_get_pc(interp, cur_ctx);
annotations = PackFile_Annotations_lookup(interp,
seg->annotations, pc - seg->base.data,
@@ -815,7 +795,7 @@
/* Push frame and go to next caller. */
VTABLE_push_pmc(interp, result, frame);
- cur_ctx = cur_ctx->caller_ctx;
+ cur_ctx = Parrot_pcc_get_caller_ctx(interp, cur_ctx);
}
}
Modified: branches/kill_parrot_cont/src/pmc/exporter.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/exporter.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/exporter.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -109,7 +109,7 @@
VTABLE void init() {
/* Set up the object. */
SET_ATTR_ns_src(INTERP, SELF, PMCNULL);
- SET_ATTR_ns_dest(INTERP, SELF, CONTEXT(interp)->current_namespace);
+ SET_ATTR_ns_dest(INTERP, SELF, Parrot_pcc_get_namespace(INTERP, CURRENT_CONTEXT(INTERP)));
SET_ATTR_globals(INTERP, SELF, PMCNULL);
/* Set flags for custom GC mark and destroy. */
Modified: branches/kill_parrot_cont/src/pmc/filehandle.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/filehandle.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/filehandle.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -84,7 +84,7 @@
data_struct->os_handle = (PIOHANDLE) PIO_INVALID_HANDLE;
PObj_custom_mark_SET(SELF);
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
Modified: branches/kill_parrot_cont/src/pmc/fixedbooleanarray.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/fixedbooleanarray.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/fixedbooleanarray.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -45,7 +45,7 @@
*/
VTABLE void init() {
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
@@ -97,7 +97,7 @@
SET_ATTR_bit_array(INTERP, dest, clone_bit_array);
}
- PObj_active_destroy_SET(dest);
+ PObj_custom_destroy_SET(dest);
return dest;
}
@@ -550,15 +550,15 @@
if (info->extra_flags == EXTRA_IS_NULL) {
unsigned char * bit_array;
+ UINTVAL threshold;
const INTVAL size = VTABLE_shift_integer(INTERP, io);
STRING * const s = VTABLE_shift_string(INTERP, io);
- bit_array = (unsigned char*)mem_sys_allocate_zeroed(s->bufused);
- mem_sys_memcopy(bit_array, s->strstart, s->bufused);
+ bit_array = (unsigned char *)Parrot_str_to_cstring(INTERP, s);
+ threshold = Parrot_str_byte_length(interp, s) * BITS_PER_CHAR;
SET_ATTR_size(INTERP, SELF, size);
- SET_ATTR_resize_threshold(INTERP, SELF,
- s->bufused * BITS_PER_CHAR);
+ SET_ATTR_resize_threshold(INTERP, SELF, threshold);
SET_ATTR_bit_array(INTERP, SELF, bit_array);
}
}
Modified: branches/kill_parrot_cont/src/pmc/fixedfloatarray.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/fixedfloatarray.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/fixedfloatarray.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -73,7 +73,7 @@
dest_float_array = (FLOATVAL*)mem_sys_allocate(mem_size);
mem_sys_memcopy(dest_float_array, self_float_array, mem_size);
SET_ATTR_float_array(INTERP, dest, dest_float_array);
- PObj_active_destroy_SET(dest);
+ PObj_custom_destroy_SET(dest);
return dest;
}
@@ -290,7 +290,7 @@
SET_ATTR_size(INTERP, SELF, new_size);
SET_ATTR_float_array(INTERP, SELF,
mem_allocate_n_typed(new_size, FLOATVAL));
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
Modified: branches/kill_parrot_cont/src/pmc/fixedintegerarray.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/fixedintegerarray.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/fixedintegerarray.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -40,7 +40,7 @@
*/
VTABLE void init() {
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
@@ -190,7 +190,7 @@
SET_ATTR_int_array(INTERP, dest, dest_int_array);
mem_sys_memcopy(dest_int_array, int_array, size * sizeof (INTVAL));
- PObj_active_destroy_SET(dest);
+ PObj_custom_destroy_SET(dest);
}
return dest;
@@ -432,7 +432,7 @@
GET_ATTR_int_array(INTERP, SELF, int_array);
SET_ATTR_int_array(INTERP, SELF,
mem_realloc_n_typed(int_array, size, INTVAL));
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
@@ -636,11 +636,7 @@
}
VTABLE void thaw(visit_info *info) {
-
- Parrot_FixedIntegerArray_attributes *attrs =
- mem_allocate_zeroed_typed(Parrot_FixedIntegerArray_attributes);
- PMC_data(SELF) = attrs;
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
if (info->extra_flags == EXTRA_IS_NULL) {
IMAGE_IO * const io = info->image_io;
Modified: branches/kill_parrot_cont/src/pmc/hash.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/hash.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/hash.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -620,16 +620,20 @@
for (j = 0; j < n; ++j) {
STRING * const key = VTABLE_shift_string(INTERP, iter);
+ char * key_str;
+ size_t i, str_len;
int all_digit = 1;
- int i;
PMC *val;
- for (i = 0; i < (int)key->strlen; ++i) {
- if (!isdigit((unsigned char)((const char *)key->strstart)[i])) {
+ key_str = Parrot_str_to_cstring(INTERP, key);
+ str_len = strlen(key_str);
+ for (i = 0; i < str_len; ++i) {
+ if (!isdigit((unsigned char)key_str[i])) {
all_digit = 0;
break;
}
}
+ Parrot_str_free_cstring(key_str);
if (all_digit) {
res = Parrot_str_append(INTERP, res, key);
Modified: branches/kill_parrot_cont/src/pmc/hashiteratorkey.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/hashiteratorkey.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/hashiteratorkey.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -44,21 +44,23 @@
Parrot_HashIteratorKey_attributes *attrs =
PARROT_HASHITERATORKEY(SELF);
- switch (attrs->parrot_hash->key_type) {
- case Hash_key_type_int:
- return Parrot_str_from_int(INTERP, (INTVAL)attrs->bucket->key);
-
- case Hash_key_type_STRING:
- return (STRING*)attrs->bucket->key;
-
- case Hash_key_type_PMC:
- return VTABLE_get_string(INTERP, (PMC *)attrs->bucket->key);
-
- default:
- /* Horribly die? */
- break;
+ if (attrs->parrot_hash) {
+ switch (attrs->parrot_hash->key_type) {
+ case Hash_key_type_int:
+ return Parrot_str_from_int(INTERP, (INTVAL)attrs->bucket->key);
+
+ case Hash_key_type_STRING:
+ return (STRING*)attrs->bucket->key;
+
+ case Hash_key_type_PMC:
+ return VTABLE_get_string(INTERP, (PMC *)attrs->bucket->key);
+
+ default:
+ break;
+ }
}
+ /* Horribly die? */
return NULL;
}
Modified: branches/kill_parrot_cont/src/pmc/lexinfo.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/lexinfo.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/lexinfo.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -71,7 +71,7 @@
(hash_hash_key_fn)Parrot_str_to_hashval); /* hash */
SELF.set_pointer(hash);
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
Modified: branches/kill_parrot_cont/src/pmc/lexpad.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/lexpad.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/lexpad.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -22,13 +22,13 @@
* LexPad provides a Hash interface for lexical fetch/store
* needed
*
- * struct_val ... Parrot_Context *ctx
+ * struct_val ... Context *ctx
* pmc_val ... LexInfo
*/
pmclass LexPad provides hash no_ro auto_attrs {
- ATTR PMC *lexinfo;
- ATTR struct Parrot_Context *ctx;
+ ATTR PMC *lexinfo;
+ ATTR PMC *ctx;
VTABLE void init() {
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
@@ -82,7 +82,7 @@
}
VTABLE void set_pointer(void *ctx) {
- SET_ATTR_ctx(INTERP, SELF, (struct Parrot_Context *)ctx);
+ SET_ATTR_ctx(INTERP, SELF, (PMC *)ctx);
}
VTABLE INTVAL elements() {
@@ -107,7 +107,7 @@
VTABLE PMC *get_pmc_keyed_str(STRING *name) {
PMC * info;
Hash * hash;
- Parrot_Context * ctx;
+ PMC * ctx;
HashBucket * b;
INTVAL regno;
@@ -132,7 +132,7 @@
VTABLE void set_pmc_keyed_str(STRING *name, PMC *value) {
PMC * info;
Hash * hash;
- Parrot_Context * ctx;
+ PMC * ctx;
HashBucket * b;
INTVAL regno;
Modified: branches/kill_parrot_cont/src/pmc/managedstruct.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/managedstruct.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/managedstruct.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -46,7 +46,7 @@
*/
VTABLE void init() {
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
Modified: branches/kill_parrot_cont/src/pmc/nci.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/nci.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/nci.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -255,7 +255,6 @@
void *orig_func;
PMC * const ret = pmc_new(INTERP, SELF->vtable->base_type);
- PMC_data(ret) = mem_allocate_zeroed_typed(Parrot_NCI_attributes);
nci_info_ret = PARROT_NCI(ret);
/* FIXME if data is malloced (JIT/i386!) then we need
@@ -302,6 +301,7 @@
VTABLE opcode_t *invoke(void *next) {
Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
nci_sub_t func;
+ char *sig_str;
void *orig_func;
PMC *cont;
@@ -324,7 +324,9 @@
nci_jit_sub_t jit_func = (nci_jit_sub_t) D2FPTR(nci_info->func);
/* Parrot_eprintf(interp, "JITTED %S\n", nci_info->signature); */
- jit_func(INTERP, SELF, (char *) nci_info->pcc_params_signature->strstart);
+ sig_str = Parrot_str_to_cstring(interp, nci_info->pcc_params_signature);
+ jit_func(INTERP, SELF, sig_str);
+ Parrot_str_free_cstring(sig_str);
}
else {
if (PObj_flag_TEST(private2, SELF)) {
@@ -346,7 +348,7 @@
*/
if (cont && cont != NEED_CONTINUATION
&& (PObj_get_FLAGS(cont) & SUB_FLAG_TAILCALL)) {
- cont = CONTEXT(interp)->current_cont;
+ cont = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
next = VTABLE_invoke(INTERP, cont, next);
}
Modified: branches/kill_parrot_cont/src/pmc/object.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/object.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/object.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -27,11 +27,11 @@
get_attrib_index(PARROT_INTERP, PMC *self, STRING *name)
{
Parrot_Class_attributes * const _class = PARROT_CLASS(self);
- const INTVAL cur_hll = CONTEXT(interp)->current_HLL;
+ const INTVAL cur_hll = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp));
int num_classes, i;
INTVAL retval;
- CONTEXT(interp)->current_HLL = 0;
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), 0);
/* First see if we can find it in the cache. */
retval = VTABLE_get_integer_keyed_str(interp,
@@ -40,7 +40,7 @@
/* there's a semi-predicate problem with a retval of 0 */
if (retval
|| VTABLE_exists_keyed_str(interp, _class->attrib_cache, name)) {
- CONTEXT(interp)->current_HLL = cur_hll;
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_hll);
return retval;
}
@@ -65,12 +65,12 @@
VTABLE_set_integer_keyed_str(interp, _class->attrib_cache, name,
index);
- CONTEXT(interp)->current_HLL = cur_hll;
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_hll);
return index;
}
}
- CONTEXT(interp)->current_HLL = cur_hll;
+ Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_hll);
return -1;
}
@@ -695,10 +695,6 @@
if (info->extra_flags == EXTRA_IS_PROP_HASH) {
SUPER(info);
}
- else if (info->extra_flags == EXTRA_IS_NULL) {
- /* Allocate the object's core data struct */
- PMC_data(SELF) = mem_allocate_zeroed_typed(Parrot_Object_attributes);
- }
}
/*
@@ -714,7 +710,7 @@
VTABLE void thawfinish(visit_info *info) {
/* Set custom GC mark and destroy on the object. */
PObj_custom_mark_SET(SELF);
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
/* Flag that it is an object */
PObj_is_object_SET(SELF);
Modified: branches/kill_parrot_cont/src/pmc/packfileannotation.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/packfileannotation.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/packfileannotation.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -42,7 +42,7 @@
Parrot_PackfileAnnotation_attributes * attrs =
mem_allocate_zeroed_typed(Parrot_PackfileAnnotation_attributes);
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
PMC_data(SELF) = attrs;
}
Modified: branches/kill_parrot_cont/src/pmc/packfileconstanttable.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/packfileconstanttable.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/packfileconstanttable.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -395,6 +395,20 @@
return i;
}
+/*
+
+=item C<METHOD type()>
+
+Set segment type.
+
+=cut
+
+*/
+
+ METHOD type() {
+ RETURN(INTVAL PF_CONST_SEG);
+ }
+
}
/*
Modified: branches/kill_parrot_cont/src/pmc/packfilefixuptable.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/packfilefixuptable.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/packfilefixuptable.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -198,6 +198,20 @@
}
+/*
+
+=item C<METHOD type()>
+
+Set segment type.
+
+=cut
+
+*/
+
+ METHOD type() {
+ RETURN(INTVAL PF_FIXUP_SEG);
+ }
+
}
/*
Modified: branches/kill_parrot_cont/src/pmc/packfilerawsegment.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/packfilerawsegment.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/packfilerawsegment.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -25,6 +25,8 @@
*/
pmclass PackfileRawSegment extends PackfileSegment {
+ /* Type of segment */
+ ATTR INTVAL type;
/* ResizableIntegerArray of opcodes */
ATTR PMC *opcodes;
@@ -43,6 +45,7 @@
mem_allocate_zeroed_typed(Parrot_PackfileRawSegment_attributes);
attrs->opcodes = pmc_new(interp, enum_class_ResizableIntegerArray);
+ attrs->type = PF_BYTEC_SEG;
PObj_custom_mark_destroy_SETALL(SELF);
PMC_data(SELF) = attrs;
@@ -103,9 +106,14 @@
VTABLE void set_pointer(void * pointer) {
const PackFile_Segment * const pfseg =
(const PackFile_Segment *)pointer;
- PMC * opcodes = PARROT_PACKFILERAWSEGMENT(SELF)->opcodes;
+ Parrot_PackfileRawSegment_attributes * attrs =
+ PARROT_PACKFILERAWSEGMENT(SELF);
+ PMC * opcodes = attrs->opcodes;
size_t i;
+ /* Preserve type of unpacked segment */
+ attrs->type = pfseg->type;
+
if (pfseg->size) {
/* copy data to own array */
VTABLE_set_integer_native(interp, opcodes, pfseg->size);
@@ -132,7 +140,7 @@
PMC * opcodes = attrs->opcodes;
size_t i;
- pfseg->type = PF_BYTEC_SEG;
+ pfseg->type = attrs->type;
pfseg->size = VTABLE_get_integer(interp, opcodes);
pfseg->data = mem_allocate_n_typed(pfseg->size, opcode_t);
@@ -187,6 +195,30 @@
PARROT_PACKFILERAWSEGMENT(SELF)->opcodes, key, value);
}
+/*
+
+=item C<METHOD type()>
+
+Set of get segment type.
+
+=cut
+
+TODO: Don't allow create Directory, Annotations, etc segments.
+
+*/
+
+ METHOD type(INTVAL type :optional, INTVAL got_type :opt_flag) {
+ Parrot_PackfileRawSegment_attributes * attrs =
+ PARROT_PACKFILERAWSEGMENT(SELF);
+ INTVAL res;
+
+ if (got_type) {
+ attrs->type = type;
+ }
+
+ res = attrs->type;
+ RETURN(INTVAL res);
+ }
}
/*
Modified: branches/kill_parrot_cont/src/pmc/parrotinterpreter.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/parrotinterpreter.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/parrotinterpreter.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -242,7 +242,7 @@
if (!PMC_interp(SELF)) {
create_interp(SELF, INTERP);
}
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
@@ -268,7 +268,7 @@
if (!PMC_interp(SELF)) {
create_interp(SELF, p);
}
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
@@ -309,7 +309,7 @@
Parrot_ParrotInterpreter_attributes *attrs =
mem_allocate_zeroed_typed(Parrot_ParrotInterpreter_attributes);
PMC_data(SELF) = attrs;
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
PMC_interp(SELF) = (struct parrot_interp_t *)value;
}
@@ -450,7 +450,7 @@
STRING *s = CONST_STRING(interp, "globals");
int level = 0;
- Parrot_Context *ctx;
+ PMC *ctx;
if (Parrot_str_equal(interp, item, s))
return interp->root_namespace;
@@ -478,19 +478,19 @@
Parrot_ex_throw_from_c_args(interp, NULL, CONTROL_ERROR,
"No such caller depth");
- ctx = CONTEXT(interp);
+ ctx = CURRENT_CONTEXT(interp);
if (outer) {
for (; level; --level) {
- ctx = ctx->outer_ctx;
- if (!ctx)
+ ctx = Parrot_pcc_get_outer_ctx(interp, ctx);
+ if (PMC_IS_NULL(ctx))
Parrot_ex_throw_from_c_args(interp, NULL,
CONTROL_ERROR, "No such outer depth");
}
}
else {
for (; level; --level) {
- cont = ctx->current_cont;
+ cont = Parrot_pcc_get_continuation(interp, ctx);
if (PMC_IS_NULL(cont) || !PARROT_CONTINUATION(cont)->seg)
Parrot_ex_throw_from_c_args(interp, NULL,
@@ -498,51 +498,50 @@
ctx = PARROT_CONTINUATION(cont)->to_ctx;
- if (!ctx->current_sub)
+ if (PMC_IS_NULL(Parrot_pcc_get_sub(interp, ctx)))
Parrot_ex_throw_from_c_args(interp, NULL,
CONTROL_ERROR, "No such caller depth");
}
}
if (item == outer)
- return ctx->current_sub;
+ return Parrot_pcc_get_sub(interp, ctx);
s = CONST_STRING(interp, "sub");
if (Parrot_str_equal(interp, item, s))
- return ctx->current_sub;
+ return Parrot_pcc_get_sub(interp, ctx);
s = CONST_STRING(interp, "lexpad");
if (Parrot_str_equal(interp, item, s))
- return ctx->lex_pad;
+ return Parrot_pcc_get_lex_pad(interp, ctx);
s = CONST_STRING(interp, "namespace");
if (Parrot_str_equal(interp, item, s))
- return ctx->current_namespace;
+ return Parrot_pcc_get_namespace(interp, ctx);
s = CONST_STRING(interp, "continuation");
if (Parrot_str_equal(interp, item, s))
- return VTABLE_clone(interp, ctx->current_cont);
+ return VTABLE_clone(interp, Parrot_pcc_get_continuation(interp, ctx));
s = CONST_STRING(interp, "annotations");
if (Parrot_str_equal(interp, item, s)) {
- PMC *sub_pmc = ctx->current_sub;
- if (ctx == CONTEXT(interp)) {
+ PMC *sub_pmc = Parrot_pcc_get_sub(interp, ctx);
+ if (ctx == CURRENT_CONTEXT(interp)) {
/* We can't know the current program counter for the currently
* executing sub, so can't return annotations for that. */
- if (ctx == CONTEXT(interp))
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "Cannot get annotations at depth 0; use annotations op instead.");
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Cannot get annotations at depth 0; use annotations op instead.");
}
if (!PMC_IS_NULL(sub_pmc)
&& sub_pmc->vtable->base_type == enum_class_Sub) {
Parrot_Sub_attributes *sub;
PackFile_ByteCode *seg;
- opcode_t *pc = ctx->current_pc;
+ opcode_t *pc = Parrot_pcc_get_pc(interp, ctx);
PMC_get_sub(interp, sub_pmc, sub);
seg = sub->seg;
@@ -722,7 +721,7 @@
Parrot_ParrotInterpreter_attributes *attrs =
mem_allocate_zeroed_typed(Parrot_ParrotInterpreter_attributes);
PMC_data(SELF) = attrs;
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
PMC_interp(SELF) = INTERP;
@@ -803,7 +802,7 @@
METHOD hll_map(PMC *core_type, PMC *hll_type) {
INTVAL core_type_id = VTABLE_type(INTERP, core_type);
INTVAL hll_type_id = VTABLE_type(INTERP, hll_type);
- INTVAL hll_id = CONTEXT(interp)->current_HLL;
+ INTVAL hll_id = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp));
Parrot_register_HLL_type(INTERP, hll_id, core_type_id, hll_type_id);
}
@@ -845,3 +844,5 @@
* End:
* vim: expandtab shiftwidth=4:
*/
+
+
Modified: branches/kill_parrot_cont/src/pmc/parrotlibrary.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/parrotlibrary.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/parrotlibrary.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -46,7 +46,7 @@
*/
VTABLE void init() {
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
Modified: branches/kill_parrot_cont/src/pmc/parrotrunningthread.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/parrotrunningthread.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/parrotrunningthread.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -50,7 +50,7 @@
mem_allocate_zeroed_typed(Parrot_ParrotRunningThread_attributes);
attrs->tid = -1;
PMC_data(SELF) = attrs;
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
Modified: branches/kill_parrot_cont/src/pmc/resizablebooleanarray.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/resizablebooleanarray.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/resizablebooleanarray.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -392,7 +392,7 @@
SET_ATTR_bit_array(INTERP, dest, dest_bit_array);
- PObj_active_destroy_SET(dest);
+ PObj_custom_destroy_SET(dest);
return dest;
}
@@ -453,11 +453,7 @@
const UINTVAL tail_pos = VTABLE_shift_integer(INTERP, io);
STRING * const s = VTABLE_shift_string(INTERP, io);
- bit_array = (unsigned char *)mem_sys_allocate_zeroed(s->bufused);
- mem_sys_memcopy(bit_array, (unsigned char *)s->strstart, s->bufused);
- PMC_data(SELF) =
- mem_allocate_zeroed_typed(Parrot_ResizableBooleanArray_attributes);
-
+ bit_array = (unsigned char*)Parrot_str_to_cstring(INTERP, s);
SET_ATTR_size(INTERP, SELF, tail_pos);
SET_ATTR_resize_threshold(INTERP, SELF, head_pos);
SET_ATTR_bit_array(INTERP, SELF, bit_array);
Modified: branches/kill_parrot_cont/src/pmc/resizableintegerarray.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/resizableintegerarray.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/resizableintegerarray.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -294,11 +294,6 @@
}
VTABLE void thaw(visit_info *info) {
-
- Parrot_ResizableIntegerArray_attributes *attrs =
- mem_allocate_zeroed_typed(Parrot_ResizableIntegerArray_attributes);
- PMC_data(SELF) = attrs;
-
if (info->extra_flags == EXTRA_IS_NULL) {
IMAGE_IO * const io = info->image_io;
const INTVAL n = VTABLE_shift_integer(INTERP, io);
Modified: branches/kill_parrot_cont/src/pmc/retcontinuation.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/retcontinuation.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/retcontinuation.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -38,8 +38,8 @@
VTABLE void init() {
Parrot_RetContinuation_attributes * const attrs = PARROT_RETCONTINUATION(SELF);
- attrs->to_ctx = CONTEXT(interp);
- attrs->from_ctx = CONTEXT(interp); /* filled in during a call */
+ attrs->to_ctx = CURRENT_CONTEXT(interp);
+ attrs->from_ctx = CURRENT_CONTEXT(interp); /* filled in during a call */
attrs->runloop_id = 0;
attrs->seg = interp->code;
attrs->current_results = NULL;
@@ -75,14 +75,13 @@
*/
VTABLE opcode_t *invoke(void *in_next) {
- Parrot_Context *from_ctx = PARROT_CONTINUATION(SELF)->from_ctx;
- PackFile_ByteCode * const seg = PARROT_CONTINUATION(SELF)->seg;
- opcode_t *next = PARROT_CONTINUATION(SELF)->address;
+ PMC *from_ctx = PARROT_CONTINUATION(SELF)->from_ctx;
+ PackFile_ByteCode * const seg = PARROT_CONTINUATION(SELF)->seg;
+ opcode_t *next = PARROT_CONTINUATION(SELF)->address;
UNUSED(in_next)
Parrot_continuation_check(interp, SELF);
Parrot_continuation_rewind_environment(interp, SELF);
- Parrot_free_context(INTERP, from_ctx, 1);
/* the continuation is dead - delete and destroy it */
/* This line causes a failure in t/pmc/packfiledirectory.t. No idea
Modified: branches/kill_parrot_cont/src/pmc/role.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/role.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/role.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -102,7 +102,7 @@
/* Namespace is nested in the current namespace and with the name of
* the role. */
role->_namespace = Parrot_make_namespace_keyed_str(interp,
- CONTEXT(interp)->current_namespace, role->name);
+ Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp)), role->name);
}
/* Otherwise, we may just have a namespace. */
Modified: branches/kill_parrot_cont/src/pmc/scheduler.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/scheduler.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/scheduler.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -52,7 +52,7 @@
/* Set flags for custom GC mark and destroy. */
PObj_custom_mark_SET(SELF);
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
/* Set up the core struct. */
core_struct->id = 0;
@@ -246,7 +246,10 @@
*/
VTABLE void destroy() {
Parrot_Scheduler_attributes * const core_struct = PARROT_SCHEDULER(SELF);
- MUTEX_DESTROY(core_struct->msg_lock);
+ /* TT #946: this line is causing an order-of-destruction error
+ because the scheduler is being freed before it's tasks.
+ Commenting this out till we get a real fix (although it's a hack) */
+ /* MUTEX_DESTROY(core_struct->msg_lock); */
}
Modified: branches/kill_parrot_cont/src/pmc/sockaddr.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/sockaddr.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/sockaddr.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -47,7 +47,7 @@
(Parrot_Sockaddr_attributes *) PMC_data(SELF);
pdata_struct->pointer = mem_allocate_zeroed_typed(struct sockaddr_in);
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
}
/*
Modified: branches/kill_parrot_cont/src/pmc/string.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/string.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/string.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -220,11 +220,16 @@
*/
VTABLE void set_string_native(STRING *value) {
+ /* in lieu of a STRINGNULL, promote any NULL STRINGs to empty ones */
+ if (!value)
+ value = Parrot_str_new(INTERP, NULL, 0);
+
/* Only allow constant PMCs to embed constant strings */
if (PObj_constant_TEST(SELF) && !PObj_constant_TEST(value)) {
char *copy = Parrot_str_to_cstring(INTERP, value);
value = Parrot_str_new_init(INTERP, copy, strlen(copy),
- PARROT_DEFAULT_ENCODING, PARROT_DEFAULT_CHARSET, PObj_constant_FLAG);
+ PARROT_DEFAULT_ENCODING, PARROT_DEFAULT_CHARSET,
+ PObj_constant_FLAG);
Parrot_str_free_cstring(copy);
}
@@ -645,6 +650,16 @@
return string_ord(INTERP, s, pos);
}
+ VTABLE PMC *get_pmc_keyed(PMC *key) {
+ return SELF.get_pmc_keyed_int(VTABLE_get_integer(INTERP, key));
+ }
+
+ VTABLE PMC *get_pmc_keyed_int(INTVAL pos) {
+ PMC * const dest = pmc_new(INTERP, SELF->vtable->base_type);
+ VTABLE_set_string_native(INTERP, dest, SELF.get_string_keyed_int(pos));
+ return dest;
+ }
+
VTABLE void set_string_keyed(PMC *key, STRING * const value) {
SELF.set_string_keyed_int(VTABLE_get_integer(INTERP, key), value);
}
@@ -666,6 +681,14 @@
Parrot_str_replace(INTERP, s, pos, 1, c, NULL);
VTABLE_set_string_native(INTERP, SELF, s);
}
+
+ VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
+ SELF.set_pmc_keyed_int(VTABLE_get_integer(INTERP, key), value);
+ }
+
+ VTABLE void set_pmc_keyed_int(INTVAL pos, PMC *value) {
+ SELF.set_string_keyed_int(pos, VTABLE_get_string(INTERP, value));
+ }
/*
=item C<void replace(STRING *orig, STRING *_new)>
@@ -711,17 +734,18 @@
enum_class_Integer));
/* TODO verify encoding */
- const STRING *me = VTABLE_get_string(INTERP, SELF);
- const char *start = me->strstart;
- const char * const end = start + me->bufused;
- UINTVAL i = 0;
+ const STRING *me = VTABLE_get_string(INTERP, SELF);
+ char *str = Parrot_str_to_cstring(INTERP, me);
+ UINTVAL i = 0;
+ size_t j = 0;
+ size_t len = strlen(str);
if (base < 2 || base > 36)
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
"invalid conversion to int - bad base %d", base);
- while (start < end) {
- const unsigned char c = *start;
+ while (j < len) {
+ const unsigned char c = str[j];
int dig;
if (isdigit((unsigned char)c))
@@ -737,13 +761,17 @@
break;
i = i * base + dig;
- ++start;
+ j++;
}
- if (start < end)
+ if (j < len) {
+ char ch = str[j];
+ Parrot_str_free_cstring(str);
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
- "invalid conversion to int - bad char %c", *start);
+ "invalid conversion to int - bad char %c", ch);
+ }
+ Parrot_str_free_cstring(str);
/* TODO: autopromote to BigInt instead of casting away the high bit */
VTABLE_set_integer_native(INTERP, result, (INTVAL)i);
RETURN(PMC *result);
@@ -878,7 +906,7 @@
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_ENCODING,
"Can't translate non-ascii");
- p = (unsigned char *)src->strstart;
+ p = (unsigned char *)Buffer_bufstart(src);
/* TODO verify trans table */
GETATTR_FixedIntegerArray_int_array(INTERP, table, tr_data);
@@ -912,7 +940,7 @@
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_ENCODING,
"Can't reverse non-ascii");
- p = (unsigned char *)src->strstart;
+ p = (unsigned char *)Buffer_bufstart(src);
for (i = 0, --len; i < len; ++i, --len) {
const unsigned char ch = p[len];
@@ -945,7 +973,7 @@
"Can't is_integer non-ascii");
i = 0;
- p = (unsigned char *)src->strstart;
+ p = (unsigned char *)Buffer_bufstart(src);
if (p[i] == '-' || p[i] == '+' ||
(p[i] >= '0' && p[i] <= '9')) {
Modified: branches/kill_parrot_cont/src/pmc/sub.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/sub.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/sub.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -57,12 +57,12 @@
ATTR PMC *lex_info; /* LexInfo PMC */
ATTR PMC *outer_sub; /* :outer for closures */
ATTR PMC *eval_pmc; /* eval container / NULL */
- ATTR Parrot_Context *ctx; /* the context this sub is in */
+ ATTR PMC *ctx; /* the context this sub is in */
ATTR UINTVAL comp_flags; /* compile time and additional flags */
ATTR Parrot_sub_arginfo *arg_info;/* Argument counts and flags. */
/* - end common */
- ATTR Parrot_Context *outer_ctx; /* outer context, if a closure */
+ ATTR PMC *outer_ctx; /* outer context, if a closure */
/*
@@ -113,10 +113,6 @@
if (sub) {
if (sub->arg_info)
mem_sys_free(sub->arg_info);
- if (sub->ctx)
- Parrot_free_context(INTERP, sub->ctx, 1);
- if (sub->outer_ctx)
- Parrot_free_context(INTERP, sub->outer_ctx, 1);
}
}
@@ -237,10 +233,10 @@
VTABLE opcode_t *invoke(void *next) {
Parrot_Sub_attributes *sub;
- Parrot_Context *caller_ctx;
- Parrot_Context *context;
- PMC *ccont;
- opcode_t *pc;
+ PMC *caller_ctx;
+ PMC *context;
+ PMC *ccont;
+ opcode_t *pc;
PMC_get_sub(INTERP, SELF, sub);
if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG))
@@ -269,7 +265,7 @@
*
*/
pc = sub->seg->base.data + sub->start_offs;
- caller_ctx = CONTEXT(interp);
+ caller_ctx = CURRENT_CONTEXT(interp);
ccont = INTERP->current_cont;
INTERP->current_cont = NULL;
@@ -281,13 +277,13 @@
/* plain subroutine call
* create new context, place it in interpreter */
context = Parrot_set_new_context(INTERP, sub->n_regs_used);
- context->current_sub = SELF;
- context->caller_ctx = caller_ctx;
- context->current_pc = pc;
- context->current_cont = ccont;
+ Parrot_pcc_set_sub(interp, context, SELF);
+ Parrot_pcc_set_caller_ctx(interp, context, caller_ctx);
+ Parrot_pcc_set_pc(interp, context, pc);
+ Parrot_pcc_set_continuation(interp, context, ccont);
/* check recursion/call depth */
- if (++context->recursion_depth > INTERP->recursion_limit)
+ if (Parrot_pcc_inc_recursion_depth(INTERP, context) > INTERP->recursion_limit)
Parrot_ex_throw_from_c_args(INTERP, next, CONTROL_ERROR,
"maximum recursion depth exceeded");
@@ -298,49 +294,44 @@
* to the new context (refcounted) and convert the
* retcontinuation to a normal continuation. */
if (PObj_get_FLAGS(SELF) & SUB_FLAG_IS_OUTER) {
- /* release any previously held context */
- if (sub->ctx)
- Parrot_free_context(interp, sub->ctx, 1);
- sub->ctx = Parrot_context_ref(interp, context);
+ sub->ctx = context;
/* convert retcontinuation to a continuation */
ccont->vtable = interp->vtables[enum_class_Continuation];
}
- /* reference counting should work */
- Parrot_context_ref(interp, context);
-
if (!PMC_IS_NULL(INTERP->current_object)) {
- context->current_object = INTERP->current_object;
+ Parrot_pcc_set_object(interp, context, INTERP->current_object);
INTERP->current_object = NULL;
}
- context->current_HLL = sub->HLL_id;
- context->current_namespace = sub->namespace_stash;
+ Parrot_pcc_set_HLL(interp, context, sub->HLL_id);
+ Parrot_pcc_set_namespace(interp, context, sub->namespace_stash);
/* create pad if needed
* TODO move this up in front of argument passing
* and factor out common code with coroutine pmc
*/
if (!PMC_IS_NULL(sub->lex_info)) {
- context->lex_pad = pmc_new_init(INTERP,
+ Parrot_pcc_set_lex_pad(interp, context, pmc_new_init(INTERP,
Parrot_get_ctx_HLL_type(interp, enum_class_LexPad),
- sub->lex_info);
- VTABLE_set_pointer(INTERP, context->lex_pad, context);
+ sub->lex_info));
+ VTABLE_set_pointer(INTERP, Parrot_pcc_get_lex_pad(interp, context), context);
}
- if (sub->outer_ctx) {
+ if (!PMC_IS_NULL(sub->outer_ctx)) {
/* set outer context */
- context->outer_ctx = Parrot_context_ref(interp, sub->outer_ctx);
+ Parrot_pcc_set_outer_ctx(interp, context, sub->outer_ctx);
}
else {
/* autoclose */
- Parrot_Context *c;
- for (c = context; !c->outer_ctx; c = c->outer_ctx) {
+ PMC *c = context;
+ PMC *outer_c = Parrot_pcc_get_outer_ctx(interp, c);
+ for (c = context; PMC_IS_NULL(outer_c); c = outer_c) {
PMC *outer_pmc;
Parrot_Sub_attributes *current_sub, *outer_sub;
- PMC_get_sub(INTERP, c->current_sub, current_sub);
+ PMC_get_sub(INTERP, Parrot_pcc_get_sub(interp, c), current_sub);
outer_pmc = current_sub->outer_sub;
if (PMC_IS_NULL(outer_pmc))
@@ -348,26 +339,25 @@
PMC_get_sub(INTERP, outer_pmc, outer_sub);
- if (!outer_sub->ctx) {
- Parrot_Context * const dummy = Parrot_alloc_context(INTERP,
+ if (PMC_IS_NULL(outer_sub->ctx)) {
+ PMC * const dummy = Parrot_alloc_context(INTERP,
outer_sub->n_regs_used, NULL);
- dummy->current_sub = outer_pmc;
+ Parrot_pcc_set_sub(interp, dummy, outer_pmc);
if (!PMC_IS_NULL(outer_sub->lex_info)) {
- dummy->lex_pad = pmc_new_init(INTERP,
+ Parrot_pcc_set_lex_pad(interp, dummy, pmc_new_init(INTERP,
Parrot_get_ctx_HLL_type(interp, enum_class_LexPad),
- outer_sub->lex_info);
- VTABLE_set_pointer(INTERP, dummy->lex_pad, dummy);
+ outer_sub->lex_info));
+ VTABLE_set_pointer(INTERP, Parrot_pcc_get_lex_pad(interp, dummy), dummy);
}
- if (outer_sub->outer_ctx) {
- dummy->outer_ctx = Parrot_context_ref(interp,
- outer_sub->outer_ctx);
- }
- outer_sub->ctx = Parrot_context_ref(interp, dummy);
+ if (!PMC_IS_NULL(outer_sub->outer_ctx))
+ Parrot_pcc_set_outer_ctx(interp, dummy, outer_sub->outer_ctx);
+ outer_sub->ctx = dummy;
}
- c->outer_ctx = Parrot_context_ref(interp, outer_sub->ctx);
+ Parrot_pcc_set_outer_ctx(interp, c, outer_sub->ctx);
+ outer_c = outer_sub->ctx;
}
}
@@ -381,12 +371,11 @@
&& pc[2] == PARROT_OP_get_params_pc))) {
/* TODO keep it or resize it */
- --context->recursion_depth;
+ Parrot_pcc_dec_recursion_depth(INTERP, context);
PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
- context->caller_ctx = caller_ctx->caller_ctx;
-
- Parrot_free_context(INTERP, caller_ctx, 1);
+ Parrot_pcc_set_caller_ctx(interp, context,
+ Parrot_pcc_get_caller_ctx(interp, caller_ctx));
}
}
@@ -415,12 +404,6 @@
PMC_get_sub(INTERP, SELF, dest_sub);
PMC_get_sub(INTERP, ret, sub);
- /* release any previously held contexts */
- if (sub->ctx)
- Parrot_free_context(INTERP, sub->ctx, 1);
- if (sub->outer_ctx)
- Parrot_free_context(INTERP, sub->outer_ctx, 1);
-
/* first set the sub struct, Parrot_str_copy may cause GC */
*sub = *dest_sub;
@@ -430,12 +413,6 @@
/* Be sure not to share arg_info. */
dest_sub->arg_info = NULL;
- /* mark any newly held contexts */
- if (sub->ctx)
- Parrot_context_ref(INTERP, sub->ctx);
- if (sub->outer_ctx)
- Parrot_context_ref(INTERP, sub->outer_ctx);
-
return ret;
}
@@ -462,15 +439,6 @@
PMC_get_sub(INTERP, SELF, my_sub);
PMC_get_sub(INTERP, other, other_sub);
- /* Increase reference count of destination before
- * freeing the one in self, to avoid problems in
- * case of self assignment */
- if (other_sub->ctx)
- Parrot_context_ref(interp, other_sub->ctx);
- /* get rid of this context, if attached */
- if (my_sub->ctx)
- Parrot_free_context(INTERP, my_sub->ctx, 1);
-
/* copy the sub struct */
memmove(my_sub, other_sub, sizeof (Parrot_Sub_attributes));
@@ -521,9 +489,9 @@
if (sub->subid)
Parrot_gc_mark_PObj_alive(INTERP, (PObj *) sub->subid);
if (sub->ctx)
- mark_context(interp, sub->ctx);
+ Parrot_gc_mark_PObj_alive(interp, (PObj *) sub->ctx);
if (sub->outer_ctx)
- mark_context(interp, sub->outer_ctx);
+ Parrot_gc_mark_PObj_alive(interp, (PObj *) sub->outer_ctx);
}
/*
@@ -974,6 +942,7 @@
METHOD set_outer(PMC *outer) {
/* Set outer sub. */
Parrot_Sub_attributes *sub;
+ PMC *tmp1, *tmp2;
PMC_get_sub(INTERP, SELF, sub);
sub->outer_sub = outer;
@@ -990,10 +959,16 @@
/* If we've got a context around for the outer sub, set it as the
* outer context. */
- if (CONTEXT(interp)->caller_ctx->caller_ctx->current_sub == outer)
- sub->outer_ctx = Parrot_context_ref(interp, CONTEXT(interp)->caller_ctx->caller_ctx);
- else if (CONTEXT(interp)->caller_ctx->current_sub == outer)
- sub->outer_ctx = Parrot_context_ref(interp, CONTEXT(interp)->caller_ctx);
+
+ /* XXX This code looks very suspicious. */
+ /* (CONTEXT(interp)->caller_ctx->caller_ctx->current_sub */
+ tmp1 = Parrot_pcc_get_caller_ctx(interp, CURRENT_CONTEXT(interp));
+ tmp2 = Parrot_pcc_get_caller_ctx(interp, tmp1);
+ if (Parrot_pcc_get_sub(interp, tmp2) == outer)
+ sub->outer_ctx = tmp2;
+ /* else if (CONTEXT(interp)->caller_ctx->current_sub == outer) */
+ else if (Parrot_pcc_get_sub(interp, tmp1) == outer)
+ sub->outer_ctx = tmp1;
}
METHOD get_multisig() {
Modified: branches/kill_parrot_cont/src/pmc/timer.pmc
==============================================================================
--- branches/kill_parrot_cont/src/pmc/timer.pmc Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/pmc/timer.pmc Sun Sep 6 00:20:10 2009 (r41024)
@@ -79,7 +79,7 @@
/* Set flags for custom GC mark and destroy. */
PObj_custom_mark_SET(SELF);
- PObj_active_destroy_SET(SELF);
+ PObj_custom_destroy_SET(SELF);
/* Set up the core struct. */
core_struct->id = 0;
Modified: branches/kill_parrot_cont/src/runcore/cores.c
==============================================================================
--- branches/kill_parrot_cont/src/runcore/cores.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/runcore/cores.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -263,6 +263,16 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
+#ifdef code_start
+# undef code_start
+#endif
+#ifdef code_end
+# undef code_end
+#endif
+
+#define code_start interp->code->base.data
+#define code_end (interp->code->base.data + interp->code->base.size)
+
/*
=item C<opcode_t * runops_fast_core(PARROT_INTERP, opcode_t *pc)>
@@ -282,9 +292,16 @@
ASSERT_ARGS(runops_fast_core)
/* disable pc */
- CONTEXT(interp)->current_pc = NULL;
+ Parrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), NULL);
while (pc) {
+ /* TODO
+ * Decide do we need check here.
+ * Fast-core cause segfaults even on test suite
+ if (pc < code_start || pc >= code_end)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "attempt to access code outside of current code segment");
+ */
DO_OP(pc, interp);
}
@@ -314,7 +331,7 @@
ASSERT_ARGS(runops_cgoto_core)
/* disable pc */
- CONTEXT(interp)->current_pc = NULL;
+ Parrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), NULL);
#ifdef HAVE_COMPUTED_GOTO
pc = cg_core(pc, interp);
@@ -327,16 +344,6 @@
#endif
}
-#ifdef code_start
-# undef code_start
-#endif
-#ifdef code_end
-# undef code_end
-#endif
-
-#define code_start interp->code->base.data
-#define code_end (interp->code->base.data + interp->code->base.size)
-
/*
@@ -403,7 +410,7 @@
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"attempt to access code outside of current code segment");
- CONTEXT(interp)->current_pc = pc;
+ Parrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), pc);
DO_OP(pc, interp);
trace_op(interp, code_start, code_end, pc);
@@ -457,7 +464,7 @@
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"attempt to access code outside of current code segment");
- CONTEXT(interp)->current_pc = pc;
+ Parrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), pc);
DO_OP(pc, interp);
}
@@ -490,7 +497,7 @@
"attempt to access code outside of current code segment");
Parrot_gc_mark_and_sweep(interp, GC_TRACE_FULL);
- CONTEXT(interp)->current_pc = pc;
+ Parrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), pc);
DO_OP(pc, interp);
}
@@ -530,9 +537,9 @@
while (pc) {/* && pc >= code_start && pc < code_end) */
opcode_t cur_op;
- CONTEXT(interp)->current_pc = pc;
- profile->cur_op = cur_op = *pc + PARROT_PROF_EXTRA;
- profile->starttime = Parrot_floatval_time();
+ Parrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), pc);
+ profile->cur_op = cur_op = *pc + PARROT_PROF_EXTRA;
+ profile->starttime = Parrot_floatval_time();
profile->data[cur_op].numcalls++;
DO_OP(pc, interp);
@@ -591,7 +598,7 @@
pc);
}
- CONTEXT(interp)->current_pc = pc;
+ Parrot_pcc_set_pc(interp, CURRENT_CONTEXT(interp), pc);
DO_OP(pc, interp);
if (interp->pdb->state & PDB_STOPPED) {
Modified: branches/kill_parrot_cont/src/runcore/main.c
==============================================================================
--- branches/kill_parrot_cont/src/runcore/main.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/runcore/main.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -188,10 +188,10 @@
ASSERT_ARGS(prederef_args)
const PackFile_ConstTable * const const_table = interp->code->const_table;
- const int regs_n = CONTEXT(interp)->n_regs_used[REGNO_NUM];
- const int regs_i = CONTEXT(interp)->n_regs_used[REGNO_INT];
- const int regs_p = CONTEXT(interp)->n_regs_used[REGNO_PMC];
- const int regs_s = CONTEXT(interp)->n_regs_used[REGNO_STR];
+ const int regs_n = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_NUM);
+ const int regs_i = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_INT);
+ const int regs_p = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_PMC);
+ const int regs_s = Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_STR);
/* prederef var part too */
const int m = opinfo->op_count;
@@ -312,11 +312,6 @@
opinfo = &interp->op_info_table[*pc];
- /* first arguments - PIC needs it */
-
- /* check for RT#58044 */
- PARROT_ASSERT(CONTEXT(interp)->n_regs_used);
-
prederef_args(pc_prederef, interp, pc, opinfo);
switch (type) {
@@ -541,7 +536,7 @@
N * sizeof (void *));
#endif
/* calc and remember pred_offset */
- CONTEXT(interp)->pred_offset = pc - (opcode_t *)temp;
+ Parrot_pcc_set_pred_offset(interp, CURRENT_CONTEXT(interp), pc - (opcode_t *)temp);
/* fill with the prederef__ opcode function */
if (which == PARROT_SWITCH_CORE || which == PARROT_SWITCH_JIT_CORE)
Modified: branches/kill_parrot_cont/src/scheduler.c
==============================================================================
--- branches/kill_parrot_cont/src/scheduler.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/scheduler.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -482,10 +482,10 @@
Parrot_cx_add_handler_local(PARROT_INTERP, ARGIN(PMC *handler))
{
ASSERT_ARGS(Parrot_cx_add_handler_local)
- if (PMC_IS_NULL(CONTEXT(interp)->handlers))
- CONTEXT(interp)->handlers = pmc_new(interp, enum_class_ResizablePMCArray);
+ if (PMC_IS_NULL(Parrot_pcc_get_handlers(interp, interp->ctx)))
+ Parrot_pcc_set_handers(interp, interp->ctx, pmc_new(interp, enum_class_ResizablePMCArray));
- VTABLE_unshift_pmc(interp, CONTEXT(interp)->handlers, handler);
+ VTABLE_unshift_pmc(interp, Parrot_pcc_get_handlers(interp, interp->ctx), handler);
}
@@ -506,7 +506,7 @@
Parrot_cx_delete_handler_local(PARROT_INTERP, ARGIN(STRING *handler_type))
{
ASSERT_ARGS(Parrot_cx_delete_handler_local)
- PMC *handlers = CONTEXT(interp)->handlers;
+ PMC *handlers = Parrot_pcc_get_handlers(interp, interp->ctx);
if (PMC_IS_NULL(handlers))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
@@ -577,7 +577,7 @@
Parrot_cx_count_handlers_local(PARROT_INTERP, ARGIN(STRING *handler_type))
{
ASSERT_ARGS(Parrot_cx_count_handlers_local)
- PMC *handlers = CONTEXT(interp)->handlers;
+ PMC *handlers = Parrot_pcc_get_handlers(interp, interp->ctx);
INTVAL elements;
if (PMC_IS_NULL(handlers))
@@ -849,9 +849,9 @@
* for a handler
*/
static int already_doing = 0;
- static Parrot_Context * keep_context = NULL;
+ static PMC * keep_context = NULL;
- Parrot_Context *context;
+ PMC *context;
PMC *iter = PMCNULL;
STRING * const handled_str = CONST_STRING(interp, "handled");
STRING * const iter_str = CONST_STRING(interp, "handler_iter");
@@ -865,30 +865,28 @@
* Note that we are now trying to handle the new exception,
* not the initial task argument (exception or whatever).
*/
- context = keep_context->caller_ctx;
+ context = Parrot_pcc_get_caller_ctx(interp, keep_context);
keep_context = NULL;
- if (context && !PMC_IS_NULL(context->handlers))
- iter = VTABLE_get_iter(interp, context->handlers);
+ if (context && !PMC_IS_NULL(Parrot_pcc_get_handlers(interp, context)))
+ iter = VTABLE_get_iter(interp, Parrot_pcc_get_handlers(interp, context));
else
iter = PMCNULL;
}
else {
+ ++already_doing;
- ++already_doing;
-
- /* Exceptions store the handler iterator for rethrow, other kinds of
- * tasks don't (though they could). */
- if (task->vtable->base_type == enum_class_Exception
- && VTABLE_get_integer_keyed_str(interp, task, handled_str) == -1) {
- iter = VTABLE_get_attr_str(interp, task, iter_str);
- context = (Parrot_Context *)VTABLE_get_pointer(interp, task);
- }
- else {
- context = CONTEXT(interp);
- if (!PMC_IS_NULL(context->handlers))
- iter = VTABLE_get_iter(interp, context->handlers);
- }
-
+ /* Exceptions store the handler iterator for rethrow, other kinds of
+ * tasks don't (though they could). */
+ if (task->vtable->base_type == enum_class_Exception
+ && VTABLE_get_integer_keyed_str(interp, task, handled_str) == -1) {
+ iter = VTABLE_get_attr_str(interp, task, iter_str);
+ context = (PMC *)VTABLE_get_pointer(interp, task);
+ }
+ else {
+ context = CURRENT_CONTEXT(interp);
+ if (!PMC_IS_NULL(Parrot_pcc_get_handlers(interp, context)))
+ iter = VTABLE_get_iter(interp, Parrot_pcc_get_handlers(interp, context));
+ }
}
while (context) {
@@ -899,7 +897,11 @@
if (!PMC_IS_NULL(handler)) {
INTVAL valid_handler = 0;
- Parrot_PCCINVOKE(interp, handler, CONST_STRING(interp, "can_handle"),
+ if (handler->vtable->base_type == enum_class_Object)
+ Parrot_pcc_invoke_method_from_c_args(interp, handler, CONST_STRING(interp, "can_handle"),
+ "P->I", task, &valid_handler);
+ else
+ Parrot_PCCINVOKE(interp, handler, CONST_STRING(interp, "can_handle"),
"P->I", task, &valid_handler);
if (valid_handler) {
@@ -916,9 +918,9 @@
}
/* Continue the search in the next context up the chain. */
- context = context->caller_ctx;
- if (context && !PMC_IS_NULL(context->handlers))
- iter = VTABLE_get_iter(interp, context->handlers);
+ context = Parrot_pcc_get_caller_ctx(interp, context);
+ if (context && !PMC_IS_NULL(Parrot_pcc_get_handlers(interp, context)))
+ iter = VTABLE_get_iter(interp, Parrot_pcc_get_handlers(interp, context));
else
iter = PMCNULL;
}
Modified: branches/kill_parrot_cont/src/string/charset/unicode.c
==============================================================================
--- branches/kill_parrot_cont/src/string/charset/unicode.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/string/charset/unicode.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -969,6 +969,11 @@
UINTVAL end = offset + count;
int bit;
+ if (pos > source_string->strlen) {
+ /* XXX: Throw in this case? */
+ return offset + count;
+ }
+
ENCODING_ITER_INIT(interp, source_string, &iter);
if (pos)
Modified: branches/kill_parrot_cont/src/sub.c
==============================================================================
--- branches/kill_parrot_cont/src/sub.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/sub.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -49,84 +49,6 @@
/*
-=item C<void mark_context(PARROT_INTERP, Parrot_Context* ctx)>
-
-Marks the context C<*ctx>.
-
-=cut
-
-*/
-
-void
-mark_context(PARROT_INTERP, ARGMOD(Parrot_Context* ctx))
-{
- ASSERT_ARGS(mark_context)
- PObj *obj;
- int i;
-
- if (ctx->gc_mark == context_gc_mark)
- return;
- ctx->gc_mark = context_gc_mark;
-
- /* don't mark the context if it's actually dead */
- if (ctx->ref_count < 0) {
- /* report it, though */
- if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
- fprintf(stderr, "[attempt to mark dead context %p]\n",
- (void *)ctx);
- }
- return;
- }
-
- obj = (PObj *)ctx->current_sub;
- if (obj)
- Parrot_gc_mark_PObj_alive(interp, obj);
-
- obj = (PObj *)ctx->current_object;
- if (obj)
- Parrot_gc_mark_PObj_alive(interp, obj);
-
- obj = (PObj *)ctx->current_cont;
- if (obj && !PObj_live_TEST(obj))
- Parrot_gc_mark_PObj_alive(interp, obj);
-
- if (ctx->caller_ctx)
- mark_context(interp, ctx->caller_ctx);
-
- if (ctx->outer_ctx)
- mark_context(interp, ctx->outer_ctx);
-
- obj = (PObj *)ctx->current_namespace;
- if (obj)
- Parrot_gc_mark_PObj_alive(interp, obj);
-
- obj = (PObj *)ctx->lex_pad;
- if (obj)
- Parrot_gc_mark_PObj_alive(interp, obj);
-
- obj = (PObj *)ctx->handlers;
- if (obj)
- Parrot_gc_mark_PObj_alive(interp, obj);
-
-
- if (!ctx->n_regs_used)
- return;
-
- for (i = 0; i < ctx->n_regs_used[REGNO_PMC]; ++i) {
- obj = (PObj *)CTX_REG_PMC(ctx, i);
- if (obj)
- Parrot_gc_mark_PObj_alive(interp, obj);
- }
-
- for (i = 0; i < ctx->n_regs_used[REGNO_STR]; ++i) {
- obj = (PObj *)CTX_REG_STR(ctx, i);
- if (obj)
- Parrot_gc_mark_PObj_alive(interp, obj);
- }
-}
-
-/*
-
/*
@@ -165,10 +87,9 @@
{
ASSERT_ARGS(invalidate_retc_context)
- Parrot_Context *ctx = PARROT_CONTINUATION(cont)->from_ctx;
- cont = ctx->current_cont;
+ PMC *ctx = PARROT_CONTINUATION(cont)->from_ctx;
+ cont = Parrot_pcc_get_continuation(interp, ctx);
- Parrot_set_context_threshold(interp, ctx);
while (1) {
/*
* We stop if we encounter a true continuation, because
@@ -178,9 +99,8 @@
if (!cont || cont->vtable != interp->vtables[enum_class_RetContinuation])
break;
cont->vtable = interp->vtables[enum_class_Continuation];
- Parrot_context_ref(interp, ctx);
- ctx = ctx->caller_ctx;
- cont = ctx->current_cont;
+ ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
+ cont = Parrot_pcc_get_continuation(interp, ctx);
}
}
@@ -255,8 +175,8 @@
/*
-=item C<int Parrot_Context_get_info(PARROT_INTERP, const Parrot_Context *ctx,
-Parrot_Context_info *info)>
+=item C<int Parrot_Context_get_info(PARROT_INTERP, PMC *ctx, Parrot_Context_info
+*info)>
Takes pointers to a context and its information table.
Populates the table and returns 0 or 1. XXX needs explanation
@@ -268,7 +188,7 @@
PARROT_EXPORT
int
-Parrot_Context_get_info(PARROT_INTERP, ARGIN(const Parrot_Context *ctx),
+Parrot_Context_get_info(PARROT_INTERP, ARGIN(PMC *ctx),
ARGOUT(Parrot_Context_info *info))
{
ASSERT_ARGS(Parrot_Context_get_info)
@@ -283,7 +203,7 @@
info->fullname = NULL;
/* is the current sub of the specified context valid? */
- if (PMC_IS_NULL(ctx->current_sub)) {
+ if (PMC_IS_NULL(Parrot_pcc_get_sub(interp, ctx))) {
info->subname = Parrot_str_new(interp, "???", 3);
info->nsname = info->subname;
info->fullname = Parrot_str_new(interp, "??? :: ???", 10);
@@ -292,10 +212,10 @@
}
/* fetch Parrot_sub of the current sub in the given context */
- if (!VTABLE_isa(interp, ctx->current_sub, CONST_STRING(interp, "Sub")))
+ if (!VTABLE_isa(interp, Parrot_pcc_get_sub(interp, ctx), CONST_STRING(interp, "Sub")))
return 1;
- PMC_get_sub(interp, ctx->current_sub, sub);
+ PMC_get_sub(interp, Parrot_pcc_get_sub(interp, ctx), sub);
/* set the sub name */
info->subname = sub->name;
@@ -306,18 +226,18 @@
}
else {
info->nsname = VTABLE_get_string(interp, sub->namespace_name);
- info->fullname = Parrot_full_sub_name(interp, ctx->current_sub);
+ info->fullname = Parrot_full_sub_name(interp, Parrot_pcc_get_sub(interp, ctx));
}
/* return here if there is no current pc */
- if (ctx->current_pc == NULL)
+ if (Parrot_pcc_get_pc(interp, ctx) == NULL)
return 1;
/* calculate the current pc */
- info->pc = ctx->current_pc - sub->seg->base.data;
+ info->pc = Parrot_pcc_get_pc(interp, ctx) - sub->seg->base.data;
/* determine the current source file/line */
- if (ctx->current_pc) {
+ if (Parrot_pcc_get_pc(interp, ctx)) {
const size_t offs = info->pc;
size_t i, n;
opcode_t *pc = sub->seg->base.data;
@@ -347,8 +267,7 @@
/*
-=item C<STRING* Parrot_Context_infostr(PARROT_INTERP, const Parrot_Context
-*ctx)>
+=item C<STRING* Parrot_Context_infostr(PARROT_INTERP, PMC *ctx)>
Formats context information for display. Takes a context pointer and
returns a pointer to the text. Used in debug.c and warnings.c
@@ -361,12 +280,12 @@
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
STRING*
-Parrot_Context_infostr(PARROT_INTERP, ARGIN(const Parrot_Context *ctx))
+Parrot_Context_infostr(PARROT_INTERP, ARGIN(PMC *ctx))
{
ASSERT_ARGS(Parrot_Context_infostr)
Parrot_Context_info info;
STRING *res = NULL;
- const char * const msg = (CONTEXT(interp) == ctx)
+ const char * const msg = (CURRENT_CONTEXT(interp) == ctx)
? "current instr.:"
: "called from Sub";
@@ -384,8 +303,7 @@
/*
-=item C<PMC* Parrot_find_pad(PARROT_INTERP, STRING *lex_name, const
-Parrot_Context *ctx)>
+=item C<PMC* Parrot_find_pad(PARROT_INTERP, STRING *lex_name, PMC *ctx)>
Locate the LexPad containing the given name. Return NULL on failure.
@@ -396,12 +314,12 @@
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
PMC*
-Parrot_find_pad(PARROT_INTERP, ARGIN(STRING *lex_name), ARGIN(const Parrot_Context *ctx))
+Parrot_find_pad(PARROT_INTERP, ARGIN(STRING *lex_name), ARGIN(PMC *ctx))
{
ASSERT_ARGS(Parrot_find_pad)
while (1) {
- PMC * const lex_pad = ctx->lex_pad;
- const Parrot_Context * const outer = ctx->outer_ctx;
+ PMC * const lex_pad = Parrot_pcc_get_lex_pad(interp, ctx);
+ PMC * outer = Parrot_pcc_get_outer_ctx(interp, ctx);
if (!outer)
return lex_pad;
@@ -410,17 +328,6 @@
if (VTABLE_exists_keyed_str(interp, lex_pad, lex_name))
return lex_pad;
-#if CTX_LEAK_DEBUG
- if (outer == ctx) {
- /* This is a bug; a context can never be its own :outer context.
- * Detecting it avoids an unbounded loop, which is difficult to
- * debug, though we'd rather not pay the cost of detection in a
- * production release.
- */
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "Bug: Context %p :outer points back to itself.", ctx);
- }
-#endif
ctx = outer;
}
}
@@ -428,6 +335,39 @@
/*
+=item C<PMC* Parrot_find_dynamic_pad(PARROT_INTERP, STRING *lex_name, PMC *ctx)>
+
+Locate the LexPad containing the given C<lex_name> in C<ctx> and
+its caller pads. Return PMCNULL on failure.
+
+=cut
+
+*/
+
+PARROT_CAN_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+PMC*
+Parrot_find_dynamic_pad(PARROT_INTERP, ARGIN(STRING *lex_name), ARGIN(PMC *ctx))
+{
+ ASSERT_ARGS(Parrot_find_dynamic_pad)
+ while (1) {
+ PMC * const lex_pad = Parrot_pcc_get_lex_pad(interp, ctx);
+ PMC * caller = Parrot_pcc_get_caller_ctx(interp, ctx);
+
+ if (!caller)
+ return lex_pad;
+
+ if (!PMC_IS_NULL(lex_pad))
+ if (VTABLE_exists_keyed_str(interp, lex_pad, lex_name))
+ return lex_pad;
+
+ ctx = caller;
+ }
+}
+
+
+/*
+
=item C<void Parrot_capture_lex(PARROT_INTERP, PMC *sub_pmc)>
Capture the current lexical environment of a sub.
@@ -440,12 +380,11 @@
Parrot_capture_lex(PARROT_INTERP, ARGMOD(PMC *sub_pmc))
{
ASSERT_ARGS(Parrot_capture_lex)
- Parrot_Context * const ctx = CONTEXT(interp);
+ PMC * const ctx = CURRENT_CONTEXT(interp);
Parrot_Sub_attributes *current_sub;
Parrot_Sub_attributes *sub;
- Parrot_Context *old;
- PMC_get_sub(interp, ctx->current_sub, current_sub);
+ PMC_get_sub(interp, Parrot_pcc_get_sub(interp, ctx), current_sub);
/* MultiSub gets special treatment */
if (VTABLE_isa(interp, sub_pmc, CONST_STRING(interp, "MultiSub"))) {
@@ -463,10 +402,7 @@
PMC_get_sub(interp, child_sub->outer_sub, child_outer_sub);
if (Parrot_str_equal(interp, current_sub->subid,
child_outer_sub->subid)) {
- old = child_sub->outer_ctx;
- child_sub->outer_ctx = Parrot_context_ref(interp, ctx);
- if (old)
- Parrot_free_context(interp, old, 1);
+ child_sub->outer_ctx = ctx;
}
}
}
@@ -491,10 +427,7 @@
#endif
/* set the sub's outer context to the current context */
- old = sub->outer_ctx;
- sub->outer_ctx = Parrot_context_ref(interp, ctx);
- if (old)
- Parrot_free_context(interp, old, 1);
+ sub->outer_ctx = ctx;
}
@@ -540,16 +473,11 @@
Parrot_continuation_check(PARROT_INTERP, ARGIN(const PMC *pmc))
{
ASSERT_ARGS(Parrot_continuation_check)
- Parrot_Context *to_ctx = PARROT_CONTINUATION(pmc)->to_ctx;
- Parrot_Context *from_ctx = CONTEXT(interp);
-#if CTX_LEAK_DEBUG
- if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG))
- fprintf(stderr,
- "[invoke cont %p, to_ctx %p, from_ctx %p (refs %d)]\n",
- (const void *)pmc, (void *)to_ctx, (void *)from_ctx, (int)from_ctx->ref_count);
-#endif
- if (!to_ctx)
+ PMC *to_ctx = PARROT_CONTINUATION(pmc)->to_ctx;
+ PMC *from_ctx = CURRENT_CONTEXT(interp);
+
+ if (PMC_IS_NULL(to_ctx))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Continuation invoked after deactivation.");
}
@@ -570,11 +498,11 @@
{
ASSERT_ARGS(Parrot_continuation_rewind_environment)
- Parrot_Context * const to_ctx = PARROT_CONTINUATION(pmc)->to_ctx;
+ PMC * const to_ctx = PARROT_CONTINUATION(pmc)->to_ctx;
/* debug print before context is switched */
if (Interp_trace_TEST(interp, PARROT_TRACE_SUB_CALL_FLAG)) {
- PMC * const sub = to_ctx->current_sub;
+ PMC * const sub = Parrot_pcc_get_sub(interp, to_ctx);
Parrot_io_eprintf(interp, "# Back in sub '%Ss', env %p\n",
Parrot_full_sub_name(interp, sub),
@@ -582,9 +510,7 @@
}
/* set context */
- CONTEXT(interp) = to_ctx;
- interp->ctx.bp = to_ctx->bp;
- interp->ctx.bp_ps = to_ctx->bp_ps;
+ CURRENT_CONTEXT(interp) = to_ctx;
}
Modified: branches/kill_parrot_cont/src/warnings.c
==============================================================================
--- branches/kill_parrot_cont/src/warnings.c Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/src/warnings.c Sun Sep 6 00:20:10 2009 (r41024)
@@ -53,8 +53,7 @@
interp->pdb->debugger :
interp;
Parrot_io_eprintf(tracer, "%Ss\n",
- Parrot_Context_infostr(interp,
- CONTEXT(interp)));
+ Parrot_Context_infostr(interp, CURRENT_CONTEXT(interp)));
}
/*
Modified: branches/kill_parrot_cont/t/compilers/pge/06-grammar.t
==============================================================================
--- branches/kill_parrot_cont/t/compilers/pge/06-grammar.t Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/compilers/pge/06-grammar.t Sun Sep 6 00:20:10 2009 (r41024)
@@ -180,6 +180,7 @@
load_bytecode 'PGE.pbc'
load_bytecode 'PGE/Perl6Grammar.pbc'
+ ok = 1
match = parser(expr)
result = match
Modified: branches/kill_parrot_cont/t/compilers/pge/perl6regex/rx_quantifiers
==============================================================================
--- branches/kill_parrot_cont/t/compilers/pge/perl6regex/rx_quantifiers Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/compilers/pge/perl6regex/rx_quantifiers Sun Sep 6 00:20:10 2009 (r41024)
@@ -204,7 +204,7 @@
^\w+ ** ','$ foo,bar,baz y ** with a term
^\w+ **? ',' ....$ foo,bar,baz y **? with a term
-^\w+ **[','\s*]$ foo, bar, baz y **? with term + ws
-:sigspace ^\w+ ** ',' $ foo, bar ,baz y **? under :sigspace
-:sigspace ^\w+**',' $ foo, bar ,baz n **? under :sigspace w/o ws
-:sigspace ^\w+**',' $ foo,bar,baz y **? under :sigspace w/o ws
+^\w+ **[','\s*]$ foo, bar, baz y ** with term + ws
+:sigspace ^\w+ ** ',' $ foo, bar ,baz y ** under :sigspace
+:sigspace ^\w+**',' $ foo, bar ,baz n ** under :sigspace w/o ws
+:sigspace ^\w+**',' $ foo,bar,baz y ** under :sigspace w/o ws
Modified: branches/kill_parrot_cont/t/native_pbc/annotations.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/kill_parrot_cont/t/native_pbc/integer_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/kill_parrot_cont/t/native_pbc/number_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/kill_parrot_cont/t/native_pbc/string_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/kill_parrot_cont/t/op/annotate.t
==============================================================================
--- branches/kill_parrot_cont/t/op/annotate.t Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/op/annotate.t Sun Sep 6 00:20:10 2009 (r41024)
@@ -37,6 +37,7 @@
failed:
.local pmc exception
.get_results (exception)
+ pop_eh
$P0 = exception.'annotations'()
isa_ok ($P0, 'Hash', 'annotations gives back hash')
$I0 = elements $P0
@@ -59,6 +60,7 @@
failed:
.local pmc exception
.get_results (exception)
+ pop_eh
$P0 = exception.'annotations'('file')
is ($P0, 'foo.p6', "file annotation got OK")
@@ -107,6 +109,7 @@
failed:
.local pmc exception, bt, frame, ann
.get_results (exception)
+ pop_eh
bt = exception.'backtrace'()
$I0 = elements bt
$I0 = $I0 > 3
Modified: branches/kill_parrot_cont/t/op/box.t
==============================================================================
--- branches/kill_parrot_cont/t/op/box.t Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/op/box.t Sun Sep 6 00:20:10 2009 (r41024)
@@ -1,5 +1,5 @@
#!parrot
-# Copyright (C) 2008, Parrot Foundation.
+# Copyright (C) 2008-2009, Parrot Foundation.
# $Id$
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-.const int TESTS = 24
+.const int TESTS = 26
# must set these up before the hll_map calls later
.sub '__setup' :immediate
@@ -33,6 +33,7 @@
'box_int'()
'box_num'()
'box_string'()
+ 'box_null_string'()
.local pmc box_int_hll
box_int_hll = get_root_global [ 'for_test' ], 'box_int'
@@ -93,7 +94,20 @@
isa_ok( $P0, 'String', 'string boxed to appropriate base type from reg' )
.end
+.sub 'box_null_string'
+ null $S0
+ $P0 = box $S0
+ $S1 = $P0
+ is( $S1, '', 'NULL STRING boxed to empty String PMC' )
+
+ $P1 = clone $P0
+ $S1 = $P0
+ is( $S1, '', '... and survives clone of boxed PMC (TT #964)' )
+
+.end
+
.HLL 'for_test'
+
.sub anon :anon :init
.local pmc interp
.local pmc cint, myint
Modified: branches/kill_parrot_cont/t/op/lexicals.t
==============================================================================
--- branches/kill_parrot_cont/t/op/lexicals.t Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/op/lexicals.t Sun Sep 6 00:20:10 2009 (r41024)
@@ -14,7 +14,7 @@
plan( skip_all => 'lexicals not thawed properly from PBC, RT #60652' )
if $ENV{TEST_PROG_ARGS} =~ /--run-pbc/;
-plan( tests => 48 );
+plan( tests => 51 );
=head1 NAME
@@ -1493,6 +1493,71 @@
ok 2 - looking up lexical sub
OUTPUT
+pir_output_is( <<'CODE', <<'OUTPUT', 'find_dynamic_lex basic' );
+.sub 'main'
+ $P0 = box 'main'
+ .lex '$*VAR', $P0
+ 'foo'()
+ $P1 = find_dynamic_lex '$*VAR'
+ if null $P1 goto p1_null
+ print 'not '
+ p1_null:
+ say 'null'
+.end
+
+.sub 'foo'
+ $P1 = find_dynamic_lex '$*VAR'
+ say $P1
+.end
+CODE
+main
+null
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "find_dynamic_lex doesn't search outer" );
+.sub 'main'
+ $P0 = box 'main'
+ .lex '$*VAR', $P0
+ 'bar'()
+.end
+
+.sub 'bar'
+ $P0 = box 'bar'
+ .lex '$*VAR', $P0
+ 'foo'()
+.end
+
+.sub 'foo' :outer('main')
+ $P1 = find_dynamic_lex '$*VAR'
+ say $P1
+ $P1 = find_lex '$*VAR'
+ say $P1
+.end
+CODE
+bar
+main
+OUTPUT
+
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'find_dynamic_lex two levels deep' );
+.sub 'main'
+ $P0 = box 'main'
+ .lex '$*VAR', $P0
+ 'bar'()
+.end
+
+.sub 'bar'
+ 'foo'()
+.end
+
+.sub 'foo'
+ $P1 = find_dynamic_lex '$*VAR'
+ say $P1
+.end
+CODE
+main
+OUTPUT
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
Modified: branches/kill_parrot_cont/t/op/string.t
==============================================================================
--- branches/kill_parrot_cont/t/op/string.t Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/op/string.t Sun Sep 6 00:20:10 2009 (r41024)
@@ -1,5 +1,5 @@
#!perl
-# Copyright (C) 2001-2008, Parrot Foundation.
+# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
use strict;
@@ -7,7 +7,7 @@
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 166;
+use Parrot::Test tests => 167;
use Parrot::Config;
=head1 NAME
@@ -55,6 +55,13 @@
Bar
OUTPUT
+pasm_output_is( <<'CODE', <<'OUTPUT', 'clone null' );
+ null S0
+ clone S1, S0
+ end
+CODE
+OUTPUT
+
pasm_output_is( <<'CODE', '4', 'length_i_s' );
set I4, 0
set S4, "JAPH"
Copied: branches/kill_parrot_cont/t/pmc/context.t (from r41020, trunk/t/pmc/context.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/kill_parrot_cont/t/pmc/context.t Sun Sep 6 00:20:10 2009 (r41024, copy of r41020, trunk/t/pmc/context.t)
@@ -0,0 +1,35 @@
+#! parrot
+# Copyright (C) 2009, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+t/pmc/context.t - test Context PMC
+
+=head1 SYNOPSIS
+
+ % prove t/pmc/context.t
+
+=head1 DESCRIPTION
+
+Tests the Context PMC.
+
+TODO: Implement real tests when Context PMC will be migrated to use ATTRibutes.
+
+=cut
+
+.sub main :main
+ .include 'test_more.pir'
+
+ plan(1)
+
+ $P0 = new ['Context']
+ sweep 1
+ ok(1, 'Instantiated .Context')
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/kill_parrot_cont/t/pmc/exceptionhandler.t
==============================================================================
--- branches/kill_parrot_cont/t/pmc/exceptionhandler.t Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/pmc/exceptionhandler.t Sun Sep 6 00:20:10 2009 (r41024)
@@ -22,7 +22,8 @@
.sub main :main
.include 'test_more.pir'
- plan(8)
+ # If test exited with "bad plan" MyHandlerCan.can_handle wasn't invoked.
+ plan(9)
.local pmc eh
eh = new ['ExceptionHandler']
@@ -213,6 +214,7 @@
.sub can_handle :method
.param pmc ex
+ ok(1, 'MyHandlerCan.can_handle invoked')
.return(1)
.end
Modified: branches/kill_parrot_cont/t/pmc/fixedpmcarray.t
==============================================================================
--- branches/kill_parrot_cont/t/pmc/fixedpmcarray.t Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/pmc/fixedpmcarray.t Sun Sep 6 00:20:10 2009 (r41024)
@@ -6,7 +6,7 @@
use warnings;
use lib qw(lib . ../lib ../../lib);
-use Parrot::Test tests => 21;
+use Parrot::Test tests => 25;
use Test::More;
=head1 NAME
@@ -44,6 +44,53 @@
ok 2
OUTPUT
+pir_output_is( <<'CODE', <<'OUTPUT', "Assign from other FPA");
+.sub main
+ .local pmc arr1, arr2
+ .local int n
+ arr1 = new ['FixedPMCArray']
+ arr1 = 32
+ arr2 = new ['FixedPMCArray']
+ arr2 = 15
+ assign arr1, arr2
+ n = arr1
+ say n
+.end
+CODE
+15
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "Assign to self");
+.sub main
+ .local pmc arr
+ arr = new ['FixedPMCArray']
+ assign arr, arr
+ say 'Done'
+.end
+CODE
+Done
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "Assign from non-array");
+.sub main
+ .local pmc arr, other
+ .local int n
+ arr = new ['FixedPMCArray']
+ other = new ['Integer']
+ push_eh catch
+ say 'Assign'
+ assign arr, other
+ say 'Never here!'
+ goto done
+catch:
+ say 'Catched'
+done:
+.end
+CODE
+Assign
+Catched
+OUTPUT
+
pasm_error_output_like( <<'CODE', <<'OUTPUT', "Resetting array size (and getting an exception)" );
new P0, ['FixedPMCArray']
@@ -401,6 +448,27 @@
/Null PMC access in name()/
OUTPUT
+pir_output_is(<<'CODE', <<'OUTPUT', "Getting null elements");
+
+.sub main :main
+ .local pmc arr1, n
+ .local int i
+ .local string s
+ arr1 = new ['FixedPMCArray']
+ arr1 = 1
+ arr1[0] = n
+ i = arr1[0]
+ say i
+ s = arr1[0]
+ print '"'
+ print s
+ say '"'
+.end
+CODE
+0
+""
+OUTPUT
+
pir_output_is( << 'CODE', << 'OUTPUT', "Multi keys" );
.sub test :main
Copied: branches/kill_parrot_cont/t/pmc/namespace-old.t (from r41020, trunk/t/pmc/namespace-old.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/kill_parrot_cont/t/pmc/namespace-old.t Sun Sep 6 00:20:10 2009 (r41024, copy of r41020, trunk/t/pmc/namespace-old.t)
@@ -0,0 +1,1404 @@
+#! perl
+# Copyright (C) 2001-2009, Parrot Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use lib qw( . lib ../lib ../../lib );
+use Test::More;
+use Parrot::Test tests => 45;
+use Parrot::Config;
+
+=head1 NAME
+
+t/pmc/namespace.t - test the NameSpace PMC as described in PDD 21.
+
+=head1 SYNOPSIS
+
+ % prove t/pmc/namespace.t
+
+=head1 DESCRIPTION
+
+Test the NameSpace PMC as described in PDD21.
+
+=cut
+
+# How do we convert this to PIR?
+pir_output_is( <<'CODE', <<'OUTPUT', 'get namespace of :anon .sub' );
+.namespace ['lib']
+.sub main :main :anon
+ $P0 = get_namespace
+ $P0 = $P0.'get_name'()
+ $S0 = join "::", $P0
+ say $S0
+ end
+.end
+CODE
+parrot::lib
+OUTPUT
+
+# How do we convert this to PIR?
+pir_output_is( <<'CODE', <<'OUTPUT', "segv in get_name" );
+.namespace ['pugs';'main']
+.sub 'main' :main
+ $P0 = find_name "&say"
+ $P0()
+.end
+.sub "&say"
+ say "ok"
+.end
+CODE
+ok
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUT', "unicode namespace, global" );
+.namespace [ unicode:"Fran\xe7ois" ]
+
+.sub 'test'
+ print "unicode namespaces are fun\n"
+.end
+
+.namespace []
+
+.sub 'main' :main
+ $P0 = get_global [unicode:"Fran\xe7ois"], 'test'
+ $P0()
+.end
+CODE
+unicode namespaces are fun
+OUT
+
+my $temp_a = "temp_a";
+my $temp_b = "temp_b";
+
+END {
+ unlink( "$temp_a.pir", "$temp_a.pbc", "$temp_b.pir", "$temp_b.pbc" );
+}
+
+open my $S, '>', "$temp_a.pir" or die "Can't write $temp_a.pir";
+print $S <<'EOF';
+.HLL "Foo"
+.namespace ["Foo_A"]
+.sub loada :load
+ $P0 = get_global ["Foo_A"], "A"
+ print "ok 1\n"
+ load_bytecode "temp_b.pbc"
+.end
+
+.sub A
+.end
+EOF
+close $S;
+
+open $S, '>', "$temp_b.pir" or die "Can't write $temp_b.pir";
+print $S <<'EOF';
+.namespace ["Foo_B"]
+.sub loadb :load
+ $P0 = get_global ["Foo_B"], "B"
+ print "ok 2\n"
+.end
+
+.sub B
+.end
+EOF
+
+close $S;
+
+system(".$PConfig{slash}parrot$PConfig{exe} -o $temp_a.pbc $temp_a.pir");
+system(".$PConfig{slash}parrot$PConfig{exe} -o $temp_b.pbc $temp_b.pir");
+
+pir_output_is( <<'CODE', <<'OUTPUT', "HLL and load_bytecode - #38888" );
+.sub main :main
+ load_bytecode "temp_a.pbc"
+ print "ok 3\n"
+.end
+CODE
+ok 1
+ok 2
+ok 3
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "HLL and vars" );
+# initial storage of _tcl global variable...
+
+.HLL '_Tcl'
+
+.sub huh
+ $P0 = new ['Integer']
+ $P0 = 3.14
+ set_global '$variable', $P0
+.end
+
+# start running HLL language
+.HLL 'Tcl'
+
+.sub foo :main
+ huh()
+ $P1 = get_root_namespace ['_tcl']
+ $P2 = $P1['$variable']
+ print $P2
+ print "\n"
+.end
+CODE
+3.14
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "HLL and namespace directives" );
+.HLL '_Tcl'
+.namespace ['Foo'; 'Bar']
+
+.HLL 'Tcl'
+
+.sub main :main
+ $P0 = get_namespace
+ $P1 = $P0.'get_name'()
+ $S0 = join "::", $P1
+ print $S0
+ print "\n"
+ end
+.end
+CODE
+tcl
+OUTPUT
+
+{
+ my $temp_a = "temp_a.pir";
+
+ END {
+ unlink($temp_a);
+ }
+
+ open $S, '>', $temp_a or die "Can't write $temp_a";
+ print $S <<'EOF';
+.HLL 'eek'
+
+.sub foo :load :anon
+ $P1 = new ['String']
+ $P1 = "3.14\n"
+ set_global '$whee', $P1
+.end
+
+.sub bark
+ $P0 = get_global '$whee'
+ print $P0
+.end
+EOF
+ close $S;
+
+ pir_output_is( <<'CODE', <<'OUTPUT', ":anon subs still get default namespace" );
+.HLL 'cromulent'
+
+.sub what
+ load_bytecode 'temp_a.pir'
+ .local pmc var
+ var = get_root_namespace
+ var = var['eek']
+ var = var['bark']
+
+ var()
+.end
+CODE
+3.14
+OUTPUT
+}
+
+SKIP:
+{
+ skip( "immediate test, doesn't with --run-pbc", 1 )
+ if ( exists $ENV{TEST_PROG_ARGS} and $ENV{TEST_PROG_ARGS} =~ m/--run-pbc/ );
+
+ pir_output_is( <<'CODE', <<'OUTPUT', "get_global in current" );
+.HLL 'bork'
+.namespace []
+
+.sub a :immediate
+ $P1 = new ['String']
+ $P1 = "ok\n"
+ set_global ['sub_namespace'], "eek", $P1
+.end
+
+.namespace [ 'sub_namespace' ]
+
+.sub whee :main
+ $P1 = get_global 'eek'
+ print $P1
+.end
+CODE
+ok
+OUTPUT
+}
+
+open $S, '>', "$temp_b.pir" or die "Can't write $temp_b.pir";
+print $S <<'EOF';
+.HLL 'B'
+.sub b_foo
+ print "b_foo\n"
+.end
+EOF
+close $S;
+
+pir_error_output_like( <<'CODE', <<'OUTPUT', 'export_to() with null destination throws exception' );
+.sub 'test' :main
+ .local pmc nsa, nsb, ar
+
+ ar = new ['ResizableStringArray']
+ push ar, 'foo'
+ nsa = new ['Null']
+ nsb = get_namespace ['B']
+ nsb.'export_to'(nsa, ar)
+.end
+
+.namespace ['B']
+.sub 'foo' :anon
+.end
+CODE
+/^destination namespace not specified\n/
+OUTPUT
+
+pir_error_output_like(
+ <<'CODE', <<'OUTPUT', 'export_to() with null exports default object set !!!UNSPECIFIED!!!' );
+.sub 'test' :main
+ .local pmc nsa, nsb, ar
+
+ ar = new ['Null']
+ nsa = get_namespace
+ nsb = get_namespace ['B']
+ nsb.'export_to'(nsa, ar)
+.end
+
+.namespace ['B']
+.sub 'foo'
+.end
+CODE
+/^exporting default object set not yet implemented\n/
+OUTPUT
+
+pir_error_output_like(
+ <<'CODE', <<'OUTPUT', 'export_to() with empty array exports default object set !!!UNSPECIFIED!!!' );
+.sub 'test' :main
+ .local pmc nsa, nsb, ar
+
+ ar = new ['ResizableStringArray']
+ nsa = get_namespace
+ nsb = get_namespace ['B']
+ nsb.'export_to'(nsa, ar)
+.end
+
+.namespace ['B']
+.sub 'foo'
+.end
+CODE
+/^exporting default object set not yet implemented\n/
+OUTPUT
+
+pir_error_output_like(
+ <<'CODE', <<'OUTPUT', 'export_to() with empty hash exports default object set !!!UNSPECIFIED!!!' );
+.sub 'test' :main
+ .local pmc nsa, nsb, ar
+
+ ar = new ['Hash']
+ nsa = get_namespace
+ nsb = get_namespace ['B']
+ nsb.'export_to'(nsa, ar)
+.end
+
+.namespace ['B']
+.sub 'foo'
+.end
+CODE
+/^exporting default object set not yet implemented\n/
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with array" );
+.HLL 'A'
+.sub main :main
+ a_foo()
+ load_bytecode "$temp_b.pir"
+ .local pmc nsr, nsa, nsb, ar
+ ar = new ['ResizableStringArray']
+ push ar, "b_foo"
+ nsr = get_root_namespace
+ nsa = nsr['a']
+ nsb = nsr['b']
+ nsb."export_to"(nsa, ar)
+ b_foo()
+.end
+
+.sub a_foo
+ print "a_foo\\n"
+.end
+CODE
+a_foo
+b_foo
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with hash (empty value)" );
+.HLL 'A'
+.sub main :main
+ a_foo()
+ load_bytecode "$temp_b.pir"
+ .local pmc nsr, nsa, nsb, ar
+ ar = new ['Hash']
+ ar["b_foo"] = ""
+ nsr = get_root_namespace
+ nsa = nsr['a']
+ nsb = nsr['b']
+ nsb."export_to"(nsa, ar)
+ b_foo()
+.end
+
+.sub a_foo
+ print "a_foo\\n"
+.end
+CODE
+a_foo
+b_foo
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', "export_to -- success with hash (null value)" );
+.HLL 'A'
+.sub main :main
+ a_foo()
+ load_bytecode "$temp_b.pir"
+ .local pmc nsr, nsa, nsb, ar, nul
+ nul = new ['Null']
+ ar = new ['Hash']
+ ar["b_foo"] = nul
+ nsr = get_root_namespace
+ nsa = nsr['a']
+ nsb = nsr['b']
+ nsb."export_to"(nsa, ar)
+ b_foo()
+.end
+
+.sub a_foo
+ print "a_foo\\n"
+.end
+CODE
+a_foo
+b_foo
+OUTPUT
+
+pir_error_output_like( <<"CODE", <<'OUTPUT', "export_to -- success with hash (and value)" );
+.HLL 'A'
+.sub main :main
+ a_foo()
+ load_bytecode "$temp_b.pir"
+ .local pmc nsr, nsa, nsb, ar
+ ar = new ['Hash']
+ ar["b_foo"] = "c_foo"
+ nsr = get_root_namespace
+ nsa = nsr['a']
+ nsb = nsr['b']
+ nsb."export_to"(nsa, ar)
+ c_foo()
+ b_foo()
+.end
+
+.sub a_foo
+ print "a_foo\\n"
+.end
+CODE
+/^a_foo
+b_foo
+Could not find non-existent sub b_foo/
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_parent" );
+.sub main :main
+ .local pmc ns
+ ns = get_hll_namespace ['Foo']
+ ns = ns.'get_parent'()
+ print ns
+ print "\n"
+.end
+.namespace ['Foo']
+.sub dummy
+.end
+CODE
+parrot
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global [''], \"print_ok\"" );
+.namespace ['']
+
+.sub print_ok
+ print "ok\n"
+ .return()
+.end
+
+.namespace ['foo']
+
+.sub main :main
+ $P0 = get_hll_global [''], 'print_ok'
+ $P0()
+ end
+.end
+CODE
+ok
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global with array ('')" );
+.namespace ['']
+
+.sub print_ok
+ print "ok\n"
+ .return()
+.end
+
+.namespace ['foo']
+
+.sub main :main
+ $P0 = new ['ResizableStringArray']
+ $P0[0] = ''
+ $P0 = get_hll_global $P0, 'print_ok'
+ $P0()
+ end
+.end
+CODE
+ok
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "get_global with empty array" );
+.namespace []
+
+.sub print_ok
+ print "ok\n"
+ .return()
+.end
+
+.namespace ['foo']
+
+.sub main :main
+ $P0 = new ['ResizablePMCArray']
+ $P0 = 0
+ $P0 = get_hll_global $P0, 'print_ok'
+ $P0()
+ end
+.end
+CODE
+ok
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "Namespace.get_global() with array ('')" );
+.namespace ['']
+
+.sub print_ok
+ print "ok\n"
+ .return()
+.end
+
+.namespace ['foo']
+
+.sub main :main
+ $P1 = new ['ResizableStringArray']
+ $P1[0] = ''
+ $P1 = get_hll_global $P1, 'print_ok'
+ $P1()
+ end
+.end
+CODE
+ok
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "Namespace introspection" );
+.sub main :main
+ .local pmc f
+ f = get_hll_global ['Foo'], 'dummy'
+ f()
+.end
+.namespace ['Foo']
+.sub dummy
+ .local pmc interp, ns_caller
+ interp = getinterp
+ ns_caller = interp['namespace'; 1]
+ print ns_caller
+ print "\n"
+.end
+CODE
+parrot
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "Nested namespace introspection" );
+.sub main :main
+ .local string no_symbol
+
+ .local pmc foo_ns
+ foo_ns = get_hll_namespace [ 'Foo' ]
+ $S0 = foo_ns
+ print "Found namespace: "
+ print $S0
+ print "\n"
+
+ .local pmc bar_ns
+ bar_ns = foo_ns.'find_namespace'( 'Bar' )
+ $S0 = bar_ns
+ print "Found nested namespace: "
+ print $S0
+ print "\n"
+
+ .local pmc baz_ns
+ baz_ns = bar_ns.'find_namespace'( 'Baz' )
+ no_symbol = 'Baz'
+
+ .local int is_defined
+ is_defined = defined baz_ns
+ if is_defined goto oops
+ goto find_symbols
+
+ oops:
+ print "Found non-null '"
+ print no_symbol
+ print "'\n"
+ .return()
+
+ find_symbols:
+ .local pmc a_sub
+ a_sub = bar_ns.'find_sub'( 'a_sub' )
+ $S0 = a_sub
+ a_sub()
+ print "Found sub: "
+ print $S0
+ print "\n"
+
+ .local pmc some_sub
+ some_sub = bar_ns.'find_sub'( 'some_sub' )
+ no_symbol = 'some_sub'
+
+ is_defined = defined some_sub
+ if is_defined goto oops
+
+ .local pmc a_var
+ a_var = bar_ns.'find_var'( 'a_var' )
+ print "Found var: "
+ print a_var
+ print "\n"
+
+ .local pmc some_var
+ some_var = bar_ns.'find_var'( 'some_var' )
+ no_symbol = 'some_var'
+
+ is_defined = defined some_var
+ if is_defined goto oops
+
+.end
+
+.namespace ['Foo']
+
+.sub some_sub
+.end
+
+.namespace [ 'Foo'; 'Bar' ]
+
+.sub a_sub
+ .local pmc some_var
+ some_var = new ['String']
+ some_var = 'a string PMC'
+ set_hll_global [ 'Foo'; 'Bar' ], 'a_var', some_var
+.end
+CODE
+Found namespace: Foo
+Found nested namespace: Bar
+Found sub: a_sub
+Found var: a string PMC
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace' );
+.sub main :main
+ .local pmc root_ns
+ root_ns = get_root_namespace
+ .local int is_defined
+ is_defined = defined root_ns
+ unless is_defined goto NO_NAMESPACE_FOUND
+ print "Found root namespace.\n"
+ NO_NAMESPACE_FOUND:
+.end
+CODE
+Found root namespace.
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'root namespace is not a class' );
+.sub main :main
+ .local pmc root_ns
+ root_ns = get_root_namespace
+ .local pmc root_class
+ root_class = get_class root_ns
+ .local int is_class
+ is_class = defined root_class
+ say is_class
+.end
+CODE
+0
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace "Foo"' );
+.sub main :main
+ .local pmc foo_ns
+ foo_ns = get_root_namespace [ "foo" ]
+ .local int is_defined
+ is_defined = defined foo_ns
+ unless is_defined goto NO_NAMESPACE_FOUND
+ print "Found root namespace 'foo'.\n"
+ NO_NAMESPACE_FOUND:
+.end
+.HLL 'Foo'
+.sub dummy
+.end
+CODE
+Found root namespace 'foo'.
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', 'get_root_namespace "Foo", not there' );
+.sub main :main
+ .local pmc foo_ns
+ foo_ns = get_root_namespace [ "Foo" ]
+ .local int is_defined
+ is_defined = defined foo_ns
+ if is_defined goto NAMESPACE_FOUND
+ print "Didn't find root namespace 'Foo'.\n"
+ NAMESPACE_FOUND:
+.end
+
+.namespace [ "NotFoo" ]
+CODE
+Didn't find root namespace 'Foo'.
+OUTPUT
+
+my $create_nested_key = <<'CREATE_NESTED_KEY';
+.sub create_nested_key
+ .param string name
+ .param pmc other_names :slurpy
+
+ .local pmc key
+ key = new ['Key']
+ key = name
+
+ .local int elem
+ elem = other_names
+
+ if elem goto nested
+ .return( key )
+
+ nested:
+ .local pmc tail
+ tail = create_nested_key(other_names :flat)
+ push key, tail
+
+ .return( key )
+.end
+CREATE_NESTED_KEY
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'get_name()' );
+$create_nested_key
+
+.sub main :main
+ .local pmc key
+ key = create_nested_key( 'SingleName' )
+ print_namespace( key )
+
+ key = create_nested_key( 'Nested', 'Name', 'Space' )
+ print_namespace( key )
+
+ key = get_namespace
+
+ .local pmc ns
+ ns = key.'get_name'()
+
+ .local string ns_name
+ ns_name = join ';', ns
+ print ns_name
+ print "\\n"
+.end
+
+.sub 'print_namespace'
+ .param pmc key
+
+ .local pmc get_ns
+ get_ns = get_global key, 'get_namespace'
+
+ .local pmc ns
+ ns = get_ns()
+
+ .local pmc name_array
+ name_array = ns.'get_name'()
+
+ .local string name
+ name = join ';', name_array
+
+ print name
+ print "\\n"
+.end
+
+.sub get_namespace
+ .local pmc ns
+ ns = get_namespace
+ .return( ns )
+.end
+
+.namespace [ 'SingleName' ]
+
+.sub get_namespace
+ .local pmc ns
+ ns = get_namespace
+ .return( ns )
+.end
+
+.namespace [ 'Nested'; 'Name'; 'Space' ]
+
+.sub get_namespace
+ .local pmc ns
+ ns = get_namespace
+ .return( ns )
+.end
+
+CODE
+parrot;SingleName
+parrot;Nested;Name;Space
+parrot
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'add_namespace()' );
+$create_nested_key
+
+.sub main :main
+ .local pmc root_ns
+ root_ns = get_namespace
+
+ .local pmc child_ns
+ child_ns = new ['NameSpace']
+ root_ns.'add_namespace'( 'Nested', child_ns )
+
+ .local pmc grandchild_ns
+ grandchild_ns = new ['NameSpace']
+ child_ns.'add_namespace'( 'Grandkid', grandchild_ns )
+
+ .local pmc great_grandchild_ns
+ great_grandchild_ns = new ['NameSpace']
+ grandchild_ns.'add_namespace'( 'Greatgrandkid', great_grandchild_ns )
+
+ .local pmc parent
+ parent = great_grandchild_ns.'get_parent'()
+ print_ns_name( parent )
+
+ parent = parent.'get_parent'()
+ print_ns_name( parent )
+
+ parent = parent.'get_parent'()
+ print_ns_name( parent )
+.end
+
+.sub print_ns_name
+ .param pmc namespace
+
+ .local pmc ns
+ ns = namespace.'get_name'()
+
+ .local string ns_name
+ ns_name = join ';', ns
+ print ns_name
+ print "\\n"
+.end
+CODE
+parrot;Nested;Grandkid
+parrot;Nested
+parrot
+OUTPUT
+
+pir_output_like( <<'CODE', <<'OUTPUT', 'add_namespace() with error' );
+.sub main :main
+ .local pmc ns_child
+ ns_child = subclass 'NameSpace', 'NSChild'
+
+ .local pmc child
+ child = new ['NSChild']
+
+ .local pmc root_ns
+ root_ns = get_namespace
+
+ root_ns.'add_namespace'( 'Really nested', child )
+
+ .local pmc not_a_ns
+ not_a_ns = new ['Integer']
+
+ push_eh _invalid_ns
+ root_ns.'add_namespace'( 'Nested', not_a_ns )
+ end
+
+_invalid_ns:
+ .local pmc exception
+ .local string message
+ .get_results( exception )
+
+ message = exception
+ print message
+ print "\n"
+.end
+CODE
+/Invalid type \d+ in add_namespace\(\)/
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'add_sub()' );
+$create_nested_key
+
+.sub 'main' :main
+ .local pmc report_ns
+ report_ns = get_global 'report_namespace'
+
+ .local pmc key
+ key = create_nested_key( 'Parent' )
+
+ .local pmc parent_ns
+ parent_ns = get_namespace key
+ parent_ns.'add_sub'( 'report_ns', report_ns )
+
+ key = create_nested_key( 'Parent', 'Child' )
+
+ .local pmc child_ns
+ child_ns = get_namespace key
+ child_ns.'add_sub'( 'report_ns', report_ns )
+
+ .local pmc report_namespace
+ report_namespace = get_global [ 'Parent' ], 'report_ns'
+ report_namespace()
+
+ report_namespace = get_global [ 'Parent'; 'Child' ], 'report_ns'
+ report_namespace()
+.end
+
+.sub 'report_namespace'
+ .local pmc namespace
+ namespace = get_namespace
+
+ .local pmc ns
+ ns = namespace.'get_name'()
+
+ .local string ns_name
+ ns_name = join ';', ns
+ print ns_name
+ print "\\n"
+.end
+
+.namespace [ 'Parent' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent'; 'Child' ]
+
+.sub dummy
+.end
+CODE
+parrot
+parrot
+OUTPUT
+
+pir_output_like( <<'CODE', <<'OUTPUT', 'add_sub() with error' );
+.sub main :main
+ .local pmc s_child
+ s_child = subclass 'Sub', 'SubChild'
+
+ .local pmc child
+ child = new ['SubChild']
+
+ .local pmc root_ns
+ root_ns = get_namespace
+
+ root_ns.'add_sub'( 'child', child )
+ print "Added sub child\n"
+
+ child = new ['Coroutine']
+ root_ns.'add_sub'( 'coroutine', child )
+ print "Added coroutine\n"
+
+ child = new ['Eval']
+ root_ns.'add_sub'( 'eval', child )
+ print "Added eval\n"
+
+ .local pmc not_a_sub
+ not_a_sub = new ['Integer']
+
+ push_eh _invalid_sub
+ root_ns.'add_sub'( 'Nested', not_a_sub )
+ end
+
+_invalid_sub:
+ .local pmc exception
+ .local string message
+ .get_results( exception )
+
+ message = exception
+ print message
+ print "\n"
+.end
+CODE
+/Added sub child
+Added coroutine
+Added eval
+Invalid type \d+ in add_sub\(\)/
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'add_var()' );
+$create_nested_key
+
+.sub 'main' :main
+ .local pmc foo
+ foo = new ['String']
+ foo = 'Foo'
+
+ .local pmc bar
+ bar = new ['String']
+ bar = 'Bar'
+
+ .local pmc key
+ key = create_nested_key( 'Parent' )
+
+ .local pmc parent_ns
+ parent_ns = get_namespace key
+ parent_ns.'add_var'( 'foo', foo )
+
+ key = create_nested_key( 'Parent', 'Child' )
+
+ .local pmc child_ns
+ child_ns = get_namespace key
+ child_ns.'add_var'( 'bar', bar )
+
+ .local pmc my_var
+ my_var = get_global [ 'Parent' ], 'foo'
+ print "Foo: "
+ print my_var
+ print "\\n"
+
+ my_var = get_global [ 'Parent'; 'Child' ], 'bar'
+ print "Bar: "
+ print my_var
+ print "\\n"
+.end
+
+.namespace [ 'Parent' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent'; 'Child' ]
+
+.sub dummy
+.end
+CODE
+Foo: Foo
+Bar: Bar
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'del_namespace()' );
+$create_nested_key
+
+.sub 'main' :main
+ .local pmc root_ns
+ root_ns = get_namespace
+
+ .local pmc key
+ key = create_nested_key( 'Parent' )
+
+ .local pmc child_ns
+ child_ns = root_ns.'find_namespace'( key )
+
+ key = create_nested_key( 'Child' )
+
+ .local pmc grandchild_ns
+ grandchild_ns = child_ns.'find_namespace'( key )
+
+ child_ns.'del_namespace'( 'Child' )
+
+ key = create_nested_key( 'Child' )
+
+ grandchild_ns = child_ns.'find_namespace'( key )
+ if_null grandchild_ns, CHECK_SIBLING
+ print "Grandchild still exists\\n"
+
+ CHECK_SIBLING:
+ key = create_nested_key( 'Sibling' )
+ grandchild_ns = child_ns.'find_namespace'( key )
+ if_null grandchild_ns, DELETE_PARENT
+ print "Sibling not deleted\\n"
+
+ DELETE_PARENT:
+ key = create_nested_key( 'Parent' )
+ root_ns.'del_namespace'( 'Parent' )
+ child_ns = root_ns.'find_namespace'( key )
+ if_null child_ns, CHECK_UNCLE
+ print "Child still exists\\n"
+
+ CHECK_UNCLE:
+ key = create_nested_key( 'FunUncle' )
+ grandchild_ns = root_ns.'find_namespace'( key )
+ if_null grandchild_ns, DELETE_PARENT
+ print "Fun uncle stuck around\\n"
+
+ ALL_DONE:
+.end
+
+.namespace [ 'FunUncle' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent'; 'Child' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent'; 'Sibling' ]
+
+.sub dummy
+.end
+CODE
+Sibling not deleted
+Fun uncle stuck around
+OUTPUT
+
+pir_output_like( <<'CODE', <<'OUTPUT', 'del_namespace() with error' );
+.sub dummy
+.end
+
+.sub main :main
+ .local pmc not_a_ns
+ not_a_ns = new ['Array']
+
+ set_global 'Not_A_NS', not_a_ns
+
+ .local pmc root_ns
+ root_ns = get_namespace
+ delete_namespace( root_ns, 'dummy' )
+ delete_namespace( root_ns, 'Not_A_NS' )
+.end
+
+.sub delete_namespace
+ .param pmc root_ns
+ .param string name
+ push_eh _invalid_ns
+ root_ns.'del_namespace'( name )
+
+_invalid_ns:
+ .local pmc exception
+ .local string message
+ .get_results( exception )
+
+ message = exception
+ print message
+ print "\n"
+ .return()
+.end
+CODE
+/Invalid type \d+ for 'dummy' in del_namespace\(\)
+Invalid type \d+ for 'Not_A_NS' in del_namespace\(\)/
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'del_sub()' );
+.sub 'main' :main
+ .local pmc root_ns
+ root_ns = get_namespace
+
+ .local pmc parent_ns
+ parent_ns = root_ns.'find_namespace'( 'Parent' )
+ parent_ns.'del_sub'( 'dummy' )
+
+ .local pmc my_sub
+ my_sub = get_global [ 'Parent' ], 'dummy'
+ if_null my_sub, PARENT_NO_DUMMY
+ print "Parent did not delete dummy\\n"
+
+ PARENT_NO_DUMMY:
+ my_sub = get_global [ 'Parent' ], 'no_dummy'
+ my_sub()
+
+ .local pmc child_ns
+ child_ns = parent_ns.'find_namespace'( 'Child' )
+ child_ns.'del_sub'( 'dummy' )
+
+ my_sub = get_global [ 'Parent'; 'Child' ], 'dummy'
+ if_null my_sub, CHILD_NO_DUMMY
+ print "Child did not delete dummy\\n"
+ my_sub()
+
+ CHILD_NO_DUMMY:
+ my_sub = get_global [ 'Parent'; 'Child' ], 'no_dummy'
+ my_sub()
+.end
+
+.namespace [ 'Parent' ]
+
+.sub dummy
+.end
+
+.sub no_dummy
+ print "Parent is no dummy\\n"
+.end
+
+.namespace [ 'Parent'; 'Child' ]
+
+.sub dummy
+ print "Dummy sub!\\n"
+.end
+
+.sub no_dummy
+ print "Child is no dummy\\n"
+.end
+
+CODE
+Parent is no dummy
+Child is no dummy
+OUTPUT
+
+pir_output_like( <<'CODE', <<'OUTPUT', 'del_sub() with error' );
+.sub main :main
+ .local pmc not_a_ns
+ not_a_ns = new ['Array']
+
+ set_global 'Not_A_Sub', not_a_ns
+
+ .local pmc root_ns
+ root_ns = get_namespace
+
+ push_eh _invalid_sub
+ root_ns.'del_sub'( 'Not_A_Sub' )
+
+_invalid_sub:
+ .local pmc exception
+ .local string message
+ .get_results( exception )
+
+ message = exception
+ print message
+ print "\n"
+ .return()
+.end
+CODE
+/Invalid type \d+ for 'Not_A_Sub' in del_sub\(\)/
+OUTPUT
+
+pir_output_is( <<"CODE", <<'OUTPUT', 'del_var()' );
+.sub 'main' :main
+ .local pmc foo
+ foo = new ['String']
+ foo = 'Foo'
+
+ .local pmc bar
+ bar = new ['String']
+ bar = 'Bar'
+
+ set_global [ 'Parent' ], 'Foo', foo
+ set_global [ 'Parent'; 'Child' ], 'Bar', bar
+
+ .local pmc root_ns
+ root_ns = get_namespace
+
+ .local pmc parent_ns
+ parent_ns = root_ns.'find_namespace'( 'Parent' )
+ parent_ns.'del_var'( 'Foo' )
+
+ .local pmc child_ns
+ child_ns = parent_ns.'find_namespace'( 'Child' )
+ child_ns.'del_var'( 'Bar' )
+
+ .local pmc my_var
+ my_var = get_global [ 'Parent' ], 'Foo'
+ if_null my_var, TEST_CHILD_VAR
+ print "Parent Foo exists: "
+ print my_var
+ print "\\n"
+
+ TEST_CHILD_VAR:
+ my_var = get_global [ 'Parent'; 'Child' ], 'Bar'
+ if_null my_var, ALL_DONE
+ print "Child Bar exists: "
+ print my_var
+ print "\\n"
+
+ ALL_DONE:
+.end
+
+.namespace [ 'Parent' ]
+
+.sub dummy
+.end
+
+.namespace [ 'Parent'; 'Child' ]
+
+CODE
+OUTPUT
+
+pir_error_output_like( <<'CODE', <<'OUTPUT', 'overriding find_method()' );
+.sub 'main' :main
+ $P0 = newclass 'Override'
+ $P1 = new ['Override']
+ $P2 = find_method $P1, 'foo'
+.end
+
+.namespace [ 'Override' ]
+
+.sub 'find_method' :vtable
+ .param string method
+ say "Finding method"
+.end
+CODE
+/Finding method/
+OUTPUT
+
+pir_output_is( <<'CODE', <<OUT, "iterate through a NameSpace PMC, RT #39978" );
+.sub main :main
+ $P0 = new ['String']
+ $P0 = "Ook...BANG!\n"
+ set_root_global [ "DUMMY"; "X"; "Y" ], "Explosion", $P0
+
+ $P1 = new ['Integer']
+ $P1 = 0
+ set_root_global [ "DUMMY"; "X"; "Y" ], "T0", $P0
+
+ .local pmc dummy_x_y_ns, it, res
+ dummy_x_y_ns = get_root_namespace [ "DUMMY"; "X"; "Y" ]
+ it = iter dummy_x_y_ns
+ res = new ['ResizablePMCArray']
+loop:
+ unless it goto loop_end
+ $S0 = shift it
+ push res, $S0
+ goto loop
+loop_end:
+
+ res.'sort'()
+ $S0 = join ' ', res
+ say $S0
+
+.end
+CODE
+Explosion T0
+OUT
+
+pir_error_output_like( <<'CODE', <<OUT, "NameSpace with no class, RT #55620" );
+.sub 'main' :main
+ $P1 = new ['NameSpace']
+ set_args '(0)', $P1
+ tailcallmethod $P1, 'bob'
+.end
+CODE
+/Null PMC access in get_string()/
+OUT
+
+pir_output_is( <<'CODE', <<OUT, "iterate through a NameSpace PMC" );
+.namespace [ 'bar' ]
+
+.sub 'main' :main
+ .local pmc res
+ res = new ['ResizablePMCArray']
+
+ $P0 = get_namespace
+ say $P0
+ $I0 = elements $P0
+ say $I0
+ $P1 = iter $P0
+ L1:
+ unless $P1 goto L2
+ $P2 = shift $P1
+ $S0 = $P2
+ push res, $S0
+ goto L1
+ L2:
+ res.'sort'()
+ $S0 = join "\n", res
+ say $S0
+ say 'OK'
+.end
+
+.sub 'foo'
+ say 'foo'
+.end
+CODE
+bar
+2
+foo
+main
+OK
+OUT
+
+pir_output_is( <<'CODE', <<'OUT', "make_namespace method");
+.sub 'main' :main
+ $P0 = split ';', 'perl6;Foo;Bar'
+ $P1 = get_root_namespace
+ $P2 = $P1.'make_namespace'($P0)
+ $I0 = isa $P2, 'NameSpace'
+ say $I0
+ $P3 = get_root_namespace ['perl6';'Foo';'Bar']
+ $I0 = isnull $P3
+ say $I0
+ $I0 = issame $P2, $P3
+ say $I0
+.end
+CODE
+1
+0
+1
+OUT
+
+pir_error_output_like( <<'CODE', <<'OUT', 'adding :anon sub to a namespace, TT #56' );
+.namespace ['Foo']
+.sub main :main
+ .const 'Sub' $P0 = 'bar'
+
+ set_global 'ok', $P0
+ $P1 = get_global 'ok'
+ say $P1
+ $S0 = ok()
+ say $S0
+ $S0 = nok()
+ say $S0
+.end
+
+.namespace []
+.sub 'nok' :anon :subid('bar')
+ .return( 'ok 1' )
+.end
+CODE
+/
+ok 1
+Could not find non-existent sub nok/
+OUT
+
+
+pir_output_is( <<'CODE', <<'OUT', 'HLL_map on namespace', todo => 'TT #867');
+.HLL 'tcl'
+
+.sub 'foo' :anon :init
+ $P1 = get_class 'NameSpace'
+ $P2 = subclass $P1, 'BSNS'
+ $P0 = getinterp
+ $P0.'hll_map'($P1, $P2)
+.end
+
+.namespace ['a';'b';'c']
+
+.sub 'hi'
+ noop
+.end
+
+.namespace []
+
+.sub 'blah' :main
+ $P1 = get_hll_namespace ['a';'b';'c']
+ $S0 = typeof $P1
+ print 'ok 1 - '
+ say $S0
+.end
+CODE
+ok 1 - BSNS
+OUT
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Copied: branches/kill_parrot_cont/t/pmc/namespace.t (from r41020, trunk/t/pmc/namespace.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/kill_parrot_cont/t/pmc/namespace.t Sun Sep 6 00:20:10 2009 (r41024, copy of r41020, trunk/t/pmc/namespace.t)
@@ -0,0 +1,380 @@
+#! parrot
+# Copyright (C) 2006-2007, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+t/pmc/namepspace.t - test NameSpace PMC
+
+=head1 SYNOPSIS
+
+ % prove t/pmc/namespace.t
+
+=head1 DESCRIPTION
+
+Tests the NameSpace PMC.
+
+=cut
+
+.namespace []
+
+.sub main :main
+ .include 'test_more.pir'
+ plan(44)
+
+ create_namespace_pmc()
+ verify_namespace_type()
+ get_global_opcode()
+ get_sub_from_namespace_hash()
+ access_sub_in_namespace()
+ get_namespace_from_sub()
+ build_namespaces_at_runtime()
+ hll_namespaces()
+ namespace_methods()
+.end
+
+# L<PDD21/Namespace PMC API/=head4 Untyped Interface>
+.sub 'create_namespace_pmc'
+ push_eh eh1
+ $P0 = new ['NameSpace']
+ pop_eh
+ ok(1, "Create new Namespace PMC")
+ goto _end
+ eh1:
+ ok(0, "Could not create Namespace PMC")
+ _end:
+.end
+
+.sub 'verify_namespace_type'
+ $P0 = get_global "Foo"
+ typeof $S0, $P0
+ is($S0, "NameSpace", "A NameSpace is a NameSpace")
+
+ # root namespace
+ $P0 = get_root_namespace
+ typeof $S0, $P0
+ is($S0, "NameSpace", "Root NameSpace is a NameSpace")
+
+ # parrot namespace
+ $P1 = $P0["parrot"]
+ typeof $S0, $P1
+ is($S0, "NameSpace", "::parrot NameSpace is a NameSpace")
+
+ $P0 = get_namespace
+ typeof $S0, $P1
+ is($S0, "NameSpace", "Current NameSpace is a NameSpace")
+.end
+
+# L<PDD21//>
+.sub 'get_global_opcode'
+ push_eh eh1
+ $P0 = get_global "baz"
+ $S0 = $P0()
+ pop_eh
+ is($S0, "", "Can get_global a .sub")
+ goto test2
+ eh1:
+ ok(0, "Cannot get_global a .sub")
+
+ test2:
+ push_eh eh2
+ $P0 = get_global ["Foo"], "baz"
+ $S0 = $P0()
+ pop_eh
+ is($S0, "Foo", "Get Sub from NameSpace")
+ goto test3
+ eh2:
+ ok(0, "Cannot get Sub from NameSpace Foo")
+
+ test3:
+ push_eh eh3
+ $P0 = get_global ["Foo";"Bar"], "baz"
+ $S0 = $P0()
+ pop_eh
+ is($S0, "Foo::Bar", "Get Sub from nested NameSpace")
+ goto test4
+ eh3:
+ ok(0, "Cannot get Sub from NameSpace Foo::Bar")
+
+ test4:
+ push_eh eh4
+ $P0 = get_global ["Foo"], "SUB_THAT_DOES_NOT_EXIST"
+ $P0()
+ ok(0, "Found and invoked a non-existant sub")
+ goto test5
+ eh4:
+ # Should we check the exact error message here?
+ ok(1, "Cannot invoke a Sub that doesn't exist")
+
+ test5:
+ # this used to behave differently from the previous case.
+ push_eh eh5
+ $P0 = get_global ["Foo";"Bar"], "SUB_THAT_DOES_NOT_EXIST"
+ $P0()
+ ok(0, "Found and invoked a non-existant sub")
+ goto test6
+ eh5:
+ # Should we check the exact error message here?
+ ok(1, "Cannot invoke a Sub that doesn't exist")
+
+ test6:
+ push_eh eh6
+ $P0 = get_global [ iso-8859-1:"François" ], "baz"
+ $S0 = $P0()
+ is($S0, iso-8859-1:"François", "Found sub in ISO-8859 NameSpace")
+ goto test7
+ eh6:
+ ok(0, "Cannot find sub in ISO-8859 NameSpace")
+
+ test7:
+ push_eh eh7
+ $P0 = get_global [ "Foo";iso-8859-1:"François" ], "baz"
+ $S0 = $P0()
+ is($S0, iso-8859-1:"Foo::François", "Found sub in nested ISO-8859 NameSpace")
+ goto test8
+ eh7:
+ ok(0, "Cannot find sub in ISO-8859 NameSpace")
+
+ test8:
+# TODO: This should probably be possible. We should be able to look up a
+# string if it is iso-8895-1 and we are Unicode
+# push_eh eh8
+# $P0 = get_global [ unicode:"François" ], "baz"
+# $I0 = isnull $P0
+# is($I0, 0, "Find Sub in an ISO-8859-1 NameSpace looked up by a Unicode name")
+
+# $S0 = $P0()
+# say $S0
+# is($S0, iso-8859-1:"François", "ISO-8859 NameSpace with Unicode name")
+# goto _end
+# eh8:
+# ok(0, "Cannot find ISO-8859 NameSpace using Unicode name")
+
+ _end:
+.end
+
+.sub 'get_sub_from_namespace_hash'
+ #See that a NameSpace does Hash
+ $P0 = get_global "Foo"
+ $I0 = does $P0, 'hash'
+ ok($I0, "Namespace does hash")
+
+ # Use a hash key to get a Sub in a namespace
+ $P1 = $P0["baz"]
+ $S0 = $P1()
+ is($S0, "Foo", "Get the Sub from the NameSpace as a Hash")
+
+ # Use hash keys to get Subs and nested NameSpaces in NameSpaces
+ $P1 = $P0["Bar"]
+ $P2 = $P1["baz"]
+ $S0 = $P2()
+ is($S0, "Foo::Bar", "Get the Sub from the nested NameSpace as a Hash")
+
+ # Use nested keys to access nested NameSpaces
+ $P1 = $P0[ "Bar";"baz" ]
+ $S0 = $P1()
+ is($S0, "Foo::Bar", "Get Sub from nested NameSpace with multi-key")
+
+ # Alias a namespace and access it by Key
+ $P1 = $P0["Bar"]
+ set_global "TopBar", $P1
+ $P2 = get_global ["TopBar"], "baz"
+ is($S0, "Foo::Bar", "Alias namespace")
+
+ # Get nested NameSpace with ISO-8859 name
+ $P1 = $P0[ iso-8859-1:"François" ]
+ $P2 = $P1["baz"]
+ $S0 = $P2()
+ is($S0, iso-8859-1:"Foo::François", "Hash-get nested ISO-8859 NameSpace")
+
+ $P1 = $P0[ iso-8859-1:"François";"baz" ]
+ $S0 = $P1()
+ is($S0, iso-8859-1:"Foo::François", "Hash-get nested ISO-8859 NameSpace Sub")
+
+ $P0 = get_global iso-8859-1:"François"
+ $P1 = $P0[ "baz" ]
+ $S0 = $P1()
+ is($S0, iso-8859-1:"François", "Hash-get ISO-8859 NameSpace")
+.end
+
+.sub 'access_sub_in_namespace'
+ $S0 = baz()
+ $P0 = get_global "baz"
+ $S1 = $P0()
+ is($S0, $S1, "Direct and Indirect Sub calls")
+
+ push_eh eh
+ 'SUB_AINT_THERE'()
+ ok(0, "Directly called a sub that doesn't exist")
+ goto _end
+ eh:
+ ok(1, "Can't direct call a sub that doesn't exist")
+ _end:
+.end
+
+.sub 'get_namespace_from_sub'
+ # root namespace is "parrot"
+ $P0 = get_global "baz"
+ $P1 = $P0."get_namespace"()
+ $S0 = $P1
+ is($S0, "parrot", "Get the root namespace from a sub in the root namespace")
+
+ # Get an explicit namespace
+ $P0 = get_global ["Foo"], "baz"
+ $P1 = $P0."get_namespace"()
+ $S0 = $P1
+ is($S0, "Foo", "Get the namespace from a Sub in the NameSpace")
+
+ # Get namespace from the current sub
+ .include 'interpinfo.pasm'
+ $P0 = interpinfo .INTERPINFO_CURRENT_SUB
+ $P1 = $P0."get_namespace"()
+ $S0 = $P1
+ is($S0, "parrot", "Get namespace from current sub")
+
+ # Now get the current sub again
+ $P2 = $P1["get_namespace_from_sub"]
+ $S0 = typeof $P2
+ is($S0, "Sub", "Get the current sub from namespace from current sub")
+.end
+
+.sub 'build_namespaces_at_runtime'
+ $P0 = get_root_namespace
+ $P1 = $P0["parrot"]
+ $P3 = new ['NameSpace']
+ $P1["Temp1"] = $P3
+ $P2 = $P3.'get_name'()
+ $S0 = join '::', $P2
+ is($S0, "parrot::Temp1", "Add a NameSpace with a given name")
+.end
+
+.sub 'hll_namespaces'
+ # Fetch HLL Global using an RSA. Current HLL == parrot
+ $P4 = new ['FixedStringArray']
+ $P4 = 1
+ $P4[0] = 'Foo'
+ $P0 = get_hll_namespace $P4
+ $P2 = $P0.'get_name'()
+ $S0 = join '::', $P2
+ is($S0, "parrot::Foo", "get_hll_namespace_p")
+
+ # Get an HLL namespace using a key. Current HLL == parrot
+ $P2 = get_hll_namespace ["Foo"]
+ $P2 = $P2.'get_name'()
+ $S0 = join '::', $P2
+ is($S0, "parrot::Foo", "get_hll_namespace_kc")
+
+ # Get a sub from an HLL Namespace using a key. Current HLL == parrot
+ $P0 = get_hll_namespace ["Foo"]
+ $P1 = $P0["baz"]
+ $S0 = $P1()
+ is($S0, "Foo", "get a Sub from a HLL namespace")
+.end
+
+.sub 'namespace_methods'
+ $P0 = get_namespace
+
+ # make_namespace returns the existing namespace if it exists
+ $P1 = $P0.'make_namespace'("Foo")
+ $P2 = $P1["baz"]
+ $S0 = $P2()
+ is($S0, "Foo", "make_namespace does not overwrite existing NS")
+
+ # First we don't have it...
+ $P1 = $P0["NewNamespace1"]
+ $I0 = isnull $P1
+ is($I0, 1, "something that doesn't exist really doesn't")
+
+ # ...now we do!
+ $P1 = $P0.'make_namespace'("NewNamespace1")
+ $P2 = $P1["baz"]
+ $I0 = isnull $P2
+ is($I0, 1, "make_namespace also creates new namespaces")
+
+ $P1 = new ["NameSpace"]
+ $P0.'add_namespace'("NewNamespace2", $P1)
+ $P2 = $P0["NewNamespace2"]
+ is($P1, $P2, "add_namespace adds a new namespace")
+
+ # test add_sub
+
+ $P1 = new 'Integer'
+ $P1 = 25
+ $P0.'add_var'("My_Integer", $P1)
+ $P2 = $P0["My_Integer"]
+ is($P1, $P2, "add_var adds a variable to the namespace")
+
+ # We've already tested NameSpace."get_name" elsewhere in this file
+
+ $P1 = $P0.'find_namespace'("Foo")
+ $P2 = $P1["baz"]
+ $S0 = $P2()
+ is($S0, "Foo", "find_namespace finds a .namespace constant")
+
+ $P1 = $P0.'find_namespace'("NewNamespace1")
+ $S0 = typeof $P1
+ is($S0, "NameSpace", "find_namespace finds a namespace added at runtime")
+
+ $P1 = $P0.'find_sub'("baz")
+ $S0 = $P1()
+ is($S0, "", "find_sub finds a sub like it should")
+
+ $P1 = $P0.'find_sub'("NewNamespace1")
+ $I0 = isnull $P1
+ is($I0, 1, "find_sub won't find a non-sub")
+
+ $P1 = $P0.'find_sub'("DOESNT EXIST")
+ $I0 = isnull $P1
+ is($I0, 1, "find_sub won't find something that doesn't exist")
+
+ $P1 = $P0.'find_var'("My_Integer")
+ $I0 = $P1
+ is($I0, 25, "find_var finds a variable we've saved in a namespace")
+
+ $P1 = $P0.'find_var'("ALSO DOESNT EXIST")
+ $I0 = isnull $P1
+ is($I0, 1, "find_var won't find something that doesn't exist")
+
+ $P1 = $P0.'find_var'("baz")
+ $S0 = typeof $P1
+ is($S0, "Sub", "find_var also finds subs")
+ $S0 = $P1()
+ is($S0, "", "find_var finds the correct sub")
+
+ # Test del_namespace. Test that it deletes an existing namespace, and that
+ # it won't delete something that isn't a namespace
+
+ # Test del_sub. Test that it deletes an existing sub and that it
+ # won't delete something that isn't a sub
+
+ # Test del_var. It will delete any type of thing
+.end
+
+##### TEST NAMESPACES AND FUNCTIONS #####
+# These functions and namespaces are used for the tests above
+
+.namespace []
+
+.sub 'baz'
+ .return("")
+.end
+
+.namespace ["Foo"]
+.sub 'baz'
+ .return("Foo")
+.end
+
+.namespace ["Foo";"Bar"]
+.sub 'baz'
+ .return("Foo::Bar")
+.end
+
+.namespace [ iso-8859-1:"François" ]
+.sub 'baz'
+ .return(iso-8859-1:"François")
+.end
+
+.namespace [ "Foo"; iso-8859-1:"François" ]
+.sub 'baz'
+ .return(iso-8859-1:"Foo::François")
+.end
Modified: branches/kill_parrot_cont/t/pmc/packfiledirectory.t
==============================================================================
--- branches/kill_parrot_cont/t/pmc/packfiledirectory.t Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/pmc/packfiledirectory.t Sun Sep 6 00:20:10 2009 (r41024)
@@ -136,7 +136,7 @@
delete_seg:
delete pfdir[$S0]
dec $I0
- $I1 = elements pfdir
+ $I1 = elements pfdir
is($I0, $I1, "segment deleted")
done:
Modified: branches/kill_parrot_cont/t/pmc/packfilerawsegment.t
==============================================================================
--- branches/kill_parrot_cont/t/pmc/packfilerawsegment.t Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/pmc/packfilerawsegment.t Sun Sep 6 00:20:10 2009 (r41024)
@@ -22,11 +22,13 @@
# get_integer_keyed_int doesn't return all zeroes either.
.include 't/pmc/testlib/packfile_common.pir'
+.include 'packfile_segments.pasm'
.sub 'main' :main
.include 'test_more.pir'
- plan(2)
+ plan(5)
test_elements()
test_get_integer()
+ test_type()
.end
# PackfileRawSegment.elements
@@ -60,6 +62,38 @@
ok($I0, "PackfileRawSegment.get_integer_keyed_int returns some data")
.end
+# PackfileRawSegment.type
+.sub 'test_type'
+ .local pmc pf, pfdir, pfseg, hash, it
+ pf = _pbc()
+ pfdir = pf.'get_directory'()
+ hash = new ['Hash']
+ # annotations.pbc contains all available segments. -1 for directory and unknown.
+ # So, in hash we should have 5 elements.
+ it = iter pfdir
+ loop:
+ unless it goto done
+ $S0 = shift it
+ $P0 = pfdir[$S0]
+ $I0 = $P0.'type'()
+ hash[$I0] = 1
+ goto loop
+
+ done:
+ $I0 = elements hash
+ is($I0, 5, "Got all types of Packfile segments")
+
+ # Now create RawSegment and set type.
+ $P0 = new ['PackfileRawSegment']
+ $I0 = $P0.'type'()
+ is($I0, .PF_BYTEC_SEG, "Default type is PF_BYTEC_SEG")
+
+ $P0.'type'(.PF_DEBUG_SEG)
+ $I0 = $P0.'type'()
+ is($I0, .PF_DEBUG_SEG, "Type successfully changed")
+
+.end
+
# Local Variables:
# mode: cperl
Modified: branches/kill_parrot_cont/t/pmc/string.t
==============================================================================
--- branches/kill_parrot_cont/t/pmc/string.t Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/pmc/string.t Sun Sep 6 00:20:10 2009 (r41024)
@@ -20,7 +20,7 @@
.sub main :main
.include 'test_more.pir'
- plan(165)
+ plan(171)
set_or_get_strings()
setting_integers()
@@ -71,7 +71,7 @@
exception_to_int_2()
exception_to_int_3()
assign_null_string()
-
+ access_keyed()
# END_OF_TESTS
.end
@@ -1018,6 +1018,39 @@
is( $I0, 0, 'assign null string, TT #729' )
.end
+.sub access_keyed
+ .local pmc s
+ s = new ['String']
+ s = "BAR" # Second character is zero, not 'o'
+
+ # Get
+ $S0 = s[0]
+ is($S0, 'B', 'Get string by index')
+
+ $I0 = s[1]
+ $I1 = ord 'A'
+ is($I0, $I1, 'Get integer by index')
+
+ $P0 = s[2]
+ is($P0, 'R', 'Get PMC by index')
+
+ # Set
+ s = new ['String']
+
+ $S0 = 'f'
+ s[0] = $S0
+ is(s, 'f', 'Set string keyed')
+
+ $I0 = ord 'o'
+ s[1] = $I0
+ is(s, 'fo', 'Set integer keyed')
+
+ $P0 = new ['String']
+ $P0 = 'o'
+ s[2] = $P0
+ is(s, 'foo', 'Set PMC keyed')
+.end
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
Modified: branches/kill_parrot_cont/t/pmc/threads.t
==============================================================================
--- branches/kill_parrot_cont/t/pmc/threads.t Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/t/pmc/threads.t Sun Sep 6 00:20:10 2009 (r41024)
@@ -831,10 +831,10 @@
.local pmc the_value
the_value = new ['PerlInt']
the_value = 42
- store_global 'Foo', 'x', the_value
- $I0 = typeof passed_value
- $I1 = typeof the_value
- $I0 = $I0 - $I1
+ set_hll_global ['Foo'], 'x', the_value
+ $S0 = typeof passed_value
+ $S1 = typeof the_value
+ $I0 = iseq $S0, $S1
print $I0
print "\n"
.local pmc ns
@@ -848,7 +848,7 @@
okay:
print "ok (equal)\n"
- $I0 = fortytwo
+ $I0 = the_value
print $I0
print "\n"
.end
Modified: branches/kill_parrot_cont/tools/dev/mk_inno_language.pl
==============================================================================
--- branches/kill_parrot_cont/tools/dev/mk_inno_language.pl Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/tools/dev/mk_inno_language.pl Sun Sep 6 00:20:10 2009 (r41024)
@@ -69,7 +69,7 @@
my $ops = <src/ops/*.dll>
? qq{Source: ".\\src\\ops\\*.dll"; DestDir: "{app}\\lib\\parrot\\dynext"; Flags:}
: '; no ops';
-my $dynext = <dynext/*.dll>
+my $dynext = <dynext/*.dll> && !<src/pmc/*.dll> && !<src/ops/*.dll>
? qq{Source: ".\\dynext\\*.dll"; DestDir: "{app}\\lib\\parrot\\dynext"; Flags:}
: '; no dynext';
my $man = -d 'man'
Modified: branches/kill_parrot_cont/tools/dev/mk_language_shell.pl
==============================================================================
--- branches/kill_parrot_cont/tools/dev/mk_language_shell.pl Sun Sep 6 00:19:53 2009 (r41023)
+++ branches/kill_parrot_cont/tools/dev/mk_language_shell.pl Sun Sep 6 00:20:10 2009 (r41024)
@@ -297,8 +297,7 @@
VERSION_DIR := @versiondir@
INCLUDE_DIR := @includedir@$(VERSION_DIR)
LIB_DIR := @libdir@$(VERSION_DIR)
-#STAGING_DIR := ../../dynext
-STAGING_DIR := @build_dir@/runtime/parrot/dynext
+STAGING_DIR := ../../dynext
#INSTALL_DIR := $(LIB_DIR)/languages/@lclang@/dynext
INSTALL_DIR := $(LIB_DIR)/dynext
@@ -309,6 +308,7 @@
# Setup some commands
PERL := @perl@
RM_F := @rm_f@
+MKPATH := @mkpath@
CHMOD := @chmod@
CP := @cp@
CC := @cc@ -c
@@ -361,6 +361,7 @@
install:
#IF(cygwin or hpux): CHMOD 0775 "*$(LOAD_EXT)"
+ $(MKPATH) $(INSTALL_DIR)
$(CP) "*$(LOAD_EXT)" $(INSTALL_DIR)
uninstall:
@@ -389,8 +390,7 @@
LIB_DIR := @libdir@$(VERSION_DIR)
SRC_DIR := @srcdir@$(VERSION_DIR)
TOOLS_DIR := @libdir@$(VERSION_DIR)/tools/lib
-#STAGING_DIR := ../../dynext
-STAGING_DIR := @build_dir@/runtime/parrot/dynext
+STAGING_DIR := ../../dynext
#INSTALL_DIR := $(LIB_DIR)/languages/@lclang@/dynext
INSTALL_DIR := $(LIB_DIR)/dynext
@@ -401,6 +401,7 @@
# Setup some commands
PERL := @perl@
RM_F := @rm_f@
+MKPATH := @mkpath@
CHMOD := @chmod@
CP := @cp@
CC := @cc@ -c
@@ -463,6 +464,7 @@
install:
#IF(cygwin or hpux): CHMOD 0775 "*$(LOAD_EXT)"
+ $(MKPATH) $(INSTALL_DIR)
$(CP) "*$(LOAD_EXT)" $(INSTALL_DIR)
uninstall:
More information about the parrot-commits
mailing list