Eliminate SVt_RV, and use SVt_IV to store plain references.

This frees up a scalar type for first class regular expressions.

p4raw-id: //depot/perl@32734

8 files changed, 88 insertions, 33 deletions

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 7c606e3c59..9dc85bb4bf 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -7,7 +7,7 @@
 #
 package B;
 
-our $VERSION = '1.17';
+our $VERSION = '1.18';
 
 use XSLoader ();
 require Exporter;
@@ -33,7 +33,8 @@ use strict;
 @B::PV::ISA = 'B::SV';
 @B::IV::ISA = 'B::SV';
 @B::NV::ISA = 'B::SV';
-@B::RV::ISA = 'B::SV';
+# RV is eliminated with 5.11.0, but effectively is a specialisation of IV now.
+@B::RV::ISA = $] > 5.011 ? 'B::IV' : 'B::SV';
 @B::PVIV::ISA = qw(B::PV B::IV);
 @B::PVNV::ISA = qw(B::PVIV B::NV);
 @B::PVMG::ISA = 'B::PVNV';
@@ -574,8 +575,8 @@ give incomprehensible results, or worse.
 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM (5.9.5 and
 earlier), B::PVLV, B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes
 correspond in the obvious way to the underlying C structures of similar names.
-The inheritance hierarchy mimics the underlying C "inheritance". For 5.9.5
-and later this is:
+The inheritance hierarchy mimics the underlying C "inheritance". For the
+5.10, 5.10.1 I<etc> this is:
 
                            B::SV
                              |
@@ -601,6 +602,9 @@ and later this is:
                       B::PVLV      B::FM
 
 
+For 5.11.0 and later, B::RV is abolished, and IVs can be used to store
+references.
+
 For 5.9.0 and earlier, PVLV is a direct subclass of PVMG, and BM is still
 present as a distinct type, so the base of this diagram is
 
diff --git a/ext/B/B.xs b/ext/B/B.xs
index e6af7a1531..aa02d540c8 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -25,8 +25,10 @@ static const char* const svclassnames[] = {
     "B::BIND",
 #endif
     "B::IV",
-    "B::RV",
     "B::NV",
+#if PERL_VERSION <= 10
+    "B::RV",
+#endif
     "B::PV",
     "B::PVIV",
     "B::PVNV",
@@ -34,6 +36,9 @@ static const char* const svclassnames[] = {
 #if PERL_VERSION <= 8
     "B::BM",
 #endif
+#if PERL_VERSION >= 11
+    "B::ORANGE",
+#endif
 #if PERL_VERSION >= 9
     "B::GV",
 #endif
@@ -1366,6 +1371,24 @@ packiv(sv)
 	    ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
 	}
 
+
+#if PERL_VERSION >= 11
+
+B::SV
+RV(sv)
+        B::IV   sv
+    CODE:
+        if( SvROK(sv) ) {
+            RETVAL = SvRV(sv);
+        }
+        else {
+            croak( "argument is not SvROK" );
+        }
+    OUTPUT:
+        RETVAL
+
+#endif
+
 MODULE = B	PACKAGE = B::NV		PREFIX = Sv
 
 NV
@@ -1392,12 +1415,16 @@ U32
 PARENT_FAKELEX_FLAGS(sv)
 	B::NV	sv
 
+#if PERL_VERSION < 11
+
 MODULE = B	PACKAGE = B::RV		PREFIX = Sv
 
 B::SV
 SvRV(sv)
 	B::RV	sv
 
+#endif
+
 MODULE = B	PACKAGE = B::PV		PREFIX = Sv
 
 char*
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index e458727318..7e81d85e2b 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/B/Concise.pm
@@ -28,7 +28,7 @@ our %EXPORT_TAGS =
 # use #6
 use B qw(class ppname main_start main_root main_cv cstring svref_2object
 	 SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL
-	 CVf_ANON PAD_FAKELEX_ANON PAD_FAKELEX_MULTI);
+	 CVf_ANON PAD_FAKELEX_ANON PAD_FAKELEX_MULTI SVf_ROK);
 
 my %style =
   ("terse" =>
@@ -698,9 +698,16 @@ sub concise_sv {
 	$hr->{svval} = "*$stash" . $gv->SAFENAME;
 	return "*$stash" . $gv->SAFENAME;
     } else {
-	while (class($sv) eq "RV") {
-	    $hr->{svval} .= "\\";
-	    $sv = $sv->RV;
+	if ($] >= 5.011) {
+	    while (class($sv) eq "IV" && $sv->FLAGS & SVf_ROK) {
+		$hr->{svval} .= "\\";
+		$sv = $sv->RV;
+	    }
+	} else {
+	    while (class($sv) eq "RV") {
+		$hr->{svval} .= "\\";
+		$sv = $sv->RV;
+	    }
 	}
 	if (class($sv) eq "SPECIAL") {
 	    $hr->{svval} .= ["Null", "sv_undef", "sv_yes", "sv_no"]->[$$sv];
diff --git a/ext/B/t/b.t b/ext/B/t/b.t
index e0e21f4a96..0a3f245090 100755
--- a/ext/B/t/b.t
+++ b/ext/B/t/b.t
@@ -126,21 +126,25 @@ my $null_ret = $nv_ref->object_2svref();
 is(ref $null_ret, "SCALAR", "Test object_2svref() return is SCALAR");
 is($$null_ret, $nv, "Test object_2svref()");
 
+my $RV_class = $] >= 5.011 ? 'B::IV' : 'B::RV';
 my $cv = sub{ 1; };
 my $cv_ref = B::svref_2object(\$cv);
-is($cv_ref->REFCNT, 1, "Test B::RV->REFCNT");
-is(ref $cv_ref, "B::RV", "Test B::RV return from svref_2object - code");
+is($cv_ref->REFCNT, 1, "Test $RV_class->REFCNT");
+is(ref $cv_ref, "$RV_class",
+   "Test $RV_class return from svref_2object - code");
 my $cv_ret = $cv_ref->object_2svref();
 is(ref $cv_ret, "REF", "Test object_2svref() return is REF");
 is($$cv_ret, $cv, "Test object_2svref()");
 
 my $av = [];
 my $av_ref = B::svref_2object(\$av);
-is(ref $av_ref, "B::RV", "Test B::RV return from svref_2object - array");
+is(ref $av_ref, "$RV_class",
+   "Test $RV_class return from svref_2object - array");
 
 my $hv = [];
 my $hv_ref = B::svref_2object(\$hv);
-is(ref $hv_ref, "B::RV", "Test B::RV return from svref_2object - hash");
+is(ref $hv_ref, "$RV_class",
+   "Test $RV_class return from svref_2object - hash");
 
 local *gv = *STDOUT;
 my $gv_ref = B::svref_2object(\*gv);
diff --git a/ext/B/t/optree_constants.t b/ext/B/t/optree_constants.t
index c39a054456..c05138b633 100644
--- a/ext/B/t/optree_constants.t
+++ b/ext/B/t/optree_constants.t
@@ -43,21 +43,23 @@ sub myyes() { 1==1 }
 sub myno () { return 1!=1 }
 sub pi () { 3.14159 };
 
+my $RV_class = $] >= 5.011 ? 'IV' : 'RV';
+
 my $want = {	# expected types, how value renders in-line, todos (maybe)
     mystr	=> [ 'PV', '"'.mystr.'"' ],
-    myhref	=> [ 'RV', '\\\\HASH'],
+    myhref	=> [ $RV_class, '\\\\HASH'],
     pi		=> [ 'NV', pi ],
-    myglob	=> [ 'RV', '\\\\' ],
-    mysub	=> [ 'RV', '\\\\' ],
-    myunsub	=> [ 'RV', '\\\\' ],
+    myglob	=> [ $RV_class, '\\\\' ],
+    mysub	=> [ $RV_class, '\\\\' ],
+    myunsub	=> [ $RV_class, '\\\\' ],
     # these are not inlined, at least not per BC::Concise
-    #myyes	=> [ 'RV', ],
-    #myno	=> [ 'RV', ],
+    #myyes	=> [ $RV_class, ],
+    #myno	=> [ $RV_class, ],
     $] > 5.009 ? (
-    myaref	=> [ 'RV', '\\\\' ],
+    myaref	=> [ $RV_class, '\\\\' ],
     myfl	=> [ 'NV', myfl ],
     myint	=> [ 'IV', myint ],
-    myrex	=> [ 'RV', '\\\\' ],
+    myrex	=> [ $RV_class, '\\\\' ],
     myundef	=> [ 'NULL', ],
     ) : (
     myaref	=> [ 'PVIV', '' ],
diff --git a/ext/B/t/terse.t b/ext/B/t/terse.t
index 2df8eee9b2..8d86a49bfe 100644
--- a/ext/B/t/terse.t
+++ b/ext/B/t/terse.t
@@ -99,7 +99,11 @@ my $path = join " ", map { qq["-I$_"] } @INC;
 $path = '-I::lib -MMac::err=unix' if $^O eq 'MacOS';
 my $redir = $^O eq 'MacOS' ? '' : "2>&1";
 my $items = qx{$^X $path "-MO=Terse" -le "print \\42" $redir};
-like( $items, qr/RV $hex \\42/, 'RV' );
+if( $] >= 5.011 ) {
+    like( $items, qr/IV $hex \\42/, 'RV (but now stored in an IV)' );
+} else {
+    like( $items, qr/RV $hex \\42/, 'RV' );
+}
 
 package TieOut;
 
diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t
index 0b6878e927..76118d1395 100644
--- a/ext/Devel/Peek/t/Peek.t
+++ b/ext/Devel/Peek/t/Peek.t
@@ -44,6 +44,7 @@ sub do_test {
 	    $pattern =~ s/^ *\$IVNV *\n/
 		($] < 5.009) ? "    IV = 0\n    NV = 0\n" : '';
 	    /mge;
+	    $pattern =~ s/\$RV/IV/g if $] >= 5.011;
 
 	    print $pattern, "\n" if $DEBUG;
 	    my ($dump, $dump2) = split m/\*\*\*\*\*\n/, scalar <IN>;
@@ -153,7 +154,7 @@ do_test( 9,
 
 do_test(10,
         \$a,
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
@@ -182,7 +183,7 @@ if ($type eq 'N') {
 }
 do_test(11,
        [$b,$c],
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
@@ -203,7 +204,7 @@ do_test(11,
 
 do_test(12,
        {$b=>$c},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
@@ -221,7 +222,7 @@ do_test(12,
 
 do_test(13,
         sub(){@_},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
@@ -247,7 +248,7 @@ do_test(13,
 
 do_test(14,
         \&do_test,
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
@@ -276,7 +277,7 @@ do_test(14,
 
 do_test(15,
         qr(tic),
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
@@ -296,7 +297,7 @@ do_test(15,
 
 do_test(16,
         (bless {}, "Tac"),
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
@@ -356,7 +357,7 @@ do_test(18,
 if (ord('A') == 193) {
 do_test(19,
 	{chr(256)=>chr(512)},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
@@ -380,7 +381,7 @@ do_test(19,
 } else {
 do_test(19,
 	{chr(256)=>chr(512)},
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
@@ -459,7 +460,7 @@ do_test(21,
 # blessed refs
 do_test(22,
 	bless(\\undef, 'Foobar'),
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
@@ -485,7 +486,7 @@ sub const () {
 
 do_test(23,
 	\&const,
-'SV = RV\\($ADDR\\) at $ADDR
+'SV = $RV\\($ADDR\\) at $ADDR
   REFCNT = 1
   FLAGS = \\(ROK\\)
   RV = $ADDR
diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index e284163f99..bb68c1bc36 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -3434,7 +3434,9 @@ static int sv_type(pTHX_ SV *sv)
 {
 	switch (SvTYPE(sv)) {
 	case SVt_NULL:
+#if PERL_VERSION <= 10
 	case SVt_IV:
+#endif
 	case SVt_NV:
 		/*
 		 * No need to check for ROK, that can't be set here since there
@@ -3442,7 +3444,11 @@ static int sv_type(pTHX_ SV *sv)
 		 */
 		return svis_SCALAR;
 	case SVt_PV:
+#if PERL_VERSION <= 10
 	case SVt_RV:
+#else
+	case SVt_IV:
+#endif
 	case SVt_PVIV:
 	case SVt_PVNV:
 		/*