[svn:parrot] r41143 - in branches/gc-refactor: . compilers/data_json compilers/data_json/data_json compilers/imcc compilers/nqp/src config/auto config/auto/sizes config/gen config/gen/makefiles config/gen/platform config/gen/platform/darwin config/gen/platform/generic config/gen/platform/win32 config/init config/init/hints config/inter docs/book/draft docs/book/pct docs/dev docs/pdds docs/project examples/embed examples/json examples/languages/abc examples/languages/squaak examples/pge ext/SQLite3 include/parrot lib/Parrot lib/Parrot/Pmc2c ports/cpan ports/cygwin ports/debian ports/fedora ports/mandriva ports/suse runtime/parrot/include runtime/parrot/languages runtime/parrot/library/Math runtime/parrot/library/Test src src/call src/gc src/interp src/ops src/pmc src/runcore src/string t/compilers/tge t/library t/oo t/pmc t/run t/src tools/dev tools/util
jrtayloriv at svn.parrot.org
jrtayloriv at svn.parrot.org
Mon Sep 7 23:56:41 UTC 2009
Author: jrtayloriv
Date: Mon Sep 7 23:56:34 2009
New Revision: 41143
URL: https://trac.parrot.org/parrot/changeset/41143
Log:
Merged changes from r41010 to r41116
Added:
branches/gc-refactor/compilers/data_json/ (props changed)
- copied from r41142, trunk/compilers/data_json/
branches/gc-refactor/config/gen/makefiles/data_json.in
- copied unchanged from r41142, trunk/config/gen/makefiles/data_json.in
branches/gc-refactor/config/gen/platform/darwin/hires_timer.c
- copied unchanged from r41142, trunk/config/gen/platform/darwin/hires_timer.c
branches/gc-refactor/config/gen/platform/generic/hires_timer.c
- copied unchanged from r41142, trunk/config/gen/platform/generic/hires_timer.c
branches/gc-refactor/config/gen/platform/win32/hires_timer.c
- copied unchanged from r41142, trunk/config/gen/platform/win32/hires_timer.c
branches/gc-refactor/tools/dev/pprof2cg.pl
- copied unchanged from r41142, trunk/tools/dev/pprof2cg.pl
Replaced:
branches/gc-refactor/compilers/data_json/data_json/ (props changed)
- copied from r41142, trunk/compilers/data_json/data_json/
branches/gc-refactor/compilers/data_json/data_json.pir
- copied unchanged from r41142, trunk/compilers/data_json/data_json.pir
branches/gc-refactor/compilers/data_json/data_json/grammar.pg
- copied unchanged from r41142, trunk/compilers/data_json/data_json/grammar.pg
branches/gc-refactor/compilers/data_json/data_json/pge2pir.tg
- copied unchanged from r41142, trunk/compilers/data_json/data_json/pge2pir.tg
Deleted:
branches/gc-refactor/include/parrot/register.h
branches/gc-refactor/src/gc/alloc_register.c
branches/gc-refactor/t/pmc/integer-old.t
Modified:
branches/gc-refactor/ (props changed)
branches/gc-refactor/CREDITS
branches/gc-refactor/MANIFEST
branches/gc-refactor/MANIFEST.SKIP
branches/gc-refactor/MANIFEST.generated
branches/gc-refactor/NEWS
branches/gc-refactor/compilers/imcc/main.c
branches/gc-refactor/compilers/nqp/src/builtins.pir
branches/gc-refactor/config/auto/crypto.pm
branches/gc-refactor/config/auto/gdbm.pm
branches/gc-refactor/config/auto/gmp.pm
branches/gc-refactor/config/auto/readline.pm
branches/gc-refactor/config/auto/sizes/intval_maxmin_c.in (props changed)
branches/gc-refactor/config/gen/makefiles.pm
branches/gc-refactor/config/gen/makefiles/root.in
branches/gc-refactor/config/gen/platform.pm
branches/gc-refactor/config/gen/platform/platform_interface.h
branches/gc-refactor/config/init/defaults.pm
branches/gc-refactor/config/init/hints/cygwin.pm
branches/gc-refactor/config/init/hints/linux.pm
branches/gc-refactor/config/init/hints/mswin32.pm
branches/gc-refactor/config/init/hints/openbsd.pm
branches/gc-refactor/config/init/hints/solaris.pm
branches/gc-refactor/config/inter/libparrot.pm
branches/gc-refactor/docs/book/draft/README (props changed)
branches/gc-refactor/docs/book/draft/appa_glossary.pod (props changed)
branches/gc-refactor/docs/book/draft/appb_patch_submission.pod (props changed)
branches/gc-refactor/docs/book/draft/appc_command_line_options.pod (props changed)
branches/gc-refactor/docs/book/draft/appd_build_options.pod (props changed)
branches/gc-refactor/docs/book/draft/appe_source_code.pod (props changed)
branches/gc-refactor/docs/book/draft/ch01_introduction.pod (props changed)
branches/gc-refactor/docs/book/draft/ch02_getting_started.pod (props changed)
branches/gc-refactor/docs/book/draft/ch07_dynpmcs.pod (props changed)
branches/gc-refactor/docs/book/draft/ch08_dynops.pod (props changed)
branches/gc-refactor/docs/book/draft/ch10_opcode_reference.pod (props changed)
branches/gc-refactor/docs/book/draft/ch11_directive_reference.pod (props changed)
branches/gc-refactor/docs/book/draft/ch12_operator_reference.pod (props changed)
branches/gc-refactor/docs/book/draft/chXX_hlls.pod (props changed)
branches/gc-refactor/docs/book/draft/chXX_library.pod (props changed)
branches/gc-refactor/docs/book/draft/chXX_testing_and_debugging.pod (props changed)
branches/gc-refactor/docs/book/pct/ch01_introduction.pod (props changed)
branches/gc-refactor/docs/book/pct/ch02_getting_started.pod (props changed)
branches/gc-refactor/docs/book/pct/ch03_compiler_tools.pod (props changed)
branches/gc-refactor/docs/book/pct/ch04_pge.pod (props changed)
branches/gc-refactor/docs/book/pct/ch05_nqp.pod (props changed)
branches/gc-refactor/docs/dev/c_functions.pod (props changed)
branches/gc-refactor/docs/pdds/pdd30_install.pod (props changed)
branches/gc-refactor/docs/project/branching_guide.pod
branches/gc-refactor/examples/embed/cotorra.c (props changed)
branches/gc-refactor/examples/json/postalcodes.pir
branches/gc-refactor/examples/json/test.pir
branches/gc-refactor/examples/languages/abc/ (props changed)
branches/gc-refactor/examples/languages/squaak/ (props changed)
branches/gc-refactor/examples/pge/demo.pir (props changed)
branches/gc-refactor/ext/SQLite3/SQLite3.pir
branches/gc-refactor/ext/SQLite3/gen_sqlite3.pl
branches/gc-refactor/ext/SQLite3/test.pir
branches/gc-refactor/include/parrot/call.h (contents, props changed)
branches/gc-refactor/include/parrot/charset.h
branches/gc-refactor/include/parrot/context.h
branches/gc-refactor/include/parrot/gc_api.h (contents, props changed)
branches/gc-refactor/include/parrot/interpreter.h
branches/gc-refactor/include/parrot/parrot.h
branches/gc-refactor/include/parrot/pic.h
branches/gc-refactor/include/parrot/pmc_freeze.h
branches/gc-refactor/include/parrot/runcore_api.h (contents, props changed)
branches/gc-refactor/include/parrot/runcore_trace.h (props changed)
branches/gc-refactor/include/parrot/sub.h
branches/gc-refactor/lib/Parrot/Pmc2c/PCCMETHOD.pm
branches/gc-refactor/lib/Parrot/Vtable.pm
branches/gc-refactor/ports/cpan/pause_guide.pod (props changed)
branches/gc-refactor/ports/cygwin/parrot-1.0.0-1.cygport (props changed)
branches/gc-refactor/ports/debian/libparrot-dev.install.in (props changed)
branches/gc-refactor/ports/debian/libparrot.install.in (props changed)
branches/gc-refactor/ports/debian/parrot-doc.install.in (props changed)
branches/gc-refactor/ports/debian/parrot.install.in (props changed)
branches/gc-refactor/ports/fedora/parrot.spec.fedora (props changed)
branches/gc-refactor/ports/mandriva/parrot.spec.mandriva (props changed)
branches/gc-refactor/ports/suse/parrot.spec.suse (props changed)
branches/gc-refactor/runtime/parrot/include/test_more.pir
branches/gc-refactor/runtime/parrot/languages/ (props changed)
branches/gc-refactor/runtime/parrot/library/Math/Rand.pir (props changed)
branches/gc-refactor/runtime/parrot/library/Test/More.pir
branches/gc-refactor/src/call/context.c
branches/gc-refactor/src/call/ops.c (contents, props changed)
branches/gc-refactor/src/call/pcc.c (contents, props changed)
branches/gc-refactor/src/debug.c
branches/gc-refactor/src/dynext.c
branches/gc-refactor/src/embed.c
branches/gc-refactor/src/exceptions.c
branches/gc-refactor/src/exec_start.c
branches/gc-refactor/src/gc/alloc_memory.c (props changed)
branches/gc-refactor/src/gc/alloc_resources.c (contents, props changed)
branches/gc-refactor/src/gc/api.c (contents, props changed)
branches/gc-refactor/src/gc/gc_malloc.c
branches/gc-refactor/src/gc/gc_ms.c
branches/gc-refactor/src/gc/gc_private.h
branches/gc-refactor/src/gc/generational_ms.c (props changed)
branches/gc-refactor/src/gc/incremental_ms.c (contents, props changed)
branches/gc-refactor/src/gc/malloc.c (props changed)
branches/gc-refactor/src/gc/malloc_trace.c (props changed)
branches/gc-refactor/src/gc/mark_sweep.c (contents, props changed)
branches/gc-refactor/src/gc/system.c (props changed)
branches/gc-refactor/src/hll.c
branches/gc-refactor/src/interp/inter_cb.c (props changed)
branches/gc-refactor/src/interp/inter_create.c (contents, props changed)
branches/gc-refactor/src/interp/inter_misc.c (contents, props changed)
branches/gc-refactor/src/ops/core.ops
branches/gc-refactor/src/ops/pic.ops
branches/gc-refactor/src/packfile.c
branches/gc-refactor/src/parrot_debugger.c
branches/gc-refactor/src/pic.c
branches/gc-refactor/src/pic_jit.c
branches/gc-refactor/src/pmc.c
branches/gc-refactor/src/pmc/context.pmc
branches/gc-refactor/src/pmc/continuation.pmc
branches/gc-refactor/src/pmc/coroutine.pmc
branches/gc-refactor/src/pmc/env.pmc
branches/gc-refactor/src/pmc/eventhandler.pmc
branches/gc-refactor/src/pmc/exception.pmc
branches/gc-refactor/src/pmc/exceptionhandler.pmc
branches/gc-refactor/src/pmc/fixedpmcarray.pmc
branches/gc-refactor/src/pmc/integer.pmc
branches/gc-refactor/src/pmc/parrotinterpreter.pmc
branches/gc-refactor/src/pmc/parrotrunningthread.pmc
branches/gc-refactor/src/pmc/retcontinuation.pmc
branches/gc-refactor/src/pmc/sub.pmc
branches/gc-refactor/src/pmc/task.pmc
branches/gc-refactor/src/pmc/timer.pmc
branches/gc-refactor/src/pmc_freeze.c
branches/gc-refactor/src/runcore/cores.c (contents, props changed)
branches/gc-refactor/src/runcore/main.c (contents, props changed)
branches/gc-refactor/src/runcore/trace.c (props changed)
branches/gc-refactor/src/string/api.c
branches/gc-refactor/src/sub.c
branches/gc-refactor/t/compilers/tge/NoneGrammar.tg (props changed)
branches/gc-refactor/t/library/test_more.t
branches/gc-refactor/t/oo/root_new.t (props changed)
branches/gc-refactor/t/pmc/fixedpmcarray.t
branches/gc-refactor/t/pmc/float.t
branches/gc-refactor/t/pmc/integer.t
branches/gc-refactor/t/pmc/namespace-old.t (contents, props changed)
branches/gc-refactor/t/pmc/namespace.t
branches/gc-refactor/t/run/options.t
branches/gc-refactor/t/src/embed.t (props changed)
branches/gc-refactor/tools/dev/fetch_languages.pl (props changed)
branches/gc-refactor/tools/dev/install_dev_files.pl
branches/gc-refactor/tools/dev/mk_gitignore.pl (props changed)
branches/gc-refactor/tools/util/perlcritic-cage.conf (props changed)
Modified: branches/gc-refactor/CREDITS
==============================================================================
--- branches/gc-refactor/CREDITS Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/CREDITS Mon Sep 7 23:56:34 2009 (r41143)
@@ -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/gc-refactor/MANIFEST
==============================================================================
--- branches/gc-refactor/MANIFEST Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/MANIFEST Mon Sep 7 23:56:34 2009 (r41143)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Sun Aug 30 20:35:30 2009 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon Sep 7 21:02:37 2009 UT
#
# See below for documentation on the format of this file.
#
@@ -28,6 +28,9 @@
RESPONSIBLE_PARTIES [main]doc
TODO []
VERSION [devel]
+compilers/data_json/data_json.pir [data_json]
+compilers/data_json/data_json/grammar.pg [data_json]
+compilers/data_json/data_json/pge2pir.tg [data_json]
compilers/imcc/cfg.c [imcc]
compilers/imcc/cfg.h [imcc]
compilers/imcc/debug.c [imcc]
@@ -310,6 +313,7 @@
config/gen/crypto/digest_t.in []
config/gen/makefiles.pm []
config/gen/makefiles/CFLAGS.in []
+config/gen/makefiles/data_json.in []
config/gen/makefiles/docs.in []
config/gen/makefiles/dynoplibs.in []
config/gen/makefiles/dynoplibs_pl.in []
@@ -336,11 +340,13 @@
config/gen/platform/ansi/time.c []
config/gen/platform/cygwin/math.c []
config/gen/platform/darwin/begin.c []
+config/gen/platform/darwin/hires_timer.c []
config/gen/platform/darwin/memalign.c []
config/gen/platform/generic/dl.c []
config/gen/platform/generic/dl.h []
config/gen/platform/generic/env.c []
config/gen/platform/generic/exec.c []
+config/gen/platform/generic/hires_timer.c []
config/gen/platform/generic/io.h []
config/gen/platform/generic/itimer.c []
config/gen/platform/generic/math.c []
@@ -368,6 +374,7 @@
config/gen/platform/win32/dl.c []
config/gen/platform/win32/env.c []
config/gen/platform/win32/exec.c []
+config/gen/platform/win32/hires_timer.c []
config/gen/platform/win32/io.h []
config/gen/platform/win32/misc.c []
config/gen/platform/win32/misc.h []
@@ -993,7 +1000,6 @@
include/parrot/pmc.h [main]include
include/parrot/pmc_freeze.h [main]include
include/parrot/pobj.h [main]include
-include/parrot/register.h [main]include
include/parrot/runcore_api.h [main]include
include/parrot/runcore_trace.h [main]include
include/parrot/scheduler.h [main]include
@@ -1272,7 +1278,6 @@
src/exit.c []
src/extend.c []
src/gc/alloc_memory.c []
-src/gc/alloc_register.c []
src/gc/alloc_resources.c []
src/gc/api.c []
src/gc/gc_inf.c []
@@ -1873,7 +1878,6 @@
t/pmc/hash.t [test]
t/pmc/hashiterator.t [test]
t/pmc/hashiteratorkey.t [test]
-t/pmc/integer-old.t [test]
t/pmc/integer.t [test]
t/pmc/io.t [test]
t/pmc/io_iterator.t [test]
@@ -1885,8 +1889,8 @@
t/pmc/managedstruct.t [test]
t/pmc/multidispatch.t [test]
t/pmc/multisub.t [test]
-t/pmc/namespace.t [test]
t/pmc/namespace-old.t [test]
+t/pmc/namespace.t [test]
t/pmc/nci.t [test]
t/pmc/null.t [test]
t/pmc/object-meths.t [test]
@@ -2161,6 +2165,7 @@
tools/dev/pbc_to_exe.pir [devel]
tools/dev/pmcrenumber.pl []
tools/dev/pmctree.pl []
+tools/dev/pprof2cg.pl []
tools/dev/reconfigure.pl [devel]
tools/dev/search-ops.pl []
tools/dev/svnclobber.pl []
Modified: branches/gc-refactor/MANIFEST.SKIP
==============================================================================
--- branches/gc-refactor/MANIFEST.SKIP Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/MANIFEST.SKIP Mon Sep 7 23:56:34 2009 (r41143)
@@ -1,6 +1,6 @@
# ex: set ro:
# $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Tue Jul 21 23:09:08 2009 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon Sep 7 21:02:37 2009 UT
#
# This file should contain a transcript of the svn:ignore properties
# of the directories in the Parrot subversion repository. (Needed for
@@ -143,6 +143,16 @@
^vc70\.pdb/
^vtable\.dump$
^vtable\.dump/
+# generated from svn:ignore of 'compilers/data_json/'
+^compilers/data_json/Makefile$
+^compilers/data_json/Makefile/
+^compilers/data_json/data_json\.pbc$
+^compilers/data_json/data_json\.pbc/
+# generated from svn:ignore of 'compilers/data_json/data_json/'
+^compilers/data_json/data_json/.*\.pbc$
+^compilers/data_json/data_json/.*\.pbc/
+^compilers/data_json/data_json/.*\.pir$
+^compilers/data_json/data_json/.*\.pir/
# generated from svn:ignore of 'compilers/imcc/'
^compilers/imcc/.*\.flag$
^compilers/imcc/.*\.flag/
Modified: branches/gc-refactor/MANIFEST.generated
==============================================================================
--- branches/gc-refactor/MANIFEST.generated Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/MANIFEST.generated Mon Sep 7 23:56:34 2009 (r41143)
@@ -7,8 +7,9 @@
blib/lib/libparrot.dylib [main]lib
blib/lib/libparrot.so.1.5.0 [main]lib
blib/lib/libparrot.so [main]lib
-compilers/json/JSON/grammar.pbc [json]
+compilers/data_json/data_json.pbc [data_json]
compilers/json/JSON.pbc [json]
+compilers/json/JSON/grammar.pbc [json]
compilers/json/JSON/pge2pir.pbc [json]
compilers/nqp/nqp.pbc [nqp]
config/gen/call_list/opengl.in []
Modified: branches/gc-refactor/NEWS
==============================================================================
--- branches/gc-refactor/NEWS Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/NEWS Mon Sep 7 23:56:34 2009 (r41143)
@@ -1,5 +1,31 @@
# $Id$
+New in 1.6.0
+- Core
+ + Profiling runcore can now be used to generate Callgrind-compatible output
+ + PMC allocator now automatically allocates ATTR structures
+ + Added fixed-size structure allocator to GC
+ + Contexts are now garbage-collectable
+ + Created a new Context API
+ + Op definitions cache the current Context for subsequent lookups
+ + Unified Continuation PMC and Parrot_cont structure
+ + Unified Sub PMC and Parrot_sub structure
+ + Began proper encapsulation of STRING API
+ + Modify PMC structure to remove UnionVal
+ + Removed PMC_EXT structure
+ + Removed PMC_Sync from PMC
+ + Added a "Lazy" mode to the PObj and Fixed-Size allocators
+ + Reduce string comparisons in VTABLE_isa
+ + Unified all PMC destruction functions
+ + Added several fixes for stack-walking GC code
+ + Copying a NULL string now returns an empty STRING structure
+ + Add find_dynamic_lex and store_dynamic_lex opcodes
+- Tests
+ + Convert several Perl5 tests to PIR
+ + Expand test coverage of NameSpace PMC
+- Compilers
+ + PCT is now included in "make install"
+
New in 1.5.0
- Core
+ Removed several deprecated functions and features
Copied: branches/gc-refactor/compilers/data_json/data_json.pir (from r41142, trunk/compilers/data_json/data_json.pir)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gc-refactor/compilers/data_json/data_json.pir Mon Sep 7 23:56:34 2009 (r41143, copy of r41142, trunk/compilers/data_json/data_json.pir)
@@ -0,0 +1,93 @@
+# Copyright (C) 2005-2008, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+data_json - parse JSON, a lightweight data-interchange format.
+
+=head1 SYNOPSIS
+
+Given a valid JSON (JavaScript Object Notation) string, the compiler will
+return a sub that when called will produce the appropriate values. For
+example:
+
+ .local pmc json, code, result
+ json = compreg 'data_json'
+ code = json.'compile'('[1,2,3]')
+ result = code()
+
+will create a PMC that C<does> C<array> containing the values 1, 2, and 3,
+and store it in the C<result>.
+
+For more information about the structure of the JSON representation, see
+the documentation at L<http://www.json.org/>.
+
+=cut
+
+.HLL 'data_json'
+
+.sub '__onload' :load
+ load_bytecode 'PGE.pbc'
+ load_bytecode 'PGE/Util.pbc'
+ load_bytecode 'TGE.pbc'
+
+ $P1 = newclass ['JSON'; 'Compiler']
+ $P2 = new $P1
+ compreg 'data_json', $P2
+
+ $P1 = new 'Hash'
+ $P1['\"'] = '"'
+ $P1['\\'] = "\\"
+ $P1['\/'] = '/'
+ $P1['\b'] = "\b"
+ $P1['\f'] = "\f"
+ $P1['\n'] = "\n"
+ $P1['\r'] = "\r"
+ $P1['\t'] = "\t"
+
+ set_hll_global '$escapes', $P1
+.end
+
+
+.namespace ['JSON';'Compiler']
+
+.sub 'compile' :method
+ .param string json_string
+
+ .local pmc parse, match
+ parse = get_root_global ['parrot'; 'JSON'], 'value'
+
+ $P0 = get_root_global ['parrot'; 'PGE'], 'Match'
+ match = $P0.'new'(json_string)
+ match.'to'(0)
+ match = parse(match)
+ unless match goto failed
+
+ .local pmc pirgrammar, pirbuilder, pir
+ pirgrammar = new ['JSON'; 'PIR']
+ pirbuilder = pirgrammar.'apply'(match)
+ pir = pirbuilder.'get'('result')
+
+ .local pmc pirc, result
+ pirc = compreg 'PIR'
+ result = pirc(pir)
+ .return (result)
+
+ failed:
+ $P0 = new 'Exception'
+ $P0[0] = "Invalid JSON value"
+ throw $P0
+.end
+
+
+.HLL 'parrot'
+
+.include 'compilers/data_json/data_json/grammar.pir'
+.include 'compilers/data_json/data_json/pge2pir.pir'
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Copied: branches/gc-refactor/compilers/data_json/data_json/grammar.pg (from r41142, trunk/compilers/data_json/data_json/grammar.pg)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gc-refactor/compilers/data_json/data_json/grammar.pg Mon Sep 7 23:56:34 2009 (r41143, copy of r41142, trunk/compilers/data_json/data_json/grammar.pg)
@@ -0,0 +1,38 @@
+# From http://www.json.org/
+
+grammar JSON;
+
+rule object { '{' <members>? '}' }
+rule array { '[' ']' | '[' <elements> ']' }
+rule string { \"<char>*\" }
+
+rule members { <string> ':' <value> [',' <string> ':' <value> ]* }
+
+rule elements { <value> [',' <value> ]* }
+
+token value {
+ | <object>
+ | <array>
+ | <string>
+ | <number>
+ | true
+ | false
+ | null
+ | <?PGE::Util::die 'not a valid JSON value'>
+}
+
+# XXX need to add "except control char" to the final charclass here.
+token char {
+ | \\<["\\/bfnrt]>
+ | \\u<xdigit>**{4}
+ | <-[\\"]>
+}
+
+token number {
+ <.ws>
+ '-'?
+ [ <[1..9]> <[0..9]>+ | <[0..9]> ]
+ [ '.' <[0..9]>+ ]?
+ [ <[Ee]> <[+\-]>? <[0..9]>+ ]?
+ <.ws>
+}
Copied: branches/gc-refactor/compilers/data_json/data_json/pge2pir.tg (from r41142, trunk/compilers/data_json/data_json/pge2pir.tg)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gc-refactor/compilers/data_json/data_json/pge2pir.tg Mon Sep 7 23:56:34 2009 (r41143, copy of r41142, trunk/compilers/data_json/data_json/pge2pir.tg)
@@ -0,0 +1,210 @@
+grammar JSON::PIR is TGE::Grammar;
+
+transform result (ROOT) {
+ .local pmc pir
+ .local string result
+
+ $S0 = tree.'get'('pir', node, 'value')
+
+ pir = new 'CodeString'
+ pir.'emit'('.sub anon :anon')
+ pir.'emit'($S0)
+ result = node['ret']
+ pir.'emit'(' .return (%0)',result)
+ pir.'emit'('.end')
+
+ .return(pir)
+}
+
+transform pir (value) {
+
+ .local pmc sub_node, transform_result
+ .local pmc pir, result
+ .local string value, type
+
+ type = 'string'
+ sub_node = node[type]
+ unless null sub_node goto got_type
+
+ type = 'number'
+ sub_node = node[type]
+ unless null sub_node goto got_type
+
+ type = 'object'
+ sub_node = node[type]
+ unless null sub_node goto got_type
+
+ type = 'array'
+ sub_node = node[type]
+ unless null sub_node goto got_type
+
+ value = node
+ if value == 'true' goto got_true
+ if value == 'false' goto got_false
+ if value == 'null' goto got_null
+
+ .return ('') # should never reach this.
+
+ got_type:
+ pir = tree.'get'('pir', sub_node, type)
+ $S0 = sub_node['ret']
+ node['ret'] = $S0
+ .return (pir)
+
+ got_true:
+ pir = new 'CodeString'
+ result = pir.'unique'('$P')
+ $S0 = node
+ pir.'emit'(" %0 = new 'Boolean'", result)
+ pir.'emit'(' %0 = 1', result, $S0)
+ node['ret'] = result
+ .return(pir)
+
+ got_false:
+ pir = new 'CodeString'
+ result = pir.'unique'('$P')
+ $S0 = node
+ pir.'emit'(" %0 = new 'Boolean'", result)
+ pir.'emit'(' %0 = 0', result, $S0)
+ node['ret'] = result
+ .return(pir)
+
+ got_null:
+ pir = new 'CodeString'
+ result = pir.'unique'('$P')
+ $S0 = node
+ pir.'emit'(' null %0', result)
+ node['ret'] = result
+ .return(pir)
+}
+
+transform pir (object) {
+ .local pmc pir
+ pir = new 'CodeString'
+ .local string result, child_result, key_result
+ result = pir.'unique'('$P')
+ pir.'emit'(" %0 = new 'Hash'", result)
+
+ .local pmc items
+
+ items = node['members']
+ if null items goto end
+
+ items = items[0]
+
+ .local pmc keys
+ keys = items['string']
+ items = items['value']
+
+ .local pmc it, key_iter, child, key
+ key_iter = iter keys
+ it = iter items
+
+ # the two iters should be in lockstep as a result of the PGE grammar
+loop:
+ unless it goto end
+ child = shift it
+ $P0 = tree.'get'('pir', child, 'value')
+ $S0 = $P0
+ pir .= $S0
+ child_result = child['ret']
+
+ key = shift key_iter
+ $P0 = tree.'get'('pir', key, 'string')
+ $S0 = $P0
+ pir .= $S0
+ key_result = key['ret']
+
+ pir.'emit'(' %0[%1] = %2', result, key_result, child_result)
+
+
+ goto loop
+end:
+ node['ret'] = result
+
+ .return (pir)
+}
+
+transform pir (array) {
+ .local pmc pir
+ pir = new 'CodeString'
+ .local string result, child_result
+ result = pir.'unique'('$P')
+ pir.'emit'(" %0 = new 'ResizablePMCArray'", result)
+
+ .local pmc items
+
+
+ items = node['elements']
+ if null items goto end
+
+ items = items['value']
+
+ .local pmc it, child
+ it = iter items
+loop:
+ unless it goto end
+ child = shift it
+ $P0 = tree.'get'('pir', child, 'value')
+ $S0 = $P0
+ pir .= $S0
+
+ child_result = child['ret']
+ pir.'emit'(' push %0, %1', result, child_result)
+ goto loop
+end:
+ node['ret'] = result
+
+ .return (pir)
+}
+
+transform pir (string) {
+ .local pmc pir, result, children, it, child
+ .local string tmp
+ tmp = ''
+ pir = new 'CodeString'
+ children = node['char']
+ if null children goto loop_end
+ it = iter children
+ loop:
+ push_eh loop_end
+ child = shift it
+ pop_eh
+ unless child goto loop_end
+ $S0 = child
+ $I0 = length $S0
+ if $I0 == 1 goto char
+ if $I0 == 2 goto escape
+ unicode:
+ $P1 = new 'String'
+ $S1 = substr $S0, 2, 4
+ $P1 = $S1
+ $I0 = $P1.'to_int'(16)
+ $S0 = chr $I0
+ goto char
+ escape:
+ $P0 = get_root_global [ 'JSON' ], '$escapes'
+ $S0 = $P0[$S0]
+ char:
+ tmp .= $S0
+ goto loop
+ loop_end:
+
+ result = pir.'unique'('$P')
+ $S1 = pir.'escape'(tmp)
+ pir.'emit'(" %0 = new 'String'", result)
+ pir.'emit'(' %0 = %1', result, $S1)
+ node['ret'] = result
+ .return(pir)
+}
+
+transform pir (number) {
+ .local pmc pir, result
+ pir = new 'CodeString'
+ result = pir.'unique'('$P')
+ $S0 = node
+ pir.'emit'(" %0 = new 'Integer'", result)
+ pir.'emit'(' %0 = %1', result, $S0)
+ node['ret'] = result
+ .return(pir)
+}
Modified: branches/gc-refactor/compilers/imcc/main.c
==============================================================================
--- branches/gc-refactor/compilers/imcc/main.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/compilers/imcc/main.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -33,6 +33,7 @@
#include "parrot/embed.h"
#include "parrot/longopt.h"
#include "parrot/imcc.h"
+#include "parrot/runcore_api.h"
#include "pbc.h"
#include "parser.h"
@@ -147,7 +148,7 @@
ASSERT_ARGS(usage)
fprintf(fp,
"parrot -[acEGhprtvVwy.] [-d [FLAGS]] [-D [FLAGS]]"
- "[-O [level]] [-o FILE] <file>\n");
+ "[-O [level]] [-R runcore] [-o FILE] <file>\n");
}
/*
@@ -220,8 +221,7 @@
" -X --dynext add path to dynamic extension search\n"
" <Run core options>\n"
" -R --runcore slow|bounds|fast|jit|cgoto|cgp|cgp-jit\n"
- " -R --runcore switch|switch-jit|trace|exec|gcdebug\n"
- " -p --profile\n"
+ " -R --runcore switch|switch-jit|trace|profiling|gcdebug\n"
" -t --trace [flags]\n"
" <VM options>\n"
" -D --parrot-debug[=HEXFLAGS]\n"
@@ -279,7 +279,6 @@
#define SET_FLAG(flag) Parrot_set_flag(interp, (flag))
#define SET_DEBUG(flag) Parrot_set_debug(interp, (flag))
#define SET_TRACE(flag) Parrot_set_trace(interp, (flag))
-#define SET_CORE(core) interp->run_core |= (core)
#define OPT_GC_DEBUG 128
#define OPT_DESTROY_FLAG 129
@@ -308,7 +307,6 @@
{ 'h', 'h', (OPTION_flags)0, { "--help" } },
{ 'o', 'o', OPTION_required_FLAG, { "--output" } },
{ '\0', OPT_PBC_OUTPUT, (OPTION_flags)0, { "--output-pbc" } },
- { 'p', 'p', (OPTION_flags)0, { "--profile" } },
{ 'r', 'r', (OPTION_flags)0, { "--run-pbc" } },
{ '\0', OPT_RUNTIME_PREFIX, (OPTION_flags)0, { "--runtime-prefix" } },
{ 't', 't', OPTION_optional_FLAG, { "--trace" } },
@@ -356,8 +354,10 @@
const char *
parseflags(PARROT_INTERP, int *argc, char **argv[])
{
- struct longopt_opt_info opt = LONGOPT_OPT_INFO_INIT;
- int status;
+ struct longopt_opt_info opt = LONGOPT_OPT_INFO_INIT;
+ INTVAL core = 0;
+ int status;
+
if (*argc == 1) {
usage(stderr);
exit(EXIT_SUCCESS);
@@ -370,42 +370,34 @@
switch (opt.opt_id) {
case 'R':
if (STREQ(opt.opt_arg, "slow") || STREQ(opt.opt_arg, "bounds"))
- SET_CORE(PARROT_SLOW_CORE);
+ core |= PARROT_SLOW_CORE;
else if (STREQ(opt.opt_arg, "fast") || STREQ(opt.opt_arg, "function"))
- SET_CORE(PARROT_FAST_CORE);
+ core |= PARROT_FAST_CORE;
else if (STREQ(opt.opt_arg, "switch"))
- SET_CORE(PARROT_SWITCH_CORE);
+ core |= PARROT_SWITCH_CORE;
else if (STREQ(opt.opt_arg, "cgp"))
- SET_CORE(PARROT_CGP_CORE);
+ core |= PARROT_CGP_CORE;
else if (STREQ(opt.opt_arg, "cgoto"))
- SET_CORE(PARROT_CGOTO_CORE);
+ core |= PARROT_CGOTO_CORE;
else if (STREQ(opt.opt_arg, "jit"))
- SET_CORE(PARROT_JIT_CORE);
+ core |= PARROT_JIT_CORE;
else if (STREQ(opt.opt_arg, "cgp-jit"))
- SET_CORE(PARROT_CGP_JIT_CORE);
+ core |= PARROT_CGP_JIT_CORE;
else if (STREQ(opt.opt_arg, "switch-jit"))
- SET_CORE(PARROT_SWITCH_JIT_CORE);
+ core |= PARROT_SWITCH_JIT_CORE;
else if (STREQ(opt.opt_arg, "exec"))
- SET_CORE(PARROT_EXEC_CORE);
- else if (STREQ(opt.opt_arg, "trace")) {
- SET_CORE(PARROT_SLOW_CORE);
-#ifdef HAVE_COMPUTED_GOTO
- SET_CORE(PARROT_CGP_CORE);
-#endif
-#if JIT_CAPABLE
- SET_CORE(PARROT_JIT_CORE);
-#endif
- }
+ core |= PARROT_EXEC_CORE;
+ else if (STREQ(opt.opt_arg, "trace"))
+ core |= PARROT_SLOW_CORE;
+ else if (STREQ(opt.opt_arg, "profiling"))
+ core = PARROT_PROFILING_CORE;
else if (STREQ(opt.opt_arg, "gcdebug"))
- SET_CORE(PARROT_GC_DEBUG_CORE);
+ core |= PARROT_GC_DEBUG_CORE;
else
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"main: Unrecognized runcore '%s' specified."
"\n\nhelp: parrot -h\n", opt.opt_arg);
break;
- case 'p':
- SET_FLAG(PARROT_PROFILE_FLAG);
- break;
case 't':
if (opt.opt_arg && is_all_hex_digits(opt.opt_arg))
SET_TRACE(strtoul(opt.opt_arg, NULL, 16));
@@ -498,7 +490,7 @@
IMCC_INFO(interp)->allocator = IMCC_GRAPH_ALLOCATOR;
/* currently not ok due to different register allocation */
if (strchr(opt.opt_arg, 'j')) {
- SET_CORE(PARROT_JIT_CORE);
+ core |= PARROT_JIT_CORE;
}
if (strchr(opt.opt_arg, '1')) {
IMCC_INFO(interp)->optimizer_level |= OPT_PRE;
@@ -507,12 +499,12 @@
IMCC_INFO(interp)->optimizer_level |= (OPT_PRE | OPT_CFG);
}
if (strchr(opt.opt_arg, 't')) {
- SET_CORE(PARROT_SWITCH_CORE);
+ core |= PARROT_SWITCH_CORE;
#ifdef HAVE_COMPUTED_GOTO
- SET_CORE(PARROT_CGP_CORE);
+ core |= PARROT_CGP_CORE;
#endif
#if JIT_CAPABLE
- SET_CORE(PARROT_JIT_CORE);
+ core |= PARROT_JIT_CORE;
#endif
}
break;
@@ -546,11 +538,13 @@
(*argv)[0]);
}
}
+
if (status == -1) {
fprintf(stderr, "%s\n", opt.opt_error);
usage(stderr);
exit(EX_USAGE);
}
+
/* reached the end of the option list and consumed all of argv */
if (*argc == opt.opt_index) {
if (interp->output_file) {
@@ -563,9 +557,11 @@
usage(stderr);
exit(EX_USAGE);
}
+
*argc -= opt.opt_index;
*argv += opt.opt_index;
+ Parrot_set_run_core(interp, (Parrot_Run_core_t) core);
return (*argv)[0];
}
@@ -719,10 +715,10 @@
if (opt_level & OPT_SUB)
opt_desc[i++] = 'c';
- if (interp->run_core & PARROT_JIT_CORE)
+ if (PARROT_RUNCORE_JIT_OPS_TEST(interp->run_core))
opt_desc[i++] = 'j';
- if (interp->run_core & PARROT_SWITCH_CORE)
+ if (PARROT_RUNCORE_PREDEREF_OPS_TEST(interp->run_core))
opt_desc[i++] = 't';
opt_desc[i] = '\0';
Modified: branches/gc-refactor/compilers/nqp/src/builtins.pir
==============================================================================
--- branches/gc-refactor/compilers/nqp/src/builtins.pir Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/compilers/nqp/src/builtins.pir Mon Sep 7 23:56:34 2009 (r41143)
@@ -140,8 +140,6 @@
lang = downcase lang
load_language lang
c = compreg lang
- print 'evaling in language: '
- say lang
code = c.'compile'(text)
$P0 = code()
.return ($P0)
Modified: branches/gc-refactor/config/auto/crypto.pm
==============================================================================
--- branches/gc-refactor/config/auto/crypto.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/auto/crypto.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -65,6 +65,7 @@
$has_crypto = $self->_evaluate_cc_run($conf, $test, $has_crypto, $verbose);
}
$conf->data->set( has_crypto => $has_crypto ); # for dynpmc.in & digest.t
+ $self->set_result($has_crypto ? 'yes' : 'no');
return 1;
}
Modified: branches/gc-refactor/config/auto/gdbm.pm
==============================================================================
--- branches/gc-refactor/config/auto/gdbm.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/auto/gdbm.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -70,6 +70,7 @@
$has_gdbm = $self->_evaluate_cc_run($test, $has_gdbm, $verbose);
}
$conf->data->set( has_gdbm => $has_gdbm ); # for gdbmhash.t and dynpmc.in
+ $self->set_result($has_gdbm ? 'yes' : 'no');
return 1;
}
Modified: branches/gc-refactor/config/auto/gmp.pm
==============================================================================
--- branches/gc-refactor/config/auto/gmp.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/auto/gmp.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -76,6 +76,7 @@
if ($has_gmp) {
$conf->data->add( ' ', libs => $extra_libs );
}
+ $self->set_result($has_gmp ? 'yes' : 'no');
return 1;
}
Modified: branches/gc-refactor/config/auto/readline.pm
==============================================================================
--- branches/gc-refactor/config/auto/readline.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/auto/readline.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -77,6 +77,7 @@
}
}
$conf->data->set( HAS_READLINE => $has_readline );
+ $self->set_result($has_readline ? 'yes' : 'no');
return 1;
}
Modified: branches/gc-refactor/config/gen/makefiles.pm
==============================================================================
--- branches/gc-refactor/config/gen/makefiles.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/gen/makefiles.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -48,6 +48,8 @@
{ SOURCE => 'config/gen/makefiles/tge.in' },
'compilers/json/Makefile' =>
{ SOURCE => 'config/gen/makefiles/json.in' },
+ 'compilers/data_json/Makefile' =>
+ { SOURCE => 'config/gen/makefiles/data_json.in' },
'compilers/pirc/Makefile' =>
{ SOURCE => 'config/gen/makefiles/pirc.in' },
'src/dynpmc/Makefile' =>
Copied: branches/gc-refactor/config/gen/makefiles/data_json.in (from r41142, trunk/config/gen/makefiles/data_json.in)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gc-refactor/config/gen/makefiles/data_json.in Mon Sep 7 23:56:34 2009 (r41143, copy of r41142, trunk/config/gen/makefiles/data_json.in)
@@ -0,0 +1,60 @@
+# Copyright (C) 2006-2009, Parrot Foundation.
+# $Id$
+
+PERL := @perl@
+RM_F := @rm_f@
+PARROT := ../../parrot at exe@
+
+TOOL_DIR := ../..
+PGE_DIR := ../../compilers/pge
+TGE_DIR := ../../compilers/tge
+
+# the default target
+all: data_json.pbc
+
+# This is a listing of all targets, that are meant to be called by users
+help:
+ @echo ""
+ @echo "Following targets are available for the user:"
+ @echo ""
+ @echo " all: data_json.pbc"
+ @echo " This is the default."
+ @echo "Testing:"
+ @echo " test: Run the test suite."
+ @echo " testclean: Clean up test results and temporary files."
+ @echo ""
+ @echo "Cleaning:"
+ @echo " clean: Basic cleaning up."
+ @echo ""
+ @echo "Misc:"
+ @echo " help: Print this help message."
+ @echo ""
+
+test: all
+ cd $(TOOL_DIR) && prove -r t/compilers/json
+
+testclean:
+ $(RM_F) "../../t/compilers/json/*.pir"
+
+data_json.pbc : data_json/grammar.pbc data_json/pge2pir.pbc data_json.pir
+ $(PARROT) --output=data_json.pbc data_json.pir
+
+data_json/grammar.pbc : data_json/grammar.pir
+ $(PARROT) --output=data_json/grammar.pbc data_json/grammar.pir
+
+data_json/grammar.pir : data_json/grammar.pg
+ $(PARROT) $(TOOL_DIR)/runtime/parrot/library/PGE/Perl6Grammar.pbc --output=data_json/grammar.pir data_json/grammar.pg
+
+data_json/pge2pir.pbc : data_json/pge2pir.pir
+ $(PARROT) --output=data_json/pge2pir.pbc data_json/pge2pir.pir
+
+data_json/pge2pir.pir : data_json/pge2pir.tg
+ $(PARROT) $(TGE_DIR)/tgc.pir --output=data_json/pge2pir.pir data_json/pge2pir.tg
+
+clean : testclean
+ $(RM_F) "data_json/*.pbc" "data_json/*.pir" data_json.pbc
+
+# Local variables:
+# mode: makefile
+# End:
+# vim: ft=make:
Modified: branches/gc-refactor/config/gen/makefiles/root.in
==============================================================================
--- branches/gc-refactor/config/gen/makefiles/root.in Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/gen/makefiles/root.in Mon Sep 7 23:56:34 2009 (r41143)
@@ -103,7 +103,7 @@
CC_INC := @cc_inc@
C_LIBS := @libs@
CC_SHARED := @cc_shared@
-CFLAGS := $(CC_INC) @ccflags@ @cc_debug@ @ccwarn@ @cc_hasjit@ @cg_flag@ @gc_flag@ $(CC_SHARED)
+CFLAGS := $(CC_INC) @ccflags@ @cc_debug@ @ccwarn@ @cc_hasjit@ @cg_flag@ @gc_flag@ @clock_best@ $(CC_SHARED)
LINK_DYNAMIC := @link_dynamic@
LINK := @link@
LINKFLAGS := @linkflags@ @link_debug@ @ld_debug@
@@ -147,6 +147,7 @@
GEN_MAKEFILES := \
Makefile \
docs/Makefile \
+ compilers/data_json/Makefile \
compilers/json/Makefile \
compilers/ncigen/Makefile \
compilers/nqp/Makefile \
@@ -424,7 +425,6 @@
$(SRC_DIR)/extend$(O) \
$(SRC_DIR)/extend_vtable$(O) \
$(SRC_DIR)/gc/alloc_memory$(O) \
- $(SRC_DIR)/gc/alloc_register$(O) \
$(SRC_DIR)/gc/api$(O) \
$(SRC_DIR)/gc/generational_ms$(O) \
$(SRC_DIR)/gc/incremental_ms$(O) \
@@ -635,6 +635,7 @@
$(SRC_DIR)/pmc.str \
$(SRC_DIR)/pmc_freeze.str \
$(SRC_DIR)/oo.str \
+ $(SRC_DIR)/runcore/cores.str \
$(SRC_DIR)/scheduler.str \
$(SRC_DIR)/spf_render.str \
$(SRC_DIR)/spf_vtable.str \
@@ -1150,6 +1151,9 @@
$(SRC_DIR)/call/pcc.str $(SRC_DIR)/pmc/pmc_fixedintegerarray.h \
$(SRC_DIR)/pmc/pmc_key.h $(SRC_DIR)/pmc/pmc_continuation.h
+$(SRC_DIR)/call/context$(O) : $(SRC_DIR)/call/context.c $(GENERAL_H_FILES) \
+ $(SRC_DIR)/pmc/pmc_sub.h
+
$(SRC_DIR)/interp/inter_cb$(O) : $(SRC_DIR)/interp/inter_cb.c \
$(GENERAL_H_FILES) $(SRC_DIR)/interp/inter_cb.str
@@ -1195,9 +1199,8 @@
$(SRC_DIR)/parrot$(O) : $(GENERAL_H_FILES)
-$(SRC_DIR)/gc/alloc_register$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/pmc/pmc_sub.h
-
-$(SRC_DIR)/runcore/cores$(O) : $(GENERAL_H_FILES)
+$(SRC_DIR)/runcore/cores$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/runcore/cores.str \
+ $(SRC_DIR)/pmc/pmc_sub.h
$(SRC_DIR)/tsq$(O) : $(GENERAL_H_FILES)
@@ -1411,6 +1414,7 @@
$(MAKE) compilers/tge
$(MAKE) compilers/nqp
$(MAKE) compilers/json
+ $(MAKE) compilers/data_json
compilers-clean :
$(MAKE) compilers/pct clean
@@ -1418,6 +1422,7 @@
$(MAKE) compilers/tge clean
$(MAKE) compilers/nqp clean
$(MAKE) compilers/json clean
+ $(MAKE) compilers/data_json clean
$(MAKE) compilers/pirc clean
###############################################################################
Modified: branches/gc-refactor/config/gen/platform.pm
==============================================================================
--- branches/gc-refactor/config/gen/platform.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/gen/platform.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -223,6 +223,7 @@
memexec.c
exec.c
misc.c
+ hires_timer.c
/;
my $plat_c = q{src/platform.c};
Copied: branches/gc-refactor/config/gen/platform/darwin/hires_timer.c (from r41142, trunk/config/gen/platform/darwin/hires_timer.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gc-refactor/config/gen/platform/darwin/hires_timer.c Mon Sep 7 23:56:34 2009 (r41143, copy of r41142, trunk/config/gen/platform/darwin/hires_timer.c)
@@ -0,0 +1,81 @@
+/*
+ * $Id$
+ * Copyright (C) 2009, Parrot Foundation.
+ */
+
+/*
+
+=head1 NAME
+
+config/gen/platform/generic/hires_timer.c
+
+=head1 DESCRIPTION
+
+High-resolution timer support
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include <time.h>
+
+#define TIME_IN_NS(n) ((n).tv_sec * 1000*1000*1000 + (n).tv_nsec)
+
+/*
+
+=item C<UHUGEINTVAL Parrot_hires_get_time()>
+
+Return a high-resolution number representing how long Parrot has been running.
+
+=cut
+
+*/
+
+UHUGEINTVAL Parrot_hires_get_time()
+{
+ struct timespec ts;
+ struct timeval tv;
+ gettimeofday(&tv, NULL);
+
+ ts.tv_sec = tv.tv_sec;
+ ts.tv_nsec = tv.tv_usec * 1000;
+
+ return TIME_IN_NS(ts);
+}
+
+/*
+
+=item C<UINTVAL Parrot_hires_get_tick_duration()>
+
+Return the number of ns that each time unit from Parrot_hires_get_time represents.
+
+=cut
+
+*/
+
+UINTVAL Parrot_hires_get_tick_duration()
+{
+ return (UINTVAL) 1;
+}
+
+
+
+
+/*
+
+=back
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: branches/gc-refactor/config/gen/platform/generic/hires_timer.c (from r41142, trunk/config/gen/platform/generic/hires_timer.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gc-refactor/config/gen/platform/generic/hires_timer.c Mon Sep 7 23:56:34 2009 (r41143, copy of r41142, trunk/config/gen/platform/generic/hires_timer.c)
@@ -0,0 +1,76 @@
+/*
+ * $Id$
+ * Copyright (C) 2009, Parrot Foundation.
+ */
+
+/*
+
+=head1 NAME
+
+config/gen/platform/generic/hires_timer.c
+
+=head1 DESCRIPTION
+
+High-resolution timer support
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include <time.h>
+
+#define TIME_IN_NS(n) ((n).tv_sec * 1000*1000*1000 + (n).tv_nsec)
+
+/*
+
+=item C<UHUGEINTVAL Parrot_hires_get_time()>
+
+Return a high-resolution number representing how long Parrot has been running.
+
+=cut
+
+*/
+
+UHUGEINTVAL Parrot_hires_get_time()
+{
+ struct timespec ts;
+ clock_gettime(CLOCK_BEST, &ts);
+ return TIME_IN_NS(ts);
+}
+
+/*
+
+=item C<UINTVAL Parrot_hires_get_tick_duration()>
+
+Return the number of ns that each time unit from Parrot_hires_get_time represents.
+
+=cut
+
+*/
+
+UINTVAL Parrot_hires_get_tick_duration()
+{
+ return (UINTVAL) 1;
+}
+
+
+
+
+/*
+
+=back
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/gc-refactor/config/gen/platform/platform_interface.h
==============================================================================
--- branches/gc-refactor/config/gen/platform/platform_interface.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/gen/platform/platform_interface.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -126,6 +126,13 @@
#endif
+/*
+ * high-resolution timer support
+ */
+
+UHUGEINTVAL Parrot_hires_get_time(void);
+UINTVAL Parrot_hires_get_tick_duration(void);
+
struct parrot_string_t;
INTVAL Parrot_Run_OS_Command(Interp*, struct parrot_string_t *);
Copied: branches/gc-refactor/config/gen/platform/win32/hires_timer.c (from r41142, trunk/config/gen/platform/win32/hires_timer.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gc-refactor/config/gen/platform/win32/hires_timer.c Mon Sep 7 23:56:34 2009 (r41143, copy of r41142, trunk/config/gen/platform/win32/hires_timer.c)
@@ -0,0 +1,70 @@
+/*
+ * $Id$
+ * Copyright (C) 2009, Parrot Foundation.
+ */
+
+/*
+
+=head1 NAME
+
+config/gen/platform/win32/hires_timer.c
+
+=head1 DESCRIPTION
+
+High-resolution timer support for win32
+
+=head2 Functions
+
+=over 4
+
+=item C<UHUGEINTVAL Parrot_hires_get_time()>
+
+Return a high-resolution number representing how long Parrot has been running.
+
+=cut
+
+*/
+
+UHUGEINTVAL Parrot_hires_get_time()
+{
+ LARGE_INTEGER ticks;
+ QueryPerformanceCounter(&ticks);
+ return (UHUGEINTVAL) ticks.QuadPart;
+}
+
+/*
+
+=item C<UINTVAL Parrot_hires_get_tick_duration()>
+
+Return the number of nanoseconds that each time unit from Parrot_hires_get_time represents.
+
+=cut
+
+*/
+
+UINTVAL Parrot_hires_get_tick_duration()
+{
+ LARGE_INTEGER ticks;
+ /* QueryPerformanceCounter returns ticks per second, so divide 1 billion by
+ * that to find the length of each tick */
+ QueryPerformanceFrequency(&ticks);
+ return (UINTVAL) (1000*1000*1000 / ticks.QuadPart);
+}
+
+
+
+
+/*
+
+=back
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/gc-refactor/config/init/defaults.pm
==============================================================================
--- branches/gc-refactor/config/init/defaults.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/init/defaults.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -256,6 +256,9 @@
);
}
+ #clock_id used to call the clock_gettime() in the profiling runcore.
+ $conf->data->set( clock_best => '-DCLOCK_BEST=CLOCK_PROF' );
+
$conf->data->set( 'archname', $Config{archname});
# adjust archname, cc and libs for e.g. --m=32
# RT#41499 this is maybe gcc only
Modified: branches/gc-refactor/config/init/hints/cygwin.pm
==============================================================================
--- branches/gc-refactor/config/init/hints/cygwin.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/init/hints/cygwin.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -73,6 +73,7 @@
$conf->data->set(cc => 'gcc-4') unless $conf->options->get('cc');
$conf->data->set(ld => 'g++-4') unless $conf->options->get('ld');
}
+ $conf->data->set( clock_best => '-DCLOCK_BEST=CLOCK_REALTIME' );
}
1;
Modified: branches/gc-refactor/config/init/hints/linux.pm
==============================================================================
--- branches/gc-refactor/config/init/hints/linux.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/init/hints/linux.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -23,9 +23,12 @@
# should find g++ in most cases
my $link = $conf->data->get('link') || 'c++';
- if ( $libs !~ /-lpthread/ ) {
+ if ( $libs !~ /-lpthread\b/ ) {
$libs .= ' -lpthread';
}
+ if ( $libs !~ /-lrt\b/ ) {
+ $libs .= ' -lrt';
+ }
my $ld_share_flags = $conf->data->get('ld_share_flags');
my $cc_shared = $conf->data->get('cc_shared');
@@ -149,6 +152,8 @@
libparrot_soname => "-Wl,-soname=libparrot$share_ext.$version",
);
+ $conf->data->set( clock_best => '-DCLOCK_BEST=CLOCK_PROCESS_CPUTIME_ID' );
+
if ( ( split( m/-/, $conf->data->get_p5('archname'), 2 ) )[0] eq 'ia64' ) {
$conf->data->set( platform_asm => 1 );
Modified: branches/gc-refactor/config/init/hints/mswin32.pm
==============================================================================
--- branches/gc-refactor/config/init/hints/mswin32.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/init/hints/mswin32.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -45,6 +45,8 @@
$conf->data->set( bindir => Win32::GetShortPathName($bindir) );
}
+ $conf->data->set( clock_best => ' ' );
+
if ($is_msvc) {
my $msvcversion = $conf->data->get('msvcversion');
Modified: branches/gc-refactor/config/init/hints/openbsd.pm
==============================================================================
--- branches/gc-refactor/config/init/hints/openbsd.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/init/hints/openbsd.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -37,6 +37,7 @@
$conf->data->set( as => 'as -mregnames' );
}
+ $conf->data->set( clock_best => '-DCLOCK_BEST=CLOCK_MONOTONIC' );
}
1;
Modified: branches/gc-refactor/config/init/hints/solaris.pm
==============================================================================
--- branches/gc-refactor/config/init/hints/solaris.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/init/hints/solaris.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -17,6 +17,7 @@
$libs .= ' -lrt'; # Needed for sched_yield.
}
$conf->data->set( libs => $libs );
+ $conf->data->set( clock_best => '-DCLOCK_BEST=CLOCK_PROCESS_CPUTIME_ID' );
################################################################
# If we're going to be using ICU (or any other C++-compiled library) we
Modified: branches/gc-refactor/config/inter/libparrot.pm
==============================================================================
--- branches/gc-refactor/config/inter/libparrot.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/config/inter/libparrot.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -56,6 +56,9 @@
if ($^O eq 'cygwin') {
@libs = ('libparrot.dll.a');
}
+ if ($^O eq 'darwin'){
+ @libs = qw/libparrot.dylib libparrot.a/;
+ }
if (defined $ENV{LD_LIBRARY_PATH}) {
push @libpaths, (split /:/, $ENV{LD_LIBRARY_PATH});
}
Modified: branches/gc-refactor/docs/project/branching_guide.pod
==============================================================================
--- branches/gc-refactor/docs/project/branching_guide.pod Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/docs/project/branching_guide.pod Mon Sep 7 23:56:34 2009 (r41143)
@@ -35,11 +35,13 @@
=head3 SVN
-On a regular basis (at least weekly, more often for heavy changes), synchronize
-your branch with the changes in trunk. For this you will need the revision
-number of your most recent synchronization (or the revision number of the
-initial branch creation if this is the first synchronization), and the current
-highest revision in trunk (you can get this by running C<svn update>).
+If your branch touches many source code files or is expected to be long-lived,
+you may wish to consider synchronizing your branch with changes in trunk on a
+regular basis (at least weekly, more often for heavy changes). For this you
+will need the revision number of your most recent synchronization (or the
+revision number of the initial branch creation if this is the first
+synchronization), and the current highest revision in trunk (you can get this
+by running C<svn update>).
Make sure you don't have any outstanding changes in your working copy (use
C<svn status>).
Modified: branches/gc-refactor/examples/json/postalcodes.pir
==============================================================================
--- branches/gc-refactor/examples/json/postalcodes.pir Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/examples/json/postalcodes.pir Mon Sep 7 23:56:34 2009 (r41143)
@@ -4,15 +4,15 @@
=head1 NAME
-postalcodes.pir
+postalcodes.pir - Show info about a postal code
=head1 SYNOPSIS
- % ./parrot postalcodes.pir <postal>
+ % parrot postalcodes.pir <postal>
=head1 DESCRIPTION
-Given a postal code (like, '06382'), print some information about various
+Given a postal code (e.g. '06382'), print some information about various
places with that code from around the world.
=cut
@@ -70,16 +70,15 @@
$I0 = index json_result, "\r\n\r\n"
substr json_result, 0, $I0, ""
- load_bytecode 'compilers/json/JSON.pbc'
- $P1 = compreg 'JSON'
- $P2 = $P1(json_result)
-
- $P3 = $P2['error']
- unless null $P3 goto bad_code
-
- $P2 = $P2['postalCodes']
+ load_language 'data_json'
+ $P1 = compreg 'data_json'
+ push_eh bad_code
+ $P2 = $P1.'compile'(json_result)
+ pop_eh
+ $P3 = $P2()
+ $P4 = $P3['postalCodes']
.local pmc it, code
- it = iter $P2
+ it = iter $P4
code_loop:
push_eh code_end
@@ -108,7 +107,7 @@
.return()
bad_code:
- say $P3
+ say $P2
.end
# Local Variables:
Modified: branches/gc-refactor/examples/json/test.pir
==============================================================================
--- branches/gc-refactor/examples/json/test.pir Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/examples/json/test.pir Mon Sep 7 23:56:34 2009 (r41143)
@@ -3,28 +3,27 @@
# $Id$
.sub main :main
- .param pmc argv
+ .param pmc argv
- .local int argc
- argc = elements argv
+ .local int argc
+ argc = elements argv
- if argc != 2 goto bad_args
+ if argc != 2 goto bad_args
- load_bytecode 'PGE.pbc'
- load_bytecode 'PGE/Util.pbc'
- load_bytecode 'compilers/json/JSON.pbc'
-
- .local pmc JSON
- JSON = compreg "JSON"
- $S0 = argv[1]
- $P1 = JSON($S0)
+ .local pmc json, code, data
+ .local string text
+ load_language 'data_json'
+ json = compreg 'data_json'
+ text = argv[1]
+ code = json.'compile'(text)
+ data = code()
load_bytecode 'dumper.pbc'
- _dumper($P1, "JSON")
+ _dumper(data, 'JSON')
end
bad_args:
- say "must specify a single arg."
+ say "Must specify a single arg."
end
.end
Modified: branches/gc-refactor/ext/SQLite3/SQLite3.pir
==============================================================================
--- branches/gc-refactor/ext/SQLite3/SQLite3.pir Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/ext/SQLite3/SQLite3.pir Mon Sep 7 23:56:34 2009 (r41143)
@@ -1,7 +1,7 @@
# Copyright (C) 2008-2009, Parrot Foundation.
# $Id$
-.namespace ['SQLite']
+.namespace ['SQLite3']
.const int SQLITE_OK = 0 # Successful result
# beginning-of-error-codes
@@ -61,6 +61,14 @@
push sqlite_funcs, 'ipitii'
push sqlite_funcs, 'column_name'
push sqlite_funcs, 'tpi'
+ push sqlite_funcs, 'column_count'
+ push sqlite_funcs, 'ip'
+ push sqlite_funcs, 'column_type'
+ push sqlite_funcs, 'ipi'
+ push sqlite_funcs, 'column_int'
+ push sqlite_funcs, 'ipi'
+ push sqlite_funcs, 'column_double'
+ push sqlite_funcs, 'lpi'
push sqlite_funcs, 'column_text'
push sqlite_funcs, 'tpi'
Modified: branches/gc-refactor/ext/SQLite3/gen_sqlite3.pl
==============================================================================
--- branches/gc-refactor/ext/SQLite3/gen_sqlite3.pl Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/ext/SQLite3/gen_sqlite3.pl Mon Sep 7 23:56:34 2009 (r41143)
@@ -36,7 +36,7 @@
qq{
##GENERATED FILE DO NOT EDIT##
##GENERATED BY gen_sqlite3.pl##
-.namespace ['SQLite']
+.namespace ['SQLite3']
.const int SQLITE_OK = 0 # Successful result
# beginning-of-error-codes
Modified: branches/gc-refactor/ext/SQLite3/test.pir
==============================================================================
--- branches/gc-refactor/ext/SQLite3/test.pir Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/ext/SQLite3/test.pir Mon Sep 7 23:56:34 2009 (r41143)
@@ -3,7 +3,7 @@
# $Id$
.sub 'main'
-load_bytecode 'SQLite3'
+load_bytecode 'SQLite3.pir'
$P0 = get_global [ 'SQLite' ], 'open'
$P1 = $P0("test.db")
Modified: branches/gc-refactor/include/parrot/call.h
==============================================================================
--- branches/gc-refactor/include/parrot/call.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/include/parrot/call.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -709,6 +709,22 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
+void Parrot_clear_i(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_clear_n(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_clear_p(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void Parrot_clear_s(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
struct PackFile_Constant ** Parrot_pcc_constants(PARROT_INTERP,
ARGIN(PMC *ctx))
@@ -756,6 +772,14 @@
__attribute__nonnull__(2);
PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+FLOATVAL * Parrot_pcc_get_FLOATVAL_reg(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ UINTVAL idx)
+ __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)
@@ -776,6 +800,14 @@
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
+INTVAL * Parrot_pcc_get_INTVAL_reg(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ UINTVAL 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);
@@ -819,6 +851,12 @@
__attribute__nonnull__(2);
PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PMC ** Parrot_pcc_get_PMC_reg(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL 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);
@@ -829,6 +867,23 @@
__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
+UINTVAL Parrot_pcc_get_regs_used(PARROT_INTERP, ARGIN(PMC *ctx), int type)
+ __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)
@@ -849,6 +904,14 @@
__attribute__nonnull__(2);
PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+STRING ** Parrot_pcc_get_STRING_reg(PARROT_INTERP,
+ ARGIN(PMC *ctx),
+ UINTVAL 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)
@@ -940,6 +1003,32 @@
__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);
+
+PARROT_EXPORT
+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)
+ __attribute__nonnull__(3);
+
+PARROT_EXPORT
+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_pcc_set_results(PARROT_INTERP,
ARGIN(PMC *ctx),
ARGIN_NULLOK(opcode_t *pc))
@@ -1000,6 +1089,47 @@
__attribute__nonnull__(1)
__attribute__nonnull__(2);
+PARROT_EXPORT
+void Parrot_pop_context(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+PMC * Parrot_push_context(PARROT_INTERP, ARGIN(const INTVAL *n_regs_used))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+void create_initial_context(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+PMC * Parrot_alloc_context(PARROT_INTERP,
+ ARGIN(const INTVAL *number_regs_used),
+ ARGIN_NULLOK(PMC *old))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+size_t Parrot_pcc_calculate_context_size(SHIM_INTERP,
+ ARGIN(const UINTVAL *number_regs_used))
+ __attribute__nonnull__(2);
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+PMC * Parrot_set_new_context(PARROT_INTERP,
+ ARGIN(const INTVAL *number_regs_used))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+#define ASSERT_ARGS_Parrot_clear_i __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_clear_n __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_clear_p __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_clear_s __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_Parrot_pcc_constants __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(ctx)
@@ -1024,6 +1154,9 @@
#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_FLOATVAL_reg __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)
@@ -1033,6 +1166,9 @@
#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_INTVAL_reg __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)
@@ -1054,6 +1190,9 @@
#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_PMC_reg __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)
@@ -1061,6 +1200,15 @@
__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_results __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(ctx)
@@ -1072,6 +1220,9 @@
__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_get_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(ctx)
@@ -1116,6 +1267,17 @@
#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_regs_ni __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx) \
+ || 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_pcc_set_results __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(ctx)
@@ -1144,6 +1306,22 @@
#define ASSERT_ARGS_Parrot_pcc_warnings_test __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(ctx)
+#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_create_initial_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)
+#define ASSERT_ARGS_Parrot_pcc_calculate_context_size \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(number_regs_used)
+#define ASSERT_ARGS_Parrot_set_new_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(number_regs_used)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: src/call/context.c */
Modified: branches/gc-refactor/include/parrot/charset.h
==============================================================================
--- branches/gc-refactor/include/parrot/charset.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/include/parrot/charset.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -244,7 +244,7 @@
#define CHARSET_COMPARE(interp, lhs, rhs) ((const CHARSET *)(lhs)->charset)->compare((interp), (lhs), (rhs))
#define CHARSET_INDEX(interp, source, search, offset) ((source)->charset)->index((interp), (source), (search), (offset))
#define CHARSET_RINDEX(interp, source, search, offset) ((source)->charset)->rindex((interp), (source), (search), (offset))
-#define CHARSET_VALIDATE(interp, source, offset) ((source)->charset)->validate((interp), (source))
+#define CHARSET_VALIDATE(interp, source) ((source)->charset)->validate((interp), (source))
#define CHARSET_IS_CCLASS(interp, flags, source, offset) ((source)->charset)->is_cclass((interp), (flags), (source), (offset))
#define CHARSET_FIND_CCLASS(interp, flags, source, offset, count) ((source)->charset)->find_cclass((interp), (flags), (source), (offset), (count))
#define CHARSET_FIND_NOT_CCLASS(interp, flags, source, offset, count) ((source)->charset)->find_not_cclass((interp), (flags), (source), (offset), (count))
Modified: branches/gc-refactor/include/parrot/context.h
==============================================================================
--- branches/gc-refactor/include/parrot/context.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/include/parrot/context.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -9,6 +9,69 @@
#ifndef PARROT_CONTEXT_H_GUARD
#define PARROT_CONTEXT_H_GUARD
+#include "parrot/string.h"
+#include "parrot/compiler.h"
+
+/*
+ * Macros to make accessing registers more convenient/readable.
+ */
+
+#ifndef NDEBUG
+
+# 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)))
+
+#else /* NDEBUG */
+
+/* Manually inlined macros. Used in optimised builds */
+
+# define __C(c) (PMC_data_typed(c, Parrot_Context*))
+
+# define CTX_REG_NUM(p, x) (__C(p)->bp.regs_n[-1L - (x)])
+# define CTX_REG_INT(p, x) (__C(p)->bp.regs_i[(x)])
+# define CTX_REG_PMC(p, x) (__C(p)->bp_ps.regs_p[-1L - (x)])
+# define CTX_REG_STR(p, x) (__C(p)->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))
+
+#endif
+
+/*
+ * and a set of macros to access a register by offset, used
+ * in JIT emit prederef code
+ * The offsets are relative to interp->ctx.bp.
+ *
+ * Reg order in imcc/reg_alloc.c is "INSP" TODO make defines
+ */
+
+#define REGNO_INT 0
+#define REGNO_NUM 1
+#define REGNO_STR 2
+#define REGNO_PMC 3
+
+#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])
+#define _SIZEOF_STRS (sizeof (STRING*) * __CTX->n_regs_used[REGNO_STR])
+
+#define REG_OFFS_NUM(x) (sizeof (FLOATVAL) * (-1L - (x)))
+#define REG_OFFS_INT(x) (sizeof (INTVAL) * (x))
+#define REG_OFFS_PMC(x) (_SIZEOF_INTS + sizeof (PMC*) * \
+ (__CTX->n_regs_used[REGNO_PMC] - 1L - (x)))
+#define REG_OFFS_STR(x) (sizeof (STRING*) * (x) + _SIZEOF_INTS + _SIZEOF_PMCS)
+
+
struct PackFile_Constant;
typedef union {
@@ -27,7 +90,7 @@
Regs_ps bp_ps; /* pointers to PMC & STR */
/* end common header */
- INTVAL n_regs_used[4]; /* INSP in PBC points to Sub */
+ UINTVAL n_regs_used[4]; /* INSP in PBC points to Sub */
PMC *lex_pad; /* LexPad PMC */
PMC *outer_ctx; /* outer context, if a closure */
Modified: branches/gc-refactor/include/parrot/gc_api.h
==============================================================================
--- branches/gc-refactor/include/parrot/gc_api.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/include/parrot/gc_api.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -17,15 +17,6 @@
#include "parrot/parrot.h"
-/* Set to 1 if we want to use the fixed-size allocator. Set to 0 if we want
- 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 1
-#else
-# define GC_USE_FIXED_SIZE_ALLOCATOR 1
-#endif
-
/*
* we need an alignment that is the same as malloc(3) have for
* allocating Buffer items like FLOATVAL (double)
@@ -165,9 +156,7 @@
__attribute__nonnull__(1);
PARROT_CANNOT_RETURN_NULL
-void * Parrot_gc_allocate_pmc_attributes(PARROT_INTERP,
- ARGMOD(PMC *pmc),
- size_t size)
+void * Parrot_gc_allocate_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*pmc);
@@ -220,9 +209,7 @@
__attribute__nonnull__(3)
FUNC_MODIFIES(*data);
-void Parrot_gc_free_pmc_attributes(PARROT_INTERP,
- ARGMOD(PMC *pmc),
- size_t item_size)
+void Parrot_gc_free_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*pmc);
Modified: branches/gc-refactor/include/parrot/interpreter.h
==============================================================================
--- branches/gc-refactor/include/parrot/interpreter.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/include/parrot/interpreter.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -72,7 +72,8 @@
PARROT_SWITCH_JIT_CORE = 0x12, /* J P */
PARROT_EXEC_CORE = 0x20, /* TODO Parrot_exec_run variants */
PARROT_GC_DEBUG_CORE = 0x40, /* run GC before each op */
- PARROT_DEBUGGER_CORE = 0x80 /* used by parrot debugger */
+ PARROT_DEBUGGER_CORE = 0x80, /* used by parrot debugger */
+ PARROT_PROFILING_CORE = 0x160 /* used by parrot debugger */
} Parrot_Run_core_t;
/* &end_gen */
@@ -131,7 +132,7 @@
#define Interp_core_SET(interp, core) ((interp)->run_core = (core))
#define Interp_core_TEST(interp, core) ((interp)->run_core == (core))
-#include "parrot/register.h"
+#include "parrot/context.h"
#include "parrot/parrot.h"
#include "parrot/warnings.h"
@@ -146,33 +147,6 @@
Warnings_classes classes;
} *Warnings;
-/* ProfData have these extra items in front followed by
- * one entry per op at (op + extra) */
-
-typedef enum {
- PARROT_PROF_GC_p1, /* pass 1 mark root set */
- PARROT_PROF_GC_p2, /* pass 2 mark next_for_GC */
- PARROT_PROF_GC_cp, /* collect PMCs */
- PARROT_PROF_GC_cb, /* collect buffers */
- PARROT_PROF_GC,
- PARROT_PROF_EXCEPTION,
- PARROT_PROF_EXTRA
-} profile_extra_enum;
-
-/* data[op_count] is time spent for exception handling */
-typedef struct ProfData {
- int op;
- UINTVAL numcalls;
- FLOATVAL time;
-} ProfData;
-
-typedef struct _RunProfile {
- FLOATVAL starttime;
- FLOATVAL gc_time;
- opcode_t cur_op;
- ProfData *data;
-} RunProfile;
-
/* Forward declaration for imc_info_t -- the actual struct is
* defined in imcc/imc.h */
struct _imc_info_t;
@@ -256,10 +230,9 @@
UINTVAL debug_flags; /* debug settings */
- INTVAL run_core; /* type of core to run the ops */
-
- /* TODO profile per code segment or global */
- RunProfile *profile; /* profile counters */
+ struct runcore_t *run_core; /* type of core to run the ops */
+ struct runcore_t **cores; /* array of known runcores */
+ UINTVAL num_cores; /* number of known runcores */
INTVAL resume_flag;
size_t resume_offset;
@@ -611,8 +584,7 @@
void *prederef_arena);
void prepare_for_run(PARROT_INTERP);
void *init_jit(PARROT_INTERP, opcode_t *pc);
-PARROT_EXPORT void dynop_register(PARROT_INTERP, PMC* op_lib);
-void do_prederef(void **pc_prederef, PARROT_INTERP, int type);
+PARROT_EXPORT void dynop_register(PARROT_INTERP, PMC *op_lib);
/* interpreter.pmc */
void clone_interpreter(Parrot_Interp dest, Parrot_Interp self, INTVAL flags);
Modified: branches/gc-refactor/include/parrot/parrot.h
==============================================================================
--- branches/gc-refactor/include/parrot/parrot.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/include/parrot/parrot.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -267,7 +267,7 @@
#include "parrot/list.h"
#include "parrot/pmc_freeze.h"
#include "parrot/vtable.h"
-#include "parrot/register.h"
+#include "parrot/context.h"
#include "parrot/exceptions.h"
#include "parrot/warnings.h"
#include "parrot/memory.h"
Modified: branches/gc-refactor/include/parrot/pic.h
==============================================================================
--- branches/gc-refactor/include/parrot/pic.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/include/parrot/pic.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -13,6 +13,8 @@
#ifndef PARROT_PIC_H_GUARD
#define PARROT_PIC_H_GUARD
+#include "parrot/runcore_api.h"
+
/*
* one cache slot
*
@@ -125,9 +127,10 @@
void parrot_PIC_prederef(PARROT_INTERP,
opcode_t op,
ARGOUT(void **pc_pred),
- int core)
+ ARGIN(Parrot_runcore_t *core))
__attribute__nonnull__(1)
__attribute__nonnull__(3)
+ __attribute__nonnull__(4)
FUNC_MODIFIES(*pc_pred);
#define ASSERT_ARGS_parrot_PIC_alloc_mic __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
@@ -153,7 +156,8 @@
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_parrot_PIC_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc_pred)
+ || PARROT_ASSERT_ARG(pc_pred) \
+ || PARROT_ASSERT_ARG(core)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: src/pic.c */
Modified: branches/gc-refactor/include/parrot/pmc_freeze.h
==============================================================================
--- branches/gc-refactor/include/parrot/pmc_freeze.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/include/parrot/pmc_freeze.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -91,14 +91,14 @@
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-PMC* Parrot_clone(PARROT_INTERP, ARGIN(PMC* pmc))
+PMC* Parrot_clone(PARROT_INTERP, ARGIN(PMC *pmc))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-STRING* Parrot_freeze(PARROT_INTERP, ARGIN(PMC* pmc))
+STRING* Parrot_freeze(PARROT_INTERP, ARGIN(PMC *pmc))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
@@ -112,14 +112,14 @@
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-PMC* Parrot_thaw(PARROT_INTERP, ARGIN(STRING* image))
+PMC* Parrot_thaw(PARROT_INTERP, ARGIN(STRING *image))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-PMC* Parrot_thaw_constants(PARROT_INTERP, ARGIN(STRING* image))
+PMC* Parrot_thaw_constants(PARROT_INTERP, ARGIN(STRING *image))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
Deleted: branches/gc-refactor/include/parrot/register.h
==============================================================================
--- branches/gc-refactor/include/parrot/register.h Mon Sep 7 23:56:34 2009 (r41142)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,244 +0,0 @@
-/* register.h
- * Copyright (C) 2001-2008, Parrot Foundation.
- * SVN Info
- * $Id$
- * Overview:
- * Defines the register api
- * Data Structure and Algorithms:
- * History:
- * Notes:
- * References:
- */
-
-#ifndef PARROT_REGISTER_H_GUARD
-#define PARROT_REGISTER_H_GUARD
-
-#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(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
- * in JIT emit prederef code
- * The offsets are relative to interp->ctx.bp.
- *
- * Reg order in imcc/reg_alloc.c is "INSP" TODO make defines
- */
-
-#define REGNO_INT 0
-#define REGNO_NUM 1
-#define REGNO_STR 2
-#define REGNO_PMC 3
-
-#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])
-#define _SIZEOF_STRS (sizeof (STRING*) * __CTX->n_regs_used[REGNO_STR])
-
-#define REG_OFFS_NUM(x) (sizeof (FLOATVAL) * (-1L - (x)))
-#define REG_OFFS_INT(x) (sizeof (INTVAL) * (x))
-#define REG_OFFS_PMC(x) (_SIZEOF_INTS + sizeof (PMC*) * \
- (__CTX->n_regs_used[REGNO_PMC] - 1L - (x)))
-#define REG_OFFS_STR(x) (sizeof (STRING*) * (x) + _SIZEOF_INTS + _SIZEOF_PMCS)
-
-
-/* HEADERIZER BEGIN: src/gc/alloc_register.c */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-PARROT_EXPORT
-void Parrot_clear_i(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_EXPORT
-void Parrot_clear_n(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_EXPORT
-void Parrot_clear_p(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_EXPORT
-void Parrot_clear_s(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_EXPORT
-PARROT_CANNOT_RETURN_NULL
-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);
-
-PARROT_EXPORT
-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)
- __attribute__nonnull__(3);
-
-PARROT_EXPORT
-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)
- __attribute__nonnull__(1);
-
-PARROT_EXPORT
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-PMC * Parrot_push_context(PARROT_INTERP, ARGIN(const INTVAL *n_regs_used))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-void create_initial_context(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-PMC * Parrot_alloc_context(PARROT_INTERP,
- ARGIN(const INTVAL *number_regs_used),
- ARGIN_NULLOK(PMC *old))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-PMC * Parrot_set_new_context(PARROT_INTERP,
- ARGIN(const INTVAL *number_regs_used))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-#define ASSERT_ARGS_Parrot_clear_i __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_clear_n __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_clear_p __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_clear_s __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#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(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_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_create_initial_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)
-#define ASSERT_ARGS_Parrot_set_new_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(number_regs_used)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: src/gc/alloc_register.c */
-
-#endif /* PARROT_REGISTER_H_GUARD */
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: branches/gc-refactor/include/parrot/runcore_api.h
==============================================================================
--- branches/gc-refactor/include/parrot/runcore_api.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/include/parrot/runcore_api.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -9,11 +9,136 @@
#ifndef PARROT_RUNCORE_API_H_GUARD
#define PARROT_RUNCORE_API_H_GUARD
+struct runcore_t;
+typedef struct runcore_t Parrot_runcore_t;
+
+struct profiling_runcore_t;
+typedef struct profiling_runcore_t Parrot_profiling_runcore_t;
+
#include "parrot/parrot.h"
#include "parrot/op.h"
# define DO_OP(PC, INTERP) ((PC) = (((INTERP)->op_func_table)[*(PC)])((PC), (INTERP)))
+typedef opcode_t * (*runcore_runops_fn_type) (PARROT_INTERP, ARGIN(Parrot_runcore_t *), ARGIN(opcode_t *pc));
+typedef void (*runcore_destroy_fn_type)(PARROT_INTERP, ARGIN(Parrot_runcore_t *));
+typedef void * (*runcore_prepare_fn_type)(PARROT_INTERP, ARGIN(Parrot_runcore_t *));
+
+typedef runcore_runops_fn_type Parrot_runcore_runops_fn_t;
+typedef runcore_destroy_fn_type Parrot_runcore_destroy_fn_t;
+typedef runcore_prepare_fn_type Parrot_runcore_prepare_fn_t;
+
+struct runcore_t {
+ STRING *name;
+ int id;
+ oplib_init_f opinit;
+ runcore_runops_fn_type runops;
+ runcore_destroy_fn_type destroy;
+ runcore_prepare_fn_type prepare_run;
+ INTVAL flags;
+};
+
+
+typedef enum Parrot_profiling_flags {
+ PROFILING_EXIT_CHECK_FLAG = 1 << 0,
+ PROFILING_FIRST_LOOP_FLAG = 1 << 1,
+ PROFILING_HAVE_PRINTED_CLI_FLAG = 1 << 2
+} Parrot_profiling_flags;
+
+struct profiling_runcore_t {
+ STRING *name;
+ int id;
+ oplib_init_f opinit;
+ Parrot_runcore_runops_fn_t runops;
+ Parrot_runcore_destroy_fn_t destroy;
+ Parrot_runcore_prepare_fn_t prepare_run;
+ INTVAL flags;
+
+ /* end of common members */
+ UHUGEINTVAL runcore_start;
+ UHUGEINTVAL op_start;
+ UHUGEINTVAL op_finish;
+ UHUGEINTVAL runcore_finish;
+ INTVAL profiling_flags;
+ INTVAL runloop_count;
+ FILE *profile_fd;
+ STRING *profile_filename;
+ PMC *prev_sub;
+ Parrot_Context *prev_ctx;
+ UINTVAL level; /* how many nested runloops */
+ UINTVAL time_size; /* how big is the following array */
+ UHUGEINTVAL *time; /* time spent between DO_OP and start/end of a runcore */
+};
+
+
+typedef enum Parrot_runcore_flags {
+ RUNCORE_REENTRANT_FLAG = 1 << 0,
+ RUNCORE_FUNC_TABLE_FLAG = 1 << 1,
+ RUNCORE_EVENT_CHECK_FLAG = 1 << 2,
+ RUNCORE_PREDEREF_OPS_FLAG = 1 << 3,
+ RUNCORE_CGOTO_OPS_FLAG = 1 << 4,
+ RUNCORE_JIT_OPS_FLAG = 1 << 5
+} Parrot_runcore_flags;
+
+
+#define Profiling_flag_SET(runcore, flag) \
+ ((runcore)->profiling_flags |= flag)
+#define Profiling_flag_TEST(runcore, flag) \
+ ((runcore)->profiling_flags & flag)
+#define Profiling_flag_CLEAR(runcore, flag) \
+ ((runcore)->profiling_flags &= ~(flag))
+
+#define Profiling_exit_check_TEST(o) \
+ Profiling_flag_TEST(o, PROFILING_EXIT_CHECK_FLAG)
+#define Profiling_exit_check_SET(o) \
+ Profiling_flag_SET(o, PROFILING_EXIT_CHECK_FLAG)
+#define Profiling_exit_check_CLEAR(o) \
+ Profiling_flag_CLEAR(o, PROFILING_EXIT_CHECK_FLAG)
+
+#define Profiling_first_loop_TEST(o) \
+ Profiling_flag_TEST(o, PROFILING_FIRST_LOOP_FLAG)
+#define Profiling_first_loop_SET(o) \
+ Profiling_flag_SET(o, PROFILING_FIRST_LOOP_FLAG)
+#define Profiling_first_loop_CLEAR(o) \
+ Profiling_flag_CLEAR(o, PROFILING_FIRST_LOOP_FLAG)
+
+#define Profiling_have_printed_cli_TEST(o) \
+ Profiling_flag_TEST(o, PROFILING_HAVE_PRINTED_CLI_FLAG)
+#define Profiling_have_printed_cli_SET(o) \
+ Profiling_flag_SET(o, PROFILING_HAVE_PRINTED_CLI_FLAG)
+#define Profiling_have_printed_cli_CLEAR(o) \
+ Profiling_flag_CLEAR(o, PROFILING_HAVE_PRINTED_CLI_FLAG)
+
+#define Runcore_flag_SET(runcore, flag) \
+ ((runcore)->flags |= flag)
+#define Runcore_flag_TEST(runcore, flag) \
+ ((runcore)->flags & flag)
+
+#define PARROT_RUNCORE_FUNC_TABLE_TEST(runcore) \
+ Runcore_flag_TEST(runcore, RUNCORE_FUNC_TABLE_FLAG)
+#define PARROT_RUNCORE_FUNC_TABLE_SET(runcore) \
+ Runcore_flag_SET(runcore, RUNCORE_FUNC_TABLE_FLAG)
+
+#define PARROT_RUNCORE_EVENT_CHECK_TEST(runcore) \
+ Runcore_flag_TEST(runcore, RUNCORE_EVENT_CHECK_FLAG)
+#define PARROT_RUNCORE_EVENT_CHECK_SET(runcore) \
+ Runcore_flag_SET(runcore, RUNCORE_EVENT_CHECK_FLAG)
+
+#define PARROT_RUNCORE_PREDEREF_OPS_TEST(runcore) \
+ Runcore_flag_TEST(runcore, RUNCORE_PREDEREF_OPS_FLAG)
+#define PARROT_RUNCORE_PREDEREF_OPS_SET(runcore) \
+ Runcore_flag_SET(runcore, RUNCORE_PREDEREF_OPS_FLAG)
+
+#define PARROT_RUNCORE_CGOTO_OPS_TEST(runcore) \
+ Runcore_flag_TEST(runcore, RUNCORE_CGOTO_OPS_FLAG)
+#define PARROT_RUNCORE_CGOTO_OPS_SET(runcore) \
+ Runcore_flag_SET(runcore, RUNCORE_CGOTO_OPS_FLAG)
+
+#define PARROT_RUNCORE_JIT_OPS_TEST(runcore) \
+ Runcore_flag_TEST(runcore, RUNCORE_JIT_OPS_FLAG)
+#define PARROT_RUNCORE_JIT_OPS_SET(runcore) \
+ Runcore_flag_SET(runcore, RUNCORE_JIT_OPS_FLAG)
+
/* HEADERIZER BEGIN: src/runcore/main.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
@@ -25,10 +150,25 @@
void enable_event_checking(PARROT_INTERP)
__attribute__nonnull__(1);
-void do_prederef(ARGIN(void **pc_prederef), PARROT_INTERP, int type)
+PARROT_EXPORT
+INTVAL Parrot_runcore_register(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *coredata))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
+PARROT_EXPORT
+void Parrot_runcore_switch(PARROT_INTERP, ARGIN(STRING *name))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+void do_prederef(
+ ARGIN(void **pc_prederef),
+ PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
void dynop_register(PARROT_INTERP, ARGIN(PMC *lib_pmc))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
@@ -45,6 +185,9 @@
void Parrot_runcore_destroy(PARROT_INTERP)
__attribute__nonnull__(1);
+void Parrot_runcore_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
void Parrot_setup_event_func_ptrs(PARROT_INTERP)
__attribute__nonnull__(1);
@@ -58,9 +201,16 @@
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_enable_event_checking __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_register __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(coredata)
+#define ASSERT_ARGS_Parrot_runcore_switch __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(name)
#define ASSERT_ARGS_do_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(pc_prederef) \
- || PARROT_ASSERT_ARG(interp)
+ || PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore)
#define ASSERT_ARGS_dynop_register __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(lib_pmc)
@@ -71,6 +221,8 @@
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_Parrot_runcore_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_Parrot_setup_event_func_ptrs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_prepare_for_run __attribute__unused__ int _ASSERT_ARGS_CHECK = \
@@ -83,71 +235,113 @@
/* HEADERIZER BEGIN: src/runcore/cores.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-opcode_t * runops_cgoto_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+void * destroy_profiling_core(PARROT_INTERP,
+ ARGIN(Parrot_profiling_runcore_t *runcore))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t * runops_debugger_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+PARROT_CANNOT_RETURN_NULL
+oplib_init_f get_core_op_lib_init(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t * runops_fast_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+PARROT_CANNOT_RETURN_NULL
+void * init_jit_run(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
-PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-opcode_t * runops_gc_debug_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+void * init_prederef(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t * runops_profile_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+void load_prederef(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-opcode_t * runops_slow_core(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
+void Parrot_runcore_cgoto_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
-#define ASSERT_ARGS_runops_cgoto_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_debugger_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+void Parrot_runcore_cgp_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void Parrot_runcore_cgp_jit_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void Parrot_runcore_debugger_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void Parrot_runcore_exec_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void Parrot_runcore_fast_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void Parrot_runcore_gc_debug_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void Parrot_runcore_jit_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void Parrot_runcore_profiling_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void Parrot_runcore_slow_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void Parrot_runcore_switch_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void Parrot_runcore_switch_jit_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+#define ASSERT_ARGS_destroy_profiling_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_fast_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ || PARROT_ASSERT_ARG(runcore)
+#define ASSERT_ARGS_get_core_op_lib_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_gc_debug_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ || PARROT_ASSERT_ARG(runcore)
+#define ASSERT_ARGS_init_jit_run __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_profile_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ || PARROT_ASSERT_ARG(runcore)
+#define ASSERT_ARGS_init_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_slow_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ || PARROT_ASSERT_ARG(runcore)
+#define ASSERT_ARGS_load_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
+ || PARROT_ASSERT_ARG(runcore)
+#define ASSERT_ARGS_Parrot_runcore_cgoto_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_cgp_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_cgp_jit_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_debugger_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_exec_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_fast_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_gc_debug_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_jit_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_profiling_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_slow_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_switch_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_switch_jit_init \
+ __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: src/runcore/cores.c */
-opcode_t *runops_fast_core(PARROT_INTERP, opcode_t *);
-
-opcode_t *runops_cgoto_core(PARROT_INTERP, opcode_t *);
-
-opcode_t *runops_slow_core(PARROT_INTERP, opcode_t *);
-
-opcode_t *runops_profile_core(PARROT_INTERP, opcode_t *);
-
#endif /* PARROT_RUNCORE_API_H_GUARD */
Modified: branches/gc-refactor/include/parrot/sub.h
==============================================================================
--- branches/gc-refactor/include/parrot/sub.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/include/parrot/sub.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -152,21 +152,9 @@
typedef struct Parrot_Sub_attributes Parrot_sub;
typedef struct Parrot_Coroutine_attributes Parrot_coro;
+typedef struct Parrot_Continuation_attributes Parrot_cont;
-typedef struct Parrot_cont {
- /* continuation destination */
- PackFile_ByteCode *seg; /* bytecode segment */
- opcode_t *address; /* start of bytecode, addr to continue */
- PMC *to_ctx; /* pointer to dest context */
- /* a Continuation keeps the from_ctx alive */
- PMC *from_ctx; /* sub, this cont is returning from */
- opcode_t *current_results; /* ptr into code with get_results opcode
- full continuation only */
- int runloop_id; /* id of the creating runloop. */
- int invoked; /* flag when a handler has been invoked. */
-} Parrot_cont;
-
-#define PMC_cont(pmc) (PARROT_CONTINUATION(pmc)->cont)
+#define PMC_cont(pmc) PARROT_CONTINUATION(pmc)
typedef struct Parrot_Context_info {
STRING *subname;
@@ -229,34 +217,18 @@
FUNC_MODIFIES(*cont);
void mark_context_start(void);
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-Parrot_cont * new_continuation(PARROT_INTERP,
- ARGIN_NULLOK(const Parrot_cont *to))
- __attribute__nonnull__(1);
-
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-Parrot_cont * new_ret_continuation(PARROT_INTERP)
- __attribute__nonnull__(1);
-
void Parrot_capture_lex(PARROT_INTERP, ARGMOD(PMC *sub_pmc))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*sub_pmc);
-void Parrot_continuation_check(PARROT_INTERP,
- ARGIN(const PMC *pmc),
- ARGIN(const Parrot_cont *cc))
+void Parrot_continuation_check(PARROT_INTERP, ARGIN(const PMC *pmc))
__attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
+ __attribute__nonnull__(2);
-void Parrot_continuation_rewind_environment(PARROT_INTERP,
- SHIM(PMC *pmc),
- ARGIN(Parrot_cont *cc))
+void Parrot_continuation_rewind_environment(PARROT_INTERP, ARGIN(PMC *pmc))
__attribute__nonnull__(1)
- __attribute__nonnull__(3);
+ __attribute__nonnull__(2);
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
@@ -298,21 +270,16 @@
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(cont)
#define ASSERT_ARGS_mark_context_start __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
-#define ASSERT_ARGS_new_continuation __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_new_ret_continuation __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_Parrot_capture_lex __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(sub_pmc)
#define ASSERT_ARGS_Parrot_continuation_check __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pmc) \
- || PARROT_ASSERT_ARG(cc)
+ || PARROT_ASSERT_ARG(pmc)
#define ASSERT_ARGS_Parrot_continuation_rewind_environment \
__attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(cc)
+ || 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) \
Modified: branches/gc-refactor/lib/Parrot/Pmc2c/PCCMETHOD.pm
==============================================================================
--- branches/gc-refactor/lib/Parrot/Pmc2c/PCCMETHOD.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/lib/Parrot/Pmc2c/PCCMETHOD.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -412,7 +412,7 @@
}
Parrot_pcc_set_continuation(interp, _ctx, _ret_cont);
- PMC_cont(_ret_cont)->from_ctx = _ctx;
+ PARROT_CONTINUATION(_ret_cont)->from_ctx = _ctx;
_current_args = interp->current_args;
interp->current_args = NULL;
Modified: branches/gc-refactor/lib/Parrot/Vtable.pm
==============================================================================
--- branches/gc-refactor/lib/Parrot/Vtable.pm Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/lib/Parrot/Vtable.pm Mon Sep 7 23:56:34 2009 (r41143)
@@ -169,7 +169,7 @@
PMC *_namespace; /* Pointer to namespace for this class */
INTVAL base_type; /* 'type' value for MMD */
STRING *whoami; /* Name of class this vtable is for */
- UINTVAL flags; /* Flags. Duh */
+ UINTVAL flags; /* VTABLE flags (constant, is_ro, etc). */
STRING *provides_str; /* space-separated list of interfaces */
Hash *isa_hash; /* Hash of class names */
PMC *pmc_class; /* for PMCs: a PMC of that type
@@ -265,7 +265,7 @@
"", /* Pointer to namespace for this class */
"", /* 'type' value for MMD */
"", /* Name of class this vtable is for */
- "", /* Flags. Duh */
+ "", /* VTABLE flags (constant, is_ro, etc). */
"", /* space-separated list of interfaces */
"", /* space-separated list of classes */
"", /* class */
Modified: branches/gc-refactor/runtime/parrot/include/test_more.pir
==============================================================================
--- branches/gc-refactor/runtime/parrot/include/test_more.pir Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/runtime/parrot/include/test_more.pir Mon Sep 7 23:56:34 2009 (r41143)
@@ -20,7 +20,7 @@
.local pmc exports, curr_namespace, test_namespace
curr_namespace = get_namespace
test_namespace = get_root_namespace [ 'parrot'; 'Test'; 'More' ]
- exports = split ' ', 'plan diag ok nok is is_deeply like isa_ok skip isnt todo'
+ exports = split ' ', 'plan diag ok nok is is_deeply like isa_ok skip isnt todo throws_like'
test_namespace.'export_to'(curr_namespace, exports)
Modified: branches/gc-refactor/runtime/parrot/library/Test/More.pir
==============================================================================
--- branches/gc-refactor/runtime/parrot/library/Test/More.pir Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/runtime/parrot/library/Test/More.pir Mon Sep 7 23:56:34 2009 (r41143)
@@ -13,7 +13,7 @@
.local pmc exports, curr_namespace, test_namespace
curr_namespace = get_namespace
test_namespace = get_namespace [ 'Test'; 'More' ]
- exports = split ' ', 'plan diag ok nok is is_deeply like isa_ok skip isnt todo'
+ exports = split ' ', 'plan diag ok nok is is_deeply like isa_ok skip isnt todo throws_like'
test_namespace.'export_to'(curr_namespace, exports)
@@ -814,6 +814,54 @@
.return( equal )
.end
+=item C<throws_like( codestring, pattern, description )>
+
+Takes PIR code in C<codestring> and a PGE pattern to match in C<pattern>, as
+well as an optional message in C<description>. Passes a test if the PIR throws
+an exception that matches the pattern, fails the test otherwise.
+
+=cut
+
+.sub throws_like
+ .param string target
+ .param string pattern
+ .param string description :optional
+
+ .local pmc test
+ get_hll_global test, [ 'Test'; 'More' ], '_test'
+
+ .local pmc comp
+ .local pmc compfun
+ .local pmc compiler
+ compiler = compreg 'PIR'
+
+ .local pmc eh
+ eh = new 'ExceptionHandler'
+ set_addr eh, handler # set handler label for exceptions
+ push_eh eh
+
+ compfun = compiler(target)
+ compfun() # eval the target code
+
+ pop_eh
+
+ # if it doesn't throw an exception, fail
+ test.'ok'( 0, description )
+ test.'diag'( 'no error thrown' )
+
+ goto done
+
+ handler:
+ .local pmc ex
+ .local string error_msg
+ .get_results (ex)
+ pop_eh
+ error_msg = ex
+ like(error_msg, pattern, description)
+
+ done:
+.end
+
=item C<like( target, pattern, description )>
Similar to is, but using the Parrot Grammar Engine to compare the string
@@ -854,7 +902,11 @@
match_success:
goto pass_it
match_fail:
- diagnostic = "match failed"
+ diagnostic = "match failed: target '"
+ diagnostic .= target
+ diagnostic .= "' does not match pattern '"
+ diagnostic .= pattern
+ diagnostic .= "'"
goto report
rule_fail:
diagnostic = "rule error"
@@ -995,7 +1047,7 @@
=head1 COPYRIGHT
-Copyright (C) 2005-2008, Parrot Foundation.
+Copyright (C) 2005-2009, Parrot Foundation.
=cut
Modified: branches/gc-refactor/src/call/context.c
==============================================================================
--- branches/gc-refactor/src/call/context.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/call/context.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -8,16 +8,64 @@
=head1 DESCRIPTION
-=head2 Functions
-
-=over 4
-
=cut
*/
#include "parrot/parrot.h"
#include "parrot/call.h"
+#include "../pmc/pmc_sub.h"
+
+/* set CTX_LEAK_DEBUG_FULL to 1 for enhanced context debugging.
+ * When set (1) freed contexts are "poisoned" so that any dangling
+ * references produce segfaults, and (2) contexts are not recycled
+ * so that later allocations don't suddenly restore a dangling
+ * reference to a "working" condition.
+ */
+#define CTX_LEAK_DEBUG_FULL 0
+
+/*
+
+=head2 Context and register frame layout
+
+ +----------++----+------+------------+----+
+ | context || N | I | P | S +
+ +----------++----+------+------------+----+
+ ^ ^ ^ ^
+ | | ctx.bp ctx.bp_ps
+ ctx.state opt
+ padding
+
+Registers are addressed as usual via the register base pointer ctx.bp.
+
+The macro CONTEXT() hides these details
+
+=cut
+
+*/
+
+#define ALIGNED_CTX_SIZE (((sizeof (Parrot_Context) + NUMVAL_SIZE - 1) \
+ / NUMVAL_SIZE) * NUMVAL_SIZE)
+
+/*
+
+=head2 Allocation Size
+
+Round register allocation size up to the nearest multiple of 8. A granularity
+of 8 is arbitrary, it could have been some bigger power of 2. A "slot" is an
+index into the free_list array. Each slot in free_list has a linked list of
+pointers to already allocated contexts available for (re)use. The slot where
+an available context is stored corresponds to the size of the context.
+
+=cut
+
+*/
+
+#define SLOT_CHUNK_SIZE 8
+
+#define ROUND_ALLOC_SIZE(size) ((((size) + SLOT_CHUNK_SIZE - 1) \
+ / SLOT_CHUNK_SIZE) * SLOT_CHUNK_SIZE)
+#define CALCULATE_SLOT_NUM(size) ((size) / SLOT_CHUNK_SIZE)
/* HEADERIZER HFILE: include/parrot/call.h */
@@ -25,11 +73,33 @@
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+static void clear_regs(PARROT_INTERP, ARGMOD(PMC *pmcctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*pmcctx);
+
+static void init_context(PARROT_INTERP,
+ ARGMOD(PMC *pmcctx),
+ ARGIN_NULLOK(PMC *pmcold))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*pmcctx);
+
+#define ASSERT_ARGS_clear_regs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pmcctx)
+#define ASSERT_ARGS_init_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pmcctx)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
/*
+=head2 Context API Functions
+
+=over 4
+
=item C<void Parrot_pcc_set_constants(PARROT_INTERP, PMC *ctx, struct
PackFile_Constant **constants)>
@@ -943,6 +1013,589 @@
=back
+=head2 Context and Register Allocation Functions
+
+=over 4
+
+=item C<void create_initial_context(PARROT_INTERP)>
+
+Creates the interpreter's initial context.
+
+=cut
+
+*/
+
+void
+create_initial_context(PARROT_INTERP)
+{
+ ASSERT_ARGS(create_initial_context)
+ static INTVAL num_regs[] = {32, 32, 32, 32};
+ PMC *ignored;
+
+ /* Create some initial free_list slots. */
+
+#define INITIAL_FREE_SLOTS 8
+ /* 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);
+ UNUSED(ignored);
+}
+
+
+/*
+
+=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
+values, for debugging purposes.
+
+=cut
+
+*/
+
+static void
+clear_regs(PARROT_INTERP, ARGMOD(PMC *pmcctx))
+{
+ ASSERT_ARGS(clear_regs)
+ UINTVAL i;
+ Parrot_Context *ctx = Parrot_pcc_get_context_struct(interp, pmcctx);
+
+ /* NULL out registers - P/S have to be NULL for GC
+ *
+ * if the architecture has 0x := NULL and 0.0 we could memset too
+ */
+
+ for (i = 0; i < ctx->n_regs_used[REGNO_PMC]; i++) {
+ ctx->bp_ps.regs_p[-1L - i] = PMCNULL;
+ }
+
+ for (i = 0; i < ctx->n_regs_used[REGNO_STR]; i++) {
+ ctx->bp_ps.regs_s[i] = NULL;
+ }
+
+ if (Interp_debug_TEST(interp, PARROT_REG_DEBUG_FLAG)) {
+ /* depending on -D40, set int and num to identifiable garbage values */
+ for (i = 0; i < ctx->n_regs_used[REGNO_INT]; i++) {
+ ctx->bp.regs_i[i] = -999;
+ }
+
+ for (i = 0; i < ctx->n_regs_used[REGNO_NUM]; i++) {
+ ctx->bp.regs_n[-1L - i] = -99.9;
+ }
+ }
+}
+
+
+/*
+
+=item C<static void init_context(PARROT_INTERP, PMC *pmcctx, PMC *pmcold)>
+
+Initializes a freshly allocated or recycled context.
+
+=cut
+
+*/
+
+static void
+init_context(PARROT_INTERP, ARGMOD(PMC *pmcctx), ARGIN_NULLOK(PMC *pmcold))
+{
+ ASSERT_ARGS(init_context)
+ 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;
+ ctx->outer_ctx = NULL;
+ ctx->current_cont = NULL;
+ ctx->current_object = NULL;
+ ctx->handlers = PMCNULL;
+ ctx->caller_ctx = NULL;
+ ctx->pred_offset = 0;
+
+ if (old) {
+ /* some items should better be COW copied */
+ ctx->constants = old->constants;
+ ctx->warns = old->warns;
+ ctx->errors = old->errors;
+ ctx->trace_flags = old->trace_flags;
+ ctx->pred_offset = old->pred_offset;
+ ctx->current_HLL = old->current_HLL;
+ ctx->current_namespace = old->current_namespace;
+ /* end COW */
+ ctx->recursion_depth = old->recursion_depth;
+ }
+ else {
+ ctx->constants = NULL;
+ ctx->warns = 0;
+ ctx->errors = 0;
+ ctx->trace_flags = 0;
+ ctx->pred_offset = 0;
+ ctx->current_HLL = 0;
+ ctx->current_namespace = PMCNULL;
+ ctx->recursion_depth = 0;
+ }
+
+ /* other stuff is set inside Sub.invoke */
+ clear_regs(interp, pmcctx);
+}
+
+
+/*
+
+=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>.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+PMC *
+Parrot_push_context(PARROT_INTERP, ARGIN(const INTVAL *n_regs_used))
+{
+ ASSERT_ARGS(Parrot_push_context)
+ PMC * const old = CURRENT_CONTEXT(interp);
+ PMC * const ctx = Parrot_set_new_context(interp, n_regs_used);
+
+ Parrot_pcc_set_caller_ctx(interp, ctx, old);
+
+ /* doesn't change */
+ Parrot_pcc_set_sub(interp, ctx, Parrot_pcc_get_sub(interp, old));
+
+ /* copy more ? */
+ return ctx;
+}
+
+
+/*
+
+=item C<void Parrot_pop_context(PARROT_INTERP)>
+
+Frees the context created with C<Parrot_push_context> and restores the previous
+context (the caller context).
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pop_context(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_pop_context)
+ PMC * const ctx = CURRENT_CONTEXT(interp);
+ PMC * const old = Parrot_pcc_get_caller_ctx(interp, ctx);
+
+ /* restore old, set cached interpreter base pointers */
+ CURRENT_CONTEXT(interp) = old;
+}
+
+/*
+
+=item C<size_t Parrot_pcc_calculate_context_size(PARROT_INTERP, const UINTVAL
+*number_regs_used)>
+
+Calculate size of Context.
+
+=cut
+
+*/
+size_t
+Parrot_pcc_calculate_context_size(SHIM_INTERP, ARGIN(const UINTVAL *number_regs_used))
+{
+ ASSERT_ARGS(Parrot_pcc_calculate_context_size)
+
+ return ALIGNED_CTX_SIZE + ROUND_ALLOC_SIZE(
+ sizeof (INTVAL) * number_regs_used[REGNO_INT] +
+ sizeof (FLOATVAL) * number_regs_used[REGNO_NUM] +
+ sizeof (STRING *) * number_regs_used[REGNO_STR] +
+ sizeof (PMC *) * number_regs_used[REGNO_PMC]);
+}
+
+/*
+
+=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
+the init flag to indicate whether you want to initialize the new context
+(setting its default values and clearing its registers).
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+PMC *
+Parrot_alloc_context(PARROT_INTERP, ARGIN(const INTVAL *number_regs_used),
+ ARGIN_NULLOK(PMC *old))
+{
+ ASSERT_ARGS(Parrot_alloc_context)
+ PMC *pmcctx;
+ Parrot_Context *ctx;
+ void *p;
+
+ const size_t size_i = sizeof (INTVAL) * number_regs_used[REGNO_INT];
+ const size_t size_n = sizeof (FLOATVAL) * number_regs_used[REGNO_NUM];
+ const size_t size_s = sizeof (STRING *) * number_regs_used[REGNO_STR];
+ const size_t size_p = sizeof (PMC *) * number_regs_used[REGNO_PMC];
+
+ 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 size_t to_alloc = reg_alloc + ALIGNED_CTX_SIZE;
+
+#ifdef GC_USE_FIXED_SIZE_ALLOCATOR
+ ctx = (Parrot_Context *)Parrot_gc_allocate_fixed_size_storage(interp, to_alloc);
+#else
+ ctx = (Parrot_Context *)mem_sys_allocate(to_alloc);
+#endif
+
+ 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];
+
+ /* regs start past the context */
+ p = (void *) ((char *)ctx + ALIGNED_CTX_SIZE);
+
+ /* ctx.bp points to I0, which has Nx on the left */
+ ctx->bp.regs_i = (INTVAL *)((char *)p + size_n);
+
+ /* ctx.bp_ps points to S0, which has Px on the left */
+ ctx->bp_ps.regs_s = (STRING **)((char *)p + size_nip);
+
+ pmcctx = pmc_new(interp, enum_class_Context);
+ VTABLE_set_pointer(interp, pmcctx, ctx);
+
+ init_context(interp, pmcctx, old);
+
+ return pmcctx;
+}
+
+
+/*
+
+=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
+register usage C<n_regs_used> is copied.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+PMC *
+Parrot_set_new_context(PARROT_INTERP, ARGIN(const INTVAL *number_regs_used))
+{
+ ASSERT_ARGS(Parrot_set_new_context)
+ PMC *old = CURRENT_CONTEXT(interp);
+ PMC *ctx = Parrot_alloc_context(interp, number_regs_used, old);
+
+ CURRENT_CONTEXT(interp) = ctx;
+
+ return ctx;
+}
+
+
+/*
+
+=back
+
+=head2 Register Stack Functions
+
+=over 4
+
+=cut
+
+=item C<void Parrot_clear_i(PARROT_INTERP)>
+
+Sets all integer registers in the current context to 0.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_clear_i(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_clear_i)
+ UINTVAL i;
+ for (i = 0; i < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_INT); ++i)
+ REG_INT(interp, i) = 0;
+}
+
+
+/*
+
+=item C<void Parrot_clear_s(PARROT_INTERP)>
+
+Sets all STRING registers in the current context to NULL.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_clear_s(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_clear_s)
+ UINTVAL i;
+ for (i = 0; i < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_STR); ++i)
+ REG_STR(interp, i) = NULL;
+}
+
+
+/*
+
+=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)
+ UINTVAL 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_clear_n(PARROT_INTERP)>
+
+Sets all number registers in the current context to 0.0.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_clear_n(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_clear_n)
+ UINTVAL i;
+ for (i = 0; i < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), REGNO_NUM); ++i)
+ REG_NUM(interp, i) = 0.0;
+}
+
+/*
+
+=item C<INTVAL * Parrot_pcc_get_INTVAL_reg(PARROT_INTERP, PMC *ctx, UINTVAL
+idx)>
+
+Get pointer to INTVAL register.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+INTVAL *
+Parrot_pcc_get_INTVAL_reg(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL idx)
+{
+ ASSERT_ARGS(Parrot_pcc_get_INTVAL_reg)
+ PARROT_ASSERT(Parrot_pcc_get_regs_used(interp, ctx, REGNO_INT) > idx);
+ return &(Parrot_pcc_get_context_struct(interp, ctx)->bp.regs_i[idx]);
+}
+
+/*
+
+=item C<FLOATVAL * Parrot_pcc_get_FLOATVAL_reg(PARROT_INTERP, PMC *ctx, UINTVAL
+idx)>
+
+Get pointer to FLOATVAL register.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+FLOATVAL *
+Parrot_pcc_get_FLOATVAL_reg(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL idx)
+{
+ ASSERT_ARGS(Parrot_pcc_get_FLOATVAL_reg)
+ PARROT_ASSERT(Parrot_pcc_get_regs_used(interp, ctx, REGNO_NUM) > idx);
+ return &(Parrot_pcc_get_context_struct(interp, ctx)->bp.regs_n[-1L - idx]);
+}
+
+/*
+
+=item C<STRING ** Parrot_pcc_get_STRING_reg(PARROT_INTERP, PMC *ctx, UINTVAL
+idx)>
+
+Get pointer to STRING register.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+STRING **
+Parrot_pcc_get_STRING_reg(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL idx)
+{
+ ASSERT_ARGS(Parrot_pcc_get_STRING_reg)
+ PARROT_ASSERT(Parrot_pcc_get_regs_used(interp, ctx, REGNO_STR) > idx);
+ 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, UINTVAL idx)>
+
+Get pointer to PMC register.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PMC **
+Parrot_pcc_get_PMC_reg(PARROT_INTERP, ARGIN(PMC *ctx), UINTVAL idx)
+{
+ ASSERT_ARGS(Parrot_pcc_get_PMC_reg)
+ PARROT_ASSERT(Parrot_pcc_get_regs_used(interp, ctx, REGNO_PMC) > idx);
+ return &(Parrot_pcc_get_context_struct(interp, ctx)->bp_ps.regs_p[-1L - idx]);
+}
+
+/*
+
+=item C<UINTVAL Parrot_pcc_get_regs_used(PARROT_INTERP, PMC *ctx, int type)>
+
+Return number of used registers of particular type.
+
+=cut
+
+*/
+PARROT_EXPORT
+UINTVAL
+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_pcc_set_regs_used(PARROT_INTERP, ARGIN(PMC *ctx), int type, INTVAL num)
+{
+ ASSERT_ARGS(Parrot_pcc_set_regs_used)
+ Parrot_pcc_get_context_struct(interp, ctx)->n_regs_used[type] = num;
+}
+
+/*
+
+=item C<Regs_ni* Parrot_pcc_get_regs_ni(PARROT_INTERP, PMC *ctx)>
+
+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_pcc_set_regs_ni(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN(Regs_ni *bp))
+{
+ 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/gc-refactor/src/call/ops.c
==============================================================================
--- branches/gc-refactor/src/call/ops.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/call/ops.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -251,7 +251,7 @@
if (*sig_p && (dest[0] == PARROT_OP_get_params_pc
|| (sub->vtable->base_type == enum_class_ExceptionHandler
- && PMC_cont(sub)->current_results))) {
+ && PARROT_CONTINUATION(sub)->current_results))) {
dest = parrot_pass_args_fromc(interp, sig_p, dest, old_ctx, ap);
}
Modified: branches/gc-refactor/src/call/pcc.c
==============================================================================
--- branches/gc-refactor/src/call/pcc.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/call/pcc.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -19,6 +19,7 @@
#include "parrot/parrot.h"
#include "parrot/oplib/ops.h"
+#include "parrot/runcore_api.h"
#include "pcc.str"
#include "../pmc/pmc_key.h"
#include "../pmc/pmc_continuation.h"
@@ -511,7 +512,7 @@
/* 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 */
if (SUB_FLAG_TAILCALL_ISSET(current_cont))
- ctx = PMC_cont(current_cont)->to_ctx;
+ ctx = PARROT_CONTINUATION(current_cont)->to_ctx;
/* TODO simplify all */
Parrot_init_arg_sig(interp, CURRENT_CONTEXT(interp), sig, NULL, &st->src);
@@ -1194,22 +1195,28 @@
for (; key; key = VTABLE_shift_pmc(interp, key)) {
/* register keys have to be cloned */
if (PObj_get_FLAGS(key) & KEY_register_FLAG) {
+ INTVAL n_regs_used[4];
Regs_ni bp;
Regs_ps bp_ps;
/* clone sets key values according to refered register items */
bp = *Parrot_pcc_get_regs_ni(interp, CURRENT_CONTEXT(interp));
bp_ps = *Parrot_pcc_get_regs_ps(interp, CURRENT_CONTEXT(interp));
+ memcpy(n_regs_used, CONTEXT(interp)->n_regs_used, 4 * sizeof (INTVAL));
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));
+ memcpy(CONTEXT(interp)->n_regs_used,
+ Parrot_pcc_get_context_struct(interp, st->src.ctx),
+ 4 * sizeof (INTVAL));
UVal_pmc(st->val) = VTABLE_clone(interp, key);
Parrot_pcc_set_regs_ni(interp, CURRENT_CONTEXT(interp), &bp);
Parrot_pcc_set_regs_ps(interp, CURRENT_CONTEXT(interp), &bp_ps);
+ memcpy(CONTEXT(interp)->n_regs_used, n_regs_used, 4 * sizeof (INTVAL));
return;
}
@@ -3017,17 +3024,15 @@
/* Invoke the function */
dest = VTABLE_invoke(interp, sub_obj, NULL);
- /* PIR Subs need runops to run their opcodes. Methods and NCI subs
- * don't. */
+ /* PIR Subs need runops to run their opcodes. Methods and NCI subs don't. */
if (sub_obj->vtable->base_type == enum_class_Sub
- && PMC_IS_NULL(interp->current_object)) {
- const INTVAL old_core = interp->run_core;
- const opcode_t offset = dest - interp->code->base.data;
+ && PMC_IS_NULL(interp->current_object)) {
+ Parrot_runcore_t *old_core = interp->run_core;
+ const opcode_t offset = dest - interp->code->base.data;
/* can't re-enter the runloop from here with PIC cores: RT #60048 */
- if (interp->run_core == PARROT_CGP_CORE
- || interp->run_core == PARROT_SWITCH_CORE)
- interp->run_core = PARROT_SLOW_CORE;
+ if (PARROT_RUNCORE_PREDEREF_OPS_TEST(interp->run_core))
+ Parrot_runcore_switch(interp, CONST_STRING(interp, "slow"));
runops(interp, offset);
interp->run_core = old_core;
Modified: branches/gc-refactor/src/debug.c
==============================================================================
--- branches/gc-refactor/src/debug.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/debug.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -117,6 +117,11 @@
PARROT_WARN_UNUSED_RESULT
static const char * nextarg(ARGIN_NULLOK(const char *command));
+static void no_such_register(PARROT_INTERP,
+ char register_type,
+ UINTVAL register_num)
+ __attribute__nonnull__(1);
+
PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
static const char * parse_int(ARGIN(const char *str), ARGOUT(int *intP))
@@ -178,6 +183,8 @@
#define ASSERT_ARGS_list_breakpoints __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(pdb)
#define ASSERT_ARGS_nextarg __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
+#define ASSERT_ARGS_no_such_register __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_parse_int __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(str) \
|| PARROT_ASSERT_ARG(intP)
@@ -207,7 +214,7 @@
if (*skip_whitespace(cmd) == '\0')
return 1;
else {
- Parrot_eprintf(pdb->debugger, "Spurious arg\n");
+ Parrot_io_eprintf(pdb->debugger, "Spurious arg\n");
return 0;
}
}
@@ -1239,7 +1246,7 @@
} while (*ptr == '\0' || *ptr == '#');
if (pdb->state & PDB_ECHO)
- Parrot_eprintf(pdb->debugger, "[%lu %s]\n", pdb->script_line, buf);
+ Parrot_io_eprintf(pdb->debugger, "[%lu %s]\n", pdb->script_line, buf);
#if TRACE_DEBUGGER
fprintf(stderr, "(script) %s\n", buf);
@@ -1436,12 +1443,13 @@
new_runloop_jump_point(debugee);
if (setjmp(debugee->current_runloop->resume)) {
- Parrot_eprintf(pdb->debugger, "Unhandled exception while tracing\n");
+ Parrot_io_eprintf(pdb->debugger, "Unhandled exception while tracing\n");
pdb->state |= PDB_STOPPED;
return;
}
+
pdb->tracing = n;
- pdb->debugee->run_core = PARROT_DEBUGGER_CORE;
+ Parrot_runcore_switch(pdb->debugee, CONST_STRING(interp, "debugger"));
TRACEDEB_MSG("PDB_next finished");
}
@@ -1482,13 +1490,13 @@
/* execute n ops */
new_runloop_jump_point(debugee);
if (setjmp(debugee->current_runloop->resume)) {
- Parrot_eprintf(pdb->debugger, "Unhandled exception while tracing\n");
+ Parrot_io_eprintf(pdb->debugger, "Unhandled exception while tracing\n");
pdb->state |= PDB_STOPPED;
return;
}
pdb->tracing = n;
- pdb->debugee->run_core = PARROT_DEBUGGER_CORE;
- pdb->state |= PDB_TRACING;
+ pdb->state |= PDB_TRACING;
+ Parrot_runcore_switch(pdb->debugee, CONST_STRING(interp, "debugger"));
/* Clear the following when done some testing */
@@ -1956,11 +1964,12 @@
*/
#if 0
- pdb->tracing = 0;
- pdb->debugee->run_core = PARROT_DEBUGGER_CORE;
+ pdb->tracing = 0;
+ Parrot_runcore_switch(pdb->debugee, CONST_STRING(interp, "debugger"));
+
new_internal_exception(pdb->debugee);
if (setjmp(pdb->debugee->exceptions->destination)) {
- Parrot_eprintf(pdb->debugee, "Unhandled exception while debugging: %Ss\n",
+ Parrot_io_eprintf(pdb->debugee, "Unhandled exception while debugging: %Ss\n",
pdb->debugee->exceptions->msg);
pdb->state |= PDB_STOPPED;
return;
@@ -3183,6 +3192,26 @@
/*
+=item C<static void no_such_register(PARROT_INTERP, char register_type, UINTVAL
+register_num)>
+
+Auxiliar error message function.
+
+=cut
+
+*/
+
+static void
+no_such_register(PARROT_INTERP, char register_type, UINTVAL register_num)
+{
+ ASSERT_ARGS(no_such_register)
+
+ Parrot_io_eprintf(interp, "%c%u = no such register\n",
+ register_type, register_num);
+}
+
+/*
+
=item C<void PDB_assign(PARROT_INTERP, const char *command)>
Assign to registers.
@@ -3195,43 +3224,59 @@
PDB_assign(PARROT_INTERP, ARGIN(const char *command))
{
ASSERT_ARGS(PDB_assign)
- unsigned long register_num;
- char reg_type;
- char *string;
- int t;
+ UINTVAL register_num;
+ char reg_type_id;
+ int reg_type;
+ PDB_t *pdb = interp->pdb;
+ Interp *debugger = pdb ? pdb->debugger : interp;
+ Interp *debugee = pdb ? pdb->debugee : interp;
/* smallest valid commad length is 4, i.e. "I0 1" */
if (strlen(command) < 4) {
- fprintf(stderr, "Must give a register number and value to assign\n");
+ Parrot_io_eprintf(debugger, "Must give a register number and value to assign\n");
return;
}
- reg_type = (char) command[0];
+ reg_type_id = (char) command[0];
command++;
- register_num = get_ulong(&command, 0);
+ register_num = get_ulong(&command, 0);
- switch (reg_type) {
+ switch (reg_type_id) {
case 'I':
- t = REGNO_INT;
- IREG(register_num) = get_ulong(&command, 0);
- break;
+ reg_type = REGNO_INT;
+ break;
case 'N':
- t = REGNO_NUM;
- NREG(register_num) = atof(command);
- break;
+ reg_type = REGNO_NUM;
+ break;
case 'S':
- t = REGNO_STR;
- SREG(register_num) = Parrot_str_new(interp, command, strlen(command));
- break;
+ reg_type = REGNO_STR;
+ break;
case 'P':
- t = REGNO_PMC;
- fprintf(stderr, "Assigning to PMCs is not currently supported\n");
- return;
+ reg_type = REGNO_PMC;
+ Parrot_io_eprintf(debugger, "Assigning to PMCs is not currently supported\n");
+ return;
default:
- fprintf(stderr, "Invalid register type %c\n", reg_type);
+ Parrot_io_eprintf(debugger, "Invalid register type %c\n", reg_type_id);
return;
}
- Parrot_io_eprintf(interp, "\n %c%u = ", reg_type, register_num);
- Parrot_io_eprintf(interp, "%s\n", GDB_print_reg(interp, t, register_num));
+ if (register_num >= Parrot_pcc_get_regs_used(debugee,
+ CURRENT_CONTEXT(debugee), reg_type)) {
+ no_such_register(debugger, reg_type_id, register_num);
+ return;
+ }
+ switch (reg_type) {
+ case REGNO_INT:
+ IREG(register_num) = get_ulong(&command, 0);
+ break;
+ case REGNO_NUM:
+ NREG(register_num) = atof(command);
+ break;
+ case REGNO_STR:
+ SREG(register_num) = Parrot_str_new(debugee, command, strlen(command));
+ break;
+ default: ; /* Must never come here */
+ }
+ Parrot_io_eprintf(debugger, "\n %c%u = ", reg_type_id, register_num);
+ Parrot_io_eprintf(debugger, "%s\n", GDB_print_reg(debugee, reg_type, register_num));
}
/*
@@ -3323,7 +3368,7 @@
interp->pdb->debugger : interp;
TRACEDEB_MSG("PDB_eval");
UNUSED(command);
- Parrot_eprintf(warninterp, "The eval command is currently unimplemeneted\n");
+ Parrot_io_eprintf(warninterp, "The eval command is currently unimplemeneted\n");
}
/*
@@ -3539,13 +3584,13 @@
/* backtrace: follow the continuation chain */
while (1) {
- Parrot_cont *sub_cont;
+ Parrot_Continuation_attributes *sub_cont;
sub = Parrot_pcc_get_continuation(interp, ctx);
if (PMC_IS_NULL(sub))
break;
- sub_cont = PMC_cont(sub);
+ sub_cont = PARROT_CONTINUATION(sub);
if (!sub_cont)
break;
@@ -3592,7 +3637,7 @@
}
/* get the next Continuation */
- ctx = PMC_cont(sub)->to_ctx;
+ ctx = PARROT_CONTINUATION(sub)->to_ctx;
old = sub;
if (!ctx)
@@ -3634,7 +3679,7 @@
ASSERT_ARGS(GDB_print_reg)
char * string;
- if (n >= 0 && n < Parrot_pcc_get_regs_used(interp, CURRENT_CONTEXT(interp), t)) {
+ if (n >= 0 && (UINTVAL)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;
Modified: branches/gc-refactor/src/dynext.c
==============================================================================
--- branches/gc-refactor/src/dynext.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/dynext.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -428,6 +428,13 @@
void (*init_func)(PARROT_INTERP, PMC *);
PMC *lib_pmc;
+ INTVAL regs_used[] = { 2, 2, 2, 2 }; /* Arbitrary values */
+ const int parrot_hll_id = 0;
+ PMC * context = Parrot_push_context(interp, regs_used);
+ Parrot_pcc_set_HLL(interp, context, parrot_hll_id);
+ Parrot_pcc_set_namespace(interp, context,
+ Parrot_get_HLL_namespace(interp, parrot_hll_id));
+
/*
* work around gcc 3.3.3 and other problem with dynpmcs
* something during library loading doesn't stand a GC run
@@ -475,6 +482,8 @@
/* UNLOCK */
Parrot_unblock_GC_mark(interp);
+ Parrot_pop_context(interp);
+
return lib_pmc;
}
Modified: branches/gc-refactor/src/embed.c
==============================================================================
--- branches/gc-refactor/src/embed.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/embed.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -22,6 +22,7 @@
#include "parrot/embed.h"
#include "parrot/oplib/ops.h"
#include "pmc/pmc_sub.h"
+#include "parrot/runcore_api.h"
#include "../compilers/imcc/imc.h"
@@ -30,9 +31,6 @@
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-static FLOATVAL calibrate(PARROT_INTERP)
- __attribute__nonnull__(1);
-
PARROT_CANNOT_RETURN_NULL
PARROT_OBSERVER
static const char * op_name(PARROT_INTERP, int k)
@@ -44,16 +42,6 @@
static void print_debug(PARROT_INTERP, SHIM(int status), SHIM(void *p))
__attribute__nonnull__(1);
-static void print_profile(PARROT_INTERP, SHIM(int status), SHIM(void *p))
- __attribute__nonnull__(1);
-
-static int prof_sort_f(ARGIN(const void *a), ARGIN(const void *b))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-static void runcode_print_start_info(PARROT_INTERP)
- __attribute__nonnull__(1);
-
PARROT_CANNOT_RETURN_NULL
static PMC* set_current_sub(PARROT_INTERP)
__attribute__nonnull__(1);
@@ -63,21 +51,12 @@
__attribute__nonnull__(1)
__attribute__nonnull__(3);
-#define ASSERT_ARGS_calibrate __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_op_name __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_print_constant_table __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_print_debug __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_print_profile __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_prof_sort_f __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(a) \
- || PARROT_ASSERT_ARG(b)
-#define ASSERT_ARGS_runcode_print_start_info __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_set_current_sub __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_setup_argv __attribute__unused__ int _ASSERT_ARGS_CHECK = \
@@ -172,7 +151,7 @@
switch (flag) {
case PARROT_BOUNDS_FLAG:
case PARROT_PROFILE_FLAG:
- Interp_core_SET(interp, PARROT_SLOW_CORE);
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "slow"));
break;
default:
break;
@@ -235,7 +214,7 @@
Parrot_set_trace(PARROT_INTERP, UINTVAL flag)
{
Parrot_pcc_trace_flags_on(interp, interp->ctx, flag);
- Interp_core_SET(interp, PARROT_SLOW_CORE);
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "slow"));
}
@@ -361,7 +340,47 @@
void
Parrot_set_run_core(PARROT_INTERP, Parrot_Run_core_t core)
{
- Interp_core_SET(interp, core);
+ switch (core) {
+ case PARROT_SLOW_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "slow"));
+ break;
+ case PARROT_FAST_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "fast"));
+ break;
+ case PARROT_SWITCH_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "switch"));
+ break;
+ case PARROT_CGP_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "cgp"));
+ break;
+ case PARROT_CGOTO_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "cgoto"));
+ break;
+ case PARROT_JIT_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "jit"));
+ break;
+ case PARROT_CGP_JIT_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "cgp_jit"));
+ break;
+ case PARROT_SWITCH_JIT_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "switch_jit"));
+ break;
+ case PARROT_EXEC_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "exec"));
+ break;
+ case PARROT_GC_DEBUG_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "gc_debug"));
+ break;
+ case PARROT_DEBUGGER_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "debugger"));
+ break;
+ case PARROT_PROFILING_CORE:
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "profiling"));
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
+ "Invalid runcore requested\n");
+ }
}
@@ -665,33 +684,6 @@
/*
-=item C<static int prof_sort_f(const void *a, const void *b)>
-
-Sort function for profile data, by time.
-
-=cut
-
-*/
-
-static int
-prof_sort_f(ARGIN(const void *a), ARGIN(const void *b))
-{
- ASSERT_ARGS(prof_sort_f)
- const FLOATVAL timea = ((const ProfData *)a)->time;
- const FLOATVAL timeb = ((const ProfData *)b)->time;
-
- if (timea < timeb)
- return 1;
-
- if (timea > timeb)
- return -1;
-
- return 0;
-}
-
-
-/*
-
=item C<static const char * op_name(PARROT_INTERP, int k)>
Returns the name of the opcode.
@@ -706,140 +698,7 @@
op_name(PARROT_INTERP, int k)
{
ASSERT_ARGS(op_name)
- switch (k) {
- case PARROT_PROF_GC_p1:
- return "GC_mark_root";
- case PARROT_PROF_GC_p2:
- return "GC_mark_next";
- case PARROT_PROF_GC_cp:
- return "GC_collect_PMC";
- case PARROT_PROF_GC_cb:
- return "GC_collect_buffers";
- case PARROT_PROF_GC:
- return "GC";
- case PARROT_PROF_EXCEPTION:
- return "EXCEPTION";
- default:
- break;
- }
-
- return interp->op_info_table[k - PARROT_PROF_EXTRA].full_name;
-}
-
-
-/*
-
-=item C<static FLOATVAL calibrate(PARROT_INTERP)>
-
-With this calibration, reported times of C<parrot -p> almost match those
-measured with time C<parrot -R bounds>.
-
-=cut
-
-*/
-
-static FLOATVAL
-calibrate(PARROT_INTERP)
-{
- ASSERT_ARGS(calibrate)
- opcode_t code[] = { 1 }; /* noop */
- opcode_t *pc = code;
- const size_t count = 1000000;
- size_t n = count;
- const FLOATVAL start = Parrot_floatval_time();
- FLOATVAL now = start;
-
- /* op timing isn't free; it requires at least one time fetch per op */
- for (; n; --n) {
- pc = (interp->op_func_table[*code])(pc, interp);
- now = Parrot_floatval_time();
- }
-
- return (now - start) / (FLOATVAL) count;
-}
-
-
-/*
-
-=item C<static void print_profile(PARROT_INTERP, int status, void *p)>
-
-Prints out a profile listing.
-
-=cut
-
-*/
-
-static void
-print_profile(PARROT_INTERP, SHIM(int status), SHIM(void *p))
-{
- ASSERT_ARGS(print_profile)
- RunProfile * const profile = interp->profile;
-
- if (profile) {
- UINTVAL j;
- int k, jit;
- UINTVAL op_count = 0;
- UINTVAL call_count = 0;
- FLOATVAL sum_time = 0.0;
- const FLOATVAL empty = calibrate(interp);
-
- Parrot_io_printf(interp,
- "Calibration: overhead = %.6f ms/op\n", 1000.0 * empty);
-
- Parrot_io_printf(interp,
- " Code J Name "
- "Calls Total/s Avg/ms\n");
-
- for (j = 0; j < interp->op_count + PARROT_PROF_EXTRA; j++) {
- const UINTVAL n = profile->data[j].numcalls;
- profile->data[j].op = j;
-
- if (j >= PARROT_PROF_EXTRA) {
- profile->data[j].time -= empty * n;
-
- /* faster than noop */
- if (profile->data[j].time < 0.0)
- profile->data[j].time = 0.0;
- }
- }
-
- qsort(profile->data, interp->op_count + PARROT_PROF_EXTRA,
- sizeof (ProfData), prof_sort_f);
-
- for (j = 0; j < interp->op_count + PARROT_PROF_EXTRA; j++) {
- const UINTVAL n = profile->data[j].numcalls;
-
- if (n > 0) {
- const FLOATVAL t = profile->data[j].time;
-
- op_count++;
- call_count += n;
- sum_time += t;
-
- k = profile->data[j].op;
- jit = '-';
-#if JIT_CAPABLE
- if (k >= PARROT_PROF_EXTRA &&
- op_jit[k - PARROT_PROF_EXTRA].extcall != 1)
- jit = 'j';
-#endif
- Parrot_io_printf(interp, " %4d %c %-25s %8vu %10vf %10.6vf\n",
- k - PARROT_PROF_EXTRA,
- jit,
- op_name(interp, k),
- n,
- t,
- (FLOATVAL)(t * 1000.0 / (FLOATVAL)n));
- }
- }
-
- Parrot_io_printf(interp, " %4vu - %-25s %8vu %10vf %10.6vf\n",
- op_count,
- "-",
- call_count,
- sum_time,
- (FLOATVAL)(sum_time * 1000.0 / (FLOATVAL)call_count));
- }
+ return interp->op_info_table[k].full_name;
}
@@ -948,8 +807,18 @@
PMC *userargv, *main_sub;
/* Debugging mode nonsense. */
- if (Interp_debug_TEST(interp, PARROT_START_DEBUG_FLAG))
- runcode_print_start_info(interp);
+ if (Interp_debug_TEST(interp, PARROT_START_DEBUG_FLAG)) {
+ if (Interp_flags_TEST(interp, PARROT_BOUNDS_FLAG)) {
+ Parrot_io_eprintf(interp,
+ "*** Parrot VM: Bounds checking enabled. ***\n");
+ }
+
+ if (Interp_trace_TEST(interp, PARROT_TRACE_OPS_FLAG))
+ Parrot_io_eprintf(interp, "*** Parrot VM: Tracing enabled. ***\n");
+
+ Parrot_io_eprintf(interp, "*** Parrot VM: %Ss core ***\n",
+ interp->run_core->name);
+ }
/* Set up @ARGS (or whatever this language calls it) in userargv. */
userargv = setup_argv(interp, argc, argv);
@@ -957,7 +826,8 @@
#if EXEC_CAPABLE
/* s. runops_exec interpreter.c */
- if (Interp_core_TEST(interp, PARROT_EXEC_CORE))
+ if (Parrot_str_equal(interp, interp->run_core->name,
+ Parrot_str_new_constant(interp, "exec")))
Parrot_exec_run = 1;
#endif
@@ -967,7 +837,6 @@
* before exiting, then print debug infos if turned on.
*/
Parrot_on_exit(interp, print_debug, NULL);
- Parrot_on_exit(interp, print_profile, NULL);
/* Let's kick the tires and light the fires--call interpreter.c:runops. */
main_sub = Parrot_pcc_get_sub(interp, CURRENT_CONTEXT(interp));
@@ -1290,60 +1159,6 @@
return NULL;
}
-/*
-
-=item C<static void runcode_print_start_info(PARROT_INTERP)>
-
-Show runcore info at stat,
-
-=cut
-
-*/
-
-static void
-runcode_print_start_info(PARROT_INTERP)
-{
- ASSERT_ARGS(runcode_print_start_info)
-
- const char * corename;
-
- Parrot_io_eprintf(interp,
- "*** Parrot VM: Setting stack top. ***\n");
-
- if (Interp_flags_TEST(interp, PARROT_BOUNDS_FLAG)) {
- Parrot_io_eprintf(interp,
- "*** Parrot VM: Bounds checking enabled. ***\n");
- }
-
- if (Interp_trace_TEST(interp, PARROT_TRACE_OPS_FLAG)) {
- Parrot_io_eprintf(interp,
- "*** Parrot VM: Tracing enabled. ***\n");
- }
-
- switch (interp->run_core) {
- case PARROT_SLOW_CORE:
- corename = "Slow"; break;
- case PARROT_FAST_CORE:
- corename = "Fast"; break;
- case PARROT_SWITCH_CORE:
- case PARROT_SWITCH_JIT_CORE:
- corename = "Switch"; break;
- case PARROT_CGP_CORE:
- case PARROT_CGP_JIT_CORE:
- corename = "CGP"; break;
- case PARROT_CGOTO_CORE:
- corename = "CGoto"; break;
- case PARROT_JIT_CORE:
- corename = "JIT"; break;
- case PARROT_EXEC_CORE:
- corename = "EXEC"; break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Unknown run core");
- }
-
- Parrot_io_eprintf(interp, "*** Parrot VM: %s core ***\n", corename);
-}
/*
Modified: branches/gc-refactor/src/exceptions.c
==============================================================================
--- branches/gc-refactor/src/exceptions.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/exceptions.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -251,7 +251,7 @@
passed properly. */
}
/* Set up the continuation context of the handler in the interpreter. */
- else if (PMC_cont(handler)->current_results)
+ else if (PARROT_CONTINUATION(handler)->current_results)
address = pass_exception_args(interp, "P", address,
CURRENT_CONTEXT(interp), exception);
@@ -356,7 +356,6 @@
ASSERT_ARGS(Parrot_ex_throw_from_c)
Parrot_runloop *return_point = interp->current_runloop;
- RunProfile * const profile = interp->profile;
opcode_t *address;
PMC * const handler =
Parrot_cx_find_handler_local(interp, exception);
@@ -364,17 +363,6 @@
if (PMC_IS_NULL(handler))
die_from_exception(interp, exception);
- /* If profiling, remember end time of lastop and generate entry for
- * exception. */
- if (profile && Interp_flags_TEST(interp, PARROT_PROFILE_FLAG)) {
- const FLOATVAL now = Parrot_floatval_time();
-
- profile->data[profile->cur_op].time += now - profile->starttime;
- profile->cur_op = PARROT_PROF_EXCEPTION;
- profile->starttime = now;
- profile->data[PARROT_PROF_EXCEPTION].numcalls++;
- }
-
if (Interp_debug_TEST(interp, PARROT_BACKTRACE_DEBUG_FLAG)) {
STRING * const exit_code = CONST_STRING(interp, "exit_code");
STRING * const msg = VTABLE_get_string(interp, exception);
@@ -401,7 +389,7 @@
/* Run the handler. */
address = VTABLE_invoke(interp, handler, NULL);
- if (PMC_cont(handler)->current_results)
+ if (PARROT_CONTINUATION(handler)->current_results)
address = pass_exception_args(interp, "P", address,
CURRENT_CONTEXT(interp), exception);
PARROT_ASSERT(return_point->handler_start == NULL);
Modified: branches/gc-refactor/src/exec_start.c
==============================================================================
--- branches/gc-refactor/src/exec_start.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/exec_start.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2006, Parrot Foundation.
+Copyright (C) 2001-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -97,7 +97,7 @@
#if defined(JIT_CGP)
exec_init_prederef(interp, &exec_prederef_code);
#endif
- /* Parrot_set_run_core(interp, PARROT_EXEC_CORE);
+ /* Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "exec"));
interp->code->base.data =
(opcode_t *)&((&program_code)[bytecode_offset]);
Parrot_exec_run = 0; */
Deleted: branches/gc-refactor/src/gc/alloc_register.c
==============================================================================
--- branches/gc-refactor/src/gc/alloc_register.c Mon Sep 7 23:56:34 2009 (r41142)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,677 +0,0 @@
-/*
-Copyright (C) 2001-2009, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/gc/register.c - Register handling routines
-
-=head1 DESCRIPTION
-
-Parrot has 4 register sets, one for each of its basic types. The number of
-registers in each set varies depending on the use counts of the subroutine and
-is determined by the PASM/PIR compiler in the register allocation pass
-(F<imcc/reg_alloc.c>).
-
-=cut
-
-*/
-
-#include "parrot/parrot.h"
-#include "parrot/register.h"
-#include "../pmc/pmc_sub.h"
-
-
-/* set CTX_LEAK_DEBUG_FULL to 1 for enhanced context debugging.
- * When set (1) freed contexts are "poisoned" so that any dangling
- * references produce segfaults, and (2) contexts are not recycled
- * so that later allocations don't suddenly restore a dangling
- * reference to a "working" condition.
- */
-#define CTX_LEAK_DEBUG_FULL 0
-
-
-
-/* HEADERIZER HFILE: include/parrot/register.h */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-static void clear_regs(PARROT_INTERP, ARGMOD(PMC *pmcctx))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*pmcctx);
-
-static void init_context(PARROT_INTERP,
- ARGMOD(PMC *pmcctx),
- ARGIN_NULLOK(PMC *pmcold))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*pmcctx);
-
-#define ASSERT_ARGS_clear_regs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pmcctx)
-#define ASSERT_ARGS_init_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pmcctx)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: static */
-
-
-/*
-=head2 Context and register frame layout
-
- +----------++----+------+------------+----+
- | context || N | I | P | S +
- +----------++----+------+------------+----+
- ^ ^ ^ ^
- | | ctx.bp ctx.bp_ps
- ctx.state opt
- padding
-
-Registers are addressed as usual via the register base pointer ctx.bp.
-
-The macro CONTEXT() hides these details
-
-=cut
-
-*/
-
-
-#define ALIGNED_CTX_SIZE (((sizeof (Parrot_Context) + NUMVAL_SIZE - 1) \
- / NUMVAL_SIZE) * NUMVAL_SIZE)
-
-/*
-
-=pod
-
-Round register allocation size up to the nearest multiple of 8. A granularity
-of 8 is arbitrary, it could have been some bigger power of 2. A "slot" is an
-index into the free_list array. Each slot in free_list has a linked list of
-pointers to already allocated contexts available for (re)use. The slot where
-an available context is stored corresponds to the size of the context.
-
-=cut
-
-*/
-
-#define SLOT_CHUNK_SIZE 8
-
-#define ROUND_ALLOC_SIZE(size) ((((size) + SLOT_CHUNK_SIZE - 1) \
- / SLOT_CHUNK_SIZE) * SLOT_CHUNK_SIZE)
-#define CALCULATE_SLOT_NUM(size) ((size) / SLOT_CHUNK_SIZE)
-
-/*
-
-=head2 Context and Register Allocation Functions
-
-=over 4
-
-=cut
-
-*/
-
-
-/*
-
-=item C<void create_initial_context(PARROT_INTERP)>
-
-Creates the interpreter's initial context.
-
-=cut
-
-*/
-
-void
-create_initial_context(PARROT_INTERP)
-{
- ASSERT_ARGS(create_initial_context)
- static INTVAL num_regs[] = {32, 32, 32, 32};
- PMC *ignored;
-
- /* Create some initial free_list slots. */
-
-#define INITIAL_FREE_SLOTS 8
- /* 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);
- UNUSED(ignored);
-}
-
-
-/*
-
-=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
-values, for debugging purposes.
-
-=cut
-
-*/
-
-static void
-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
- *
- * if the architecture has 0x := NULL and 0.0 we could memset too
- */
-
- for (i = 0; i < ctx->n_regs_used[REGNO_PMC]; i++) {
- CTX_REG_PMC(pmcctx, i) = PMCNULL;
- }
-
- for (i = 0; i < ctx->n_regs_used[REGNO_STR]; i++) {
- 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(pmcctx, i) = -999;
- }
- for (i = 0; i < ctx->n_regs_used[REGNO_NUM]; i++) {
- CTX_REG_NUM(pmcctx, i) = -99.9;
- }
- }
-}
-
-
-/*
-
-=item C<static void init_context(PARROT_INTERP, PMC *pmcctx, PMC *pmcold)>
-
-Initializes a freshly allocated or recycled context.
-
-=cut
-
-*/
-
-static void
-init_context(PARROT_INTERP, ARGMOD(PMC *pmcctx),
- ARGIN_NULLOK(PMC *pmcold))
-{
- ASSERT_ARGS(init_context)
- 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;
- ctx->outer_ctx = NULL;
- ctx->current_cont = NULL;
- ctx->current_object = NULL;
- ctx->handlers = PMCNULL;
- ctx->caller_ctx = NULL;
-
- if (old) {
- /* some items should better be COW copied */
- ctx->constants = old->constants;
- ctx->warns = old->warns;
- ctx->errors = old->errors;
- ctx->trace_flags = old->trace_flags;
- ctx->pred_offset = old->pred_offset;
- ctx->current_HLL = old->current_HLL;
- ctx->current_namespace = old->current_namespace;
- /* end COW */
- ctx->recursion_depth = old->recursion_depth;
- }
- else {
- ctx->constants = NULL;
- ctx->warns = 0;
- ctx->errors = 0;
- ctx->trace_flags = 0;
- ctx->pred_offset = 0;
- ctx->current_HLL = 0;
- ctx->current_namespace = PMCNULL;
- ctx->recursion_depth = 0;
- }
-
- /* other stuff is set inside Sub.invoke */
- clear_regs(interp, pmcctx);
-}
-
-
-/*
-
-=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>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-PMC *
-Parrot_push_context(PARROT_INTERP, ARGIN(const INTVAL *n_regs_used))
-{
- ASSERT_ARGS(Parrot_push_context)
- PMC * const old = CURRENT_CONTEXT(interp);
- PMC * const ctx = Parrot_set_new_context(interp, n_regs_used);
-
- Parrot_pcc_set_caller_ctx(interp, ctx, old);
-
- /* doesn't change */
- Parrot_pcc_set_sub(interp, ctx, Parrot_pcc_get_sub(interp, old));
-
- /* copy more ? */
- return ctx;
-}
-
-
-/*
-
-=item C<void Parrot_pop_context(PARROT_INTERP)>
-
-Frees the context created with C<Parrot_push_context> and restores the previous
-context (the caller context).
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_pop_context(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_pop_context)
- PMC * const ctx = CURRENT_CONTEXT(interp);
- PMC * const old = Parrot_pcc_get_caller_ctx(interp, ctx);
-
- /* restore old, set cached interpreter base pointers */
- CURRENT_CONTEXT(interp) = 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
-the init flag to indicate whether you want to initialize the new context
-(setting its default values and clearing its registers).
-
-=cut
-
-*/
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-PMC *
-Parrot_alloc_context(PARROT_INTERP, ARGIN(const INTVAL *number_regs_used),
- ARGIN_NULLOK(PMC *old))
-{
- ASSERT_ARGS(Parrot_alloc_context)
- PMC *pmcctx;
- Parrot_Context *ctx;
- void *p;
-
- const size_t size_i = sizeof (INTVAL) * number_regs_used[REGNO_INT];
- const size_t size_n = sizeof (FLOATVAL) * number_regs_used[REGNO_NUM];
- const size_t size_s = sizeof (STRING *) * number_regs_used[REGNO_STR];
- const size_t size_p = sizeof (PMC *) * number_regs_used[REGNO_PMC];
-
- 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 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];
-
- /* regs start past the context */
- p = (void *) ((char *)ctx + ALIGNED_CTX_SIZE);
-
- /* ctx.bp points to I0, which has Nx on the left */
- ctx->bp.regs_i = (INTVAL *)((char *)p + size_n);
-
- /* ctx.bp_ps points to S0, which has Px on the left */
- ctx->bp_ps.regs_s = (STRING **)((char *)p + size_nip);
-
- pmcctx = pmc_new(interp, enum_class_Context);
- VTABLE_set_pointer(interp, pmcctx, ctx);
-
- init_context(interp, pmcctx, old);
-
- return pmcctx;
-}
-
-
-/*
-
-=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
-register usage C<n_regs_used> is copied.
-
-=cut
-
-*/
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-PMC *
-Parrot_set_new_context(PARROT_INTERP, ARGIN(const INTVAL *number_regs_used))
-{
- ASSERT_ARGS(Parrot_set_new_context)
- PMC *old = CURRENT_CONTEXT(interp);
- PMC *ctx = Parrot_alloc_context(interp, number_regs_used, old);
-
- CURRENT_CONTEXT(interp) = ctx;
-
- return ctx;
-}
-
-
-/*
-
-=back
-
-=head2 Register Stack Functions
-
-=over 4
-
-=cut
-
-=item C<void Parrot_clear_i(PARROT_INTERP)>
-
-Sets all integer registers in the current context to 0.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_clear_i(PARROT_INTERP)
-{
- 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<void Parrot_clear_s(PARROT_INTERP)>
-
-Sets all STRING registers in the current context to NULL.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_clear_s(PARROT_INTERP)
-{
- 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;
-}
-
-
-/*
-
-=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_clear_n(PARROT_INTERP)>
-
-Sets all number registers in the current context to 0.0.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_clear_n(PARROT_INTERP)
-{
- 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;
-}
-
-/*
-
-=item C<INTVAL * Parrot_pcc_get_INTVAL_reg(PARROT_INTERP, PMC *ctx, INTVAL idx)>
-
-Get pointer to INTVAL register.
-
-=cut
-
-*/
-
-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
-PARROT_CANNOT_RETURN_NULL
-FLOATVAL *
-Parrot_pcc_get_FLOATVAL_reg(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
-{
- ASSERT_ARGS(Parrot_pcc_get_FLOATVAL_reg)
- return &(Parrot_pcc_get_context_struct(interp, ctx)->bp.regs_n[-1L - idx]);
-}
-
-/*
-
-=item C<STRING ** Parrot_pcc_get_STRING_reg(PARROT_INTERP, PMC *ctx, INTVAL
-idx)>
-
-Get pointer to STRING register.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_CANNOT_RETURN_NULL
-STRING **
-Parrot_pcc_get_STRING_reg(PARROT_INTERP, ARGIN(PMC *ctx), INTVAL idx)
-{
- 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<int Parrot_pcc_get_regs_used(PARROT_INTERP, PMC *ctx, int type)>
-
-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_pcc_set_regs_used(PARROT_INTERP, ARGIN(PMC *ctx), int type, INTVAL num)
-{
- ASSERT_ARGS(Parrot_pcc_set_regs_used)
- Parrot_pcc_get_context_struct(interp, ctx)->n_regs_used[type] = num;
-}
-
-/*
-
-=item C<Regs_ni* Parrot_pcc_get_regs_ni(PARROT_INTERP, PMC *ctx)>
-
-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_pcc_set_regs_ni(PARROT_INTERP, ARGIN(PMC *ctx), ARGIN(Regs_ni *bp))
-{
- 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
-
-=head1 SEE ALSO
-
-F<include/parrot/register.h> and F<src/stacks.c>.
-
-=cut
-
-*/
-
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: branches/gc-refactor/src/gc/alloc_resources.c
==============================================================================
--- branches/gc-refactor/src/gc/alloc_resources.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/gc/alloc_resources.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -348,9 +348,6 @@
++mem_pools->gc_sweep_block_level;
- if (interp->profile)
- Parrot_gc_profile_start(interp);
-
/* We're collecting */
mem_pools->mem_allocs_since_last_collect = 0;
mem_pools->header_allocs_since_last_collect = 0;
@@ -551,9 +548,6 @@
pool->guaranteed_reclaimable = 0;
pool->possibly_reclaimable = 0;
- if (interp->profile)
- Parrot_gc_profile_end(interp, PARROT_PROF_GC);
-
--mem_pools->gc_sweep_block_level;
}
Modified: branches/gc-refactor/src/gc/api.c
==============================================================================
--- branches/gc-refactor/src/gc/api.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/gc/api.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -253,13 +253,14 @@
Parrot_gc_initialize(PARROT_INTERP, ARGIN(void *stacktop))
{
ASSERT_ARGS(Parrot_gc_initialize)
+
interp->mem_pools = mem_allocate_zeroed_typed(Memory_Pools);
- interp->mem_pools->sized_header_pools = NULL;
interp->mem_pools->num_sized = 0;
- interp->mem_pools->attrib_pools = NULL;
interp->mem_pools->num_attribs = 0;
+ interp->mem_pools->attrib_pools = NULL;
+ interp->mem_pools->sized_header_pools = NULL;
- interp->lo_var_ptr = stacktop;
+ interp->lo_var_ptr = stacktop;
interp->gc_sys = mem_allocate_zeroed_typed(GC_Subsystem);
@@ -1021,9 +1022,30 @@
}
mem_internal_free(interp->mem_pools->sized_header_pools);
- if (interp->mem_pools->attrib_pools)
+
+ if (interp->mem_pools->attrib_pools) {
+ unsigned int i;
+ for (i = 0; i < interp->mem_pools->num_attribs; i++) {
+ PMC_Attribute_Pool *pool = interp->mem_pools->attrib_pools[i];
+ PMC_Attribute_Arena *arena;
+
+ if (!pool)
+ continue;
+
+ arena = pool->top_arena;
+
+ while (arena) {
+ PMC_Attribute_Arena *next = arena->next;
+ mem_internal_free(arena);
+ arena = next;
+ }
+ mem_internal_free(pool);
+ }
+
mem_internal_free(interp->mem_pools->attrib_pools);
- interp->mem_pools->attrib_pools = NULL;
+ }
+
+ interp->mem_pools->attrib_pools = NULL;
interp->mem_pools->sized_header_pools = NULL;
}
@@ -1593,15 +1615,10 @@
/*
-=item C<void * Parrot_gc_allocate_pmc_attributes(PARROT_INTERP, PMC *pmc, size_t
-size)>
-
-EXPERIMENTAL!!!
+=item C<void * Parrot_gc_allocate_pmc_attributes(PARROT_INTERP, PMC *pmc)>
-Allocation and deallocation function for PMC Attribute structures.
-
-These functions are not currently used. They are waiting for changes to
-the PMC allocation/deallocation mechanisms. See TT #895 for details.
+Allocates a new attribute structure for a PMC if it has the auto_attrs flag
+set.
=cut
@@ -1609,40 +1626,51 @@
PARROT_CANNOT_RETURN_NULL
void *
-Parrot_gc_allocate_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc), size_t size)
+Parrot_gc_allocate_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc))
{
ASSERT_ARGS(Parrot_gc_allocate_pmc_attributes)
- /* const size_t attr_size = pmc->vtable->attr_size; */
- const size_t attr_size = size;
+#if GC_USE_FIXED_SIZE_ALLOCATOR
+ const size_t attr_size = pmc->vtable->attr_size;
PMC_Attribute_Pool * const pool = Parrot_gc_get_attribute_pool(interp,
attr_size);
void * const attrs = Parrot_gc_get_attributes_from_pool(interp, pool);
- memset(attrs, 0, size);
+ memset(attrs, 0, attr_size);
PMC_data(pmc) = attrs;
return attrs;
+#else
+ void * const data = mem_sys_allocate_zeroed(new_vtable->attr_size);
+ PMC_data(pmc) = data;
+ return data;
+#endif
}
/*
-=item C<void Parrot_gc_free_pmc_attributes(PARROT_INTERP, PMC *pmc, size_t
-item_size)>
+=item C<void Parrot_gc_free_pmc_attributes(PARROT_INTERP, PMC *pmc)>
-EXPERIMENTAL!!! See above.
+Deallocates an attibutes structure from a PMC if it has the auto_attrs
+flag set.
*/
void
-Parrot_gc_free_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc), size_t item_size)
+Parrot_gc_free_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc))
{
ASSERT_ARGS(Parrot_gc_free_pmc_attributes)
void * const data = PMC_data(pmc);
if (data) {
- PMC_Attribute_Pool **pools = interp->mem_pools->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);
+
+#if GC_USE_FIXED_SIZE_ALLOCATOR
+ const size_t attr_size = pmc->vtable->attr_size;
+ const size_t item_size = attr_size < sizeof (void *) ? sizeof (void *) : attr_size;
+ PMC_Attribute_Pool ** const pools = interp->mem_pools->attrib_pools;
+ const size_t idx = item_size - sizeof (void *);
+ Parrot_gc_free_attributes_from_pool(interp, pools[idx], data);
+#else
+ mem_sys_free(PMC_data(pmc));
PMC_data(pmc) = NULL;
+#endif
}
}
@@ -1651,7 +1679,8 @@
=item C<void * Parrot_gc_allocate_fixed_size_storage(PARROT_INTERP, size_t
size)>
-EXPERIMENTAL!!! See above.
+Allocates a fixed-size chunk of memory for use. This memory is not manually
+managed and needs to be freed with C<Parrot_gc_free_fixed_size_storage>
*/
@@ -1670,7 +1699,8 @@
=item C<void Parrot_gc_free_fixed_size_storage(PARROT_INTERP, size_t size, void
*data)>
-EXPERIMENTAL!!! See above.
+Manually deallocates fixed size storage allocated with
+C<Parrot_gc_allocate_fixed_size_storage>
*/
@@ -1678,11 +1708,12 @@
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 **pools = interp->mem_pools->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);
+ const size_t item_size = size < sizeof (void *) ? sizeof (void *) : size;
+ const size_t idx = size - sizeof (void *);
+ PMC_Attribute_Pool ** const pools = interp->mem_pools->attrib_pools;
+ Parrot_gc_free_attributes_from_pool(interp, pools[idx], data);
+
}
/*
Modified: branches/gc-refactor/src/gc/gc_malloc.c
==============================================================================
--- branches/gc-refactor/src/gc/gc_malloc.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/gc/gc_malloc.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -82,9 +82,6 @@
if (flag & POOL_BUFFER)
clear_cow(interp, pool, 0);
- if (interp->profile && (flag & POOL_PMC))
- Parrot_gc_profile_end(interp, PARROT_PROF_GC_cp);
-
*total_free += pool->num_free_objects;
return 0;
Modified: branches/gc-refactor/src/gc/gc_ms.c
==============================================================================
--- branches/gc-refactor/src/gc/gc_ms.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/gc/gc_ms.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -184,15 +184,11 @@
header_pools_iterate_callback(interp, POOL_BUFFER | POOL_PMC,
(void*)&total_free, gc_ms_sweep_cb);
- if (interp->profile)
- Parrot_gc_profile_end(interp, PARROT_PROF_GC_cb);
}
else {
++mem_pools->gc_lazy_mark_runs;
Parrot_gc_clear_live_bits(interp, mem_pools->pmc_pool);
- if (interp->profile)
- Parrot_gc_profile_end(interp, PARROT_PROF_GC_p2);
}
pt_gc_stop_mark(interp);
@@ -282,9 +278,6 @@
Parrot_gc_sweep_pool(interp, pool);
- if (interp->profile && (flag & POOL_PMC))
- Parrot_gc_profile_end(interp, PARROT_PROF_GC_cp);
-
*total_free += pool->num_free_objects;
return 0;
Modified: branches/gc-refactor/src/gc/gc_private.h
==============================================================================
--- branches/gc-refactor/src/gc/gc_private.h Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/gc/gc_private.h Mon Sep 7 23:56:34 2009 (r41143)
@@ -72,6 +72,15 @@
enough to satisfy most startup costs. */
#define GC_USE_LAZY_ALLOCATOR 1
+/* Set to 1 if we want to use the fixed-size allocator. Set to 0 if we want
+ to allocate these things using mem_sys_allocate instead */
+/* Had seen errors on Windows. Appears to be fixed now. TT #940 */
+#if defined(_WIN32) || defined(_WIN64)
+# define GC_USE_FIXED_SIZE_ALLOCATOR 1
+#else
+# define GC_USE_FIXED_SIZE_ALLOCATOR 1
+#endif
+
/* We're using this here to add an additional pointer to a PObj without
having to actually add an entire pointer to every PObj-alike structure
in Parrot. Astute observers may notice that if the PObj is comprised of
@@ -427,12 +436,6 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(* pool);
-void Parrot_gc_profile_end(PARROT_INTERP, int what)
- __attribute__nonnull__(1);
-
-void Parrot_gc_profile_start(PARROT_INTERP)
- __attribute__nonnull__(1);
-
void Parrot_gc_run_init(PARROT_INTERP)
__attribute__nonnull__(1);
@@ -483,10 +486,6 @@
__attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pool)
-#define ASSERT_ARGS_Parrot_gc_profile_end __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_gc_profile_start __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_Parrot_gc_run_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_Parrot_gc_sweep_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
Modified: branches/gc-refactor/src/gc/incremental_ms.c
==============================================================================
--- branches/gc-refactor/src/gc/incremental_ms.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/gc/incremental_ms.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -775,9 +775,6 @@
Parrot_gc_sweep_pool(interp, pool);
- if (interp->profile && (flag & POOL_PMC))
- Parrot_gc_profile_end(interp, PARROT_PROF_GC_cp);
-
*n_obj += pool->total_objects - pool->num_free_objects;
return 0;
@@ -826,9 +823,6 @@
(void*)&n_objects, sweep_cb);
UNUSED(ignored);
- if (interp->profile)
- Parrot_gc_profile_end(interp, PARROT_PROF_GC_cb);
-
g_ims->state = GC_IMS_COLLECT;
g_ims->n_objects = n_objects;
}
@@ -907,9 +901,6 @@
Gc_ims_private *g_ims;
int ret;
- if (!check_only && interp->profile)
- Parrot_gc_profile_start(interp);
-
g_ims = (Gc_ims_private *)mem_pools->gc_private;
ret = header_pools_iterate_callback(interp, POOL_BUFFER,
@@ -921,9 +912,6 @@
if (check_only)
return 0;
- if (interp->profile)
- Parrot_gc_profile_end(interp, PARROT_PROF_GC);
-
g_ims->state = GC_IMS_FINISHED;
#endif
return 0;
Modified: branches/gc-refactor/src/gc/mark_sweep.c
==============================================================================
--- branches/gc-refactor/src/gc/mark_sweep.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/gc/mark_sweep.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -180,9 +180,6 @@
return 0;
}
- if (interp->profile)
- Parrot_gc_profile_start(interp);
-
/* We have to start somewhere; the interpreter globals is a good place */
if (!mem_pools->gc_mark_start) {
mem_pools->gc_mark_start
@@ -248,9 +245,6 @@
&& mem_pools->num_early_PMCs_seen >= mem_pools->num_early_gc_PMCs)
return 0;
- if (interp->profile)
- Parrot_gc_profile_end(interp, PARROT_PROF_GC_p1);
-
return 1;
}
@@ -531,9 +525,6 @@
* If there is a count of shared PMCs and we have already seen
* all these, we could skip that.
*/
- if (interp->profile)
- Parrot_gc_profile_start(interp);
-
pt_gc_mark_root_finished(interp);
do {
@@ -573,9 +564,6 @@
mem_pools->gc_mark_start = current;
mem_pools->gc_trace_ptr = NULL;
- if (interp->profile)
- Parrot_gc_profile_end(interp, PARROT_PROF_GC_p2);
-
return 1;
}
@@ -666,59 +654,6 @@
/*
-=item C<void Parrot_gc_profile_start(PARROT_INTERP)>
-
-Records the start time of a GC mark run when profiling is enabled.
-
-=cut
-
-*/
-
-void
-Parrot_gc_profile_start(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_gc_profile_start)
- if (Interp_flags_TEST(interp, PARROT_PROFILE_FLAG))
- interp->profile->gc_time = Parrot_floatval_time();
-}
-
-/*
-
-=item C<void Parrot_gc_profile_end(PARROT_INTERP, int what)>
-
-Records the end time of the GC mark run part C<what> run when profiling is
-enabled. Also record start time of next part.
-
-=cut
-
-*/
-
-void
-Parrot_gc_profile_end(PARROT_INTERP, int what)
-{
- ASSERT_ARGS(Parrot_gc_profile_end)
- if (Interp_flags_TEST(interp, PARROT_PROFILE_FLAG)) {
- RunProfile * const profile = interp->profile;
- const FLOATVAL now = Parrot_floatval_time();
-
- profile->data[what].numcalls++;
- profile->data[what].time += now - profile->gc_time;
-
- /*
- * we've recorded the time of a GC piece from
- * gc_time until now, so add this to the start of the
- * currently executing opcode, which hasn't run this
- * interval.
- */
- profile->starttime += now - profile->gc_time;
-
- /* prepare start for next step */
- profile->gc_time = now;
- }
-}
-
-/*
-
=back
=head2 Header Pool Creation Functions
@@ -1211,37 +1146,46 @@
pool->num_free_objects++;
}
+
static void
Parrot_gc_allocate_new_attributes_arena(PARROT_INTERP, ARGMOD(PMC_Attribute_Pool *pool))
{
ASSERT_ARGS(Parrot_gc_allocate_new_attributes_arena)
- const size_t num_items = pool->objects_per_alloc;
- const size_t item_size = pool->attr_size;
- const size_t total_size = sizeof (PMC_Attribute_Arena) + (item_size * num_items);
- size_t i;
PMC_Attribute_Free_List *list, *next, *first;
+
+ size_t i;
+ const size_t num_items = pool->objects_per_alloc;
+ const size_t item_size = pool->attr_size;
+ const size_t total_size = sizeof (PMC_Attribute_Arena)
+ + (item_size * num_items);
+
PMC_Attribute_Arena * const new_arena = (PMC_Attribute_Arena *)mem_internal_allocate(
total_size);
+
new_arena->prev = NULL;
new_arena->next = pool->top_arena;
pool->top_arena = new_arena;
- first = next = (PMC_Attribute_Free_List *)(new_arena + 1);
+ first = next = (PMC_Attribute_Free_List *)(new_arena + 1);
+
#if GC_USE_LAZY_ALLOCATOR
- pool->newfree = first;
- pool->newlast = (PMC_Attribute_Free_List*)((char*)first + (item_size * num_items));
+ pool->newfree = first;
+ pool->newlast = (PMC_Attribute_Free_List *)((char *)first + (item_size * num_items));
#else
for (i = 0; i < num_items; i++) {
- list = next;
+ list = next;
list->next = (PMC_Attribute_Free_List *)((char *)list + item_size);
- next = list->next;
+ next = list->next;
}
- list->next = pool->free_list;
+
+ list->next = pool->free_list;
pool->free_list = first;
#endif
+
pool->num_free_objects += num_items;
pool->total_objects += num_items;
}
+
PARROT_CANNOT_RETURN_NULL
PMC_Attribute_Pool *
Parrot_gc_get_attribute_pool(PARROT_INTERP, size_t attrib_size)
@@ -1255,16 +1199,18 @@
: attrib_size;
const size_t idx = size - sizeof (void *);
- if (pools == NULL) {
+ if (!pools) {
const size_t total_length = idx + GC_ATTRIB_POOLS_HEADROOM;
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);
memset(pools, 0, total_size);
+
mem_pools->attrib_pools = pools;
mem_pools->num_attribs = total_length;
}
+
if (mem_pools->num_attribs <= idx) {
const size_t total_length = idx + GC_ATTRIB_POOLS_HEADROOM;
const size_t total_size = total_length * sizeof (void *);
@@ -1276,8 +1222,10 @@
mem_pools->attrib_pools = pools;
mem_pools->num_attribs = total_length;
}
- if (pools[idx] == NULL)
+
+ if (!pools[idx])
pools[idx] = Parrot_gc_create_attrib_pool(interp, size);
+
return pools[idx];
}
@@ -1290,12 +1238,14 @@
(GC_FIXED_SIZE_POOL_SIZE - sizeof (PMC_Attribute_Arena)) / attrib_size;
const size_t num_objs = (num_objs_raw == 0)?(1):(num_objs_raw);
PMC_Attribute_Pool * const newpool = mem_internal_allocate_typed(PMC_Attribute_Pool);
- newpool->attr_size = attrib_size;
- newpool->total_objects = 0;
+
+ newpool->attr_size = attrib_size;
+ newpool->total_objects = 0;
newpool->objects_per_alloc = num_objs;
- newpool->num_free_objects = 0;
- newpool->free_list = NULL;
- newpool->top_arena = NULL;
+ newpool->num_free_objects = 0;
+ newpool->free_list = NULL;
+ newpool->top_arena = NULL;
+
return newpool;
}
Modified: branches/gc-refactor/src/hll.c
==============================================================================
--- branches/gc-refactor/src/hll.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/hll.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -554,6 +554,7 @@
=cut
+
*/
/*
Modified: branches/gc-refactor/src/interp/inter_create.c
==============================================================================
--- branches/gc-refactor/src/interp/inter_create.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/interp/inter_create.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -216,6 +216,9 @@
Parrot_pcc_set_continuation(interp, CURRENT_CONTEXT(interp), NULL); /* TODO Use PMCNULL */
Parrot_pcc_set_object(interp, CURRENT_CONTEXT(interp), NULL);
+ /* initialize built-in runcores */
+ Parrot_runcore_init(interp);
+
/* Load the core op func and info tables */
interp->op_lib = PARROT_CORE_OPLIB_INIT(1);
interp->op_count = interp->op_lib->op_count;
@@ -225,7 +228,6 @@
interp->evc_func_table = NULL;
interp->save_func_table = NULL;
interp->code = NULL;
- interp->profile = NULL;
/* create the root set registry */
interp->gc_registry = pmc_new(interp, enum_class_AddrRegistry);
@@ -363,6 +365,10 @@
/* Now the PIOData gets also cleared */
Parrot_io_finish(interp);
+ /* deinit runcores and dynamic op_libs */
+ if (!interp->parent_interpreter)
+ Parrot_runcore_destroy(interp);
+
/*
* now all objects that need timely destruction should be finalized
* so terminate the event loop
@@ -411,13 +417,6 @@
if (interp->initial_pf)
PackFile_destroy(interp, interp->initial_pf);
- if (interp->profile) {
- mem_sys_free(interp->profile->data);
- interp->profile->data = NULL;
- mem_sys_free(interp->profile);
- interp->profile = NULL;
- }
-
destroy_runloop_jump_points(interp);
if (interp->evc_func_table) {
@@ -437,15 +436,6 @@
/* free vtables */
parrot_free_vtables(interp);
- /* dynop libs */
- if (interp->n_libs > 0) {
- mem_sys_free(interp->op_info_table);
- mem_sys_free(interp->op_func_table);
-
- /* deinit op_lib */
- Parrot_runcore_destroy(interp);
- }
-
MUTEX_DESTROY(interpreter_array_mutex);
mem_sys_free(interp);
Modified: branches/gc-refactor/src/interp/inter_misc.c
==============================================================================
--- branches/gc-refactor/src/interp/inter_misc.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/interp/inter_misc.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -253,8 +253,35 @@
ret = Parrot_gc_impatient_pmcs(interp);
break;
case CURRENT_RUNCORE:
- ret = interp->run_core;
+ {
+ STRING *name = interp->run_core->name;
+
+ if (Parrot_str_equal(interp, name, CONST_STRING(interp, "slow")))
+ ret = PARROT_SLOW_CORE;
+ else if (Parrot_str_equal(interp, name, CONST_STRING(interp, "fast")))
+ ret = PARROT_FAST_CORE;
+ else if (Parrot_str_equal(interp, name, CONST_STRING(interp, "switch")))
+ ret = PARROT_SWITCH_CORE;
+ else if (Parrot_str_equal(interp, name, CONST_STRING(interp, "cgp")))
+ ret = PARROT_CGP_CORE;
+ else if (Parrot_str_equal(interp, name, CONST_STRING(interp, "cgoto")))
+ ret = PARROT_CGOTO_CORE;
+ else if (Parrot_str_equal(interp, name, CONST_STRING(interp, "jit")))
+ ret = PARROT_JIT_CORE;
+ else if (Parrot_str_equal(interp, name, CONST_STRING(interp, "cgp_jit")))
+ ret = PARROT_CGP_JIT_CORE;
+ else if (Parrot_str_equal(interp, name, CONST_STRING(interp, "switch_jit")))
+ ret = PARROT_SWITCH_JIT_CORE;
+ else if (Parrot_str_equal(interp, name, CONST_STRING(interp, "exec")))
+ ret = PARROT_EXEC_CORE;
+ else if (Parrot_str_equal(interp, name, CONST_STRING(interp, "gc_debug")))
+ ret = PARROT_GC_DEBUG_CORE;
+ else if (Parrot_str_equal(interp, name, CONST_STRING(interp, "debugger")))
+ ret = PARROT_DEBUGGER_CORE;
+ else if (Parrot_str_equal(interp, name, CONST_STRING(interp, "profiling")))
+ ret = PARROT_PROFILING_CORE;
break;
+ }
default: /* or a warning only? */
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
"illegal argument in interpinfo");
Modified: branches/gc-refactor/src/ops/core.ops
==============================================================================
--- branches/gc-refactor/src/ops/core.ops Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/ops/core.ops Mon Sep 7 23:56:34 2009 (r41143)
@@ -113,7 +113,7 @@
we want to throw an error. Seriously people: Do not use this opcode
directly in PIR. Ever. It absolutely makes no sense and it doesn't do
anything productive. You've been warned. */
- if (interp->run_core & PARROT_JIT_CORE) {
+ if (PARROT_RUNCORE_JIT_OPS_TEST(interp->run_core)) {
#ifdef __GNUC__
# ifdef I386
__asm__("ret");
@@ -150,12 +150,12 @@
inline op prederef__() :internal :flow {
opcode_t * const _this = CUR_OPCODE;
- if (interp->run_core & PARROT_CGOTO_CORE) {
+ if (PARROT_RUNCORE_CGOTO_OPS_TEST(interp->run_core)) {
/* must be CGP then - check for events in not yet prederefed code */
Parrot_cx_runloop_wake(interp, interp->scheduler);
/* _this = CHECK_EVENTS(interp, _this); */
}
- do_prederef((void**)cur_opcode, interp, op_lib.core_type);
+ do_prederef((void**)cur_opcode, interp, interp->run_core);
goto ADDRESS(_this); /* force this being a branch op */
}
@@ -577,7 +577,7 @@
caller_ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
ccont = Parrot_pcc_get_continuation(interp, ctx);
- if (PMC_cont(ccont)->address) {
+ if (PARROT_CONTINUATION(ccont)->address) {
/* Call is from runops_fromc */
caller_ctx = PMC_cont(ccont)->to_ctx;
if (PMC_IS_NULL(caller_ctx)) {
@@ -616,12 +616,12 @@
/* Get context of callee from return continuation. */
PMC * const cc = Parrot_pcc_get_continuation(interp, CURRENT_CONTEXT(interp));
PMC *sig = NULL;
- if (cc && PMC_cont(cc)->to_ctx) {
+ if (cc && PARROT_CONTINUATION(cc)->to_ctx) {
/* caller context has results */
opcode_t * const results = Parrot_pcc_get_results(interp, PMC_cont(cc)->to_ctx);
if (results) {
/* get results PMC index and get PMC. */
- sig = PF_CONST(PMC_cont(cc)->seg, results[1])->u.key;
+ sig = PF_CONST(PARROT_CONTINUATION(cc)->seg, results[1])->u.key;
}
}
Modified: branches/gc-refactor/src/ops/pic.ops
==============================================================================
--- branches/gc-refactor/src/ops/pic.ops Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/ops/pic.ops Mon Sep 7 23:56:34 2009 (r41143)
@@ -184,7 +184,7 @@
opcode_t *dest_pc;
void **dest_pred;
PMC *caller_ctx, *ctx;
- Parrot_cont *cc;
+ Parrot_Continuation_attributes *cc;
int n;
ctx = CURRENT_CONTEXT(interp);
Modified: branches/gc-refactor/src/packfile.c
==============================================================================
--- branches/gc-refactor/src/packfile.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/packfile.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -28,6 +28,7 @@
#include "parrot/embed.h"
#include "parrot/extend.h"
#include "parrot/packfile.h"
+#include "parrot/runcore_api.h"
#include "jit.h"
#include "../compilers/imcc/imc.h"
#include "packfile.str"
@@ -672,21 +673,20 @@
run_sub(PARROT_INTERP, ARGIN(PMC *sub_pmc))
{
ASSERT_ARGS(run_sub)
- const INTVAL old = interp->run_core;
- PMC *retval;
+ Parrot_runcore_t *old_core = interp->run_core;
+ PMC *retval;
/* turn off JIT and prederef - both would act on the whole
* PackFile which probably isn't worth the effort */
- if (interp->run_core != PARROT_CGOTO_CORE
- && interp->run_core != PARROT_SLOW_CORE
- && interp->run_core != PARROT_FAST_CORE)
- interp->run_core = PARROT_FAST_CORE;
+ if (PARROT_RUNCORE_JIT_OPS_TEST(interp->run_core)
+ || PARROT_RUNCORE_PREDEREF_OPS_TEST(interp->run_core))
+ Parrot_runcore_switch(interp, CONST_STRING(interp, "fast"));
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;
+ interp->run_core = old_core;
return retval;
}
@@ -4711,6 +4711,13 @@
ASSERT_ARGS(compile_or_load_file)
char * const filename = Parrot_str_to_cstring(interp, path);
+ INTVAL regs_used[] = { 2, 2, 2, 2 }; /* Arbitrary values */
+ const int parrot_hll_id = 0;
+ PMC * context = Parrot_push_context(interp, regs_used);
+ Parrot_pcc_set_HLL(interp, context, parrot_hll_id);
+ Parrot_pcc_set_namespace(interp, context,
+ Parrot_get_HLL_namespace(interp, parrot_hll_id));
+
if (file_type == PARROT_RUNTIME_FT_PBC) {
PackFile * const pf = PackFile_append_pbc(interp, filename);
Parrot_str_free_cstring(filename);
@@ -4738,6 +4745,8 @@
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_LIBRARY_ERROR,
"compiler returned NULL ByteCode '%Ss' - %Ss", path, err);
}
+
+ Parrot_pop_context(interp);
}
/*
Modified: branches/gc-refactor/src/parrot_debugger.c
==============================================================================
--- branches/gc-refactor/src/parrot_debugger.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/parrot_debugger.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -263,10 +263,9 @@
else
PDB_printwelcome();
- interp->run_core = PARROT_DEBUGGER_CORE;
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "debugger"));
PDB_run_code(interp, argc - nextarg, argv + nextarg);
-
Parrot_exit(interp, 0);
}
Modified: branches/gc-refactor/src/pic.c
==============================================================================
--- branches/gc-refactor/src/pic.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pic.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -78,6 +78,7 @@
#include "parrot/parrot.h"
#include "parrot/oplib/ops.h"
+#include "parrot/runcore_api.h"
#include "pmc/pmc_fixedintegerarray.h"
#include "pmc/pmc_continuation.h"
#ifdef HAVE_COMPUTED_GOTO
@@ -109,10 +110,11 @@
static int is_pic_func(PARROT_INTERP,
ARGIN(void **pc),
ARGOUT(Parrot_MIC *mic),
- int core_type)
+ ARGIN(Parrot_runcore_t *runcore))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
+ __attribute__nonnull__(4)
FUNC_MODIFIES(*mic);
static int is_pic_param(PARROT_INTERP,
@@ -197,7 +199,8 @@
#define ASSERT_ARGS_is_pic_func __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pc) \
- || PARROT_ASSERT_ARG(mic)
+ || PARROT_ASSERT_ARG(mic) \
+ || PARROT_ASSERT_ARG(runcore)
#define ASSERT_ARGS_is_pic_param __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pc) \
@@ -417,9 +420,10 @@
#ifdef HAVE_COMPUTED_GOTO
op_lib_t *cg_lib;
#endif
- const int core = interp->run_core;
+ const Parrot_runcore_t *core = interp->run_core;
- if (core == PARROT_SWITCH_CORE || core == PARROT_SWITCH_JIT_CORE)
+ if (PARROT_RUNCORE_PREDEREF_OPS_TEST(core)
+ && !PARROT_RUNCORE_CGOTO_OPS_TEST(core))
return (void *)op;
#ifdef HAVE_COMPUTED_GOTO
cg_lib = PARROT_CORE_CGP_OPLIB_INIT(1);
@@ -427,6 +431,7 @@
#else
return NULL;
#endif
+
}
/*
@@ -766,15 +771,16 @@
/*
-=item C<static int is_pic_func(PARROT_INTERP, void **pc, Parrot_MIC *mic, int
-core_type)>
+=item C<static int is_pic_func(PARROT_INTERP, void **pc, Parrot_MIC *mic,
+Parrot_runcore_t *runcore)>
=cut
*/
static int
-is_pic_func(PARROT_INTERP, ARGIN(void **pc), ARGOUT(Parrot_MIC *mic), int core_type)
+is_pic_func(PARROT_INTERP, ARGIN(void **pc), ARGOUT(Parrot_MIC *mic),
+ ARGIN(Parrot_runcore_t *runcore))
{
ASSERT_ARGS(is_pic_func)
/*
@@ -811,7 +817,7 @@
if (*op != PARROT_OP_set_p_pc)
return 0;
- do_prederef(pc, interp, core_type);
+ do_prederef(pc, interp, runcore);
sub = (PMC *)(pc[2]);
PARROT_ASSERT(PObj_is_PMC_TEST(sub));
@@ -825,7 +831,7 @@
if (*op != PARROT_OP_get_results_pc)
return 0;
- do_prederef(pc, interp, core_type);
+ do_prederef(pc, interp, runcore);
sig_results = (PMC *)(pc[1]);
ASSERT_SIG_PMC(sig_results);
@@ -841,8 +847,8 @@
/*
-=item C<void parrot_PIC_prederef(PARROT_INTERP, opcode_t op, void **pc_pred, int
-core)>
+=item C<void parrot_PIC_prederef(PARROT_INTERP, opcode_t op, void **pc_pred,
+Parrot_runcore_t *core)>
Define either the normal prederef function or the PIC stub, if PIC for
this opcode function is available. Called from C<do_prederef>.
@@ -852,7 +858,8 @@
*/
void
-parrot_PIC_prederef(PARROT_INTERP, opcode_t op, ARGOUT(void **pc_pred), int core)
+parrot_PIC_prederef(PARROT_INTERP, opcode_t op, ARGOUT(void **pc_pred),
+ ARGIN(Parrot_runcore_t *core))
{
ASSERT_ARGS(parrot_PIC_prederef)
op_func_t * const prederef_op_func = interp->op_lib->op_func_table;
@@ -897,7 +904,8 @@
}
/* rewrite opcode */
- if (core == PARROT_SWITCH_CORE || core == PARROT_SWITCH_JIT_CORE)
+ if (PARROT_RUNCORE_PREDEREF_OPS_TEST(core)
+ && !PARROT_RUNCORE_CGOTO_OPS_TEST(core))
*pc_pred = (void **)op;
else
*pc_pred = ((void **)prederef_op_func)[op];
Modified: branches/gc-refactor/src/pic_jit.c
==============================================================================
--- branches/gc-refactor/src/pic_jit.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pic_jit.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -34,6 +34,7 @@
#include "parrot/parrot.h"
#include "parrot/oplib/ops.h"
#include "pmc/pmc_sub.h"
+#include "parrot/runcore_api.h"
/* HEADERIZER HFILE: include/parrot/pic.h */
@@ -488,7 +489,7 @@
* 0) if runcore setting doesn't contain JIT
* forget it
*/
- if (!(interp->run_core & PARROT_JIT_CORE))
+ if (!(PARROT_RUNCORE_JIT_OPS_TEST(interp->run_core)))
return 0;
/* 1) if the JIT system can't JIT_CODE_SUB_REGS_ONLY
Modified: branches/gc-refactor/src/pmc.c
==============================================================================
--- branches/gc-refactor/src/pmc.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -121,19 +121,10 @@
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)) {
-#if GC_USE_FIXED_SIZE_ALLOCATOR
- Parrot_gc_free_pmc_attributes(interp, pmc, pmc->vtable->attr_size);
-#else
- mem_sys_free(PMC_data(pmc));
- PMC_data(pmc) = NULL;
-#endif
- }
- }
- else {
+ if (pmc->vtable->attr_size)
+ Parrot_gc_free_pmc_attributes(interp, pmc);
+ else
PMC_data(pmc) = NULL;
- }
#ifndef NDEBUG
@@ -280,13 +271,9 @@
/* Set the right vtable */
pmc->vtable = new_vtable;
- if (new_vtable->attr_size) {
-#if GC_USE_FIXED_SIZE_ALLOCATOR
- Parrot_gc_allocate_pmc_attributes(interp, pmc, new_vtable->attr_size);
-#else
- PMC_data(pmc) = mem_sys_allocate_zeroed(new_vtable->attr_size);
-#endif
-}
+ if (new_vtable->attr_size)
+ Parrot_gc_allocate_pmc_attributes(interp, pmc);
+
else
PMC_data(pmc) = NULL;
@@ -332,13 +319,8 @@
/* Set the right vtable */
pmc->vtable = new_vtable;
- if (new_vtable->attr_size) {
-#if GC_USE_FIXED_SIZE_ALLOCATOR
- Parrot_gc_allocate_pmc_attributes(interp, pmc, new_vtable->attr_size);
-#else
- PMC_data(pmc) = mem_sys_allocate_zeroed(new_vtable->attr_size);
-#endif
-}
+ if (new_vtable->attr_size)
+ Parrot_gc_allocate_pmc_attributes(interp, pmc);
else
PMC_data(pmc) = NULL;
@@ -476,13 +458,8 @@
pmc = Parrot_gc_new_pmc_header(interp, flags);
pmc->vtable = vtable;
- if (vtable->attr_size) {
-#if GC_USE_FIXED_SIZE_ALLOCATOR
- Parrot_gc_allocate_pmc_attributes(interp, pmc, pmc->vtable->attr_size);
-#else
- PMC_data(pmc) = mem_sys_allocate_zeroed(vtable->attr_size);
-#endif
- }
+ if (vtable->attr_size)
+ Parrot_gc_allocate_pmc_attributes(interp, pmc);
#if GC_VERBOSE
if (Interp_flags_TEST(interp, PARROT_TRACE_FLAG)) {
Modified: branches/gc-refactor/src/pmc/context.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/context.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/context.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -53,8 +53,8 @@
VTABLE void mark()
{
Parrot_Context * const ctx = PMC_data_typed(SELF, Parrot_Context*);
- PObj *obj;
- int i;
+ PObj *obj;
+ UINTVAL i;
/* If Context wasn't initialised just return */
if (!ctx)
@@ -126,7 +126,18 @@
VTABLE void destroy() {
/* We own this pointer */
Parrot_Context * const ctx = PMC_data_typed(SELF, Parrot_Context*);
+
+ if (!ctx)
+ return;
+
+#ifdef GC_USE_FIXED_SIZE_ALLOCATOR
+ Parrot_gc_free_fixed_size_storage(interp,
+ Parrot_pcc_calculate_context_size(INTERP, ctx->n_regs_used),
+ ctx);
+#else
mem_sys_free(ctx);
+#endif
+ PMC_data(SELF) = NULL;
}
/*
Modified: branches/gc-refactor/src/pmc/continuation.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/continuation.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/continuation.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -46,8 +46,16 @@
*/
pmclass Continuation auto_attrs {
- ATTR struct Parrot_cont *cont; /* the continuation struct */
-
+ /* continuation destination */
+ ATTR PackFile_ByteCode *seg; /* bytecode segment */
+ ATTR opcode_t *address; /* start of bytecode, addr to continue */
+ ATTR PMC *to_ctx; /* pointer to dest context */
+ /* a Continuation keeps the from_ctx alive */
+ 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. */
+ ATTR int invoked; /* flag when a handler has been invoked. */
/*
=item C<void init()>
@@ -59,11 +67,43 @@
*/
VTABLE void init() {
- Parrot_Continuation_attributes *attrs =
- (Parrot_Continuation_attributes *) PMC_data(SELF);
+ Parrot_Continuation_attributes * const attrs = PARROT_CONTINUATION(SELF);
+
+ 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);
+
+ /* PANIC("don't do that"); */
+ /*
+ * Whenever we create a continuation, all return continuations
+ * up the call chain may be reused due to invoking the
+ * continuation. To avoid that all return continuations are
+ * converted to true continuations.
+ */
+ invalidate_retc_context(INTERP, SELF);
+ }
+
+ /*if they pass in a PMC to initialize with*/
+ VTABLE void init_pmc(PMC *values) {
+ Parrot_Continuation_attributes * const attrs = PARROT_CONTINUATION(SELF);
+ Parrot_Continuation_attributes * const theirs = PARROT_CONTINUATION(values);
+
+ attrs->to_ctx = theirs->to_ctx;
+ attrs->from_ctx = CURRENT_CONTEXT(interp);
+ attrs->runloop_id = 0;
+ attrs->seg = theirs->seg;
+ attrs->address = theirs->address;
+ attrs->current_results = Parrot_pcc_get_results(interp, attrs->to_ctx);
- PMC_cont(SELF) = new_continuation(INTERP, NULL);
+ PObj_active_destroy_SET(SELF);
PObj_custom_mark_destroy_SETALL(SELF);
+
/* PANIC("don't do that"); */
/*
* Whenever we create a continuation, all return continuations
@@ -74,6 +114,8 @@
invalidate_retc_context(INTERP, SELF);
}
+
+
/*
=item C<void mark()>
@@ -85,8 +127,10 @@
*/
VTABLE void mark() {
- Parrot_cont *cc = PMC_cont(SELF);
+ Parrot_Continuation_attributes * const cc = PARROT_CONTINUATION(SELF);
+ if (cc->seg)
+ Parrot_gc_mark_PObj_alive(interp, (PObj *)cc->seg);
if (cc->to_ctx)
Parrot_gc_mark_PObj_alive(INTERP, (PObj *) cc->to_ctx);
if (cc->from_ctx)
@@ -95,21 +139,6 @@
/*
-=item C<void destroy()>
-
-Destroys the continuation.
-
-=cut
-
-*/
-
- VTABLE void destroy() {
- Parrot_cont * const cc = PMC_cont(SELF);
- if (cc)
- mem_sys_free(cc);
- }
-/*
-
=item C<PMC *clone()>
Creates and returns a clone of the continuation.
@@ -119,20 +148,9 @@
*/
VTABLE PMC *clone() {
- Parrot_cont * const cc_self = PMC_cont(SELF);
- Parrot_cont * const cc = new_continuation(INTERP, cc_self);
- PMC * const ret = pmc_new(INTERP, enum_class_Continuation);
- Parrot_cont * const ret_cont = PMC_cont(ret);
-
- PObj_custom_mark_destroy_SETALL(ret);
-
- /* free ret's PMC_cont */
- /* XXX Looks very suspicious... Why? */
- mem_sys_free(ret_cont);
-
- cc->runloop_id = cc_self->runloop_id;
- PMC_cont(ret) = cc;
-
+ /* Start to prepare for subclassable continuations */
+ INTVAL type = SELF->vtable->base_type;
+ PMC * ret = pmc_new_init(interp, type, SELF);
return ret;
}
@@ -146,8 +164,8 @@
*/
VTABLE void set_pmc(PMC *src) {
- Parrot_cont * const cc_self = PMC_cont(SELF);
- Parrot_cont * const cc_src = PMC_cont(src);
+ Parrot_Continuation_attributes * const cc_self = PARROT_CONTINUATION(SELF);
+ Parrot_Continuation_attributes * const cc_src = PARROT_CONTINUATION(src);
STRUCT_COPY(cc_self, cc_src);
}
@@ -163,11 +181,11 @@
*/
VTABLE void set_pointer(void *value) {
- opcode_t * const pos = (opcode_t *)value;
- Parrot_cont * const cc = PMC_cont(SELF);
+ opcode_t * const pos = (opcode_t *)value;
+ Parrot_Continuation_attributes * const cc = PARROT_CONTINUATION(SELF);
- cc->address = (opcode_t *)value;
- cc->runloop_id = INTERP->current_runloop_id;
+ cc->address = pos;
+ cc->runloop_id = INTERP->current_runloop_id;
if (pos && (*pos == PARROT_OP_get_results_pc))
cc->current_results = pos;
@@ -186,8 +204,9 @@
*/
VTABLE void *get_pointer() {
- return PMC_cont(SELF)->address;
+ return PARROT_CONTINUATION(SELF)->address;
}
+
/*
=item C<INTVAL defined()>
@@ -201,11 +220,11 @@
*/
VTABLE INTVAL defined() {
- return PMC_cont(SELF)->address != NULL;
+ return PARROT_CONTINUATION(SELF)->address != NULL;
}
VTABLE INTVAL get_bool() {
- return PMC_cont(SELF)->address != NULL;
+ return PARROT_CONTINUATION(SELF)->address != NULL;
}
/*
@@ -220,14 +239,14 @@
*/
VTABLE opcode_t *invoke(void *next) {
- Parrot_cont *cc = PMC_cont(SELF);
- PMC *from_ctx = CURRENT_CONTEXT(interp);
- PMC *to_ctx = cc->to_ctx;
- opcode_t *pc = cc->address;
+ Parrot_Continuation_attributes * const cc = PARROT_CONTINUATION(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, cc);
- Parrot_continuation_rewind_environment(interp, SELF, cc);
+ Parrot_continuation_check(interp, SELF);
+ Parrot_continuation_rewind_environment(interp, SELF);
/* pass args to where caller wants result */
if (cc->current_results)
@@ -271,7 +290,7 @@
*/
VTABLE STRING *get_string() {
- return Parrot_Context_infostr(INTERP, PMC_cont(SELF)->to_ctx);
+ return Parrot_Context_infostr(INTERP, PARROT_CONTINUATION(SELF)->to_ctx);
}
/*
@@ -285,13 +304,13 @@
*/
METHOD caller() {
- Parrot_cont *cc = PMC_cont(SELF);
- PMC *caller = Parrot_pcc_get_sub(interp, cc->to_ctx);
- Parrot_Sub_attributes *sub;
+ Parrot_Continuation_attributes * const cc = PARROT_CONTINUATION(SELF);
+ PMC *caller = Parrot_pcc_get_sub(interp, cc->to_ctx);
if (!caller)
caller = PMCNULL;
else {
+ Parrot_Sub_attributes *sub;
PMC_get_sub(INTERP, caller, sub);
if (!sub->seg)
caller = PMCNULL;
@@ -311,8 +330,8 @@
*/
METHOD continuation() {
- Parrot_cont *cc = PMC_cont(SELF);
- PMC *cont = Parrot_pcc_get_continuation(interp, cc->to_ctx);
+ Parrot_Continuation_attributes * const cc = PARROT_CONTINUATION(SELF);
+ PMC * const cont = Parrot_pcc_get_continuation(interp, cc->to_ctx);
if (cont)
RETURN(PMC *cont);
Modified: branches/gc-refactor/src/pmc/coroutine.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/coroutine.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/coroutine.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -75,11 +75,10 @@
*/
VTABLE void init() {
- Parrot_Coroutine_attributes *attrs =
- (Parrot_Coroutine_attributes *) PMC_data(SELF);
+ Parrot_Coroutine_attributes *attrs = PARROT_COROUTINE(SELF);
attrs->seg = INTERP->code;
- attrs->ctx = NULL;
+ attrs->ctx = PMCNULL;
PObj_custom_mark_destroy_SETALL(SELF);
}
@@ -96,15 +95,15 @@
*/
VTABLE PMC *clone() {
- PMC * const ret = pmc_new(INTERP, SELF->vtable->base_type);
- Parrot_Coroutine_attributes *sub = PARROT_COROUTINE(SELF);
- Parrot_Coroutine_attributes *coro_sub = PARROT_COROUTINE(ret);
+ PMC * const ret = pmc_new(INTERP, SELF->vtable->base_type);
+ Parrot_Coroutine_attributes * const sub = PARROT_COROUTINE(SELF);
+ Parrot_Coroutine_attributes * const coro_sub = PARROT_COROUTINE(ret);
PObj_custom_mark_destroy_SETALL(ret);
memcpy(coro_sub, sub, sizeof (Parrot_Coroutine_attributes));
- coro_sub->name = Parrot_str_copy(INTERP, coro_sub->name);
+ coro_sub->name = Parrot_str_copy(INTERP, coro_sub->name);
return ret;
}
@@ -120,50 +119,47 @@
*/
VTABLE opcode_t *invoke(void *next) {
- PackFile_ByteCode *wanted_seg;
- Parrot_Coroutine_attributes *co = PARROT_COROUTINE(SELF);
- opcode_t * dest = co->address;
+ PackFile_ByteCode *wanted_seg;
+ Parrot_Coroutine_attributes * const co = PARROT_COROUTINE(SELF);
+ opcode_t * dest = co->address;
+ opcode_t * const next_op = (opcode_t *)next;
if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG))
print_sub_name(INTERP, SELF);
- if (!co->ctx) {
- PMC *caller_ctx;
+ if (PMC_IS_NULL(co->ctx)) {
+ PMC * const caller_ctx = CURRENT_CONTEXT(interp);
PMC *ctx;
- PMC *ccont;
-
- ccont = INTERP->current_cont;
+ PMC *ccont = INTERP->current_cont;
if (ccont == NEED_CONTINUATION)
- ccont = (PMC *)new_ret_continuation_pmc(interp,
- (opcode_t *)next);
+ ccont = (PMC *)new_ret_continuation_pmc(interp, next_op);
if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL)
Parrot_ex_throw_from_c_args(INTERP, NULL, CONTROL_ERROR,
"tail call to coro not allowed");
/* first time set current sub, cont, object */
- caller_ctx = CURRENT_CONTEXT(interp);
- ctx = Parrot_set_new_context(INTERP, co->n_regs_used);
+ ctx = Parrot_set_new_context(INTERP, co->n_regs_used);
- co->ctx = ctx;
+ co->ctx = ctx;
Parrot_pcc_set_caller_ctx(INTERP, ctx, caller_ctx);
- PMC_cont(ccont)->from_ctx = ctx;
+ PARROT_CONTINUATION(ccont)->from_ctx = ctx;
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;
+ Parrot_pcc_set_object(interp, ctx, PMCNULL);
+ INTERP->current_object = PMCNULL;
+ INTERP->current_cont = PMCNULL;
/* create pad if needed */
if (!PMC_IS_NULL(co->lex_info)) {
- 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, Parrot_pcc_get_lex_pad(INTERP, ctx), ctx);
+ const INTVAL hlltype = Parrot_get_ctx_HLL_type(interp, enum_class_LexPad);
+ PMC * const lexpad = pmc_new_init(INTERP, hlltype, co->lex_info);
+ Parrot_pcc_set_lex_pad(INTERP, ctx, lexpad);
+ VTABLE_set_pointer(INTERP, lexpad, ctx);
}
PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF;
@@ -174,36 +170,32 @@
/* if calling the Coro we need the segment of the Coro */
else if (!(PObj_get_FLAGS(SELF) & SUB_FLAG_CORO_FF)) {
- PMC *ccont;
- PMC *ctx;
+ PMC * const ctx = co->ctx;
+ PMC * const ccont = Parrot_pcc_get_continuation(INTERP, ctx);
PObj_get_FLAGS(SELF) |= SUB_FLAG_CORO_FF;
wanted_seg = co->seg;
/* remember segment of caller */
co->caller_seg = INTERP->code;
- ctx = co->ctx;
/* and the recent call context */
- ccont = Parrot_pcc_get_continuation(INTERP, ctx);
- PMC_cont(ccont)->to_ctx = CURRENT_CONTEXT(interp);
+ PARROT_CONTINUATION(ccont)->to_ctx = CURRENT_CONTEXT(interp);
Parrot_pcc_set_caller_ctx(interp, ctx, CURRENT_CONTEXT(interp));
/* set context to coro context */
CURRENT_CONTEXT(interp) = ctx;
}
else {
- PMC *ccont;
- PMC *ctx;
+ PMC * const ccont = Parrot_pcc_get_continuation(INTERP, co->ctx);
+ PMC * const ctx = PARROT_CONTINUATION(ccont)->to_ctx;
PObj_get_FLAGS(SELF) &= ~SUB_FLAG_CORO_FF;
/* switch back to last remembered code seg and context */
wanted_seg = co->caller_seg;
- ccont = Parrot_pcc_get_continuation(INTERP, co->ctx);
- ctx = PMC_cont(ccont)->to_ctx;
- if (! ctx) {
+ if (PMC_IS_NULL(ctx)) {
/* This still isn't quite right, but it beats segfaulting. See
the "Call an exited coroutine" case in t/pmc/coroutine.t; the
problem is that the defunct coroutine yields up one more
@@ -226,24 +218,6 @@
return dest;
}
-/*
-
-=item C<void mark()>
-
-Marks the coroutine as live.
-
-=cut
-
-*/
-
- VTABLE void mark() {
- Parrot_Coroutine_attributes *co = PARROT_COROUTINE(SELF);
-
- /* co->ctx marked in SUPER(), so do not mark here */
- if (co) {
- SUPER();
- }
- }
}
/*
Modified: branches/gc-refactor/src/pmc/env.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/env.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/env.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -340,7 +340,7 @@
=head1 SEE ALS0
PDD -
-L<http://www.parrotcode.org/docs/pdd/pdd17_pdd.html#Hash_types>
+L<http://docs.parrot.org/parrot/latest/html/docs/pdds/pdd17_pmc.pod.html#Hash_types>
Environment in Perl 6 - L<http://dev.perl.org/perl6/rfc/318.html>
Modified: branches/gc-refactor/src/pmc/eventhandler.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/eventhandler.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/eventhandler.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -120,7 +120,7 @@
*/
VTABLE void mark() {
- Parrot_EventHandler_attributes *e = PMC_data_typed(SELF, Parrot_EventHandler_attributes *);
+ Parrot_EventHandler_attributes * const e = PARROT_EVENTHANDLER(SELF);
if (e) {
if (e->type)
@@ -147,7 +147,7 @@
*/
VTABLE void set_string(STRING *type) {
- Parrot_EventHandler_attributes *e = PMC_data_typed(SELF, Parrot_EventHandler_attributes *);
+ Parrot_EventHandler_attributes * const e = PARROT_EVENTHANDLER(SELF);
if (e)
e->type = type;
@@ -164,8 +164,7 @@
*/
VTABLE STRING *get_string() {
- Parrot_EventHandler_attributes *e =
- PMC_data_typed(SELF, Parrot_EventHandler_attributes *);
+ Parrot_EventHandler_attributes * const e = PARROT_EVENTHANDLER(SELF);
if (e)
return Parrot_str_copy(INTERP, e->type);
@@ -183,7 +182,7 @@
*/
VTABLE void set_integer_native(INTVAL priority) {
- Parrot_EventHandler_attributes *e = PMC_data_typed(SELF, Parrot_EventHandler_attributes *);
+ Parrot_EventHandler_attributes * const e = PARROT_EVENTHANDLER(SELF);
if (e)
e->priority = priority;
@@ -200,8 +199,7 @@
*/
VTABLE void set_pmc(PMC *interpreter) {
- Parrot_EventHandler_attributes *e =
- PMC_data_typed(SELF, Parrot_EventHandler_attributes *);
+ Parrot_EventHandler_attributes * const e = PARROT_EVENTHANDLER(SELF);
if (e)
e->interp = interpreter;
@@ -216,12 +214,11 @@
*/
VTABLE PMC *get_attr_str(STRING *name) {
- Parrot_EventHandler_attributes *core_struct
- = PMC_data_typed(SELF, Parrot_EventHandler_attributes *);
+ Parrot_EventHandler_attributes * const e = PARROT_EVENTHANDLER(SELF);
PMC *value = PMCNULL;
if (Parrot_str_equal(interp, name, CONST_STRING(interp, "code"))) {
- value = core_struct->code;
+ value = e->code;
}
return value;
@@ -237,8 +234,8 @@
*/
VTABLE opcode_t *invoke(void *next) {
- Parrot_EventHandler_attributes *e = PMC_data_typed(SELF, Parrot_EventHandler_attributes *);
- void *unused;
+ Parrot_EventHandler_attributes * const e = PARROT_EVENTHANDLER(SELF);
+ void *unused;
/* can't invoke on INTERP and can't return its result; this may not be
* the right interpreter */
@@ -274,8 +271,7 @@
*/
METHOD can_handle(PMC *event) {
- Parrot_EventHandler_attributes *handler_struct =
- PMC_data_typed(SELF, Parrot_EventHandler_attributes *);
+ Parrot_EventHandler_attributes * const handler_struct = PARROT_EVENTHANDLER(SELF);
if (event->vtable->base_type == enum_class_Task) {
PMC *type = VTABLE_get_attr_str(interp, event, CONST_STRING(interp, "type"));
STRING *type_str = VTABLE_get_string(interp, type);
Modified: branches/gc-refactor/src/pmc/exception.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/exception.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/exception.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -645,9 +645,8 @@
* XXX TT#596 - when we have Context PMCs, just take and set that. */
if (!PMC_IS_NULL(value) && VTABLE_isa(interp, value, CONST_STRING(interp, "Continuation"))) {
PMC *ctx = PMC_cont(value)->from_ctx;
- if (!PMC_IS_NULL(ctx)) {
+ if (!PMC_IS_NULL(ctx))
SET_ATTR_thrower(interp, SELF, ctx);
- }
}
}
else {
@@ -710,7 +709,7 @@
/* Get resume continuation, to find location we failed at. */
GET_ATTR_resume(interp, SELF, resume);
if (!PMC_IS_NULL(resume)) {
- Parrot_cont *cont = PMC_cont(resume);
+ Parrot_Continuation_attributes *cont = PARROT_CONTINUATION(resume);
if (cont->seg != NULL && cont->seg->annotations != NULL)
result = PackFile_Annotations_lookup(interp, cont->seg->annotations,
cont->address - cont->seg->base.data, name);
@@ -744,14 +743,14 @@
PMC *result = pmc_new(interp, enum_class_ResizablePMCArray);
PMC *resume;
PMC *cur_ctx;
- Parrot_cont *cont;
+ Parrot_Continuation_attributes *cont;
/* Get starting context, then loop over them. */
GET_ATTR_resume(interp, SELF, resume);
if (!PMC_IS_NULL(resume)) {
/* We have a resume continuation, so we can get the address from
* that. */
- cont = PMC_cont(resume);
+ cont = PARROT_CONTINUATION(resume);
cur_ctx = cont->to_ctx;
}
else {
Modified: branches/gc-refactor/src/pmc/exceptionhandler.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/exceptionhandler.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/exceptionhandler.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -40,23 +40,19 @@
*/
VTABLE void init() {
- Parrot_ExceptionHandler_attributes * const core_struct =
- (Parrot_ExceptionHandler_attributes *)PMC_data(SELF);
- Parrot_cont * const cc = new_continuation(INTERP, NULL);
-
- cc->invoked = 0;
- PMC_cont(SELF) = cc;
- core_struct->min_severity = 0;
- core_struct->max_severity = 0;
- core_struct->handled_types = PMCNULL;
- core_struct->handled_types_except = PMCNULL;
+ Parrot_ExceptionHandler_attributes * const attrs = PARROT_EXCEPTIONHANDLER(SELF);
+ SUPER();
+ attrs->invoked = 0;
+ attrs->min_severity = 0;
+ attrs->max_severity = 0;
+ attrs->handled_types = PMCNULL;
+ attrs->handled_types_except = PMCNULL;
/* an exception handler has no separate context; it's only a snapshot
* of an "earlier" context, which is contained in the interpreter's
* context - the stacks can only be deeper in the interpreter - so no
* mark of context is needed */
- PObj_custom_mark_SET(SELF);
- PObj_custom_destroy_SET(SELF);
+ PObj_custom_mark_destroy_SETALL(SELF);
}
/*
@@ -69,17 +65,30 @@
*/
VTABLE void mark() {
- Parrot_ExceptionHandler_attributes * const core_struct =
+ Parrot_ExceptionHandler_attributes * const attrs =
PARROT_EXCEPTIONHANDLER(SELF);
- if (core_struct->handled_types)
- Parrot_gc_mark_PObj_alive(interp, (PObj *)core_struct->handled_types);
- if (core_struct->handled_types_except)
- Parrot_gc_mark_PObj_alive(interp, (PObj *)core_struct->handled_types_except);
+ if (attrs->handled_types)
+ Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->handled_types);
+ if (attrs->handled_types_except)
+ Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->handled_types_except);
+ SUPER();
+ }
+
+ VTABLE void destroy() {
+ Parrot_ExceptionHandler_attributes *attrs = PARROT_EXCEPTIONHANDLER(SELF);
+
+ if (attrs->handled_types){
+ PObj_on_free_list_SET((PObj *) attrs->handled_types);
+ }
+ if (attrs->handled_types_except){
+ PObj_on_free_list_SET((PObj *) attrs->handled_types_except);
+ }
SUPER();
}
VTABLE PMC *clone() {
PMC * const result = SUPER();
+ /* This looks wrong, why wouldn't we want to mark the clone? */
PObj_custom_mark_CLEAR(result);
return result;
}
@@ -95,8 +104,7 @@
*/
VTABLE void set_integer_native(INTVAL value) {
- Parrot_cont * const cc = (Parrot_cont *)PMC_cont(SELF);
- cc->invoked = value;
+ PARROT_CONTINUATION(SELF)->invoked = value;
}
/*
@@ -110,8 +118,7 @@
*/
VTABLE INTVAL get_integer() {
- const Parrot_cont * const cc = (Parrot_cont *)PMC_cont(SELF);
- return cc->invoked;
+ return PARROT_CONTINUATION(SELF)->invoked;
}
/*
@@ -125,15 +132,14 @@
*/
VTABLE opcode_t *invoke(void *next) {
- Parrot_cont * const cc = (Parrot_cont *)PMC_cont(SELF);
- opcode_t * const pc = cc->address;
+ opcode_t * const pc = PARROT_CONTINUATION(SELF)->address;
- Parrot_continuation_check(interp, SELF, cc);
- Parrot_continuation_rewind_environment(interp, SELF, cc);
+ Parrot_continuation_check(interp, SELF);
+ Parrot_continuation_rewind_environment(interp, SELF);
/* switch code segment if needed */
- if (INTERP->code != cc->seg)
- Parrot_switch_to_cs(INTERP, cc->seg, 1);
+ if (INTERP->code != PARROT_CONTINUATION(SELF)->seg)
+ Parrot_switch_to_cs(INTERP, PARROT_CONTINUATION(SELF)->seg, 1);
return pc;
}
@@ -232,13 +238,13 @@
*/
METHOD min_severity(INTVAL severity :optional, INTVAL have_severity :opt_flag) {
- Parrot_ExceptionHandler_attributes * const core_struct =
+ Parrot_ExceptionHandler_attributes * const attrs =
PARROT_EXCEPTIONHANDLER(SELF);
if (have_severity)
- core_struct->min_severity = severity;
+ attrs->min_severity = severity;
else
- severity = core_struct->min_severity;
+ severity = attrs->min_severity;
RETURN(INTVAL severity);
}
@@ -254,13 +260,13 @@
*/
METHOD max_severity(INTVAL severity :optional, INTVAL have_severity :opt_flag) {
- Parrot_ExceptionHandler_attributes * const core_struct =
+ Parrot_ExceptionHandler_attributes * const attrs =
PARROT_EXCEPTIONHANDLER(SELF);
if (have_severity)
- core_struct->max_severity = severity;
+ attrs->max_severity = severity;
else
- severity = core_struct->max_severity;
+ severity = attrs->max_severity;
RETURN(INTVAL severity);
}
@@ -276,9 +282,9 @@
*/
METHOD handle_types(PMC *types :slurpy) {
- Parrot_ExceptionHandler_attributes * const core_struct =
+ Parrot_ExceptionHandler_attributes * const attrs =
PARROT_EXCEPTIONHANDLER(SELF);
- core_struct->handled_types =
+ attrs->handled_types =
VTABLE_elements(interp, types) > 0
? types
: PMCNULL;
@@ -295,9 +301,9 @@
*/
METHOD handle_types_except(PMC *types :slurpy) {
- Parrot_ExceptionHandler_attributes * const core_struct =
+ Parrot_ExceptionHandler_attributes * const attrs =
PARROT_EXCEPTIONHANDLER(SELF);
- core_struct->handled_types_except =
+ attrs->handled_types_except =
VTABLE_elements(interp, types) > 0
? types
: PMCNULL;
Modified: branches/gc-refactor/src/pmc/fixedpmcarray.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/fixedpmcarray.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/fixedpmcarray.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -65,8 +65,6 @@
*/
VTABLE void init() {
- Parrot_FixedPMCArray_attributes *attrs =
- (Parrot_FixedPMCArray_attributes *) PMC_data(SELF);
PObj_custom_mark_destroy_SETALL(SELF);
}
@@ -81,9 +79,8 @@
*/
VTABLE void destroy() {
- if (PMC_array(SELF)) {
+ if (PMC_array(SELF))
mem_sys_free(PMC_array(SELF));
- }
}
/*
@@ -101,8 +98,8 @@
const INTVAL size = PMC_size(SELF);
if (size) {
- PMC_size(dest) = size;
- PMC_array(dest) = mem_allocate_n_typed(size, PMC *);
+ PMC_size(dest) = size;
+ PMC_array(dest) = mem_allocate_n_typed(size, PMC *);
mem_copy_n_typed(PMC_array(dest), PMC_array(SELF), size, PMC *);
PObj_custom_mark_destroy_SETALL(dest);
}
Modified: branches/gc-refactor/src/pmc/integer.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/integer.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/integer.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -196,7 +196,9 @@
*/
VTABLE INTVAL get_bool() {
- return SELF.get_integer() ? 1 : 0;
+ INTVAL iv;
+ GET_ATTR_iv(INTERP, SELF, iv);
+ return iv ? 1 : 0;
}
/*
@@ -210,7 +212,9 @@
*/
VTABLE FLOATVAL get_number() {
- return SELF.get_integer();
+ INTVAL iv;
+ GET_ATTR_iv(INTERP, SELF, iv);
+ return (FLOATVAL)iv;
}
@@ -1182,17 +1186,24 @@
MULTI INTVAL cmp(Float value) {
- const FLOATVAL diff = SELF.get_number() - VTABLE_get_number(INTERP, value);
- return diff > 0 ? 1 : diff < 0 ? -1 : 0;
+ INTVAL iv;
+ GET_ATTR_iv(interp, SELF, iv);
+
+ {
+ const FLOATVAL diff = (FLOATVAL)iv - VTABLE_get_number(INTERP, value);
+ return diff > 0 ? 1 : diff < 0 ? -1 : 0;
+ }
}
MULTI INTVAL cmp(DEFAULT value) {
/* int or undef */
- const INTVAL selfint = SELF.get_integer();
- const INTVAL valueint = VTABLE_get_integer(INTERP, value);
-
- return selfint > valueint ? 1 : selfint < valueint ? -1 : 0;
+ INTVAL selfint;
+ GET_ATTR_iv(interp, SELF, selfint);
+ {
+ const INTVAL valueint = VTABLE_get_integer(INTERP, value);
+ return selfint > valueint ? 1 : selfint < valueint ? -1 : 0;
+ }
}
@@ -1243,15 +1254,16 @@
*/
VTABLE void increment() {
- const INTVAL a = VTABLE_get_integer(INTERP, SELF);
- const INTVAL c = a + 1;
+ INTVAL a, c;
+ GET_ATTR_iv(interp, SELF, a);
+ c = a + 1;
/* did not overflow */
if ((c^a) >= 0 || (c^1) >= 0)
- VTABLE_set_integer_native(interp, SELF, c);
+ SET_ATTR_iv(interp, SELF, c);
else {
- pmc_reuse(INTERP, SELF, enum_class_BigInt, 0);
- VTABLE_set_integer_native(INTERP, SELF, a);
+ pmc_reuse(interp, SELF, enum_class_BigInt, 0);
+ VTABLE_set_integer_native(interp, SELF, a);
VTABLE_increment(interp, SELF);
}
}
Modified: branches/gc-refactor/src/pmc/parrotinterpreter.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/parrotinterpreter.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/parrotinterpreter.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -28,6 +28,7 @@
#include "parrot/embed.h"
#include "parrot/dynext.h"
#include "parrot/io.h"
+#include "parrot/runcore_api.h"
#include "pmc_class.h"
#include "pmc_sub.h"
@@ -55,8 +56,9 @@
d->scheduler = pmc_new(d, enum_class_Scheduler);
d->scheduler = VTABLE_share_ro(d, d->scheduler);
+ /* can't copy directly, unless you want double-frees */
if (flags & PARROT_CLONE_RUNOPS)
- d->run_core = s->run_core;
+ Parrot_runcore_switch(d, s->run_core->name);
if (flags & PARROT_CLONE_INTERP_FLAGS) {
/* XXX setting of IS_THREAD? */
@@ -492,11 +494,11 @@
for (; level; --level) {
cont = Parrot_pcc_get_continuation(interp, ctx);
- if (PMC_IS_NULL(cont) || !PMC_cont(cont)->seg)
+ if (PMC_IS_NULL(cont) || !PARROT_CONTINUATION(cont)->seg)
Parrot_ex_throw_from_c_args(interp, NULL,
CONTROL_ERROR, "No such caller depth");
- ctx = PMC_cont(cont)->to_ctx;
+ ctx = PARROT_CONTINUATION(cont)->to_ctx;
if (PMC_IS_NULL(Parrot_pcc_get_sub(interp, ctx)))
Parrot_ex_throw_from_c_args(interp, NULL,
Modified: branches/gc-refactor/src/pmc/parrotrunningthread.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/parrotrunningthread.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/parrotrunningthread.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -30,9 +30,9 @@
#include "parrot/embed.h"
-#define PMC_tid(x) ((Parrot_ParrotRunningThread_attributes *)PMC_data(x))->tid
+#define PMC_tid(x) (PARROT_PARROTRUNNINGTHREAD(x))->tid
-pmclass ParrotRunningThread no_ro {
+pmclass ParrotRunningThread no_ro auto_attrs {
ATTR INTVAL tid; /* thread id */
/*
@@ -46,26 +46,7 @@
*/
VTABLE void init() {
- Parrot_ParrotRunningThread_attributes *attrs =
- mem_allocate_zeroed_typed(Parrot_ParrotRunningThread_attributes);
- attrs->tid = -1;
- PMC_data(SELF) = attrs;
- PObj_custom_destroy_SET(SELF);
- }
-
-/*
-
-=item C<void destroy()>
-
-Destroy this PMC.
-
-=cut
-
-*/
-
- VTABLE void destroy() {
- mem_sys_free(PMC_data(SELF));
- PMC_data(SELF) = NULL;
+ PMC_tid(SELF) = -1;
}
/*
Modified: branches/gc-refactor/src/pmc/retcontinuation.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/retcontinuation.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/retcontinuation.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -36,24 +36,18 @@
*/
VTABLE void init() {
- Parrot_RetContinuation_attributes * const attrs =
- (Parrot_RetContinuation_attributes *) PMC_data(SELF);
- PMC_cont(SELF) = new_ret_continuation(INTERP);
+ Parrot_RetContinuation_attributes * const attrs = PARROT_RETCONTINUATION(SELF);
- PObj_custom_mark_destroy_SETALL(SELF);
- }
+ 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;
+ attrs->address = NULL;
- /*
- * XXX when reusing SUPER.destroy() RetContinuations
- * have to set ref_count initially to 1
- */
+ }
- VTABLE void destroy() {
- Parrot_cont * const cc = PMC_cont(SELF);
- if (cc)
- mem_sys_free(cc);
- }
/*
=item C<PMC *clone>
@@ -81,19 +75,19 @@
*/
VTABLE opcode_t *invoke(void *in_next) {
- Parrot_cont *cc = PMC_cont(SELF);
- PMC *from_ctx = cc->from_ctx;
- PackFile_ByteCode * const seg = cc->seg;
- opcode_t *next = cc->address;
+ Parrot_Continuation_attributes *data = PARROT_CONTINUATION(SELF);
+ PMC *from_ctx = data->from_ctx;
+ PackFile_ByteCode * const seg = data->seg;
+ opcode_t *next = data->address;
UNUSED(in_next)
- Parrot_continuation_check(interp, SELF, cc);
- Parrot_continuation_rewind_environment(interp, SELF, cc);
+ Parrot_continuation_check(interp, SELF);
+ Parrot_continuation_rewind_environment(interp, SELF);
/* the continuation is dead - delete and destroy it */
/* This line causes a failure in t/pmc/packfiledirectory.t. No idea
what the relationship is between this line of code and that test
- failure. Will look into it later */
+ failure. */
/* Parrot_gc_free_pmc_header(interp, SELF); */
if (INTERP->code != seg)
Modified: branches/gc-refactor/src/pmc/sub.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/sub.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/sub.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -288,7 +288,7 @@
"maximum recursion depth exceeded");
/* and copy set context variables */
- PMC_cont(ccont)->from_ctx = context;
+ PARROT_CONTINUATION(ccont)->from_ctx = context;
/* if this is an outer sub, then we need to set sub->ctx
* to the new context (refcounted) and convert the
@@ -463,7 +463,7 @@
*/
VTABLE void mark() {
- Parrot_Sub_attributes *sub = PARROT_SUB(SELF);
+ Parrot_Sub_attributes * const sub = PARROT_SUB(SELF);
if (!sub)
return;
@@ -671,13 +671,13 @@
{
/* Create a hash, then use inspect_str to get all of the data to
* fill it up with. */
- PMC * const metadata = pmc_new(interp, enum_class_Hash);
- STRING * const pos_required_str = CONST_STRING(interp, "pos_required");
- STRING * const pos_optional_str = CONST_STRING(interp, "pos_optional");
+ PMC * const metadata = pmc_new(interp, enum_class_Hash);
+ STRING * const pos_required_str = CONST_STRING(interp, "pos_required");
+ STRING * const pos_optional_str = CONST_STRING(interp, "pos_optional");
STRING * const named_required_str = CONST_STRING(interp, "named_required");
STRING * const named_optional_str = CONST_STRING(interp, "named_optional");
- STRING * const pos_slurpy_str = CONST_STRING(interp, "pos_slurpy");
- STRING * const named_slurpy_str = CONST_STRING(interp, "named_slurpy");
+ STRING * const pos_slurpy_str = CONST_STRING(interp, "pos_slurpy");
+ STRING * const named_slurpy_str = CONST_STRING(interp, "named_slurpy");
VTABLE_set_pmc_keyed_str(interp, metadata, pos_required_str,
VTABLE_inspect_str(interp, SELF, pos_required_str));
Modified: branches/gc-refactor/src/pmc/task.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/task.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/task.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -43,8 +43,7 @@
*/
VTABLE void init() {
- Parrot_Task_attributes * const core_struct =
- (Parrot_Task_attributes *) PMC_data(SELF);
+ Parrot_Task_attributes * const core_struct = PARROT_TASK(SELF);
/* Set flags for custom GC mark. */
PObj_custom_mark_SET(SELF);
@@ -285,7 +284,7 @@
*/
VTABLE INTVAL get_integer() {
- const Parrot_Task_attributes * const core_struct = PARROT_TASK(SELF);
+ Parrot_Task_attributes * const core_struct = PARROT_TASK(SELF);
return core_struct->id;
}
Modified: branches/gc-refactor/src/pmc/timer.pmc
==============================================================================
--- branches/gc-refactor/src/pmc/timer.pmc Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc/timer.pmc Mon Sep 7 23:56:34 2009 (r41143)
@@ -58,10 +58,10 @@
#include "parrot/scheduler_private.h"
pmclass Timer extends Task provides event auto_attrs {
- ATTR FLOATVAL duration; /* The duration of the timer pause */
- ATTR FLOATVAL interval; /* How often to repeat */
- ATTR INTVAL repeat; /* Whether to repeat:
- * 0 = run once (no repeat), -1 = forever */
+ ATTR FLOATVAL duration; /* The duration of the timer pause */
+ ATTR FLOATVAL interval; /* How often to repeat */
+ ATTR INTVAL repeat; /* Whether to repeat:
+ * 0 = run once (no repeat), -1 = forever */
/*
@@ -74,8 +74,7 @@
*/
VTABLE void init() {
- Parrot_Timer_attributes * const core_struct =
- (Parrot_Timer_attributes *) PMC_data(SELF);
+ Parrot_Timer_attributes * const core_struct = PARROT_TIMER(SELF);
/* Set flags for custom GC mark and destroy. */
PObj_custom_mark_SET(SELF);
@@ -155,7 +154,7 @@
*/
VTABLE PMC *clone() {
- PMC * const copy = SUPER();
+ PMC * const copy = SUPER();
Parrot_Timer_attributes * const new_struct = PARROT_TIMER(copy);
Parrot_Timer_attributes * const old_struct = PARROT_TIMER(SELF);
@@ -240,7 +239,7 @@
*/
VTABLE FLOATVAL get_number_keyed_int(INTVAL key) {
- const Parrot_Timer_attributes * const core_struct = PARROT_TIMER(SELF);
+ Parrot_Timer_attributes * const core_struct = PARROT_TIMER(SELF);
switch (key) {
case PARROT_TIMER_NSEC:
Modified: branches/gc-refactor/src/pmc_freeze.c
==============================================================================
--- branches/gc-refactor/src/pmc_freeze.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/pmc_freeze.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -69,7 +69,7 @@
PARROT_INLINE
static void do_thaw(PARROT_INTERP,
- ARGIN_NULLOK(PMC* pmc),
+ ARGIN_NULLOK(PMC *pmc),
ARGIN(visit_info *info))
__attribute__nonnull__(1)
__attribute__nonnull__(3);
@@ -457,23 +457,26 @@
{
ASSERT_ARGS(str_append)
- const size_t used = s->bufused;
- const int need_free = (int)Buffer_buflen(s) - used - len;
- /*
- * grow by factor 1.5 or such
- */
+ const size_t used = s->bufused;
+ const int need_free = (int)Buffer_buflen(s) - used - len;
+
+ /* grow by factor 1.5 or such */
if (need_free <= 16) {
size_t new_size = (size_t) (Buffer_buflen(s) * 1.5);
if (new_size < Buffer_buflen(s) - need_free + 512)
new_size = Buffer_buflen(s) - need_free + 512;
+
Parrot_gc_reallocate_string_storage(interp, s, new_size);
PARROT_ASSERT(Buffer_buflen(s) - used - len >= 15);
}
+
mem_sys_memcopy((void *)((ptrcast_t)s->strstart + used), b, len);
+
s->bufused += len;
- s->strlen += len;
+ s->strlen += len;
}
+
/*
=item C<static void push_ascii_integer(PARROT_INTERP, IMAGE_IO *io, INTVAL v)>
@@ -494,6 +497,7 @@
str_append(interp, io->image, buffer, len);
}
+
/*
=item C<static void push_ascii_number(PARROT_INTERP, const IMAGE_IO *io,
@@ -515,6 +519,7 @@
str_append(interp, io->image, buffer, len);
}
+
/*
=item C<static void push_ascii_string(PARROT_INTERP, IMAGE_IO *io, const STRING
@@ -536,9 +541,11 @@
{
ASSERT_ARGS(push_ascii_string)
const UINTVAL length = Parrot_str_byte_length(interp, s);
- char * const buffer = (char *)malloc(4*length); /* XXX Why 4? What does that mean? */
- char *cursor = buffer;
- UINTVAL idx = 0;
+
+ /* XXX Why 4? What does that mean? */
+ char * const buffer = mem_allocate_n_typed(4 * length, char);
+ char *cursor = buffer;
+ UINTVAL idx = 0;
/* temporary--write out in UTF-8 */
for (idx = 0; idx < length; ++idx) {
@@ -551,6 +558,7 @@
mem_sys_free(buffer);
}
+
/*
=item C<static void push_ascii_pmc(PARROT_INTERP, IMAGE_IO *io, const PMC* v)>
@@ -571,6 +579,7 @@
str_append(interp, io->image, buffer, len);
}
+
/*
=item C<static INTVAL shift_ascii_integer(PARROT_INTERP, IMAGE_IO *io)>
@@ -586,20 +595,23 @@
{
ASSERT_ARGS(shift_ascii_integer)
- char * const start = (char*)io->image->strstart;
- char *p = start;
- const INTVAL i = strtoul(p, &p, 10);
+ char * const start = (char *)io->image->strstart;
+ char *p = start;
+ const INTVAL i = strtoul(p, &p, 10);
++p;
PARROT_ASSERT(p <= start + io->image->bufused);
+
io->image->strstart = p;
io->image->bufused -= (p - start);
- io->image->strlen -= (p - start);
+ io->image->strlen -= (p - start);
+
PARROT_ASSERT((int)io->image->bufused >= 0);
return i;
}
+
/*
=item C<static FLOATVAL shift_ascii_number(PARROT_INTERP, IMAGE_IO *io)>
@@ -615,20 +627,23 @@
{
ASSERT_ARGS(shift_ascii_number)
- char * const start = (char*)io->image->strstart;
- char *p = start;
- const FLOATVAL f = (FLOATVAL) strtod(p, &p);
+ char * const start = (char *)io->image->strstart;
+ char *p = start;
+ const FLOATVAL f = (FLOATVAL) strtod(p, &p);
++p;
PARROT_ASSERT(p <= start + io->image->bufused);
+
io->image->strstart = p;
io->image->bufused -= (p - start);
- io->image->strlen -= (p - start);
+ io->image->strlen -= (p - start);
+
PARROT_ASSERT((int)io->image->bufused >= 0);
return f;
}
+
/*
=item C<static STRING* shift_ascii_string(PARROT_INTERP, IMAGE_IO *io)>
@@ -647,23 +662,27 @@
ASSERT_ARGS(shift_ascii_string)
STRING *s;
- char * const start = (char*)io->image->strstart;
- char *p = start;
+ char * const start = (char *)io->image->strstart;
+ char *p = start;
while (*p != ' ')
++p;
+
++p;
PARROT_ASSERT(p <= start + io->image->bufused);
+
io->image->strstart = p;
io->image->bufused -= (p - start);
- io->image->strlen -= (p - start);
+ io->image->strlen -= (p - start);
+
PARROT_ASSERT((int)io->image->bufused >= 0);
+ /* probably should be UTF-8 */
s = string_make(interp, start, p - start - 1, "iso-8859-1", 0);
-/* s = string_make(interp, start, p - start - 1, "UTF-8", 0); */
return s;
}
+
/*
=item C<static PMC* shift_ascii_pmc(PARROT_INTERP, IMAGE_IO *io)>
@@ -681,19 +700,24 @@
{
ASSERT_ARGS(shift_ascii_pmc)
- char * const start = (char*)io->image->strstart;
- char *p = start;
- const unsigned long i = strtoul(p, &p, 16);
+ char * const start = (char *)io->image->strstart;
+ char *p = start;
+ const unsigned long i = strtoul(p, &p, 16);
+
++p;
+
PARROT_ASSERT(p <= start + io->image->bufused);
+
io->image->strstart = p;
io->image->bufused -= (p - start);
- io->image->strlen -= (p - start);
+ io->image->strlen -= (p - start);
+
PARROT_ASSERT((int)io->image->bufused >= 0);
- return (PMC*) i;
+ return (PMC *)i;
}
+
/*
=back
@@ -705,7 +729,7 @@
=item C<static void op_check_size(PARROT_INTERP, STRING *s, size_t len)>
Checks the size of the "stream" buffer to see if it can accommodate
-C<len> more bytes. If not then the buffer is expanded.
+C<len> more bytes. If not, expands the buffer.
=cut
@@ -716,12 +740,10 @@
op_check_size(PARROT_INTERP, ARGIN(STRING *s), size_t len)
{
ASSERT_ARGS(op_check_size)
- const size_t used = s->bufused;
- const int need_free = (int)Buffer_buflen(s) - used - len;
+ const size_t used = s->bufused;
+ const int need_free = (int)Buffer_buflen(s) - used - len;
- /*
- * grow by factor 1.5 or such
- */
+ /* grow by factor 1.5 or such */
if (need_free <= 16) {
size_t new_size = (size_t) (Buffer_buflen(s) * 1.5);
if (new_size < Buffer_buflen(s) - need_free + 512)
@@ -729,11 +751,14 @@
Parrot_gc_reallocate_string_storage(interp, s, new_size);
PARROT_ASSERT(Buffer_buflen(s) - used - len >= 15);
}
+
#ifndef DISABLE_GC_DEBUG
Parrot_gc_compact_memory_pool(interp);
#endif
+
}
+
/*
=item C<static void op_append(PARROT_INTERP, STRING *s, opcode_t b, size_t len)>
@@ -751,12 +776,15 @@
char *str_pos;
op_check_size(interp, s, len);
- str_pos = s->strstart + s->bufused;
+
+ str_pos = s->strstart + s->bufused;
*((opcode_t *)(str_pos)) = b;
+
s->bufused += len;
- s->strlen += len;
+ s->strlen += len;
}
+
/*
=item C<static void push_opcode_integer(PARROT_INTERP, IMAGE_IO *io, INTVAL v)>
@@ -777,6 +805,7 @@
op_append(interp, io->image, (opcode_t)v, sizeof (opcode_t));
}
+
/*
=item C<static void push_opcode_number(PARROT_INTERP, IMAGE_IO *io, FLOATVAL v)>
@@ -792,10 +821,10 @@
{
ASSERT_ARGS(push_opcode_number)
- const size_t len = PF_size_number() * sizeof (opcode_t);
+ opcode_t *ignored;
STRING * const s = io->image;
+ const size_t len = PF_size_number() * sizeof (opcode_t);
const size_t used = s->bufused;
- opcode_t *ignored;
op_check_size(interp, s, len);
ignored = PF_store_number((opcode_t *)((ptrcast_t)s->strstart + used), &v);
@@ -805,6 +834,7 @@
s->strlen += len;
}
+
/*
=item C<static void push_opcode_string(PARROT_INTERP, IMAGE_IO *io, STRING *v)>
@@ -820,10 +850,10 @@
{
ASSERT_ARGS(push_opcode_string)
- const size_t len = PF_size_string(v) * sizeof (opcode_t);
- STRING * const s = io->image;
- const size_t used = s->bufused;
opcode_t *ignored;
+ STRING * const s = io->image;
+ const size_t len = PF_size_string(v) * sizeof (opcode_t);
+ const size_t used = s->bufused;
op_check_size(interp, s, len);
ignored = PF_store_string((opcode_t *)((ptrcast_t)s->strstart + used), v);
@@ -833,6 +863,7 @@
s->strlen += len;
}
+
/*
=item C<static void push_opcode_pmc(PARROT_INTERP, IMAGE_IO *io, PMC* v)>
@@ -850,6 +881,7 @@
op_append(interp, io->image, (opcode_t)v, sizeof (opcode_t));
}
+
/*
=item C<static INTVAL shift_opcode_integer(PARROT_INTERP, IMAGE_IO *io)>
@@ -870,12 +902,14 @@
(const opcode_t **)opcode);
io->image->bufused -= ((char *)io->image->strstart - start);
- io->image->strlen -= ((char *)io->image->strstart - start);
+ io->image->strlen -= ((char *)io->image->strstart - start);
+
PARROT_ASSERT((int)io->image->bufused >= 0);
return i;
}
+
/*
=item C<static PMC* shift_opcode_pmc(PARROT_INTERP, IMAGE_IO *io)>
@@ -898,6 +932,7 @@
return (PMC *)i;
}
+
/*
=item C<static FLOATVAL shift_opcode_number(PARROT_INTERP, IMAGE_IO *io)>
@@ -919,12 +954,14 @@
(const opcode_t **)opcode);
io->image->bufused -= ((char *)io->image->strstart - start);
- io->image->strlen -= ((char *)io->image->strstart - start);
+ io->image->strlen -= ((char *)io->image->strstart - start);
+
PARROT_ASSERT((int)io->image->bufused >= 0);
return f;
}
+
/*
=item C<static STRING* shift_opcode_string(PARROT_INTERP, IMAGE_IO *io)>
@@ -949,12 +986,14 @@
io->image->strstart = opcode;
io->image->bufused -= (opcode - start);
- io->image->strlen -= (opcode - start);
+ io->image->strlen -= (opcode - start);
+
PARROT_ASSERT((int)io->image->bufused >= 0);
return s;
}
+
/*
=back
@@ -1011,7 +1050,7 @@
ft_init(PARROT_INTERP, ARGIN(visit_info *info))
{
ASSERT_ARGS(ft_init)
- STRING *s = info->image;
+ STRING *s = info->image;
PackFile *pf;
/* We want to store a 16-byte aligned header, but the actual
@@ -1020,23 +1059,24 @@
(PACKFILE_HEADER_BYTES % 16 ?
16 - PACKFILE_HEADER_BYTES % 16 : 0);
- info->image_io = mem_allocate_typed(IMAGE_IO);
+ info->image_io = mem_allocate_typed(IMAGE_IO);
+ info->image_io->image = s = info->image;
- info->image_io->image = s = info->image;
#if FREEZE_ASCII
info->image_io->vtable = &ascii_funcs;
#else
info->image_io->vtable = &opcode_funcs;
#endif
+
pf = info->image_io->pf = PackFile_new(interp, 0);
- if (info->what == VISIT_FREEZE_NORMAL ||
- info->what == VISIT_FREEZE_AT_DESTRUCT) {
+ if (info->what == VISIT_FREEZE_NORMAL
+ || info->what == VISIT_FREEZE_AT_DESTRUCT) {
op_check_size(interp, s, header_length);
mem_sys_memcopy(s->strstart, pf->header, PACKFILE_HEADER_BYTES);
s->bufused += header_length;
- s->strlen += header_length;
+ s->strlen += header_length;
}
else {
if (Parrot_str_byte_length(interp, s) < header_length) {
@@ -1055,18 +1095,21 @@
mem_sys_memcopy(pf->header, s->strstart, PACKFILE_HEADER_BYTES);
PackFile_assign_transforms(pf);
+
s->bufused -= header_length;
- s->strlen -= header_length;
+ s->strlen -= header_length;
+
LVALUE_CAST(char *, s->strstart) += header_length;
}
- info->last_type = -1;
- info->id_list = pmc_new(interp, enum_class_Array);
- info->id = 0;
+ info->last_type = -1;
+ info->id_list = pmc_new(interp, enum_class_Array);
+ info->id = 0;
info->extra_flags = EXTRA_IS_NULL;
- info->container = NULL;
+ info->container = NULL;
}
+
/*
=item C<static void todo_list_init(PARROT_INTERP, visit_info *info)>
@@ -1081,9 +1124,10 @@
todo_list_init(PARROT_INTERP, ARGOUT(visit_info *info))
{
ASSERT_ARGS(todo_list_init)
- info->visit_pmc_now = visit_todo_list;
+ info->visit_pmc_now = visit_todo_list;
info->visit_pmc_later = add_pmc_todo_list;
- /* we must use PMCs here, so that they get marked properly */
+
+ /* we must use PMCs here so that they get marked properly */
info->todo = pmc_new(interp, enum_class_Array);
info->seen = pmc_new(interp, enum_class_Hash);
VTABLE_set_pointer(interp, info->seen, parrot_new_intval_hash(interp));
@@ -1111,36 +1155,42 @@
{
ASSERT_ARGS(freeze_pmc)
IMAGE_IO * const io = info->image_io;
- INTVAL type;
+ INTVAL type;
if (PMC_IS_NULL(pmc)) {
/* NULL + seen bit */
VTABLE_push_pmc(interp, io, (PMC*) 1);
return;
}
+
type = pmc->vtable->base_type;
if (PObj_is_object_TEST(pmc))
type = enum_class_Object;
+
+ /* TODO: get rid of these magic numbers; they look like pointer tags */
if (seen) {
if (info->extra_flags) {
id |= 3;
- VTABLE_push_pmc(interp, io, (PMC*)id);
+ VTABLE_push_pmc(interp, io, (PMC *)id);
VTABLE_push_integer(interp, io, info->extra_flags);
return;
}
+
id |= 1; /* mark bit 0 if this PMC is known */
}
- else if (type == info->last_type) {
+ else if (type == info->last_type)
id |= 2; /* mark bit 1 and don't write type */
- }
+
VTABLE_push_pmc(interp, io, (PMC*)id);
+
if (! (id & 3)) { /* else write type */
VTABLE_push_integer(interp, io, type);
info->last_type = type;
}
}
+
/*
=item C<static int thaw_pmc(PARROT_INTERP, visit_info *info, UINTVAL *id, INTVAL
@@ -1170,41 +1220,46 @@
ARGOUT(UINTVAL *id), ARGOUT(INTVAL *type))
{
ASSERT_ARGS(thaw_pmc)
- PMC *n;
- IMAGE_IO * const io = info->image_io;
- int seen = 0;
+ IMAGE_IO * const io = info->image_io;
+ PMC *n = VTABLE_shift_pmc(interp, io);
+ int seen = 0;
- info->extra_flags = EXTRA_IS_NULL;
- n = VTABLE_shift_pmc(interp, io);
+ info->extra_flags = EXTRA_IS_NULL;
+ /* pmc has extra data */
if (((UINTVAL) n & 3) == 3) {
- /* pmc has extra data */
info->extra_flags = VTABLE_shift_integer(interp, io);
}
- else if ((UINTVAL) n & 1) { /* seen PMCs have bit 0 set */
+
+ /* seen PMCs have bit 0 set */
+ else if ((UINTVAL) n & 1) {
seen = 1;
}
- else if ((UINTVAL) n & 2) { /* prev PMC was same type */
+
+ /* prev PMC was same type */
+ else if ((UINTVAL) n & 2) {
*type = info->last_type;
}
- else { /* type follows */
- *type = VTABLE_shift_integer(interp, io);
+
+ /* type follows */
+ else {
+ *type = VTABLE_shift_integer(interp, io);
info->last_type = *type;
+
if (*type <= 0)
Parrot_ex_throw_from_c_args(interp, NULL, 1,
"Unknown PMC type to thaw %d", (int) *type);
- if (*type >= interp->n_vtable_max ||
- !interp->vtables[*type]) {
- /* that ought to be a class */
+ /* that ought to be a class */
+ if (*type >= interp->n_vtable_max || !interp->vtables[*type])
*type = enum_class_Class;
- }
}
- *id = (UINTVAL) n;
+ *id = (UINTVAL)n;
return seen;
}
+
/*
=item C<static void do_action(PARROT_INTERP, PMC *pmc, visit_info *info, int
@@ -1213,7 +1268,8 @@
Called from C<visit_next_for_GC()> and C<visit_todo_list()> to perform
the action specified in C<< info->what >>.
-Currently only C<VISIT_FREEZE_NORMAL> is implemented.
+Currently only C<VISIT_FREEZE_NORMAL> and C<VISIT_FREEZE_AT_DESTRUCT> are
+implemented.
=cut
@@ -1238,6 +1294,7 @@
}
}
+
/*
=item C<static PMC* thaw_create_pmc(PARROT_INTERP, const visit_info *info,
@@ -1265,14 +1322,17 @@
pmc = constant_pmc_new_noinit(interp, type);
break;
default:
- Parrot_ex_throw_from_c_args(interp, NULL, 1, "Illegal visit_next type");
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "Illegal visit_next type");
}
+
return pmc;
}
+
/*
-=item C<static void do_thaw(PARROT_INTERP, PMC* pmc, visit_info *info)>
+=item C<static void do_thaw(PARROT_INTERP, PMC *pmc, visit_info *info)>
Called by C<visit_todo_list_thaw()> to thaw and return a PMC.
@@ -1284,15 +1344,15 @@
PARROT_INLINE
static void
-do_thaw(PARROT_INTERP, ARGIN_NULLOK(PMC* pmc), ARGIN(visit_info *info))
+do_thaw(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc), ARGIN(visit_info *info))
{
ASSERT_ARGS(do_thaw)
- UINTVAL id;
- INTVAL type;
- PMC ** pos;
- int must_have_seen;
- type = 0; /* it's set below, avoid compiler warning. */
- must_have_seen = thaw_pmc(interp, info, &id, &type);
+ PMC **pos;
+
+ /* set below, but avoid compiler warning */
+ UINTVAL id = 0;
+ INTVAL type = 0;
+ int must_have_seen = thaw_pmc(interp, info, &id, &type);
id >>= 2;
@@ -1306,19 +1366,23 @@
return;
}
- pos = (PMC **)list_get(interp, (List *)PMC_data(info->id_list), id, enum_type_PMC);
- if (pos == (void*)-1)
+ pos = (PMC **)list_get(interp, (List *)PMC_data(info->id_list),
+ id, enum_type_PMC);
+
+ if (pos == (void *)-1)
pos = NULL;
else if (pos) {
- pmc = *(PMC**)pos;
+ pmc = *(PMC **)pos;
if (!pmc)
pos = NULL;
}
+
if (pos) {
if (info->extra_flags == EXTRA_IS_PROP_HASH) {
interp->vtables[enum_class_default]->thaw(interp, pmc, info);
return;
}
+
/* else maybe VTABLE_thaw ... but there is no other extra stuff */
#if FREEZE_USE_NEXT_FOR_GC
@@ -1351,16 +1415,19 @@
pmc = thaw_create_pmc(interp, info, type);
VTABLE_thaw(interp, pmc, info);
+
if (info->extra_flags == EXTRA_CLASS_EXISTS) {
- pmc = (PMC *)info->extra;
- info->extra = NULL;
+ pmc = (PMC *)info->extra;
+ info->extra = NULL;
info->extra_flags = 0;
}
+
if (!info->thaw_result)
info->thaw_result = pmc;
else
*info->thaw_ptr = pmc;
+
list_assign(interp, (List *)PMC_data(info->id_list), id, pmc, enum_type_PMC);
/* remember nested aggregates depth first */
@@ -1371,10 +1438,10 @@
=item C<static UINTVAL id_from_pmc(PARROT_INTERP, PMC* pmc)>
-Find a PMC in an arena, and return an id (left-shifted 2 bits),
-based on its position.
+Finds a PMC in an arena and returns an id (left-shifted 2 bits), based on its
+position.
-If not found, throw an exception.
+If not found, throws an exception.
=cut
@@ -1387,6 +1454,7 @@
return Parrot_gc_get_pmc_index(interp, pmc) << 2;
}
+
/*
=item C<static void add_pmc_next_for_GC(PARROT_INTERP, PMC *pmc, visit_info
@@ -1403,19 +1471,19 @@
{
ASSERT_ARGS(add_pmc_next_for_GC)
PMC_next_for_GC(info->mark_ptr) = pmc;
- info->mark_ptr = PMC_next_for_GC(pmc) = pmc;
+ info->mark_ptr = PMC_next_for_GC(pmc) = pmc;
}
+
/*
=item C<static int next_for_GC_seen(PARROT_INTERP, PMC *pmc, visit_info *info,
UINTVAL *id)>
-Remembers next child to visit via the C<next_for_GC pointer> generate a
-unique ID per PMC and freeze the ID (not the PMC address) so thaw the
-hash-lookup can be replaced by an array lookup then which is a lot
-faster.
+Remembers next child to visit via the C<next_for_GC pointer>. Generates a
+unique ID per PMC and freezes the ID (not the PMC address) so that in thaw, the
+hash-lookup can be replaced by an array lookup.
=cut
@@ -1439,15 +1507,19 @@
seen = 1;
goto skip;
}
+
/* put pmc at the end of the list */
PMC_next_for_GC(info->mark_ptr) = pmc;
+
/* make end self-referential */
info->mark_ptr = PMC_next_for_GC(pmc) = pmc;
+
skip:
*id = id_from_pmc(interp, pmc);
return seen;
}
+
/*
=item C<static void add_pmc_todo_list(PARROT_INTERP, PMC *pmc, visit_info
@@ -1466,14 +1538,15 @@
list_push(interp, (List *)PMC_data(info->todo), pmc, enum_type_PMC);
}
+
/*
=item C<static int todo_list_seen(PARROT_INTERP, PMC *pmc, visit_info *info,
UINTVAL *id)>
-Returns true if the PMC was seen, otherwise it put it on the todo list,
-generates an ID (tag) for PMC, offset by 4 as are addresses, low bits
-are flags.
+Returns true if the PMC was seen, otherwise it put it on the todo list.
+Generates an ID (tag) for PMC, offset by 4 as are addresses. Low bits are
+flags.
=cut
@@ -1494,15 +1567,21 @@
return 1;
}
- info->id += 4; /* next id to freeze */
+ /* next id to freeze */
+ info->id += 4;
+
*id = info->id;
+
parrot_hash_put(interp,
- (Hash *)VTABLE_get_pointer(interp, info->seen), pmc, (void*)*id);
+ (Hash *)VTABLE_get_pointer(interp, info->seen), pmc, (void *)*id);
+
/* remember containers */
list_unshift(interp, (List *)PMC_data(info->todo), pmc, enum_type_PMC);
+
return 0;
}
+
/*
=item C<static void visit_next_for_GC(PARROT_INTERP, PMC* pmc, visit_info*
@@ -1510,8 +1589,7 @@
C<visit_child> callbacks:
-Checks if the PMC was seen, generate an ID for it if not, then do the
-appropriate action.
+Checks if the PMC was seen. If not, generates an ID for it.
=cut
@@ -1521,7 +1599,7 @@
visit_next_for_GC(PARROT_INTERP, ARGIN(PMC* pmc), ARGIN(visit_info* info))
{
ASSERT_ARGS(visit_next_for_GC)
- UINTVAL id;
+ UINTVAL id;
const int seen = next_for_GC_seen(interp, pmc, info, &id);
UNUSED(seen);
@@ -1539,6 +1617,7 @@
*/
}
+
/*
=item C<static void visit_todo_list(PARROT_INTERP, PMC* pmc, visit_info* info)>
@@ -1553,20 +1632,23 @@
visit_todo_list(PARROT_INTERP, ARGIN_NULLOK(PMC* pmc), ARGIN(visit_info* info))
{
ASSERT_ARGS(visit_todo_list)
- UINTVAL id;
- int seen;
+ int seen;
+ UINTVAL id = 0;
if (PMC_IS_NULL(pmc)) {
seen = 1;
- id = 0;
+ id = 0;
}
else
seen = todo_list_seen(interp, pmc, info, &id);
+
do_action(interp, pmc, info, seen, id);
+
if (!seen)
(info->visit_action)(interp, pmc, info);
}
+
/*
=item C<static void visit_todo_list_thaw(PARROT_INTERP, PMC* old, visit_info*
@@ -1587,6 +1669,7 @@
do_thaw(interp, old, info);
}
+
/*
=item C<static void visit_loop_next_for_GC(PARROT_INTERP, PMC *current,
@@ -1609,7 +1692,7 @@
while (current != prev) {
VTABLE_visit(interp, current, info);
- prev = current;
+ prev = current;
current = PMC_next_for_GC(current);
}
}
@@ -1649,7 +1732,7 @@
/* can't cache upper limit, visit may append items */
again:
- while ((list_item = (PMC**)list_shift(interp, todo, enum_type_PMC))) {
+ while ((list_item = (PMC **)list_shift(interp, todo, enum_type_PMC))) {
current = *list_item;
if (!current)
Parrot_ex_throw_from_c_args(interp, NULL, 1,
@@ -1713,8 +1796,8 @@
STRING *hash = CONST_STRING(interp, "hash");
INTVAL len;
- if (!PMC_IS_NULL(pmc) && (VTABLE_does(interp, pmc, array) ||
- VTABLE_does(interp, pmc, hash))) {
+ if (!PMC_IS_NULL(pmc)
+ && (VTABLE_does(interp, pmc, array) || VTABLE_does(interp, pmc, hash))) {
const INTVAL items = VTABLE_elements(interp, pmc);
/* TODO check e.g. first item of aggregate and estimate size */
len = items * FREEZE_BYTES_PER_ITEM;
@@ -1725,6 +1808,7 @@
info->image = Parrot_str_new_noinit(interp, enum_stringrep_one, len);
}
+
/*
=item C<static PMC* run_thaw(PARROT_INTERP, STRING* image, visit_enum_type
@@ -1752,13 +1836,13 @@
run_thaw(PARROT_INTERP, ARGIN(STRING* image), visit_enum_type what)
{
ASSERT_ARGS(run_thaw)
- visit_info info;
- int gc_block = 0;
- const UINTVAL bufused = image->bufused;
+ visit_info info;
+ int gc_block = 0;
+ const UINTVAL bufused = image->bufused;
info.image = image;
/*
- * if we are thawing a lot of PMCs, its cheaper to do
+ * if we are thawing a lot of PMCs, it's cheaper to do
* a GC run first and then block GC - the limit should be
* chosen so that no more then one GC run would be triggered
*
@@ -1774,35 +1858,40 @@
gc_block = 1;
}
- info.what = what; /* _NORMAL or _CONSTANTS */
+ /* _NORMAL or _CONSTANTS */
+ info.what = what;
+
todo_list_init(interp, &info);
- info.visit_pmc_now = visit_todo_list_thaw;
+ info.visit_pmc_now = visit_todo_list_thaw;
info.visit_pmc_later = add_pmc_todo_list;
info.thaw_result = NULL;
- /*
- * run thaw loop
- */
+
+ /* run thaw loop */
visit_loop_todo_list(interp, NULL, &info);
+
/*
- * thaw does "consume" the image string by incrementing strstart
+ * thaw consumes the image string by incrementing strstart
* and decrementing bufused - restore that
*/
LVALUE_CAST(char *, image->strstart) -= bufused;
image->bufused = bufused;
image->strlen += bufused;
+
PARROT_ASSERT(image->strstart >= (char *)Buffer_bufstart(image));
if (gc_block) {
Parrot_unblock_GC_mark(interp);
Parrot_unblock_GC_sweep(interp);
}
+
PackFile_destroy(interp, info.image_io->pf);
mem_sys_free(info.image_io);
info.image_io = NULL;
return info.thaw_result;
}
+
/*
=back
@@ -1813,8 +1902,8 @@
=item C<STRING* Parrot_freeze_at_destruct(PARROT_INTERP, PMC* pmc)>
-This function must not consume any resources (except the image itself).
-It uses the C<next_for_GC> pointer, so its not reentrant and must not be
+This function must not consume any resources (except the image itself). It
+uses the C<next_for_GC> pointer, so it's not reentrant and must not be
interrupted by a GC run.
=cut
@@ -1832,11 +1921,13 @@
Parrot_block_GC_mark(interp);
Parrot_gc_cleanup_next_for_GC(interp);
- info.what = VISIT_FREEZE_AT_DESTRUCT;
- info.mark_ptr = pmc;
- info.thaw_ptr = NULL;
- info.visit_pmc_now = visit_next_for_GC;
+
+ info.what = VISIT_FREEZE_AT_DESTRUCT;
+ info.mark_ptr = pmc;
+ info.thaw_ptr = NULL;
+ info.visit_pmc_now = visit_next_for_GC;
info.visit_pmc_later = add_pmc_next_for_GC;
+
create_image(interp, pmc, &info);
ft_init(interp, &info);
@@ -1848,9 +1939,10 @@
return info.image;
}
+
/*
-=item C<STRING* Parrot_freeze(PARROT_INTERP, PMC* pmc)>
+=item C<STRING* Parrot_freeze(PARROT_INTERP, PMC *pmc)>
Freeze using either method.
@@ -1862,7 +1954,7 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
STRING*
-Parrot_freeze(PARROT_INTERP, ARGIN(PMC* pmc))
+Parrot_freeze(PARROT_INTERP, ARGIN(PMC *pmc))
{
ASSERT_ARGS(Parrot_freeze)
#if FREEZE_USE_NEXT_FOR_GC
@@ -1891,11 +1983,12 @@
#endif
}
+
/*
-=item C<PMC* Parrot_thaw(PARROT_INTERP, STRING* image)>
+=item C<PMC* Parrot_thaw(PARROT_INTERP, STRING *image)>
-Thaw a PMC, called from the C<thaw> opcode.
+Thaws a PMC. Called from the C<thaw> opcode.
=cut
@@ -1905,18 +1998,18 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
PMC*
-Parrot_thaw(PARROT_INTERP, ARGIN(STRING* image))
+Parrot_thaw(PARROT_INTERP, ARGIN(STRING *image))
{
ASSERT_ARGS(Parrot_thaw)
return run_thaw(interp, image, VISIT_THAW_NORMAL);
}
+
/*
-=item C<PMC* Parrot_thaw_constants(PARROT_INTERP, STRING* image)>
+=item C<PMC* Parrot_thaw_constants(PARROT_INTERP, STRING *image)>
-Thaw the constants. This is used by PackFile for unpacking PMC
-constants.
+Thaws constants, used by PackFile for unpacking PMC constants.
=cut
@@ -1926,19 +2019,19 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
PMC*
-Parrot_thaw_constants(PARROT_INTERP, ARGIN(STRING* image))
+Parrot_thaw_constants(PARROT_INTERP, ARGIN(STRING *image))
{
ASSERT_ARGS(Parrot_thaw_constants)
return run_thaw(interp, image, VISIT_THAW_CONSTANTS);
}
+
/*
-=item C<PMC* Parrot_clone(PARROT_INTERP, PMC* pmc)>
+=item C<PMC* Parrot_clone(PARROT_INTERP, PMC *pmc)>
There are for sure shortcuts to clone faster, e.g. always thaw the image
-immediately or use a special callback. But for now we just thaw a frozen
-PMC.
+immediately or use a special callback. For now we just thaw a frozen PMC.
=cut
@@ -1948,19 +2041,20 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
PMC*
-Parrot_clone(PARROT_INTERP, ARGIN(PMC* pmc))
+Parrot_clone(PARROT_INTERP, ARGIN(PMC *pmc))
{
ASSERT_ARGS(Parrot_clone)
return VTABLE_clone(interp, pmc);
}
+
/*
=back
=head1 TODO
-The seen-hash version for freezing might go away sometimes.
+The seen-hash version for freezing might go away sometime.
=head1 SEE ALSO
Modified: branches/gc-refactor/src/runcore/cores.c
==============================================================================
--- branches/gc-refactor/src/runcore/cores.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/runcore/cores.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -241,9 +241,27 @@
#include "parrot/runcore_api.h"
#include "parrot/embed.h"
#include "parrot/runcore_trace.h"
+#include "cores.str"
+
+#include "parrot/oplib/ops.h"
+#include "parrot/oplib/core_ops.h"
+#include "parrot/oplib/core_ops_switch.h"
+#include "parrot/dynext.h"
+
+#include "../pmc/pmc_sub.h"
#ifdef HAVE_COMPUTED_GOTO
# include "parrot/oplib/core_ops_cg.h"
+# include "parrot/oplib/core_ops_cgp.h"
+#endif
+
+#if JIT_CAPABLE
+# include "parrot/exec.h"
+# include "../jit.h"
+#endif
+
+#ifdef WIN32
+# define getpid _getpid
#endif
/* HEADERIZER HFILE: include/parrot/runcore_api.h */
@@ -251,31 +269,543 @@
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+PARROT_CAN_RETURN_NULL
+static void * init_profiling_core(PARROT_INTERP,
+ ARGIN(Parrot_profiling_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t * runops_cgoto_core(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static opcode_t * runops_cgp_core(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t * runops_debugger_core(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t * runops_exec_core(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t * runops_fast_core(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t * runops_gc_debug_core(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t * runops_jit_core(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-static opcode_t * runops_trace_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+static opcode_t * runops_profiling_core(PARROT_INTERP,
+ ARGIN(Parrot_profiling_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t * runops_slow_core(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static opcode_t * runops_switch_core(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
__attribute__nonnull__(1)
- __attribute__nonnull__(2);
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t * runops_trace_core(PARROT_INTERP,
+ ARGIN(Parrot_runcore_t *runcore),
+ ARGIN(opcode_t *pc))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
+#define ASSERT_ARGS_init_profiling_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_cgoto_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_cgp_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_debugger_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_exec_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_fast_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_gc_debug_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_jit_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_profiling_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_slow_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
+ || PARROT_ASSERT_ARG(pc)
+#define ASSERT_ARGS_runops_switch_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
+ || PARROT_ASSERT_ARG(pc)
#define ASSERT_ARGS_runops_trace_core __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(runcore) \
|| PARROT_ASSERT_ARG(pc)
/* 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<void Parrot_runcore_slow_init(PARROT_INTERP)>
+
+Registers the slow runcore with Parrot.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_slow_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_slow_init)
+
+ Parrot_runcore_t *coredata = mem_allocate_typed(Parrot_runcore_t);
+ coredata->name = CONST_STRING(interp, "slow");
+ coredata->id = PARROT_SLOW_CORE;
+ coredata->opinit = PARROT_CORE_OPLIB_INIT;
+ coredata->runops = runops_slow_core;
+ coredata->prepare_run = NULL;
+ coredata->destroy = NULL;
+ coredata->flags = 0;
+
+ PARROT_RUNCORE_FUNC_TABLE_SET(coredata);
+
+ Parrot_runcore_register(interp, coredata);
+
+ /* it's the first runcore and the default runcore */
+ Parrot_runcore_switch(interp, coredata->name);
+}
+
/*
-=item C<opcode_t * runops_fast_core(PARROT_INTERP, opcode_t *pc)>
+=item C<void Parrot_runcore_fast_init(PARROT_INTERP)>
+
+Registers the fast runcore with Parrot.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_fast_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_fast_init)
+
+ Parrot_runcore_t *coredata = mem_allocate_typed(Parrot_runcore_t);
+ coredata->name = CONST_STRING(interp, "fast");
+ coredata->id = PARROT_FAST_CORE;
+ coredata->opinit = PARROT_CORE_OPLIB_INIT;
+ coredata->runops = runops_fast_core;
+ coredata->destroy = NULL;
+ coredata->prepare_run = NULL;
+ coredata->flags = 0;
+
+ PARROT_RUNCORE_FUNC_TABLE_SET(coredata);
+
+ Parrot_runcore_register(interp, coredata);
+}
+
+
+/*
+
+=item C<void Parrot_runcore_switch_init(PARROT_INTERP)>
+
+Registers the switch runcore with Parrot.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_switch_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_switch_init)
+
+ Parrot_runcore_t *coredata = mem_allocate_typed(Parrot_runcore_t);
+ coredata->name = CONST_STRING(interp, "switch");
+ coredata->id = PARROT_SWITCH_CORE;
+ coredata->opinit = PARROT_CORE_SWITCH_OPLIB_INIT;
+ coredata->runops = runops_switch_core;
+ coredata->prepare_run = init_prederef;
+ coredata->destroy = NULL;
+ coredata->flags = 0;
+
+ PARROT_RUNCORE_PREDEREF_OPS_SET(coredata);
+
+ Parrot_runcore_register(interp, coredata);
+}
+
+
+/*
+
+=item C<void Parrot_runcore_jit_init(PARROT_INTERP)>
+
+Registers the jit runcore with Parrot.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_jit_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_jit_init)
+
+ Parrot_runcore_t *coredata = mem_allocate_typed(Parrot_runcore_t);
+ coredata->name = CONST_STRING(interp, "jit");
+ coredata->id = PARROT_JIT_CORE;
+ coredata->opinit = PARROT_CORE_OPLIB_INIT;
+ coredata->prepare_run = init_jit_run;
+ coredata->runops = runops_jit_core;
+ coredata->destroy = NULL;
+ coredata->flags = 0;
+
+ PARROT_RUNCORE_JIT_OPS_SET(coredata);
+
+ Parrot_runcore_register(interp, coredata);
+}
+
+
+/*
+
+=item C<void Parrot_runcore_switch_jit_init(PARROT_INTERP)>
+
+Registers the switch_jit runcore with Parrot.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_switch_jit_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_switch_jit_init)
+
+ Parrot_runcore_t *coredata = mem_allocate_typed(Parrot_runcore_t);
+ coredata->name = CONST_STRING(interp, "switch_jit");
+ coredata->id = PARROT_SWITCH_JIT_CORE;
+ coredata->opinit = PARROT_CORE_SWITCH_OPLIB_INIT;
+ coredata->destroy = NULL;
+ coredata->prepare_run = init_prederef;
+ coredata->runops = runops_switch_core;
+ coredata->flags = 0;
+
+ PARROT_RUNCORE_PREDEREF_OPS_SET(coredata);
+ PARROT_RUNCORE_JIT_OPS_SET(coredata);
+
+ Parrot_runcore_register(interp, coredata);
+}
+
+
+/*
+
+=item C<void Parrot_runcore_exec_init(PARROT_INTERP)>
+
+Registers the exec runcore with Parrot.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_exec_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_exec_init)
+
+ Parrot_runcore_t *coredata = mem_allocate_typed(Parrot_runcore_t);
+ coredata->name = CONST_STRING(interp, "exec");
+ coredata->id = PARROT_EXEC_CORE;
+ coredata->opinit = PARROT_CORE_OPLIB_INIT;
+ coredata->runops = runops_exec_core;
+ coredata->destroy = NULL;
+ coredata->prepare_run = NULL;
+ coredata->flags = 0;
+
+ Parrot_runcore_register(interp, coredata);
+}
+
+
+/*
+
+=item C<void Parrot_runcore_gc_debug_init(PARROT_INTERP)>
+
+Registers the gc_debug runcore with Parrot.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_gc_debug_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_gc_debug_init)
+
+ Parrot_runcore_t *coredata = mem_allocate_typed(Parrot_runcore_t);
+ coredata->name = CONST_STRING(interp, "gc_debug");
+ coredata->id = PARROT_GC_DEBUG_CORE;
+ coredata->opinit = PARROT_CORE_OPLIB_INIT;
+ coredata->runops = runops_gc_debug_core;
+ coredata->destroy = NULL;
+ coredata->prepare_run = NULL;
+ coredata->flags = 0;
+
+ PARROT_RUNCORE_FUNC_TABLE_SET(coredata);
+
+ Parrot_runcore_register(interp, coredata);
+}
+
+
+/*
+
+=item C<void Parrot_runcore_debugger_init(PARROT_INTERP)>
+
+Registers the debugger runcore with Parrot.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_debugger_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_debugger_init)
+
+ Parrot_runcore_t *coredata = mem_allocate_typed(Parrot_runcore_t);
+ coredata->name = CONST_STRING(interp, "debugger");
+ coredata->id = PARROT_DEBUGGER_CORE;
+ coredata->opinit = PARROT_CORE_OPLIB_INIT;
+ coredata->prepare_run = init_prederef;
+ coredata->runops = runops_debugger_core;
+ coredata->destroy = NULL;
+ coredata->flags = 0;
+
+ PARROT_RUNCORE_FUNC_TABLE_SET(coredata);
+
+ Parrot_runcore_register(interp, coredata);
+}
+
+
+/*
+
+=item C<void Parrot_runcore_cgp_init(PARROT_INTERP)>
+
+Registers the CGP runcore with Parrot.
+
+=cut
+
+*/
+
+#ifdef HAVE_COMPUTED_GOTO
+
+void
+Parrot_runcore_cgp_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_cgp_init)
+
+ Parrot_runcore_t *coredata = mem_allocate_typed(Parrot_runcore_t);
+ coredata->name = CONST_STRING(interp, "cgp");
+ coredata->id = PARROT_CGP_CORE;
+ coredata->opinit = PARROT_CORE_CGP_OPLIB_INIT;
+ coredata->prepare_run = init_prederef;
+ coredata->runops = runops_cgp_core;
+ coredata->flags = 0;
+
+ coredata->destroy = NULL;
+
+ PARROT_RUNCORE_CGOTO_OPS_SET(coredata);
+ PARROT_RUNCORE_EVENT_CHECK_SET(coredata);
+ PARROT_RUNCORE_PREDEREF_OPS_SET(coredata);
+
+ Parrot_runcore_register(interp, coredata);
+}
+
+
+/*
+
+=item C<void Parrot_runcore_cgoto_init(PARROT_INTERP)>
+
+Registers the cgoto runcore with Parrot.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_cgoto_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_cgoto_init)
+
+ Parrot_runcore_t *coredata = mem_allocate_typed(Parrot_runcore_t);
+ coredata->name = CONST_STRING(interp, "cgoto");
+ coredata->id = PARROT_CGOTO_CORE;
+ coredata->opinit = PARROT_CORE_CG_OPLIB_INIT;
+ coredata->runops = runops_cgoto_core;
+ coredata->destroy = NULL;
+ coredata->prepare_run = NULL;
+ coredata->flags = 0;
+
+ PARROT_RUNCORE_FUNC_TABLE_SET(coredata);
+ PARROT_RUNCORE_CGOTO_OPS_SET(coredata);
+
+ Parrot_runcore_register(interp, coredata);
+}
+
+
+/*
+
+=item C<void Parrot_runcore_cgp_jit_init(PARROT_INTERP)>
+
+Registers the CGP/JIT runcore with Parrot.
+
+=cut
+
+*/
+
+
+void
+Parrot_runcore_cgp_jit_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_cgp_jit_init)
+
+ Parrot_runcore_t *coredata = mem_allocate_typed(Parrot_runcore_t);
+ coredata->name = CONST_STRING(interp, "cgp_jit");
+ coredata->id = PARROT_CGP_JIT_CORE;
+ coredata->opinit = PARROT_CORE_CGP_OPLIB_INIT;
+ coredata->prepare_run = init_prederef;
+ coredata->runops = runops_cgp_core;
+ coredata->destroy = NULL;
+ coredata->flags = 0;
+
+ PARROT_RUNCORE_JIT_OPS_SET(coredata);
+ PARROT_RUNCORE_CGOTO_OPS_SET(coredata);
+ PARROT_RUNCORE_EVENT_CHECK_SET(coredata);
+ PARROT_RUNCORE_PREDEREF_OPS_SET(coredata);
+
+ Parrot_runcore_register(interp, coredata);
+}
+
+#endif /* #ifdef HAVE_COMPUTED_GOTO */
+
+/*
+
+=item C<void Parrot_runcore_profiling_init(PARROT_INTERP)>
+
+Registers the profiling runcore with Parrot.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_profiling_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_profiling_init)
+
+ Parrot_profiling_runcore_t *coredata =
+ mem_allocate_typed(Parrot_profiling_runcore_t);
+ coredata->name = CONST_STRING(interp, "profiling");
+ coredata->id = PARROT_PROFILING_CORE;
+ coredata->opinit = PARROT_CORE_OPLIB_INIT;
+ coredata->runops = (Parrot_runcore_runops_fn_t) init_profiling_core;
+ coredata->destroy = NULL;
+ coredata->prepare_run = NULL;
+ coredata->flags = 0;
+
+ PARROT_RUNCORE_FUNC_TABLE_SET(coredata);
+
+ Parrot_runcore_register(interp, (Parrot_runcore_t *) coredata);
+}
+
+
+/*
+
+=item C<static opcode_t * runops_fast_core(PARROT_INTERP, Parrot_runcore_t
+*runcore, opcode_t *pc)>
Runs the Parrot operations starting at C<pc> until there are no more
operations. This performs no bounds checking, profiling, or tracing.
@@ -286,8 +816,8 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_fast_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+static opcode_t *
+runops_fast_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc))
{
ASSERT_ARGS(runops_fast_core)
@@ -311,7 +841,8 @@
/*
-=item C<opcode_t * runops_cgoto_core(PARROT_INTERP, opcode_t *pc)>
+=item C<static opcode_t * runops_cgoto_core(PARROT_INTERP, Parrot_runcore_t
+*runcore, opcode_t *pc)>
Runs the Parrot operations starting at C<pc> until there are no more
operations, using the computed C<goto> core, performing no bounds checking,
@@ -325,8 +856,8 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_cgoto_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+static opcode_t *
+runops_cgoto_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc))
{
ASSERT_ARGS(runops_cgoto_core)
@@ -344,10 +875,22 @@
#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)
+
+
/*
-=item C<static opcode_t * runops_trace_core(PARROT_INTERP, opcode_t *pc)>
+=item C<static opcode_t * runops_trace_core(PARROT_INTERP, Parrot_runcore_t
+*runcore, opcode_t *pc)>
Runs the Parrot operations starting at C<pc> until there are no more
operations, using the tracing interpreter.
@@ -359,7 +902,7 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
static opcode_t *
-runops_trace_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+runops_trace_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc))
{
ASSERT_ARGS(runops_trace_core)
@@ -436,7 +979,8 @@
/*
-=item C<opcode_t * runops_slow_core(PARROT_INTERP, opcode_t *pc)>
+=item C<static opcode_t * runops_slow_core(PARROT_INTERP, Parrot_runcore_t
+*runcore, opcode_t *pc)>
Runs the Parrot operations starting at C<pc> until there are no more
operations, with tracing and bounds checking enabled.
@@ -447,13 +991,13 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_slow_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+static opcode_t *
+runops_slow_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc))
{
ASSERT_ARGS(runops_slow_core)
if (Interp_trace_TEST(interp, PARROT_TRACE_OPS_FLAG))
- return runops_trace_core(interp, pc);
+ return runops_trace_core(interp, runcore, pc);
#if 0
if (interp->debugger && interp->debugger->pdb)
return Parrot_debug(interp, interp->debugger, pc);
@@ -475,7 +1019,8 @@
/*
-=item C<opcode_t * runops_gc_debug_core(PARROT_INTERP, opcode_t *pc)>
+=item C<static opcode_t * runops_gc_debug_core(PARROT_INTERP, Parrot_runcore_t
+*runcore, opcode_t *pc)>
Runs the Parrot operations starting at C<pc> until there are no more
operations, performing a full GC run before each op. This is very slow, but
@@ -487,8 +1032,8 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_gc_debug_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+static opcode_t *
+runops_gc_debug_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc))
{
ASSERT_ARGS(runops_gc_debug_core)
while (pc) {
@@ -505,13 +1050,86 @@
return pc;
}
-#undef code_start
-#undef code_end
+/*
+
+=item C<static void * init_profiling_core(PARROT_INTERP,
+Parrot_profiling_runcore_t *runcore, opcode_t *pc)>
+
+Perform initialization for the profiling runcore.
+
+=cut
+
+*/
+
+PARROT_CAN_RETURN_NULL
+static void *
+init_profiling_core(PARROT_INTERP, ARGIN(Parrot_profiling_runcore_t *runcore), ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(init_profiling_core)
+
+ char *profile_filename, *profile_output_var;
+ int free_env_var;
+
+ profile_output_var = Parrot_getenv("PARROT_PROFILING_OUTPUT", &free_env_var);
+
+ if (profile_output_var) {
+
+ STRING *lc_filename;
+ runcore->profile_filename = Parrot_str_new(interp, profile_output_var, 0);
+ profile_filename = Parrot_str_to_cstring(interp, runcore->profile_filename);
+ lc_filename = Parrot_str_downcase(interp, runcore->profile_filename);
+
+ if (Parrot_str_equal(interp, lc_filename, CONST_STRING(interp, "stderr"))) {
+ runcore->profile_fd = stderr;
+ runcore->profile_filename = lc_filename;
+ }
+ else if (Parrot_str_equal(interp, lc_filename, CONST_STRING(interp, "stdout"))) {
+ runcore->profile_fd = stdout;
+ runcore->profile_filename = lc_filename;
+ }
+ else {
+ runcore->profile_fd = fopen(profile_filename, "w");
+ }
+
+ if (free_env_var)
+ mem_sys_free(profile_output_var);
+ }
+ else {
+ runcore->profile_filename = Parrot_sprintf_c(interp, "parrot.pprof.%d", getpid());
+ profile_filename = Parrot_str_to_cstring(interp, runcore->profile_filename);
+ runcore->profile_fd = fopen(profile_filename, "w");
+ }
+
+ /* profile_filename gets collected if it's not marked or in the root set. */
+ gc_register_pmc(interp, (PMC *) runcore->profile_filename);
+
+ runcore->runops = (Parrot_runcore_runops_fn_t) runops_profiling_core;
+ runcore->destroy = (Parrot_runcore_destroy_fn_t) destroy_profiling_core;
+
+ runcore->prev_ctx = 0;
+ runcore->profiling_flags = 0;
+ runcore->runloop_count = 0;
+ runcore->level = 0;
+ runcore->time_size = 32;
+ runcore->time = mem_allocate_n_typed(runcore->time_size, UHUGEINTVAL);
+ Profiling_first_loop_SET(runcore);
+
+ if (!runcore->profile_fd) {
+ fprintf(stderr, "unable to open %s for writing", profile_filename);
+ Parrot_str_free_cstring(profile_filename);
+ exit(1);
+ }
+
+ Parrot_str_free_cstring(profile_filename);
+
+ return runops_profiling_core(interp, runcore, pc);
+}
/*
-=item C<opcode_t * runops_profile_core(PARROT_INTERP, opcode_t *pc)>
+=item C<static opcode_t * runops_profiling_core(PARROT_INTERP,
+Parrot_profiling_runcore_t *runcore, opcode_t *pc)>
Runs the Parrot operations starting at C<pc> until there are no more
operations, with tracing, bounds checking, and profiling enabled.
@@ -522,45 +1140,209 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_profile_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+static opcode_t *
+runops_profiling_core(PARROT_INTERP, ARGIN(Parrot_profiling_runcore_t *runcore),
+ARGIN(opcode_t *pc))
{
- ASSERT_ARGS(runops_profile_core)
- RunProfile * const profile = interp->profile;
- const opcode_t old_op = profile->cur_op;
-
- /* if reentering the runloop, remember old op and calc time 'til now */
- if (old_op)
- profile->data[old_op].time +=
- Parrot_floatval_time() - profile->starttime;
+ ASSERT_ARGS(runops_profiling_core)
- while (pc) {/* && pc >= code_start && pc < code_end) */
- opcode_t cur_op;
+ Parrot_Context_info preop_info, postop_info;
+ PMC *preop_sub, *argv;
+ opcode_t *preop_pc;
+ UHUGEINTVAL op_time;
+ STRING *unknown_file = CONST_STRING(interp, "<unknown file>");
+
+ runcore->runcore_start = Parrot_hires_get_time();
+
+ /* if we're in a nested runloop, */
+ if (runcore->level != 0) {
+
+ if (runcore->level > runcore->time_size) {
+ runcore->time_size *= 2;
+ runcore->time =
+ mem_realloc_n_typed(runcore->time, runcore->time_size+1, UHUGEINTVAL);
+ }
- 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++;
+ /* store the time between DO_OP and the start of this runcore in this
+ * op's running total */
+ runcore->time[runcore->level] = runcore->runcore_start - runcore->op_start;
+ }
+
+ Parrot_Context_get_info(interp, CURRENT_CONTEXT(interp), &postop_info);
+
+ argv = VTABLE_get_pmc_keyed_int(interp, interp->iglobals, IGLOBALS_ARGV_LIST);
+
+ if (argv && !Profiling_have_printed_cli_TEST(runcore)) {
+
+ /* silly way to avoid line length codingstds nit */
+ PMC *iglobals = interp->iglobals;
+ PMC *executable = VTABLE_get_pmc_keyed_int(interp, iglobals, IGLOBALS_EXECUTABLE);
+ STRING *command_line = Parrot_str_join(interp, CONST_STRING(interp, " "), argv);
+
+ char *exec_cstr, *command_line_cstr;
+
+ exec_cstr = Parrot_str_to_cstring(interp, VTABLE_get_string(interp, executable));
+ command_line_cstr = Parrot_str_to_cstring(interp, command_line);
+
+ /* The CLI line won't reflect any options passed to the parrot binary. */
+ fprintf(runcore->profile_fd, "CLI:%s %s\n", exec_cstr, command_line_cstr);
+
+ Parrot_str_free_cstring(exec_cstr);
+ Parrot_str_free_cstring(command_line_cstr);
+
+ Profiling_have_printed_cli_SET(runcore);
+ }
- DO_OP(pc, interp);
- /* profile->cur_op may be different, if exception was thrown */
- profile->data[profile->cur_op].time +=
- Parrot_floatval_time() - profile->starttime;
+ if (Profiling_first_loop_TEST(runcore)) {
+
+ fprintf(runcore->profile_fd, "VERSION:1\n");
+ /* silly hack to make all separate runloops appear to come from a single source */
+ /* NOTE: yes, {x{ foo:bar }x} is ugly an inefficient. Escaping would
+ * be more effort but the priority right now is to get the runcore
+ * working correctly. Once all the bugs are ironed out we'll switch to
+ * a nice efficient compressed binary format. */
+ fprintf(runcore->profile_fd,
+ "CS:{x{ns:main}x}{x{file:no_file}x}{x{sub:0x1}x}{x{ctx:0x1}x}\n");
+ fprintf(runcore->profile_fd,
+ "OP:{x{line:%d}x}{x{time:0}x}{x{op:noop}x}\n", (int) runcore->runloop_count);
+ runcore->runloop_count++;
+ Profiling_first_loop_CLEAR(runcore);
}
- if (old_op) {
- /* old opcode continues */
- profile->starttime = Parrot_floatval_time();
- profile->cur_op = old_op;
+ while (pc) {
+
+ STRING *postop_file_name;
+ Parrot_Context *preop_ctx;
+
+ 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");
+ }
+
+ /* avoid an extra call to Parrot_Context_get_info */
+ mem_sys_memcopy(&preop_info, &postop_info, sizeof (Parrot_Context_info));
+
+ Parrot_Context_get_info(interp, CURRENT_CONTEXT(interp), &postop_info);
+
+ CONTEXT(interp)->current_pc = pc;
+ preop_sub = CONTEXT(interp)->current_sub;
+ preop_pc = pc;
+ preop_ctx = CONTEXT(interp);
+
+ runcore->level++;
+ Profiling_exit_check_CLEAR(runcore);
+ runcore->op_start = Parrot_hires_get_time();
+ DO_OP(pc, interp);
+ runcore->op_finish = Parrot_hires_get_time();
+
+ if (Profiling_exit_check_TEST(runcore)) {
+ op_time = runcore->op_finish - runcore->runcore_finish;
+ op_time += runcore->time[runcore->level];
+ runcore->time[runcore->level] = 0;
+ }
+ else {
+ op_time = runcore->op_finish - runcore->op_start;
+ }
+
+ runcore->level--;
+ postop_file_name = postop_info.file;
+
+ if (!postop_file_name) postop_file_name = unknown_file;
+
+ /* if current context changed since the last time a CS line was printed... */
+ /* Occasionally the ctx stays the same while the sub changes, possible
+ * with a call to a subclass' method. */
+ if ((runcore->prev_ctx != preop_ctx) || runcore->prev_sub != preop_ctx->current_sub) {
+
+ if (preop_ctx->current_sub) {
+ STRING *sub_name;
+ char *sub_cstr, *filename_cstr, *ns_cstr;
+
+ GETATTR_Sub_name(interp, preop_ctx->current_sub, sub_name);
+ sub_cstr = Parrot_str_to_cstring(interp, sub_name);
+ filename_cstr = Parrot_str_to_cstring(interp, postop_file_name);
+ ns_cstr = Parrot_str_to_cstring(interp,
+ VTABLE_get_string(interp, preop_ctx->current_namespace));
+
+ fprintf(runcore->profile_fd,
+ "CS:{x{ns:%s;%s}x}{x{file:%s}x}{x{sub:0x%p}x}{x{ctx:0x%p}x}\n",
+ ns_cstr, sub_cstr, filename_cstr,
+ preop_ctx->current_sub,
+ preop_ctx);
+
+ Parrot_str_free_cstring(sub_cstr);
+ Parrot_str_free_cstring(filename_cstr);
+ Parrot_str_free_cstring(ns_cstr);
+ }
+
+ runcore->prev_ctx = preop_ctx;
+ runcore->prev_sub = preop_ctx->current_sub;
+ }
+
+ /* I'd expect that preop_info.line would be the right thing to use here
+ * but it gives me obviously incorrect results while postop_info.line
+ * works. It might be an imcc bug or it might just be me
+ * misunderstanding something. */
+ fprintf(runcore->profile_fd, "OP:{x{line:%d}x}{x{time:%li}x}{x{op:%s}x}\n",
+ postop_info.line, (unsigned long)op_time,
+ (interp->op_info_table)[*preop_pc].name);
+
+ } /* while (pc) */
+
+ /* make it easy to tell separate runloops apart */
+ if (runcore->level == 0) {
+ fprintf(runcore->profile_fd, "END_OF_RUNLOOP\n");
+ /* silly hack to make all separate runloops appear to come from a single source */
+ fprintf(runcore->profile_fd,
+ "CS:{x{ns:main}x}{x{file:no_file}x}{x{sub:0x1}x}{x{ctx:0x1}x}\n");
+ fprintf(runcore->profile_fd,
+ "OP:{x{line:%d}x}{x{time:0}x}{x{op:noop}x}\n", (int) runcore->runloop_count);
+ runcore->runloop_count++;
}
+ Profiling_exit_check_SET(runcore);
+ runcore->runcore_finish = Parrot_hires_get_time();;
return pc;
}
+
+/*
+
+=item C<void * destroy_profiling_core(PARROT_INTERP, Parrot_profiling_runcore_t
+*runcore)>
+
+Perform any finalization needed by the profiling runcore.
+
+=cut
+
+*/
+
+PARROT_CAN_RETURN_NULL
+void *
+destroy_profiling_core(PARROT_INTERP, ARGIN(Parrot_profiling_runcore_t *runcore))
+{
+ ASSERT_ARGS(destroy_profiling_core)
+
+ char *filename_cstr = Parrot_str_to_cstring(interp, runcore->profile_filename);
+ fprintf(stderr, "\nPROFILING RUNCORE: wrote profile to %s\n", filename_cstr);
+ fprintf(stderr, "Use tools/dev/pprof2cg.pl to generate Callgrind-compatible "
+ "output from this file.\n");
+ Parrot_str_free_cstring(filename_cstr);
+
+ fclose(runcore->profile_fd);
+ mem_sys_free(runcore->time);
+
+ return NULL;
+}
+
+#undef code_start
+#undef code_end
+
/*
-=item C<opcode_t * runops_debugger_core(PARROT_INTERP, opcode_t *pc)>
+=item C<static opcode_t * runops_debugger_core(PARROT_INTERP, Parrot_runcore_t
+*runcore, opcode_t *pc)>
Used by the debugger, under construction
@@ -570,17 +1352,15 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
-opcode_t *
-runops_debugger_core(PARROT_INTERP, ARGIN(opcode_t *pc))
+static opcode_t *
+runops_debugger_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc))
{
ASSERT_ARGS(runops_debugger_core)
- /*fprintf(stderr, "Enter runops_debugger_core\n");*/
PARROT_ASSERT(interp->pdb);
- if (interp->pdb->state & PDB_ENTER) {
+ if (interp->pdb->state & PDB_ENTER)
Parrot_debugger_start(interp, pc);
- }
while (pc) {
if (pc < interp->code->base.data || pc >= interp->code->base.data + interp->code->base.size)
@@ -604,24 +1384,335 @@
if (interp->pdb->state & PDB_STOPPED) {
Parrot_debugger_start(interp, pc);
}
- else
- {
+ else {
if (PDB_break(interp)) {
Parrot_debugger_start(interp, pc);
continue;
}
- if (interp->pdb->tracing) {
- if (--interp->pdb->tracing == 0) {
- Parrot_debugger_start(interp, pc);
- }
- }
+ if (interp->pdb->tracing && --interp->pdb->tracing == 0)
+ Parrot_debugger_start(interp, pc);
}
}
return pc;
}
+
+/*
+
+=item C<static opcode_t * runops_switch_core(PARROT_INTERP, Parrot_runcore_t
+*runcore, opcode_t *pc)>
+
+Runs the C<switch> core.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static opcode_t *
+runops_switch_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_switch_core)
+ opcode_t * const code_start = (opcode_t *)interp->code->base.data;
+ opcode_t *pc_prederef;
+
+ init_prederef(interp, runcore);
+ pc_prederef = (opcode_t*)interp->code->prederef.code + (pc - code_start);
+
+ return switch_core(pc_prederef, interp);
+}
+
+
+/*
+
+=item C<void * init_prederef(PARROT_INTERP, Parrot_runcore_t *runcore)>
+
+Initialize: load prederef C<func_table>, file prederef.code.
+
+=cut
+
+*/
+
+PARROT_CAN_RETURN_NULL
+void *
+init_prederef(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore))
+{
+ ASSERT_ARGS(init_prederef)
+ load_prederef(interp, runcore);
+
+ if (!interp->code->prederef.code) {
+ void *pred_func;
+ opcode_t *pc = interp->code->base.data;
+ const size_t N = interp->code->base.size;
+ size_t i, n_pics;
+
+/* Parrot_memalign_if_possible in OpenBSD allocates 256 if you ask for 312
+ -- Need to verify this, it may have been a bug elsewhere. If it works now,
+ we can remove the mem_sys_allocate_zeroed line below. */
+
+#if 0
+ void **temp = (void **)mem_sys_allocate_zeroed(N * sizeof (void *));
+#else
+ void **temp = (void **)Parrot_memalign_if_possible(256,
+ N * sizeof (void *));
+#endif
+ /* calc and remember pred_offset */
+ CONTEXT(interp)->pred_offset = pc - (opcode_t *)temp;
+
+ /* fill with the prederef__ opcode function */
+ if (PARROT_RUNCORE_PREDEREF_OPS_TEST(runcore)
+ && !PARROT_RUNCORE_CGOTO_OPS_TEST(runcore))
+ pred_func = (void *)CORE_OPS_prederef__;
+ else {
+ PARROT_ASSERT(interp->op_lib->op_func_table);
+ pred_func = ((void **)
+ interp->op_lib->op_func_table)[CORE_OPS_prederef__];
+ }
+
+ for (i = n_pics = 0; i < N;) {
+ op_info_t * const opinfo = &interp->op_info_table[*pc];
+ size_t n = opinfo->op_count;
+
+ temp[i] = pred_func;
+
+ ADD_OP_VAR_PART(interp, interp->code, pc, n);
+
+ /* count ops that need a PIC */
+ if (parrot_PIC_op_is_cached(*pc))
+ n_pics++;
+
+ pc += n;
+ i += n;
+ }
+
+ interp->code->prederef.code = temp;
+
+ /* allocate pic store, which starts from 1 */
+ if (n_pics)
+ parrot_PIC_alloc_store(interp->code, n_pics + 1);
+ }
+
+ return NULL;
+}
+
+
+/*
+
+=item C<void load_prederef(PARROT_INTERP, Parrot_runcore_t *runcore)>
+
+C<< interp->op_lib >> = prederefed oplib.
+
+=cut
+
+*/
+
+void
+load_prederef(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore))
+{
+ ASSERT_ARGS(load_prederef)
+ const oplib_init_f init_func = get_core_op_lib_init(interp, runcore);
+
+ int (*get_op)(const char * name, int full);
+
+ get_op = interp->op_lib->op_code;
+ interp->op_lib = init_func(1);
+
+ /* preserve the get_op function */
+ interp->op_lib->op_code = get_op;
+
+ if (interp->op_lib->op_count != interp->op_count)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PREDEREF_LOAD_ERROR,
+ "Illegal op count (%d) in prederef oplib\n",
+ (int)interp->op_lib->op_count);
+}
+
+
+/*
+
+=item C<oplib_init_f get_core_op_lib_init(PARROT_INTERP, Parrot_runcore_t
+*runcore)>
+
+Returns an opcode's library C<op_lib> init function.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+oplib_init_f
+get_core_op_lib_init(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore))
+{
+ ASSERT_ARGS(get_core_op_lib_init)
+ return runcore->opinit;
+}
+
+
+/*
+
+=item C<void * init_jit_run(PARROT_INTERP, Parrot_runcore_t *runcore)>
+
+Initializes JIT function for the specified opcode and runs it.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+void *
+init_jit_run(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore))
+{
+ ASSERT_ARGS(init_jit_run)
+ return init_jit(interp, interp->code->base.data);
+}
+
+
+#ifdef PARROT_EXEC_OS_AIX
+extern void* aix_get_toc();
+#endif
+
+/*
+
+=item C<static opcode_t * runops_jit_core(PARROT_INTERP, Parrot_runcore_t
+*runcore, opcode_t *pc)>
+
+Runs the JIT code for the specified opcode.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t *
+runops_jit_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_jit_core)
+#if JIT_CAPABLE
+# ifdef PARROT_EXEC_OS_AIX
+ /* AIX calling convention requires that function-call-by-ptr be made
+ through the following struct: */
+ struct ptrgl_t { jit_f functPtr; void *toc; void *env; } ptrgl_t;
+
+ ptrgl_t.functPtr = (jit_f) D2FPTR(init_jit(interp, pc));
+ ptrgl_t.env = NULL;
+
+ /* r2 (TOC) needs to point back here so we can return from non-JIT
+ functions */
+ ptrgl_t.toc = aix_get_toc();
+
+ ((jit_f) D2FPTR(&ptrgl_t)) (interp, pc);
+# else
+ jit_f jit_code = (jit_f)(init_jit(interp, pc));
+ (jit_code) (interp, pc);
+# endif
+#else
+ UNUSED(interp);
+ UNUSED(pc);
+#endif
+ return NULL;
+}
+
+
+/*
+
+=item C<static opcode_t * runops_exec_core(PARROT_INTERP, Parrot_runcore_t
+*runcore, opcode_t *pc)>
+
+Runs the native executable version of the specified opcode.
+
+=cut
+
+*/
+
+#if EXEC_CAPABLE
+ extern int Parrot_exec_run;
+#endif
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static opcode_t *
+runops_exec_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_exec_core)
+#if EXEC_CAPABLE
+ opcode_t *code_start = interp->code->base.data;
+
+ /* size in opcodes */
+ UINTVAL code_size = interp->code->base.size;
+ opcode_t *code_end = code_start + code_size;
+
+# if defined HAVE_COMPUTED_GOTO && defined USE_CGP
+# ifdef __GNUC__
+# ifdef PARROT_I386
+ init_prederef(interp, PARROT_CGP_CORE);
+# endif
+# endif
+# endif
+ if (Parrot_exec_run == 2) {
+ void *ignored;
+ Parrot_exec_run = 0;
+
+ Parrot_runcore_switch(interp, CONST_STRING(interp, "jit"));
+
+ ignored = runops_jit_core(interp, runcore, pc);
+ UNUSED(ignored);
+
+ Parrot_runcore_switch(interp, CONST_STRING(interp, "exec"));
+ }
+ else if (Parrot_exec_run == 1)
+ Parrot_exec(interp, pc, code_start, code_end);
+ else
+ run_native(interp, pc, code_start);
+
+#else
+ UNUSED(interp);
+ UNUSED(pc);
+#endif
+
+ return NULL;
+}
+
+
+/*
+
+=item C<static opcode_t * runops_cgp_core(PARROT_INTERP, Parrot_runcore_t
+*runcore, opcode_t *pc)>
+
+Runs the computed goto and predereferenced core.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static opcode_t *
+runops_cgp_core(PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore), ARGIN(opcode_t *pc))
+{
+ ASSERT_ARGS(runops_cgp_core)
+#ifdef HAVE_COMPUTED_GOTO
+ opcode_t * const code_start = (opcode_t *)interp->code->base.data;
+ opcode_t *pc_prederef;
+
+ init_prederef(interp, runcore);
+
+ pc_prederef = (opcode_t *)interp->code->prederef.code + (pc - code_start);
+ return cgp_core(pc_prederef, interp);
+
+#else
+ UNUSED(pc);
+ Parrot_io_eprintf(interp,
+ "Computed goto unavailable in this configuration.\n");
+ Parrot_exit(interp, 1);
+#endif
+
+}
+
/*
=back
Modified: branches/gc-refactor/src/runcore/main.c
==============================================================================
--- branches/gc-refactor/src/runcore/main.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/runcore/main.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -64,23 +64,12 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
-static oplib_init_f get_core_op_lib_init(PARROT_INTERP, int which)
- __attribute__nonnull__(1);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
static oplib_init_f get_dynamic_op_lib_init(SHIM_INTERP,
ARGIN(const PMC *lib))
__attribute__nonnull__(2);
-static void init_prederef(PARROT_INTERP, int which)
- __attribute__nonnull__(1);
-
-static void load_prederef(PARROT_INTERP, int which)
- __attribute__nonnull__(1);
-
static void notify_func_table(PARROT_INTERP,
- ARGIN(op_func_t* table),
+ ARGIN(op_func_t *table),
int on)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
@@ -96,30 +85,6 @@
__attribute__nonnull__(4)
FUNC_MODIFIES(*pc_prederef);
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static opcode_t * runops_cgp(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-static opcode_t * runops_exec(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-static opcode_t * runops_jit(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static opcode_t * runops_switch(PARROT_INTERP, ARGIN(opcode_t *pc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
static void stop_prederef(PARROT_INTERP)
__attribute__nonnull__(1);
@@ -129,14 +94,8 @@
#define ASSERT_ARGS_dynop_register_switch __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
#define ASSERT_ARGS_dynop_register_xx __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_get_core_op_lib_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_get_dynamic_op_lib_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(lib)
-#define ASSERT_ARGS_init_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_load_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_notify_func_table __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(table)
@@ -145,18 +104,6 @@
|| PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pc) \
|| PARROT_ASSERT_ARG(opinfo)
-#define ASSERT_ARGS_runops_cgp __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_exec __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_jit __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
-#define ASSERT_ARGS_runops_switch __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pc)
#define ASSERT_ARGS_stop_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_turn_ev_check __attribute__unused__ int _ASSERT_ARGS_CHECK = \
@@ -164,9 +111,104 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
-#if EXEC_CAPABLE
- extern int Parrot_exec_run;
+/*
+
+=item C<void Parrot_runcore_init(PARROT_INTERP)>
+
+Initializes the runcores.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_init)
+
+ interp->cores = NULL;
+ interp->num_cores = 0;
+
+ Parrot_runcore_slow_init(interp);
+ Parrot_runcore_fast_init(interp);
+ Parrot_runcore_switch_init(interp);
+
+ Parrot_runcore_jit_init(interp);
+ Parrot_runcore_switch_jit_init(interp);
+ Parrot_runcore_exec_init(interp);
+ Parrot_runcore_gc_debug_init(interp);
+ Parrot_runcore_debugger_init(interp);
+
+ Parrot_runcore_profiling_init(interp);
+
+#ifdef HAVE_COMPUTED_GOTO
+ Parrot_runcore_cgp_init(interp);
+ Parrot_runcore_cgoto_init(interp);
+ Parrot_runcore_cgp_jit_init(interp);
#endif
+}
+
+
+/*
+
+=item C<INTVAL Parrot_runcore_register(PARROT_INTERP, Parrot_runcore_t
+*coredata)>
+
+Registers a new runcore with Parrot. Returns 1 on success, 0 on failure.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+INTVAL
+Parrot_runcore_register(PARROT_INTERP, ARGIN(Parrot_runcore_t *coredata))
+{
+ ASSERT_ARGS(Parrot_runcore_register)
+ size_t num_cores = ++interp->num_cores;
+
+ mem_realloc_n_typed(interp->cores, num_cores, Parrot_runcore_t *);
+
+ interp->cores[num_cores - 1] = coredata;
+
+ return 1;
+}
+
+
+/*
+
+=item C<void Parrot_runcore_switch(PARROT_INTERP, STRING *name)>
+
+Switches to a named runcore. Throws an exception on an unknown runcore.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_runcore_switch(PARROT_INTERP, ARGIN(STRING *name))
+{
+ ASSERT_ARGS(Parrot_runcore_switch)
+
+ size_t num_cores = interp->num_cores;
+ size_t i;
+
+ if (interp->run_core
+ && Parrot_str_equal(interp, name, interp->run_core->name))
+ return;
+
+ for (i = 0; i < num_cores; ++i) {
+ if (Parrot_str_equal(interp, name, interp->cores[i]->name)) {
+ interp->run_core = interp->cores[i];
+ return;
+ }
+ }
+
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
+ "Invalid runcore %Ss requested\n", name);
+}
+
/*
@@ -286,7 +328,8 @@
/*
-=item C<void do_prederef(void **pc_prederef, PARROT_INTERP, int type)>
+=item C<void do_prederef(void **pc_prederef, PARROT_INTERP, Parrot_runcore_t
+*runcore)>
This is called from within the run cores to predereference the current
opcode.
@@ -298,7 +341,7 @@
*/
void
-do_prederef(ARGIN(void **pc_prederef), PARROT_INTERP, int type)
+do_prederef(ARGIN(void **pc_prederef), PARROT_INTERP, ARGIN(Parrot_runcore_t *runcore))
{
ASSERT_ARGS(do_prederef)
const size_t offset = pc_prederef - interp->code->prederef.code;
@@ -314,18 +357,11 @@
prederef_args(pc_prederef, interp, pc, opinfo);
- switch (type) {
- case PARROT_SWITCH_CORE:
- case PARROT_SWITCH_JIT_CORE:
- case PARROT_CGP_CORE:
- case PARROT_CGP_JIT_CORE:
- parrot_PIC_prederef(interp, *pc, pc_prederef, type);
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Tried to prederef wrong core");
- break;
- }
+ if (PARROT_RUNCORE_PREDEREF_OPS_TEST(runcore))
+ parrot_PIC_prederef(interp, *pc, pc_prederef, interp->run_core);
+ else
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "Tried to prederef wrong core");
/* now remember backward branches, invoke and similar opcodes */
n = opinfo->op_count;
@@ -400,57 +436,6 @@
/*
-=item C<static oplib_init_f get_core_op_lib_init(PARROT_INTERP, int which)>
-
-Returns an opcode's library C<op_lib> init function.
-
-C<which> is the run core type.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static oplib_init_f
-get_core_op_lib_init(PARROT_INTERP, int which)
-{
- ASSERT_ARGS(get_core_op_lib_init)
- oplib_init_f init_func;
- switch (which) {
- case PARROT_SWITCH_CORE:
- case PARROT_SWITCH_JIT_CORE:
- init_func = PARROT_CORE_SWITCH_OPLIB_INIT;
- break;
-#ifdef HAVE_COMPUTED_GOTO
- case PARROT_CGP_CORE:
- case PARROT_CGP_JIT_CORE:
- init_func = PARROT_CORE_CGP_OPLIB_INIT;
- break;
- case PARROT_CGOTO_CORE:
- init_func = PARROT_CORE_CG_OPLIB_INIT;
- break;
-#endif
- /* normal func core */
- case PARROT_EXEC_CORE:
- case PARROT_JIT_CORE:
- case PARROT_SLOW_CORE:
- case PARROT_FAST_CORE:
- case PARROT_GC_DEBUG_CORE:
- case PARROT_DEBUGGER_CORE:
- init_func = PARROT_CORE_OPLIB_INIT;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Couldn't find init_func for core %d", which);
- }
-
- return init_func;
-}
-
-
-/*
-
=item C<static oplib_init_f get_dynamic_op_lib_init(PARROT_INTERP, const PMC
*lib)>
@@ -475,103 +460,6 @@
/*
-=item C<static void load_prederef(PARROT_INTERP, int which)>
-
-C<< interp->op_lib >> = prederefed oplib.
-
-=cut
-
-*/
-
-static void
-load_prederef(PARROT_INTERP, int which)
-{
- ASSERT_ARGS(load_prederef)
- const oplib_init_f init_func = get_core_op_lib_init(interp, which);
-
- int (*get_op)(const char * name, int full);
-
- get_op = interp->op_lib->op_code;
- interp->op_lib = init_func(1);
-
- /* preserve the get_op function */
- interp->op_lib->op_code = get_op;
-
- if (interp->op_lib->op_count != interp->op_count)
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PREDEREF_LOAD_ERROR,
- "Illegal op count (%d) in prederef oplib\n",
- (int)interp->op_lib->op_count);
-}
-
-
-/*
-
-=item C<static void init_prederef(PARROT_INTERP, int which)>
-
-Initialize: load prederef C<func_table>, file prederef.code.
-
-=cut
-
-*/
-
-static void
-init_prederef(PARROT_INTERP, int which)
-{
- ASSERT_ARGS(init_prederef)
- load_prederef(interp, which);
- if (!interp->code->prederef.code) {
- void *pred_func;
- opcode_t *pc = interp->code->base.data;
- const size_t N = interp->code->base.size;
- size_t i, n_pics;
-
-/* Parrot_memalign_if_possible in OpenBSD allocates 256 if you ask for 312
- -- Need to verify this, it may have been a bug elsewhere. If it works now,
- we can remove the mem_sys_allocate_zeroed line below. */
-
-#if 0
- void **temp = (void **)mem_sys_allocate_zeroed(N * sizeof (void *));
-#else
- void **temp = (void **)Parrot_memalign_if_possible(256,
- N * sizeof (void *));
-#endif
- /* calc and remember pred_offset */
- 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)
- pred_func = (void *)CORE_OPS_prederef__;
- else
- pred_func = ((void **)
- interp->op_lib->op_func_table)[CORE_OPS_prederef__];
-
- for (i = n_pics = 0; i < N;) {
- op_info_t * const opinfo = &interp->op_info_table[*pc];
- size_t n = opinfo->op_count;
-
- temp[i] = pred_func;
-
- ADD_OP_VAR_PART(interp, interp->code, pc, n);
-
- /* count ops that need a PIC */
- if (parrot_PIC_op_is_cached(*pc))
- n_pics++;
-
- pc += n;
- i += n;
- }
-
- interp->code->prederef.code = temp;
-
- /* allocate pic store, which starts from 1 */
- if (n_pics)
- parrot_PIC_alloc_store(interp->code, n_pics + 1);
- }
-}
-
-
-/*
-
=item C<static void stop_prederef(PARROT_INTERP)>
Restore the interpreter's op function tables to their initial state.
@@ -617,7 +505,11 @@
exec_init_prederef(PARROT_INTERP, ARGIN(void *prederef_arena))
{
ASSERT_ARGS(exec_init_prederef)
- load_prederef(interp, PARROT_CGP_CORE);
+ Parrot_runcore_t *old_runcore = interp->run_core;
+ Parrot_runcore_switch(interp, Parrot_str_new_constant(interp, "cgp"));
+
+ load_prederef(interp, interp->run_core);
+ interp->run_core = old_runcore;
if (!interp->code->prederef.code) {
void ** const temp = (void **)prederef_arena;
@@ -694,185 +586,10 @@
prepare_for_run(PARROT_INTERP)
{
ASSERT_ARGS(prepare_for_run)
- void *ignored;
+ const runcore_prepare_fn_type prepare_run = interp->run_core->prepare_run;
- switch (interp->run_core) {
- case PARROT_JIT_CORE:
- ignored = init_jit(interp, interp->code->base.data);
- UNUSED(ignored);
- break;
- case PARROT_SWITCH_CORE:
- case PARROT_SWITCH_JIT_CORE:
- case PARROT_CGP_CORE:
- case PARROT_CGP_JIT_CORE:
- case PARROT_DEBUGGER_CORE:
- init_prederef(interp, interp->run_core);
- break;
- default:
- break;
- }
-}
-
-
-#ifdef PARROT_EXEC_OS_AIX
-extern void* aix_get_toc();
-#endif
-
-/*
-
-=item C<static opcode_t * runops_jit(PARROT_INTERP, opcode_t *pc)>
-
-Runs the JIT code for the specified opcode.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-static opcode_t *
-runops_jit(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_jit)
-#if JIT_CAPABLE
-# ifdef PARROT_EXEC_OS_AIX
- /* AIX calling convention requires that function-call-by-ptr be made
- through the following struct: */
- struct ptrgl_t { jit_f functPtr; void *toc; void *env; } ptrgl_t;
-
- ptrgl_t.functPtr = (jit_f) D2FPTR(init_jit(interp, pc));
- ptrgl_t.env = NULL;
-
- /* r2 (TOC) needs to point back here so we can return from non-JIT
- functions */
- ptrgl_t.toc = aix_get_toc();
-
- ((jit_f) D2FPTR(&ptrgl_t)) (interp, pc);
-# else
- jit_f jit_code = (jit_f)(init_jit(interp, pc));
- (jit_code) (interp, pc);
-# endif
-#else
- UNUSED(interp);
- UNUSED(pc);
-#endif
- return NULL;
-}
-
-
-/*
-
-=item C<static opcode_t * runops_exec(PARROT_INTERP, opcode_t *pc)>
-
-Runs the native executable version of the specified opcode.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-static opcode_t *
-runops_exec(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_exec)
-#if EXEC_CAPABLE
- opcode_t *code_start;
- UINTVAL code_size; /* in opcodes */
- opcode_t *code_end;
-
- code_start = interp->code->base.data;
- code_size = interp->code->base.size;
- code_end = code_start + code_size;
-# if defined HAVE_COMPUTED_GOTO && defined USE_CGP
-# ifdef __GNUC__
-# ifdef PARROT_I386
- init_prederef(interp, PARROT_CGP_CORE);
-# endif
-# endif
-# endif
- if (Parrot_exec_run == 2) {
- void *ignored;
- Parrot_exec_run = 0;
-
- Interp_core_SET(interp, PARROT_JIT_CORE);
- ignored = runops_jit(interp, pc);
- UNUSED(ignored);
-
- Interp_core_SET(interp, PARROT_EXEC_CORE);
- }
- else if (Parrot_exec_run == 1)
- Parrot_exec(interp, pc, code_start, code_end);
- else
- run_native(interp, pc, code_start);
-
-#else
- UNUSED(interp);
- UNUSED(pc);
-#endif
-
- return NULL;
-}
-
-
-/*
-
-=item C<static opcode_t * runops_cgp(PARROT_INTERP, opcode_t *pc)>
-
-Runs the C C<goto>, predereferenced core.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static opcode_t *
-runops_cgp(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_cgp)
-#ifdef HAVE_COMPUTED_GOTO
- opcode_t * const code_start = (opcode_t *)interp->code->base.data;
- opcode_t *pc_prederef;
-
- init_prederef(interp, PARROT_CGP_CORE);
-
- pc_prederef = (opcode_t*)interp->code->prederef.code + (pc - code_start);
- return cgp_core(pc_prederef, interp);
-
-#else
- UNUSED(pc);
- Parrot_io_eprintf(interp,
- "Computed goto unavailable in this configuration.\n");
- Parrot_exit(interp, 1);
-#endif
-
-}
-
-
-/*
-
-=item C<static opcode_t * runops_switch(PARROT_INTERP, opcode_t *pc)>
-
-Runs the C<switch> core.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-static opcode_t *
-runops_switch(PARROT_INTERP, ARGIN(opcode_t *pc))
-{
- ASSERT_ARGS(runops_switch)
- opcode_t * const code_start = (opcode_t *)interp->code->base.data;
- opcode_t *pc_prederef;
-
- init_prederef(interp, PARROT_SWITCH_CORE);
- pc_prederef = (opcode_t*)interp->code->prederef.code + (pc - code_start);
-
- return switch_core(pc_prederef, interp);
+ if (prepare_run)
+ (*prepare_run)(interp, interp->run_core);
}
@@ -893,7 +610,6 @@
runops_int(PARROT_INTERP, size_t offset)
{
ASSERT_ARGS(runops_int)
- opcode_t *(*core) (PARROT_INTERP, opcode_t *) = NULL;
/* setup event function ptrs */
if (!interp->save_func_table)
@@ -905,81 +621,12 @@
while (interp->resume_flag & RESUME_RESTART) {
opcode_t * const pc = (opcode_t *)
interp->code->base.data + interp->resume_offset;
+ const runcore_runops_fn_type core = interp->run_core->runops;
interp->resume_offset = 0;
interp->resume_flag &= ~(RESUME_RESTART | RESUME_INITIAL);
- switch (interp->run_core) {
- case PARROT_SLOW_CORE:
- core = runops_slow_core;
-
- if (Interp_flags_TEST(interp, PARROT_PROFILE_FLAG)) {
- core = runops_profile_core;
- if (interp->profile == NULL) {
- interp->profile = mem_allocate_zeroed_typed(RunProfile);
- interp->profile->data =
- mem_allocate_n_typed((interp->op_count +
- PARROT_PROF_EXTRA), ProfData);
- }
- }
- break;
- case PARROT_FAST_CORE:
- core = runops_fast_core;
- break;
- case PARROT_CGOTO_CORE:
-#ifdef HAVE_COMPUTED_GOTO
- core = runops_cgoto_core;
-#else
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Error: PARROT_CGOTO_CORE not available");
-#endif
- break;
- case PARROT_CGP_CORE:
- case PARROT_CGP_JIT_CORE:
-#ifdef HAVE_COMPUTED_GOTO
- core = runops_cgp;
-#else
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Error: PARROT_CGP_CORE not available");
-#endif
- break;
- case PARROT_SWITCH_CORE:
- case PARROT_SWITCH_JIT_CORE:
- core = runops_switch;
- break;
- case PARROT_JIT_CORE:
-#if !JIT_CAPABLE
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_JIT_UNAVAILABLE,
- "Error: PARROT_JIT_FLAG is set, "
- "but interpreter is not JIT_CAPABLE!\n");
-#else
- core = runops_jit;
-#endif
- break;
- case PARROT_EXEC_CORE:
-#if !EXEC_CAPABLE
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_EXEC_UNAVAILABLE,
- "Error: PARROT_EXEC_FLAG is set, "
- "but interpreter is not EXEC_CAPABLE!\n");
-#else
- core = runops_exec;
-#endif
- break;
- case PARROT_GC_DEBUG_CORE:
- core = runops_gc_debug_core;
- break;
- case PARROT_DEBUGGER_CORE:
- core = runops_debugger_core;
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
- "ambigious runcore switch used");
- break;
- }
-
-
- /* run it finally */
- core(interp, pc);
+ (*core)(interp, interp->run_core, pc);
/* if we have fallen out with resume and we were running CGOTO, set
* the stacktop again to a sane value, so that restarting the runloop
@@ -1048,10 +695,33 @@
Parrot_runcore_destroy(PARROT_INTERP)
{
ASSERT_ARGS(Parrot_runcore_destroy)
- op_lib_t *cg_lib;
+ op_lib_t *cg_lib;
+ size_t num_cores = interp->num_cores;
+ size_t i;
+
+ for (i = 0; i < num_cores; ++i) {
+ Parrot_runcore_t *core = interp->cores[i];
+ runcore_destroy_fn_type destroy = core->destroy;
+
+ if (destroy)
+ (*destroy)(interp, core);
+
+ mem_sys_free(core);
+ }
+
+ if (interp->cores)
+ mem_sys_free(interp->cores);
+
+ interp->cores = NULL;
+ interp->run_core = NULL;
+
+ /* dynop libs */
+ if (interp->n_libs <= 0)
+ return;
#ifdef HAVE_COMPUTED_GOTO
cg_lib = PARROT_CORE_CGP_OPLIB_INIT(1);
+
if (cg_lib->op_func_table)
mem_sys_free(cg_lib->op_func_table);
cg_lib->op_func_table = NULL;
@@ -1061,6 +731,11 @@
mem_sys_free(cg_lib->op_func_table);
cg_lib->op_func_table = NULL;
#endif
+
+ mem_sys_free(interp->op_info_table);
+ mem_sys_free(interp->op_func_table);
+ interp->op_info_table = NULL;
+ interp->op_func_table = NULL;
}
@@ -1286,7 +961,7 @@
}
/* if we are running this core, update event check ops */
- if ((int)interp->run_core == cg_lib->core_type) {
+ if (interp->run_core->id == cg_lib->core_type) {
size_t i;
for (i = n_old; i < n_tot; ++i)
@@ -1325,7 +1000,7 @@
/*
-=item C<static void notify_func_table(PARROT_INTERP, op_func_t* table, int on)>
+=item C<static void notify_func_table(PARROT_INTERP, op_func_t *table, int on)>
Tell the interpreter's running core about the new function table.
@@ -1334,27 +1009,20 @@
*/
static void
-notify_func_table(PARROT_INTERP, ARGIN(op_func_t* table), int on)
+notify_func_table(PARROT_INTERP, ARGIN(op_func_t *table), int on)
{
ASSERT_ARGS(notify_func_table)
const oplib_init_f init_func = get_core_op_lib_init(interp, interp->run_core);
init_func((long) table);
- switch (interp->run_core) {
- case PARROT_SLOW_CORE: /* normal func core */
- case PARROT_FAST_CORE: /* normal func core */
- case PARROT_CGOTO_CORE: /* cgoto address list */
- case PARROT_DEBUGGER_CORE:
- PARROT_ASSERT(table);
- interp->op_func_table = table;
- break;
- case PARROT_CGP_CORE:
- case PARROT_CGP_JIT_CORE:
- turn_ev_check(interp, on);
- break;
- default:
- break;
+
+ if (PARROT_RUNCORE_FUNC_TABLE_TEST(interp->run_core)) {
+ PARROT_ASSERT(table);
+ interp->op_func_table = table;
}
+
+ if (PARROT_RUNCORE_EVENT_CHECK_TEST(interp->run_core))
+ turn_ev_check(interp, on);
}
Modified: branches/gc-refactor/src/string/api.c
==============================================================================
--- branches/gc-refactor/src/string/api.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/string/api.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -2836,7 +2836,7 @@
if (encoding != result->encoding)
Parrot_str_length(interp, result);
- if (!CHARSET_VALIDATE(interp, result, 0))
+ if (!CHARSET_VALIDATE(interp, result))
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_INVALID_STRING_REPRESENTATION, "Malformed string");
Modified: branches/gc-refactor/src/sub.c
==============================================================================
--- branches/gc-refactor/src/sub.c Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/src/sub.c Mon Sep 7 23:56:34 2009 (r41143)
@@ -49,74 +49,9 @@
/*
-=item C<Parrot_cont * new_continuation(PARROT_INTERP, const Parrot_cont *to)>
-
-Returns a new C<Parrot_cont> to the context of C<to> with its own copy of the
-current interpreter context. If C<to> is C<NULL>, then the C<to_ctx> is set
-to the current context.
-
-=cut
-
-*/
-
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-Parrot_cont *
-new_continuation(PARROT_INTERP, ARGIN_NULLOK(const Parrot_cont *to))
-{
- ASSERT_ARGS(new_continuation)
- Parrot_cont * const cc = mem_allocate_typed(Parrot_cont);
- PMC * const to_ctx = to ? to->to_ctx : CURRENT_CONTEXT(interp);
-
- cc->to_ctx = to_ctx;
- cc->from_ctx = CURRENT_CONTEXT(interp);
- cc->runloop_id = 0;
- if (to) {
- cc->seg = to->seg;
- cc->address = to->address;
- }
- else {
- cc->seg = interp->code;
- cc->address = NULL;
- }
-
- cc->current_results = Parrot_pcc_get_results(interp, to_ctx);
- return cc;
-}
-
-/*
-
-=item C<Parrot_cont * new_ret_continuation(PARROT_INTERP)>
-
-Returns a new C<Parrot_cont> pointing to the current context.
-
-=cut
-
-*/
-
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-Parrot_cont *
-new_ret_continuation(PARROT_INTERP)
-{
- ASSERT_ARGS(new_ret_continuation)
- Parrot_cont * const cc = mem_allocate_typed(Parrot_cont);
-
- cc->to_ctx = CURRENT_CONTEXT(interp);
- cc->from_ctx = CURRENT_CONTEXT(interp); /* filled in during a call */
- cc->runloop_id = 0;
- cc->seg = interp->code;
- cc->current_results = NULL;
- cc->address = NULL;
- return cc;
-}
-
-/*
-
=item C<PMC * new_ret_continuation_pmc(PARROT_INTERP, opcode_t *address)>
-Returns a new C<RetContinuation> PMC. Uses one from the cache,
-if possible; otherwise, creates a new one.
+Returns a new C<RetContinuation> PMC, and sets address field to C<address>
=cut
@@ -148,7 +83,8 @@
invalidate_retc_context(PARROT_INTERP, ARGMOD(PMC *cont))
{
ASSERT_ARGS(invalidate_retc_context)
- PMC *ctx = PMC_cont(cont)->from_ctx;
+
+ PMC *ctx = PARROT_CONTINUATION(cont)->from_ctx;
cont = Parrot_pcc_get_continuation(interp, ctx);
while (1) {
@@ -163,7 +99,6 @@
ctx = Parrot_pcc_get_caller_ctx(interp, ctx);
cont = Parrot_pcc_get_continuation(interp, ctx);
}
-
}
/*
@@ -250,9 +185,10 @@
PARROT_EXPORT
int
Parrot_Context_get_info(PARROT_INTERP, ARGIN(PMC *ctx),
- ARGOUT(Parrot_Context_info *info))
+ ARGOUT(Parrot_Context_info *info))
{
ASSERT_ARGS(Parrot_Context_get_info)
+ PMC *subpmc;
Parrot_Sub_attributes *sub;
/* set file/line/pc defaults */
@@ -263,8 +199,10 @@
info->subname = NULL;
info->fullname = NULL;
+ subpmc = Parrot_pcc_get_sub(interp, ctx);
+
/* is the current sub of the specified context valid? */
- if (PMC_IS_NULL(Parrot_pcc_get_sub(interp, ctx))) {
+ if (PMC_IS_NULL(subpmc)) {
info->subname = Parrot_str_new(interp, "???", 3);
info->nsname = info->subname;
info->fullname = Parrot_str_new(interp, "??? :: ???", 10);
@@ -273,10 +211,10 @@
}
/* fetch Parrot_sub of the current sub in the given context */
- if (!VTABLE_isa(interp, Parrot_pcc_get_sub(interp, ctx), CONST_STRING(interp, "Sub")))
+ if (!VTABLE_isa(interp, subpmc, CONST_STRING(interp, "Sub")))
return 1;
- PMC_get_sub(interp, Parrot_pcc_get_sub(interp, ctx), sub);
+ PMC_get_sub(interp, subpmc, sub);
/* set the sub name */
info->subname = sub->name;
@@ -287,7 +225,7 @@
}
else {
info->nsname = VTABLE_get_string(interp, sub->namespace_name);
- info->fullname = Parrot_full_sub_name(interp, Parrot_pcc_get_sub(interp, ctx));
+ info->fullname = Parrot_full_sub_name(interp, subpmc);
}
/* return here if there is no current pc */
@@ -514,7 +452,7 @@
parrot_new_closure(PARROT_INTERP, ARGIN(PMC *sub_pmc))
{
ASSERT_ARGS(parrot_new_closure)
- PMC * const clos_pmc = VTABLE_clone(interp, sub_pmc);
+ PMC * const clos_pmc = VTABLE_clone(interp, sub_pmc);
Parrot_capture_lex(interp, clos_pmc);
return clos_pmc;
}
@@ -522,8 +460,7 @@
/*
-=item C<void Parrot_continuation_check(PARROT_INTERP, const PMC *pmc, const
-Parrot_cont *cc)>
+=item C<void Parrot_continuation_check(PARROT_INTERP, const PMC *pmc)>
Verifies that the provided continuation is sane.
@@ -532,23 +469,18 @@
*/
void
-Parrot_continuation_check(PARROT_INTERP, ARGIN(const PMC *pmc),
- ARGIN(const Parrot_cont *cc))
+Parrot_continuation_check(PARROT_INTERP, ARGIN(const PMC *pmc))
{
ASSERT_ARGS(Parrot_continuation_check)
- PMC *to_ctx = cc->to_ctx;
- PMC *from_ctx = CURRENT_CONTEXT(interp);
-
+ PMC * const to_ctx = PARROT_CONTINUATION(pmc)->to_ctx;
if (PMC_IS_NULL(to_ctx))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Continuation invoked after deactivation.");
}
-
/*
-=item C<void Parrot_continuation_rewind_environment(PARROT_INTERP, PMC *pmc,
-Parrot_cont *cc)>
+=item C<void Parrot_continuation_rewind_environment(PARROT_INTERP, PMC *pmc)>
Restores the appropriate context for the continuation.
@@ -557,11 +489,11 @@
*/
void
-Parrot_continuation_rewind_environment(PARROT_INTERP, SHIM(PMC *pmc),
- ARGIN(Parrot_cont *cc))
+Parrot_continuation_rewind_environment(PARROT_INTERP, ARGIN(PMC *pmc))
{
ASSERT_ARGS(Parrot_continuation_rewind_environment)
- PMC * const to_ctx = cc->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)) {
@@ -593,8 +525,7 @@
void *
Parrot_get_sub_pmc_from_subclass(PARROT_INTERP, ARGIN(PMC *subclass)) {
ASSERT_ARGS(Parrot_get_sub_pmc_from_subclass)
- PMC *key, *sub_pmc;
- Parrot_Sub_attributes *sub;
+ PMC *key, *sub_pmc;
/* Ensure we really do have a subclass of sub. */
if (VTABLE_isa(interp, subclass, CONST_STRING(interp, "Sub"))) {
Modified: branches/gc-refactor/t/library/test_more.t
==============================================================================
--- branches/gc-refactor/t/library/test_more.t Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/t/library/test_more.t Mon Sep 7 23:56:34 2009 (r41143)
@@ -1,5 +1,5 @@
-#!./parrot
-# Copyright (C) 2005-2008, Parrot Foundation.
+#!parrot
+# Copyright (C) 2005-2009, Parrot Foundation.
# $Id$
.sub _main :main
@@ -15,14 +15,14 @@
.local pmc exports, curr_namespace, test_namespace
curr_namespace = get_namespace
test_namespace = get_namespace [ 'Test'; 'More' ]
- exports = split " ", "ok is diag like skip todo is_deeply isa_ok isnt"
+ exports = split " ", "ok is diag like skip todo is_deeply isa_ok isnt throws_like"
test_namespace.'export_to'(curr_namespace, exports)
test_namespace = get_namespace [ 'Test'; 'Builder'; 'Tester' ]
exports = split " ", "plan test_out test_diag test_fail test_pass test_test"
test_namespace.'export_to'(curr_namespace, exports)
- plan( 75 )
+ plan( 81 )
test_skip()
test_todo()
@@ -32,11 +32,46 @@
test_like()
test_is_deeply()
test_diagnostics()
+ test_throws_like()
test_isa_ok()
test.'finish'()
.end
+.sub test_throws_like
+
+ test_fail('throws_like fails when there is no error')
+ throws_like( <<'CODE', 'somejunk', 'throws_like fails when there is no error')
+.sub main
+ $I0 = 42
+.end
+CODE
+ test_diag( 'no error thrown' )
+ test_test( 'throws_like fails when there is no error')
+
+ test_pass('throws_like passes when error matches pattern')
+ throws_like( <<'CODE', 'for\ the\ lulz','throws_like passes when error matches pattern')
+.sub main
+ die 'I did it for the lulz'
+.end
+CODE
+ test_test( 'throws_like passes when error matches pattern' )
+
+ test_fail( 'throws_like fails when error does not match pattern' )
+ throws_like( <<'CODE', 'for\ the\ lulz','throws_like fails when error does not match pattern')
+.sub main
+ die 'DO NOT WANT'
+.end
+CODE
+ .local string diagnostic
+ diagnostic = "match failed: target 'DO NOT WANT' does not match pattern '"
+ diagnostic .= 'for\ the\ lulz'
+ diagnostic .= "'"
+ test_diag( diagnostic )
+ test_test('throws_like fails when error does not match pattern' )
+
+.end
+
.sub test_ok
test_pass()
ok( 1 )
@@ -263,14 +298,27 @@
test_test( 'passing test like() with description' )
test_fail()
- test_diag( 'match failed' )
+
+ test_diag( "match failed: target 'abcdef' does not match pattern '<[g]>'" )
like( 'abcdef', '<[g]>' )
test_test( 'failing test like()' )
test_fail( 'testing like()' )
- test_diag( 'match failed' )
+ test_diag( "match failed: target 'abcdef' does not match pattern '<[g]>'" )
like( 'abcdef', '<[g]>', 'testing like()' )
test_test( 'failing test like() with description' )
+
+ test_pass( 'like() can match literal strings' )
+ like( 'foobar', 'foobar', 'like() can match literal strings' )
+ test_test( 'like() can match literal strings' )
+
+ test_pass( 'like() can match partial literal strings' )
+ like( 'foobar()', 'foobar', 'like() can match partial literal strings' )
+ test_test( 'like() can match partial literal strings' )
+
+ test_pass( 'like() can match partial literal strings with spaces' )
+ like( 'foo bar()', 'foo\ bar', 'like() can match partial literal strings with spaces' )
+ test_test( 'like() can match partial literal strings with spaces' )
.end
.sub test_is_deeply
Modified: branches/gc-refactor/t/pmc/fixedpmcarray.t
==============================================================================
--- branches/gc-refactor/t/pmc/fixedpmcarray.t Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/t/pmc/fixedpmcarray.t Mon Sep 7 23:56:34 2009 (r41143)
@@ -6,7 +6,7 @@
use warnings;
use lib qw(lib . ../lib ../../lib);
-use Parrot::Test tests => 25;
+use Parrot::Test tests => 26;
use Test::More;
=head1 NAME
@@ -800,6 +800,22 @@
/FixedPMCArray: index out of bounds!/
OUTPUT
+pir_output_like( <<'CODE', <<'OUTPUT', 'get_repr');
+.sub 'main'
+ .local pmc fpa, n
+ .local string s
+ fpa = new ['FixedPMCArray']
+ fpa = 2
+ n = box 1
+ fpa[0] = n
+ fpa[1] = n
+ s = get_repr fpa
+ say s
+.end
+CODE
+/(1,\s*1)/
+OUTPUT
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
Modified: branches/gc-refactor/t/pmc/float.t
==============================================================================
--- branches/gc-refactor/t/pmc/float.t Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/t/pmc/float.t Mon Sep 7 23:56:34 2009 (r41143)
@@ -1,15 +1,7 @@
-#!perl
+#! parrot
# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-
-use Test::More;
-use Parrot::Test tests => 61;
-use Parrot::Config;
-
=head1 NAME
t/pmc/float.t - Floating-point Numbers
@@ -24,1600 +16,1004 @@
=cut
+.const int TESTS = 159
+.const num PRECISION = 0.000001
+
+.sub 'test' :main
+ .include 'test_more.pir'
+
+ plan(TESTS)
+ basic_assignment()
+ add_number_to_self()
+ sub_number_from_self()
+ multiply_number_by_self()
+ divide_number_by_self()
+ divide_by_zero()
+ truth_positive_float()
+ truth_negative_float()
+ truth_positive_integer()
+ truth_negative_integer()
+ falseness_0()
+ 'falseness_0.000'()
+ integer_addition()
+ integer_substraction()
+ integer_multiplication()
+ integer_division()
+ number_addition()
+ number_substraction()
+ number_multiplication()
+ number_division()
+ increment_decrement()
+ 'neg'()
+ negative_zero()
+ equality()
+ is_interface_done()
+ 'abs'()
+ 'lt'()
+ 'lt_num'()
+ 'le'()
+ 'le_num'()
+ 'gt'()
+ 'gt_num'()
+ 'ge'()
+ 'ge_num'()
+ cmp_p_n()
+ 'isgt'()
+ 'isge'()
+ 'islt'()
+ 'isle'()
+ 'iseq'()
+ 'isne'()
+ instantiate_str()
+ cmp_subclasses()
+ acos_method()
+ cos_method()
+ asec_method()
+ asin_method()
+ atan_method()
+ atan2_method()
+ cosh_method()
+ exp_method()
+ ln_method()
+ log10_method()
+ log2_method()
+ sec_method()
+ sech_method()
+ sin_method()
+ sinh_method()
+ tan_method()
+ tanh_method()
+ sqrt_method()
+.end
+
+.include 'fp_equality.pasm'
+
+.sub 'basic_assignment'
+ $P0 = new ['Float']
+
+ $P0 = 0.001
+ is($P0, 0.001, 'basic float assignment 1', PRECISION)
+
+ $P0 = 12.5
+ is($P0, 12.5, 'basic assignment 2', PRECISION)
+
+ $P0 = 1000
+ is($P0, 1000.0, 'basic integer assignment', PRECISION)
+
+ $P0 = 'Twelve point five'
+ is($P0, 0.0, 'basic string assignment', PRECISION)
+
+ $P0 = 123.45
+ $I0 = $P0
+ is($I0, 123, 'rounding to integer')
+
+ $P0 = 123.45
+ $N0 = $P0
+ is($N0, 123.45, 'get_float_value', PRECISION)
+
+ $P0 = 123.45
+ $S0 = $P0
+ is($S0, '123.45', 'get string')
+
+ $P0 = "12.49"
+ $P1 = get_class ['Float']
+ is($P0, 12.49, 'setting value from string', PRECISION)
+.end
+
+.sub 'add_number_to_self'
+ $P0 = new ['Float']
+ $P0 = 0.001
+ $P0 = $P0 + $P0
+
+ is($P0, 0.002, 'add number to self', PRECISION)
+.end
+
+.sub 'sub_number_from_self'
+ $P0 = new ['Float']
+ $P0 = -1000.2
+ $P0 = $P0 - $P0
+
+ is($P0, 0.0, 'sub number from self', PRECISION)
+.end
+
+.sub 'multiply_number_by_self'
+ $P0 = new ['Float']
+ $P0 = 123.4
+ $P0 = $P0 * $P0
+
+ is($P0, 15227.56, 'multiply number by self', PRECISION)
+.end
+
+.sub 'divide_number_by_self'
+ $P0 = new ['Float']
+ $P0 = 1829354.988
+ $P0 = $P0 / $P0
-pasm_output_is( <<"CODE", <<OUTPUT, "basic assignment" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
-
- set P0, 0.001
- .fp_eq_pasm( P0, 0.001, EQ1)
- print "not "
-EQ1: print "ok 1\\n"
-
- set P0, 1000
- .fp_eq_pasm( P0, 1000.0, EQ2)
- print "not "
-EQ2: print "ok 2\\n"
-
- set P0, "12.5"
- .fp_eq_pasm( P0, 12.5, EQ3)
- print "not "
-EQ3: print "ok 3\\n"
-
- set P0, "Twelve point five"
- .fp_eq_pasm( P0, 0.0, EQ4)
- print "not "
-EQ4: print "ok 4\\n"
-
- set P0, 123.45
- set I0, P0
- eq I0, 123, EQ5
- print "not "
-EQ5: print "ok 5\\n"
-
- set P0, 123.45
- set N0, P0
- .fp_eq_pasm(N0, 123.45, EQ6)
- print "not "
-EQ6: print "ok 6\\n"
-
- set P0, 123.45
- set S0, P0
- eq S0, "123.45", EQ7
- print "not "
-EQ7: print "ok 7\\n"
-
- end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-ok 5
-ok 6
-ok 7
-OUTPUT
-
-pasm_output_is( <<"CODE", <<OUTPUT, "add number to self" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 0.001
- add P0, P0, P0
- .fp_eq_pasm( P0, 0.002, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
- end
-CODE
-ok 1
-OUTPUT
-
-pasm_output_is( <<"CODE", <<OUTPUT, "sub number from self" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, -1000.2
- sub P0, P0, P0
- .fp_eq_pasm( P0, 0.0, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
- end
-CODE
-ok 1
-OUTPUT
-
-pasm_output_is( <<"CODE", <<OUTPUT, "multiply number by self" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 123.4
- mul P0, P0, P0
- .fp_eq_pasm( P0, 15227.56, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
- end
-CODE
-ok 1
-OUTPUT
-
-pasm_output_is( <<"CODE", <<OUTPUT, "divide number by self" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 1829354.988
- div P0, P0, P0
- .fp_eq_pasm( P0, 1.0, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
- end
-CODE
-ok 1
-OUTPUT
+ is($P0, 1.0, 'divide number by self', PRECISION)
+.end
-pir_output_is( <<'CODE', <<OUTPUT, "divide by zero" );
-.sub _main :main
+.sub 'divide_by_zero'
$P0 = new ['Float']
- set $P0, "12.0"
+ $P0 = 12.0
+
$P1 = new ['Float']
+
$P2 = new ['Float']
- set $P2, "0.0"
- push_eh OK
+ $P2 = 0.0
+
+ push_eh divide_by_zero_handler
$P1 = $P0 / $P2
- print "fail\n"
pop_eh
-OK:
- get_results '0', $P0
- $S0 = $P0
- print "ok\n"
- print $S0
- print "\n"
-.end
-CODE
-ok
-float division by zero
-OUTPUT
+ nok(1, 'divide by zero')
+ .return ()
-pir_output_is( << 'CODE', << 'OUTPUT', "Truth of a positive float" );
+ divide_by_zero_handler:
+ .get_results ($P1)
+ $S1 = $P1
+ say $S1
+ like($S1, ':s division by zero', 'divide by zero')
+.end
-.sub _main
+.sub 'truth_positive_float'
.local pmc float_1
float_1 = new ['Float']
float_1 = 123.123
- print float_1
- if float_1 goto IS_TRUE
- print " is false\n"
- end
- IS_TRUE:
- print " is true\n"
- end
-.end
-CODE
-123.123 is true
-OUTPUT
-
-pir_output_is( << 'CODE', << 'OUTPUT', "Truth of a negative float" );
+ ok(float_1, 'Truth of a positive float')
+.end
-.sub _main
+.sub 'truth_negative_float'
.local pmc float_1
float_1 = new ['Float']
float_1 = -123.123
- print float_1
- if float_1 goto IS_TRUE
- print " is false\n"
- end
- IS_TRUE:
- print " is true\n"
- end
-.end
-CODE
--123.123 is true
-OUTPUT
-
-pir_output_is( << 'CODE', << 'OUTPUT', "Truth of a positive integer" );
+ ok(float_1, 'Truth of a negative float')
+.end
-.sub _main
+.sub 'truth_positive_integer'
.local pmc float_1
float_1 = new ['Float']
float_1 = 1
- print float_1
- if float_1 goto IS_TRUE
- print " is false\n"
- end
- IS_TRUE:
- print " is true\n"
- end
-.end
-CODE
-1 is true
-OUTPUT
-
-pir_output_is( << 'CODE', << 'OUTPUT', "Truth of a negative integer" );
+ ok(float_1, 'Truth of a positive integer')
+.end
-.sub _main
+.sub 'truth_negative_integer'
.local pmc float_1
float_1 = new ['Float']
float_1 = -1
- print float_1
- if float_1 goto IS_TRUE
- print " is false\n"
- end
- IS_TRUE:
- print " is true\n"
- end
-.end
-CODE
--1 is true
-OUTPUT
-
-pir_output_is( << 'CODE', << 'OUTPUT', "Falseness of 0" );
+ ok(float_1, 'Truth of a negative integer')
+.end
-.sub _main
+.sub 'falseness_0'
.local pmc float_1
float_1 = new ['Float']
float_1 = 0
- print float_1
- if float_1 goto IS_TRUE
- print " is false\n"
- end
- IS_TRUE:
- print " is true\n"
- end
-.end
-CODE
-0 is false
-OUTPUT
-
-pir_output_is( << 'CODE', << 'OUTPUT', "Falseness of 0.000" );
+ nok(float_1, 'Falseness of 0')
+.end
-.sub _main
+.sub 'falseness_0.000'
.local pmc float_1
float_1 = new ['Float']
float_1 = 0.000
- print float_1
- if float_1 goto IS_TRUE
- print " is false\n"
- end
- IS_TRUE:
- print " is true\n"
- end
-.end
-CODE
-0 is false
-OUTPUT
-
-pasm_output_is( << "CODE", << 'OUTPUT', "Basic integer arithmetic: addition" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 0.001
- add P0, 1
- .fp_eq_pasm(P0, 1.001, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
-
- add P0, -2
- .fp_eq_pasm(P0, -0.999, EQ2)
- print P0
- print "not "
-EQ2: print "ok 2\\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-pasm_output_is( << "CODE", << 'OUTPUT', "Basic integer arithmetic: subtraction" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 103.45
- sub P0, 77
- .fp_eq_pasm(P0, 26.45, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
-
- sub P0, -24
- .fp_eq_pasm(P0, 50.45, EQ2)
- print P0
- print "not "
-EQ2: print "ok 2\\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-pasm_output_is( << "CODE", << 'OUTPUT', "Basic integer arithmetic: multiplication" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 0.001
- mul P0, 10000
- .fp_eq_pasm(P0, 10.0, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
-
- mul P0, -1
- .fp_eq_pasm(P0, -10.0, EQ2)
- print P0
- print "not "
-EQ2: print "ok 2\\n"
-
- mul P0, 0
- .fp_eq_pasm(P0, 0.0, EQ3)
- print P0
- print "not "
-EQ3: print "ok 3\\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( << "CODE", << 'OUTPUT', "Basic integer arithmetic: division" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 1e8
- div P0, 10000
- .fp_eq_pasm(P0, 10000.0, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
-
- div P0, 1000000
- .fp_eq_pasm(P0, 0.01, EQ2)
- print P0
- print "not "
-EQ2: print "ok 2\\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-pasm_output_is( << "CODE", << 'OUTPUT', "Basic numeric arithmetic: addition" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 0.001
- add P0, 1.2
- .fp_eq_pasm(P0, 1.201, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
-
- add P0, -2.4
- .fp_eq_pasm(P0, -1.199, EQ2)
- print P0
- print "not "
-EQ2: print "ok 2\\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-pasm_output_is( << "CODE", << 'OUTPUT', "Basic numeric arithmetic: subtraction" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 103.45
- sub P0, 3.46
- .fp_eq_pasm(P0, 99.99, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
-
- sub P0, -0.01
- .fp_eq_pasm(P0, 100.00, EQ2)
- print P0
- print "not "
-EQ2: print "ok 2\\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-pasm_output_is( << "CODE", << 'OUTPUT', "Basic numeric arithmetic: multiplication" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 0.001
- mul P0, 123.5
- .fp_eq_pasm(P0, 0.1235, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
-
- mul P0, -2.6
- .fp_eq_pasm(P0, -0.3211, EQ2)
- print P0
- print "not "
-EQ2: print "ok 2\\n"
-
- mul P0, 0
- .fp_eq_pasm(P0, 0.0, EQ3)
- print P0
- print "not "
-EQ3: print "ok 3\\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( << "CODE", << 'OUTPUT', "Basic numeric arithmetic: division" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 1e8
- div P0, 0.5
- .fp_eq_pasm(P0, 2e8, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
-
- div P0, 4000.0
- .fp_eq_pasm(P0, 50000.0, EQ2)
- print P0
- print "not "
-EQ2: print "ok 2\\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-pasm_output_is( << "CODE", << 'OUTPUT', "Increment & decrement" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 0.5
- inc P0
- .fp_eq_pasm(P0, 1.5, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
-
- dec P0
- .fp_eq_pasm(P0, 0.5, EQ2)
- print P0
- print "not "
-EQ2: print "ok 2\\n"
-
- dec P0
- .fp_eq_pasm(P0, -0.5, EQ3)
- print P0
- print "not "
-EQ3: print "ok 3\\n"
-
- inc P0
- .fp_eq_pasm(P0, 0.5, EQ4)
- print P0
- print "not "
-EQ4: print "ok 4\\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-OUTPUT
-
-pasm_output_is( << "CODE", << 'OUTPUT', "Neg" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 0.5
- neg P0
- .fp_eq_pasm(P0, -0.5, EQ1)
- print P0
- print "not "
-EQ1: print "ok 1\\n"
-
- new P1, ['Float']
- neg P1, P0
- .fp_eq_pasm(P1, 0.5, EQ2)
- print P1
- print "not "
-EQ2: print "ok 2\\n"
- end
-CODE
-ok 1
-ok 2
-OUTPUT
-
-TODO: {
- my @todo;
- @todo = ( todo => '-0.0 not implemented, TT #313' )
- unless $PConfig{has_negative_zero};
-
-pasm_output_like( <<'CODE', <<'OUTPUT', 'neg 0', @todo );
- new P0, ['Float']
- set P0, 0.0
- neg P0
- print P0
- end
-CODE
-/^-0/
-OUTPUT
-}
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "Equality" );
- new P0, ['Float']
- set P0, 1e8
- new P1, ['Float']
- set P1, 1e8
- new P2, ['Float']
- set P2, 2.4
-
- eq P0, P1, OK1
- print "not "
-OK1: print "ok 1\n"
-
- eq P0, P2, BAD2
- branch OK2
-BAD2: print "not "
-OK2: print "ok 2\n"
-
- ne P0, P2, OK3
- print "not "
-OK3: print "ok 3\n"
-
- ne P0, P1, BAD4
- branch OK4
-BAD4: print "not "
-OK4: print "ok 4\n"
-
- eq_num P0, P1, OK5
- print "not "
-OK5: print "ok 5\n"
-
- eq_num P0, P2, BAD6
- branch OK6
-BAD6: print "not "
-OK6: print "ok 6\n"
-
- ne_num P0, P2, OK7
- print "not "
-OK7: print "ok 7\n"
-
- ne_num P0, P1, BAD8
- branch OK8
-BAD8: print "not "
-OK8: print "ok 8\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-ok 5
-ok 6
-ok 7
-ok 8
-OUTPUT
+ nok(float_1, 'Falseness of 0.000')
+.end
-pir_output_is( << 'CODE', << 'OUTPUT', "check whether interface is done" );
+.sub 'integer_addition'
+ $P0 = new ['Float']
-.sub _main
- .local pmc pmc1
- pmc1 = new ['Float']
- .local int bool1
- does bool1, pmc1, "scalar"
- print bool1
- print "\n"
- does bool1, pmc1, "float"
- print bool1
- print "\n"
- does bool1, pmc1, "no_interface"
- print bool1
- print "\n"
- end
-.end
-CODE
-1
-1
-0
-OUTPUT
-
-pasm_output_is( << "CODE", << 'OUTPUT', "Abs" );
- .include 'fp_equality.pasm'
- new P0, ['Float']
- set P0, 1.0
- abs P0
- eq P0, P0, OK1
- print P0
- print "not "
-OK1: print "ok 1\\n"
-
- set P0, -1.0
- abs P0
- .fp_eq_pasm(P0, 1.0, OK2)
- print P0
- print "not "
-OK2: print "ok 2\\n"
-
- new P1, ['Float']
- set P0, -5.0
- abs P1, P0
- .fp_eq_pasm(P1, 5.0, OK3)
- print P1
- print "not "
-OK3: print "ok 3\\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: lt" );
- new P1, ['Float']
- set P1, 111.1
- set N1, P1
-
- lt P1, 111.2, OK1
- print "not "
-OK1: print "ok 1\n"
-
- lt P1, N1, BAD2
- branch OK2
-BAD2: print "not "
-OK2: print "ok 2\n"
-
- lt P1, 111.0, BAD3
- branch OK3
-BAD3: print "not "
-OK3: print "ok 3\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: lt_num" );
- new P1, ['Float']
- set P1, 1.1
- new P2, ['Float']
- set P2, 1.2
- new P3, ['Float']
- set P3, 1.0
- new P4, ['Float']
- set P4, P1
-
- lt_num P1, P2, OK1
- print "not "
-OK1: print "ok 1\n"
-
- lt_num P1, P4, BAD2
- branch OK2
-BAD2: print "not "
-OK2: print "ok 2\n"
-
- lt_num P1, P3, BAD3
- branch OK3
-BAD3: print "not "
-OK3: print "ok 3\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: le" );
- new P1, ['Float']
- set P1, 111.1
- set N1, P1
-
- le P1, 111.2, OK1
- print "not "
-OK1: print "ok 1\n"
-
- le P1, N1, OK2
- print "not "
-OK2: print "ok 2\n"
-
- le P1, 111.0, BAD3
- branch OK3
-BAD3: print "not "
-OK3: print "ok 3\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: le_num" );
- new P1, ['Float']
- set P1, 1.1
- new P2, ['Float']
- set P2, 1.2
- new P3, ['Float']
- set P3, 1.0
- new P4, ['Float']
- set P4, P1
-
- le_num P1, P2, OK1
- print "not "
-OK1: print "ok 1\n"
-
- le_num P1, P4, OK2
- print "not "
-OK2: print "ok 2\n"
-
- le_num P1, P3, BAD3
- branch OK3
-BAD3: print "not "
-OK3: print "ok 3\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: gt" );
- new P1, ['Float']
- set P1, 111.1
- set N1, P1
-
- gt P1, 111.2, BAD1
- branch OK1
-BAD1: print "not "
-OK1: print "ok 1\n"
-
- gt P1, N1, OK2
- branch OK2
-BAD2: print "not "
-OK2: print "ok 2\n"
-
- gt P1, 111.0, OK3
- print "not "
-OK3: print "ok 3\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: gt_num" );
- new P1, ['Float']
- set P1, 1.1
- new P2, ['Float']
- set P2, 1.2
- new P3, ['Float']
- set P3, 1.0
- new P4, ['Float']
- set P4, P1
-
- gt_num P1, P2, BAD1
- branch OK1
-BAD1: print "not "
-OK1: print "ok 1\n"
-
- gt_num P1, P4, OK2
- branch OK2
-BAD2: print "not "
-OK2: print "ok 2\n"
-
- gt_num P1, P3, OK3
- print "not "
-OK3: print "ok 3\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: ge" );
- new P1, ['Float']
- set P1, 111.1
- set N1, P1
-
- ge P1, 111.2, BAD1
- branch OK1
-BAD1: print "not "
-OK1: print "ok 1\n"
-
- ge P1, N1, OK2
- print "not "
-OK2: print "ok 2\n"
-
- ge P1, 111.0, OK3
- print "not "
-OK3: print "ok 3\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: ge_num" );
- new P1, ['Float']
- set P1, 1.1
- new P2, ['Float']
- set P2, 1.2
- new P3, ['Float']
- set P3, 1.0
- new P4, ['Float']
- set P4, P1
-
- ge_num P1, P2, BAD1
- branch OK1
-BAD1: print "not "
-OK1: print "ok 1\n"
-
- ge_num P1, P4, OK2
- print "not "
-OK2: print "ok 2\n"
-
- ge_num P1, P3, OK3
- print "not "
-OK3: print "ok 3\n"
- end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: cmp_p_n" );
- new P1, ['Float']
- set P1, 123.45
- set N1, 123.45
- set N2, -1.0
- set N3, 123.54
-
- cmp I0, P1, N1
- print I0
- print "\n"
- cmp I0, P1, N2
- print I0
- print "\n"
- cmp I0, P1, N3
- print I0
- print "\n"
- end
-CODE
-0
-1
--1
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: isgt" );
- new P1, ['Float']
- new P2, ['Float']
- new P3, ['Float']
- new P4, ['Integer']
- new P5, ['Integer']
- new P6, ['Float']
-
- set P1, 10.0
- set P2, 20.0
- set P3, 5.0
- set P4, 3
- set P5, 12
- set P6, 10.0
-
- isgt I0, P1, P2
- print I0
- print "\n"
- isgt I0, P1, P1
- print I0
- print "\n"
- isgt I0, P1, P3
- print I0
- print "\n"
- isgt I0, P1, P4
- print I0
- print "\n"
- isgt I0, P1, P5
- print I0
- print "\n"
- isgt I0, P1, P6
- print I0
- print "\n"
- end
-CODE
-0
-0
-1
-1
-0
-0
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: isge" );
- new P1, ['Float']
- new P2, ['Float']
- new P3, ['Float']
- new P4, ['Integer']
- new P5, ['Integer']
- new P6, ['Float']
-
- set P1, 10.0
- set P2, 20.0
- set P3, 5.0
- set P4, 3
- set P5, 12
- set P6, 10.0
-
- isge I0, P1, P2
- print I0
- print "\n"
- isge I0, P1, P1
- print I0
- print "\n"
- isge I0, P1, P3
- print I0
- print "\n"
- isge I0, P1, P4
- print I0
- print "\n"
- isge I0, P1, P5
- print I0
- print "\n"
- isge I0, P1, P6
- print I0
- print "\n"
- end
-CODE
-0
-1
-1
-1
-0
-1
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: islt" );
- new P1, ['Float']
- new P2, ['Float']
- new P3, ['Float']
- new P4, ['Integer']
- new P5, ['Integer']
- new P6, ['Float']
-
- set P1, 10.0
- set P2, 20.0
- set P3, 5.0
- set P4, 3
- set P5, 12
- set P6, 10.0
-
- islt I0, P1, P2
- print I0
- print "\n"
- islt I0, P1, P1
- print I0
- print "\n"
- islt I0, P1, P3
- print I0
- print "\n"
- islt I0, P1, P4
- print I0
- print "\n"
- islt I0, P1, P5
- print I0
- print "\n"
- islt I0, P1, P6
- print I0
- print "\n"
- end
-CODE
-1
-0
-0
-0
-1
-0
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: isle" );
- new P1, ['Float']
- new P2, ['Float']
- new P3, ['Float']
- new P4, ['Integer']
- new P5, ['Integer']
- new P6, ['Float']
-
- set P1, 10.0
- set P2, 20.0
- set P3, 5.0
- set P4, 3
- set P5, 12
- set P6, 10.0
-
- isle I0, P1, P2
- print I0
- print "\n"
- isle I0, P1, P1
- print I0
- print "\n"
- isle I0, P1, P3
- print I0
- print "\n"
- isle I0, P1, P4
- print I0
- print "\n"
- isle I0, P1, P5
- print I0
- print "\n"
- isle I0, P1, P6
- print I0
- print "\n"
- end
-CODE
-1
-1
-0
-0
-1
-1
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: iseq" );
- new P1, ['Float']
- new P2, ['Float']
- new P3, ['Float']
- new P4, ['Integer']
-
- set P1, 2.5
- set P2, 2.6
- set P3, 2.5
- set P4, 2
-
- iseq I0, P1, P1
- print I0
- print "\n"
- iseq I0, P1, P2
- print I0
- print "\n"
- iseq I0, P1, P3
- print I0
- print "\n"
- iseq I0, P1, P4
- print I0
- print "\n"
- end
-CODE
-1
-0
-1
-0
-OUTPUT
-
-pasm_output_is( << 'CODE', << 'OUTPUT', "comparison ops: isne" );
- new P1, ['Float']
- new P2, ['Float']
- new P3, ['Float']
- new P4, ['Integer']
-
- set P1, 2.5
- set P2, 2.6
- set P3, 2.5
- set P4, 2
-
- isne I0, P1, P1
- print I0
- print "\n"
- isne I0, P1, P2
- print I0
- print "\n"
- isne I0, P1, P3
- print I0
- print "\n"
- isne I0, P1, P4
- print I0
- print "\n"
- end
-CODE
-0
-1
-0
-1
-OUTPUT
+ $P0 = 0.001
+ $P0 += 1
+ is($P0, 1.001, 'Basic integer arithmetic: addition (1)', PRECISION)
-pir_output_is( <<'CODE', <<OUTPUT, "instantiate_str" );
-.sub main :main
- .const 'Float' pi = "3.1"
- print pi
- print "\n"
+ $P0 += -2
+ is($P0, -0.999, 'Basic integer arithmetic: addition (2)', PRECISION)
.end
-CODE
-3.1
-OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', 'cmp functions for subclasses' );
-.sub main :main
- $P0 = subclass 'Float', 'Flt'
+.sub 'integer_substraction'
+ $P0 = new ['Float']
- $P1 = new ['Flt']
- $P1 = 1.5
- $P2 = new ['Flt']
- $P2 = 2.73
+ $P0 = 103.45
+ $P0 -= 77
+ is($P0, 26.45, 'Basic integer arithmetic: subtraction (1)', PRECISION)
- $I0 = cmp $P1, $P2
- say $I0
- $I0 = cmp $P1, $P1
- say $I0
- $I0 = cmp $P2, $P1
- say $I0
+ $P0 -= -24
+ is($P0, 50.45, 'Basic integer arithmetic: subtraction (2)', PRECISION)
.end
-CODE
--1
-0
-1
-OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', 'acos as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
+.sub 'integer_multiplication'
$P0 = new ['Float']
- $P0 = 0.0
- $P1 = $P0.'acos'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "acos(%.1f) is %.9f", array
- say $S0
- $P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'acos'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "acos(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-acos(0.0) is 1.570796327
-acos(0.5) is 1.047197551
-OUTPUT
+ $P0 = 0.001
+ $P0 *= 10000
+ is($P0, 10.0, 'Basic integer arithmetic: multiplication (1)', PRECISION)
-pir_output_is( <<'CODE', <<'OUTPUT', 'cos as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
+ $P0 *= -1
+ is($P0, -10.0, 'Basic integer arithmetic: multiplication (2)', PRECISION)
+
+ $P0 *= 0
+ is($P0, 0.0, 'Basic integer arithmetic: multiplication (3)', PRECISION)
+.end
+
+.sub 'integer_division'
$P0 = new ['Float']
- $P0 = 0.0
- $P1 = $P0.'cos'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "cos(%.1f) is %.9f", array
- say $S0
- $P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'cos'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "cos(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-cos(0.0) is 1.000000000
-cos(0.5) is 0.877582562
-OUTPUT
+ $P0 = 1e8
+ $P0 /= 10000
+ is($P0, 10000.0, 'Basic integer arithmetic: division (1)', PRECISION)
-pir_output_is( <<'CODE', <<'OUTPUT', 'asec as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
+ $P0 /= 1000000
+ is($P0, 0.01, 'Basic integer arithmetic: division (2)', PRECISION)
+.end
+
+.sub 'number_addition'
$P0 = new ['Float']
- $P0 = 1.0
- $P1 = $P0.'asec'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "asec(%.1f) is %.9f", array
- say $S0
- $P2 = new ['Float']
- $P2 = 3.0
- $P3 = $P2.'asec'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "asec(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-asec(1.0) is 0.000000000
-asec(3.0) is 1.230959417
-OUTPUT
+ $P0 = 0.001
+ $P0 += 1.2
+ is($P0, 1.201, 'Basic numeric arithmetic: addition (1)', PRECISION)
-pir_output_is( <<'CODE', <<'OUTPUT', 'asin as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
+ $P0 += -2.4
+ is($P0, -1.199, 'Basic numeric arithmetic: addition (2)', PRECISION)
+.end
+
+.sub 'number_substraction'
$P0 = new ['Float']
- $P0 = 0.0
- $P1 = $P0.'asin'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "asin(%.1f) is %.9f", array
- say $S0
- $P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'asin'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "asin(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-asin(0.0) is 0.000000000
-asin(0.5) is 0.523598776
-OUTPUT
+ $P0 = 103.45
+ $P0 -= 3.46
+ is($P0, 99.99, 'Basic numeric arithmetic: subtraction (1)', PRECISION)
-pir_output_is( <<'CODE', <<'OUTPUT', 'atan as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
+ $P0 -= -0.01
+ is($P0, 100.0, 'Basic numeric arithmetic: subtraction (2)', PRECISION)
+.end
+
+.sub 'number_multiplication'
$P0 = new ['Float']
- $P0 = 0.0
- $P1 = $P0.'atan'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "atan(%.1f) is %.9f", array
- say $S0
- $P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'atan'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "atan(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-atan(0.0) is 0.000000000
-atan(0.5) is 0.463647609
-OUTPUT
+ $P0 = 0.001
+ $P0 *= 123.5
+ is($P0, 0.1235, 'Basic numeric arithmetic: multiplication (1)', PRECISION)
-pir_output_is( <<'CODE', <<'OUTPUT', 'atan2 as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 3
+ $P0 *= -2.6
+ is($P0, -0.3211, 'Basic numeric arithmetic: multiplication (2)', PRECISION)
+
+ $P0 *= 0.0
+ is($P0, 0.0, 'Basic numeric arithmetic: multiplication (3)', PRECISION)
+.end
+
+.sub 'number_division'
+ $P0 = new ['Float']
+
+ $P0 = 1e8
+ $P0 /= 0.5
+ is($P0, 2e8, 'Basic numeric arithmetic: division (1)', PRECISION)
+
+ $P0 /= 4000.0
+ is($P0, 50000.0, 'Basic numeric arithmetic: division (2)', PRECISION)
+.end
+
+.sub 'increment_decrement'
+ $P0 = new ['Float']
+
+ $P0 = 0.5
+ inc $P0
+ is($P0, 1.5, 'increment (1)', PRECISION)
+ dec $P0
+ is($P0, 0.5, 'decrement (1)', PRECISION)
+ dec $P0
+ is($P0, -.5, 'decrement (2)', PRECISION)
+ inc $P0
+ is($P0, 0.5, 'increment (2)', PRECISION)
+.end
+
+.sub 'neg'
$P0 = new ['Float']
+ $P0 = 0.5
+ neg $P0
+ is($P0, -0.5, 'Neg', PRECISION)
+
$P1 = new ['Float']
- $P0 = 0.7
- $P1 = 0.5
- $P2 = $P0.'atan2'($P1)
- array[0] = $P0
- array[1] = $P1
- array[2] = $P2
- $S0 = sprintf "atan2(%.1f, %.1f) is %.9f", array
- say $S0
-.end
-CODE
-atan2(0.7, 0.5) is 0.950546841
-OUTPUT
+ $P1 = - $P0
+ is($P1, 0.5, 'Neg is involutive', PRECISION)
+.end
+
+.sub 'negative_zero'
+ load_bytecode 'config.pbc'
+ $P1 = _config()
+ $P2 = $P1['has_negative_zero']
+ unless $P2 goto negative_zero_todoed
-pir_output_is( <<'CODE', <<'OUTPUT', 'cosh as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
$P0 = new ['Float']
$P0 = 0.0
- $P1 = $P0.'cosh'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "cosh(%.1f) is %.9f", array
- say $S0
+ neg $P0
- $P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'cosh'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "cosh(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-cosh(0.0) is 1.000000000
-cosh(0.5) is 1.127625965
-OUTPUT
+ $S0 = $P0
+ like($S0, '^\-0', 'negative zero')
+ .return ()
-pir_output_is( <<'CODE', <<'OUTPUT', 'exp as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
+ negative_zero_todoed:
+ todo(1, '-0.0 not implemented, TT#313')
+.end
+
+.sub 'equality'
$P0 = new ['Float']
- $P0 = 0.0
- $P1 = $P0.'exp'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "exp(%.1f) is %.9f", array
- say $S0
+ $P0 = 1e8
+
+ $P1 = new ['Float']
+ $P1 = 1e8
$P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'exp'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "exp(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-exp(0.0) is 1.000000000
-exp(0.5) is 1.648721271
-OUTPUT
+ $P2 = 2.4
-pir_output_is( <<'CODE', <<'OUTPUT', 'ln as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
+ $I0 = 1
+ if $P0 == $P1 goto equality_1
+ $I0 = 0
+ equality_1:
+ ok($I0, 'equal floats')
+
+ $I0 = 0
+ if $P0 == $P2 goto equality_2
+ $I0 = 1
+ equality_2:
+ ok($I0, 'different floats are not equal')
+
+ $I0 = 1
+ if $P0 != $P2 goto equality_3
+ $I0 = 0
+ equality_3:
+ ok($I0, "different floats are different")
+
+ $I0 = 0
+ if $P0 != $P1 goto equality_4
+ $I0 = 1
+ equality_4:
+ ok($I0, "equal floats aren't different")
+
+ $I0 = 1
+ eq_num $P0, $P1, equality_5
+ $I0 = 0
+ equality_5:
+ ok($I0, "equal floats are eq_num")
+
+ $I0 = 0
+ eq_num $P0, $P2, equality_6
+ $I0 = 1
+ equality_6:
+ ok($I0, "different floats aren't eq_num")
+
+ $I0 = 1
+ ne_num $P0, $P2, equality_7
+ $I0 = 0
+ equality_7:
+ ok($I0, "different floats are ne_num")
+
+ $I0 = 0
+ ne_num $P0, $P1, equality_8
+ $I0 = 1
+ equality_8:
+ ok($I0, "equal floats aren't ne_num")
+.end
+
+.sub 'is_interface_done'
+ .local pmc pmc1
+ .local int bool1
+ pmc1 = new ['Float']
+
+ bool1 = does pmc1, "scalar"
+ ok(bool1, 'Float does "scalar"')
+
+ bool1 = does pmc1, "float"
+ ok(bool1, 'Float does "float"')
+
+ bool1 = does pmc1, "no_interface"
+ nok(bool1, 'Float does not "no_interface"')
+.end
+
+.sub 'abs'
$P0 = new ['Float']
- $P0 = 45.0
- $P1 = $P0.'ln'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "ln(%.1f) is %.9f", array
- say $S0
+ $P0 = 1.0
+ abs $P0
+ is($P0, $P0, 'abs does not change positive floats')
+
+ $P0 = -1.0
+ abs $P0
+ is($P0, 1.0, 'abs of -1.0', PRECISION)
+
+ $P0 = -5.0
+ abs $P0
+ is($P0, 5.0, 'abs of -5.0', PRECISION)
+.end
+
+.sub 'lt'
+ $P1 = new ['Float']
+ $P1 = 111.11
+ $N1 = $P1
+
+ $I0 = 1
+ lt $P1, 111.12, lt_1
+ $I0 = 0
+ lt_1:
+ ok($I0, 'lt ok')
+
+ $I0 = 0
+ lt $P1, $N1, lt_2
+ $I0 = 1
+ lt_2:
+ ok($I0, 'lt irreflexive')
+
+ $I0 = 0
+ lt $P1, 111.0, lt_3
+ $I0 = 1
+ lt_3:
+ ok($I0, 'not lt')
+.end
+
+.sub 'lt_num'
+ $P1 = new ['Float']
+ $P1 = 1.1
$P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'ln'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "ln(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-ln(45.0) is 3.806662490
-ln(0.5) is -0.693147181
-OUTPUT
+ $P2 = 1.2
-pir_output_is( <<'CODE', <<'OUTPUT', 'log10 as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
- $P0 = new ['Float']
- $P0 = 1000.0
- $P1 = $P0.'log10'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "log10(%.1f) is %.9f", array
- say $S0
+ $P3 = new ['Float']
+ $P3 = 1.0
+
+ $P4 = new ['Float']
+ $P4 = $P1
+
+ $I0 = 1
+ lt_num $P1, $P2, lt_num_1
+ $I0 = 0
+ lt_num_1:
+ ok($I0, 'lt_num true')
+
+ $I0 = 0
+ lt_num $P1, $P4, lt_num_2
+ $I0 = 1
+ lt_num_2:
+ ok($I0, 'lt_num irreflexive')
+
+ $I0 = 0
+ lt_num $P1, $P3, lt_num_3
+ $I0 = 1
+ lt_num_3:
+ ok($I0, 'lt_num false')
+.end
+
+.sub 'le'
+ $P1 = new ['Float']
+ $P1 = 111.1
+ $N1 = $P1
+
+ $I0 = 1
+ le $P1, 111.2, le_1
+ $I0 = 0
+ le_1:
+ ok($I0, 'le_p_nc')
+
+ $I0 = 1
+ le $P1, $N1, le_2
+ $I0 = 0
+ le_2:
+ ok($I0, 'le_p_n')
+
+ $I0 = 0
+ le $P1, 111.0, le_3
+ $I0 = 1
+ le_3:
+ ok($I0, 'le_p_nc false')
+
+ $I0 = 1
+ le $P1, $P1, le_4
+ $I0 = 0
+ le_4:
+ ok($I0, 'le reflexive')
+.end
+
+.sub 'le_num'
+ $P1 = new ['Float']
+ $P1 = 1.1
$P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'log10'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "log10(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-log10(1000.0) is 3.000000000
-log10(0.5) is -0.301029996
-OUTPUT
+ $P2 = 1.2
-pir_output_is( <<'CODE', <<'OUTPUT', 'log2 as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
- $P0 = new ['Float']
- $P0 = 32.0
- $P1 = $P0.'log2'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "log2(%.1f) is %.9f", array
- say $S0
+ $P3 = new ['Float']
+ $P3 = 1.0
+
+ $P4 = new ['Float']
+ $P4 = $P1
+
+ $I0 = 1
+ le_num $P1, $P2, le_num_1
+ $I0 = 0
+ le_num_1:
+ ok($I0, 'le_num true')
+
+ $I0 = 1
+ le_num $P1, $P4, le_num_2
+ $I0 = 0
+ le_num_2:
+ ok($I0, 'le_num reflexive')
+
+ $I0 = 0
+ le_num $P1, $P3, le_num_3
+ $I0 = 1
+ le_num_3:
+ ok($I0, 'le_num false')
+.end
+.sub 'gt'
+ $P1 = new ['Float']
+ $P1 = 111.1
+ $N1 = $P1
+
+ $I0 = 0
+ gt $P1, 111.2, gt_1
+ $I0 = 1
+ gt_1:
+ ok($I0, 'comparison ops: gt nok')
+
+ $I0 = 1
+ gt $P1, $N1, gt_2
+ $I0 = 0
+ gt_2:
+ nok($I0, 'comparison ops: gt irreflexive')
+
+ $I0 = 1
+ gt $P1, 111.0, gt_3
+ $I0 = 0
+ gt_3:
+ ok($I0, 'comparison ops: gt ok')
+.end
+
+.sub 'gt_num'
+ $P1 = new ['Float']
$P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'log2'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "log2(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-log2(32.0) is 5.000000000
-log2(0.5) is -1.000000000
-OUTPUT
+ $P3 = new ['Float']
+ $P4 = new ['Float']
-pir_output_is( <<'CODE', <<'OUTPUT', 'sec as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
- $P0 = new ['Float']
- $P0 = 0.0
- $P1 = $P0.'sec'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "sec(%.1f) is %.9f", array
- say $S0
+ $P1 = 1.1
+ $P2 = 1.2
+ $P3 = 1.0
+ $P4 = $P1
+
+ $I0 = 0
+ gt_num $P1, $P2, gt_num_1
+ $I0 = 1
+ gt_num_1:
+ ok($I0, 'comparison ops: gt_num nok')
+
+ $I0 = 0
+ gt_num $P1, $P4, gt_num_2
+ $I0 = 1
+ gt_num_2:
+ ok($I0, 'comparison ops: gt_num irreflexive')
+
+ $I0 = 1
+ gt_num $P1, $P3, gt_num_3
+ $I0 = 0
+ gt_num_3:
+ ok($I0, 'comparison ops: gt_num ok')
+.end
+.sub 'ge'
+ $P1 = new ['Float']
+ $P1 = 111.1
+ $N1 = $P1
+
+ $I0 = 0
+ ge $P1, 111.2, ge_1
+ $I0 = 1
+ ge_1:
+ ok($I0, 'comparison ops: ge nok')
+
+ $I0 = 1
+ ge $P1, $N1, ge_2
+ $I0 = 0
+ ge_2:
+ ok($I0, 'comparison ops: ge reflexive')
+
+ $I0 = 1
+ ge $P1, 111.0, ge_3
+ $I0 = 0
+ ge_3:
+ ok($I0, 'comparison ops: ge ok')
+.end
+
+.sub 'ge_num'
+ $P1 = new ['Float']
$P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'sec'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "sec(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-sec(0.0) is 1.000000000
-sec(0.5) is 1.139493927
-OUTPUT
+ $P3 = new ['Float']
+ $P4 = new ['Float']
-pir_output_is( <<'CODE', <<'OUTPUT', 'sech as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
- $P0 = new ['Float']
- $P0 = 0.0
- $P1 = $P0.'sech'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "sech(%.1f) is %.9f", array
- say $S0
+ $P1 = 1.1
+ $P2 = 1.2
+ $P3 = 1.0
+ $P4 = $P1
+
+ $I0 = 0
+ ge_num $P1, $P2, ge_num_1
+ $I0 = 1
+ ge_num_1:
+ ok($I0, 'comparison ops: ge_num nok')
+
+ $I0 = 1
+ ge_num $P1, $P4, ge_num_2
+ $I0 = 0
+ ge_num_2:
+ ok($I0, 'comparison ops: ge_num reflexive')
+
+ $I0 = 1
+ ge_num $P1, $P3, ge_num_3
+ $I0 = 0
+ ge_num_3:
+ ok($I0, 'comparison ops: ge_num ok')
+.end
+.sub 'cmp_p_n'
+ $P1 = new ['Float']
+ $P1 = 123.45
+ $N1 = 123.45
+ $N2 = -1.0
+ $N3 = 123.54
+
+ $I0 = cmp $P1, $N1
+ is($I0, 0, 'comparison ops: cmp_p_n: equality')
+
+ $I0 = cmp $P1, $N2
+ is($I0, 1, 'comparison ops: cmp_p_n: gt')
+
+ $I0 = cmp $P1, $N3
+ is($I0, -1, 'comparison ops: cmp_p_n: lt')
+.end
+
+.sub 'isgt'
+ $P1 = new ['Float']
$P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'sech'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "sech(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-sech(0.0) is 1.000000000
-sech(0.5) is 0.886818884
-OUTPUT
+ $P3 = new ['Float']
+ $P4 = new ['Integer']
+ $P5 = new ['Integer']
+ $P6 = new ['Float']
-pir_output_is( <<'CODE', <<'OUTPUT', 'sin as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
- $P0 = new ['Float']
- $P0 = 0.0
- $P1 = $P0.'sin'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "sin(%.1f) is %.9f", array
- say $S0
+ $P1 = 10.0
+ $P2 = 20.0
+ $P3 = 5.0
+ $P4 = 3
+ $P5 = 12
+ $P6 = 10.0
+
+ $I0 = isgt $P1, $P2
+ nok($I0, 'comparison ops: isgt nok')
+
+ $I0 = isgt $P1, $P1
+ nok($I0, 'comparison ops: isgt irreflexive')
+
+ $I0 = isgt $P1, $P3
+ ok($I0, 'comparison ops: isgt ok')
+
+ $I0 = isgt $P1, $P4
+ ok($I0, 'comparison ops: isgt ok with Float and Integer')
+ $I0 = isgt $P1, $P5
+ nok($I0, 'comparison ops: isgt nok with Float and Integer')
+
+ $I0 = isgt $P1, $P6
+ nok($I0, 'comparison ops: isgt irreflexive (different PMCs)')
+.end
+
+.sub 'isge'
+ $P1 = new ['Float']
$P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'sin'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "sin(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-sin(0.0) is 0.000000000
-sin(0.5) is 0.479425539
-OUTPUT
+ $P3 = new ['Float']
+ $P4 = new ['Integer']
+ $P5 = new ['Integer']
+ $P6 = new ['Float']
-pir_output_is( <<'CODE', <<'OUTPUT', 'sinh as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
- $P0 = new ['Float']
- $P0 = 0.0
- $P1 = $P0.'sinh'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "sinh(%.1f) is %.9f", array
- say $S0
+ $P1 = 10.0
+ $P2 = 20.0
+ $P3 = 5.0
+ $P4 = 3
+ $P5 = 12
+ $P6 = 10.0
+
+ $I0 = isge $P1, $P2
+ nok($I0, 'comparison ops: isge nok')
+
+ $I0 = isge $P1, $P1
+ ok($I0, 'comparison ops: isge reflexive')
+
+ $I0 = isge $P1, $P3
+ ok($I0, 'comparison ops: isge ok')
+
+ $I0 = isge $P1, $P4
+ ok($I0, 'comparison ops: isge ok with Float and Integer')
+
+ $I0 = isge $P1, $P5
+ nok($I0, 'comparison ops: isge nok with Float and Integer')
+
+ $I0 = isge $P1, $P6
+ ok($I0, 'comparison ops: isge reflexive (different PMCs)')
+.end
+.sub 'islt'
+ $P1 = new ['Float']
$P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'sinh'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "sinh(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-sinh(0.0) is 0.000000000
-sinh(0.5) is 0.521095305
-OUTPUT
+ $P3 = new ['Float']
+ $P4 = new ['Integer']
+ $P5 = new ['Integer']
+ $P6 = new ['Float']
-pir_output_is( <<'CODE', <<'OUTPUT', 'tan as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
- $P0 = new ['Float']
- $P0 = 0.0
- $P1 = $P0.'tan'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "tan(%.1f) is %.9f", array
- say $S0
+ $P1 = 10.0
+ $P2 = 20.0
+ $P3 = 5.0
+ $P4 = 3
+ $P5 = 12
+ $P6 = 10.0
+
+ $I0 = islt $P1, $P2
+ ok($I0, 'comparison ops: islt ok')
+
+ $I0 = islt $P1, $P1
+ nok($I0, 'comparison ops: islt irreflexive')
+
+ $I0 = islt $P1, $P3
+ nok($I0, 'comparison ops: islt nok')
+
+ $I0 = islt $P1, $P4
+ nok($I0, 'comparison ops: islt nok with Float and Integer')
+ $I0 = islt $P1, $P5
+ ok($I0, 'comparison ops: islt ok with Float and Integer')
+
+ $I0 = islt $P1, $P6
+ nok($I0, 'comparison ops: islt irreflexive (different PMCs)')
+.end
+
+.sub 'isle'
+ $P1 = new ['Float']
$P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'tan'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "tan(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-tan(0.0) is 0.000000000
-tan(0.5) is 0.546302490
-OUTPUT
+ $P3 = new ['Float']
+ $P4 = new ['Integer']
+ $P5 = new ['Integer']
+ $P6 = new ['Float']
-pir_output_is( <<'CODE', <<'OUTPUT', 'tanh as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
- .local pmc array
- array = new 'FixedFloatArray'
- array = 2
- $P0 = new ['Float']
- $P0 = 0.0
- $P1 = $P0.'tanh'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "tanh(%.1f) is %.9f", array
- say $S0
+ $P1 = 10.0
+ $P2 = 20.0
+ $P3 = 5.0
+ $P4 = 3
+ $P5 = 12
+ $P6 = 10.0
+
+ $I0 = isle $P1, $P2
+ ok($I0, 'comparison ops: isle ok')
+
+ $I0 = isle $P1, $P1
+ ok($I0, 'comparison ops: isle reflexive')
+ $I0 = isle $P1, $P3
+ nok($I0, 'comparison ops: isle nok')
+
+ $I0 = isle $P1, $P4
+ nok($I0, 'comparison ops: isle nok with Float and Integer')
+
+ $I0 = isle $P1, $P5
+ ok($I0, 'comparison ops: isle ok with Float and Integer')
+
+ $I0 = isle $P1, $P6
+ ok($I0, 'comparison ops: isle reflexive (different PMCs)')
+.end
+
+.sub 'iseq'
+ $P1 = new ['Float']
$P2 = new ['Float']
- $P2 = 0.5
- $P3 = $P2.'tanh'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "tanh(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-tanh(0.0) is 0.000000000
-tanh(0.5) is 0.462117157
-OUTPUT
+ $P3 = new ['Float']
+ $P4 = new ['Integer']
+
+ $P1 = 2.5
+ $P2 = 2.6
+ $P3 = 2.5
+ $P4 = 2
+
+ $I0 = iseq $P1, $P1
+ ok($I0, 'iseq reflexive, same PMC')
+
+ $I0 = iseq $P1, $P3
+ ok($I0, 'iseq reflexive, different PMCs')
+
+ $I0 = iseq $P1, $P2
+ nok($I0, 'iseq nok with two Floats')
+
+ $I0 = iseq $P1, $P4
+ nok($I0, 'iseq nok between an Integer and a Float')
+.end
+
+.sub 'isne'
+ $P1 = new ['Float']
+ $P2 = new ['Float']
+ $P3 = new ['Float']
+ $P4 = new ['Integer']
+
+ $P1 = 2.5
+ $P2 = 2.6
+ $P3 = 2.5
+ $P4 = 2
+
+ $I0 = isne $P1, $P1
+ nok($I0, 'isne irreflexive, same PMC')
+
+ $I0 = isne $P1, $P3
+ nok($I0, 'isne irreflexive, different PMCs')
+
+ $I0 = isne $P1, $P2
+ ok($I0, 'isne ok with two Floats')
+
+ $I0 = isne $P1, $P4
+ ok($I0, 'isne ok between an Integer and a Float')
+.end
+
+.sub 'instantiate_str'
+ .const 'Float' pi = "3.1"
+ $P1 = get_class ['Float']
+ isa_ok(pi, $P1)
+ is(pi, 3.1, 'instantiate_str', PRECISION)
+.end
+
+.sub 'cmp_subclasses'
+ $P0 = subclass 'Float', 'Flt'
+
+ $P1 = new ['Flt']
+ $P1 = 1.5
+
+ $P2 = new ['Flt']
+ $P2 = 2.73
+
+ $I0 = cmp $P1, $P2
+ is(-1, $I0, 'cmp functions for subclasses (lt)')
+
+ $I0 = cmp $P1, $P1
+ is(0, $I0, 'cmp functions for subclasses (eq)')
+
+ $I0 = cmp $P2, $P1
+ is(1, $I0, 'cmp functions for subclasses (gt)')
+.end
+
+.sub 'test_method'
+ .param string method
+ .param num number
+ .param num expected
-pir_output_is( <<'CODE', <<'OUTPUT', 'sqrt as a method' );
-.include 'fp_equality.pasm'
-.sub main :main
.local pmc array
- array = new 'FixedFloatArray'
- array = 2
+ array = new 'FixedPMCArray'
+ array = 3
+ array[0] = method
+ array[1] = number
+ array[2] = expected
+
$P0 = new ['Float']
- $P0 = 16.0
- $P1 = $P0.'sqrt'()
- array[0] = $P0
- array[1] = $P1
- $S0 = sprintf "sqrt(%.1f) is %.9f", array
- say $S0
+ $P0 = number
+ $P1 = $P0.method()
- $P2 = new ['Float']
- $P2 = 2.0
- $P3 = $P2.'sqrt'()
- array[0] = $P2
- array[1] = $P3
- $S0 = sprintf "sqrt(%.1f) is %.9f", array
- say $S0
-.end
-CODE
-sqrt(16.0) is 4.000000000
-sqrt(2.0) is 1.414213562
-OUTPUT
+ $S0 = sprintf '%s(%.1f) is %.9f', array
+ is($P1, expected, $S0, PRECISION)
+.end
+
+.sub 'acos_method'
+ test_method('acos', 0.0, 1.570796327)
+ test_method('acos', 0.5, 1.047197551)
+.end
+
+.sub 'cos_method'
+ test_method('cos', 0.0, 1.0)
+ test_method('cos', 0.5, 0.877582562)
+.end
+
+.sub 'asec_method'
+ test_method('asec', 1.0, 0.0)
+ test_method('asec', 3.0, 1.230959417)
+.end
+
+.sub 'asin_method'
+ test_method('asin', 0.0, 0.0)
+ test_method('asin', 0.5, 0.523598776)
+.end
+
+.sub 'atan_method'
+ test_method('atan', 0.0, 0.0)
+ test_method('atan', 0.5, 0.463647609)
+.end
+
+.sub 'atan2_method'
+ $P0 = new ['Float']
+ $P1 = new ['Float']
+
+ $P0 = 0.7
+ $P1 = 0.5
+
+ $P2 = $P0.'atan2'($P1)
+ is($P2, 0.950546841, 'atan2 as a method', PRECISION)
+.end
+
+.sub 'cosh_method'
+ test_method('cosh', 0.0, 1.0)
+ test_method('cosh', 0.5, 1.127625965)
+.end
+
+.sub 'exp_method'
+ test_method('exp', 0.0, 1.0)
+ test_method('exp', 0.5, 1.648721271)
+.end
+.sub 'ln_method'
+ test_method('ln', 1.0, 0.0)
+ test_method('ln', 45.0, 3.806662490)
+ test_method('ln', 0.5, -0.693147181)
+.end
+
+.sub 'log10_method'
+ test_method('log10', 1000.0, 3.0)
+ test_method('log10', 0.5, -0.301029996)
+.end
+
+.sub 'log2_method'
+ test_method('log2', 32.0, 5.0)
+ test_method('log2', 0.5, -1.0)
+.end
+
+.sub 'sec_method'
+ test_method('sec', 0.0, 1.0)
+ test_method('sec', 0.5, 1.139493927)
+.end
+
+.sub 'sech_method'
+ test_method('sech', 0.0, 1.0)
+ test_method('sech', 0.5, 0.886818884)
+.end
+
+.sub 'sin_method'
+ test_method('sin', 0.0, 0.0)
+ test_method('sin', 0.5, 0.479425539)
+.end
+
+.sub 'sinh_method'
+ test_method('sinh', 0.0, 0.0)
+ test_method('sinh', 0.5, 0.521095305)
+.end
+
+.sub 'tan_method'
+ test_method('tan', 0.0, 0.0)
+ test_method('tan', 0.5, 0.546302490)
+.end
+
+.sub 'tanh_method'
+ test_method('tanh', 0.0, 0.0)
+ test_method('tanh', 0.5, 0.462117157)
+.end
+
+.sub 'sqrt_method'
+ test_method('sqrt', 16.0, 4.0)
+ test_method('sqrt', 2.0, 1.414213562)
+.end
# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
+# mode: pir
# fill-column: 100
# End:
-# vim: expandtab shiftwidth=4:
+# vim: expandtab shiftwidth=4 ft=pir:
Deleted: branches/gc-refactor/t/pmc/integer-old.t
==============================================================================
--- branches/gc-refactor/t/pmc/integer-old.t Mon Sep 7 23:56:34 2009 (r41142)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,54 +0,0 @@
-#!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 => 2;
-
-=head1 NAME
-
-t/pmc/integer-old.t - Perl tests for Integer basic type
-
-=head1 SYNOPSIS
-
- % prove t/pmc/integer.t
-
-=head1 DESCRIPTION
-
-Perl tests the Integer PMC. These should be translated to PIR when possible.
-
-=cut
-
-
-pir_error_output_like( <<'CODE',qr/get_as_base: base out of bounds/ms, "get_as_base() bounds check" );
-.sub main :main
- $P0 = new ['Integer']
- $P0 = 42
-
- $S0 = $P0.'get_as_base'(1)
-
- say $S0
-.end
-CODE
-
-pir_error_output_like( <<'CODE', qr/get_as_base: base out of bounds/ms,"get_as_base() bounds check" );
-.sub main :main
- $P0 = new ['Integer']
- $P0 = 42
-
- $S0 = $P0.'get_as_base'(37)
-
- say $S0
-.end
-CODE
-
-# Local Variables:
-# mode: cperl
-# cperl-indent-level: 4
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4:
Modified: branches/gc-refactor/t/pmc/integer.t
==============================================================================
--- branches/gc-refactor/t/pmc/integer.t Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/t/pmc/integer.t Mon Sep 7 23:56:34 2009 (r41143)
@@ -19,7 +19,7 @@
.sub 'test' :main
.include 'test_more.pir'
- plan(58)
+ plan(60)
test_basic_math()
test_truthiness_and_definedness()
test_set_string_native()
@@ -35,10 +35,29 @@
test_get_as_base()
test_get_as_base10()
test_get_as_base_various()
+ test_get_as_base_bounds_check()
test_cmp_subclass()
test_cmp_RT59336()
.end
+.sub test_get_as_base_bounds_check
+ throws_like(<<'CODE', ':s get_as_base\: base out of bounds', 'get_as_base lower bound check')
+ .sub main
+ $P0 = new ['Integer']
+ $P0 = 42
+ $S0 = $P0.'get_as_base'(1)
+ say $S0
+ .end
+CODE
+ throws_like(<<'CODE', ':s get_as_base\: base out of bounds', 'get_as_base upper bound check')
+ .sub main
+ $P0 = new ['Integer']
+ $P0 = 42
+ $S0 = $P0.'get_as_base'(37)
+ say $S0
+ .end
+CODE
+.end
.sub test_basic_math
.local pmc int_1
@@ -304,40 +323,6 @@
ok($I0,'Integers can get_as_base')
.end
-=pod
-
-pir_error_output_like( <<'CODE',qr/get_as_base: base out of bounds/ms, "get_as_base() bounds check" );
-.sub main :main
- $P0 = new ['Integer']
- $P0 = 42
-
- $S0 = $P0.'get_as_base'(1)
-
- print $S0
- print "\n"
-.end
-CODE
-/get_as_base: base out of bounds
-.*/
-OUTPUT
-
-pir_error_output_like( <<'CODE', <<'OUTPUT', "get_as_base() bounds check" );
-.sub main :main
- $P0 = new ['Integer']
- $P0 = 42
-
- $S0 = $P0.'get_as_base'(37)
-
- print $S0
- print "\n"
-.end
-CODE
-/get_as_base: base out of bounds
-.*/
-OUTPUT
-
-=cut
-
.sub test_get_as_base10
$P0 = new ['Integer']
$P0 = 42
Modified: branches/gc-refactor/t/pmc/namespace-old.t
==============================================================================
--- branches/gc-refactor/t/pmc/namespace-old.t Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/t/pmc/namespace-old.t Mon Sep 7 23:56:34 2009 (r41143)
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 45;
+use Parrot::Test tests => 38;
use Parrot::Config;
=head1 NAME
@@ -23,51 +23,6 @@
=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";
@@ -237,78 +192,6 @@
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
@@ -404,6 +287,7 @@
Could not find non-existent sub b_foo/
OUTPUT
+
pir_output_is( <<'CODE', <<'OUTPUT', "get_parent" );
.sub main :main
.local pmc ns
Modified: branches/gc-refactor/t/pmc/namespace.t
==============================================================================
--- branches/gc-refactor/t/pmc/namespace.t Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/t/pmc/namespace.t Mon Sep 7 23:56:34 2009 (r41143)
@@ -12,7 +12,43 @@
=head1 DESCRIPTION
-Tests the NameSpace PMC.
+Tests the NameSpace PMC. Some things that it tests specifically:
+
+=over 4
+
+=item* Creating new NameSpace PMCs
+
+=item* Verify that things which are supposed to return a NameSpace actually
+do.
+
+=item* Various forms of get_global opcode
+
+=item* Finding and calling Subs which are stored in the NameSpace
+
+=item* Methods on the NameSpace PMC
+
+=item* Building NameSpace hierarchies on the fly
+
+=item* HLL NameSpaces
+
+=back
+
+Items that need to be tested according to PDD21, or the current source code
+of the NameSpace PMC:
+
+=over 4
+
+=item* methods: add_sub, del_sub, del_var, del_namespace
+
+=item* Typed and Untyped interfaces
+
+=item* Subclassing NameSpace (If it's possible)
+
+=item* .'export_to'()
+
+Although NameSpace.'export_to'() is used in test_more.pir.
+
+=back
=cut
@@ -20,29 +56,33 @@
.sub main :main
.include 'test_more.pir'
- plan(44)
+ plan(70)
create_namespace_pmc()
verify_namespace_type()
+ get_namespace_class()
get_global_opcode()
get_sub_from_namespace_hash()
access_sub_in_namespace()
get_namespace_from_sub()
build_namespaces_at_runtime()
hll_namespaces()
+ anon_function_namespace()
+ find_name_opcode()
namespace_methods()
+ export_to_method()
.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:
+ pop_eh
.end
.sub 'verify_namespace_type'
@@ -55,99 +95,188 @@
typeof $S0, $P0
is($S0, "NameSpace", "Root NameSpace is a NameSpace")
+ # While we're here. Prove that the root namespace stringifies to ""
+ $S0 = $P0
+ is($S0, "", "Root NameSpace stringifies to empty string")
+
# parrot namespace
$P1 = $P0["parrot"]
typeof $S0, $P1
is($S0, "NameSpace", "::parrot NameSpace is a NameSpace")
+ # get_namespace with no args
$P0 = get_namespace
typeof $S0, $P1
is($S0, "NameSpace", "Current NameSpace is a NameSpace")
+
+ # Prove that HLL namespace names are mangled to lower-case
+ $P0 = get_root_namespace ["MyHLL"]
+ $I0 = isnull $P0
+ is($I0, 1, "HLL NameSpace names are stored lowercase")
+
+ $P0 = get_root_namespace ["myhll"]
+ $I0 = isnull $P0
+ is($I0, 0, "HLL NameSpaces are name-mangled lowercase")
+
+ # Get an HLL namespace and verify that it's a NameSpace PMC
+ $P0 = get_root_namespace ["myhll"]
+ $S0 = typeof $P0
+ is($S0, "NameSpace", "HLL NameSpaces are NameSpaces too")
+
+.end
+
+.sub 'get_namespace_class'
+ # First, prove that we don't have a class until it's created
+ $P0 = get_global "Foo"
+ $P1 = get_class $P0
+ $I0 = isnull $P1
+ is($I0, 1, "NameSpace doesn't have a Class till it's created")
+
+ # Can create a new class from a NameSpace
+ $P1 = newclass $P0
+ $I0 = isnull $P1
+ is($I0, 0, "Create Class from NameSpace")
+
+ # New Class is a Class
+ $S0 = typeof $P1
+ is($S0, "Class", "get_class on a NameSpace returns a Class")
+
+ # Class has same name as namespace
+ $S0 = $P0
+ $S1 = $P1
+ is($S0, $S1, "Class has same name as NameSpace")
+
+ # Now, we do have a class
+ $P1 = get_class $P0
+ $I0 = isnull $P1
+ is($I0, 0, "get_class on a NameSpace returns something")
+
+ # Create object from class from NameSpace
+ push_eh eh
+ $P2 = new $P1
+ ok(1, "Can create a new object from a namespace")
+ goto pmc_is_created
+ eh:
+ ok(0, "Cannot create a new object from a namespace")
+ pmc_is_created:
+ pop_eh
+
+ # Object from Class from NameSpace has right type
+ $S0 = typeof $P2
+ is($S0, "Foo", "Object created from class has name of NameSpace")
+
.end
# L<PDD21//>
.sub 'get_global_opcode'
+ test1:
push_eh eh1
$P0 = get_global "baz"
$S0 = $P0()
- pop_eh
is($S0, "", "Can get_global a .sub")
- goto test2
+ goto end_test1
eh1:
ok(0, "Cannot get_global a .sub")
+ end_test1:
+ pop_eh
test2:
push_eh eh2
$P0 = get_global ["Foo"], "baz"
$S0 = $P0()
- pop_eh
is($S0, "Foo", "Get Sub from NameSpace")
- goto test3
+ goto end_test2
eh2:
ok(0, "Cannot get Sub from NameSpace Foo")
+ end_test2:
+ pop_eh
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
+ goto end_test3
eh3:
ok(0, "Cannot get Sub from NameSpace Foo::Bar")
+ end_test3:
+ pop_eh
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")
+ throws_like( <<'CODE', 'Null\ PMC\ access\ in\ invoke', 'Invoking a non-existent sub')
+ .sub main
+ $P0 = get_global ["Foo"], "SUB_THAT_DOES_NOT_EXIST"
+ $P0()
+ .end
+CODE
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")
+ throws_like( <<'CODE', 'Null\ PMC\ access\ in\ invoke', 'Invoking a non-existent sub')
+ .sub main
+ $P0 = get_global ["Foo";"Bar"], "SUB_THAT_DOES_NOT_EXIST"
+ $P0()
+ .end
+CODE
test6:
push_eh eh6
- $P0 = get_global [ iso-8859-1:"François" ], "baz"
+ $P0 = get_global [ iso-8859-1:"Fran\x{E7}ois" ], "baz"
$S0 = $P0()
- is($S0, iso-8859-1:"François", "Found sub in ISO-8859 NameSpace")
- goto test7
+ is($S0, iso-8859-1:"Fran\x{E7}ois", "Found sub in ISO-8859 NameSpace")
+ goto end_test6
eh6:
ok(0, "Cannot find sub in ISO-8859 NameSpace")
+ end_test6:
+ pop_eh
test7:
push_eh eh7
- $P0 = get_global [ "Foo";iso-8859-1:"François" ], "baz"
+ $P0 = get_global [ "Foo";iso-8859-1:"Fran\x{E7}ois" ], "baz"
$S0 = $P0()
- is($S0, iso-8859-1:"Foo::François", "Found sub in nested ISO-8859 NameSpace")
- goto test8
+ is($S0, iso-8859-1:"Foo::Fran\x{E7}ois", "Found sub in nested ISO-8859 NameSpace")
+ goto end_test7
eh7:
ok(0, "Cannot find sub in ISO-8859 NameSpace")
+ end_test7:
+ pop_eh
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"
-# $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")
+ push_eh eh8
+ $P0 = get_global [ unicode:"Fran\x{00E7}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\x{E7}ois", "ISO-8859 NameSpace with Unicode name")
+ goto end_test8
+ eh8:
+ ok(0, "Cannot find ISO-8859 NameSpace using Unicode name")
+ end_test8:
+ pop_eh
+
+ test9:
+ push_eh eh9
+ $P0 = get_global [ unicode:"\x{20AC}uros" ], "baz"
+ $S0 = $P0()
+ is($S0, unicode:"\x{20AC}uros", "Found sub in Unicode NameSpace")
+ goto end_test9
+ eh9:
+ ok(0, "Cannot find sub in Unicode NameSpace")
+ end_test9:
+ pop_eh
+
+ test10:
+ push_eh eh10
+ $P0 = get_global [ "Foo";unicode:"\x{20AC}uros" ], "baz"
+ $S0 = $P0()
+ is($S0, unicode:"Foo::\x{20AC}uros", "Found sub in nested Unicode NameSpace")
+ goto end_test10
+ eh10:
+ ok(0, "Cannot find sub in nested Unicode NameSpace")
+ end_test10:
+ pop_eh
- _end:
.end
.sub 'get_sub_from_namespace_hash'
@@ -179,27 +308,29 @@
is($S0, "Foo::Bar", "Alias namespace")
# Get nested NameSpace with ISO-8859 name
- $P1 = $P0[ iso-8859-1:"François" ]
+ $P1 = $P0[ iso-8859-1:"Fran\x{E7}ois" ]
$P2 = $P1["baz"]
$S0 = $P2()
- is($S0, iso-8859-1:"Foo::François", "Hash-get nested ISO-8859 NameSpace")
+ is($S0, iso-8859-1:"Foo::Fran\x{E7}ois", "Hash-get nested ISO-8859 NameSpace")
- $P1 = $P0[ iso-8859-1:"François";"baz" ]
+ $P1 = $P0[ iso-8859-1:"Fran\x{E7}ois";"baz" ]
$S0 = $P1()
- is($S0, iso-8859-1:"Foo::François", "Hash-get nested ISO-8859 NameSpace Sub")
+ is($S0, iso-8859-1:"Foo::Fran\x{E7}ois", "Hash-get nested ISO-8859 NameSpace Sub")
- $P0 = get_global iso-8859-1:"François"
+ $P0 = get_global iso-8859-1:"Fran\x{E7}ois"
$P1 = $P0[ "baz" ]
$S0 = $P1()
- is($S0, iso-8859-1:"François", "Hash-get ISO-8859 NameSpace")
+ is($S0, iso-8859-1:"Fran\x{E7}ois", "Hash-get ISO-8859 NameSpace")
.end
.sub 'access_sub_in_namespace'
+ # Direct access of sub that does exist in current namespace
$S0 = baz()
$P0 = get_global "baz"
$S1 = $P0()
is($S0, $S1, "Direct and Indirect Sub calls")
+ # Direct access of sub that doesn't exist in current namespace
push_eh eh
'SUB_AINT_THERE'()
ok(0, "Directly called a sub that doesn't exist")
@@ -207,6 +338,7 @@
eh:
ok(1, "Can't direct call a sub that doesn't exist")
_end:
+ pop_eh
.end
.sub 'get_namespace_from_sub'
@@ -243,6 +375,13 @@
$P2 = $P3.'get_name'()
$S0 = join '::', $P2
is($S0, "parrot::Temp1", "Add a NameSpace with a given name")
+
+ # test VTABLE_get_string while we are here
+ $S0 = $P1
+ is($S0, "parrot", "get_string on HLL NameSpace")
+
+ $S0 = $P3
+ is($S0, "Temp1", "get_string on NameSpace")
.end
.sub 'hll_namespaces'
@@ -266,6 +405,69 @@
$P1 = $P0["baz"]
$S0 = $P1()
is($S0, "Foo", "get a Sub from a HLL namespace")
+
+ # find something an a different .HLL
+ push_eh eh1
+ $P0 = get_root_namespace ["myhll"]
+ $P1 = $P0["baz"]
+ $S0 = $P1()
+ is($S0, "MyHLL", "Found Sub in HLL namespace by key")
+ goto end_test1
+ eh1:
+ ok(0, "Cannot find sub in HLL NameSpace by key")
+ end_test1:
+ pop_eh
+
+ # get_root_namespace won't return something not a namespace
+ $P0 = get_root_namespace ["myhll";"baz"]
+ $I0 = isnull $P0
+ is($I0, 1, "get_root_namespace only returns NameSpace PMCs")
+.end
+
+.sub 'anon_function_namespace'
+
+ $S0 = <<"CODE"
+ .namespace ["anon_test_internal_ns"]
+ .sub anon_test_internal :main :anon
+ $P0 = get_namespace
+ .return($P0)
+ .end
+CODE
+ $P0 = compreg "PIR"
+ $P1 = $P0($S0)
+ $P2 = $P1()
+ $S0 = typeof $P2
+ is($S0, "NameSpace", "get_namespace from anon sub")
+ $P3 = $P2.'get_name'()
+ $S0 = join "::", $P3
+ is($S0, "parrot::anon_test_internal_ns", "get_namespace name from anon sub")
+.end
+
+.sub 'find_name_opcode'
+
+ $S0 = <<'CODE'
+ .namespace ['pugs';'main']
+ .sub 'main' :main
+ push_eh just_in_case
+ $P0 = find_name "&say"
+ $P0()
+ $I0 = 1
+ goto the_end
+ just_in_case:
+ $I0 = 0
+ the_end:
+ pop_eh
+ .return($I0)
+ .end
+
+ .sub "&say"
+ noop
+ .end
+CODE
+ $P0 = compreg "PIR"
+ $P1 = $P0($S0)
+ $I0 = $P1()
+ is($I0, 1, "find_name sub with sigil in namespace")
.end
.sub 'namespace_methods'
@@ -337,33 +539,124 @@
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
+
+.sub 'export_to_method'
+ .local string errormsg, description
+
+ errormsg = ":s destination namespace not specified"
+ description = "export_to() Null NameSpace"
+ throws_like(<<"CODE", errormsg, description)
+ .sub 'test' :main
+ .local pmc nsa, nsb, ar
+
+ ar = new ['ResizableStringArray']
+ push ar, 'baz'
+ nsa = new ['Null']
+ nsb = get_namespace ['Foo']
+ nsb.'export_to'(nsa, ar)
+ .end
+CODE
+
+ errormsg = ":s exporting default object set not yet implemented"
+ description = 'export_to() with null exports default object set !!!UNSPECIFIED!!!'
+ throws_like(<<'CODE', errormsg, description)
+ .sub 'test' :main
+ .local pmc nsa, nsb, ar
+
+ ar = new ['Null']
+ nsa = get_namespace
+ nsb = get_namespace ['Foo']
+ nsb.'export_to'(nsa, ar)
+ .end
+CODE
+
+
+ errormsg = ":s exporting default object set not yet implemented"
+ description = 'export_to() with empty array exports default object set !!!UNSPECIFIED!!!'
+ throws_like(<<'CODE', errormsg, description)
+ .sub 'test' :main
+ .local pmc nsa, nsb, ar
+
+ ar = new ['ResizableStringArray']
+ nsa = get_namespace
+ nsb = get_namespace ['Foo']
+ nsb.'export_to'(nsa, ar)
+ .end
+CODE
+
+ errormsg = ":s exporting default object set not yet implemented"
+ description = 'export_to() with empty hash exports default object set !!!UNSPECIFIED!!!'
+ throws_like(<<'CODE', errormsg, description)
+ .sub 'test' :main
+ .local pmc nsa, nsb, ar
+
+ ar = new ['Hash']
+ nsa = get_namespace
+ nsb = get_namespace ['Foo']
+ nsb.'export_to'(nsa, ar)
+ .end
+CODE
+
+# Things to add: successful export_to with non-empty array, successful
+# export_to with non-empty hash. both of these things across HLL boundaries
+
.end
##### TEST NAMESPACES AND FUNCTIONS #####
# These functions and namespaces are used for the tests above
+# The current namespace
.namespace []
-
.sub 'baz'
.return("")
.end
+# NameSpace "Foo"
.namespace ["Foo"]
.sub 'baz'
.return("Foo")
.end
+# NameSpace "Foo";"Bar". Nested namespace
.namespace ["Foo";"Bar"]
.sub 'baz'
.return("Foo::Bar")
.end
-.namespace [ iso-8859-1:"François" ]
+# Namespace specified in ISO-8859-1
+.namespace [ iso-8859-1:"Fran\x{E7}ois" ]
+.sub 'baz'
+ .return(iso-8859-1:"Fran\x{E7}ois")
+.end
+
+# Nested namespace specified in ISO-8859
+.namespace [ "Foo"; iso-8859-1:"Fran\x{E7}ois" ]
+.sub 'baz'
+ .return(iso-8859-1:"Foo::Fran\x{E7}ois")
+.end
+
+# Namesace specified in Unicode
+.namespace [ unicode:"\x{20AC}uros" ]
+.sub 'baz'
+ .return(unicode:"\x{20AC}uros")
+.end
+
+# Nested namespace specified in Unicode
+.namespace [ "Foo";unicode:"\x{20AC}uros" ]
.sub 'baz'
- .return(iso-8859-1:"François")
+ .return(unicode:"Foo::\x{20AC}uros")
.end
-.namespace [ "Foo"; iso-8859-1:"François" ]
+.HLL "MyHLL"
.sub 'baz'
- .return(iso-8859-1:"Foo::François")
+ .return("MyHLL")
.end
Modified: branches/gc-refactor/t/run/options.t
==============================================================================
--- branches/gc-refactor/t/run/options.t Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/t/run/options.t Mon Sep 7 23:56:34 2009 (r41143)
@@ -88,7 +88,7 @@
is( qx{$cmd}, "second\n", "-r option <$cmd>" );
$cmd = qq{"$PARROT" -D 8 -R slow "$second_pir_file" 2>&1};
- like( qx{$cmd}, qr/Parrot VM: Slow core/, "-r option <$cmd>" );
+ like( qx{$cmd}, qr/Parrot VM: slow core/, "-r option <$cmd>" );
}
## RT#46815 test remaining options
Modified: branches/gc-refactor/tools/dev/install_dev_files.pl
==============================================================================
--- branches/gc-refactor/tools/dev/install_dev_files.pl Mon Sep 7 23:07:42 2009 (r41142)
+++ branches/gc-refactor/tools/dev/install_dev_files.pl Mon Sep 7 23:56:34 2009 (r41143)
@@ -80,7 +80,7 @@
srcdir => '/usr/src/', # parrot/ subdir added below
versiondir => '',
'dry-run' => 0,
- packages => 'devel|pct|tge|nqp',
+ packages => 'devel|pct|tge|nqp|data_json',
);
my @manifests;
Copied: branches/gc-refactor/tools/dev/pprof2cg.pl (from r41142, trunk/tools/dev/pprof2cg.pl)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/gc-refactor/tools/dev/pprof2cg.pl Mon Sep 7 23:56:34 2009 (r41143, copy of r41142, trunk/tools/dev/pprof2cg.pl)
@@ -0,0 +1,421 @@
+#! perl
+
+# Copyright (C) 2009, Parrot Foundation.
+# $Id$
+
+use strict;
+use warnings;
+
+use Data::Dumper;
+
+=head1 Name
+
+tools/dev/pprof2cg.pl
+
+=head1 Description
+
+Convert the output of Parrot's profiling runcore to a Callgrind-compatible
+format.
+
+=head1 Synopsis
+
+perl tools/dev/pprof2cg.pl parrot.pprof.1234
+
+=head1 Usage
+
+Generate a profile by passing C<-Rprofiling> to parrot, for example C<./parrot
+-Rprofiling perl6.pbc hello.p6>. Once execution completes, C<parrot> will
+print a message specifying the location of the parrot profile (pprof). The
+profile will be named parrot.pprof.XXXX, where XXXX is the PID of the parrot
+process unless another name is specified by the B<PARROT_PROFILING_OUTPUT>
+environment variable.
+
+To generate a Callgrind-compatible profile, run this script with the pprof
+filename as the first argument. The output file usable by kcachegrind will be
+in parrot.out.XXXX, where XXXX again is the PID of the original parrot process.
+
+=head1 Environment Variables
+
+=head2 PARROT_PROFILING_OUTPUT
+
+If the environment variable PARROT_PROFILING_OUTPUT is set, the profiling
+runcore will attempt to use its value as the profile filename. Note that it
+does not check whether the file already exists and will happily overwrite
+existing files.
+
+=cut
+
+main(\@ARGV);
+
+=head1 Internal Data Structures
+
+=over 4
+
+=item notes
+
+Parrot's execution model is built on continuation-passing style and does not
+precisely fit the straightforward function-based format that
+Callgrind-compatible tools expect. For this reason, the profiling runcore
+captures information about context switches (CS lines in the pprof file) and
+pprof2cg.pl maintains a context stack that functions similarly to a typical
+call stack. pprof2cg.pl then maps these context switches as if they were
+function calls and returns. See C<$ctx_stack> for more information.
+
+=item C<$ctx_stack>
+
+Variables which are named C<$ctx_stack> hold a reference to an array of hashes
+which contain information about the currently active contexts. When collecting
+timing information about an op, it is necessary to add that information to all
+function calls on the stack because Callgrind-compatible tools expect the cost
+of a function call to include the cost of all calls made by that function, etc.
+
+When a context switch is detected, C<process_line> looks at the context stack
+to determine if the context switch looks like a function call (if the context
+hasn't been seen before) or a return (if the context is somewhere on the
+stack). There are some other cases that the code handles, but these can be
+ignored for now in the interest of simplicity. If the context has been seen,
+C<process_line> shifts contexts off the stack until it finds the context that
+has been switched to. When C<process_line> detects a new context, it adds a
+fake op representing a function call to C<$stats> and unshifts a new context
+onto the stack.
+
+Each element of C<@$ctx_stack> contains the information needed to uniquely
+identify the site of the original context switch.
+
+=item C<$stats>
+
+Variables which are named C<$stats> contain a reference to a deeply nested
+HoHoH.. which contains all information gathered about a profiled PIR program.
+The nested hashes and arrays refer to the file, namespace, line of source code
+and op number, respectively. The op number is used to allow multiple
+instructions per line because PIR instructions often represent multiple
+low-level instructions. This also makes it easy to inject pseudo-ops to
+represent function calls.
+
+Each op always has a time value representing the total amount of time spent in
+that op. Ops may also have an op_name value that gives the name of the op.
+When control flow similar to a function call is detected, a pseudo-op
+representing a function call is injected. These pseudo-ops have zero cost when
+initialized and are used to determine the total time spent between when the
+context becomes active and when control flow returns to or past the context.
+Although they're not exactly like functions calls, they're close enough that it
+may help to think of them as such.
+
+Uncomment the print_stats line in main to see a representation of the data
+contained in C<$stats>.
+
+=back
+
+=head1 Functions
+
+=over 4
+
+=item C<main>
+
+This function is minimal driver for the other functions in this file, taking
+the name of a Parrot profile and writing a Callgrind-compatible profile to a
+similarly-named file.
+
+=cut
+
+sub main {
+ my $argv = shift;
+ my $stats = {};
+ my $ctx_stack = [];
+ my $filename = $argv->[0];
+
+ open(my $in_fh, '<', $filename) or die "couldn't open $filename for reading: $!";
+
+ while (my $line = <$in_fh>) {
+ process_line($line, $stats, $ctx_stack);
+ }
+ close($in_fh) or die "couldn't close $filename: $!";
+
+ #print_stats($stats);
+
+ unless ($filename =~ s/pprof/out/) {
+ $filename = "$filename.out";
+ }
+
+ open(my $out_fh, '>', $filename) or die "couldn't open $filename for writing: $!";
+ my $cg_profile = get_cg_profile($stats);
+ print $out_fh $cg_profile;
+ close($out_fh) or die "couldn't close $filename: $!";
+ print "$filename can now be used with kcachegrind or other callgrind-compatible tools.\n";
+}
+
+=item C<process_line>
+
+This function takes a string containing a single line from a Parrot profile, a
+reference to a hash of fine-grained statistics about the current PIR program
+and a reference to the current context stack. It modifies the statistics and
+context stack according to the information from the Parrot profile.
+
+=cut
+
+sub process_line {
+
+ my $line = shift;
+ my $stats = shift;
+ my $ctx_stack = shift;
+
+ for ($line) {
+ if (/^#/) {
+ #comments are always ignored
+ }
+ elsif (/^VERSION:(\d+)$/) {
+ my $version = $1;
+ if ($version != 1) {
+ die "profile was generated by an incompatible version of the profiling runcore.";
+ }
+ }
+ elsif (/^CLI:(.*)$/) {
+ $stats->{'global_stats'}{'cli'} = $1;
+ }
+ #context switch
+ elsif (/^CS:(.*)$/) {
+
+ my $cs_hash = split_vars($1);
+ my $is_first = scalar(@$ctx_stack) == 0;
+ my $is_redundant = !$is_first && ($ctx_stack->[0]{'ctx'} eq $cs_hash->{'ctx'});
+ my $reused_ctx = $is_redundant && ($ctx_stack->[0]{'sub'} ne $cs_hash->{'sub'});
+ my $is_call = scalar(grep {$_->{'ctx'} eq $cs_hash->{'ctx'}} @$ctx_stack) == 0;
+
+ if ($is_first) {
+ $ctx_stack->[0] = $cs_hash;
+ }
+ elsif ($reused_ctx) {
+ $ctx_stack->[0]{'sub'} = $cs_hash->{'sub'};
+ $ctx_stack->[0]{'ns'} = $cs_hash->{'ns'};
+ }
+ elsif ($is_redundant) {
+ #don't do anything
+ }
+ elsif ($is_call) {
+ $ctx_stack->[0]{'op_num'}++;
+ my $extra = {
+ op_name => "CALL",
+ target => $cs_hash->{'ns'}
+ };
+ store_stats($stats, $ctx_stack->[0], 0, $extra );
+ unshift @$ctx_stack, $cs_hash;
+ }
+ else {
+ #shift contexts off the stack until one matches the current ctx
+ while ($ctx_stack->[0]->{'ctx'} ne $cs_hash->{'ctx'}) {
+ my $ctx = shift @$ctx_stack;
+ }
+ }
+ #print Dumper($ctx_stack);
+ }
+ elsif (/^END_OF_RUNLOOP$/) {
+ #end of loop
+ @$ctx_stack = ();
+ }
+ elsif (/^OP:(.*)$/) {
+ my $op_hash = split_vars($1);
+
+ die "input file did not specify an initial context" if (@$ctx_stack == 0);
+
+ if (exists $ctx_stack->[0]{'line'} && $op_hash->{'line'} == $ctx_stack->[0]{'line'}) {
+ $ctx_stack->[0]{'op_num'}++;
+ }
+ else {
+ $ctx_stack->[0]{'op_num'} = 0;
+ }
+
+ $ctx_stack->[0]{'line'} = $op_hash->{'line'};
+ my $extra = { op_name => $op_hash->{'op'} };
+ store_stats($stats, $ctx_stack->[0], $op_hash->{'time'}, $extra);
+
+ $extra->{'no_hits'} = 1;
+ for my $frame (@$ctx_stack[1 .. scalar(@$ctx_stack)-1 ]) {
+ store_stats($stats, $frame, $op_hash->{'time'}, $extra);
+ }
+ }
+ else {
+ die "Unrecognized line format: \"$line\"";
+ }
+ }
+}
+
+=item C<print_stats>
+
+This function prints a complete, human-readable representation of the
+statistical data that have been collected into the C<$stats> argument to
+stdout. It is primarily intended to ease debugging and is not necessary to
+create a Callgrind-compatible profile.
+
+=cut
+
+sub print_stats {
+ my $stats = shift;
+
+ for my $file (grep {$_ ne 'global_stats'} sort keys %$stats) {
+ for my $ns (sort keys %{ $stats->{$file} }) {
+ for my $line_num (sort {$a<=>$b} keys %{ $stats->{$file}{$ns} }) {
+ for my $op_num (0 .. $#{$stats->{$file}{$ns}{$line_num}}) {
+
+ print "$file $ns line/op:$line_num/$op_num ";
+
+ for my $attr (sort keys %{ $stats->{$file}{$ns}{$line_num}[$op_num] }) {
+ print "{ $attr => $stats->{$file}{$ns}{$line_num}[$op_num]{$attr} } ";
+ }
+ print "\n";
+ }
+ }
+ print "\n";
+ }
+ }
+}
+
+=item C<split_vars>
+
+This function takes a string specifying 1 or more key/value mappings and
+returns a reference to a hash containing those keys and values. The string
+must be in the format C<{x{key1:value1}x}{x{key2:value2}x}>.
+
+=cut
+
+sub split_vars {
+ my $href;
+ my $str = shift;
+ die "invalidly formed line '$str'"
+ unless $str =~ /({x{ [^:]+ : (.*?) }x})+/x;
+ while ($str =~ /\G {x{ ([^:]+) : (.*?) }x} /cxg) {
+ $href->{$1} = $2;
+ }
+ return $href;
+}
+
+=item C<store_stats>
+
+This function adds statistical data to the C<$stats> hash reference. The
+C<$locator> argument specifies information such as the namespace, file, line
+and op number where the data should go. C<$time> is an integer representing
+the amount of time spent at the specified location. C<$extra> contains any
+ancillary data that should be stored in the hash. This includes data on
+(faked) subroutine calls and op names.
+
+=cut
+
+sub store_stats {
+ my $stats = shift;
+ my $locator = shift;
+ my $time = shift;
+ my $extra = shift;
+
+ my $file = $locator->{'file'};
+ my $ns = $locator->{'ns'};
+ my $line = $locator->{'line'};
+ my $op_num = $locator->{'op_num'};
+
+ if (exists $stats->{'global_stats'}{'total_time'}) {
+ $stats->{'global_stats'}{'total_time'} += $time;
+ }
+ else {
+ $stats->{'global_stats'}{'total_time'} = $time;
+ }
+
+ if (exists $stats->{$file}{$ns}{$line}[$op_num]) {
+ $stats->{$file}{$ns}{$line}[$op_num]{'hits'}++
+ unless exists $extra->{no_hits};
+ $stats->{$file}{$ns}{$line}[$op_num]{'time'} += $time;
+ }
+ else {
+ $stats->{$file}{$ns}{$line}[$op_num]{'hits'} = 1;
+ $stats->{$file}{$ns}{$line}[$op_num]{'time'} = $time;
+ for my $key (keys %{$extra}) {
+ $stats->{$file}{$ns}{$line}[$op_num]{$key} = $extra->{$key};
+ }
+ }
+}
+
+=item C<get_cg_profile>
+
+This function takes a reference to a hash of statistical information about a
+PIR program and returns a string containing a Callgrind-compatible profile.
+Although some information in the profile may not be accurate (namely PID and
+creator), tools such as kcachegrind are able to consume files generated by this
+function.
+
+=cut
+
+sub get_cg_profile {
+
+ my $stats = shift;
+ my @output = ();
+
+ push @output, <<"HEADER";
+version: 1
+creator: 3.4.1-Debian
+pid: 5751
+cmd: $stats->{'global_stats'}{'cli'}
+
+part: 1
+desc: I1 cache:
+desc: D1 cache:
+desc: L2 cache:
+desc: Timerange: Basic block 0 - $stats->{'global_stats'}{'total_time'}
+desc: Trigger: Program termination
+positions: line
+events: Ir
+summary: $stats->{'global_stats'}{'total_time'}
+
+HEADER
+
+ for my $file (grep {$_ ne 'global_stats'} keys %$stats) {
+
+ push @output, "fl=$file";
+
+ for my $ns (keys %{ $stats->{$file} }) {
+ push @output, "\nfn=$ns";
+
+ for my $line (sort keys %{ $stats->{$file}{$ns} }) {
+
+ my $curr_op = 0;
+ my $line_stats = $stats->{$file}{$ns}{$line};
+ my $op_count = scalar(@$line_stats);
+ my $op_time = 0;
+
+ while ($curr_op < $op_count && $line_stats->[$curr_op]{'op_name'} ne 'CALL') {
+ $op_time += $line_stats->[$curr_op]{'time'};
+ $curr_op++;
+ }
+ push @output, "$line $op_time";
+
+ if ($curr_op < $op_count && $line_stats->[$curr_op]{'op_name'} eq 'CALL') {
+ my $call_target = $line_stats->[$curr_op]{'target'};
+ my $call_count = $line_stats->[$curr_op]{'hits'};
+ my $call_cost = $line_stats->[$curr_op]{'time'};
+
+ push @output, "cfn=$call_target";
+ push @output, "calls=$call_count $call_cost";
+ }
+
+ if ($curr_op < $op_count) {
+ $op_time = 0;
+ while ($curr_op < $op_count) {
+ $op_time += $line_stats->[$curr_op]{'time'};
+ $curr_op++;
+ }
+ push @output, "$line $op_time";
+ }
+ }
+ }
+ }
+
+ push @output, "totals: $stats->{'global_stats'}{'total_time'}";
+ return join("\n", @output);
+}
+
+=back
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
More information about the parrot-commits
mailing list