[svn:parrot] r40952 - in branches/context_pmc3: . compilers/nqp/src compilers/pct/src/POST config/gen/crypto config/gen/platform/netbsd docs docs/book/pct docs/pdds docs/project include/parrot src src/call src/dynpmc src/gc src/interp src/jit/i386 src/ops src/pmc src/runcore t/op t/pmc tools/dev

bacek at svn.parrot.org bacek at svn.parrot.org
Thu Sep 3 10:17:46 UTC 2009


Author: bacek
Date: Thu Sep  3 10:17:39 2009
New Revision: 40952
URL: https://trac.parrot.org/parrot/changeset/40952

Log:
Last merge from trunk before mergin back.

Conflicts:
	MANIFEST
	docs/pdds/pdd17_pmc.pod
	include/parrot/pmc.h
	src/gc/api.c
	src/ops/set.ops
	src/pmc.c
	src/pmc/eventhandler.pmc
	src/pmc/exception.pmc
	src/pmc/nci.pmc
	src/pmc/sub.pmc
	t/op/gc.t

Added:
   branches/context_pmc3/t/pmc/integer-old.t
   branches/context_pmc3/tools/dev/parrot_shell.pl
Modified:
   branches/context_pmc3/MANIFEST
   branches/context_pmc3/MANIFEST.generated
   branches/context_pmc3/compilers/nqp/src/builtins.pir
   branches/context_pmc3/compilers/pct/src/POST/Compiler.pir
   branches/context_pmc3/config/gen/crypto/digest_pmc.in
   branches/context_pmc3/config/gen/platform/netbsd/math.c
   branches/context_pmc3/config/gen/platform/netbsd/misc.c
   branches/context_pmc3/docs/book/pct/ch03_compiler_tools.pod
   branches/context_pmc3/docs/debugger.pod
   branches/context_pmc3/docs/embed.pod
   branches/context_pmc3/docs/memory_internals.pod
   branches/context_pmc3/docs/pdds/pdd09_gc.pod
   branches/context_pmc3/docs/pdds/pdd17_pmc.pod
   branches/context_pmc3/docs/pdds/pdd28_strings.pod
   branches/context_pmc3/docs/pmc.pod
   branches/context_pmc3/docs/project/support_policy.pod
   branches/context_pmc3/docs/vtables.pod
   branches/context_pmc3/include/parrot/extend.h
   branches/context_pmc3/include/parrot/pmc.h
   branches/context_pmc3/include/parrot/pobj.h
   branches/context_pmc3/src/call/pcc.c
   branches/context_pmc3/src/dynpmc/gdbmhash.pmc
   branches/context_pmc3/src/dynpmc/rational.pmc
   branches/context_pmc3/src/gc/api.c
   branches/context_pmc3/src/gc/generational_ms.c
   branches/context_pmc3/src/gc/system.c
   branches/context_pmc3/src/hll.c
   branches/context_pmc3/src/interp/inter_cb.c
   branches/context_pmc3/src/jit/i386/jit_defs.c
   branches/context_pmc3/src/misc.c
   branches/context_pmc3/src/oo.c
   branches/context_pmc3/src/ops/set.ops
   branches/context_pmc3/src/packdump.c
   branches/context_pmc3/src/packfile.c
   branches/context_pmc3/src/pmc.c
   branches/context_pmc3/src/pmc/bigint.pmc
   branches/context_pmc3/src/pmc/bignum.pmc
   branches/context_pmc3/src/pmc/class.pmc
   branches/context_pmc3/src/pmc/eventhandler.pmc
   branches/context_pmc3/src/pmc/exception.pmc
   branches/context_pmc3/src/pmc/exceptionhandler.pmc
   branches/context_pmc3/src/pmc/filehandle.pmc
   branches/context_pmc3/src/pmc/fixedbooleanarray.pmc
   branches/context_pmc3/src/pmc/fixedfloatarray.pmc
   branches/context_pmc3/src/pmc/fixedintegerarray.pmc
   branches/context_pmc3/src/pmc/lexinfo.pmc
   branches/context_pmc3/src/pmc/managedstruct.pmc
   branches/context_pmc3/src/pmc/nci.pmc
   branches/context_pmc3/src/pmc/object.pmc
   branches/context_pmc3/src/pmc/packfileannotation.pmc
   branches/context_pmc3/src/pmc/packfileconstanttable.pmc
   branches/context_pmc3/src/pmc/packfilefixuptable.pmc
   branches/context_pmc3/src/pmc/packfilerawsegment.pmc
   branches/context_pmc3/src/pmc/parrotinterpreter.pmc
   branches/context_pmc3/src/pmc/parrotlibrary.pmc
   branches/context_pmc3/src/pmc/parrotrunningthread.pmc
   branches/context_pmc3/src/pmc/resizablebooleanarray.pmc
   branches/context_pmc3/src/pmc/resizableintegerarray.pmc
   branches/context_pmc3/src/pmc/scheduler.pmc
   branches/context_pmc3/src/pmc/sockaddr.pmc
   branches/context_pmc3/src/pmc/string.pmc
   branches/context_pmc3/src/pmc/timer.pmc
   branches/context_pmc3/src/pmc/undef.pmc
   branches/context_pmc3/src/runcore/cores.c
   branches/context_pmc3/t/op/box.t
   branches/context_pmc3/t/op/gc.t
   branches/context_pmc3/t/op/string.t
   branches/context_pmc3/t/pmc/integer.t
   branches/context_pmc3/t/pmc/packfiledirectory.t
   branches/context_pmc3/t/pmc/packfilerawsegment.t
   branches/context_pmc3/t/pmc/string.t
   branches/context_pmc3/tools/dev/fetch_languages.pl
   branches/context_pmc3/tools/dev/pbc_to_exe.pir

Modified: branches/context_pmc3/MANIFEST
==============================================================================
--- branches/context_pmc3/MANIFEST	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/MANIFEST	Thu Sep  3 10:17:39 2009	(r40952)
@@ -1,7 +1,7 @@
 # ex: set ro:
 # $Id$
 #
-# generated by tools/dev/mk_manifest_and_skip.pl Tue Sep  1 11:42:14 2009 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sun Aug 30 20:35:30 2009 UT
 #
 # See below for documentation on the format of this file.
 #
@@ -1873,6 +1873,7 @@
 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]
@@ -2153,6 +2154,7 @@
 tools/dev/parrot.supp                                       []
 tools/dev/parrot_api.pl                                     []
 tools/dev/parrot_coverage.pl                                []
+tools/dev/parrot_shell.pl                                   []
 tools/dev/parrotbench.pl                                    []
 tools/dev/pbc_header.pl                                     []
 tools/dev/pbc_to_exe.pir                                    [devel]

Modified: branches/context_pmc3/MANIFEST.generated
==============================================================================
--- branches/context_pmc3/MANIFEST.generated	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/MANIFEST.generated	Thu Sep  3 10:17:39 2009	(r40952)
@@ -171,10 +171,10 @@
 runtime/parrot/library/parrotlib.pbc              [main]
 runtime/parrot/library/pcore.pbc                  [main]
 runtime/parrot/library/pcre.pbc                   [main]
-runtime/parrot/library/PCT/Grammar.pbc            [pct]
-runtime/parrot/library/PCT/HLLCompiler.pbc        [pct]
-runtime/parrot/library/PCT/PAST.pbc               [pct]
-runtime/parrot/library/PCT.pbc                    [pct]
+runtime/parrot/library/PCT/Grammar.pbc            [main]
+runtime/parrot/library/PCT/HLLCompiler.pbc        [main]
+runtime/parrot/library/PCT/PAST.pbc               [main]
+runtime/parrot/library/PCT.pbc                    [main]
 runtime/parrot/library/PGE/Dumper.pbc             [main]
 runtime/parrot/library/PGE/Glob.pbc               [main]
 runtime/parrot/library/PGE/Hs.pbc                 [main]

Modified: branches/context_pmc3/compilers/nqp/src/builtins.pir
==============================================================================
--- branches/context_pmc3/compilers/nqp/src/builtins.pir	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/compilers/nqp/src/builtins.pir	Thu Sep  3 10:17:39 2009	(r40952)
@@ -129,6 +129,24 @@
     .return ()
 .end
 
+=item C<eval(lang,code)>
+
+=cut
+
+.sub 'eval'
+    .param string text
+    .param string lang
+    .local pmc c, code
+    lang = downcase lang
+    load_language lang
+    c = compreg lang
+    print 'evaling in language: '
+    say lang
+    code = c.'compile'(text)
+    $P0 = code()
+    .return ($P0)
+.end
+
 =back
 
 =cut

Modified: branches/context_pmc3/compilers/pct/src/POST/Compiler.pir
==============================================================================
--- branches/context_pmc3/compilers/pct/src/POST/Compiler.pir	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/compilers/pct/src/POST/Compiler.pir	Thu Sep  3 10:17:39 2009	(r40952)
@@ -82,6 +82,8 @@
     pos = cpost['pos']
     if null pos goto done_subline
     source = cpost['source']
+    $I0 = can source, 'lineof'
+    unless $I0 goto done_subline
     line = source.'lineof'(pos)
     inc line
   done_subline:

Modified: branches/context_pmc3/config/gen/crypto/digest_pmc.in
==============================================================================
--- branches/context_pmc3/config/gen/crypto/digest_pmc.in	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/config/gen/crypto/digest_pmc.in	Thu Sep  3 10:17:39 2009	(r40952)
@@ -22,7 +22,6 @@
 
 pmclass @TEMP_md_name@
     dynpmc
-    need_ext
     group digest_group
     lib crypto {
 
@@ -37,7 +36,7 @@
 @TEMP_md_guard@
         @TEMP_md_ctx@ *c    = mem_allocate_zeroed_typed(@TEMP_md_ctx@);
         PMC_data(SELF) = c;
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
 #else
         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ILL_INHERIT,
             "@TEMP_md_name@ is disabled");
@@ -76,7 +75,7 @@
         memcpy(c, PMC_data(SELF), sizeof (@TEMP_md_ctx@));
         PMC_data(retval) = c;
 
-        PObj_active_destroy_SET(retval);
+        PObj_custom_destroy_SET(retval);
         return retval;
 #else
         return NULL;

Modified: branches/context_pmc3/config/gen/platform/netbsd/math.c
==============================================================================
--- branches/context_pmc3/config/gen/platform/netbsd/math.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/config/gen/platform/netbsd/math.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -22,14 +22,8 @@
 
 */
 
-/*
- * force atan2() to use IEEE behavior
- */
-
 #include <math.h>
 
-_LIB_VERSION_TYPE _LIB_VERSION = _IEEE_;
-
 #if DOUBLE_SIZE == 2 * INT_SIZE
 /*
 

Modified: branches/context_pmc3/config/gen/platform/netbsd/misc.c
==============================================================================
--- branches/context_pmc3/config/gen/platform/netbsd/misc.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/config/gen/platform/netbsd/misc.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -26,17 +26,23 @@
 =item C<void Parrot_platform_init_code(void)>
 
 Initialize Parrot for the NetBSD platform.
-So far only turns off SIGFPE for Alpha.
+So far turns off SIGFPE for Alpha, and
+ensures IEEE floating-point semantics from
+the math library.
 
 =cut
 
 */
 
 #include <signal.h>
+#include <math.h>
 
 void
 Parrot_platform_init_code(void)
 {
+
+    _LIB_VERSION = _IEEE_;	/* force IEEE math semantics and behaviour */
+
 #if defined(__alpha__)
     signal(SIGFPE, SIG_IGN);
 #endif

Modified: branches/context_pmc3/docs/book/pct/ch03_compiler_tools.pod
==============================================================================
--- branches/context_pmc3/docs/book/pct/ch03_compiler_tools.pod	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/docs/book/pct/ch03_compiler_tools.pod	Thu Sep  3 10:17:39 2009	(r40952)
@@ -30,7 +30,7 @@
 executing the new Perl 6 language, when specifications for that were first
 starting to be drafted. However, as time went on it was decided that Parrot
 would benefit from having a clean abstraction layer between it's internals
-and the Perl 6 language syntax. This clean abstraction layer brough with it
+and the Perl 6 language syntax. This clean abstraction layer brought with it
 the side effect that Parrot could be used to host a wide variety of dynamic
 languages, not just Perl 6. And beyond just hosting them, it could
 facilitate their advancement, interaction, and code sharing.
@@ -42,7 +42,7 @@
 all those features to any languages that wanted them.
 
 Perl 6, under the project name Rakudo N<http://www.rakudo.org>, is still one
-of the primary user of Parrot and therefore one of the primary drivers in
+of the primary users of Parrot and therefore one of the primary drivers in
 its development. However, compilers for other dynamic languages such as
 Python 3, Ruby, Tcl, are under active development. Several compilers exist
 which are not being as actively developed, and many compilers exist for

Modified: branches/context_pmc3/docs/debugger.pod
==============================================================================
--- branches/context_pmc3/docs/debugger.pod	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/docs/debugger.pod	Thu Sep  3 10:17:39 2009	(r40952)
@@ -20,17 +20,16 @@
 required to read this document. Some familiarity with debugging principles is
 also mandatory beyond this point.
 
+
 =head1 BUILDING parrot_debugger
 
-The debugger is not built with Parrot, but you should make it with its specific
-target:
+The debugger is built along with Parrot when you run 'make', but if you want to build 
+*only* the debugger, then you can run:
 
   make parrot_debugger
 
-(where C<make> is the same C<make> incarnation you used to build Parrot).
-
-If everything goes well, you should come up with a F<parrot_debugger>
-executable in the same directory as the Parrot program.
+Which will create a new parrot_debugger executable in the same directory as the parrot
+executable.
 
 =head1 THE DEBUGGER SHELL
 

Modified: branches/context_pmc3/docs/embed.pod
==============================================================================
--- branches/context_pmc3/docs/embed.pod	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/docs/embed.pod	Thu Sep  3 10:17:39 2009	(r40952)
@@ -1853,7 +1853,7 @@
 
 =item C<pmc_type>
 
-=item C<PObj_active_destroy_SET>
+=item C<PObj_custom_destroy_SET>
 
 =item C<PObj_custom_mark_SET>
 

Modified: branches/context_pmc3/docs/memory_internals.pod
==============================================================================
--- branches/context_pmc3/docs/memory_internals.pod	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/docs/memory_internals.pod	Thu Sep  3 10:17:39 2009	(r40952)
@@ -1,4 +1,4 @@
-# Copyright (C) 2001-2004, Parrot Foundation.
+# Copyright (C) 2001-2009, Parrot Foundation.
 # $Id$
 
 =head1 NAME
@@ -117,18 +117,16 @@
 =head2 General structure of a buffer-like item
 
     struct parrot_object_t {
-        UnionVal cache;
         unsigned flags;
         ...
     } PObj;
 
-This does not totally reflect the current implementation, but is the spirit of
-the abstraction of current objects. The C<UnionVal cache> field is a C<union>
-that contains a variety of pointer and data configurations. The flags field
-may contain a series of flags which indicate the type, status, configuration,
-and special requirements of each item. Buffers, C<PMC>s, and C<PObj>s all
-have these basic fields in common, although they also contain a variety of
-other data fields, depending on type.
+The flags field may contain a series of flags which indicate the type, status,
+configuration, and special requirements of each item. C<Buffer>s, C<PMC>s, and
+C<PObj>s all have this basic field in common.
+
+C<PMC>s and C<Buffer>s each have an additional field which contain a pointer
+to a block of data.
 
 =head2 GC-related PObj flags
 
@@ -279,5 +277,3 @@
 =head1 VERSION
 
 0.1.1 June 2008
-
-

Modified: branches/context_pmc3/docs/pdds/pdd09_gc.pod
==============================================================================
--- branches/context_pmc3/docs/pdds/pdd09_gc.pod	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/docs/pdds/pdd09_gc.pod	Thu Sep  3 10:17:39 2009	(r40952)
@@ -1,4 +1,4 @@
-# Copyright (C) 2001-2008, Parrot Foundation.
+# Copyright (C) 2001-2009, Parrot Foundation.
 # $Id$
 
 =head1 PDD 9: Garbage Collection Subsystem
@@ -560,7 +560,7 @@
 
 =over 4
 
-=item PObj_active_destroy_FLAG
+=item PObj_custom_destroy_FLAG
 
 The PMC has some sort of active destructor, and will have that destructor
 called when the PMC is destroyed. The destructor is typically called from
@@ -620,6 +620,9 @@
 
 =head2 References
 
+"Uniprocessor Garbage Collection Techniques"
+http://www.cs.rice.edu/~javaplt/311/Readings/wilson92uniprocessor.pdf
+
 "A unified theory of garbage collection":
 http://portal.acm.org/citation.cfm?id=1028982
 

Modified: branches/context_pmc3/docs/pdds/pdd17_pmc.pod
==============================================================================
--- branches/context_pmc3/docs/pdds/pdd17_pmc.pod	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/docs/pdds/pdd17_pmc.pod	Thu Sep  3 10:17:39 2009	(r40952)
@@ -44,39 +44,13 @@
 All PMCs have the form:
 
     struct PMC {
-        UnionVal cache;
         Parrot_UInt flags;
         VTABLE *vtable;
         DPOINTER *data;
         PMC *_metadata;
-        struct _Sync *_synchronize; # [Note: may be deprecated, see STM]
+        struct _Sync *_synchronize;    # [Note: may be deprecated, see STM]
         PMC *_next_for_GC;
-    };
-
-where C<cache> is a C<UnionVal> union:
-
-    typedef union UnionVal {
-        struct {
-            void  *_bufstart;
-            size_t _buflen;
-        } _b;
-        struct {
-            DPOINTER *_struct_val;
-            PMC      *_pmc_val;
-        } _ptrs;
-        struct _i {
-            INTVAL _int_val;
-            INTVAL _int_val2;
-        } _i;
-        FLOATVAL _num_val;
-        struct parrot_string_t * _string_val;
-    } UnionVal;
-
-C<u> holds data associated with the PMC. This can be in the form of an integer
-value, a floating-point value, a string value, or a pointer to other data.
-C<u> may be empty, since the PMC structure also provides a more general data
-pointer, but is useful for PMCs which hold only a single piece of data (e.g.
-C<PerlInts>).
+    }
 
 C<flags> holds a set of flags associated with the PMC; these are documented
 in F<include/parrot/pobj.h>, and are generally only used within the Parrot
@@ -90,8 +64,8 @@
 C<data> holds a pointer to the core data associated with the PMC. This
 may be null.
 
-C<_metadata> holds internal PMC metadata. The specification for this has not
-yet been finalized.
+C<_metadata> holds internal PMC metadata (properties). See the setprop/getprop
+ops in F<docs/ops/pmc.pod>.
 
 C<_synchronize> is for access synchronization between shared PMCs.
 

Modified: branches/context_pmc3/docs/pdds/pdd28_strings.pod
==============================================================================
--- branches/context_pmc3/docs/pdds/pdd28_strings.pod	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/docs/pdds/pdd28_strings.pod	Thu Sep  3 10:17:39 2009	(r40952)
@@ -257,30 +257,29 @@
 
 Parrot's internal strings (C<STRING>s) have the following structure:
 
-  struct parrot_string_t {
-      UnionVal                      cache;
-      Parrot_UInt                   flags;
-      UINTVAL                       bufused;
-      UINTVAL                       strlen;
-      UINTVAL                       hashval;
-      const struct _encoding       *encoding;
-      const struct _charset        *charset;
-      const struct _normalization  *normalization;
-  };
+    struct parrot_string_t {
+	Parrot_UInt flags;
+	void *     _bufstart;
+	size_t     _buflen;
+	char       *strstart;
+	UINTVAL     bufused;
+	UINTVAL     strlen;
+	UINTVAL     hashval;
+	const struct _encoding *encoding;
+	const struct _charset  *charset;
+};
 
 The fields are:
 
 =over 4
 
-=item cache
+=item _bufstart
 
-A structure that holds the buffer for the string data and the size of the
-buffer in bytes.
+A pointer to the buffer for the string data.
 
-{{ NOTE: this is currently called "cache" for compatibility with PMC
-structures.  As we eliminate the cache from PMCs, we will flatten out this
-union value in the string structure to two members: a string buffer and the
-size of the buffer used. }}
+=item _buflen
+
+The size of the buffer in bytes.
 
 =item flags
 
@@ -320,13 +319,6 @@
 The charset structure specifies the character set (by index number and by
 name) and provides functions for transcoding to and from that character set.
 
-=item normalization
-
-What normalization form the string data is in, one of the four Unicode
-normalization forms or NFG. This structure stores the current normalization
-form, function pointers for composition and decomposition for the current
-normalization form, and a pointer to the grapheme table for NFG.
-
 =back
 
 {{DEPRECATION NOTE: the enum C<parrot_string_representation_t> will be removed

Modified: branches/context_pmc3/docs/pmc.pod
==============================================================================
--- branches/context_pmc3/docs/pmc.pod	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/docs/pmc.pod	Thu Sep  3 10:17:39 2009	(r40952)
@@ -42,7 +42,7 @@
 C<PMC_data> in the PMC's C<init()> and C<init_pmc()> VTABLE functions (if used)
 and it must be destroyed in the C<destroy()> VTABLE function.  PMCs with ATTRs
 also need to indicate that they need active destruction by calling
-C<PObj_active_destroy_SET()> or C<PObj_custom_mark_destroy_SETALL()>.
+C<PObj_custom_destroy_SET()> or C<PObj_custom_mark_destroy_SETALL()>.
 
 If your PMC only needs to store a single pointer, it can use C<PMC_data> directly.
 Note that this may make maintaining your PMC difficult, should more data ever
@@ -80,10 +80,10 @@
 VTABLE function must call B<Parrot_gc_mark_PObj_alive()> on all B<PObj>s which your PMC
 contains.
 
-=item PObj_active_destroy_FLAG
+=item PObj_custom_destroy_FLAG
 
 If your PMC allocates any memory or opens any resources during its lifetime, it
-must set B<PObj_active_destroy> and implement the B<destroy()> VTABLE function to
+must set B<PObj_custom_destroy> and implement the B<destroy()> VTABLE function to
 free those resources.
 
 =item PObj_needs_early_gc_FLAG

Modified: branches/context_pmc3/docs/project/support_policy.pod
==============================================================================
--- branches/context_pmc3/docs/project/support_policy.pod	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/docs/project/support_policy.pod	Thu Sep  3 10:17:39 2009	(r40952)
@@ -164,10 +164,27 @@
 
 =item * bytecode changes (opcode or core PMC removals, renames)
 
-=item * PARROT_API function changes
+=item * C<PARROT_API> function changes
 
 =item * PIR or PASM syntax changes
 
 =item * API changes in the compiler tools
 
 =back
+
+Please note that these features I<do not> require deprecation notices:
+
+=over 4
+
+=item * Parrot functions I<not> marked with C<PARROT_API>
+
+=item * The layout of Parrot's internal data structures
+
+=item * Parrot internals hidden behind a public API
+
+=back
+
+Note that all pointers passed to and returned from functions marked with
+C<PARROT_API> are considered opaque.  We do not guarantee backwards
+compatibility between monthly releases for the layout of these pointers;
+dereference them at your own risk.

Modified: branches/context_pmc3/docs/vtables.pod
==============================================================================
--- branches/context_pmc3/docs/vtables.pod	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/docs/vtables.pod	Thu Sep  3 10:17:39 2009	(r40952)
@@ -211,7 +211,7 @@
 =item C<destroy>
 
 Do any data shut-down and finalization you need to do. To have this method
-called, you must set the C<Pobj_active_destroy_FLAG>.
+called, you must set the C<Pobj_custom_destroy_FLAG>.
 
 =item C<get_integer>
 

Modified: branches/context_pmc3/include/parrot/extend.h
==============================================================================
--- branches/context_pmc3/include/parrot/extend.h	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/include/parrot/extend.h	Thu Sep  3 10:17:39 2009	(r40952)
@@ -35,10 +35,15 @@
    pointer, which is on the stack and as good a thing as any to use as
    an anchor */
 #define PARROT_CALLIN_START(x) void *oldtop = (x)->lo_var_ptr; \
-                               if (!oldtop) (x)->lo_var_ptr = &oldtop;
+                               if (oldtop) {} else (x)->lo_var_ptr = &oldtop
 /* Put the stack top back, if what we cached was NULL. Otherwise we
    leave it alone and assume it's OK */
-#define PARROT_CALLIN_END(x)   if (!oldtop) (x)->lo_var_ptr = NULL;
+#define PARROT_CALLIN_END(x)   do {\
+                if (!oldtop) {\
+                    PARROT_ASSERT((x)->lo_var_ptr == &oldtop);\
+                    (x)->lo_var_ptr = NULL;\
+                }\
+            } while (0)
 
 #else
 

Modified: branches/context_pmc3/include/parrot/pmc.h
==============================================================================
--- branches/context_pmc3/include/parrot/pmc.h	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/include/parrot/pmc.h	Thu Sep  3 10:17:39 2009	(r40952)
@@ -53,10 +53,10 @@
 void Parrot_create_mro(PARROT_INTERP, INTVAL type)
         __attribute__nonnull__(1);
 
-PARROT_EXPORT
-void Parrot_pmc_destroy(PARROT_INTERP, ARGIN(PMC *pmc))
+void Parrot_pmc_destroy(PARROT_INTERP, ARGMOD(PMC *pmc))
         __attribute__nonnull__(1)
-        __attribute__nonnull__(2);
+        __attribute__nonnull__(2)
+        FUNC_MODIFIES(*pmc);
 
 PARROT_EXPORT
 INTVAL PMC_is_null(SHIM_INTERP, ARGIN_NULLOK(const PMC *pmc));

Modified: branches/context_pmc3/include/parrot/pobj.h
==============================================================================
--- branches/context_pmc3/include/parrot/pobj.h	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/include/parrot/pobj.h	Thu Sep  3 10:17:39 2009	(r40952)
@@ -38,9 +38,8 @@
                     v                 v
 
 The actual set-up is more involved because of padding.  obj->bufstart must
-be suitably aligned for any UnionVal.  (Perhaps it should be a Buffer
-there instead.)  The start of the memory region (as returned by malloc()
-is also suitably aligned for any use.  If, for example, malloc() returns
+be suitably aligned. The start of the memory region (as returned by malloc())
+is suitably aligned for any use.  If, for example, malloc() returns
 objects aligned on 8-byte boundaries, and obj->bufstart is also aligned
 on 8-byte boundaries, then there should be 4 bytes of padding.  It is
 handled differently in the two files alloc_resources.c and res_lea.c.
@@ -192,7 +191,7 @@
     /* Mark the buffer as needing GC */
     PObj_custom_GC_FLAG         = POBJ_FLAG(21),
     /* Set if the PObj has a destroy method that must be called */
-    PObj_active_destroy_FLAG    = POBJ_FLAG(22),
+    PObj_custom_destroy_FLAG    = POBJ_FLAG(22),
     /* For debugging, report when this buffer gets moved around */
     PObj_report_FLAG            = POBJ_FLAG(23),
 
@@ -290,7 +289,7 @@
 #define PObj_special_CLEAR(flag, o) do { \
     PObj_flag_CLEAR(flag, o); \
     if ((PObj_get_FLAGS(o) & \
-                (PObj_active_destroy_FLAG | \
+                (PObj_custom_destroy_FLAG | \
                  PObj_custom_mark_FLAG | \
                  PObj_needs_early_gc_FLAG))) \
         gc_flag_SET(is_special_PMC, o); \
@@ -313,9 +312,17 @@
 #define PObj_custom_mark_CLEAR(o)   PObj_special_CLEAR(custom_mark, o)
 #define PObj_custom_mark_TEST(o)   PObj_flag_TEST(custom_mark, o)
 
-#define PObj_active_destroy_SET(o) PObj_flag_SET(active_destroy, o)
-#define PObj_active_destroy_TEST(o) PObj_flag_TEST(active_destroy, o)
-#define PObj_active_destroy_CLEAR(o) PObj_flag_CLEAR(active_destroy, o)
+#define PObj_custom_destroy_SET(o)   PObj_flag_SET(custom_destroy,   o)
+#define PObj_custom_destroy_TEST(o)  PObj_flag_TEST(custom_destroy,  o)
+#define PObj_custom_destroy_CLEAR(o) PObj_flag_CLEAR(custom_destroy, o)
+
+/*******************************************************
+ * DEPRECATED -- use PObj_custom_destroy_FOO() instead *
+ *******************************************************/
+#define PObj_active_destroy_FLAG     PObj_custom_destroy_FLAG
+#define PObj_active_destroy_SET(o)   PObj_flag_SET(custom_destroy,   o)
+#define PObj_active_destroy_TEST(o)  PObj_flag_TEST(custom_destroy,  o)
+#define PObj_active_destroy_CLEAR(o) PObj_flag_CLEAR(custom_destroy, o)
 
 #define PObj_is_class_SET(o) PObj_flag_SET(is_class, o)
 #define PObj_is_class_TEST(o) PObj_flag_TEST(is_class, o)
@@ -357,7 +364,7 @@
 
 #define PObj_custom_mark_destroy_SETALL(o) do { \
         PObj_custom_mark_SET(o); \
-        PObj_active_destroy_SET(o); \
+        PObj_custom_destroy_SET(o); \
 } while (0)
 
 #endif /* PARROT_POBJ_H_GUARD */

Modified: branches/context_pmc3/src/call/pcc.c
==============================================================================
--- branches/context_pmc3/src/call/pcc.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/call/pcc.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -1891,6 +1891,8 @@
         Parrot_pcc_set_results_signature(interp, dest_ctx, NULL);
     }
 
+    memset(&st, 0, sizeof st);
+
     Parrot_init_arg_indexes_and_sig_pmc(interp, src_ctx, src_indexes,
         src_signature, &st.src);
 
@@ -2953,8 +2955,8 @@
     INTVAL n_regs_used[] = { 0, 0, 0, 0, 0, 0, 0, 0 };
 
     /* Each of these is 8K. Do we want 16K on the stack? */
-    opcode_t arg_indexes[PCC_ARG_MAX];
-    opcode_t result_indexes[PCC_ARG_MAX];
+    opcode_t arg_indexes[PCC_ARG_MAX] = {0};
+    opcode_t result_indexes[PCC_ARG_MAX] = {0};
 
     /* create the signature string, and the various PMCs that are needed to
        store all the parameters and parameter counts. */

Modified: branches/context_pmc3/src/dynpmc/gdbmhash.pmc
==============================================================================
--- branches/context_pmc3/src/dynpmc/gdbmhash.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/dynpmc/gdbmhash.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -105,7 +105,7 @@
 
         attrs->db_handle = mem_allocate_zeroed_typed(GDBM_FH);
         PMC_data(SELF)   = attrs;
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
     VTABLE void destroy() {
@@ -214,13 +214,16 @@
         if (!dbf) return;
         keystr = make_hash_key(interp, key);
 
-        key_gdbm.dsize = keystr->strlen;
-        key_gdbm.dptr  = keystr->strstart;
-        val_gdbm.dsize = value->strlen;
-        val_gdbm.dptr  = value->strstart;
+        key_gdbm.dptr  = Parrot_str_to_cstring(interp, keystr);
+        key_gdbm.dsize = strlen(key_gdbm.dptr);
+        val_gdbm.dptr  = Parrot_str_to_cstring(interp, value);
+        val_gdbm.dsize = strlen(val_gdbm.dptr);
 
         gdbm_store(dbf, key_gdbm, val_gdbm, GDBM_REPLACE);
 
+        Parrot_str_free_cstring(key_gdbm.dptr);
+        Parrot_str_free_cstring(val_gdbm.dptr);
+
         return;
     }
 

Modified: branches/context_pmc3/src/dynpmc/rational.pmc
==============================================================================
--- branches/context_pmc3/src/dynpmc/rational.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/dynpmc/rational.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -269,7 +269,7 @@
         PMC_data(SELF)     = attrs;
         PMC_rational(SELF) = (RATIONAL *)malloc(sizeof (RATIONAL));
         mpq_init(RT(SELF));
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
       #endif
     }
 

Modified: branches/context_pmc3/src/gc/api.c
==============================================================================
--- branches/context_pmc3/src/gc/api.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/gc/api.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -361,20 +361,7 @@
     Small_Object_Pool * const pool = (PObj_constant_TEST(pmc)) ?
         interp->arena_base->constant_pmc_pool : interp->arena_base->pmc_pool;
 
-    if (PObj_active_destroy_TEST(pmc))
-        VTABLE_destroy(interp, pmc);
-
-    Parrot_gc_free_pmc_sync(interp, pmc);
-    if (PMC_data(pmc) && pmc->vtable->attr_size) {
-#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
-    }
-    PARROT_ASSERT(NULL == PMC_data(pmc));
-
+    Parrot_pmc_destroy(interp, pmc);
 
     PObj_flags_SETTO((PObj *)pmc, PObj_on_free_list_FLAG);
     pool->add_free_object(interp, pool, (PObj *)pmc);
@@ -419,10 +406,13 @@
 Parrot_gc_add_pmc_sync(PARROT_INTERP, ARGMOD(PMC *pmc))
 {
     ASSERT_ARGS(Parrot_gc_add_pmc_sync)
+
+    /* This mutex already exists, leave it alone. */
     if (PMC_sync(pmc))
-        /* This mutex already exists, leave it alone. */
         return;
+
     PMC_sync(pmc) = mem_allocate_typed(Sync);
+
     if (!PMC_sync(pmc))
         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ALLOCATION_ERROR,
             "Parrot VM: PMC Sync allocation failed!\n");
@@ -1692,7 +1682,7 @@
 
 =head1 SEE ALSO
 
-F<include/parrot/gc_api.h>, F<src/cpu_dep.c> and F<docs/pdds/pdd09_gc.pod>.
+F<include/parrot/gc_api.h>, F<src/gc/system.c> and F<docs/pdds/pdd09_gc.pod>.
 
 =head1 HISTORY
 

Modified: branches/context_pmc3/src/gc/generational_ms.c
==============================================================================
--- branches/context_pmc3/src/gc/generational_ms.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/gc/generational_ms.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -606,7 +606,7 @@
 =item C<static void gc_gms_chain_objects(PARROT_INTERP, Small_Object_Pool *pool,
 Small_Object_Arena *new_arena, size_t real_size)>
 
-TODO: interfere active_destroy and put these items into a
+TODO: interfere custom_destroy and put these items into a
 separate white area, so that a sweep has just to run through these
 objects
 
@@ -1691,7 +1691,7 @@
         PMC * const obj = (PMC*)GMSH_to_PObj(h);
         if (PObj_needs_early_gc_TEST(obj))
             --arena_base->num_early_gc_PMCs;
-        if (PObj_active_destroy_TEST(obj))
+        if (PObj_custom_destroy_TEST(obj))
             VTABLE_destroy(interp, (PMC *)obj);
     }
     pool->free_list = pool->white;

Modified: branches/context_pmc3/src/gc/system.c
==============================================================================
--- branches/context_pmc3/src/gc/system.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/gc/system.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -238,6 +238,7 @@
        the "bottom" of the stack. We must trace the entire area between the
        top and bottom. */
     const size_t lo_var_ptr = (size_t)interp->lo_var_ptr;
+    PARROT_ASSERT(lo_var_ptr);
 
     trace_mem_block(interp, (size_t)lo_var_ptr,
             (size_t)&lo_var_ptr);

Modified: branches/context_pmc3/src/hll.c
==============================================================================
--- branches/context_pmc3/src/hll.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/hll.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -53,7 +53,7 @@
 #define END_READ_HLL_INFO(interp, hll_info)
 #define START_WRITE_HLL_INFO(interp, hll_info) \
     do { \
-        if (PMC_sync((interp)->HLL_info)) { \
+        if (PObj_is_PMC_shared_TEST(hll_info) && PMC_sync((interp)->HLL_info)) { \
             (hll_info) = (interp)->HLL_info = \
                 Parrot_clone((interp), (interp)->HLL_info); \
             if (PMC_sync((interp)->HLL_info)) \
@@ -362,8 +362,8 @@
             "no such HLL ID (%vd)", hll_id);
 
     /* the type might already be registered in a non-conflicting way, in which
-     * case we can avoid copying */
-    if (PMC_sync(hll_info)) {
+     * ca se we can avoid copying */
+    if (PObj_is_PMC_shared_TEST(hll_info) && PMC_sync(hll_info)) {
         if (hll_type == Parrot_get_HLL_type(interp, hll_id, core_type))
             return;
     }

Modified: branches/context_pmc3/src/interp/inter_cb.c
==============================================================================
--- branches/context_pmc3/src/interp/inter_cb.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/interp/inter_cb.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -79,6 +79,7 @@
     int type;
     char * sig_str;
     STRING *sc;
+    char * const signature = Parrot_str_to_cstring(interp, cb_signature);
     /*
      * we stuff all the information into the user_data PMC and pass that
      * on to the external sub
@@ -92,11 +93,13 @@
     sc = CONST_STRING(interp, "_sub");
     VTABLE_setprop(interp, user_data, sc, sub);
     /* only ASCII signatures are supported */
-    sig_str = cb_signature->strstart;
+    sig_str = signature;
 
-    if (strlen(sig_str) != 3)
+    if (strlen(sig_str) != 3) {
+        mem_sys_free(signature);
         Parrot_ex_throw_from_c_args(interp, NULL, 1,
-            "unhandled signature '%s' in make_cb", cb_signature->strstart);
+            "unhandled signature '%Ss' in make_cb", cb_signature);
+    }
 
     ++sig_str;     /* Skip callback return type */
 
@@ -109,11 +112,13 @@
             type = 'C';
         }
         else {
+            mem_sys_free(signature);
             Parrot_ex_throw_from_c_args(interp, NULL, 1,
-                "unhandled signature '%s' in make_cb", cb_signature->strstart);
+                "unhandled signature '%Ss' in make_cb", cb_signature);
         }
     }
 
+    mem_sys_free(signature);
     cb_sig = pmc_new(interp, enum_class_String);
     VTABLE_set_string_native(interp, cb_sig, cb_signature);
     sc = CONST_STRING(interp, "_signature");

Modified: branches/context_pmc3/src/jit/i386/jit_defs.c
==============================================================================
--- branches/context_pmc3/src/jit/i386/jit_defs.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/jit/i386/jit_defs.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -2410,7 +2410,7 @@
     emitm_ret(pc);
     PARROT_ASSERT(pc - jit_info.arena.start <= JIT_ALLOC_SIZE);
     /* could shrink arena.start here to used size */
-    PObj_active_destroy_SET(pmc_nci);
+    PObj_custom_destroy_SET(pmc_nci);
     if (sizeptr)
         *sizeptr = JIT_ALLOC_SIZE;
     return (void *)D2FPTR(jit_info.arena.start);

Modified: branches/context_pmc3/src/misc.c
==============================================================================
--- branches/context_pmc3/src/misc.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/misc.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -112,6 +112,8 @@
                  size_t len, ARGIN(const char *pat), va_list args)
 {
     ASSERT_ARGS(Parrot_vsnprintf)
+    char   *str_ret;
+    size_t  str_len;
     if (len == 0)
         return;
     len--;
@@ -119,12 +121,15 @@
         const STRING * const ret = Parrot_vsprintf_c(interp, pat, args);
         /* string_transcode(interp, ret, NULL, NULL, &ret); */
 
-        if (len > ret->bufused) {
-            len = ret->bufused;
+        str_ret = Parrot_str_to_cstring(interp, ret);
+        str_len = strlen(str_ret);
+        if (len > str_len) {
+            len = str_len;
         }
 
         if (len)
-            memcpy(targ, ret->strstart, len);
+            memcpy(targ, str_ret, len);
+        Parrot_str_free_cstring(str_ret);
     }
     targ[len] = 0;
 }

Modified: branches/context_pmc3/src/oo.c
==============================================================================
--- branches/context_pmc3/src/oo.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/oo.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -286,14 +286,13 @@
 
     /* Set custom GC mark and destroy on the object. */
     PObj_custom_mark_SET(cloned);
-    PObj_active_destroy_SET(cloned);
+    PObj_custom_destroy_SET(cloned);
 
     /* Flag that it is an object */
     PObj_is_object_SET(cloned);
 
-    /* Now create the underlying structure, and clone attributes list.class. */
-    cloned_guts               = mem_allocate_typed(Parrot_Object_attributes);
-    PMC_data(cloned)          = cloned_guts;
+    /* Now clone attributes list.class. */
+    cloned_guts               = (Parrot_Object_attributes *) PMC_data(cloned);
     cloned_guts->_class       = obj->_class;
     cloned_guts->attrib_store = NULL;
     cloned_guts->attrib_store = VTABLE_clone(interp, obj->attrib_store);

Modified: branches/context_pmc3/src/ops/set.ops
==============================================================================
--- branches/context_pmc3/src/ops/set.ops	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/ops/set.ops	Thu Sep  3 10:17:39 2009	(r40952)
@@ -25,7 +25,10 @@
 =cut
 
 inline op clone(out STR, in STR) :base_mem {
-  $1 = Parrot_str_copy(interp, $2);
+  /* cloning a NULL STRING produces an empty STRING; TT #964 */
+  $1 = $2
+     ? Parrot_str_copy(interp, $2)
+     : Parrot_str_new(interp, NULL, 0);
 }
 
 
@@ -508,10 +511,10 @@
 
         /* don't let the clone's destruction destroy the destination's data */
         PObj_active_destroy_CLEAR(clone);
-        PMC_data(clone) = NULL;
-        PMC_metadata(clone) = NULL;
+        PMC_data(clone)        = NULL;
+        PMC_sync(clone)        = NULL;
+        PMC_metadata(clone)    = NULL;
         PMC_next_for_GC(clone) = NULL;
-        PMC_sync(clone) = NULL;
 
         /* Restore metadata. */
         if (!PMC_IS_NULL(meta)) {

Modified: branches/context_pmc3/src/packdump.c
==============================================================================
--- branches/context_pmc3/src/packdump.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/packdump.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -111,7 +111,7 @@
     "on_free_list",
     "custom_mark",
     "custom_GC",
-    "active_destroy",
+    "custom_destroy",
     "report",
     "data_is_PMC_array",
     "need_finalize",

Modified: branches/context_pmc3/src/packfile.c
==============================================================================
--- branches/context_pmc3/src/packfile.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/packfile.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -26,6 +26,7 @@
 
 #include "parrot/parrot.h"
 #include "parrot/embed.h"
+#include "parrot/extend.h"
 #include "parrot/packfile.h"
 #include "jit.h"
 #include "../compilers/imcc/imc.h"
@@ -4922,7 +4923,9 @@
 PackFile_fixup_subs(PARROT_INTERP, pbc_action_enum_t what, ARGIN_NULLOK(PMC *eval))
 {
     ASSERT_ARGS(PackFile_fixup_subs)
+    PARROT_CALLIN_START(interp);
     do_sub_pragmas(interp, interp->code, what, eval);
+    PARROT_CALLIN_END(interp);
 }
 
 

Modified: branches/context_pmc3/src/pmc.c
==============================================================================
--- branches/context_pmc3/src/pmc.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -105,16 +105,21 @@
 
 PARROT_EXPORT
 void
-Parrot_pmc_destroy(PARROT_INTERP, ARGIN(PMC *pmc))
+Parrot_pmc_destroy(PARROT_INTERP, ARGMOD(PMC *pmc))
 {
     ASSERT_ARGS(Parrot_pmc_destroy)
 
-    if (PObj_active_destroy_TEST(pmc)) {
+    if (PObj_custom_destroy_TEST(pmc)) {
         VTABLE_destroy(interp, pmc);
         /* Prevent repeated calls. */
-        PObj_active_destroy_CLEAR(pmc);
+        PObj_custom_destroy_CLEAR(pmc);
     }
 
+    PObj_custom_mark_CLEAR(pmc);
+    PObj_live_CLEAR(pmc);
+
+    Parrot_gc_free_pmc_sync(interp, pmc);
+
     if (pmc->vtable->attr_size) {
         if (PMC_data(pmc)) {
 #if GC_USE_FIXED_SIZE_ALLOCATOR

Modified: branches/context_pmc3/src/pmc/bigint.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/bigint.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/bigint.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -627,7 +627,7 @@
 
     VTABLE void init() {
         bigint_init(INTERP, SELF);
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
     VTABLE PMC *clone() {

Modified: branches/context_pmc3/src/pmc/bignum.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/bignum.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/bignum.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -841,7 +841,7 @@
 
     VTABLE void init() {
         bignum_init(INTERP, SELF);
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
     VTABLE PMC *clone() {

Modified: branches/context_pmc3/src/pmc/class.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/class.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/class.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -1222,7 +1222,7 @@
 
         /* Set custom GC mark and destroy on the object. */
         PObj_custom_mark_SET(object);
-        PObj_active_destroy_SET(object);
+        PObj_custom_destroy_SET(object);
 
         /* Flag that it is an object */
         PObj_is_object_SET(object);

Modified: branches/context_pmc3/src/pmc/eventhandler.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/eventhandler.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/eventhandler.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -39,7 +39,7 @@
 
     VTABLE void init() {
         PObj_custom_mark_SET(SELF);
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*
@@ -101,7 +101,7 @@
                     INTERP->iglobals, IGLOBALS_INTERPRETER);
 
         PObj_custom_mark_SET(SELF);
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
 
         e->type        = type;
         e->code        = code;

Modified: branches/context_pmc3/src/pmc/exception.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/exception.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/exception.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -84,7 +84,7 @@
 
     VTABLE void init() {
         /* Set flags for custom GC mark and destroy. */
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
         PObj_custom_mark_SET(SELF);
 
         SET_ATTR_severity(INTERP, SELF, EXCEPT_error);
@@ -124,7 +124,7 @@
         }
 
         /* Set flags for custom GC mark. */
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
         PObj_custom_mark_SET(SELF);
 
         /* Set up the core struct and default values for the exception object. */

Modified: branches/context_pmc3/src/pmc/exceptionhandler.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/exceptionhandler.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/exceptionhandler.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -56,7 +56,7 @@
          * context - the stacks can only be deeper in the interpreter - so no
          * mark of context is needed */
         PObj_custom_mark_SET(SELF);
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 /*
 

Modified: branches/context_pmc3/src/pmc/filehandle.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/filehandle.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/filehandle.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -84,7 +84,7 @@
         data_struct->os_handle     = (PIOHANDLE) PIO_INVALID_HANDLE;
 
         PObj_custom_mark_SET(SELF);
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*

Modified: branches/context_pmc3/src/pmc/fixedbooleanarray.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/fixedbooleanarray.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/fixedbooleanarray.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -45,7 +45,7 @@
 */
 
     VTABLE void init() {
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*
@@ -97,7 +97,7 @@
             SET_ATTR_bit_array(INTERP, dest, clone_bit_array);
         }
 
-        PObj_active_destroy_SET(dest);
+        PObj_custom_destroy_SET(dest);
         return dest;
     }
 
@@ -550,15 +550,15 @@
 
         if (info->extra_flags == EXTRA_IS_NULL) {
             unsigned char * bit_array;
+            UINTVAL         threshold;
             const INTVAL    size      = VTABLE_shift_integer(INTERP, io);
             STRING * const  s         = VTABLE_shift_string(INTERP, io);
 
-            bit_array = (unsigned char*)mem_sys_allocate_zeroed(s->bufused);
-            mem_sys_memcopy(bit_array, s->strstart, s->bufused);
+            bit_array = (unsigned char *)Parrot_str_to_cstring(INTERP, s);
+            threshold = Parrot_str_byte_length(interp, s) * BITS_PER_CHAR;
 
             SET_ATTR_size(INTERP, SELF, size);
-            SET_ATTR_resize_threshold(INTERP, SELF,
-                    s->bufused * BITS_PER_CHAR);
+            SET_ATTR_resize_threshold(INTERP, SELF, threshold);
             SET_ATTR_bit_array(INTERP, SELF, bit_array);
         }
     }

Modified: branches/context_pmc3/src/pmc/fixedfloatarray.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/fixedfloatarray.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/fixedfloatarray.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -73,7 +73,7 @@
         dest_float_array  = (FLOATVAL*)mem_sys_allocate(mem_size);
         mem_sys_memcopy(dest_float_array, self_float_array, mem_size);
         SET_ATTR_float_array(INTERP, dest, dest_float_array);
-        PObj_active_destroy_SET(dest);
+        PObj_custom_destroy_SET(dest);
 
         return dest;
     }
@@ -290,7 +290,7 @@
         SET_ATTR_size(INTERP, SELF, new_size);
         SET_ATTR_float_array(INTERP, SELF,
                 mem_allocate_n_typed(new_size, FLOATVAL));
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*

Modified: branches/context_pmc3/src/pmc/fixedintegerarray.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/fixedintegerarray.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/fixedintegerarray.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -40,7 +40,7 @@
 */
 
     VTABLE void init() {
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*
@@ -190,7 +190,7 @@
             SET_ATTR_int_array(INTERP, dest, dest_int_array);
 
             mem_sys_memcopy(dest_int_array, int_array, size * sizeof (INTVAL));
-            PObj_active_destroy_SET(dest);
+            PObj_custom_destroy_SET(dest);
         }
 
         return dest;
@@ -432,7 +432,7 @@
         GET_ATTR_int_array(INTERP, SELF, int_array);
         SET_ATTR_int_array(INTERP, SELF,
                 mem_realloc_n_typed(int_array, size, INTVAL));
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*
@@ -636,11 +636,7 @@
     }
 
     VTABLE void thaw(visit_info *info) {
-
-        Parrot_FixedIntegerArray_attributes *attrs =
-            mem_allocate_zeroed_typed(Parrot_FixedIntegerArray_attributes);
-        PMC_data(SELF) = attrs;
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
 
         if (info->extra_flags == EXTRA_IS_NULL) {
             IMAGE_IO * const io = info->image_io;

Modified: branches/context_pmc3/src/pmc/lexinfo.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/lexinfo.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/lexinfo.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -71,7 +71,7 @@
             (hash_hash_key_fn)Parrot_str_to_hashval); /*        hash    */
 
         SELF.set_pointer(hash);
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*

Modified: branches/context_pmc3/src/pmc/managedstruct.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/managedstruct.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/managedstruct.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -46,7 +46,7 @@
 */
 
     VTABLE void init() {
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*

Modified: branches/context_pmc3/src/pmc/nci.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/nci.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/nci.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -255,7 +255,6 @@
         void                  *orig_func;
 
         PMC * const ret     = pmc_new(INTERP, SELF->vtable->base_type);
-        PMC_data(ret)       = mem_allocate_zeroed_typed(Parrot_NCI_attributes);
         nci_info_ret        = PARROT_NCI(ret);
 
         /* FIXME if data is malloced (JIT/i386!) then we need
@@ -302,6 +301,7 @@
     VTABLE opcode_t *invoke(void *next) {
         Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF);
         nci_sub_t                     func;
+        char                         *sig_str;
         void                         *orig_func;
         PMC                          *cont;
 
@@ -324,7 +324,9 @@
             nci_jit_sub_t jit_func = (nci_jit_sub_t) D2FPTR(nci_info->func);
 
             /* Parrot_eprintf(interp, "JITTED %S\n", nci_info->signature); */
-            jit_func(INTERP, SELF, (char *) nci_info->pcc_params_signature->strstart);
+            sig_str = Parrot_str_to_cstring(interp, nci_info->pcc_params_signature);
+            jit_func(INTERP, SELF, sig_str);
+            Parrot_str_free_cstring(sig_str);
         }
         else {
             if (PObj_flag_TEST(private2, SELF)) {

Modified: branches/context_pmc3/src/pmc/object.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/object.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/object.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -695,10 +695,6 @@
         if (info->extra_flags == EXTRA_IS_PROP_HASH) {
             SUPER(info);
         }
-        else if (info->extra_flags == EXTRA_IS_NULL) {
-            /* Allocate the object's core data struct */
-            PMC_data(SELF) = mem_allocate_zeroed_typed(Parrot_Object_attributes);
-        }
     }
 
 /*
@@ -714,7 +710,7 @@
     VTABLE void thawfinish(visit_info *info) {
         /* Set custom GC mark and destroy on the object. */
         PObj_custom_mark_SET(SELF);
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
 
         /* Flag that it is an object */
         PObj_is_object_SET(SELF);

Modified: branches/context_pmc3/src/pmc/packfileannotation.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/packfileannotation.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/packfileannotation.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -42,7 +42,7 @@
         Parrot_PackfileAnnotation_attributes * attrs =
                 mem_allocate_zeroed_typed(Parrot_PackfileAnnotation_attributes);
 
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
         PMC_data(SELF) = attrs;
     }
 

Modified: branches/context_pmc3/src/pmc/packfileconstanttable.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/packfileconstanttable.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/packfileconstanttable.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -395,6 +395,20 @@
         return i;
     }
 
+/*
+
+=item C<METHOD type()>
+
+Set segment type.
+
+=cut
+
+*/
+
+    METHOD type() {
+        RETURN(INTVAL PF_CONST_SEG);
+    }
+
 
 }
 /*

Modified: branches/context_pmc3/src/pmc/packfilefixuptable.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/packfilefixuptable.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/packfilefixuptable.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -198,6 +198,20 @@
     }
 
 
+/*
+
+=item C<METHOD type()>
+
+Set segment type.
+
+=cut
+
+*/
+
+    METHOD type() {
+        RETURN(INTVAL PF_FIXUP_SEG);
+    }
+
 }
 /*
 

Modified: branches/context_pmc3/src/pmc/packfilerawsegment.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/packfilerawsegment.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/packfilerawsegment.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -25,6 +25,8 @@
 */
 
 pmclass PackfileRawSegment extends PackfileSegment {
+    /* Type of segment */
+    ATTR INTVAL  type;
     /* ResizableIntegerArray of opcodes */
     ATTR PMC    *opcodes;
 
@@ -43,6 +45,7 @@
                 mem_allocate_zeroed_typed(Parrot_PackfileRawSegment_attributes);
 
         attrs->opcodes = pmc_new(interp, enum_class_ResizableIntegerArray);
+        attrs->type    = PF_BYTEC_SEG;
 
         PObj_custom_mark_destroy_SETALL(SELF);
         PMC_data(SELF) = attrs;
@@ -103,9 +106,14 @@
     VTABLE void set_pointer(void * pointer) {
         const PackFile_Segment * const pfseg =
                 (const PackFile_Segment *)pointer;
-        PMC * opcodes = PARROT_PACKFILERAWSEGMENT(SELF)->opcodes;
+        Parrot_PackfileRawSegment_attributes * attrs =
+                PARROT_PACKFILERAWSEGMENT(SELF);
+        PMC * opcodes = attrs->opcodes;
         size_t i;
 
+        /* Preserve type of unpacked segment */
+        attrs->type = pfseg->type;
+
         if (pfseg->size) {
             /* copy data to own array */
             VTABLE_set_integer_native(interp, opcodes, pfseg->size);
@@ -132,7 +140,7 @@
         PMC * opcodes = attrs->opcodes;
         size_t i;
 
-        pfseg->type     = PF_BYTEC_SEG;
+        pfseg->type     = attrs->type;
         pfseg->size     = VTABLE_get_integer(interp, opcodes);
         pfseg->data     = mem_allocate_n_typed(pfseg->size, opcode_t);
 
@@ -187,6 +195,30 @@
             PARROT_PACKFILERAWSEGMENT(SELF)->opcodes, key, value);
     }
 
+/*
+
+=item C<METHOD type()>
+
+Set of get segment type.
+
+=cut
+
+TODO: Don't allow create Directory, Annotations, etc segments.
+
+*/
+
+    METHOD type(INTVAL type :optional, INTVAL got_type :opt_flag) {
+        Parrot_PackfileRawSegment_attributes * attrs =
+                PARROT_PACKFILERAWSEGMENT(SELF);
+        INTVAL res;
+
+        if (got_type) {
+            attrs->type = type;
+        }
+
+        res = attrs->type;
+        RETURN(INTVAL res);
+    }
 
 }
 /*

Modified: branches/context_pmc3/src/pmc/parrotinterpreter.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/parrotinterpreter.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/parrotinterpreter.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -242,7 +242,7 @@
         if (!PMC_interp(SELF)) {
             create_interp(SELF, INTERP);
         }
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*
@@ -268,7 +268,7 @@
         if (!PMC_interp(SELF)) {
             create_interp(SELF, p);
         }
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 
@@ -309,7 +309,7 @@
             Parrot_ParrotInterpreter_attributes *attrs =
                 mem_allocate_zeroed_typed(Parrot_ParrotInterpreter_attributes);
             PMC_data(SELF) = attrs;
-            PObj_active_destroy_SET(SELF);
+            PObj_custom_destroy_SET(SELF);
         }
         PMC_interp(SELF) = (struct parrot_interp_t *)value;
     }
@@ -721,7 +721,7 @@
                 Parrot_ParrotInterpreter_attributes *attrs =
                     mem_allocate_zeroed_typed(Parrot_ParrotInterpreter_attributes);
                 PMC_data(SELF) = attrs;
-                PObj_active_destroy_SET(SELF);
+                PObj_custom_destroy_SET(SELF);
             }
 
             PMC_interp(SELF) = INTERP;

Modified: branches/context_pmc3/src/pmc/parrotlibrary.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/parrotlibrary.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/parrotlibrary.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -46,7 +46,7 @@
 */
 
     VTABLE void init() {
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*

Modified: branches/context_pmc3/src/pmc/parrotrunningthread.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/parrotrunningthread.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/parrotrunningthread.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -50,7 +50,7 @@
             mem_allocate_zeroed_typed(Parrot_ParrotRunningThread_attributes);
         attrs->tid = -1;
         PMC_data(SELF) = attrs;
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*

Modified: branches/context_pmc3/src/pmc/resizablebooleanarray.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/resizablebooleanarray.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/resizablebooleanarray.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -392,7 +392,7 @@
 
         SET_ATTR_bit_array(INTERP, dest, dest_bit_array);
 
-        PObj_active_destroy_SET(dest);
+        PObj_custom_destroy_SET(dest);
         return dest;
     }
 
@@ -453,11 +453,7 @@
         const UINTVAL    tail_pos = VTABLE_shift_integer(INTERP, io);
         STRING * const   s        = VTABLE_shift_string(INTERP, io);
 
-        bit_array      = (unsigned char *)mem_sys_allocate_zeroed(s->bufused);
-        mem_sys_memcopy(bit_array, (unsigned char *)s->strstart, s->bufused);
-        PMC_data(SELF) =
-            mem_allocate_zeroed_typed(Parrot_ResizableBooleanArray_attributes);
-
+        bit_array      = (unsigned char*)Parrot_str_to_cstring(INTERP, s);
         SET_ATTR_size(INTERP, SELF, tail_pos);
         SET_ATTR_resize_threshold(INTERP, SELF, head_pos);
         SET_ATTR_bit_array(INTERP, SELF, bit_array);

Modified: branches/context_pmc3/src/pmc/resizableintegerarray.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/resizableintegerarray.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/resizableintegerarray.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -294,11 +294,6 @@
     }
 
     VTABLE void thaw(visit_info *info) {
-
-        Parrot_ResizableIntegerArray_attributes *attrs =
-            mem_allocate_zeroed_typed(Parrot_ResizableIntegerArray_attributes);
-        PMC_data(SELF) = attrs;
-
         if (info->extra_flags == EXTRA_IS_NULL) {
             IMAGE_IO * const io = info->image_io;
             const INTVAL n = VTABLE_shift_integer(INTERP, io);

Modified: branches/context_pmc3/src/pmc/scheduler.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/scheduler.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/scheduler.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -52,7 +52,7 @@
 
         /* Set flags for custom GC mark and destroy. */
         PObj_custom_mark_SET(SELF);
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
 
         /* Set up the core struct. */
         core_struct->id          = 0;

Modified: branches/context_pmc3/src/pmc/sockaddr.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/sockaddr.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/sockaddr.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -47,7 +47,7 @@
             (Parrot_Sockaddr_attributes *) PMC_data(SELF);
 
         pdata_struct->pointer = mem_allocate_zeroed_typed(struct sockaddr_in);
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
     }
 
 /*

Modified: branches/context_pmc3/src/pmc/string.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/string.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/string.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -220,11 +220,16 @@
 */
 
     VTABLE void set_string_native(STRING *value) {
+        /* in lieu of a STRINGNULL, promote any NULL STRINGs to empty ones */
+        if (!value)
+            value = Parrot_str_new(INTERP, NULL, 0);
+
         /* Only allow constant PMCs to embed constant strings */
         if (PObj_constant_TEST(SELF) && !PObj_constant_TEST(value)) {
             char *copy = Parrot_str_to_cstring(INTERP, value);
             value      = Parrot_str_new_init(INTERP, copy, strlen(copy),
-                    PARROT_DEFAULT_ENCODING, PARROT_DEFAULT_CHARSET, PObj_constant_FLAG);
+                PARROT_DEFAULT_ENCODING, PARROT_DEFAULT_CHARSET,
+                PObj_constant_FLAG);
             Parrot_str_free_cstring(copy);
         }
 
@@ -645,6 +650,16 @@
         return string_ord(INTERP, s, pos);
     }
 
+    VTABLE PMC *get_pmc_keyed(PMC *key) {
+        return SELF.get_pmc_keyed_int(VTABLE_get_integer(INTERP, key));
+    }
+
+    VTABLE PMC *get_pmc_keyed_int(INTVAL pos) {
+        PMC * const dest = pmc_new(INTERP, SELF->vtable->base_type);
+        VTABLE_set_string_native(INTERP, dest, SELF.get_string_keyed_int(pos));
+        return dest;
+    }
+
     VTABLE void set_string_keyed(PMC *key, STRING * const value) {
         SELF.set_string_keyed_int(VTABLE_get_integer(INTERP, key), value);
     }
@@ -666,6 +681,14 @@
         Parrot_str_replace(INTERP, s, pos, 1, c, NULL);
         VTABLE_set_string_native(INTERP, SELF, s);
     }
+
+    VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
+        SELF.set_pmc_keyed_int(VTABLE_get_integer(INTERP, key), value);
+    }
+
+    VTABLE void set_pmc_keyed_int(INTVAL pos, PMC *value) {
+        SELF.set_string_keyed_int(pos, VTABLE_get_string(INTERP, value));
+    }
 /*
 
 =item C<void replace(STRING *orig, STRING *_new)>

Modified: branches/context_pmc3/src/pmc/timer.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/timer.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/timer.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -79,7 +79,7 @@
 
         /* Set flags for custom GC mark and destroy. */
         PObj_custom_mark_SET(SELF);
-        PObj_active_destroy_SET(SELF);
+        PObj_custom_destroy_SET(SELF);
 
         /* Set up the core struct. */
         core_struct->id          = 0;

Modified: branches/context_pmc3/src/pmc/undef.pmc
==============================================================================
--- branches/context_pmc3/src/pmc/undef.pmc	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/pmc/undef.pmc	Thu Sep  3 10:17:39 2009	(r40952)
@@ -45,19 +45,28 @@
             VTABLE_set_pmc(INTERP, SELF, other);
         }
         else {
-            PMC * const class_ = PARROT_OBJECT(other)->_class;
-            PMC        *clone  = VTABLE_clone(interp, other);
-            void       *attrs;
+            PMC * const class_  = PARROT_OBJECT(other)->_class;
+            PMC        *clone   = VTABLE_clone(interp, other);
+            void       *attrs   = PMC_data(clone);
+            PMC        *meta    = PMC_metadata(clone);
             pmc_reuse_by_class(INTERP, SELF, class_, PObj_is_object_FLAG);
 
             /* now swap memory without leaking it */
-            attrs              = PMC_data(SELF);
-            PMC_data(SELF)     = PMC_data(clone);
-            PMC_data(clone)    = attrs;
-            VTABLE_destroy(interp, clone);
+            PMC_data(clone)     = PMC_data(SELF);
+            PMC_data(SELF)      = attrs;
 
-            PObj_is_object_SET(SELF);
+            /* Restore metadata. */
+            if (!PMC_IS_NULL(meta)) {
+                PMC * const iter = VTABLE_get_iter(interp, meta);
+                while (VTABLE_get_bool(interp, iter)) {
+                    STRING * const key = VTABLE_shift_string(interp, iter);
+                    PMC * const value  = VTABLE_get_pmc_keyed_str(interp, meta, key);
+                    VTABLE_setprop(interp, SELF, key, value);
+                }
+            }
+            PMC_data(clone) = NULL;
 
+            PObj_is_object_SET(SELF);
         }
     }
 

Modified: branches/context_pmc3/src/runcore/cores.c
==============================================================================
--- branches/context_pmc3/src/runcore/cores.c	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/src/runcore/cores.c	Thu Sep  3 10:17:39 2009	(r40952)
@@ -386,7 +386,7 @@
         PARROT_ASSERT(debugger);
 
         /* set the top of the stack so GC can trace it for GC-able pointers
-         * see trace_system_areas() in src/cpu_dep.c */
+         * see trace_system_areas() in src/gc/system.c */
         debugger->lo_var_ptr = interp->lo_var_ptr;
 
         pio = Parrot_io_STDERR(debugger);

Modified: branches/context_pmc3/t/op/box.t
==============================================================================
--- branches/context_pmc3/t/op/box.t	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/t/op/box.t	Thu Sep  3 10:17:39 2009	(r40952)
@@ -1,5 +1,5 @@
 #!parrot
-# Copyright (C) 2008, Parrot Foundation.
+# Copyright (C) 2008-2009, Parrot Foundation.
 # $Id$
 
 =head1 NAME
@@ -16,7 +16,7 @@
 
 =cut
 
-.const int TESTS = 24
+.const int TESTS = 26
 
 # must set these up before the hll_map calls later
 .sub '__setup' :immediate
@@ -33,6 +33,7 @@
     'box_int'()
     'box_num'()
     'box_string'()
+    'box_null_string'()
 
     .local pmc box_int_hll
     box_int_hll = get_root_global [ 'for_test' ], 'box_int'
@@ -93,7 +94,20 @@
     isa_ok( $P0, 'String', 'string boxed to appropriate base type from reg' )
 .end
 
+.sub 'box_null_string'
+    null $S0
+    $P0 = box $S0
+    $S1 = $P0
+    is( $S1, '', 'NULL STRING boxed to empty String PMC' )
+
+    $P1 = clone $P0
+    $S1 = $P0
+    is( $S1, '', '... and survives clone of boxed PMC (TT #964)' )
+
+.end
+
 .HLL 'for_test'
+
 .sub anon :anon :init
   .local pmc interp
   .local pmc cint, myint

Modified: branches/context_pmc3/t/op/gc.t
==============================================================================
--- branches/context_pmc3/t/op/gc.t	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/t/op/gc.t	Thu Sep  3 10:17:39 2009	(r40952)
@@ -1,20 +1,14 @@
-#!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 => 18;
+# $Id: string.t 40481 2009-08-11 06:09:35Z dukeleto $
 
 =head1 NAME
 
-t/op/gc.t - Garbage Collection
+t/op/gc.t - Garbage collection
 
 =head1 SYNOPSIS
 
-        % prove t/op/gc.t
+    % prove t/op/gc.t
 
 =head1 DESCRIPTION
 
@@ -23,117 +17,129 @@
 
 =cut
 
-pir_output_is( <<'CODE', '1', "sweep 1" );
 .include 'interpinfo.pasm'
+
 .sub main :main
-      $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS  # How many GC mark runs have we done already?
-      sweep 1
-      $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS  # Should be one more now
-      $I3 = $I2 - $I1
-      print $I3
+    .include 'test_more.pir'
+    plan(140)
+
+    sweep_1()
+    sweep_0()
+    sweep_0_need_destroy_obj()
+    sweep_0_need_destroy_destroy_obj()
+    collect_count()
+    collect_toggle()
+    collect_toggle_nested()
+    vanishing_singleton_PMC()
+    vanishing_ret_continuation()
+    regsave_marked()
+    recursion_and_exceptions()
+    write_barrier_1()
+    write_barrier_2()
+    addr_registry_1()
+    addr_registry_2_int()
+    addr_registry_2_str()
+    pmc_proxy_obj_mark()
+    coro_context_ret_continuation()
+    # END_OF_TESTS
+
 .end
-CODE
 
-pir_output_is( <<'CODE', '0', "sweep 0" );
-.include 'interpinfo.pasm'
-.sub main :main
-      $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS   # How many GC mark runs have we done already?
-      sweep 0
-      $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS  # Should be same
-      $I3 = $I2 - $I1
-      print $I3
-.end
-CODE
-
-pasm_output_is( <<'CODE', '1', "sweep 0, with object that need destroy" );
-      new P0, 'Undef'
-      interpinfo I1, 2   # How many GC mark runs have we done already?
-      needs_destroy P0
-      sweep 0
-      interpinfo I2, 2   # Should be one more now
-      sub I3, I2, I1
-      print I3
-      end
-CODE
-
-pasm_output_is( <<'CODE', '10', "sweep 0, with object that need destroy/destroy" );
-      new P0, 'Undef'
-      needs_destroy P0
-      interpinfo I1, 2   # How many GC mark runs have we done already?
-      new P0, 'Undef'    # kill object
-      sweep 0
-      interpinfo I2, 2   # Should be one more now
-      sub I3, I2, I1
-      sweep 0
-      interpinfo I4, 2   # Should be same as last
-      sub I5, I4, I2
-      print I3           # These create PMCs that need early GC, so we need
-      print I5           # to put them after the second sweep op.
-      end
-CODE
+.sub sweep_1
+    $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS  # How many GC mark runs have we done already?
+    sweep 1
+    $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS  # Should be one more now
+    $I3 = $I2 - $I1
+    is($I3,1)
+.end
 
-pir_output_is( <<'CODE', '1', "collect" );
-.include 'interpinfo.pasm'
-.sub main :main
-      $I1 = interpinfo .INTERPINFO_GC_COLLECT_RUNS   # How many garbage collections have we done already?
-      collect
-      $I2 = interpinfo .INTERPINFO_GC_COLLECT_RUNS  # Should be one more now
-      $I3 = $I2 - $I1
-      print $I3
-.end
-CODE
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "collectoff/on" );
-      interpinfo I1, 3
-      collectoff
-      collect
-      interpinfo I2, 3
-      sub I3, I2, I1
-      print I3
-      print "\n"
-
-      collecton
-      collect
-      interpinfo I4, 3
-      sub I6, I4, I2
-      print I6
-      print "\n"
-
-      end
-CODE
-0
-1
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUTPUT', "Nested collectoff/collecton" );
-      interpinfo I1, 3
-      collectoff
-      collectoff
-      collecton
-      collect           # This shouldn't do anything...    #'
-      interpinfo I2, 3
-      sub I3, I2, I1
-      print I3
-      print "\n"
-
-      collecton
-      collect           # ... but this should
-      interpinfo I4, 3
-      sub I6, I4, I2
-      print I6
-      print "\n"
-
-      end
-CODE
-0
-1
-OUTPUT
 
-pir_output_is( <<'CODE', <<OUTPUT, "vanishing singleton PMC" );
-.sub main :main
+.sub sweep_0
+    $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS   # How many GC mark runs have we done already?
+    sweep 0
+    $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS  # Should be same
+    $I3 = $I2 - $I1
+    is($I3,0)
+.end
+
+
+# sweep 0, with object that needs destroy/destroy
+.sub sweep_0_need_destroy_obj
+    $P0 = new 'Undef'
+    $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS   # How many GC mark runs have we done already?
+    needs_destroy $P0
+    sweep 0
+    $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS   # Should be one more now
+    $I3 = $I2 - $I1
+    is($I3,1)
+.end
+
+
+# sweep 0, with object that needs destroy/destroy
+.sub sweep_0_need_destroy_destroy_obj
+    $P0 = new 'Undef'
+    needs_destroy $P0
+    $I1 = interpinfo .INTERPINFO_GC_MARK_RUNS   # How many GC mark runs have we done already?
+    $P0 = new 'Undef'  #kill object
+    sweep 0
+    $I2 = interpinfo .INTERPINFO_GC_MARK_RUNS   # Should be one more now
+    $I3 = $I2 - $I1
+    sweep 0
+    $I4 = interpinfo .INTERPINFO_GC_MARK_RUNS   # Should be same as last
+    $I5 = $I4 - $I2
+    is($I3,1)
+    is($I5,0)
+.end
+
+
+.sub collect_count
+    $I1 = interpinfo .INTERPINFO_GC_COLLECT_RUNS   # How many garbage collections have we done already?
+    collect
+    $I2 = interpinfo .INTERPINFO_GC_COLLECT_RUNS  # Should be one more now
+    $I3 = $I2 - $I1
+    is($I3,1)
+.end
+
+
+.sub collect_toggle
+    $I1 = interpinfo .INTERPINFO_GC_COLLECT_RUNS
+    collectoff
+    collect
+    $I2 = interpinfo .INTERPINFO_GC_COLLECT_RUNS
+    $I3 = $I2 - $I1
+    is($I3,0)
+
+    collecton
+    collect
+    $I4 = interpinfo .INTERPINFO_GC_COLLECT_RUNS
+    $I6 = $I4 - $I2
+    is($I6,1)
+.end
+
+
+.sub collect_toggle_nested
+    $I1 = interpinfo .INTERPINFO_GC_COLLECT_RUNS
+    collectoff
+    collectoff
+    collecton
+    collect           # This shouldn't do anything...    #'
+    $I2 = interpinfo .INTERPINFO_GC_COLLECT_RUNS
+    $I3 = $I2 - $I1
+    is($I3,0)
+
+    collecton
+    collect           # ... but this should
+    $I4 = interpinfo .INTERPINFO_GC_COLLECT_RUNS
+    $I6 = $I4 - $I2
+    is($I6,1)
+
+.end
+
+
+.sub vanishing_singleton_PMC
     $P16 = new 'Env'
     $P16['Foo'] = 'bar'
-    $I16 = 100
+    $I16 = 100    #Why 100?
     $I17 = 0
 
     loop:
@@ -141,38 +147,27 @@
     	_rand()
     	$I17 += 1
     	if $I17 <= $I16 goto loop
-   	say "ok"
 .end
 
 .sub _rand
     $P16 = new 'Env'
     $P5 = $P16['Foo']
+    is($P5, 'bar')
     if $P5 != 'bar' goto err
     .return()
     err:
-	say "singleton destroyed .Env = ."
+	print "singleton destroyed .Env = ."
     	$P16 = new 'Env'
     	$S16 = typeof $P16
     	say $S16
 .end
+# END: vanishing_singleton_PMC
 
-CODE
-ok
-OUTPUT
-
-pir_output_is( <<'CODE', <<OUTPUT, "vanishing return continuation in method calls" );
-.sub main :main
-    .local pmc o, cl
-    cl = newclass "Foo"
-
-    new o, "Foo"
-    print "ok\n"
-    end
-.end
 
+# vanishing return continuation in method calls
 .namespace ["Foo"]
 .sub init :vtable :method
-    print "init\n"
+    ok(1, "entered init()")
     sweep 1
     new $P6, 'String'
     set $P6, "hi"
@@ -184,105 +179,81 @@
     sweep 1
     inc self
     sweep 1
-    print "back from _inc\n"
+    ok(1, "leaving do_inc")
 .end
 
 .sub __increment :method
-    print "inc\n"
+    ok(1, "in __increment")
     sweep 1
 .end
-CODE
-init
-inc
-back from _inc
-ok
-OUTPUT
-
-pasm_output_is( <<'CODE', <<OUTPUT, "failing if regsave is not marked" );
-    newclass P9, "Source"
-    newclass P10, "Source::Buffer"
-    new P12, "Source"
-
-    set S20, P12
-    print S20
-    set S20, P12
-    print S20
-    end
+.namespace [ ]
+
+.sub vanishing_ret_continuation
+    .local pmc o, cl
+    cl = newclass 'Foo'
+    o = new 'Foo'
+    ok(1)
+.end
 
+# END: vanishing_return_continuation
+
+
+
+#Fail if regsave is not marked
 .namespace ["Source"]
-.pcc_sub __get_string:  # buffer
-    get_params "0", P2
-    getprop P12, "buffer", P2
+.sub get_string :method :vtable # buffer
+    $P4  = self
+    $P2 = getprop "buffer", $P4
     sweep 1
-    unless_null P12, buffer_ok
-    new P12, "Source::Buffer"
-    new P14, 'String'
-    set P14, "hello\n"
-    setprop P12, "buf", P14
-    setprop P2, "buffer", P12
+    unless_null $P2, buffer_ok
+    $P2 = new "Source::Buffer"
+    $P3 = new "String"
+    $P3 = "hello"
+    $P2 = setprop "buf", $P3
+    $P4  = setprop "buffer", $P2
 buffer_ok:
-    set_returns "0", P12
-    returncc
+    .return($P2)
+.end
 
 .namespace ["Source::Buffer"]
-.pcc_sub __get_string:
-    get_params "0", P2
+.sub get_string :method :vtable
+    $P4 = self
     sweep 1
-    getprop P12, "buf", P2
-    set S16, P12
-    set_returns "0", S16
-    returncc
-CODE
-hello
-hello
-OUTPUT
+    $P2 = getprop "buf", $P4
+    $S0 = $P2
+    .return($S0)
+.end
 
-# this is a stripped down version of imcc/t/syn/pcc_16
-# s. also src/pmc/retcontinuation.pmc
-pasm_output_is( <<'CODE', <<OUTPUT, "coro context and invalid return continuations" );
-.pcc_sub main:
-    .const 'Sub' P0 = "co1"
-    set I20, 0
-l:
-    get_results ''
-    set_args ''
-    invokecc P0
-    inc I20
-    lt I20, 3, l
-    print "done\n"
-    end
-.pcc_sub co1:
-    get_params ''
-    set P17, P1
-col:
-    print "coro\n"
-    sweep 1
-    yield
-    branch col
+.namespace [ ]
 
-CODE
-coro
-coro
-coro
-done
-OUTPUT
+.sub regsave_marked
+    $P0  = newclass "Source"
+    $P1 = newclass "Source::Buffer"
+    $P2 = new "Source"
 
-pir_output_is( <<'CODE', <<OUTPUT, "Recursion and exceptions" );
+    $S1 = $P2
+    is($S1, "hello")
 
-# this did segfault with GC_DEBUG
+    $S1 = $P2        #why are we doing this twice?
+    is($S1, "hello")
+.end
 
-.sub main :main
+# end regsave_marked()
+
+
+# Recursion and exceptions
+# NOTE: this did segfault with GC_DEBUG
+.sub recursion_and_exceptions
     .local pmc n
     $P0 = getinterp
     $P0."recursion_limit"(10)
-    newclass $P0, "b"
+    $P0 = newclass "b"
     $P0 = new "b"
     $P1 = new 'Integer'
     $P1 = 0
     n = $P0."b11"($P1)
-    print "ok 1\n"
-    print n
-    print "\n"
+    ok(1)
+    is(n,8)
 .end
 .namespace ["b"]
 .sub b11 :method
@@ -292,7 +263,8 @@
     # store_lex -1, "n", n
     n1 = new 'Integer'
     n1 = n + 1
-    push_eh catch
+    push_eh catch    # we're going to catch an exception when recursion_depth
+                     # is too large
     n = self."b11"(n1)
     # store_lex -1, "n", n
     pop_eh
@@ -300,233 +272,176 @@
     # n = find_lex "n"
     .return(n)
 .end
-CODE
-ok 1
-9
-OUTPUT
-
-pasm_output_is( <<'CODE', <<OUTPUT, "write barrier 1" );
-    null I2
-    set I3, 100
+.namespace [ ]
+
+# write barrier 1
+.sub write_barrier_1
+    null $I2
+    $I3 = 100
 lp3:
-    null I0
-    set I1, 1000
-    new P1, 'ResizablePMCArray'
+    null $I0
+    $I1 = 1000
+    $P1 = new 'ResizablePMCArray'
 lp1:
-    new P2, 'ResizablePMCArray'
-    new P0, 'Integer'
-    set P0, I0
-    set P2[0], P0
-    set P1[I0], P2
-    if I0, not_0
-    needs_destroy P0
-    # force marking past P2[0]
+    $P2 = new 'ResizablePMCArray'
+    $P0 = new 'Integer'
+    $P0 = $I0
+    $P2[0] = $P0
+    $P1[$I0] = $P2
+    if $I0, not_0
+    needs_destroy $P0
+    # force marking past $P2[0]
     sweep 0
 not_0:
-    new P3, 'Undef'
-    new P4, 'Undef'
-    inc I0
-    lt I0, I1, lp1
+    $P3 = new 'Undef'
+    $P4 = new 'Undef'
+    inc $I0
+    lt $I0, $I1, lp1
 
-    null I0
+    null $I0
     # trace 1
 lp2:
-    set P2, P1[I0]
-    set P2, P2[0]
-    eq P2, I0, ok
+    $P2 = $P1[$I0]
+    $P2 = $P2[0]
+    eq $P2, $I0, ok
     print "nok\n"
     print "I0: "
-    print I0
+    print $I0
     print " P2: "
-    print P2
+    print $P2
     print " type: "
-    typeof S0, P2
-    print S0
+    $S0 = typeof $P2
+    print $S0
     print " I2: "
-    print I2
+    print $I2
     print "\n"
     exit 1
 ok:
-    inc I0
-    lt I0, I1, lp2
-    inc I2
-    lt I2, I3, lp3
-    print "ok\n"
-    end
-CODE
-ok
-OUTPUT
-
-pasm_output_is( <<'CODE', <<OUTPUT, "write barrier 2 - hash" );
-    null I2
-    set I3, 100
+    inc $I0
+    lt $I0, $I1, lp2
+    inc $I2
+    lt $I2, $I3, lp3
+    ok(1)
+.end
+
+
+# write barrier 2 - hash
+.sub write_barrier_2
+    null $I2
+    $I3 = 100
 lp3:
-    null I0
-    set I1, 100
-    new P1, 'Hash'
+    null $I0
+    $I1 = 100
+    $P1 = new 'Hash'
 lp1:
-    new P2, 'Hash'
-    new P0, 'Integer'
-    set P0, I0
-    set S0, I0
-    set P2["first"], P0
-    set P1[S0], P2
-    if I0, not_0
-    new P0, 'Integer'
-    needs_destroy P0
-    null P0
+    $P2 = new 'Hash'
+    $P0 = new 'Integer'
+    $P0 = $I0
+    $S0 = $I0
+    $P2["first"] = $P0
+    $P1[$S0] = $P2
+    if $I0, not_0
+    $P0 = new 'Integer'
+    needs_destroy $P0
+    null $P0
     # force full sweep
     sweep 0
 not_0:
-    new P3, 'Undef'
-    new P4, 'Undef'
-    inc I0
-    lt I0, I1, lp1
+    $P3 = new 'Undef'
+    $P4 = new 'Undef'
+    inc $I0
+    lt $I0, $I1, lp1
 
-    null I0
+    null $I0
     # trace 1
 lp2:
-    set S0, I0
-    set P2, P1[S0]
-    set P2, P2["first"]
-    eq P2, I0, ok
+    $S0 = $I0
+    $P2 = $P1[$S0]
+    $P2 = $P2["first"]
+    eq $P2, $I0, ok
     print "nok\n"
     print "I0: "
-    print I0
+    print $I0
     print " P2: "
-    print P2
+    print $P2
     print " type: "
-    typeof S0, P2
-    print S0
+    $S0 = typeof $P2
+    print $S0
     print " I2: "
-    print I2
+    print $I2
     print "\n"
     exit 1
 ok:
-    inc I0
-    lt I0, I1, lp2
-    inc I2
-    lt I2, I3, lp3
-    print "ok\n"
-    end
-CODE
-ok
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "verify pmc proxy object marking" );
-.sub main :main
-    .local pmc cl, s, t
-    cl = subclass "String", "X"
-    addattribute cl, "o3"
-    addattribute cl, "o4"
-    s = new "X"
-    $P0 = new 'String'
-    $S0 = "ok" . " 3\n"
-    $P0 = $S0
-    setattribute s, "o3", $P0
-    $P0 = new 'String'
-    $S0 = "ok" . " 4\n"
-    $P0 = $S0
-    setattribute s, "o4", $P0
-    null $P0
-    null $S0
-    null cl
-    sweep 1
-    s = "ok 1\n"
-    print s
-    .local int i
-    i = 0
-lp:
-    t = new "X"
-    inc i
-    if i < 1000 goto lp
-    t = "ok 2\n"
-    print s
-    print t
-    $P0 = getattribute s, "o3"
-    print $P0
-    $P0 = getattribute s, "o4"
-    print $P0
+    inc $I0
+    lt $I0, $I1, lp2
+    inc $I2
+    lt $I2, $I3, lp3
+    ok(1)
 .end
-CODE
-ok 1
-ok 1
-ok 2
-ok 3
-ok 4
-OUTPUT
 
-pir_output_is( <<'CODE', <<'OUTPUT', "AddrRegistry 1" );
-.sub main :main
+
+
+# AddrRegistry 1
+.sub addr_registry_1
     .local pmc a, reg, nil
     reg = new 'AddrRegistry'
     a = new 'String'
     null nil
     $I0 = reg[a]
     if $I0 == 0 goto ok1
-    print "not "
+    notok(1)
 ok1:
-    print "ok 1\n"
+    ok(1, "ok 1")
     reg[a] = nil
     $I0 = reg[a]
     if $I0 == 1 goto ok2
-    print "not "
+    notok(1)
 ok2:
-    print "ok 2\n"
+    ok(1, "ok 2")
     reg[a] = nil
     $I0 = reg[a]
     if $I0 == 2 goto ok3
-    print "not "
+    notok(1)
 ok3:
-    print "ok 3\n"
-
+    ok(1, "ok 3")
     delete reg[a]
     $I0 = reg[a]
     if $I0 == 1 goto ok4
-    print "not "
+    notok(1)
 ok4:
-    print "ok 4\n"
+    ok(1, "ok 4")
     delete reg[a]
     $I0 = reg[a]
     if $I0 == 0 goto ok5
-    print "not "
+    notok(1)
 ok5:
-    print "ok 5\n"
+    ok(1, "ok 5")
 .end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-ok 5
-OUTPUT
 
-pir_output_is( <<'CODE', <<'OUTPUT', "AddrRegistry 2" );
-.sub main :main
+
+# AddrRegistry 2
+.sub addr_registry_2_int
     .local pmc a, b, reg, nil
     null nil
     reg = new 'AddrRegistry'
     a = new 'String'
     b = new 'String'
     $I0 = elements reg
-    print $I0
+    is($I0, 0)
     reg[a] = nil
     $I0 = elements reg
-    print $I0
+    is($I0, 1)
     reg[a] = nil
     $I0 = elements reg
-    print $I0
+    is($I0, 1)
     reg[b] = nil
     $I0 = elements reg
-    print $I0
-    print "\n"
+    is($I0, 2)
 .end
-CODE
-0112
-OUTPUT
 
-pir_output_is( <<'CODE', <<'OUTPUT', "AddrRegistry 2" );
-.sub main :main
+
+# AddrRegistry 2
+.sub addr_registry_2_str
     .local pmc a, b, c, reg, nil, it
     null nil
     reg = new 'AddrRegistry'
@@ -551,12 +466,71 @@
 done:
     $P1.'sort'()
     $S1 = join '', $P1
-    print $S1
-    print "\n"
+    is($S1, 'k1k2k3')
+.end
+
+# verify pmc proxy object marking
+.sub pmc_proxy_obj_mark
+    .local pmc cl, s, t
+    cl = subclass "String", "X"
+    addattribute cl, "o3"
+    addattribute cl, "o4"
+    s = new "X"
+    $P0 = new 'String'
+    $S0 = "ok" . " 3"
+    $P0 = $S0
+    setattribute s, "o3", $P0
+    $P0 = new 'String'
+    $S0 = "ok" . " 4"
+    $P0 = $S0
+    setattribute s, "o4", $P0
+    null $P0
+    null $S0
+    null cl
+    sweep 1
+    s = "ok 1"
+    is(s, "ok 1")
+    .local int i
+    i = 0
+lp:
+    t = new "X"
+    inc i
+    if i < 1000 goto lp
+    t = "ok 2"
+    is(s, "ok 1")
+    is(t, "ok 2")
+    $P0 = getattribute s, "o3"
+    is($P0, "ok 3")
+    $P0 = getattribute s, "o4"
+    is($P0, "ok 4")
+.end
+
+
+# coro context and invalid return continuations
+# this is a stripped down version of imcc/t/syn/pcc_16
+# s. also src/pmc/retcontinuation.pmc
+
+.sub coro_context_ret_continuation
+    .const 'Sub' $P0 = "co1"
+    $I20 = 0
+l:
+    get_results ''
+    set_args ''
+    invokecc $P0
+    inc $I20
+    lt $I20, 3, l
+    ok(1, "done\n")
+.end
+
+.sub co1
+    get_params ''
+    $P17 = $P1
+col:
+    ok(1, "coro\n")
+    sweep 1
+    yield
+    branch col
 .end
-CODE
-k1k2k3
-OUTPUT
 
 =head1 SEE ALSO
 
@@ -567,11 +541,9 @@
 F<examples/benchmarks/primes2.c>,
 F<examples/benchmarks/primes2.py>.
 
-=cut
-
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4
 #   fill-column: 100
 # End:
-# vim: expandtab shiftwidth=4:
+# vim: expandtab shiftwidth=4 filetype=pir:

Modified: branches/context_pmc3/t/op/string.t
==============================================================================
--- branches/context_pmc3/t/op/string.t	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/t/op/string.t	Thu Sep  3 10:17:39 2009	(r40952)
@@ -1,5 +1,5 @@
 #!perl
-# Copyright (C) 2001-2008, Parrot Foundation.
+# Copyright (C) 2001-2009, Parrot Foundation.
 # $Id$
 
 use strict;
@@ -7,7 +7,7 @@
 use lib qw( . lib ../lib ../../lib );
 
 use Test::More;
-use Parrot::Test tests => 166;
+use Parrot::Test tests => 167;
 use Parrot::Config;
 
 =head1 NAME
@@ -55,6 +55,13 @@
 Bar
 OUTPUT
 
+pasm_output_is( <<'CODE', <<'OUTPUT', 'clone null' );
+    null S0
+    clone S1, S0
+    end
+CODE
+OUTPUT
+
 pasm_output_is( <<'CODE', '4', 'length_i_s' );
     set I4, 0
     set S4, "JAPH"

Added: branches/context_pmc3/t/pmc/integer-old.t
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/context_pmc3/t/pmc/integer-old.t	Thu Sep  3 10:17:39 2009	(r40952)
@@ -0,0 +1,54 @@
+#!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/context_pmc3/t/pmc/integer.t
==============================================================================
--- branches/context_pmc3/t/pmc/integer.t	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/t/pmc/integer.t	Thu Sep  3 10:17:39 2009	(r40952)
@@ -1,14 +1,7 @@
-#!perl
-# Copyright (C) 2001-2008, Parrot Foundation.
+#!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 => 19;
-
 =head1 NAME
 
 t/pmc/integer.t - Integer basic type
@@ -23,372 +16,297 @@
 
 =cut
 
-pir_output_is( << 'CODE', << 'OUTPUT', "basic math" );
+.sub 'test' :main
+    .include 'test_more.pir'
+
+    plan(58)
+    test_basic_math()
+    test_truthiness_and_definedness()
+    test_set_string_native()
+    test_isa()
+    test_interface()
+    test_ne()
+    test_gt()
+    test_ge()
+    test_istrue_isfalse()
+    test_if_unless()
+    test_add()
+    test_arithmetic()
+    test_get_as_base()
+    test_get_as_base10()
+    test_get_as_base_various()
+    test_cmp_subclass()
+    test_cmp_RT59336()
+.end
 
-.sub _main
+
+.sub test_basic_math
     .local pmc int_1
     int_1 = new ['Integer']
-    print int_1
-    print "\n"
+    is(int_1,0)
     int_1 = 1
-    print int_1
-    print "\n"
+    is(int_1,1)
     int_1 += 777777
     int_1 -= 777776
-    print int_1
-    print "\n"
+    is(int_1,2)
     int_1 *= -333333
     int_1 /= -222222
-    print int_1
-    print "\n"
+    is(int_1,3)
     inc int_1
     inc int_1
     dec int_1
-    print int_1
-    print "\n"
+    is(int_1,4)
     neg int_1
     dec int_1
     neg int_1
-    print int_1
-    print "\n"
-    end
+    is(int_1,5)
 .end
-CODE
-0
-1
-2
-3
-4
-5
-OUTPUT
 
-pir_output_is( << 'CODE', << 'OUTPUT', "truth and definedness" );
 
-.sub _main
+.sub test_truthiness_and_definedness
     .local pmc int_1
     int_1 = new ['Integer']
 
-    print "A newly created Integer is "
-    if int_1 goto LABEL_1
-    print "not "
-LABEL_1:
-    print "true.\n"
+    nok(int_1, "A newly created Integer is not true")
 
     .local int is_defined
 
     is_defined = defined int_1
-    print "A newly created Integer is "
-    if is_defined goto LABEL_2
-    print " not "
-LABEL_2:
-    print "defined.\n"
+
+    nok(int_1, "A newly created Integer is not defined")
 
     int_1 = -999999999
-    print "The Integer "
-    print int_1
-    print " is "
-    if is_defined goto LABEL_3
-    print "not "
-LABEL_3:
-    print "true.\n"
+
+    ok(int_1, "-999999999 is true")
 
     is_defined = defined int_1
-    print "The Integer "
-    print int_1
-    print " is "
-    if is_defined goto LABEL_4
-    print "not "
-LABEL_4:
-    print "defined.\n"
-    end
+
+    ok(int_1, "-999999999 is defined")
+
 .end
-CODE
-A newly created Integer is not true.
-A newly created Integer is defined.
-The Integer -999999999 is true.
-The Integer -999999999 is defined.
-OUTPUT
 
-pir_output_is( <<'CODE', <<'OUTPUT', "set_string_native" );
 
-.sub _main
+.sub test_set_string_native
     .local pmc pmc1
     pmc1 = new ['Integer']
     pmc1 = "-123456789"
-    print pmc1
-    print "\n"
-    end
+    is(pmc1, -123456789)
 .end
-CODE
--123456789
-OUTPUT
 
-pir_output_is( <<'CODE', <<'OUTPUT', "isa" );
 
-.sub _main
+.sub test_isa
     .local pmc pmc1
     pmc1 = new ['Integer']
 
     .local int pmc1_is_a
     pmc1_is_a = isa pmc1, "Integer"
-    print "A newly created Integer is "
-    if pmc1_is_a goto PMC1_IS_A_INTEGER
-      print "not "
-PMC1_IS_A_INTEGER:
-    print "an Integer.\n"
-
-    end
+    isa_ok(pmc1, "Integer")
 .end
-CODE
-A newly created Integer is an Integer.
-OUTPUT
 
-pir_output_is( << 'CODE', << 'OUTPUT', "check whether interface is done" );
-
-.sub _main
+.sub test_interface
     .local pmc pmc1
     pmc1 = new ['Integer']
     .local int bool1
     does bool1, pmc1, "scalar"
-    print bool1
-    print "\n"
+    is(bool1,1)
     does bool1, pmc1, "integer"
-    print bool1
-    print "\n"
+    is(bool1,1)
     does bool1, pmc1, "no_interface"
-    print bool1
-    print "\n"
-    end
+    is(bool1,0)
 .end
-CODE
-1
-1
-0
-OUTPUT
 
-pir_output_is( << 'CODE', << 'OUTPUT', "Comparison ops: ne" );
-
-.sub _main
+.sub test_ne
     .local pmc pmc1
     pmc1 = new ['Integer']
     .local int int1
     pmc1 = 10
     int1 = 20
     ne pmc1, int1, OK1
-    print "not "
+    ok(0)
+    goto next_test
 OK1:
-    print "ok 1\n"
+    ok(1)
+
+next_test:
+
     int1 = 10
     ne pmc1, int1, BAD2
     branch OK2
 BAD2:
-    print "not "
+    ok(0)
+    goto fin
 OK2:
-    print "ok 2\n"
-    end
+    ok(1)
+fin:
 .end
-CODE
-ok 1
-ok 2
-OUTPUT
 
-pir_output_is( << 'CODE', << 'OUTPUT', "Comparison ops: gt" );
 
-.sub _main
+.sub test_gt
     .local pmc pmc1
     pmc1 = new ['Integer']
     .local int int1
     pmc1 = 10
     int1 = 5
     gt pmc1, int1, OK1
-    print "not "
+    ok(0)
+    goto next_test1
 OK1:
-    print "ok 1\n"
+    ok(1)
+
+next_test1:
     int1 = 10
     gt pmc1, int1, BAD2
     branch OK2
 BAD2:
-    print "not "
+    ok(0)
 OK2:
-    print "ok 2\n"
+    ok(1)
+
+next_test2:
     int1 = 20
     gt pmc1, int1, BAD3
     branch OK3
 BAD3:
-    print "not "
+    ok(0)
+    goto fin
 OK3:
-    print "ok 3\n"
-    end
+    ok(1)
+fin:
 .end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
 
-pir_output_is( << 'CODE', << 'OUTPUT', "Comparison ops: ge" );
 
-.sub _main
+.sub test_ge
     .local pmc pmc1
     pmc1 = new ['Integer']
     .local int int1
     pmc1 = 10
     int1 = 5
     ge pmc1, int1, OK1
-    print "not "
+    ok(0)
+    goto next_test1
 OK1:
-    print "ok 1\n"
+    ok(1)
     int1 = 10
+
+next_test1:
     ge pmc1, int1, OK2
-    print "not "
+    ok(0)
+    goto next_test2
 OK2:
-    print "ok 2\n"
+    ok(1)
     int1 = 20
+next_test2:
     ge pmc1, int1, BAD3
     branch OK3
 BAD3:
-    print "not "
+    ok(0)
+    goto fin
 OK3:
-    print "ok 3\n"
-    end
+    ok(1)
+fin:
 .end
-CODE
-ok 1
-ok 2
-ok 3
-OUTPUT
 
-pir_output_is( << 'CODE', << 'OUTPUT', "Logical ops: istrue & isfalse" );
 
-.sub _main
+.sub test_istrue_isfalse
     .local pmc pmc1
     pmc1 = new ['Integer']
     .local int int1
     pmc1 = 10
     istrue int1, pmc1
-    print int1
-    print "\n"
+    is(1,int1)
     isfalse int1, pmc1
-    print int1
-    print "\n"
+    is(0,int1)
     pmc1 = 0
     istrue int1, pmc1
-    print int1
-    print "\n"
+    is(0,int1)
     isfalse int1, pmc1
-    print int1
-    print "\n"
-
-    end
+    is(1,int1)
 .end
-CODE
-1
-0
-0
-1
-OUTPUT
 
-pasm_output_is( <<'CODE', <<'OUTPUT', "if/unless with Integer PMC" );
-      new P0, ['Integer']
-      set P0, 10
-      if P0, OK1
-      print "not "
-OK1:  print "ok 1\n"
-      unless P0, BAD2
+
+.sub test_if_unless
+      new $P0, ['Integer']
+      set $P0, 10
+      if $P0, OK1
+      ok(0)
+      goto test1
+OK1:
+      ok(1)
+test1:
+      unless $P0, BAD2
       branch OK2
-BAD2: print "not "
-OK2:  print "ok 2\n"
-      set P0, 0
-      if P0, BAD3
+BAD2:
+      ok(0)
+      goto test2
+OK2:
+      ok(1)
+      set $P0, 0
+test2:
+      if $P0, BAD3
       branch OK3
-BAD3: print "not "
-OK3:  print "ok 3\n"
-      unless P0, OK4
-      print "not "
-OK4:  print "ok 4\n"
-      end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-OUTPUT
-
-pasm_output_is( <<'CODE', <<'OUT', "add" );
-   new P0, ['Integer']
-   set P0, 5
-   new P1, ['Integer']
-   set P1, 10
-   new P2, ['Integer']
-   add P2, P0, P1
-   set S0, P2
-   print S0
-   print "\n"
-   set P0, "20"
-   set P1, "30"
-   add P2, P1, P0
-   set S0, P2
-   print S0
-   print "\n"
-   end
-CODE
-15
-50
-OUT
+BAD3:
+      ok(0)
+      goto test3
+OK3:
+      ok(1)
+test3:
+      unless $P0, OK4
+      ok(0)
+      goto fin
+OK4:
+      ok(1)
+fin:
+.end
+
+.sub test_add
+   new $P0, ['Integer']
+   set $P0, 5
+   new $P1, ['Integer']
+   set $P1, 10
+   new $P2, ['Integer']
+   add $P2, $P0, $P1
+   set $S0, $P2
+   is($S0,15)
+   set $P0, "20"
+   set $P1, "30"
+   add $P2, $P1, $P0
+   set $S0, $P2
+   is($S0,50)
+.end
 
-pir_output_is( << 'CODE', << 'OUTPUT', "<oper>" );
-.sub main :main
+.sub test_arithmetic
     $P0 = new ['Integer']
     $P1 = new ['Integer']
     set $P0, 6
     set $P1, 2
 
     add $P2, $P0, $P1
-    print $P2
-    print "\n"
+    is($P2,8)
     $P2 = add $P0, $P1
-    print $P2
-    print "\n"
+    is($P2,8)
     sub $P2, $P0, $P1
-    print $P2
-    print "\n"
+    is($P2,4)
     mul $P2, $P0, $P1
-    print $P2
-    print "\n"
+    is($P2,12)
     div $P2, $P0, $P1
-    print $P2
-    print "\n"
+    is($P2,3)
     mod $P2, $P0, $P1
-    print $P2
-    print "\n"
+    is($P2,0)
     pow $P2, $P0, $P1
-    print $P2
-    print "\n"
+    is($P2,36)
 .end
-CODE
-8
-8
-4
-12
-3
-0
-36
-OUTPUT
 
-pir_output_is( <<'CODE', <<'OUTPUT', "can get_as_base()" );
-.sub main :main
+
+.sub test_get_as_base
     $P0 = new ['Integer']
     $P0 = 42
     $I0 = can $P0, 'get_as_base'
-    if $I0, OK
-    print "not "
-OK: print "ok\n"
+    ok($I0,'Integers can get_as_base')
 .end
-CODE
-ok
-OUTPUT
 
-pir_error_output_like( <<'CODE', <<'OUTPUT', "get_as_base() bounds check" );
+=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
@@ -418,84 +336,55 @@
 .*/
 OUTPUT
 
-pir_output_is( <<'CODE', <<'OUTPUT', "get_as_base(10)" );
-.sub main :main
+=cut
+
+.sub test_get_as_base10
     $P0 = new ['Integer']
     $P0 = 42
 
     $S0 = $P0.'get_as_base'(10)
-
-    print $S0
-    print "\n"
+    is($S0,42)
 .end
-CODE
-42
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "get_as_base(various)" );
-.sub main :main
-    .local pmc jmpstack
-    jmpstack = new 'ResizableIntegerArray'
 
+.sub test_get_as_base_various
     $P0 = new ['Integer']
     $P0 = 42
 
     $S0 = $P0.'get_as_base'(2)
-    local_branch jmpstack, PRINT
+    is($S0,101010)
 
     $S0 = $P0.'get_as_base'(3)
-    local_branch jmpstack, PRINT
+    is($S0,1120)
 
     $S0 = $P0.'get_as_base'(5)
-    local_branch jmpstack, PRINT
+    is($S0,132)
 
     $S0 = $P0.'get_as_base'(7)
-    local_branch jmpstack, PRINT
+    is($S0,60)
 
     $S0 = $P0.'get_as_base'(11)
-    local_branch jmpstack, PRINT
+    is($S0,39)
 
     $S0 = $P0.'get_as_base'(13)
-    local_branch jmpstack, PRINT
+    is($S0,33)
 
     $S0 = $P0.'get_as_base'(17)
-    local_branch jmpstack, PRINT
+    is($S0,28)
 
     $S0 = $P0.'get_as_base'(19)
-    local_branch jmpstack, PRINT
+    is($S0,24)
 
     $S0 = $P0.'get_as_base'(23)
-    local_branch jmpstack, PRINT
+    is($S0,'1j')
 
     $S0 = $P0.'get_as_base'(29)
-    local_branch jmpstack, PRINT
+    is($S0,'1d')
 
     $S0 = $P0.'get_as_base'(31)
-    local_branch jmpstack, PRINT
-    goto END
-
-PRINT:
-    print $S0
-    print "\n"
-    local_return jmpstack
-END:
+    is($S0,'1b')
 .end
-CODE
-101010
-1120
-132
-60
-39
-33
-28
-24
-1j
-1d
-1b
-OUTPUT
 
-pir_output_is( <<'CODE', <<'OUTPUT', 'cmp functions for subclasses' );
-.sub main :main
+.sub test_cmp_subclass
     $P0 = subclass 'Integer', 'Int'
 
     $P1 = new ['Int']
@@ -504,43 +393,32 @@
     $P2 = 2
 
     $I0 = cmp $P1, $P2
-    say $I0
+    is($I0,-1)
     $I0 = cmp $P1, $P1
-    say $I0
+    is($I0,0)
     $I0 = cmp $P2, $P1
-    say $I0
+    is($I0,1)
 .end
-CODE
--1
-0
-1
-OUTPUT
 
-pir_output_is( <<'CODE', <<'OUTPUT', 'cmp for Integers more than 2^31 apart, RT #59336' );
-.sub 'main' :main
+.sub test_cmp_RT59336
     $P0 = new ['Integer']
     $P0 = 2147483600
 
-  test_10:
-    print $P0
-    print " is"
-    if $P0 > -10 goto skip_10
-    print " not"
-  skip_10:
-    say " greater than -10"
-
-  test_1000:
-    print $P0
-    print " is"
-    if $P0 > -1000 goto skip_1000
-    print " not"
-  skip_1000:
-    say " greater than -1000"
+test_10:
+    if $P0 > -10 goto pass
+    ok(0)
+    goto test_1000
+pass:
+    ok(1)
+
+test_1000:
+    if $P0 > -1000 goto pass2
+    ok(0)
+    goto fin
+pass2:
+    ok(1)
+fin:
 .end
-CODE
-2147483600 is greater than -10
-2147483600 is greater than -1000
-OUTPUT
 
 # Local Variables:
 #   mode: cperl

Modified: branches/context_pmc3/t/pmc/packfiledirectory.t
==============================================================================
--- branches/context_pmc3/t/pmc/packfiledirectory.t	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/t/pmc/packfiledirectory.t	Thu Sep  3 10:17:39 2009	(r40952)
@@ -136,7 +136,7 @@
   delete_seg:
     delete pfdir[$S0]
     dec $I0
-    $I1   = elements pfdir
+    $I1 = elements pfdir
     is($I0, $I1, "segment deleted")
 
   done:

Modified: branches/context_pmc3/t/pmc/packfilerawsegment.t
==============================================================================
--- branches/context_pmc3/t/pmc/packfilerawsegment.t	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/t/pmc/packfilerawsegment.t	Thu Sep  3 10:17:39 2009	(r40952)
@@ -22,11 +22,13 @@
 # get_integer_keyed_int doesn't return all zeroes either.
 
 .include 't/pmc/testlib/packfile_common.pir'
+.include 'packfile_segments.pasm'
 .sub 'main' :main
 .include 'test_more.pir'
-    plan(2)
+    plan(5)
     test_elements()
     test_get_integer()
+    test_type()
 .end
 
 # PackfileRawSegment.elements
@@ -60,6 +62,38 @@
     ok($I0, "PackfileRawSegment.get_integer_keyed_int returns some data")
 .end
 
+# PackfileRawSegment.type
+.sub 'test_type'
+    .local pmc pf, pfdir, pfseg, hash, it
+    pf    = _pbc()
+    pfdir = pf.'get_directory'()
+    hash  = new ['Hash']
+    # annotations.pbc contains all available segments. -1 for directory and unknown.
+    # So, in hash we should have 5 elements.
+    it = iter pfdir
+  loop:
+    unless it goto done
+    $S0 = shift it
+    $P0 = pfdir[$S0]
+    $I0 = $P0.'type'()
+    hash[$I0] = 1
+    goto loop
+
+  done:
+    $I0 = elements hash
+    is($I0, 5, "Got all types of Packfile segments")
+
+    # Now create RawSegment and set type.
+    $P0 = new ['PackfileRawSegment']
+    $I0 = $P0.'type'()
+    is($I0, .PF_BYTEC_SEG, "Default type is PF_BYTEC_SEG")
+
+    $P0.'type'(.PF_DEBUG_SEG)
+    $I0 = $P0.'type'()
+    is($I0, .PF_DEBUG_SEG, "Type successfully changed")
+
+.end
+
 
 # Local Variables:
 #   mode: cperl

Modified: branches/context_pmc3/t/pmc/string.t
==============================================================================
--- branches/context_pmc3/t/pmc/string.t	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/t/pmc/string.t	Thu Sep  3 10:17:39 2009	(r40952)
@@ -20,7 +20,7 @@
 .sub main :main
     .include 'test_more.pir'
 
-    plan(165)
+    plan(171)
 
     set_or_get_strings()
     setting_integers()
@@ -71,7 +71,7 @@
     exception_to_int_2()
     exception_to_int_3()
     assign_null_string()
-
+    access_keyed()
     # END_OF_TESTS
 
 .end
@@ -1018,6 +1018,39 @@
     is( $I0, 0, 'assign null string, TT #729' )
 .end
 
+.sub access_keyed
+    .local pmc s
+    s = new ['String']
+    s = "BAR" # Second character is zero, not 'o'
+
+    # Get
+    $S0 = s[0]
+    is($S0, 'B', 'Get string by index')
+    
+    $I0 = s[1]
+    $I1 = ord 'A'
+    is($I0, $I1, 'Get integer by index')
+    
+    $P0 = s[2]
+    is($P0, 'R', 'Get PMC by index')
+
+    # Set
+    s = new ['String']
+
+    $S0 = 'f'
+    s[0] = $S0
+    is(s, 'f', 'Set string keyed')
+
+    $I0 = ord 'o'
+    s[1] = $I0
+    is(s, 'fo', 'Set integer keyed')
+
+    $P0 = new ['String']
+    $P0 = 'o'
+    s[2] = $P0
+    is(s, 'foo', 'Set PMC keyed')
+.end
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4

Modified: branches/context_pmc3/tools/dev/fetch_languages.pl
==============================================================================
--- branches/context_pmc3/tools/dev/fetch_languages.pl	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/tools/dev/fetch_languages.pl	Thu Sep  3 10:17:39 2009	(r40952)
@@ -60,6 +60,12 @@
     },
 
     {
+        name       => 'blizkost',
+        scm        => 'GIT',
+        repository => 'git://github.com/jnthn/blizkost.git'
+    },
+
+    {
         name       => 'c99',
         scm        => 'SVN',
         repository => 'https://svn.parrot.org/languages/c99/trunk'

Added: branches/context_pmc3/tools/dev/parrot_shell.pl
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/context_pmc3/tools/dev/parrot_shell.pl	Thu Sep  3 10:17:39 2009	(r40952)
@@ -0,0 +1,182 @@
+#! perl
+# Copyright (C) 2009, Parrot Foundation.
+# $Id$
+
+use 5.008;
+use strict;
+use warnings;
+use FindBin qw($Bin);
+use lib "$Bin/../lib";    # install location
+use lib "$Bin/../../lib"; # build location
+use IO::File ();
+use File::Spec;
+use Parrot::Config;
+use File::Temp qw/ tempfile /;
+use Benchmark qw/timeit timestr :hireswallclock/;
+
+=head1 NAME
+
+tools/dev/parrot_shell.pl - The Parrot Shell
+
+=head1 SYNOPSIS
+
+    % perl tools/dev/parrot_shell.pl
+
+=head1 DESCRIPTION
+
+The Parrot Shell allows you to rapidly prototype Parrot code. It wraps your code
+in a ".sub main" and ".end", so you don't have to, unless your code begins with
+".sub". It reads code from STDIN until it sees a line containing a single ".",
+which is how you tell parrot_shell to run the code you are giving to it:
+
+Example:
+    parrot_shell 0> $I0 = 42
+    $N1 = sqrt $I0
+    say $N1
+    .
+    Output:
+    6.48074069840786
+
+    parrot_shell 1> quit
+    Thanks for visiting the Parrot Shell, come back soon!
+
+Each numbered Parrot Shell session is run in its own interpreter, so no registers
+or variables are shared/leaked between them.
+
+=cut
+
+my $parrot;
+my $session_no = 0;
+
+BEGIN {
+    $parrot = File::Spec->catfile( ".", "parrot");
+    unless (-e $parrot) {
+        warn "$parrot not found, attempting to use an installed parrot";
+        $parrot = 'parrot';
+    }
+    my $exefile = $parrot . $PConfig{exe};
+}
+
+show_welcome();
+
+while(1) {
+    my $code;
+    show_prompt($session_no);
+
+    while( my $line = <STDIN> ) {
+        exit_shell() if $line =~ m/^q(uit)?$/;
+
+        if ($line =~ m/^h(elp)?$/) {
+            show_help();
+            show_prompt($session_no) if !defined $code;
+            next;
+        }
+        if ($line =~ m/^\s*\.\s*$/) { # Run it, baby!
+            print eval_snippet($code);
+            last;
+        }
+        else {
+            $code .= $line;
+        }
+    }
+
+    $session_no++;
+}
+
+sub show_welcome {
+    print <<BIENVENIDO;
+Welcome to the Parrot Shell, it's experimental!
+Type h or help for some basic help
+Type q or quit to flee the madness
+BIENVENIDO
+
+}
+
+sub show_prompt {
+    my ($session_no) = @_;
+    print "\nparrot_shell $session_no> ";
+}
+sub exit_shell {
+    print "Thanks for visiting the Parrot Shell, come back soon!\n";
+    exit 0;
+}
+
+sub show_help {
+    print <<'EX';
+
+The Parrot Shell allows you to rapidly prototype Parrot code. It wraps your code
+in a ".sub main" and ".end", so you don't have to, unless your code begins with
+".sub". It reads code from STDIN until it sees a line containing a single ".",
+which is how you tell parrot_shell to run the code you are giving to it:
+
+Example:
+    parrot_shell> $I0 = 42
+    $N1 = sqrt $I0
+    say $N1
+    .
+    Output:
+    6.48074069840786
+EX
+}
+
+sub eval_snippet {
+    my ($snippet) = @_;
+    my $codefn   = get_tempfile();
+    my $stdoutfn = get_tempfile();
+    my $f        = IO::File->new(">$codefn");
+
+    $f->print(normalize_snippet($snippet || ''));
+    $f->close();
+
+    my $time = timestr(timeit(1, sub { system("$parrot $codefn >$stdoutfn 2>&1") } ));
+    $time =~ s/\(.*//g;
+
+    handle_errors($?) if $?;
+
+    $f = IO::File->new($stdoutfn);
+
+    my $output = join( '', <$f> );
+    return "Time: $time\nOutput:\n$output";
+}
+
+sub handle_errors {
+    my ($exit_code) = @_;
+    if ($exit_code == -1) {
+        print "Error: failed to execute: $!\n";
+    }
+    elsif ($exit_code & 127) {
+        printf "Error: child died with signal %d, %s coredump\n",
+            ($exit_code & 127),  ($exit_code & 128) ? 'with' : 'without';
+    }
+    else {
+        printf "Error: child exited with value %d\n", $? >> 8;
+    }
+}
+
+sub get_tempfile {
+    my (undef, $name)   = tempfile( CLEANUP => 1);
+    return $name;
+}
+
+sub normalize_snippet {
+    my ($snippet) = @_;
+
+    if ($snippet =~ m/^\.sub/) {
+        # don't wrap snippet
+        return $snippet;
+    }
+    else {
+        return <<SNIP;
+.sub main :main
+$snippet
+.end
+SNIP
+    }
+}
+
+# Local Variables:
+#   mode: cperl
+#   cperl-indent-level: 4
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:

Modified: branches/context_pmc3/tools/dev/pbc_to_exe.pir
==============================================================================
--- branches/context_pmc3/tools/dev/pbc_to_exe.pir	Thu Sep  3 08:27:30 2009	(r40951)
+++ branches/context_pmc3/tools/dev/pbc_to_exe.pir	Thu Sep  3 10:17:39 2009	(r40952)
@@ -79,6 +79,7 @@
             if (!interp)
                 return 1;
 
+            Parrot_init_stacktop(interp, &interp);
             Parrot_set_executable_name(interp,
                 Parrot_str_new(interp, argv[0], 0));
             Parrot_set_flag(interp, PARROT_DESTROY_FLAG);


More information about the parrot-commits mailing list