First class regexps.

p4raw-id: //depot/perl@32751

1 files changed, 20 insertions, 15 deletions

diff --git a/sv.c b/sv.c
index 585685e358..3e7c3ffda3 100644
--- a/sv.c
+++ b/sv.c
@@ -916,9 +916,10 @@ static const struct body_details bodies_by_type[] = {
     { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
 
-    /* 28 */
-    { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_ORANGE, FALSE, HADNV,
-      HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
+    /* 32 */
+    { sizeof(struct xregexp), copy_length(struct xregexp, xrx_regexp), 0,
+      SVt_REGEXP, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(struct xregexp))
+    },
 
     /* 48 */
     { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
@@ -1310,7 +1311,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     case SVt_PVGV:
     case SVt_PVCV:
     case SVt_PVLV:
-    case SVt_ORANGE:
+    case SVt_REGEXP:
     case SVt_PVMG:
     case SVt_PVNV:
     case SVt_PV:
@@ -2692,22 +2693,20 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 		STRLEN len;
 		char *retval;
 		char *buffer;
-		MAGIC *mg;
 		const SV *const referent = (SV*)SvRV(sv);
 
 		if (!referent) {
 		    len = 7;
 		    retval = buffer = savepvn("NULLREF", len);
-		} else if (SvTYPE(referent) == SVt_ORANGE
-			   && ((SvFLAGS(referent) &
-				(SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
-			       == (SVs_OBJECT|SVs_SMG))
-			   && (mg = mg_find(referent, PERL_MAGIC_qr)))
-                {
+		} else if (SvTYPE(referent) == SVt_REGEXP) {
                     char *str = NULL;
                     I32 haseval = 0;
                     U32 flags = 0;
-                    (str) = CALLREG_AS_STR(mg,lp,&flags,&haseval);
+		    struct magic temp;
+		    temp.mg_obj
+			= (SV*)((struct xregexp *)SvANY(referent))->xrx_regexp;
+		    assert(temp.mg_obj);
+                    (str) = CALLREG_AS_STR(&temp,lp,&flags,&haseval);
                     if (flags & 1)
 	                SvUTF8_on(sv);
                     else
@@ -5206,6 +5205,9 @@ Perl_sv_clear(pTHX_ register SV *sv)
 	Safefree(IoFMT_NAME(sv));
 	Safefree(IoBOTTOM_NAME(sv));
 	goto freescalar;
+    case SVt_REGEXP:
+	ReREFCNT_dec(((struct xregexp *)SvANY(sv))->xrx_regexp);
+	goto freescalar;
     case SVt_PVCV:
     case SVt_PVFM:
 	cv_undef((CV*)sv);
@@ -7771,7 +7773,7 @@ Perl_sv_reftype(pTHX_ const SV *sv, int ob)
 	case SVt_PVFM:		return "FORMAT";
 	case SVt_PVIO:		return "IO";
 	case SVt_BIND:		return "BIND";
-	case SVt_ORANGE:	return "ORANGE";
+	case SVt_REGEXP:	return "Regexp"; /* FIXME? to "REGEXP"  */
 	default:		return "UNKNOWN";
 	}
     }
@@ -10121,7 +10123,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
 	    case SVt_PVAV:
 	    case SVt_PVCV:
 	    case SVt_PVLV:
-	    case SVt_ORANGE:
+	    case SVt_REGEXP:
 	    case SVt_PVMG:
 	    case SVt_PVNV:
 	    case SVt_PVIV:
@@ -10176,7 +10178,10 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
 		break;
 	    case SVt_PVMG:
 		break;
-	    case SVt_ORANGE:
+	    case SVt_REGEXP:
+		((struct xregexp *)SvANY(dstr))->xrx_regexp
+		    = CALLREGDUPE(((struct xregexp *)SvANY(dstr))->xrx_regexp,
+				  param);
 		break;
 	    case SVt_PVLV:
 		/* XXX LvTARGOFF sometimes holds PMOP* when DEBUGGING */