This is v2 of patch for views (nee binds), brought up to date with 5.15.chip/view2

This has not passed self-test, and is committed for sharing purposes.

8 files changed, 200 insertions, 114 deletions

diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
index fb25a78308..d0eaa4c9aa 100644
--- a/dist/Storable/Storable.xs
+++ b/dist/Storable/Storable.xs
@@ -3499,8 +3499,9 @@ static int sv_type(pTHX_ SV *sv)
 		return svis_HASH;
 	case SVt_PVCV:
 		return svis_CODE;
-#if PERL_VERSION > 8
-	/* case SVt_BIND: */
+#if PERL_VERSION > 14
+	/* case SVt_VIEW: */
+        /*  .... this case requires changing to SvVTYPE() above, and much else.  XXX TODO -Chip */
 #endif
 	default:
 		break;
diff --git a/dump.c b/dump.c
index c32807c24b..11737dc159 100644
--- a/dump.c
+++ b/dump.c
@@ -2741,7 +2741,7 @@ Perl_sv_xmlpeek(pTHX_ SV *sv)
     case SVt_PVGV:
 	sv_catpv(t, " GV=\"");
 	break;
-    case SVt_BIND:
+    case SVt_VIEW:
 	sv_catpv(t, " BIND=\"");
 	break;
     case SVt_REGEXP:
diff --git a/gv.c b/gv.c
index 79bc0e9c0c..09b7eb3461 100644
--- a/gv.c
+++ b/gv.c
@@ -221,7 +221,7 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
 	}
     }
 
-    SvANY(cv)->xcv_gv = gv;
+    ((XPVCV*) SvANY(cv))->xcv_gv = gv;
     assert(!CvCVGV_RC(cv));
 
     if (!gv)
@@ -246,7 +246,7 @@ Perl_cvstash_set(pTHX_ CV *cv, HV *st)
 	return;
     if (oldst)
 	sv_del_backref(MUTABLE_SV(oldst), MUTABLE_SV(cv));
-    SvANY(cv)->xcv_stash = st;
+    ((XPVCV*) SvANY(cv))->xcv_stash = st;
     if (st)
 	Perl_sv_add_backref(aTHX_ MUTABLE_SV(st), MUTABLE_SV(cv));
 }
diff --git a/handy.h b/handy.h
index b75eafb53f..21ef4917bb 100644
--- a/handy.h
+++ b/handy.h
@@ -116,6 +116,13 @@ Null SV pointer. (No longer available when C<PERL_CORE> is defined.)
 
 #define cBOOL(cbool) ((bool)!!(cbool))
 
+/* Inline functions - welcome to the 1980s */
+#if defined(_MSC_VER)
+#  define PINLINE static _inline
+#else
+#  define PINLINE static inline
+#endif
+
 /* Try to figure out __func__ or __FUNCTION__ equivalent, if any.
  * XXX Should really be a Configure probe, with HAS__FUNCTION__
  *     and FUNCTION__ as results.
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index b06fc7a408..58ba2c0747 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -28,6 +28,15 @@ here, but most should go in the L</Performance Enhancements> section.
 
 [ List each enhancement as a =head2 entry ]
 
+=head2 Views
+
+Views are almost-transparent references.  Using a view is almost like using
+the view's target.  However, if a view is read-only (and most are), attempts
+to modify the target through the view will fail.
+
+This feature has been introduced to allow efficient and safe passing of
+parameters by value.
+
 =head2 C<splice()> doesn't warn when truncating
 
 You can now limit the size of an array using C<splice(@a,MAX_LEN)> without
@@ -458,6 +467,25 @@ when a hash is freed that has had its current iterator deleted
 
 =back
 
+=head API Changes
+
+=head2 New type SVt_VIEW for views; replaces SVt_BIND
+
+A new type C<SVt_VIEW> has been added in support of L<views>.  This type is
+a renaming of C<SVt_BIND>.  Because the name C<SVt_BIND> was never given any
+semantic nor could ever be created or destroyed, it has been removed.
+
+=head2 Most API macros and functions follow views
+
+For backward compatibility and convenience, most Perl API macros and
+functions follow views transparently; e.g. if C<sv> is a view, then
+C<SvTYPE(sv)> is not C<SVt_VIEW>, but the type of the view's target.
+
+=head2 View-aware features added to API
+
+New macros and functions have been added to support examination of views,
+e.g. C<SvVTYPE(sv)> of a view is C<SVt_VIEW>.
+
 =head1 Known Problems
 
 XXX Descriptions of platform agnostic bugs we know we can't fix go here. Any
diff --git a/regexp.h b/regexp.h
index 5776a9023a..6242532814 100644
--- a/regexp.h
+++ b/regexp.h
@@ -422,54 +422,32 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
 #define RX_WRAPPED(prog)	SvPVX(prog)
 #define RX_WRAPPED_const(prog)	SvPVX_const(prog)
 #define RX_WRAPLEN(prog)	SvCUR(prog)
-#define RX_CHECK_SUBSTR(prog)	(((struct regexp *)SvANY(prog))->check_substr)
 #define RX_REFCNT(prog)		SvREFCNT(prog)
+
 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-#  define RX_EXTFLAGS(prog)						\
-    (*({								\
-	const REGEXP *const _rx_extflags = (prog);			\
-	assert(SvTYPE(_rx_extflags) == SVt_REGEXP);			\
-	&RXp_EXTFLAGS(SvANY(_rx_extflags));				\
-    }))
-#  define RX_ENGINE(prog)						\
-    (*({								\
-	const REGEXP *const _rx_engine = (prog);			\
-	assert(SvTYPE(_rx_engine) == SVt_REGEXP);			\
-	&SvANY(_rx_engine)->engine;					\
-    }))
-#  define RX_SUBBEG(prog)						\
-    (*({								\
-	const REGEXP *const _rx_subbeg = (prog);			\
-	assert(SvTYPE(_rx_subbeg) == SVt_REGEXP);			\
-	&SvANY(_rx_subbeg)->subbeg;					\
-    }))
-#  define RX_OFFS(prog)							\
-    (*({								\
-	const REGEXP *const _rx_offs = (prog);				\
-	assert(SvTYPE(_rx_offs) == SVt_REGEXP);				\
-	&SvANY(_rx_offs)->offs;						\
-    }))
-#  define RX_NPARENS(prog)						\
-    (*({								\
-	const REGEXP *const _rx_nparens = (prog);			\
-	assert(SvTYPE(_rx_nparens) == SVt_REGEXP);			\
-	&SvANY(_rx_nparens)->nparens;					\
+#  define RXp_ATTR(prog,attr)				\
+    (*({						\
+	const REGEXP *const _rx = RX_SKIPVIEW(prog);	\
+	assert(SvVTYPE(_rx) == SVt_REGEXP);		\
+	&SvVANY(_rx)->attr;				\
     }))
 #else
-#  define RX_EXTFLAGS(prog)	RXp_EXTFLAGS((struct regexp *)SvANY(prog))
-#  define RX_ENGINE(prog)	(((struct regexp *)SvANY(prog))->engine)
-#  define RX_SUBBEG(prog)	(((struct regexp *)SvANY(prog))->subbeg)
-#  define RX_OFFS(prog)		(((struct regexp *)SvANY(prog))->offs)
-#  define RX_NPARENS(prog)	(((struct regexp *)SvANY(prog))->nparens)
+#  define RXp_ATTR(prog,attr)	(((struct regexp *)SvANY(prog))->attr)
 #endif
-#define RX_SUBLEN(prog)		(((struct regexp *)SvANY(prog))->sublen)
-#define RX_MINLEN(prog)		(((struct regexp *)SvANY(prog))->minlen)
-#define RX_MINLENRET(prog)	(((struct regexp *)SvANY(prog))->minlenret)
-#define RX_GOFS(prog)		(((struct regexp *)SvANY(prog))->gofs)
-#define RX_LASTPAREN(prog)	(((struct regexp *)SvANY(prog))->lastparen)
-#define RX_LASTCLOSEPAREN(prog)	(((struct regexp *)SvANY(prog))->lastcloseparen)
-#define RX_SEEN_EVALS(prog)	(((struct regexp *)SvANY(prog))->seen_evals)
-#define RX_SAVED_COPY(prog)	(((struct regexp *)SvANY(prog))->saved_copy)
+#define RX_EXTFLAGS(prog)	RXp_ATTR(prog,extflags)
+#define RX_ENGINE(prog)		RXp_ATTR(prog,engine)
+#define RX_SUBBEG(prog)		RXp_ATTR(prog,subbeg)
+#define RX_OFFS(prog)		RXp_ATTR(prog,offs)
+#define RX_NPARENS(prog)	RXp_ATTR(prog,nparens)
+#define RX_CHECK_SUBSTR(prog)	RXp_ATTR(prog,check_substr)
+#define RX_SUBLEN(prog)		RXp_ATTR(prog,sublen)
+#define RX_MINLEN(prog)		RXp_ATTR(prog,minlen)
+#define RX_MINLENRET(prog)	RXp_ATTR(prog,minlenret)
+#define RX_GOFS(prog)		RXp_ATTR(prog,gofs)
+#define RX_LASTPAREN(prog)	RXp_ATTR(prog,lastparen)
+#define RX_LASTCLOSEPAREN(prog)	RXp_ATTR(prog,lastcloseparen)
+#define RX_SAVED_COPY(prog)	RXp_ATTR(prog,saved_copy)
+#define RX_SEEN_EVALS(prog)	(((struct regexp *)SvANY(prog))->seen_evals)  /* bitfield */
 
 #endif /* PLUGGABLE_RE_EXTENSION */
 
diff --git a/sv.c b/sv.c
index fffa6e99ed..94995e96b5 100644
--- a/sv.c
+++ b/sv.c
@@ -192,17 +192,17 @@ Public API:
 #endif
 
 #ifdef PERL_POISON
-#  define SvARENA_CHAIN(sv)	((sv)->sv_u.svu_rv)
+#  define SvARENA_CHAIN(sv)		((sv)->sv_u.svu_rv)
 #  define SvARENA_CHAIN_SET(sv,val)	(sv)->sv_u.svu_rv = MUTABLE_SV((val))
 /* Whilst I'd love to do this, it seems that things like to check on
    unreferenced scalars
-#  define POSION_SV_HEAD(sv)	PoisonNew(sv, 1, struct STRUCT_SV)
+#  define POSION_SV_HEAD(sv)		PoisonNew(sv, 1, struct STRUCT_SV)
 */
-#  define POSION_SV_HEAD(sv)	PoisonNew(&SvANY(sv), 1, void *), \
-				PoisonNew(&SvREFCNT(sv), 1, U32)
+#  define POSION_SV_HEAD(sv)		PoisonNew(&SvANY(sv), 1, void *), \
+					PoisonNew(&SvREFCNT(sv), 1, U32)
 #else
-#  define SvARENA_CHAIN(sv)	SvANY(sv)
-#  define SvARENA_CHAIN_SET(sv,val)	SvANY(sv) = (void *)(val)
+#  define SvARENA_CHAIN(sv)		SvVANY(sv)
+#  define SvARENA_CHAIN_SET(sv,val)	SvVANY(sv) = (void *)(val)
 #  define POSION_SV_HEAD(sv)
 #endif
 
@@ -263,9 +263,9 @@ S_new_SV(pTHX_ const char *file, int line, const char *func)
 	uproot_SV(sv);
     else
 	sv = S_more_sv(aTHX);
-    SvANY(sv) = 0;
+    SvVFLAGS(sv) = 0;
+    SvVANY(sv) = 0;
     SvREFCNT(sv) = 1;
-    SvFLAGS(sv) = 0;
     sv->sv_debug_optype = PL_op ? PL_op->op_type : 0;
     sv->sv_debug_line = (U16) (PL_parser && PL_parser->copline != NOLINE
 		? PL_parser->copline
@@ -294,9 +294,9 @@ S_new_SV(pTHX_ const char *file, int line, const char *func)
 	    uproot_SV(p);				\
 	else						\
 	    (p) = S_more_sv(aTHX);			\
-	SvANY(p) = 0;					\
+	SvVFLAGS(p) = 0;				\
+	SvVANY(p) = 0;					\
 	SvREFCNT(p) = 1;				\
-	SvFLAGS(p) = 0;					\
 	MEM_LOG_NEW_SV(p, __FILE__, __LINE__, FUNCTION__);  \
     } STMT_END
 #endif
@@ -324,7 +324,7 @@ S_del_sv(pTHX_ SV *p)
     if (DEBUG_D_TEST) {
 	SV* sva;
 	bool ok = 0;
-	for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvANY(sva))) {
+	for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvARENA_CHAIN(sva))) {
 	    const SV * const sv = sva + 1;
 	    const SV * const svend = &sva[SvREFCNT(sva)];
 	    if (p >= sv && p < svend) {
@@ -371,9 +371,9 @@ S_sv_add_arena(pTHX_ char *const ptr, const U32 size, const U32 flags)
     PERL_ARGS_ASSERT_SV_ADD_ARENA;
 
     /* The first SV in an arena isn't an SV. */
-    SvANY(sva) = (void *) PL_sv_arenaroot;		/* ptr to next arena */
+    SvVFLAGS(sva) = flags;			/* FAKE if not to be freed */
+    SvARENA_CHAIN_SET(sva, PL_sv_arenaroot);	/* ptr to next arena */
     SvREFCNT(sva) = size / sizeof(SV);		/* number of SV slots */
-    SvFLAGS(sva) = flags;			/* FAKE if not to be freed */
 
     PL_sv_arenaroot = sva;
     PL_sv_root = sva + 1;
@@ -387,14 +387,14 @@ S_sv_add_arena(pTHX_ char *const ptr, const U32 size, const U32 flags)
 #endif
 	/* Must always set typemask because it's always checked in on cleanup
 	   when the arenas are walked looking for objects.  */
-	SvFLAGS(sv) = SVTYPEMASK;
+	SvVFLAGS(sv) = SVTYPEMASK;
 	sv++;
     }
     SvARENA_CHAIN_SET(sv, 0);
 #ifdef DEBUGGING
     SvREFCNT(sv) = 0;
 #endif
-    SvFLAGS(sv) = SVTYPEMASK;
+    SvVFLAGS(sv) = SVTYPEMASK;
 }
 
 /* visit(): call the named function for each non-free SV in the arenas
@@ -409,13 +409,14 @@ S_visit(pTHX_ SVFUNC_t f, const U32 flags, const U32 mask)
 
     PERL_ARGS_ASSERT_VISIT;
 
-    for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvANY(sva))) {
+    for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvARENA_CHAIN(sva))) {
 	register const SV * const svend = &sva[SvREFCNT(sva)];
 	register SV* sv;
 	for (sv = sva + 1; sv < svend; ++sv) {
-	    if (SvTYPE(sv) != SVTYPEMASK
-		    && (sv->sv_flags & mask) == flags
-		    && SvREFCNT(sv))
+	    if (SvVTYPE(sv) != SVTYPEMASK
+		&& !SvVIEW(sv)
+		&& (SvVFLAGS(sv) & mask) == flags
+		&& SvREFCNT(sv))
 	    {
 		(FCALL)(aTHX_ sv);
 		++visited;
@@ -432,10 +433,8 @@ S_visit(pTHX_ SVFUNC_t f, const U32 flags, const U32 mask)
 static void
 do_report_used(pTHX_ SV *const sv)
 {
-    if (SvTYPE(sv) != SVTYPEMASK) {
-	PerlIO_printf(Perl_debug_log, "****\n");
-	sv_dump(sv);
-    }
+    PerlIO_printf(Perl_debug_log, "****\n");
+    sv_dump(sv);
 }
 #endif
 
@@ -875,16 +874,14 @@ struct body_details {
 
 #define copy_length(type, last_member) \
 	STRUCT_OFFSET(type, last_member) \
-	+ sizeof (((type*)SvANY((const SV *)0))->last_member)
+	+ sizeof (((type*)SvVANY((const SV *)0))->last_member)
 
 static const struct body_details bodies_by_type[] = {
     /* HEs use this offset for their arena.  */
     { 0, 0, 0, SVt_NULL, FALSE, NONV, NOARENA, 0 },
 
-    /* The bind placeholder pretends to be an RV for now.
-       Also it's marked as "can't upgrade" to stop anyone using it before it's
-       implemented.  */
-    { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
+    /* A bind is pretty much an RV, only it can't be upgraded. */
+    { 0, 0, 0, SVt_VIEW, TRUE, NONV, NOARENA, 0 },
 
     /* IVs are in the head, so the allocation size is 0.  */
     { 0,
@@ -4085,7 +4082,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV* sstr, const I32 flags)
 	    sv_upgrade(dstr, SVt_REGEXP);
 	break;
 
-	/* case SVt_BIND: */
+	/* case SVt_VIEW: */
     case SVt_PVLV:
     case SVt_PVGV:
     case SVt_PVMG:
@@ -5642,7 +5639,7 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
 			/* You lookin' at me?  */
 			assert(CvSTASH(referrer));
 			assert(CvSTASH(referrer) == (const HV *)sv);
-			SvANY(MUTABLE_CV(referrer))->xcv_stash = 0;
+			((XPVCV*) SvANY(MUTABLE_CV(referrer)))->xcv_stash = 0;
 		    }
 		    else {
 			assert(SvTYPE(sv) == SVt_PVGV);
@@ -5872,7 +5869,7 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv)
 
     /* will the CV shortly be freed by gp_free() ? */
     if (GvCV(gv) == cv && GvGP(gv)->gp_refcnt < 2 && SvREFCNT(cv) < 2) {
-	SvANY(cv)->xcv_gv = NULL;
+	((XPVCV*) SvANY(cv))->xcv_gv = NULL;
 	return;
     }
 
@@ -5886,7 +5883,7 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv)
 
     CvANON_on(cv);
     CvCVGV_RC_on(cv);
-    SvANY(cv)->xcv_gv = MUTABLE_GV(SvREFCNT_inc(anongv));
+    ((XPVCV*) SvANY(cv))->xcv_gv = MUTABLE_GV(SvREFCNT_inc(anongv));
 }
 
 
@@ -5965,7 +5962,7 @@ Perl_sv_clear(pTHX_ SV *const orig_sv)
 		SvREFCNT_dec(SvSTASH(sv));
 	}
 	switch (type) {
-	    /* case SVt_BIND: */
+	    /* case SVt_VIEW: */
 	case SVt_PVIO:
 	    if (IoIFP(sv) &&
 		IoIFP(sv) != PerlIO_stdin() &&
@@ -9108,7 +9105,7 @@ Perl_sv_reftype(pTHX_ const SV *const sv, const int ob)
 				    ? "GLOB" : "SCALAR");
 	case SVt_PVFM:		return "FORMAT";
 	case SVt_PVIO:		return "IO";
-	case SVt_BIND:		return "BIND";
+	case SVt_VIEW:		return "VIEW";
 	case SVt_REGEXP:	return "REGEXP";
 	default:		return "UNKNOWN";
 	}
@@ -11761,7 +11758,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 	SvANY(dstr)	= new_XNV();
 	SvNV_set(dstr, SvNVX(sstr));
 	break;
-	/* case SVt_BIND: */
+	/* case SVt_VIEW: */
     default:
 	{
 	    /* These are all the types that need complex bodies allocating.  */
@@ -12016,7 +12013,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 		/*FALLTHROUGH*/
 	    case SVt_PVFM:
 		/* NOTE: not refcounted */
-		SvANY(MUTABLE_CV(dstr))->xcv_stash =
+		((XPVCV*) SvANY(MUTABLE_CV(dstr)))->xcv_stash =
 		    hv_dup(CvSTASH(dstr), param);
 		if ((param->flags & CLONEf_JOIN_IN) && CvSTASH(dstr))
 		    Perl_sv_add_backref(aTHX_ MUTABLE_SV(CvSTASH(dstr)), dstr);
@@ -12031,7 +12028,7 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
 		}
 		/* don't dup if copying back - CvGV isn't refcounted, so the
 		 * duped GV may never be freed. A bit of a hack! DAPM */
-		SvANY(MUTABLE_CV(dstr))->xcv_gv =
+		((XPVCV*) SvANY(MUTABLE_CV(dstr)))->xcv_gv =
 		    CvCVGV_RC(dstr)
 		    ? gv_dup_inc(CvGV(sstr), param)
 		    : (param->flags & CLONEf_JOIN_IN)
diff --git a/sv.h b/sv.h
index 5f58935ddc..a39708115a 100644
--- a/sv.h
+++ b/sv.h
@@ -45,7 +45,7 @@ Type flag for code refs.  See C<svtype>.
 
 typedef enum {
 	SVt_NULL,	/* 0 */
-	SVt_BIND,	/* 1 */
+	SVt_VIEW,	/* 1 */
 	SVt_IV,		/* 2 */
 	SVt_NV,		/* 3 */
 	/* RV was here, before it was merged with IV.  */
@@ -54,7 +54,7 @@ typedef enum {
 	SVt_PVNV,	/* 6 */
 	SVt_PVMG,	/* 7 */
 	SVt_REGEXP,	/* 8 */
-	/* PVBM was here, before BIND replaced it.  */
+	/* PVBM was here, before VIEW replaced it.  */
 	SVt_PVGV,	/* 9 */
 	SVt_PVLV,	/* 10 */
 	SVt_PVAV,	/* 11 */
@@ -206,7 +206,23 @@ and faster.
 Decrements the reference count of the given SV.
 
 =for apidoc Am|svtype|SvTYPE|SV* sv
-Returns the type of the SV.  See C<svtype>.
+Returns the type of the SV (following views, as usual).  See C<svtype>.
+
+=for apidoc Am|svtype|SvVTYPE|SV* sv
+Returns the type of the SV--even if it's a view.  See C<svtype>.
+
+=for apidoc Am|svtype|SvFLAGS|SV* sv
+Returns the flags of the SV (following views, as usual), including the type.
+If the SV is a view, then SVf_READONLY may be included as a result.  Not an
+lvalue.
+
+=for apidoc Am|svtype|SvFLAGS|SV* sv
+Returns the flags of the SV (following views, as usual), including the type.
+If the SV is a view, then any extra SVf_READONLY will not be included.  Is
+an lvalue.
+
+=for apidoc Am|svtype|SvVFLAGS|SV* sv
+Returns the flags of the SV--even if it's a view--including the type.
 
 =for apidoc Am|void|SvUPGRADE|SV* sv|svtype type
 Used to upgrade an SV to a more complex form.  Uses C<sv_upgrade> to
@@ -215,8 +231,6 @@ perform the upgrade if necessary.  See C<svtype>.
 =cut
 */
 
-#define SvANY(sv)	(sv)->sv_any
-#define SvFLAGS(sv)	(sv)->sv_flags
 #define SvREFCNT(sv)	(sv)->sv_refcnt
 
 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
@@ -279,16 +293,6 @@ perform the upgrade if necessary.  See C<svtype>.
 #define SvREFCNT_dec(sv)	sv_free(MUTABLE_SV(sv))
 #endif
 
-#define SVTYPEMASK	0xff
-#define SvTYPE(sv)	((svtype)((sv)->sv_flags & SVTYPEMASK))
-
-/* Sadly there are some parts of the core that have pointers to already-freed
-   SV heads, and rely on being able to tell that they are now free. So mark
-   them all by using a consistent macro.  */
-#define SvIS_FREED(sv)	((sv)->sv_flags == SVTYPEMASK)
-
-#define SvUPGRADE(sv, mt) (SvTYPE(sv) >= (mt) || (sv_upgrade(sv, mt), 1))
-
 #define SVf_IOK		0x00000100  /* has valid public integer value */
 #define SVf_NOK		0x00000200  /* has valid public numeric value */
 #define SVf_POK		0x00000400  /* has valid public pointer value */
@@ -405,6 +409,81 @@ perform the upgrade if necessary.  See C<svtype>.
 /* RV upwards. However, SVf_ROK and SVp_IOK are exclusive  */
 #define SVprv_WEAKREF   0x80000000  /* Weak reference */
 
+#define SVTYPEMASK	0xff
+#define SvVTYPE(sv)	((svtype)((sv)->sv_flags & SVTYPEMASK))
+#define SvVFLAGS(sv)	(sv)->sv_flags
+#define SvVANY(sv)	(sv)->sv_any
+
+#define SvVIEW(sv)	(SvVTYPE(sv) == SVt_VIEW)
+#define SvVIEWEDx(sv)	((sv)->sv_u.svu_rv)
+
+#if defined (DEBUGGING) && !defined(PERL_DEBUG_COW) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+/* These get expanded inside other macros that already use a variable _sv  */
+#  define SvVIEWED(sv)							\
+	(*({ SV *const _svrv = MUTABLE_SV(sv);				\
+	    assert(SvVTYPE(_svrv) == SVt_VIEW);				\
+	    &SvVIEWEDx(_svrv);						\
+	 }))
+#  define SvVIEWED_const(sv)						\
+	({  const SV *const _svrv = (const SV *)(sv);			\
+	    assert(SvVTYPE(_svrv) == SVt_VIEW);				\
+	    &SvVIEWEDx(_svrv);						\
+	 })
+#else
+#  define SvVIEWED(sv)       SvVIEWEDx(sv)
+#  define SvVIEWED_const(sv) SvVIEWEDx(sv)
+#endif
+
+/* these macros remove const */
+#if defined(DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+
+#  define _S_sv_skipview(sv)					\
+    ({								\
+	const SV * const _bsv = (const SV *)(sv);		\
+	SvVIEW(_bsv) ? (SV*)SvVIEWEDx(_bsv) : (SV*)_bsv;	\
+    })
+
+#  define SvFLAGS_view(sv)							\
+    ({										\
+	const SV * const _bsv = (const SV *)(sv);				\
+	SvVIEW(_bsv)								\
+	    ? (SvVFLAGS(_bsv) & SVf_READONLY) | SvVFLAGS(SvVIEWEDx(_bsv)) 	\
+	    : SvVFLAGS(_bsv);							\
+    })
+
+#else
+
+    PINLINE SV *_S_sv_skipview(const void *sv) {
+	return SvVIEW((SV*)sv) ? (SV*)SvVIEWEDx((SV*)sv) : (SV*)sv;
+    }
+
+#  define SvFLAGS_view(sv)        _S_sv_flags_view((SV*)(sv))
+    PINLINE U32 _S_sv_flags_view(SV *sv) {
+	return SvVIEW(sv)
+		? (SvVFLAGS(sv) & SVf_READONLY) | SvVFLAGS(SvVIEWEDx(sv)))
+		: SvVFLAGS(sv);
+    }
+
+#endif
+
+#define SvTYPE(sv)		SvVTYPE(_S_sv_skipview(sv))
+#define SvFLAGS(sv)		SvVFLAGS(_S_sv_skipview(sv))
+#define SvANY(sv)		SvVANY(_S_sv_skipview(sv))
+
+/* XXX - THESE REMOVE CONST - DO WE NEED _const VARIANTS?  -Chip */
+#define SvSKIPVIEWt(type,sv)	((type*)_S_sv_skipview(sv))
+#define SvSKIPVIEW(sv)		SvSKIPVIEWt(SV,sv)
+#define AvSKIPVIEW(av)		SvSKIPVIEWt(AV,av)
+#define HvSKIPVIEW(hv)		SvSKIPVIEWt(HV,hv)
+#define RX_SKIPVIEW(rx)		SvSKIPVIEWt(REGEXP,rx) /* yay for inconsistent naming conventions */
+
+/* Sadly there are some parts of the core that have pointers to already-freed
+   SV heads, and rely on being able to tell that they are now free. So mark
+   them all by using a consistent macro.  */
+#define SvIS_FREED(sv)	((sv)->sv_flags == SVTYPEMASK)
+
+#define SvUPGRADE(sv, mt) (SvTYPE(sv) >= (mt) || (sv_upgrade(sv, mt), 1))
+
 #define _XPV_HEAD							\
     HV*		xmg_stash;	/* class package */			\
     union _xmgu	xmg_u;							\
@@ -739,17 +818,13 @@ Set the actual length of the string which is in the SV.  See C<SvIV_set>.
 #define assert_not_glob(sv)	
 #endif
 
-#define SvOK(sv)		((SvTYPE(sv) == SVt_BIND)		\
-				 ? (SvFLAGS(SvRV(sv)) & SVf_OK)		\
-				 : (SvFLAGS(sv) & SVf_OK))
-#define SvOK_off(sv)		(assert_not_ROK(sv) assert_not_glob(sv)	\
-				 SvFLAGS(sv) &=	~(SVf_OK|		\
-						  SVf_IVisUV|SVf_UTF8),	\
-							SvOOK_off(sv))
-#define SvOK_off_exc_UV(sv)	(assert_not_ROK(sv)			\
-				 SvFLAGS(sv) &=	~(SVf_OK|		\
-						  SVf_UTF8),		\
-							SvOOK_off(sv))
+#define SvOK(sv)		(SvFLAGS(sv) & SVf_OK)
+#define SvOK_off(sv)		(assert_not_ROK(sv) assert_not_glob(sv)			\
+				 SvFLAGS(sv) &= ~(SVf_OK|SVf_IVisUV|SVf_UTF8),	\
+						    SvOOK_off(sv))
+#define SvOK_off_exc_UV(sv)	(assert_not_ROK(sv)				\
+				 SvFLAGS(sv) &= ~(SVf_OK|SVf_UTF8),		\
+						    SvOOK_off(sv))
 
 #define SvOKp(sv)		(SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK))
 #define SvIOKp(sv)		(SvFLAGS(sv) & SVp_IOK)
@@ -923,9 +998,9 @@ the scalar's value cannot change unless written to.
 #define SvOBJECT_on(sv)		(SvFLAGS(sv) |= SVs_OBJECT)
 #define SvOBJECT_off(sv)	(SvFLAGS(sv) &= ~SVs_OBJECT)
 
-#define SvREADONLY(sv)		(SvFLAGS(sv) & SVf_READONLY)
-#define SvREADONLY_on(sv)	(SvFLAGS(sv) |= SVf_READONLY)
-#define SvREADONLY_off(sv)	(SvFLAGS(sv) &= ~SVf_READONLY)
+#define SvREADONLY(sv)		(SvFLAGS_view(sv) & SVf_READONLY)
+#define SvREADONLY_on(sv)	(SvFLAGS(sv)      |= SVf_READONLY)
+#define SvREADONLY_off(sv)	(SvFLAGS(sv)      &= ~SVf_READONLY)
 
 #define SvSCREAM(sv) ((SvFLAGS(sv) & (SVp_SCREAM|SVp_POK)) == (SVp_SCREAM|SVp_POK))
 #define SvSCREAM_on(sv)		(SvFLAGS(sv) |= SVp_SCREAM)