[svn:parrot] r38653 - in branches/gc_api: . compilers/imcc config/auto config/auto/gmp config/auto/sizes config/gen/makefiles docs docs/book docs/book/draft docs/dev docs/pdds examples/languages/abc examples/languages/squaak include/parrot lib/Parrot/Pmc2c lib/Parrot/Pmc2c/PMC ports/cpan ports/cygwin ports/debian ports/fedora ports/mandriva ports/suse runtime/parrot/library/Math src src/call src/gc src/interp src/io src/ops src/pmc src/runcore src/string t/compilers/imcc/syn t/compilers/tge t/dynpmc t/pmc t/src tools/dev tools/util
whiteknight at svn.parrot.org
whiteknight at svn.parrot.org
Sat May 9 19:32:40 UTC 2009
Author: whiteknight
Date: Sat May 9 19:32:38 2009
New Revision: 38653
URL: https://trac.parrot.org/parrot/changeset/38653
Log:
[gc_api] merge to trunk HEAD (38652). found the error
Modified:
branches/gc_api/ (props changed)
branches/gc_api/CREDITS
branches/gc_api/MANIFEST
branches/gc_api/compilers/imcc/pbc.c
branches/gc_api/config/auto/arch.pm
branches/gc_api/config/auto/gmp/gmp_c.in
branches/gc_api/config/auto/sizes/intval_maxmin_c.in (props changed)
branches/gc_api/config/gen/makefiles/root.in
branches/gc_api/docs/book/appb_patch_submission.pod (props changed)
branches/gc_api/docs/book/ch01_introduction.pod (props changed)
branches/gc_api/docs/book/ch03_pir.pod (props changed)
branches/gc_api/docs/book/ch04_compiler_tools.pod (props changed)
branches/gc_api/docs/book/ch07_dynpmcs.pod (props changed)
branches/gc_api/docs/book/ch08_dynops.pod (props changed)
branches/gc_api/docs/book/ch09_pasm.pod (props changed)
branches/gc_api/docs/book/ch10_opcode_reference.pod (props changed)
branches/gc_api/docs/book/draft/chXX_hlls.pod (props changed)
branches/gc_api/docs/book/draft/chXX_library.pod (props changed)
branches/gc_api/docs/book/draft/chXX_testing_and_debugging.pod (props changed)
branches/gc_api/docs/dev/c_functions.pod (props changed)
branches/gc_api/docs/embed.pod
branches/gc_api/docs/pdds/pdd30_install.pod (props changed)
branches/gc_api/examples/languages/abc/ (props changed)
branches/gc_api/examples/languages/squaak/ (props changed)
branches/gc_api/include/parrot/call.h (props changed)
branches/gc_api/include/parrot/exceptions.h
branches/gc_api/include/parrot/gc_api.h (props changed)
branches/gc_api/include/parrot/hash.h
branches/gc_api/include/parrot/io.h
branches/gc_api/include/parrot/misc.h
branches/gc_api/include/parrot/runcore_api.h (props changed)
branches/gc_api/include/parrot/runcore_trace.h (props changed)
branches/gc_api/include/parrot/stacks.h
branches/gc_api/lib/Parrot/Pmc2c/PMC/RO.pm
branches/gc_api/lib/Parrot/Pmc2c/PMC/default.pm
branches/gc_api/lib/Parrot/Pmc2c/PMCEmitter.pm
branches/gc_api/ports/cpan/pause_guide.pod (props changed)
branches/gc_api/ports/cygwin/parrot-1.0.0-1.cygport (props changed)
branches/gc_api/ports/debian/libparrot-dev.install.in (props changed)
branches/gc_api/ports/debian/libparrot.install.in (props changed)
branches/gc_api/ports/debian/parrot-doc.install.in (props changed)
branches/gc_api/ports/debian/parrot.install.in (props changed)
branches/gc_api/ports/fedora/parrot.spec.fedora (props changed)
branches/gc_api/ports/mandriva/parrot.spec.mandriva (props changed)
branches/gc_api/ports/suse/parrot.spec.suse (props changed)
branches/gc_api/runtime/parrot/library/Math/Rand.pir (props changed)
branches/gc_api/src/call/ops.c (props changed)
branches/gc_api/src/call/pcc.c (contents, props changed)
branches/gc_api/src/gc/api.c (props changed)
branches/gc_api/src/gc/gc_private.h
branches/gc_api/src/gc/generational_ms.c (props changed)
branches/gc_api/src/gc/incremental_ms.c (props changed)
branches/gc_api/src/gc/mark_sweep.c (props changed)
branches/gc_api/src/gc/pools.c (props changed)
branches/gc_api/src/gc/system.c (contents, props changed)
branches/gc_api/src/global.c
branches/gc_api/src/hash.c
branches/gc_api/src/interp/inter_cb.c (props changed)
branches/gc_api/src/interp/inter_create.c (props changed)
branches/gc_api/src/interp/inter_misc.c (props changed)
branches/gc_api/src/io/api.c
branches/gc_api/src/jit.c
branches/gc_api/src/key.c
branches/gc_api/src/ops/io.ops
branches/gc_api/src/pmc/class.pmc
branches/gc_api/src/pmc/default.pmc
branches/gc_api/src/pmc/key.pmc
branches/gc_api/src/pmc/namespace.pmc
branches/gc_api/src/pmc/orderedhash.pmc
branches/gc_api/src/pmc/retcontinuation.pmc
branches/gc_api/src/runcore/cores.c (props changed)
branches/gc_api/src/runcore/main.c (props changed)
branches/gc_api/src/runcore/trace.c (props changed)
branches/gc_api/src/scheduler.c
branches/gc_api/src/string/api.c
branches/gc_api/src/sub.c
branches/gc_api/t/compilers/imcc/syn/regressions.t
branches/gc_api/t/compilers/tge/NoneGrammar.tg (props changed)
branches/gc_api/t/dynpmc/pair.t (props changed)
branches/gc_api/t/pmc/class.t
branches/gc_api/t/src/embed.t (props changed)
branches/gc_api/tools/dev/fetch_languages.pl (props changed)
branches/gc_api/tools/dev/mk_gitignore.pl (props changed)
branches/gc_api/tools/util/perlcritic-cage.conf (props changed)
Modified: branches/gc_api/CREDITS
==============================================================================
--- branches/gc_api/CREDITS Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/CREDITS Sat May 9 19:32:38 2009 (r38653)
@@ -400,6 +400,10 @@
N: H.Merijn Brand
D: HP-UX fixes and smoke tests
+N: Igor Rafael Sanchez-Puls
+D: extending test_file_coverage to test PMC coverage
+E: quevlar at ymail.com
+
N: Ibotty
D: parrotbench ruby benchmarks
Modified: branches/gc_api/MANIFEST
==============================================================================
--- branches/gc_api/MANIFEST Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/MANIFEST Sat May 9 19:32:38 2009 (r38653)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Tue May 5 05:00:39 2009 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Fri May 8 15:20:54 2009 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -2060,6 +2060,7 @@
tools/dev/.gdbinit []
tools/dev/as2c.pl []
tools/dev/bench_op.pir []
+tools/dev/branch_status.pl []
tools/dev/cc_flags.pl []
tools/dev/create_language.pl []
tools/dev/debian_docs.sh []
Modified: branches/gc_api/compilers/imcc/pbc.c
==============================================================================
--- branches/gc_api/compilers/imcc/pbc.c Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/compilers/imcc/pbc.c Sat May 9 19:32:38 2009 (r38653)
@@ -1084,8 +1084,10 @@
const int k = add_const_table(interp);
STRING * const s = Parrot_str_new(interp, buf, 0);
- interp->code->const_table->constants[k]->type = PFC_NUMBER;
- interp->code->const_table->constants[k]->u.number = Parrot_str_to_num(interp, s);
+ PackFile_Constant * const constant = interp->code->const_table->constants[k];
+
+ constant->type = PFC_NUMBER;
+ constant->u.number = Parrot_str_to_num(interp, s);
return k;
}
Modified: branches/gc_api/config/auto/arch.pm
==============================================================================
--- branches/gc_api/config/auto/arch.pm Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/config/auto/arch.pm Sat May 9 19:32:38 2009 (r38653)
@@ -39,10 +39,10 @@
$verbose and print "\n";
my $archname = $conf->data->get('archname');
+ # This was added to convert IA64.ARCHREV_0 on HP-UX, TT #645, TT #653
+ $archname =~ s|\.|_|g;
my ( $cpuarch, $osname ) = split( /-/, $archname );
- # This was added to convert IA64.ARCHREV_0 on HP-UX, TT #645
- $archname =~ s|\.|_|g;
if ($verbose) {
print "determining operating system and cpu architecture\n";
Modified: branches/gc_api/config/auto/gmp/gmp_c.in
==============================================================================
--- branches/gc_api/config/auto/gmp/gmp_c.in Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/config/auto/gmp/gmp_c.in Sat May 9 19:32:38 2009 (r38653)
@@ -6,6 +6,9 @@
#include <stdio.h>
#include <stdlib.h>
#include <gmp.h>
+#ifdef WIN32
+# include <windows.h>
+#endif
int
main(int argc, char *argv[])
Modified: branches/gc_api/config/gen/makefiles/root.in
==============================================================================
--- branches/gc_api/config/gen/makefiles/root.in Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/config/gen/makefiles/root.in Sat May 9 19:32:38 2009 (r38653)
@@ -1948,14 +1948,13 @@
\
-show-summary \
+show-scan \
- +time-dist
-
-# Watch for naming conflicts, but don't complain about str*() functions
-SPLINTFLAGS := $(SPLINTFLAGS) \
+ +time-dist \
+ \
+ansi-reserved \
+ansi-reserved-internal \
-iso-reserved \
- -iso-reserved-internal
+ -iso-reserved-internal \
+ -include-nest 10
# Memory safety checks
SPLINTFLAGS := $(SPLINTFLAGS) \
@@ -1985,90 +1984,64 @@
-pred-bool-others \
-boolops \
+# Report qualifier mismatches only if dangerous
+SPLINTFLAGS := $(SPLINTFLAGS) \
+ +relax-quals
+
# Pointer arithmetic is OK, but watch for null pointers
SPLINTFLAGS := $(SPLINTFLAGS) \
-ptr-arith \
+nullptrarith \
- +ptr-negate
+ +ptr-negate \
+ -zero-ptr
-# Check on consistency of defs
+# Symbol definitions
SPLINTFLAGS := $(SPLINTFLAGS) \
+ +decl-undef \
+incon-defs \
+incon-defs-lib \
-# The rest of the flags to be organized.
+# Check for conflicts with C++ compilers
SPLINTFLAGS := $(SPLINTFLAGS) \
- +char-index \
+cpp-names \
- +decl-undef \
+
+# Format codes
+SPLINTFLAGS := $(SPLINTFLAGS) \
+ +format-code \
+ +format-type \
+
+# Problems with evaluation and control structions
+SPLINTFLAGS := $(SPLINTFLAGS) \
+ +controlnestdepth 15 \
+duplicate-case \
- +enum-members \
+eval-order \
+eval-order-uncon \
- +format-code \
- +format-type \
+
+# Types and stuff
+SPLINTFLAGS := $(SPLINTFLAGS) \
+ +enum-members \
+ignore-signs \
- +match-fields \
- +null \
- +nullret \
- +strict-destroy \
- \
- +use-released \
- +strict-use-released \
- -abstract \
+
+# TODO: Miscellaneous other flags
+SPLINTFLAGS := $(SPLINTFLAGS) \
+aliasunique \
+assignexpose \
- -casebreak \
- -castfcnptr \
- -charint \
+continuecomment \
- +controlnestdepth 15 \
- -exportlocal \
- -fcnuse \
+fielduse \
- -globs \
- +imptype \
- -initallelements \
+longintegral \
+matchanyintegral \
+ +match-fields \
+nestedextern \
- -noeffect \
- -paramuse \
- +ptrnegate \
+ +null \
+ +nullret \
+ +paramuse \
+readonlystrings \
- -redef \
- -retvalint \
- -retvalother \
+shadow \
- -shiftimplementation \
- -shiftnegative \
- -showsourceloc \
- -type \
- \
- -branchstate \
- -compdef \
- -compdestroy \
- -compmempass \
- -globstate \
- -mustfreefresh \
- -mustfreeonly \
- -nullstate \
- -redecl \
- -retalias \
- \
- -immediatetrans \
- -kepttrans \
- -observertrans \
- -onlytrans \
- -readonlytrans \
- -statictrans \
- -temptrans \
- -unqualifiedtrans \
-
+ +strict-destroy \
+ +strict-use-released \
+ +use-released \
# Other options we'd like to add back
-# +paramuse: As soon as we get SHIM()s in the ops
-# -includedepth 8 : Let's investigate why we do so many includes.
# +initallelements : Right now, the *.ops files don't initialize all
# values of the arrays
# +casebreak: Auto-generated ops have way too case fallthrus right now
@@ -2080,9 +2053,6 @@
# added to splint target to simplify experimentation,
# ex: make SPLINTFLAGS_TEST='-posixstrictlib +posixlib' splint
-# Don't complain about using pointers and ints as booleans
-SPLINTFLAGS_TEST := $(SPLINTFLAGS_TEST) -pred-bool
-
splint : $(PARROT)
$(MKPATH) $(SPLINT_TMP)
$(SPLINT) $(CC_INC) @cc_hasjit@ "-Isrc/pmc" "-Icompilers/ast" $(SPLINTFLAGS) $(SPLINTFLAGS_TEST) `echo $(O_FILES) | $(PERL) -pe @PQ at s/\.o/\.c/g at PQ@`
@@ -2092,7 +2062,7 @@
$(MKPATH) $(SPLINT_TMP)
splint $(CC_INC) @cc_hasjit@ -DNDEBUG "-Isrc/pmc" "-Icompilers/ast" $(SPLINTFLAGS) $(SPLINTFLAGS_TEST) \
+partial -memchecks \
- src/s*.c \
+ src/p*.c \
| grep -v 'Source code error generation point'
COVER_FLAGS := -fprofile-arcs -ftest-coverage
Modified: branches/gc_api/docs/embed.pod
==============================================================================
--- branches/gc_api/docs/embed.pod Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/docs/embed.pod Sat May 9 19:32:38 2009 (r38653)
@@ -386,7 +386,7 @@
Returns the class corresponding to the supplied namespace.
-=item C<Parrot_PMC Parrot_Class_instantiate(PARROT_INTERP, Parrot_PMC the_class Parrot_PMC arg)>
+=item C<Parrot_PMC VTABLE_instantiate(PARROT_INTERP, Parrot_PMC the_class Parrot_PMC arg)>
Instantiates a new object of class C<the_class>, which can be obtained from
C<Parrot_oo_get_class()>. Passes an optional PMC argument C<arg> to the
Modified: branches/gc_api/include/parrot/exceptions.h
==============================================================================
--- branches/gc_api/include/parrot/exceptions.h Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/include/parrot/exceptions.h Sat May 9 19:32:38 2009 (r38653)
@@ -283,11 +283,11 @@
# define PARROT_ASSERT(x) (x) ? ((void)0) : Parrot_confess(#x, __FILE__, __LINE__)
# define PARROT_ASSERT_ARG(x) ((x) ? (0) : (Parrot_confess(#x, __FILE__, __LINE__), 0))
-# ifdef _MSC_VER
-# define ASSERT_ARGS(a)
-# else
+# ifdef __GNUC__
# define ASSERT_ARGS(a) ASSERT_ARGS_ ## a ;
-# endif /* _MSC_VER */
+# else
+# define ASSERT_ARGS(a)
+# endif /* __GNUC__ */
#endif /* NDEBUG */
Modified: branches/gc_api/include/parrot/hash.h
==============================================================================
--- branches/gc_api/include/parrot/hash.h Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/include/parrot/hash.h Sat May 9 19:32:38 2009 (r38653)
@@ -81,8 +81,7 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
-void parrot_dump_hash(SHIM_INTERP, ARGIN(const Hash *hash))
- __attribute__nonnull__(2);
+void parrot_dump_hash(SHIM_INTERP, SHIM(const Hash *hash));
PARROT_EXPORT
void parrot_hash_clone(PARROT_INTERP,
@@ -160,8 +159,7 @@
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_PURE_FUNCTION
-INTVAL parrot_hash_size(PARROT_INTERP, ARGIN(const Hash *hash))
- __attribute__nonnull__(1)
+INTVAL parrot_hash_size(SHIM_INTERP, ARGIN(const Hash *hash))
__attribute__nonnull__(2);
PARROT_EXPORT
@@ -242,8 +240,7 @@
__attribute__nonnull__(4)
__attribute__nonnull__(5);
-#define ASSERT_ARGS_parrot_dump_hash __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(hash)
+#define ASSERT_ARGS_parrot_dump_hash __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
#define ASSERT_ARGS_parrot_hash_clone __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(hash) \
@@ -275,8 +272,7 @@
|| PARROT_ASSERT_ARG(hash) \
|| PARROT_ASSERT_ARG(key)
#define ASSERT_ARGS_parrot_hash_size __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(hash)
+ PARROT_ASSERT_ARG(hash)
#define ASSERT_ARGS_parrot_hash_visit __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(hash) \
Modified: branches/gc_api/include/parrot/io.h
==============================================================================
--- branches/gc_api/include/parrot/io.h Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/include/parrot/io.h Sat May 9 19:32:38 2009 (r38653)
@@ -184,7 +184,9 @@
FUNC_MODIFIES(*pmc);
PARROT_EXPORT
-INTVAL Parrot_io_fprintf(PARROT_INTERP,
+PARROT_IGNORABLE_RESULT
+INTVAL /*@alt void@*/
+Parrot_io_fprintf(PARROT_INTERP,
ARGMOD(PMC *pmc),
ARGIN(const char *s),
...)
@@ -201,6 +203,7 @@
FUNC_MODIFIES(*pmc);
PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
INTVAL Parrot_io_is_closed(PARROT_INTERP, ARGMOD(PMC *pmc))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
@@ -214,6 +217,7 @@
FUNC_MODIFIES(*pmc);
PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
PIOOFF_T Parrot_io_make_offset(INTVAL offset);
PARROT_EXPORT
@@ -233,6 +237,7 @@
__attribute__nonnull__(3);
PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
INTVAL Parrot_io_peek(PARROT_INTERP,
ARGMOD(PMC *pmc),
ARGOUT(STRING **buffer))
@@ -243,7 +248,11 @@
FUNC_MODIFIES(*buffer);
PARROT_EXPORT
-INTVAL Parrot_io_printf(PARROT_INTERP, ARGIN(const char *s), ...)
+PARROT_IGNORABLE_RESULT
+INTVAL /*@alt void@*/
+Parrot_io_printf(PARROT_INTERP,
+ ARGIN(const char *s),
+ ...)
__attribute__nonnull__(1)
__attribute__nonnull__(2);
@@ -296,6 +305,7 @@
__attribute__nonnull__(1);
PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PMC * Parrot_io_stdhandle(PARROT_INTERP,
INTVAL fileno,
@@ -332,7 +342,10 @@
__attribute__nonnull__(3)
FUNC_MODIFIES(*pmc);
+PARROT_WARN_UNUSED_RESULT
PIOOFF_T Parrot_io_make_offset32(INTVAL hi, INTVAL lo);
+
+PARROT_WARN_UNUSED_RESULT
PIOOFF_T Parrot_io_make_offset_pmc(PARROT_INTERP, ARGMOD(PMC *pmc))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
Modified: branches/gc_api/include/parrot/misc.h
==============================================================================
--- branches/gc_api/include/parrot/misc.h Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/include/parrot/misc.h Sat May 9 19:32:38 2009 (r38653)
@@ -268,12 +268,12 @@
typedef struct sprintf_obj SPRINTF_OBJ;
- typedef STRING *(*sprintf_getchar_t) (PARROT_INTERP, INTVAL, SPRINTF_OBJ *);
- typedef HUGEINTVAL(*sprintf_getint_t) (PARROT_INTERP, INTVAL, SPRINTF_OBJ *);
- typedef UHUGEINTVAL(*sprintf_getuint_t) (PARROT_INTERP, INTVAL, SPRINTF_OBJ *);
- typedef HUGEFLOATVAL(*sprintf_getfloat_t) (PARROT_INTERP, INTVAL, SPRINTF_OBJ *);
- typedef STRING *(*sprintf_getstring_t) (PARROT_INTERP, INTVAL, SPRINTF_OBJ *);
- typedef void *(*sprintf_getptr_t) (PARROT_INTERP, INTVAL, SPRINTF_OBJ *);
+ typedef STRING *(*sprintf_getchar_t) (PARROT_INTERP, INTVAL, ARGIN(SPRINTF_OBJ *));
+ typedef HUGEINTVAL(*sprintf_getint_t) (PARROT_INTERP, INTVAL, ARGIN(SPRINTF_OBJ *));
+ typedef UHUGEINTVAL(*sprintf_getuint_t) (PARROT_INTERP, INTVAL, ARGIN(SPRINTF_OBJ *));
+ typedef HUGEFLOATVAL(*sprintf_getfloat_t) (PARROT_INTERP, INTVAL, ARGIN(SPRINTF_OBJ *));
+ typedef STRING *(*sprintf_getstring_t) (PARROT_INTERP, INTVAL, ARGIN(SPRINTF_OBJ *));
+ typedef void *(*sprintf_getptr_t) (PARROT_INTERP, INTVAL, ARGIN(SPRINTF_OBJ *));
struct sprintf_obj {
void *data;
Modified: branches/gc_api/include/parrot/stacks.h
==============================================================================
--- branches/gc_api/include/parrot/stacks.h Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/include/parrot/stacks.h Sat May 9 19:32:38 2009 (r38653)
@@ -21,7 +21,7 @@
typedef struct Stack_Entry {
UnionVal entry;
Stack_entry_type entry_type;
- void (*cleanup)(PARROT_INTERP, struct Stack_Entry *);
+ void (*cleanup)(PARROT_INTERP, ARGIN(struct Stack_Entry *));
} Stack_Entry_t;
typedef struct Stack_Chunk {
Modified: branches/gc_api/lib/Parrot/Pmc2c/PMC/RO.pm
==============================================================================
--- branches/gc_api/lib/Parrot/Pmc2c/PMC/RO.pm Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/lib/Parrot/Pmc2c/PMC/RO.pm Sat May 9 19:32:38 2009 (r38653)
@@ -64,77 +64,44 @@
}
foreach my $vt_method ( @{ $self->vtable->methods } ) {
- my $vt_method_name = $vt_method->name;
- if ( $vt_method_name eq 'find_method' ) {
- my $ro_method = Parrot::Pmc2c::Method->new(
- {
- name => $vt_method_name,
- parent_name => $parent->name,
- return_type => $vt_method->return_type,
- parameters => $vt_method->parameters,
- type => Parrot::Pmc2c::Method::VTABLE,
- }
- );
- my $find_method_parent;
- if ( $parent->implements_vtable($vt_method_name) ) {
- $find_method_parent = $parent->name;
- }
- else {
- $find_method_parent = $parent->{super}{$vt_method_name};
+ my $name = $vt_method->name;
+
+ # Generate ro variant only iff we override method constantness with ":write"
+ next unless $parent->{has_method}{$name}
+ && $parent->vtable_method_does_write($name)
+ && !$parent->vtable->attrs($name)->{write};
+
+ # All parameters passed in are shims, because we're
+ # creating an exception-thrower.
+ my @parameters = split( /\s*,\s*/, $vt_method->parameters );
+ @parameters = map { "SHIM($_)" } @parameters;
+
+ my $ro_method = Parrot::Pmc2c::Method->new(
+ {
+ name => $name,
+ parent_name => $parent->name,
+ return_type => $vt_method->return_type,
+ parameters => join( ', ', @parameters ),
+ type => Parrot::Pmc2c::Method::VTABLE,
+ pmc_unused => 1,
}
- # We can't use enum_class_Foo there. $parent can be non-core PMC.
- my $real_findmethod = 'interp->vtables[pmc_type(interp, Parrot_str_new_constant(interp, "' . $find_method_parent . '"))]->find_method';
- my $body = <<"EOC";
- PMC *const method = $real_findmethod(interp, pmc, method_name);
- if (!PMC_IS_NULL(VTABLE_getprop(interp, method, CONST_STRING_GEN(interp, "write"))))
- return PMCNULL;
- else
- return method;
-EOC
- $ro_method->body( Parrot::Pmc2c::Emitter->text($body) );
- $self->add_method($ro_method);
- }
- elsif ( $parent->vtable_method_does_write($vt_method_name) ) {
- # All parameters passed in are shims, because we're
- # creating an exception-thrower.
- my @parameters = split( /\s*,\s*/, $vt_method->parameters );
- @parameters = map { "SHIM($_)" } @parameters;
-
- my $ro_method = Parrot::Pmc2c::Method->new(
- {
- name => $vt_method_name,
- parent_name => $parent->name,
- return_type => $vt_method->return_type,
- parameters => join( ', ', @parameters ),
- type => Parrot::Pmc2c::Method::VTABLE,
- pmc_unused => 1,
- }
- );
- my $pmcname = $parent->name;
- my $ret = return_statement($ro_method);
- my $body = <<EOC;
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_WRITE_TO_CONSTCLASS,
- "$vt_method_name() in read-only instance of $pmcname");
+ );
+ my $pmcname = $parent->name;
+ my $ret = return_statement($ro_method);
+ my $body = <<EOC;
+Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_WRITE_TO_CONSTCLASS,
+ "$name() in read-only instance of $pmcname");
EOC
- # don't return after a Parrot_ex_throw_from_c_args
- $ro_method->body( Parrot::Pmc2c::Emitter->text($body) );
- $self->add_method($ro_method);
- }
- else {
- if ( $parent->implements_vtable($vt_method_name) ) {
- my $parent_method = $parent->get_method($vt_method_name);
- $self->{super}{$vt_method_name} = $parent_method->parent_name;
- }
- else {
- $self->{super}{$vt_method_name} = $parent->{super}{$vt_method_name};
- }
- }
+ # don't return after a Parrot_ex_throw_from_c_args
+ $ro_method->body( Parrot::Pmc2c::Emitter->text($body) );
+ $self->add_method($ro_method);
}
return $self;
}
+
1;
# Local Variables:
Modified: branches/gc_api/lib/Parrot/Pmc2c/PMC/default.pm
==============================================================================
--- branches/gc_api/lib/Parrot/Pmc2c/PMC/default.pm Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/lib/Parrot/Pmc2c/PMC/default.pm Sat May 9 19:32:38 2009 (r38653)
@@ -26,27 +26,65 @@
foreach my $method ( @{ $self->vtable->methods } ) {
my $vt_method_name = $method->name;
next unless $self->unimplemented_vtable($vt_method_name);
- my $new_default_method = $method->clone(
- {
- parent_name => $self->name,
- type => Parrot::Pmc2c::Method::VTABLE,
- }
- );
- my $ret = return_statement($method);
-
- # take care to mark the parameters as unused
- # to avoid compiler warnings
- my $body;
- foreach my $param (split /,\s*/, $method->parameters) {
- $param =~ s/.*\b(\w+)/$1/;
- $body .= " UNUSED($param)\n";
+ $self->add_method($self->_generate_default_method($self, $method, 'cant_do_method'));
+ }
+ return 1;
+}
+
+sub gen_methods {
+ my ($self) = @_;
+
+ $self->SUPER::gen_methods;
+
+ # Generate RO variants.
+ my $ro = Parrot::Pmc2c::PMC::RO->new($self);
+ $ro->{emitter} = $self->{emitter};
+ foreach my $method ( @{ $self->vtable->methods } ) {
+ my $vt_method_name = $method->name;
+ if ($vt_method_name eq 'find_method') {
+ # Generate default_ro_find_method.
+ $self->{emitter}->emit(<<'EOC');
+static PMC *
+Parrot_default_ro_find_method(PARROT_INTERP, PMC *pmc, STRING *method_name) {
+ /* Use non-readonly find_method. Current vtable is ro variant. So ro_variant contains non-ro variant */
+ PMC *const method = pmc->vtable->ro_variant_vtable->find_method(interp, pmc, method_name);
+ if (!PMC_IS_NULL(VTABLE_getprop(interp, method, CONST_STRING_GEN(interp, "write"))))
+ return PMCNULL;
+ else
+ return method;
+}
+EOC
+ }
+ if ( $self->vtable_method_does_write($vt_method_name) ) {
+ my $m = $self->_generate_default_method($ro, $method, 'cant_do_write_method');
+ $m->generate_body($ro);
}
- $body .= qq{ cant_do_method(interp, pmc, "$vt_method_name");\n};
+ }
+}
+
+sub _generate_default_method {
+ my ($self, $pmc, $method, $stub_func) = @_;
- $new_default_method->body( Parrot::Pmc2c::Emitter->text($body));
- $self->add_method($new_default_method);
+ my $clone = $method->clone(
+ {
+ parent_name => $self->name,
+ type => Parrot::Pmc2c::Method::VTABLE,
+ }
+ );
+
+ # take care to mark the parameters as unused
+ # to avoid compiler warnings
+ my $body;
+ foreach my $param (split /,\s*/, $method->parameters) {
+ $param =~ s/.*\b(\w+)/$1/;
+ $body .= " UNUSED($param)\n";
}
- return 1;
+ my $vt_method_name = $method->name;
+ $body .= qq{ $stub_func(interp, pmc, "$vt_method_name");\n};
+
+ $clone->body( Parrot::Pmc2c::Emitter->text($body));
+
+ $clone;
}
sub update_vtable_func {
@@ -74,6 +112,27 @@
EOC
+ # Generate RO version of default VTABLE.
+ my $ro_vtable_decl = '';
+ foreach my $name ( @{ $self->vtable->names } ) {
+ if ($self->vtable_method_does_write($name) || ($name eq 'find_method')) {
+ $ro_vtable_decl .= " vt->$name = Parrot_default_ro_${name};\n";
+ }
+ }
+
+ $cout .= <<"EOC";
+
+PARROT_EXPORT VTABLE* Parrot_default_ro_get_vtable(PARROT_INTERP) {
+
+ VTABLE * vt = Parrot_default_get_vtable(interp);
+
+$ro_vtable_decl
+
+ return vt;
+}
+
+EOC
+
$cout;
}
Modified: branches/gc_api/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- branches/gc_api/lib/Parrot/Pmc2c/PMCEmitter.pm Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/lib/Parrot/Pmc2c/PMCEmitter.pm Sat May 9 19:32:38 2009 (r38653)
@@ -827,28 +827,29 @@
EOC
- my %extra_vt;
- $extra_vt{ro} = $self->{ro} if $self->{ro};
-
- for my $k (keys %extra_vt) {
-
- my $vtable_updates = '';
- foreach my $vt_method ( @{ $self->$k->vtable->names} ) {
-
- next unless ($self->$k->implements_vtable($vt_method));
-
- $vtable_updates .= " vt->$vt_method = Parrot_${classname}_${k}_${vt_method};\n";
+ # Generate RO vtable for implemented non-updating methods
+ $vtable_updates = '';
+ foreach my $name ( @{ $self->vtable->names} ) {
+ next unless exists $self->{has_method}{$name};
+ if ($self->vtable_method_does_write($name)) {
+ # If we override constantness status of vtable
+ if (!$self->vtable->attrs($name)->{write}) {
+ $vtable_updates .= " vt->$name = Parrot_${classname}_ro_${name};\n";
+ }
}
+ else {
+ $vtable_updates .= " vt->$name = Parrot_${classname}_${name};\n";
+ }
+ }
- $cout .= <<"EOC";
+ $cout .= <<"EOC";
-PARROT_EXPORT VTABLE *Parrot_${classname}_${k}_update_vtable(VTABLE *vt) {
+PARROT_EXPORT VTABLE *Parrot_${classname}_ro_update_vtable(VTABLE *vt) {
$vtable_updates
return vt;
}
EOC
- }
$cout;
}
@@ -885,31 +886,25 @@
EOC
- my %extra_vt;
- $extra_vt{ro} = $self->{ro} if $self->{ro};
-
- for my $k (keys %extra_vt) {
- my $get_extra_vtable = '';
- foreach my $parent_name ( reverse ($self->name, @{ $self->parents }) ) {
- if ($parent_name eq 'default') {
- $get_extra_vtable .= " vt = Parrot_default_get_vtable(interp);\n";
- }
- else {
- $get_extra_vtable .= " Parrot_${parent_name}_update_vtable(vt);\n";
- $get_extra_vtable .= " Parrot_${parent_name}_${k}_update_vtable(vt);\n";
- }
+ my $get_extra_vtable = '';
+ foreach my $parent_name ( reverse ($self->name, @{ $self->parents }) ) {
+ if ($parent_name eq 'default') {
+ $get_extra_vtable .= " vt = Parrot_default_ro_get_vtable(interp);\n";
}
+ else {
+ $get_extra_vtable .= " Parrot_${parent_name}_ro_update_vtable(vt);\n";
+ }
+ }
- $cout .= <<"EOC";
+ $cout .= <<"EOC";
PARROT_EXPORT
-VTABLE* Parrot_${classname}_${k}_get_vtable(PARROT_INTERP) {
+VTABLE* Parrot_${classname}_ro_get_vtable(PARROT_INTERP) {
VTABLE *vt;
$get_extra_vtable
return vt;
}
EOC
- }
$cout;
}
Modified: branches/gc_api/src/call/pcc.c
==============================================================================
--- branches/gc_api/src/call/pcc.c Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/call/pcc.c Sat May 9 19:32:38 2009 (r38653)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2008, Parrot Foundation.
+Copyright (C) 2001-2009, Parrot Foundation.
$Id$
=head1 Parrot Calling Conventions
@@ -1199,7 +1199,7 @@
if (key->vtable->base_type != enum_class_Key)
return;
- for (; key; key=key_next(interp, key)) {
+ for (; key; key = VTABLE_shift_pmc(interp, key)) {
/* register keys have to be cloned */
if (PObj_get_FLAGS(key) & KEY_register_FLAG) {
Parrot_Context temp_ctx;
Modified: branches/gc_api/src/gc/gc_private.h
==============================================================================
--- branches/gc_api/src/gc/gc_private.h Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/gc/gc_private.h Sat May 9 19:32:38 2009 (r38653)
@@ -29,7 +29,12 @@
extern void *flush_reg_store(void);
# define BACKING_STORE_BASE 0x80000fff80000000
-#endif
+# ifdef __hpux
+# include <sys/pstat.h>
+# include <ia64/sys/inline.h>
+# endif /* __hpux */
+
+#endif /* __ia64__ */
/* 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
Modified: branches/gc_api/src/gc/system.c
==============================================================================
--- branches/gc_api/src/gc/system.c Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/gc/system.c Sat May 9 19:32:38 2009 (r38653)
@@ -93,9 +93,35 @@
#elif defined(__ia64__)
- /* On IA64 systems, we use the function getcontext() to get the current
- processor context. This function is located in <ucontext.h>, included
- above. */
+
+# if defined(__hpux)
+ ucontext_t ucp;
+ void *current_regstore_top;
+
+ getcontext(&ucp);
+ _Asm_flushrs();
+
+# if defined(_LP64)
+ current_regstore_top = (void*)(uint64_t)_Asm_mov_from_ar(_AREG_BSP);
+# else
+ current_regstore_top = (void*)(uint32_t)_Asm_mov_from_ar(_AREG_BSP);
+# endif
+
+ size_t base = 0;
+ struct pst_vm_status buf;
+ int i = 0;
+
+ while (pstat_getprocvm(&buf, sizeof (buf), 0, i++) == 1) {
+ if (buf.pst_type == PS_RSESTACK) {
+ base = (size_t)buf.pst_vaddr;
+ break;
+ }
+ }
+
+# else /* !__hpux */
+ /* On IA64 Linux systems, we use the function getcontext() to get the
+ current processor context. This function is located in <ucontext.h>,
+ included above. */
struct ucontext ucp;
void *current_regstore_top;
@@ -110,9 +136,14 @@
is separate from the normal system stack. The register backing
stack starts at memory address 0x80000FFF80000000 and ends at
current_regstore_top. */
- trace_mem_block(interp, 0x80000fff80000000,
+ size_t base = 0x80000fff80000000;
+
+# endif /* __hpux */
+
+ trace_mem_block(interp, base,
(size_t)current_regstore_top);
-#else
+
+#else /* !__ia64__ */
# ifdef PARROT_HAS_HEADER_SETJMP
/* A jump buffer that is used to store the current processor context.
@@ -130,7 +161,7 @@
setjmp(env);
# endif
-#endif
+#endif /* __ia64__ */
}
/* With the processor context accounted for above, we can trace the
Modified: branches/gc_api/src/global.c
==============================================================================
--- branches/gc_api/src/global.c Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/global.c Sat May 9 19:32:38 2009 (r38653)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2004-2008, Parrot Foundation.
+Copyright (C) 2004-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -222,7 +222,7 @@
}
ns = sub_ns;
- key = key_next(interp, key);
+ key = VTABLE_shift_pmc(interp, key);
}
return ns;
Modified: branches/gc_api/src/hash.c
==============================================================================
--- branches/gc_api/src/hash.c Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/hash.c Sat May 9 19:32:38 2009 (r38653)
@@ -364,10 +364,9 @@
PARROT_EXPORT
void
-parrot_dump_hash(SHIM_INTERP, ARGIN(const Hash *hash))
+parrot_dump_hash(SHIM_INTERP, SHIM(const Hash *hash))
{
ASSERT_ARGS(parrot_dump_hash)
- UNUSED(hash);
}
@@ -461,7 +460,7 @@
parrot_mark_hash_values(PARROT_INTERP, ARGIN(Hash *hash))
{
ASSERT_ARGS(parrot_mark_hash_values)
- UINTVAL entries = hash->entries;
+ const UINTVAL entries = hash->entries;
UINTVAL found = 0;
INTVAL i;
@@ -470,7 +469,7 @@
while (bucket) {
if (++found > entries)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
"Detected hash corruption at hash %p entries %d",
hash, (int)entries);
@@ -497,7 +496,7 @@
parrot_mark_hash_both(PARROT_INTERP, ARGIN(Hash *hash))
{
ASSERT_ARGS(parrot_mark_hash_both)
- UINTVAL entries = hash->entries;
+ const UINTVAL entries = hash->entries;
UINTVAL found = 0;
INTVAL i;
@@ -616,7 +615,7 @@
size_t i;
for (i = 0; i < hash->entries; i++) {
- HashBucket *b = hash->bs+i;
+ HashBucket * const b = hash->bs+i;
switch (hash->key_type) {
case Hash_key_type_STRING:
@@ -1099,7 +1098,7 @@
PARROT_WARN_UNUSED_RESULT
PARROT_PURE_FUNCTION
INTVAL
-parrot_hash_size(PARROT_INTERP, ARGIN(const Hash *hash))
+parrot_hash_size(SHIM_INTERP, ARGIN(const Hash *hash))
{
ASSERT_ARGS(parrot_hash_size)
Modified: branches/gc_api/src/io/api.c
==============================================================================
--- branches/gc_api/src/io/api.c Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/io/api.c Sat May 9 19:32:38 2009 (r38653)
@@ -46,6 +46,7 @@
*/
PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_io_stdhandle(PARROT_INTERP, INTVAL fileno, ARGIN_NULLOK(PMC *newhandle))
@@ -203,6 +204,7 @@
*/
PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
INTVAL
Parrot_io_is_closed(PARROT_INTERP, ARGMOD(PMC *pmc))
{
@@ -378,6 +380,7 @@
*/
PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
INTVAL
Parrot_io_peek(PARROT_INTERP, ARGMOD(PMC *pmc), ARGOUT(STRING **buffer))
{
@@ -476,6 +479,7 @@
*/
PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
INTVAL
Parrot_io_fprintf(PARROT_INTERP, ARGMOD(PMC *pmc), ARGIN(const char *s), ...)
{
@@ -503,6 +507,7 @@
*/
PARROT_EXPORT
+PARROT_IGNORABLE_RESULT
INTVAL
Parrot_io_printf(PARROT_INTERP, ARGIN(const char *s), ...)
{
@@ -692,6 +697,7 @@
*/
PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
PIOOFF_T
Parrot_io_make_offset(INTVAL offset)
{
@@ -710,6 +716,7 @@
*/
+PARROT_WARN_UNUSED_RESULT
PIOOFF_T
Parrot_io_make_offset32(INTVAL hi, INTVAL lo)
{
@@ -727,6 +734,7 @@
*/
+PARROT_WARN_UNUSED_RESULT
PIOOFF_T
Parrot_io_make_offset_pmc(PARROT_INTERP, ARGMOD(PMC *pmc))
{
Modified: branches/gc_api/src/jit.c
==============================================================================
--- branches/gc_api/src/jit.c Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/jit.c Sat May 9 19:32:38 2009 (r38653)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2008, Parrot Foundation.
+Copyright (C) 2001-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -372,7 +372,7 @@
if (n < NUM_REGISTERS && !ru[typ].reg_count[n]++)
ru[typ].reg_dir[n] |= PARROT_ARGDIR_IN;
}
- key = key_next(interp, key);
+ key = VTABLE_shift_pmc(interp, key);
}
}
}
Modified: branches/gc_api/src/key.c
==============================================================================
--- branches/gc_api/src/key.c Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/key.c Sat May 9 19:32:38 2009 (r38653)
@@ -548,9 +548,8 @@
GETATTR_Key_next_key(interp, key, next_key);
return next_key;
}
- else {
- return NULL;
- }
+
+ return NULL;
}
Modified: branches/gc_api/src/ops/io.ops
==============================================================================
--- branches/gc_api/src/ops/io.ops Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/ops/io.ops Sat May 9 19:32:38 2009 (r38653)
@@ -383,14 +383,18 @@
STRING ** const s = &$1;
*s = NULL;
- Parrot_io_peek(interp, _PIO_STDIN(interp), s);
+ if (Parrot_io_peek(interp, _PIO_STDIN(interp), s) < 0) {
+ $1 = Parrot_str_new_noinit(interp, enum_stringrep_one, 0);
+ }
}
op peek(out STR, invar PMC) :base_io {
STRING ** const s = &$1;
*s = NULL;
- Parrot_io_peek(interp, $2, s);
+ if (Parrot_io_peek(interp, $2, s) < 0) {
+ $1 = Parrot_str_new_noinit(interp, enum_stringrep_one, 0);
+ }
}
##########################################
Modified: branches/gc_api/src/pmc/class.pmc
==============================================================================
--- branches/gc_api/src/pmc/class.pmc Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/pmc/class.pmc Sat May 9 19:32:38 2009 (r38653)
@@ -820,7 +820,7 @@
STRING * const current_name = VTABLE_get_string(interp, current_parent);
/* throw an exception if we already have this parent */
- if (Parrot_str_equal(interp, current_name, parent_name))
+ if (current_parent == parent)
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_INVALID_OPERATION,
"The class '%S' already has a parent class '%S'. "
Modified: branches/gc_api/src/pmc/default.pmc
==============================================================================
--- branches/gc_api/src/pmc/default.pmc Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/pmc/default.pmc Sat May 9 19:32:38 2009 (r38653)
@@ -68,6 +68,28 @@
caller(interp, pmc));
}
+
+/*
+
+=item C<static void cant_do_write_method(PARROT_INTERP, PMC *pmc,
+ const char *methname)>
+
+Throws an exception "$methname() on read-only instance of '$class'", used by
+all updating messages on read-only instances.
+
+=cut
+
+*/
+
+PARROT_DOES_NOT_RETURN
+static void
+cant_do_write_method(PARROT_INTERP, PMC *pmc /*NULLOK*/, const char *methname)
+{
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_WRITE_TO_CONSTCLASS,
+ "%s() in read-only instance of '%Ss'", methname,
+ caller(interp, pmc));
+}
+
/*
=item C<static INTVAL
Modified: branches/gc_api/src/pmc/key.pmc
==============================================================================
--- branches/gc_api/src/pmc/key.pmc Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/pmc/key.pmc Sat May 9 19:32:38 2009 (r38653)
@@ -277,7 +277,13 @@
*/
VTABLE PMC *shift_pmc() {
- return key_next(INTERP, SELF);
+ PMC *next_key;
+
+ if (!SELF->pmc_ext)
+ return NULL;
+
+ GET_ATTR_next_key(INTERP, SELF, next_key);
+ return next_key;
}
/*
Modified: branches/gc_api/src/pmc/namespace.pmc
==============================================================================
--- branches/gc_api/src/pmc/namespace.pmc Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/pmc/namespace.pmc Sat May 9 19:32:38 2009 (r38653)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2005-2008, Parrot Foundation.
+Copyright (C) 2005-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -354,7 +354,7 @@
if (key->vtable->base_type == enum_class_Key) {
while (1) {
STRING * const part = VTABLE_get_string(INTERP, key);
- key = key_next(INTERP, key);
+ key = VTABLE_shift_pmc(INTERP, key);
if (!key) {
Parrot_set_global(INTERP, ns, part, value);
@@ -407,7 +407,7 @@
if (key->vtable->base_type == enum_class_Key) {
STRING * const part = VTABLE_get_string(INTERP, key);
- key = key_next(INTERP, key);
+ key = VTABLE_shift_pmc(INTERP, key);
if (!key)
return VTABLE_get_pmc_keyed_str(INTERP, ns, part);
@@ -476,7 +476,7 @@
/* this loop (and function) could use a rewrite for clarity */
while (1) {
STRING * const part = VTABLE_get_string(INTERP, key);
- key = key_next(INTERP, key);
+ key = VTABLE_shift_pmc(INTERP, key);
if (!key)
return VTABLE_get_pointer_keyed_str(INTERP, ns, part);
Modified: branches/gc_api/src/pmc/orderedhash.pmc
==============================================================================
--- branches/gc_api/src/pmc/orderedhash.pmc Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/pmc/orderedhash.pmc Sat May 9 19:32:38 2009 (r38653)
@@ -113,7 +113,7 @@
VTABLE PMC *get_pmc_keyed(PMC *key) {
if ((PObj_get_FLAGS(key) & KEY_type_FLAGS) == KEY_integer_FLAG) {
PMC * const item = SELF.get_pmc_keyed_int(VTABLE_get_integer(INTERP, key));
- PMC * const next = key_next(INTERP, key);
+ PMC * const next = VTABLE_shift_pmc(INTERP, key);
if (!next)
return item;
@@ -161,7 +161,7 @@
VTABLE STRING *get_string_keyed(PMC *key) {
if ((PObj_get_FLAGS(key) & KEY_type_FLAGS) == KEY_integer_FLAG) {
PMC * const item = SELF.get_pmc_keyed_int(VTABLE_get_integer(INTERP, key));
- PMC * const next = key_next(INTERP, key);
+ PMC * const next = VTABLE_shift_pmc(INTERP, key);
if (!next)
return VTABLE_get_string(INTERP, item);
@@ -210,7 +210,7 @@
if ((PObj_get_FLAGS(key) & KEY_type_FLAGS) == KEY_integer_FLAG) {
PMC * const item = SELF.get_pmc_keyed_int(VTABLE_get_integer(INTERP, key));
- PMC * const next = key_next(INTERP, key);
+ PMC * const next = VTABLE_shift_pmc(INTERP, key);
if (!next)
return VTABLE_get_integer(INTERP, item);
@@ -259,7 +259,7 @@
VTABLE FLOATVAL get_number_keyed(PMC *key) {
if ((PObj_get_FLAGS(key) & KEY_type_FLAGS) == KEY_integer_FLAG) {
PMC * const item = SELF.get_pmc_keyed_int(VTABLE_get_integer(INTERP, key));
- PMC * const next = key_next(INTERP, key);
+ PMC * const next = VTABLE_shift_pmc(INTERP, key);
if (!next)
return VTABLE_get_number(INTERP, item);
@@ -417,7 +417,7 @@
return 0;
item = (PMC *)b->value;
- next = key_next(INTERP, key);
+ next = VTABLE_shift_pmc(INTERP, key);
if (!next)
return 1;
@@ -469,7 +469,7 @@
return 0;
item = (PMC *)b->value;
- next = key_next(INTERP, key);
+ next = VTABLE_shift_pmc(INTERP, key);
if (!next)
return VTABLE_defined(INTERP, item);
Modified: branches/gc_api/src/pmc/retcontinuation.pmc
==============================================================================
--- branches/gc_api/src/pmc/retcontinuation.pmc Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/pmc/retcontinuation.pmc Sat May 9 19:32:38 2009 (r38653)
@@ -43,7 +43,6 @@
PMC_data(SELF) = attrs;
PMC_cont(SELF) = new_ret_continuation(INTERP);
- PMC_data(SELF) = attrs;
PObj_custom_mark_destroy_SETALL(SELF);
}
@@ -64,11 +63,10 @@
=item C<PMC *clone>
-Return a new Continuation PMC with the context of SELF. Note: the
-returned object is not a RetContinuation and creating a real
-Continuation invalidates all RetContinuation all the way up the call
-chain that is, these can't be recycled, they get persistent until
-the GC gets at them.
+Return a new Continuation PMC with the context of SELF. Note: the returned
+object is not a RetContinuation and creating a real Continuation invalidates
+all RetContinuation all the way up the call chain. That is, these can't be
+recycled; they persist until the GC gets at them.
=cut
@@ -81,7 +79,7 @@
=item C<opcode_t *invoke(void *next)>
-Transfers control to the calling context, and frees the current context.
+Transfers control to the calling context and frees the current context.
=cut
@@ -101,14 +99,6 @@
#ifdef NDEBUG
/* the continuation is dead - delete and destroy it */
Parrot_gc_free_pmc_header(interp, SELF);
-#else
- cc->from_ctx = NULL;
-
- /*
- * the to_ctx is marked in Continuation.mark
- * NULLify it or turn off the custom_mark bit
- */
- cc->to_ctx = NULL;
#endif
if (INTERP->code != seg)
@@ -116,9 +106,9 @@
return next;
}
-
}
+
/*
=back
Modified: branches/gc_api/src/scheduler.c
==============================================================================
--- branches/gc_api/src/scheduler.c Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/scheduler.c Sat May 9 19:32:38 2009 (r38653)
@@ -127,29 +127,29 @@
while (VTABLE_get_integer(interp, scheduler) > 0) {
PMC * const task = VTABLE_pop_pmc(interp, scheduler);
if (!PMC_IS_NULL(task)) {
- PMC *type_pmc = VTABLE_get_attr_str(interp, task, CONST_STRING(interp, "type"));
- STRING *type = VTABLE_get_string(interp, type_pmc);
+ PMC * const type_pmc = VTABLE_get_attr_str(interp, task, CONST_STRING(interp, "type"));
+ STRING * const type = VTABLE_get_string(interp, type_pmc);
- if (Parrot_str_equal(interp, type, CONST_STRING(interp, "callback"))) {
- Parrot_cx_invoke_callback(interp, task);
- }
- else if (Parrot_str_equal(interp, type, CONST_STRING(interp, "timer"))) {
- Parrot_cx_timer_invoke(interp, task);
- }
- else if (Parrot_str_equal(interp, type, CONST_STRING(interp, "event"))) {
- PMC * const handler = Parrot_cx_find_handler_for_task(interp, task);
- if (!PMC_IS_NULL(handler)) {
- PMC * handler_sub = VTABLE_get_attr_str(interp, handler, CONST_STRING(interp, "code"));
- Parrot_runops_fromc_args_event(interp, handler_sub,
- "vPP", handler, task);
+ if (Parrot_str_equal(interp, type, CONST_STRING(interp, "callback"))) {
+ Parrot_cx_invoke_callback(interp, task);
+ }
+ else if (Parrot_str_equal(interp, type, CONST_STRING(interp, "timer"))) {
+ Parrot_cx_timer_invoke(interp, task);
+ }
+ else if (Parrot_str_equal(interp, type, CONST_STRING(interp, "event"))) {
+ PMC * const handler = Parrot_cx_find_handler_for_task(interp, task);
+ if (!PMC_IS_NULL(handler)) {
+ PMC * const handler_sub = VTABLE_get_attr_str(interp, handler, CONST_STRING(interp, "code"));
+ Parrot_runops_fromc_args_event(interp, handler_sub,
+ "vPP", handler, task);
+ }
+ }
+ else {
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Unknown task type '%Ss'.\n", type);
}
- }
- else {
- Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
- "Unknown task type '%Ss'.\n", type);
- }
- Parrot_cx_delete_task(interp, task);
+ Parrot_cx_delete_task(interp, task);
}
/* If the scheduler was flagged to terminate, make sure you process all
@@ -1008,7 +1008,7 @@
#if PARROT_HAS_THREADS
Parrot_cond condition;
Parrot_mutex lock;
- FLOATVAL timer_end = time + Parrot_floatval_time();
+ const FLOATVAL timer_end = time + Parrot_floatval_time();
struct timespec time_struct;
/* Tell the scheduler runloop to wake, this is a good time to process
@@ -1029,7 +1029,7 @@
/* A more primitive, platform-specific, non-threaded form of sleep. */
if (time > 1000) {
/* prevent integer overflow when converting to microseconds */
- int seconds = floor(time);
+ const int seconds = floor(time);
Parrot_sleep(seconds);
time -= seconds;
}
Modified: branches/gc_api/src/string/api.c
==============================================================================
--- branches/gc_api/src/string/api.c Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/string/api.c Sat May 9 19:32:38 2009 (r38653)
@@ -2091,12 +2091,10 @@
Parrot_str_to_num(PARROT_INTERP, ARGIN(const STRING *s))
{
ASSERT_ARGS(Parrot_str_to_num)
- FLOATVAL f = 0.0;
+ FLOATVAL f;
char *cstr;
const char *p;
- DECL_CONST_CAST;
-
/*
* XXX C99 atof interprets 0x prefix
* XXX would strtod() be better for detecting malformed input?
Modified: branches/gc_api/src/sub.c
==============================================================================
--- branches/gc_api/src/sub.c Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/src/sub.c Sat May 9 19:32:38 2009 (r38653)
@@ -351,7 +351,7 @@
}
else {
PMC *ns_array;
- STRING *j = CONST_STRING(interp, ";");
+ STRING * const semicolon = CONST_STRING(interp, ";");
STRING *res;
/*
@@ -384,7 +384,7 @@
if (sub->name)
VTABLE_push_string(interp, ns_array, sub->name);
- res = Parrot_str_join(interp, j, ns_array);
+ res = Parrot_str_join(interp, semicolon, ns_array);
Parrot_unblock_GC_mark(interp);
return res;
}
@@ -412,7 +412,6 @@
{
ASSERT_ARGS(Parrot_Context_get_info)
Parrot_sub *sub;
- DECL_CONST_CAST;
/* set file/line/pc defaults */
info->file = CONST_STRING(interp, "(unknown file)");
@@ -512,7 +511,6 @@
Parrot_block_GC_mark(interp);
if (Parrot_Context_get_info(interp, ctx, &info)) {
- DECL_CONST_CAST;
res = Parrot_sprintf_c(interp,
"%s '%Ss' pc %d (%Ss:%d)", msg,
Modified: branches/gc_api/t/compilers/imcc/syn/regressions.t
==============================================================================
--- branches/gc_api/t/compilers/imcc/syn/regressions.t Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/t/compilers/imcc/syn/regressions.t Sat May 9 19:32:38 2009 (r38653)
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 10;
+use Parrot::Test tests => 11;
pir_error_output_like( <<'CODE', <<'OUT', 'invalid get_results syntax');
.sub main :main
@@ -138,6 +138,24 @@
hello world
OUT
+TODO: {
+ local $TODO = 'TT #654';
+pir_output_is( <<'CODE', <<'OUT', 'unicode named identifiers (TT #654)');
+ .sub 'main' :main
+ 'foo'(1 :named(unicode:"\x{e4}"))
+ .end
+
+ # Perl 6: sub foo(:$ä) { say "ok $ä"; }
+ .sub 'foo'
+ .param int x :named(unicode:"\x{e4}")
+ print "ok "
+ say x
+ .end
+CODE
+1
+OUT
+}
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
Modified: branches/gc_api/t/pmc/class.t
==============================================================================
--- branches/gc_api/t/pmc/class.t Sat May 9 19:20:47 2009 (r38652)
+++ branches/gc_api/t/pmc/class.t Sat May 9 19:32:38 2009 (r38653)
@@ -17,7 +17,7 @@
=cut
-.const int TESTS = 62
+.const int TESTS = 63
.sub 'main' :main
@@ -45,6 +45,7 @@
'isa'()
'does'()
'more does'()
+ 'anon_inherit'()
.end
@@ -592,6 +593,14 @@
is($I0, 1, 'does Red')
.end
+.sub 'anon_inherit'
+ $P0 = new 'Class'
+ $P1 = new 'Class'
+ $P2 = new 'Class'
+ addparent $P2, $P0
+ addparent $P2, $P1
+ ok(1, 'inheritance of two different anonymous classes works')
+.end
# Local Variables:
# mode: pir
More information about the parrot-commits
mailing list