[svn:ponie] r349 - in trunk: . perl src/pmc

Author: nicholas
Date: Mon Aug 29 07:54:42 2005
New Revision: 349

Added:
   trunk/src/pmc/perl5sv_yes.pmc
Modified:
   trunk/perl/perl.c
   trunk/write_makefile.pl
Log:
Add a new PMC class Perl5sv_yes, a subtype of Perl5PVNV, for PL_sv_yes and
PL_sv_no


Modified: trunk/perl/perl.c
==============================================================================
--- trunk/perl/perl.c	(original)
+++ trunk/perl/perl.c	Mon Aug 29 07:54:42 2005
@@ -349,21 +349,24 @@ perl_construct(pTHXx)
 
 	    SvREADONLY_on(&PL_sv_undef);
 
-	    PL_sv_no_p = newSV(0);
+	    PL_sv_no_p
+		= MUMBLE(Parrot_PMC_new(PL_Parrot,
+					type_or_bail("Perl5sv_yes")));
+
 	    sv_setpv(&PL_sv_no,PL_No);
 	    /* value lookup in void context - happens to have the side effect
 	       of caching the numeric forms.  */
 	    SvIV(&PL_sv_no);
 	    SvNV(&PL_sv_no);
 	    SvREADONLY_on(&PL_sv_no);
-	    SvREFCNT_set(&PL_sv_no, (~(U32)0)/2);
 
-	    PL_sv_yes_p = newSV(0);
+	    PL_sv_yes_p
+		= MUMBLE(Parrot_PMC_new(PL_Parrot,
+					type_or_bail("Perl5sv_yes")));
 	    sv_setpv(&PL_sv_yes,PL_Yes);
 	    SvIV(&PL_sv_yes);
 	    SvNV(&PL_sv_yes);
 	    SvREADONLY_on(&PL_sv_yes);
-	    SvREFCNT_set(&PL_sv_yes, (~(U32)0)/2);
 
 	    PL_sv_placeholder_p
 		= MUMBLE(Parrot_PMC_new(PL_Parrot,

Added: trunk/src/pmc/perl5sv_yes.pmc
==============================================================================
--- (empty file)
+++ trunk/src/pmc/perl5sv_yes.pmc	Mon Aug 29 07:54:42 2005
@@ -0,0 +1,67 @@
+/* Perl5sv_yes.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_yes
+ *  Data Structure and Algorithms:
+ *  History:
+ *  Notes:
+ *  References:
+ */
+
+#include "ponie.h"
+
+pmclass Perl5sv_yes extends Perl5PVNV dynpmc group Perl5_group {
+
+    void init () {
+        struct Ponie_upgrade_info info;
+        /* Initialise ourself as a regular PMC.  */
+        SUPER();
+        /* And fake an upgrade to SVt_PVNV  */
+        ((struct STRUCT_SV *)PMC_struct_val(SELF))->sv_flags = SVt_PVNV;
+        memset(&info, 0, sizeof(info));
+        DYNSELF.set_pointer_keyed_int(Ponie_P_SET_UPGRADE, &info);
+    }
+
+    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_yes");
+            break;
+#if 0
+        case Ponie_P_SET_UPGRADE:
+            Perl_croak(aTHX_ "Can't upgrade to PL_sv_yes");
+            break; 
+#endif
+        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 07:54:42 2005
@@ -12,7 +12,7 @@ use FindBin;
 my $top = $FindBin::Bin;
 
 my @allPMCs = map {"Perl5$_"}
-  qw(cargo_cult base NULL Pining PVMG_mess sv_undef
+  qw(cargo_cult base NULL Pining PVMG_mess sv_undef sv_yes
      IV NV RV PV PVIV PVNV PVMG PVBM PVGV PVLV PVAV PVHV PVCV PVFM PVIO);
 
 my $parrotdir = "$top/parrot";