HV *hseen; /* which objects have been seen, store time */
AV *hook_seen; /* which SVs were returned by STORABLE_freeze() */
AV *aseen; /* which objects have been seen, retrieve time */
+ IV where_is_undef; /* index in aseen of PL_sv_undef */
HV *hclass; /* which classnames have been seen, store time */
AV *aclass; /* which classnames have been seen, retrieve time */
HV *hook; /* cache for hook methods per class name */
* To achieve that, the class name of the last retrieved object is passed down
* recursively, and the first SEEN() call for which the class name is not NULL
* will bless the object.
+ *
+ * i should be true iff sv is immortal (ie PL_sv_yes, PL_sv_no or PL_sv_undef)
*/
-#define SEEN(y,c) \
+#define SEEN(y,c,i) \
STMT_START { \
if (!y) \
return (SV *) 0; \
- if (av_store(cxt->aseen, cxt->tagnum++, SvREFCNT_inc(y)) == 0) \
+ 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)); \
? newHV() : 0);
cxt->aseen = newAV(); /* Where retrieved objects are kept */
+ cxt->where_is_undef = -1; /* Special case for PL_sv_undef */
cxt->aclass = newAV(); /* Where seen classnames are kept */
cxt->tagnum = 0; /* Have to count objects... */
cxt->classnum = 0; /* ...and class names as well */
av_undef(aseen);
sv_free((SV *) aseen);
}
+ cxt->where_is_undef = -1;
if (cxt->aclass) {
AV *aclass = cxt->aclass;
qsort((char *) AvARRAY(av), len, sizeof(SV *), sortcmp);
for (i = 0; i < len; i++) {
- unsigned char flags;
+#ifdef HAS_RESTRICTED_HASHES
+ int placeholders = HvPLACEHOLDERS(hv);
+#endif
+ unsigned char flags = 0;
char *keyval;
STRLEN keylen_tmp;
I32 keylen;
SV *key = av_shift(av);
+ /* This will fail if key is a placeholder.
+ Track how many placeholders we have, and error if we
+ "see" too many. */
HE *he = hv_fetch_ent(hv, key, 0, 0);
- SV *val = HeVAL(he);
- if (val == 0)
- return 1; /* Internal error, not I/O error */
+ SV *val;
+
+ if (he) {
+ if (!(val = HeVAL(he))) {
+ /* Internal error, not I/O error */
+ return 1;
+ }
+ } else {
+#ifdef HAS_RESTRICTED_HASHES
+ /* Should be a placeholder. */
+ if (placeholders-- < 0) {
+ /* This should not happen - number of
+ retrieves should be identical to
+ number of placeholders. */
+ return 1;
+ }
+ /* Value is never needed, and PL_sv_undef is
+ more space efficient to store. */
+ val = &PL_sv_undef;
+ ASSERT (flags == 0,
+ ("Flags not 0 but %d", flags));
+ flags = SHV_K_PLACEHOLDER;
+#else
+ return 1;
+#endif
+ }
/*
* Store value first.
/* Implementation of restricted hashes isn't nicely
abstracted: */
- flags
- = (((hash_flags & SHV_RESTRICTED)
- && SvREADONLY(val))
- ? SHV_K_LOCKED : 0);
- if (val == &PL_sv_placeholder)
- flags |= SHV_K_PLACEHOLDER;
+ if ((hash_flags & SHV_RESTRICTED) && SvREADONLY(val)) {
+ flags |= SHV_K_LOCKED;
+ }
keyval = SvPV(key, keylen_tmp);
keylen = keylen_tmp;
if (val == 0)
return 1; /* Internal error, not I/O error */
+ /* Implementation of restricted hashes isn't nicely
+ abstracted: */
+ flags
+ = (((hash_flags & SHV_RESTRICTED)
+ && SvREADONLY(val))
+ ? SHV_K_LOCKED : 0);
+
+ if (val == &PL_sv_placeholder) {
+ flags |= SHV_K_PLACEHOLDER;
+ val = &PL_sv_undef;
+ }
+
/*
* Store value first.
*/
if ((ret = store(cxt, val))) /* Extra () for -Wall, grr... */
goto out;
- /* Implementation of restricted hashes isn't nicely
- abstracted: */
- flags
- = (((hash_flags & SHV_RESTRICTED)
- && SvREADONLY(val))
- ? SHV_K_LOCKED : 0);
- if (val == &PL_sv_placeholder)
- flags |= SHV_K_PLACEHOLDER;
hek = HeKEY_hek(he);
len = HEK_LEN(hek);
svh = hv_fetch(hseen, (char *) &sv, sizeof(sv), FALSE);
if (svh) {
- I32 tagval = htonl(LOW_32BITS(*svh));
+ I32 tagval;
+
+ if (sv == &PL_sv_undef) {
+ /* We have seen PL_sv_undef before, but fake it as
+ if we have not.
+
+ Not the simplest solution to making restricted
+ hashes work on 5.8.0, but it does mean that
+ repeated references to the one true undef will
+ take up less space in the output file.
+ */
+ /* Need to jump past the next hv_store, because on the
+ second store of undef the old hash value will be
+ SV_REFCNT_DEC()ed, and as Storable cheats horribly
+ by storing non-SVs in the hash a SEGV will ensure.
+ Need to increase the tag number so that the
+ receiver has no idea what games we're up to. This
+ special casing doesn't affect hooks that store
+ undef, as the hook routine does its own lookup into
+ hseen. Also this means that any references back
+ to PL_sv_undef (from the pathological case of hooks
+ storing references to it) will find the seen hash
+ entry for the first time, as if we didn't have this
+ hackery here. (That hseen lookup works even on 5.8.0
+ because it's a key of &PL_sv_undef and a value
+ which is a tag number, not a value which is
+ PL_sv_undef.) */
+ cxt->tagnum++;
+ type = svis_SCALAR;
+ goto undef_special_case;
+ }
+
+ tagval = htonl(LOW_32BITS(*svh));
TRACEME(("object 0x%"UVxf" seen as #%d", PTR2UV(sv), ntohl(tagval)));
type = sv_type(sv);
+undef_special_case:
TRACEME(("storing 0x%"UVxf" tag #%d, type %d...",
PTR2UV(sv), cxt->tagnum, type));
default:
return retrieve_other(cxt, 0); /* Let it croak */
}
- SEEN(sv, 0); /* Don't bless yet */
+ SEEN(sv, 0, 0); /* Don't bless yet */
/*
* Whilst flags tell us to recurse, do so.
READ_I32(tag);
tag = ntohl(tag);
svh = av_fetch(cxt->aseen, tag, FALSE);
- if (!svh)
- CROAK(("Object #%"IVdf" should have been retrieved already",
- (IV) tag));
+ if (!svh) {
+ if (tag == cxt->where_is_undef) {
+ /* av_fetch uses PL_sv_undef internally, hence this
+ somewhat gruesome hack. */
+ xsv = &PL_sv_undef;
+ svh = &xsv;
+ } else {
+ CROAK(("Object #%"IVdf" should have been retrieved already",
+ (IV) tag));
+ }
+ }
xsv = *svh;
ary[i] = SvREFCNT_inc(xsv);
}
*/
rv = NEWSV(10002, 0);
- SEEN(rv, cname); /* Will return if rv is null */
+ SEEN(rv, cname, 0); /* Will return if rv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
*/
rv = NEWSV(10002, 0);
- SEEN(rv, cname); /* Will return if rv is null */
+ SEEN(rv, cname, 0); /* Will return if rv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
TRACEME(("retrieve_tied_array (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname); /* Will return if tv is null */
+ SEEN(tv, cname, 0); /* Will return if tv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
TRACEME(("retrieve_tied_hash (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname); /* Will return if tv is null */
+ SEEN(tv, cname, 0); /* Will return if tv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
TRACEME(("retrieve_tied_scalar (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname); /* Will return if rv is null */
+ SEEN(tv, cname, 0); /* Will return if rv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv) {
return (SV *) 0; /* Failed */
TRACEME(("retrieve_tied_key (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname); /* Will return if tv is null */
+ SEEN(tv, cname, 0); /* Will return if tv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
TRACEME(("retrieve_tied_idx (#%d)", cxt->tagnum));
tv = NEWSV(10002, 0);
- SEEN(tv, cname); /* Will return if tv is null */
+ SEEN(tv, cname, 0); /* Will return if tv is null */
sv = retrieve(cxt, 0); /* Retrieve <object> */
if (!sv)
return (SV *) 0; /* Failed */
*/
sv = NEWSV(10002, len);
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
/*
* WARNING: duplicates parts of sv_setpv and breaks SV data encapsulation.
*/
sv = NEWSV(10002, len);
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
/*
* WARNING: duplicates parts of sv_setpv and breaks SV data encapsulation.
READ(&iv, sizeof(iv));
sv = newSViv(iv);
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("integer %"IVdf, iv));
TRACEME(("ok (retrieve_integer at 0x%"UVxf")", PTR2UV(sv)));
sv = newSViv(iv);
TRACEME(("network integer (as-is) %d", iv));
#endif
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("ok (retrieve_netint at 0x%"UVxf")", PTR2UV(sv)));
READ(&nv, sizeof(nv));
sv = newSVnv(nv);
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("double %"NVff, nv));
TRACEME(("ok (retrieve_double at 0x%"UVxf")", PTR2UV(sv)));
TRACEME(("small integer read as %d", (unsigned char) siv));
tmp = (unsigned char) siv - 128;
sv = newSViv(tmp);
- SEEN(sv, cname); /* Associate this new scalar with tag "tagnum" */
+ SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */
TRACEME(("byte %d", tmp));
TRACEME(("ok (retrieve_byte at 0x%"UVxf")", PTR2UV(sv)));
TRACEME(("retrieve_undef"));
sv = newSV(0);
- SEEN(sv, cname);
+ SEEN(sv, cname, 0);
return sv;
}
TRACEME(("retrieve_sv_undef"));
- SEEN(sv, cname);
+ /* Special case PL_sv_undef, as av_fetch uses it internally to mark
+ deleted elements, and will return NULL (fetch failed) whenever it
+ is fetched. */
+ if (cxt->where_is_undef == -1) {
+ cxt->where_is_undef = cxt->tagnum;
+ }
+ SEEN(sv, cname, 1);
return sv;
}
TRACEME(("retrieve_sv_yes"));
- SEEN(sv, cname);
+ SEEN(sv, cname, 1);
return sv;
}
TRACEME(("retrieve_sv_no"));
- cxt->tagnum--; /* undo the tagnum increment in retrieve_l?scalar */
- SEEN(sv, cname);
+ SEEN(sv, cname, 1);
return sv;
}
RLEN(len);
TRACEME(("size = %d", len));
av = newAV();
- SEEN(av, cname); /* Will return if array not allocated nicely */
+ SEEN(av, cname, 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, cname); /* Will return if table not allocated properly */
+ SEEN(hv, cname, 0); /* Will return if table not allocated properly */
if (len == 0)
return (SV *) hv; /* No data follow if table empty */
hv_ksplit(hv, len); /* pre-extend hash to save multiple splits */
RLEN(len);
TRACEME(("size = %d, flags = %d", len, hash_flags));
hv = newHV();
- SEEN(hv, cname); /* Will return if table not allocated properly */
+ SEEN(hv, cname, 0); /* Will return if table not allocated properly */
if (len == 0)
return (SV *) hv; /* No data follow if table empty */
hv_ksplit(hv, len); /* pre-extend hash to save multiple splits */
*/
tagnum = cxt->tagnum;
sv = newSViv(0);
- SEEN(sv, cname);
+ SEEN(sv, cname, 0);
/*
* Retrieve the source of the code reference
RLEN(len);
TRACEME(("size = %d", len));
av = newAV();
- SEEN(av, 0); /* Will return if array not allocated nicely */
+ SEEN(av, 0, 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); /* Will return if table not allocated properly */
+ SEEN(hv, 0, 0); /* Will return if table not allocated properly */
if (len == 0)
return (SV *) hv; /* No data follow if table empty */
hv_ksplit(hv, len); /* pre-extend hash to save multiple splits */
https://perl5.git.perl.org / perl5.git / commitdiff