# define HvTOTALKEYS(hv) HvKEYS(hv)
#endif
+#ifdef SVf_IsCOW
+# define SvTRULYREADONLY(sv) SvREADONLY(sv)
+#else
+# define SvTRULYREADONLY(sv) (SvREADONLY(sv) && !SvIsCOW(sv))
+#endif
+
#ifdef DEBUGME
#ifndef DASSERT
#define SX_WEAKOVERLOAD C(28) /* Overloaded weak reference */
#define SX_VSTRING C(29) /* vstring forthcoming (small) */
#define SX_LVSTRING C(30) /* vstring forthcoming (large) */
-#define SX_ERROR C(31) /* Error */
+#define SX_SVUNDEF_ELEM C(31) /* array element set to &PL_sv_undef */
+#define SX_ERROR C(32) /* Error */
/*
* Those are only used to retrieve "old" pre-0.6 binary images.
#define INIT_STCXT \
dSTCXT; \
NEW_STORABLE_CXT_OBJ(cxt); \
+ assert(perinterp_sv); \
sv_setiv(perinterp_sv, PTR2IV(cxt->my_sv))
#define SET_STCXT(x) \
#endif
#define STORABLE_BIN_MAJOR 2 /* Binary major "version" */
-#define STORABLE_BIN_MINOR 9 /* Binary minor "version" */
+#define STORABLE_BIN_MINOR 10 /* Binary minor "version" */
#if (PATCHLEVEL <= 5)
#define STORABLE_BIN_WRITE_MINOR 4
* Perl 5.6.0-5.8.0 can do weak references, but not vstring magic.
*/
#define STORABLE_BIN_WRITE_MINOR 8
+#elif PATCHLEVEL >= 19
+/* Perl 5.19 takes away the special meaning of PL_sv_undef in arrays. */
+#define STORABLE_BIN_WRITE_MINOR 10
#else
#define STORABLE_BIN_WRITE_MINOR 9
#endif /* (PATCHLEVEL <= 5) */
#ifdef HAS_HTONL
#define WLEN(x) \
STMT_START { \
+ ASSERT(sizeof(x) == sizeof(int), ("WLEN writing an int")); \
if (cxt->netorder) { \
int y = (int) htonl(x); \
if (!cxt->fio) \
#define STORE_SCALAR(pv, len) STORE_PV_LEN(pv, len, SX_SCALAR, SX_LSCALAR)
/*
- * Store &PL_sv_undef in arrays without recursing through store().
+ * Store &PL_sv_undef in arrays without recursing through store(). We
+ * actually use this to represent nonexistent elements, for historical
+ * reasons.
*/
#define STORE_SV_UNDEF() \
STMT_START { \
} STMT_END
/*
- * This macro is used at retrieve time, to remember where object 'y', bearing a
+ * SEEN() is used at retrieve time, to remember where object 'y', bearing a
* given tag 'tagnum', has been retrieved. Next time we see an SX_OBJECT marker,
* we'll therefore know where it has been retrieved and will be able to
* share the same reference, as in the original stored memory image.
* will bless the object.
*
* i should be true iff sv is immortal (ie PL_sv_yes, PL_sv_no or PL_sv_undef)
+ *
+ * SEEN0() is a short-cut where stash is always NULL.
+ *
+ * The _NN variants dont check for y being null
*/
-#define SEEN(y,c,i) \
- STMT_START { \
- if (!y) \
- return (SV *) 0; \
+#define SEEN0_NN(y,i) \
+ STMT_START { \
if (av_store(cxt->aseen, cxt->tagnum++, i ? (SV*)(y) : SvREFCNT_inc(y)) == 0) \
return (SV *) 0; \
- TRACEME(("aseen(#%d) = 0x%"UVxf" (refcnt=%d)", cxt->tagnum-1, \
- PTR2UV(y), SvREFCNT(y)-1)); \
- if (c) \
- BLESS((SV *) (y), c); \
- } STMT_END
+ TRACEME(("aseen(#%d) = 0x%"UVxf" (refcnt=%d)", cxt->tagnum-1, \
+ PTR2UV(y), SvREFCNT(y)-1)); \
+ } STMT_END
+
+#define SEEN0(y,i) \
+ STMT_START { \
+ if (!y) \
+ return (SV *) 0; \
+ SEEN0_NN(y,i) \
+ } STMT_END
+
+#define SEEN_NN(y,stash,i) \
+ STMT_START { \
+ SEEN0_NN(y,i); \
+ if (stash) \
+ BLESS((SV *) (y), (HV *)(stash)); \
+ } STMT_END
+
+#define SEEN(y,stash,i) \
+ STMT_START { \
+ if (!y) \
+ return (SV *) 0; \
+ SEEN_NN(y,stash, i); \
+ } STMT_END
/*
* Bless 's' in 'p', via a temporary reference, required by sv_bless().
* "A" magic is added before the sv_bless for overloaded classes, this avoids
* an expensive call to S_reset_amagic in sv_bless.
*/
-#define BLESS(s,p) \
+#define BLESS(s,stash) \
STMT_START { \
SV *ref; \
- HV *stash; \
- TRACEME(("blessing 0x%"UVxf" in %s", PTR2UV(s), (p))); \
- stash = gv_stashpv((p), GV_ADD); \
+ TRACEME(("blessing 0x%"UVxf" in %s", PTR2UV(s), (HvNAME_get(stash)))); \
ref = newRV_noinc(s); \
if (cxt->in_retrieve_overloaded && Gv_AMG(stash)) \
{ \
(sv_retrieve_t)retrieve_byte, /* SX_BYTE */
(sv_retrieve_t)retrieve_netint, /* SX_NETINT */
(sv_retrieve_t)retrieve_scalar, /* SX_SCALAR */
- (sv_retrieve_t)retrieve_tied_array, /* SX_ARRAY */
- (sv_retrieve_t)retrieve_tied_hash, /* SX_HASH */
- (sv_retrieve_t)retrieve_tied_scalar, /* SX_SCALAR */
+ (sv_retrieve_t)retrieve_tied_array, /* SX_TIED_ARRAY */
+ (sv_retrieve_t)retrieve_tied_hash, /* SX_TIED_HASH */
+ (sv_retrieve_t)retrieve_tied_scalar, /* SX_TIED_SCALAR */
(sv_retrieve_t)retrieve_other, /* SX_SV_UNDEF not supported */
(sv_retrieve_t)retrieve_other, /* SX_SV_YES not supported */
(sv_retrieve_t)retrieve_other, /* SX_SV_NO not supported */
(sv_retrieve_t)retrieve_other, /* SX_WEAKOVERLOAD not supported */
(sv_retrieve_t)retrieve_other, /* SX_VSTRING not supported */
(sv_retrieve_t)retrieve_other, /* SX_LVSTRING not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_SVUNDEF_ELEM not supported */
(sv_retrieve_t)retrieve_other, /* SX_ERROR */
};
static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, const char *cname);
static SV *retrieve_vstring(pTHX_ stcxt_t *cxt, const char *cname);
static SV *retrieve_lvstring(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_svundef_elem(pTHX_ stcxt_t *cxt, const char *cname);
static const sv_retrieve_t sv_retrieve[] = {
0, /* SX_OBJECT -- entry unused dynamically */
(sv_retrieve_t)retrieve_byte, /* SX_BYTE */
(sv_retrieve_t)retrieve_netint, /* SX_NETINT */
(sv_retrieve_t)retrieve_scalar, /* SX_SCALAR */
- (sv_retrieve_t)retrieve_tied_array, /* SX_ARRAY */
- (sv_retrieve_t)retrieve_tied_hash, /* SX_HASH */
- (sv_retrieve_t)retrieve_tied_scalar, /* SX_SCALAR */
+ (sv_retrieve_t)retrieve_tied_array, /* SX_TIED_ARRAY */
+ (sv_retrieve_t)retrieve_tied_hash, /* SX_TIED_HASH */
+ (sv_retrieve_t)retrieve_tied_scalar, /* SX_TIED_SCALAR */
(sv_retrieve_t)retrieve_sv_undef, /* SX_SV_UNDEF */
(sv_retrieve_t)retrieve_sv_yes, /* SX_SV_YES */
(sv_retrieve_t)retrieve_sv_no, /* SX_SV_NO */
(sv_retrieve_t)retrieve_weakoverloaded, /* SX_WEAKOVERLOAD */
(sv_retrieve_t)retrieve_vstring, /* SX_VSTRING */
(sv_retrieve_t)retrieve_lvstring, /* SX_LVSTRING */
+ (sv_retrieve_t)retrieve_svundef_elem, /* SX_SVUNDEF_ELEM */
(sv_retrieve_t)retrieve_other, /* SX_ERROR */
};
ASSERT(!cxt->s_dirty, ("clean context"));
ASSERT(prev, ("not freeing root context"));
+ assert(prev);
SvREFCNT_dec(cxt->my_sv);
SET_STCXT(prev);
*** Predicates.
***/
+/* these two functions are currently only used within asserts */
+#ifdef DASSERT
/*
* is_storing
*
return cxt->entry && (cxt->optype & ST_RETRIEVE);
}
+#endif
/*
* last_op_in_netorder
{
dSTCXT;
+ assert(cxt);
return cxt->netorder;
}
string:
#ifdef SvVOK
- if (SvMAGICAL(sv) && (mg = mg_find(sv, 'V')))
+ if (SvMAGICAL(sv) && (mg = mg_find(sv, 'V'))) {
+ /* The macro passes this by address, not value, and a lot of
+ called code assumes that it's 32 bits without checking. */
+ const int len = mg->mg_len;
STORE_PV_LEN((const char *)mg->mg_ptr,
- mg->mg_len, SX_VSTRING, SX_LVSTRING);
+ len, SX_VSTRING, SX_LVSTRING);
+ }
#endif
wlen = (I32) len; /* WLEN via STORE_SCALAR expects I32 */
for (i = 0; i < len; i++) {
sav = av_fetch(av, i, 0);
if (!sav) {
- TRACEME(("(#%d) undef item", i));
+ TRACEME(("(#%d) nonexistent item", i));
STORE_SV_UNDEF();
continue;
}
+#if PATCHLEVEL >= 19
+ /* In 5.19.3 and up, &PL_sv_undef can actually be stored in
+ * an array; it no longer represents nonexistent elements.
+ * Historically, we have used SX_SV_UNDEF in arrays for
+ * nonexistent elements, so we use SX_SVUNDEF_ELEM for
+ * &PL_sv_undef itself. */
+ if (*sav == &PL_sv_undef) {
+ TRACEME(("(#%d) undef item", i));
+ cxt->tagnum++;
+ PUTMARK(SX_SVUNDEF_ELEM);
+ continue;
+ }
+#endif
TRACEME(("(#%d) item", i));
if ((ret = store(aTHX_ cxt, *sav))) /* Extra () for -Wall, grr... */
return ret;
/* Implementation of restricted hashes isn't nicely
abstracted: */
if ((hash_flags & SHV_RESTRICTED)
- && SvREADONLY(val) && !SvIsCOW(val)) {
+ && SvTRULYREADONLY(val)) {
flags |= SHV_K_LOCKED;
}
abstracted: */
flags
= (((hash_flags & SHV_RESTRICTED)
- && SvREADONLY(val) && !SvIsCOW(val))
+ && SvTRULYREADONLY(val))
? SHV_K_LOCKED : 0);
if (val == &PL_sv_placeholder) {
TRACEME(("(#%d) key '%s'", i, key));
}
if (flags & SHV_K_ISSV) {
- store(aTHX_ cxt, key_sv);
+ int ret;
+ if ((ret = store(aTHX_ cxt, key_sv)))
+ goto out;
} else {
WLEN(len);
if (len)
* blessed code references.
*/
/* Ownership of both SVs is passed to load_module, which frees them. */
- load_module(PERL_LOADMOD_NOIMPORT, newSVpvn("B::Deparse",10), newSVnv(0.61));
+ load_module(PERL_LOADMOD_NOIMPORT, newSVpvs("B::Deparse"), newSVnv(0.61));
SPAGAIN;
ENTER;
*/
if (!count) {
+ /* free empty list returned by the hook */
+ av_undef(av);
+ sv_free((SV *) av);
+
/*
* They must not change their mind in the middle of a serialization.
*/
return SvROK(sv) ? svis_REF : svis_SCALAR;
case SVt_PVMG:
case SVt_PVLV: /* Workaround for perl5.004_04 "LVALUE" bug */
- if (SvRMAGICAL(sv) && (mg_find(sv, 'p')))
+ if ((SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) ==
+ (SVs_GMG|SVs_SMG|SVs_RMG) &&
+ (mg_find(sv, 'p')))
return svis_TIED_ITEM;
/* FALL THROUGH */
#if PERL_VERSION < 9
case SVt_PVBM:
#endif
- if (SvRMAGICAL(sv) && (mg_find(sv, 'q')))
+ if ((SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) ==
+ (SVs_GMG|SVs_SMG|SVs_RMG) &&
+ (mg_find(sv, 'q')))
return svis_TIED;
return SvROK(sv) ? svis_REF : svis_SCALAR;
case SVt_PVAV:
* Write magic number and system information into the file.
* Layout is <magic> <network> [<len> <byteorder> <sizeof int> <sizeof long>
* <sizeof ptr>] where <len> is the length of the byteorder hexa string.
- * All size and lenghts are written as single characters here.
+ * All size and lengths are written as single characters here.
*
* Note that no byte ordering info is emitted when <network> is true, since
* integers will be emitted in network order in that case.
* free up memory for them now.
*/
+ assert(cxt);
if (cxt->s_dirty)
clean_context(aTHX_ cxt);
{
dSTCXT;
+ assert(cxt);
return newSVpv(mbase, MBUF_SIZE());
}
default:
return retrieve_other(aTHX_ cxt, 0); /* Let it croak */
}
- SEEN(sv, 0, 0); /* Don't bless yet */
+ SEEN0_NN(sv, 0); /* Don't bless yet */
/*
* Whilst flags tell us to recurse, do so.
/*
* Look up the STORABLE_attach hook
*/
- stash = gv_stashpv(classname, 0);
- if (!stash) {
- CROAK(("Can't find stash for class '%s'", classname));
- }
+ stash = gv_stashpv(classname, GV_ADD);
/* Handle attach case; again can't use pkg_can because it only
* caches one method */
SvREFCNT_dec(sv);
/* we need to free RV but preserve value that RV point to */
sv = SvRV(attached);
- SEEN(sv, 0, 0);
+ SEEN0_NN(sv, 0);
SvRV_set(attached, NULL);
SvREFCNT_dec(attached);
if (!(flags & SHF_IDX_CLASSNAME) && classname != buf)
* Bless the object and look up the STORABLE_thaw hook.
*/
- BLESS(sv, classname);
+ BLESS(sv, stash);
- hook = pkg_can(aTHX_ cxt->hook, SvSTASH(sv), "STORABLE_thaw");
+ hook = pkg_can(aTHX_ cxt->hook, stash, "STORABLE_thaw");
if (!hook) {
/*
* Hook not found. Maybe they did not require the module where this
{
SV *rv;
SV *sv;
+ HV *stash;
TRACEME(("retrieve_ref (#%d)", cxt->tagnum));
*/
rv = NEWSV(10002, 0);
- SEEN(rv, cname, 0); /* Will return if rv is null */
+ if (cname)
+ stash = gv_stashpv(cname, GV_ADD);
+ else
+ stash = 0;
+ SEEN_NN(rv, stash, 0); /* Will return if rv is null */
sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
*/
rv = NEWSV(10002, 0);
- SEEN(rv, cname, 0); /* Will return if rv is null */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(rv, stash, 0); /* Will return if rv is null */
cxt->in_retrieve_overloaded = 1; /* so sv_bless doesn't call S_reset_amagic */
sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */
cxt->in_retrieve_overloaded = 0;
{
SV *tv;
SV *sv;
+ HV *stash;
TRACEME(("retrieve_tied_array (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname, 0); /* Will return if tv is null */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(tv, stash, 0); /* Will return if tv is null */
sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
{
SV *tv;
SV *sv;
+ HV *stash;
TRACEME(("retrieve_tied_hash (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname, 0); /* Will return if tv is null */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(tv, stash, 0); /* Will return if tv is null */
sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
{
SV *tv;
SV *sv, *obj = NULL;
+ HV *stash;
TRACEME(("retrieve_tied_scalar (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname, 0); /* Will return if rv is null */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(tv, stash, 0); /* Will return if rv is null */
sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */
if (!sv) {
return (SV *) 0; /* Failed */
SV *tv;
SV *sv;
SV *key;
+ HV *stash;
TRACEME(("retrieve_tied_key (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname, 0); /* Will return if tv is null */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(tv, stash, 0); /* Will return if tv is null */
sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
{
SV *tv;
SV *sv;
+ HV *stash;
I32 idx;
TRACEME(("retrieve_tied_idx (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname, 0); /* Will return if tv is null */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(tv, stash, 0); /* Will return if tv is null */
sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
{
I32 len;
SV *sv;
+ HV *stash;
RLEN(len);
TRACEME(("retrieve_lscalar (#%d), len = %"IVdf, cxt->tagnum, (IV) len));
*/
sv = NEWSV(10002, len);
- SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */
if (len == 0) {
sv_setpvn(sv, "", 0);
{
int len;
SV *sv;
+ HV *stash;
GETMARK(len);
TRACEME(("retrieve_scalar (#%d), len = %d", cxt->tagnum, len));
*/
sv = NEWSV(10002, len);
- SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */
/*
* WARNING: duplicates parts of sv_setpv and breaks SV data encapsulation.
static SV *retrieve_vstring(pTHX_ stcxt_t *cxt, const char *cname)
{
#ifdef SvVOK
- MAGIC *mg;
char s[256];
int len;
SV *sv;
static SV *retrieve_lvstring(pTHX_ stcxt_t *cxt, const char *cname)
{
#ifdef SvVOK
- MAGIC *mg;
char *s;
I32 len;
SV *sv;
static SV *retrieve_integer(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
+ HV *stash;
IV iv;
TRACEME(("retrieve_integer (#%d)", cxt->tagnum));
READ(&iv, sizeof(iv));
sv = newSViv(iv);
- SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("integer %"IVdf, iv));
TRACEME(("ok (retrieve_integer at 0x%"UVxf")", PTR2UV(sv)));
static SV *retrieve_netint(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
+ HV *stash;
I32 iv;
TRACEME(("retrieve_netint (#%d)", cxt->tagnum));
sv = newSViv(iv);
TRACEME(("network integer (as-is) %d", iv));
#endif
- SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("ok (retrieve_netint at 0x%"UVxf")", PTR2UV(sv)));
static SV *retrieve_double(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
+ HV *stash;
NV nv;
TRACEME(("retrieve_double (#%d)", cxt->tagnum));
READ(&nv, sizeof(nv));
sv = newSVnv(nv);
- SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("double %"NVff, nv));
TRACEME(("ok (retrieve_double at 0x%"UVxf")", PTR2UV(sv)));
static SV *retrieve_byte(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
+ HV *stash;
int siv;
signed char tmp; /* Workaround for AIX cc bug --H.Merijn Brand */
TRACEME(("small integer read as %d", (unsigned char) siv));
tmp = (unsigned char) siv - 128;
sv = newSViv(tmp);
- SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("byte %d", tmp));
TRACEME(("ok (retrieve_byte at 0x%"UVxf")", PTR2UV(sv)));
*/
static SV *retrieve_undef(pTHX_ stcxt_t *cxt, const char *cname)
{
- SV* sv;
+ SV *sv;
+ HV *stash;
TRACEME(("retrieve_undef"));
sv = newSV(0);
- SEEN(sv, cname, 0);
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 0);
return sv;
}
static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv = &PL_sv_undef;
+ HV *stash;
TRACEME(("retrieve_sv_undef"));
if (cxt->where_is_undef == -1) {
cxt->where_is_undef = cxt->tagnum;
}
- SEEN(sv, cname, 1);
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 1);
return sv;
}
static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv = &PL_sv_yes;
+ HV *stash;
TRACEME(("retrieve_sv_yes"));
- SEEN(sv, cname, 1);
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 1);
return sv;
}
static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv = &PL_sv_no;
+ HV *stash;
TRACEME(("retrieve_sv_no"));
- SEEN(sv, cname, 1);
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 1);
return sv;
}
/*
+ * retrieve_svundef_elem
+ *
+ * Return &PL_sv_placeholder, representing &PL_sv_undef in an array. This
+ * is a bit of a hack, but we already use SX_SV_UNDEF to mean a nonexistent
+ * element, for historical reasons.
+ */
+static SV *retrieve_svundef_elem(pTHX_ stcxt_t *cxt, const char *cname)
+{
+ TRACEME(("retrieve_svundef_elem"));
+
+ /* SEEN reads the contents of its SV argument, which we are not
+ supposed to do with &PL_sv_placeholder. */
+ SEEN_NN(&PL_sv_undef, cname, 1);
+
+ return &PL_sv_placeholder;
+}
+
+/*
* retrieve_array
*
* Retrieve a whole array.
I32 i;
AV *av;
SV *sv;
+ HV *stash;
+ bool seen_null = FALSE;
TRACEME(("retrieve_array (#%d)", cxt->tagnum));
RLEN(len);
TRACEME(("size = %d", len));
av = newAV();
- SEEN(av, cname, 0); /* Will return if array not allocated nicely */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(av, stash, 0); /* Will return if array not allocated nicely */
if (len)
av_extend(av, len);
else
sv = retrieve(aTHX_ cxt, 0); /* Retrieve item */
if (!sv)
return (SV *) 0;
+ if (sv == &PL_sv_undef) {
+ seen_null = TRUE;
+ continue;
+ }
+ if (sv == &PL_sv_placeholder)
+ sv = &PL_sv_undef;
if (av_store(av, i, sv) == 0)
return (SV *) 0;
}
+ if (seen_null) av_fill(av, len-1);
TRACEME(("ok (retrieve_array at 0x%"UVxf")", PTR2UV(av)));
I32 i;
HV *hv;
SV *sv;
+ HV *stash;
TRACEME(("retrieve_hash (#%d)", cxt->tagnum));
RLEN(len);
TRACEME(("size = %d", len));
hv = newHV();
- SEEN(hv, cname, 0); /* Will return if table not allocated properly */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(hv, stash, 0); /* Will return if table not allocated properly */
if (len == 0)
return (SV *) hv; /* No data follow if table empty */
hv_ksplit(hv, len + 1); /* pre-extend hash to save multiple splits */
I32 i;
HV *hv;
SV *sv;
+ HV *stash;
int hash_flags;
GETMARK(hash_flags);
RLEN(len);
TRACEME(("size = %d, flags = %d", len, hash_flags));
hv = newHV();
- SEEN(hv, cname, 0); /* Will return if table not allocated properly */
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(hv, stash, 0); /* Will return if table not allocated properly */
if (len == 0)
return (SV *) hv; /* No data follow if table empty */
hv_ksplit(hv, len + 1); /* pre-extend hash to save multiple splits */
int type, count, tagnum;
SV *cv;
SV *sv, *text, *sub, *errsv;
+ HV *stash;
TRACEME(("retrieve_code (#%d)", cxt->tagnum));
*/
tagnum = cxt->tagnum;
sv = newSViv(0);
- SEEN(sv, cname, 0);
+ stash = cname ? gv_stashpv(cname, GV_ADD) : 0;
+ SEEN_NN(sv, stash, 0);
/*
* Retrieve the source of the code reference
* prepend "sub " to the source
*/
- sub = newSVpvn("sub ", 4);
+ sub = newSVpvs("sub ");
if (SvUTF8(text))
SvUTF8_on(sub);
sv_catpv(sub, SvPV_nolen(text)); /* XXX no sv_catsv! */
RLEN(len);
TRACEME(("size = %d", len));
av = newAV();
- SEEN(av, 0, 0); /* Will return if array not allocated nicely */
+ SEEN0_NN(av, 0); /* Will return if array not allocated nicely */
if (len)
av_extend(av, len);
else
RLEN(len);
TRACEME(("size = %d", len));
hv = newHV();
- SEEN(hv, 0, 0); /* Will return if table not allocated properly */
+ SEEN0_NN(hv, 0); /* Will return if table not allocated properly */
if (len == 0)
return (SV *) hv; /* No data follow if table empty */
hv_ksplit(hv, len + 1); /* pre-extend hash to save multiple splits */
if (cxt->ver_major < 2) {
while ((type = GETCHAR()) != SX_STORED) {
I32 len;
+ HV* stash;
switch (type) {
case SX_CLASS:
GETMARK(len); /* Length coded on a single char */
if (len)
READ(kbuf, len);
kbuf[len] = '\0'; /* Mark string end */
- BLESS(sv, kbuf);
+ stash = gv_stashpvn(kbuf, len, GV_ADD);
+ BLESS(sv, stash);
}
}
* free up memory for them now.
*/
+ assert(cxt);
if (cxt->s_dirty)
clean_context(aTHX_ cxt);
* free up memory for them now.
*/
+ assert(cxt);
if (cxt->s_dirty)
clean_context(aTHX_ cxt);
#if PERL_VERSION < 8
|| SvTYPE(sv) == SVt_PVMG
#endif
- ) && SvRMAGICAL(sv) && mg_find(sv, 'p')) {
+ ) && (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) ==
+ (SVs_GMG|SVs_SMG|SVs_RMG) &&
+ mg_find(sv, 'p')) {
mg_get(sv);
}
* Now, 'cxt' may refer to a new context.
*/
+ assert(cxt);
ASSERT(!cxt->s_dirty, ("clean context"));
ASSERT(!cxt->entry, ("entry will not cause new context allocation"));
static int
storable_free(pTHX_ SV *sv, MAGIC* mg) {
stcxt_t *cxt = (stcxt_t *)SvPVX(sv);
+
+ PERL_UNUSED_ARG(mg);
if (kbuf)
Safefree(kbuf);
if (!cxt->membuf_ro && mbase)
ALIAS:
net_mstore = 1
CODE:
+ RETVAL = &PL_sv_undef;
if (!do_store(aTHX_ (PerlIO*) 0, obj, 0, ix, &RETVAL))
RETVAL = &PL_sv_undef;
OUTPUT:
if (ix) {
dSTCXT;
+ assert(cxt);
result = cxt->entry && (cxt->optype & ix) ? TRUE : FALSE;
} else {
result = !!last_op_in_netorder(aTHX);