This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Eliminate SVt_RV, and use SVt_IV to store plain references.
authorNicholas Clark <nick@ccl4.org>
Wed, 26 Dec 2007 17:03:56 +0000 (17:03 +0000)
committerNicholas Clark <nick@ccl4.org>
Wed, 26 Dec 2007 17:03:56 +0000 (17:03 +0000)
This frees up a scalar type for first class regular expressions.

p4raw-id: //depot/perl@32734

13 files changed:
dump.c
ext/B/B.pm
ext/B/B.xs
ext/B/B/Concise.pm
ext/B/t/b.t
ext/B/t/optree_constants.t
ext/B/t/terse.t
ext/Devel/Peek/t/Peek.t
ext/Storable/Storable.xs
pp.c
pp_hot.c
sv.c
sv.h

diff --git a/dump.c b/dump.c
index c6a9557..1cda173 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -31,12 +31,12 @@ static const char* const svtypenames[SVt_LAST] = {
     "NULL",
     "BIND",
     "IV",
-    "RV",
     "NV",
     "PV",
     "PVIV",
     "PVNV",
     "PVMG",
+    "ORANGE",
     "PVGV",
     "PVLV",
     "PVAV",
@@ -51,12 +51,12 @@ static const char* const svshorttypenames[SVt_LAST] = {
     "UNDEF",
     "BIND",
     "IV",
-    "RV",
     "NV",
     "PV",
     "PVIV",
     "PVNV",
     "PVMG",
+    "ORANGE",
     "GV",
     "PVLV",
     "AV",
@@ -1529,7 +1529,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
     }
     if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV
         && type != SVt_PVCV && !isGV_with_GP(sv))
-       || type == SVt_IV) {
+       || (type == SVt_IV && !SvROK(sv))) {
        if (SvIsUV(sv)
 #ifdef PERL_OLD_COPY_ON_WRITE
                       || SvIsCOW(sv)
@@ -2371,9 +2371,6 @@ Perl_sv_xmlpeek(pTHX_ SV *sv)
     case SVt_NV:
        sv_catpv(t, " NV=\"");
        break;
-    case SVt_RV:
-       sv_catpv(t, " RV=\"");
-       break;
     case SVt_PV:
        sv_catpv(t, " PV=\"");
        break;
@@ -2407,6 +2404,9 @@ Perl_sv_xmlpeek(pTHX_ SV *sv)
     case SVt_BIND:
        sv_catpv(t, " BIND=\"");
        break;
+    case SVt_ORANGE:
+       sv_catpv(t, " ORANGE=\"");
+       break;
     case SVt_PVFM:
        sv_catpv(t, " FM=\"");
        break;
index 7c606e3..9dc85bb 100644 (file)
@@ -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
 
index e6af7a1..aa02d54 100644 (file)
@@ -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*
index e458727..7e81d85 100644 (file)
@@ -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];
index e0e21f4..0a3f245 100755 (executable)
@@ -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);
index c39a054..c05138b 100644 (file)
@@ -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', '' ],
index 2df8eee..8d86a49 100644 (file)
@@ -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;
 
index 0b6878e..76118d1 100644 (file)
@@ -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
index e284163..bb68c1b 100644 (file)
@@ -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:
                /*
diff --git a/pp.c b/pp.c
index 349e91f..08ebe5e 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -172,8 +172,8 @@ PP(pp_rv2gv)
                        const char * const name = CopSTASHPV(PL_curcop);
                        gv = newGVgen(name);
                    }
-                   if (SvTYPE(sv) < SVt_RV || SvTYPE(sv) == SVt_NV)
-                       sv_upgrade(sv, SVt_RV);
+                   if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV)
+                       sv_upgrade(sv, SVt_IV);
                    else if (SvPVX_const(sv)) {
                        SvPV_free(sv);
                        SvLEN_set(sv, 0);
@@ -536,7 +536,7 @@ S_refto(pTHX_ SV *sv)
        SvREFCNT_inc_void_NN(sv);
     }
     rv = sv_newmortal();
-    sv_upgrade(rv, SVt_RV);
+    sv_upgrade(rv, SVt_IV);
     SvRV_set(rv, sv);
     SvROK_on(rv);
     return rv;
index ca34f91..276010c 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -150,7 +150,7 @@ PP(pp_sassign)
                   The gv becomes a(nother) reference to the constant.  */
                SV *const value = SvRV(cv);
 
-               SvUPGRADE((SV *)gv, SVt_RV);
+               SvUPGRADE((SV *)gv, SVt_IV);
                SvPCS_IMPORTED_on(gv);
                SvRV_set(gv, value);
                SvREFCNT_inc_simple_void(value);
@@ -2940,8 +2940,8 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
     if (!SvOK(sv)) {
        if (SvREADONLY(sv))
            Perl_croak(aTHX_ PL_no_modify);
-       if (SvTYPE(sv) < SVt_RV || SvTYPE(sv) == SVt_NV)
-           sv_upgrade(sv, SVt_RV);
+       if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV)
+           sv_upgrade(sv, SVt_IV);
        else if (SvTYPE(sv) >= SVt_PV) {
            SvPV_free(sv);
             SvLEN_set(sv, 0);
diff --git a/sv.c b/sv.c
index fda7935..7b49ce2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -890,9 +890,6 @@ static const struct body_details bodies_by_type[] = {
       FIT_ARENA(0, sizeof(struct ptr_tbl_ent))
     },
 
-    /* RVs are in the head now.  */
-    { 0, 0, 0, SVt_RV, FALSE, NONV, NOARENA, 0 },
-
     /* 8 bytes on most ILP32 with IEEE doubles */
     { sizeof(NV), sizeof(NV), 0, SVt_NV, FALSE, HADNV, HASARENA,
       FIT_ARENA(0, sizeof(NV)) },
@@ -918,7 +915,10 @@ static const struct body_details bodies_by_type[] = {
     /* 28 */
     { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
-    
+
+    /* There are plans for this  */
+    { 0, 0, 0, SVt_ORANGE, FALSE, NONV, NOARENA, 0 },
+
     /* 48 */
     { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVGV)) },
@@ -1115,6 +1115,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     const struct body_details *new_type_details;
     const struct body_details *const old_type_details
        = bodies_by_type + old_type;
+    SV *referant = NULL;
 
     if (new_type != SVt_PV && SvIsCOW(sv)) {
        sv_force_normal_flags(sv, 0);
@@ -1123,12 +1124,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     if (old_type == new_type)
        return;
 
-    if (old_type == SVt_RV) {
-       /* Verify my assumption that no-one upgrades a scalar which has a
-          referant but isn't flagged as a reference.  */
-       assert(!(!SvROK(sv) && SvRV(sv)));
-    }
-
     old_body = SvANY(sv);
 
     /* Copying structures onto other structures that have been neatly zeroed
@@ -1173,9 +1168,18 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     case SVt_NULL:
        break;
     case SVt_IV:
-       if (new_type < SVt_PVIV) {
-           new_type = (new_type == SVt_NV)
-               ? SVt_PVNV : SVt_PVIV;
+       if (SvROK(sv)) {
+           referant = SvRV(sv);
+           if (new_type < SVt_PVIV) {
+               new_type = SVt_PVIV;
+               /* FIXME to check SvROK(sv) ? SVt_PV : and fake up
+                  old_body_details */
+           }
+       } else {
+           if (new_type < SVt_PVIV) {
+               new_type = (new_type == SVt_NV)
+                   ? SVt_PVNV : SVt_PVIV;
+           }
        }
        break;
     case SVt_NV:
@@ -1183,8 +1187,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
            new_type = SVt_PVNV;
        }
        break;
-    case SVt_RV:
-       break;
     case SVt_PV:
        assert(new_type > SVt_PV);
        assert(SVt_IV < SVt_PV);
@@ -1233,15 +1235,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
        SvANY(sv) = new_XNV();
        SvNV_set(sv, 0);
        return;
-    case SVt_RV:
-       assert(old_type == SVt_NULL);
-       SvANY(sv) = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
-       /* Could leave this in, but changing it happens to make the next step
-          clearler. The key part is that SvANY(sv) is not NULL:
-          SvANY(sv) = &sv->sv_u.svu_rv;
-       */
-       SvRV_set(sv, 0);
-       return;
     case SVt_PVHV:
     case SVt_PVAV:
        assert(new_type_details->body_size);
@@ -1290,7 +1283,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
           The target created by newSVrv also is, and it can have magic.
           However, it never has SvPVX set.
        */
-       if (old_type == SVt_RV || old_type >= SVt_PV) {
+       if (old_type == SVt_IV) {
+           assert(!SvROK(sv));
+       } else if (old_type >= SVt_PV) {
            assert(SvPVX_const(sv) == 0);
        }
 
@@ -1361,8 +1356,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
 
        if (new_type == SVt_PVIO)
            IoPAGE_LEN(sv) = 60;
-       if (old_type < SVt_RV || old_type == SVt_NV)
-           SvPV_set(sv, NULL);
+       if (old_type < SVt_PV) {
+           /* referant will be NULL unless the old type was SVt_IV emulating
+              SVt_RV */
+           sv->sv_u.svu_rv = referant;
+       }
        break;
     default:
        Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu",
@@ -1498,7 +1496,6 @@ Perl_sv_setiv(pTHX_ register SV *sv, IV i)
     case SVt_NV:
        sv_upgrade(sv, SVt_IV);
        break;
-    case SVt_RV:
     case SVt_PV:
        sv_upgrade(sv, SVt_PVIV);
        break;
@@ -1596,7 +1593,6 @@ Perl_sv_setnv(pTHX_ register SV *sv, NV num)
     case SVt_IV:
        sv_upgrade(sv, SVt_NV);
        break;
-    case SVt_RV:
     case SVt_PV:
     case SVt_PVIV:
        sv_upgrade(sv, SVt_PVNV);
@@ -3440,7 +3436,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                sv_upgrade(dstr, SVt_IV);
                break;
            case SVt_NV:
-           case SVt_RV:
            case SVt_PV:
                sv_upgrade(dstr, SVt_PVIV);
                break;
@@ -3458,7 +3453,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            assert(!SvTAINTED(sstr));
            return;
        }
-       goto undef_sstr;
+       if (!SvROK(sstr))
+           goto undef_sstr;
+       if (dtype < SVt_PV && dtype != SVt_IV)
+           sv_upgrade(dstr, SVt_IV);
+       break;
 
     case SVt_NV:
        if (SvNOK(sstr)) {
@@ -3467,7 +3466,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            case SVt_IV:
                sv_upgrade(dstr, SVt_NV);
                break;
-           case SVt_RV:
            case SVt_PV:
            case SVt_PVIV:
                sv_upgrade(dstr, SVt_PVNV);
@@ -3486,10 +3484,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        }
        goto undef_sstr;
 
-    case SVt_RV:
-       if (dtype < SVt_PV && dtype != SVt_RV)
-           sv_upgrade(dstr, SVt_RV);
-       break;
     case SVt_PVFM:
 #ifdef PERL_OLD_COPY_ON_WRITE
        if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) {
@@ -5056,13 +5050,9 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
 #else
     StructCopy(nsv,sv,SV);
 #endif
-    /* Currently could join these into one piece of pointer arithmetic, but
-       it would be unclear.  */
-    if(SvTYPE(sv) == SVt_IV)
+    if(SvTYPE(sv) == SVt_IV) {
        SvANY(sv)
            = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
-    else if (SvTYPE(sv) == SVt_RV) {
-       SvANY(sv) = &sv->sv_u.svu_rv;
     }
        
 
@@ -5124,6 +5114,15 @@ Perl_sv_clear(pTHX_ register SV *sv)
        /* See the comment in sv.h about the collusion between this early
           return and the overloading of the NULL and IV slots in the size
           table.  */
+       if (SvROK(sv)) {
+           SV * const target = SvRV(sv);
+           if (SvWEAKREF(sv))
+               sv_del_backref(target, sv);
+           else
+               SvREFCNT_dec(target);
+       }
+       SvFLAGS(sv) &= SVf_BREAK;
+       SvFLAGS(sv) |= SVTYPEMASK;
        return;
     }
 
@@ -5254,7 +5253,6 @@ Perl_sv_clear(pTHX_ register SV *sv)
            /* Don't even bother with turning off the OOK flag.  */
        }
     case SVt_PV:
-    case SVt_RV:
        if (SvROK(sv)) {
            SV * const target = SvRV(sv);
            if (SvWEAKREF(sv))
@@ -7302,7 +7300,7 @@ SV *
 Perl_newRV_noinc(pTHX_ SV *tmpRef)
 {
     dVAR;
-    register SV *sv = newSV_type(SVt_RV);
+    register SV *sv = newSV_type(SVt_IV);
     SvTEMP_off(tmpRef);
     SvRV_set(sv, tmpRef);
     SvROK_on(sv);
@@ -7746,7 +7744,6 @@ Perl_sv_reftype(pTHX_ const SV *sv, int ob)
        case SVt_NULL:
        case SVt_IV:
        case SVt_NV:
-       case SVt_RV:
        case SVt_PV:
        case SVt_PVIV:
        case SVt_PVNV:
@@ -7857,12 +7854,12 @@ Perl_newSVrv(pTHX_ SV *rv, const char *classname)
        SvFLAGS(rv) = 0;
        SvREFCNT(rv) = refcnt;
 
-       sv_upgrade(rv, SVt_RV);
+       sv_upgrade(rv, SVt_IV);
     } else if (SvROK(rv)) {
        SvREFCNT_dec(SvRV(rv));
-    } else if (SvTYPE(rv) < SVt_RV || SvTYPE(rv) == SVt_NV)
-       sv_upgrade(rv, SVt_RV);
-    else if (SvTYPE(rv) > SVt_RV) {
+    } else if (SvTYPE(rv) < SVt_PV && SvTYPE(rv) != SVt_IV)
+       sv_upgrade(rv, SVt_IV);
+    else if (SvTYPE(rv) >= SVt_PV) {
        SvPV_free(rv);
        SvCUR_set(rv, 0);
        SvLEN_set(rv, 0);
@@ -10023,10 +10020,7 @@ Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param)
     }
     else {
        /* Copy the NULL */
-       if (SvTYPE(dstr) == SVt_RV)
-           SvRV_set(dstr, NULL);
-       else
-           SvPV_set(dstr, NULL);
+       SvPV_set(dstr, NULL);
     }
 }
 
@@ -10092,16 +10086,16 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
        break;
     case SVt_IV:
        SvANY(dstr)     = (XPVIV*)((char*)&(dstr->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
-       SvIV_set(dstr, SvIVX(sstr));
+       if(SvROK(sstr)) {
+           Perl_rvpv_dup(aTHX_ dstr, sstr, param);
+       } else {
+           SvIV_set(dstr, SvIVX(sstr));
+       }
        break;
     case SVt_NV:
        SvANY(dstr)     = new_XNV();
        SvNV_set(dstr, SvNVX(sstr));
        break;
-    case SVt_RV:
-       SvANY(dstr)     = &(dstr->sv_u.svu_rv);
-       Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-       break;
        /* case SVt_BIND: */
     default:
        {
diff --git a/sv.h b/sv.h
index db2843b..37b79c9 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -47,12 +47,13 @@ typedef enum {
        SVt_NULL,       /* 0 */
        SVt_BIND,       /* 1 */
        SVt_IV,         /* 2 */
-       SVt_RV,         /* 3 */
-       SVt_NV,         /* 4 */
-       SVt_PV,         /* 5 */
-       SVt_PVIV,       /* 6 */
-       SVt_PVNV,       /* 7 */
-       SVt_PVMG,       /* 8 */
+       SVt_NV,         /* 3 */
+       /* RV was here, before it was merged with IV.  */
+       SVt_PV,         /* 4 */
+       SVt_PVIV,       /* 5 */
+       SVt_PVNV,       /* 6 */
+       SVt_PVMG,       /* 7 */
+       SVt_ORANGE,     /* 8 */
        /* PVBM was here, before BIND replaced it.  */
        SVt_PVGV,       /* 9 */
        SVt_PVLV,       /* 10 */
@@ -69,6 +70,9 @@ typedef enum {
    purposes eternal code wanting to consider PVBM probably needs to think of
    PVMG instead.  */
 #  define SVt_PVBM     SVt_PVMG
+/* Anything wanting to create a reference from clean should ensure that it has
+   a scalar of type SVt_IV now:  */
+#  define SVt_RV       SVt_IV
 #endif
 
 /* There is collusion here with sv_clear - sv_clear exits early for SVt_NULL
@@ -1298,7 +1302,7 @@ the scalar's value cannot change unless written to.
         }))
 #    define SvRV(sv)                                                   \
        (*({ SV *const _svi = (SV *) (sv);                              \
-           assert(SvTYPE(_svi) >= SVt_PV || SvTYPE(_svi) == SVt_RV);   \
+           assert(SvTYPE(_svi) >= SVt_PV || SvTYPE(_svi) == SVt_IV);   \
            assert(SvTYPE(_svi) != SVt_PVAV);                           \
            assert(SvTYPE(_svi) != SVt_PVHV);                           \
            assert(SvTYPE(_svi) != SVt_PVCV);                           \
@@ -1383,7 +1387,7 @@ the scalar's value cannot change unless written to.
                assert(!isGV_with_GP(sv));              \
                (((XPVUV*)SvANY(sv))->xuv_uv = (val)); } STMT_END
 #define SvRV_set(sv, val) \
-        STMT_START { assert(SvTYPE(sv) >=  SVt_PV || SvTYPE(sv) ==  SVt_RV); \
+        STMT_START { assert(SvTYPE(sv) >=  SVt_PV || SvTYPE(sv) ==  SVt_IV); \
                assert(SvTYPE(sv) != SVt_PVAV);         \
                assert(SvTYPE(sv) != SVt_PVHV);         \
                assert(SvTYPE(sv) != SVt_PVCV);         \