[svn:ponie] r346 - in trunk: . perl perl/ext/Devel/Peek/t src/pmc

Author: nicholas
Date: Mon Aug 29 04:58:41 2005
New Revision: 346

Added:
   trunk/src/pmc/perl5sv_undef.pmc
Modified:
   trunk/perl/ext/Devel/Peek/t/Peek.t
   trunk/perl/perl.c
   trunk/write_makefile.pl
Log:
Add a new PMC type "sv_undef" for PL_sv_undef, which always reports a reference
count of 0x7FFFFFFF


Modified: trunk/perl/ext/Devel/Peek/t/Peek.t
==============================================================================
--- trunk/perl/ext/Devel/Peek/t/Peek.t	(original)
+++ trunk/perl/ext/Devel/Peek/t/Peek.t	Mon Aug 29 04:58:41 2005
@@ -467,7 +467,7 @@ do_test(22,
     IV = -?\d+
     NV = $FLOAT
     RV = $ADDR
-    SV = NULL\\(0x0\\) at $ADDR \\[Perl5[A-Z]+\\]
+    SV = NULL\\(0x0\\) at $ADDR \\[Perl5sv_undef\\]
       REFCNT = \d+
       FLAGS = \\(READONLY\\)
     CUR = 0

Modified: trunk/perl/perl.c
==============================================================================
--- trunk/perl/perl.c	(original)
+++ trunk/perl/perl.c	Mon Aug 29 04:58:41 2005
@@ -340,10 +340,13 @@ perl_construct(pTHXx)
 	sv_upgrade(PL_linestr,SVt_PVIV);
 
 	if (!PL_sv_undef_p) {
+	    PL_sv_undef_p
+		= MUMBLE(Parrot_PMC_new(PL_Parrot,
+					type_or_bail("Perl5sv_undef")));
+
 	    /* set read-only and try to insure than we wont see REFCNT==0
 	       very often */
 
-	    PL_sv_undef_p = newSV(0);
 	    SvREADONLY_on(&PL_sv_undef);
 	    SvREFCNT_set(&PL_sv_undef, (~(U32)0)/2);
 

Added: trunk/src/pmc/perl5sv_undef.pmc
==============================================================================
--- (empty file)
+++ trunk/src/pmc/perl5sv_undef.pmc	Mon Aug 29 04:58:41 2005
@@ -0,0 +1,56 @@
+/* Perl5NULL.pmc -*- c -*-
+ *  Copyright: 2005 The Perl Foundation.  Please see the file README at
+ *  the top level of the distribution for licensing information.
+ *  CVS Info
+ *     $Id: perl5null.pmc 289 2005-06-17 10:50:15Z nicholas $
+ *  Overview:
+ *     These are the vtable functions for the class implementing PL_sv_undef
+ *  Data Structure and Algorithms:
+ *  History:
+ *  Notes:
+ *  References:
+ */
+
+#include "ponie.h"
+
+pmclass Perl5sv_undef extends Perl5base dynpmc group Perl5_group {
+
+    void set_pointer_keyed_int(INTVAL key, void *value) {
+        switch (key) {
+        case Ponie_P_GET_UPGRADE:
+            Perl_croak(aTHX_ "Can't upgrade from PL_sv_undef");
+            break;
+            break;
+        case Ponie_P_SET_UPGRADE:
+            Perl_croak(aTHX_ "Can't upgrade to PL_sv_undef");
+            break; 
+        case Ponie_P_CLEAR:
+            Parrot_PMC_set_intval_intkey(PL_Parrot,SELF,
+                                         Ponie_I_SV_ZERO_FLAGS_SET_TYPEMASK_BREAK_DEAD,
+                                         0);
+            break;
+       default:
+            SUPER(key, value);
+        }
+    }
+
+    INTVAL get_integer_keyed_int(INTVAL key) {
+        switch (key) {
+        case Ponie_I_SV_REFCNT_NO_ABORT:
+        case Ponie_I_SV_REFCNT:
+            return 0x7FFFFFFF;
+        default:
+        return SUPER(key);
+        }
+    }
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/

Modified: trunk/write_makefile.pl
==============================================================================
--- trunk/write_makefile.pl	(original)
+++ trunk/write_makefile.pl	Mon Aug 29 04:58:41 2005
@@ -12,7 +12,7 @@ use FindBin;
 my $top = $FindBin::Bin;
 
 my @allPMCs = map {"Perl5$_"}
-  qw(cargo_cult base NULL Pining PVMG_mess
+  qw(cargo_cult base NULL Pining PVMG_mess sv_undef
      IV NV RV PV PVIV PVNV PVMG PVBM PVGV PVLV PVAV PVHV PVCV PVFM PVIO);
 
 my $parrotdir = "$top/parrot";