[perl #25960] [PATCH] COWed stack bug (was IMCC - PerlArray getting trounced)

[via RT]

# New Ticket Created by  Matt Fowles 
# Please include the string:  [perl #25960]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=25960 >


All~

This patch make the problem case submitted by Jeff Clites work.  All 
tests pass, and his sample has been added to the tests.

While I am not certain that this is the correct way to solve the 
problem, it seems good to me.

Matt

Index: imcc/t/syn/pcc.t
===================================================================
RCS file: /cvs/public/parrot/imcc/t/syn/pcc.t,v
retrieving revision 1.31
diff -u -r1.31 pcc.t
--- imcc/t/syn/pcc.t	20 Jan 2004 01:50:47 -0000	1.31
+++ imcc/t/syn/pcc.t	4 Feb 2004 02:55:11 -0000
@@ -1,6 +1,6 @@
 #!perl
 use strict;
-use TestCompiler tests => 34;
+use TestCompiler tests => 35;
 
 ##############################
 # Parrot Calling Conventions
@@ -1389,3 +1389,30 @@
 42.000000
 OUT
 }
+
+output_is(<<'CODE', <<'OUT', "COW handling on register stacks");
+.pcc_sub _main prototyped
+  $P1 = new PerlUndef
+  print $P1
+  print ":"
+  _outer()
+  print $P1
+  print "\n"
+  end
+.end
+.pcc_sub _outer prototyped
+  _inner()
+  .pcc_begin_return
+  .pcc_end_return
+.end
+.pcc_sub _inner prototyped
+  newsub $P1, .Exception_Handler, _ignore
+  .pcc_begin_return
+  .pcc_end_return
+.end
+.sub _ignore
+  noop
+.end
+CODE
+:
+OUT
Index: src/register.c
===================================================================
RCS file: /cvs/public/parrot/src/register.c,v
retrieving revision 1.41
diff -u -r1.41 register.c
--- src/register.c	25 Jan 2004 19:33:27 -0000	1.41
+++ src/register.c	4 Feb 2004 02:55:13 -0000
@@ -292,11 +292,11 @@
 {
     struct RegisterChunkBuf* top = stack->top;
     if (top->used > 1) {
+        top->used--;
         /* Before we change anything, is this a read-only stack? */
         if (PObj_COW_TEST((PObj*)top))
             top = stack->top =
                 regstack_copy_chunk(interpreter, stack->top, stack);
-        top->used--;
     }
     else {
         /* XXX: If this isn't marked COW, we should keep it around to