#endif
#endif
-#ifdef HASATTRIBUTE
-# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
-# define PERL_UNUSED_DECL
+#ifndef SvRV_set
+#define SvRV_set(sv, val) \
+ STMT_START { \
+ assert(SvTYPE(sv) >= SVt_RV); \
+ (((XRV*)SvANY(sv))->xrv_rv = (val)); \
+ } STMT_END
+#endif
+
+#ifndef PERL_UNUSED_DECL
+# ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
# else
-# define PERL_UNUSED_DECL __attribute__((unused))
+# define PERL_UNUSED_DECL
# endif
-#else
-# define PERL_UNUSED_DECL
#endif
#ifndef dNOOP
#define dVAR dNOOP
#endif
+#ifndef HvRITER_set
+# define HvRITER_set(hv,r) (HvRITER(hv) = r)
+#endif
+#ifndef HvEITER_set
+# define HvEITER_set(hv,r) (HvEITER(hv) = r)
+#endif
+
+#ifndef HvRITER_get
+# define HvRITER_get HvRITER
+#endif
+#ifndef HvEITER_get
+# define HvEITER_get HvEITER
+#endif
+
+#ifndef HvNAME_get
+#define HvNAME_get HvNAME
+#endif
+
+#ifndef HvPLACEHOLDERS_get
+# define HvPLACEHOLDERS_get HvPLACEHOLDERS
+#endif
+
#ifdef DEBUGME
#ifndef DASSERT
#define HAS_HASH_KEY_FLAGS
#endif
+#ifdef ptr_table_new
+#define USE_PTR_TABLE
+#endif
+
/*
* Fields s_tainted and s_dirty are prefixed with s_ because Perl's include
* files remap tainted and dirty when threading is enabled. That's bad for
typedef struct stcxt {
int entry; /* flags recursion */
int optype; /* type of traversal operation */
- HV *hseen; /* which objects have been seen, store time */
+ /* which objects have been seen, store time.
+ tags are numbers, which are cast to (SV *) and stored directly */
+#ifdef USE_PTR_TABLE
+ /* use pseen if we have ptr_tables. We have to store tag+1, because
+ tag numbers start at 0, and we can't store (SV *) 0 in a ptr_table
+ without it being confused for a fetch lookup failure. */
+ struct ptr_tbl *pseen;
+ /* Still need hseen for the 0.6 file format code. */
+#endif
+ HV *hseen;
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 */
PerlIO *fio; /* where I/O are performed, NULL for memory */
int ver_major; /* major of version for retrieved object */
int ver_minor; /* minor of version for retrieved object */
- SV *(**retrieve_vtbl)(pTHX_ struct stcxt *, char *); /* retrieve dispatch table */
+ SV *(**retrieve_vtbl)(pTHX_ struct stcxt *, const char *); /* retrieve dispatch table */
SV *prev; /* contexts chained backwards in real recursion */
SV *my_sv; /* the blessed scalar who's SvPVX() I am */
} stcxt_t;
#endif /* PATCHLEVEL <= 6 */
static int store(pTHX_ stcxt_t *cxt, SV *sv);
-static SV *retrieve(pTHX_ stcxt_t *cxt, char *cname);
+static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname);
/*
* Dynamic dispatching table for SV store.
typedef int (*sv_store_t)(pTHX_ stcxt_t *cxt, SV *sv);
-static const sv_store_t sv_store[] = {
+static sv_store_t sv_store[] = {
(sv_store_t)store_ref, /* svis_REF */
(sv_store_t)store_scalar, /* svis_SCALAR */
(sv_store_t)store_array, /* svis_ARRAY */
* Dynamic dispatching tables for SV retrieval.
*/
-static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, char *cname);
-static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, char *cname);
-static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_ref(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_undef(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_integer(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_double(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_byte(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_netint(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_other(pTHX_ stcxt_t *cxt, char *cname);
-
-typedef SV* (*sv_retrieve_t)(pTHX_ stcxt_t *cxt, char *name);
+static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_ref(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_undef(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_integer(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_double(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_byte(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_netint(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_other(pTHX_ stcxt_t *cxt, const char *cname);
+
+typedef SV* (*sv_retrieve_t)(pTHX_ stcxt_t *cxt, const char *name);
static const sv_retrieve_t sv_old_retrieve[] = {
0, /* SX_OBJECT -- entry unused dynamically */
(sv_retrieve_t)retrieve_other, /* SX_ERROR */
};
-static SV *retrieve_array(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_hash(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_code(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, char *cname);
-static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, char *cname);
+static SV *retrieve_array(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, const char *cname);
static const sv_retrieve_t sv_retrieve[] = {
0, /* SX_OBJECT -- entry unused dynamically */
* those optimizations increase the throughput by 12%.
*/
+#ifdef USE_PTR_TABLE
+ cxt->pseen = ptr_table_new();
+ cxt->hseen = 0;
+#else
cxt->hseen = newHV(); /* Table where seen objects are stored */
HvSHAREKEYS_off(cxt->hseen);
-
+#endif
/*
* The following does not work well with perl5.004_04, and causes
* a core dump later on, in a completely unrelated spot, which
*/
#if PERL_VERSION >= 5
#define HBUCKETS 4096 /* Buckets for %hseen */
+#ifndef USE_PTR_TABLE
HvMAX(cxt->hseen) = HBUCKETS - 1; /* keys %hseen = $HBUCKETS; */
#endif
+#endif
/*
* The `hclass' hash uses the same settings as `hseen' above, but it is
* Insert real values into hashes where we stored faked pointers.
*/
+#ifndef USE_PTR_TABLE
if (cxt->hseen) {
hv_iterinit(cxt->hseen);
while ((he = hv_iternext(cxt->hseen))) /* Extra () for -Wall, grr.. */
HeVAL(he) = &PL_sv_undef;
}
+#endif
if (cxt->hclass) {
hv_iterinit(cxt->hclass);
* -- RAM, 20/12/2000
*/
+#ifdef USE_PTR_TABLE
+ if (cxt->pseen) {
+ struct ptr_tbl *pseen = cxt->pseen;
+ cxt->pseen = 0;
+ ptr_table_free(pseen);
+ }
+ assert(!cxt->hseen);
+#else
if (cxt->hseen) {
HV *hseen = cxt->hseen;
cxt->hseen = 0;
hv_undef(hseen);
sv_free((SV *) hseen);
}
+#endif
if (cxt->hclass) {
HV *hclass = cxt->hclass;
cxt->hook = newHV(); /* Caches STORABLE_thaw */
+#ifdef USE_PTR_TABLE
+ cxt->pseen = 0;
+#endif
+
/*
* If retrieving an old binary version, the cxt->retrieve_vtbl variable
* was set to sv_old_retrieve. We'll need a hash table to keep track of
*
* Tells whether we're in the middle of a store operation.
*/
-int is_storing(pTHX)
+static int is_storing(pTHX)
{
dSTCXT;
*
* Tells whether we're in the middle of a retrieve operation.
*/
-int is_retrieving(pTHX)
+static int is_retrieving(pTHX)
{
dSTCXT;
* This is typically out-of-band information that might prove useful
* to people wishing to convert native to network order data when used.
*/
-int last_op_in_netorder(pTHX)
+static int last_op_in_netorder(pTHX)
{
dSTCXT;
{
GV *gv;
SV *sv;
+ const char *hvname = HvNAME_get(pkg);
+
/*
* The following code is the same as the one performed by UNIVERSAL::can
gv = gv_fetchmethod_autoload(pkg, method, FALSE);
if (gv && isGV(gv)) {
sv = newRV((SV*) GvCV(gv));
- TRACEME(("%s->%s: 0x%"UVxf, HvNAME(pkg), method, PTR2UV(sv)));
+ TRACEME(("%s->%s: 0x%"UVxf, hvname, method, PTR2UV(sv)));
} else {
sv = newSVsv(&PL_sv_undef);
- TRACEME(("%s->%s: not found", HvNAME(pkg), method));
+ TRACEME(("%s->%s: not found", hvname, method));
}
/*
* it just won't be cached.
*/
- (void) hv_store(cache, HvNAME(pkg), strlen(HvNAME(pkg)), sv, 0);
+ (void) hv_store(cache, hvname, strlen(hvname), sv, 0);
return SvOK(sv) ? sv : (SV *) 0;
}
HV *pkg,
char *method)
{
+ const char *hvname = HvNAME_get(pkg);
(void) hv_store(cache,
- HvNAME(pkg), strlen(HvNAME(pkg)), newSVsv(&PL_sv_undef), 0);
+ hvname, strlen(hvname), newSVsv(&PL_sv_undef), 0);
}
/*
HV *pkg,
char *method)
{
- (void) hv_delete(cache, HvNAME(pkg), strlen(HvNAME(pkg)), G_DISCARD);
+ const char *hvname = HvNAME_get(pkg);
+ (void) hv_delete(cache, hvname, strlen(hvname), G_DISCARD);
}
/*
{
SV **svh;
SV *sv;
+ const char *hvname = HvNAME_get(pkg);
- TRACEME(("pkg_can for %s->%s", HvNAME(pkg), method));
+ TRACEME(("pkg_can for %s->%s", hvname, method));
/*
* Look into the cache to see whether we already have determined
* that only one hook (i.e. always the same) is cached in a given cache.
*/
- svh = hv_fetch(cache, HvNAME(pkg), strlen(HvNAME(pkg)), FALSE);
+ svh = hv_fetch(cache, hvname, strlen(hvname), FALSE);
if (svh) {
sv = *svh;
if (!SvOK(sv)) {
- TRACEME(("cached %s->%s: not found", HvNAME(pkg), method));
+ TRACEME(("cached %s->%s: not found", hvname, method));
return (SV *) 0;
} else {
TRACEME(("cached %s->%s: 0x%"UVxf,
- HvNAME(pkg), method, PTR2UV(sv)));
+ hvname, method, PTR2UV(sv)));
return sv;
}
}
* Save possible iteration state via each() on that table.
*/
- riter = HvRITER(hv);
- eiter = HvEITER(hv);
+ riter = HvRITER_get(hv);
+ eiter = HvEITER_get(hv);
hv_iterinit(hv);
/*
for (i = 0; i < len; i++) {
#ifdef HAS_RESTRICTED_HASHES
- int placeholders = (int)HvPLACEHOLDERS(hv);
+ int placeholders = (int)HvPLACEHOLDERS_get(hv);
#endif
unsigned char flags = 0;
char *keyval;
*/
for (i = 0; i < len; i++) {
- char *key;
+ char *key = 0;
I32 len;
unsigned char flags;
#ifdef HV_ITERNEXT_WANTPLACEHOLDERS
TRACEME(("ok (hash 0x%"UVxf")", PTR2UV(hv)));
out:
- HvRITER(hv) = riter; /* Restore hash iterator state */
- HvEITER(hv) = eiter;
+ HvRITER_set(hv, riter); /* Restore hash iterator state */
+ HvEITER_set(hv, eiter);
return ret;
}
CROAK(("Unexpected return value from B::Deparse::coderef2text\n"));
text = POPs;
- len = SvLEN(text);
+ len = SvCUR(text);
reallen = strlen(SvPV_nolen(text));
/*
char mtype = '\0'; /* for blessed ref to tied structures */
unsigned char eflags = '\0'; /* used when object type is SHT_EXTRA */
- TRACEME(("store_hook, classname \"%s\", tagged #%d", HvNAME(pkg), cxt->tagnum));
+ TRACEME(("store_hook, classname \"%s\", tagged #%d", HvNAME_get(pkg), cxt->tagnum));
/*
* Determine object type on 2 bits.
}
flags = SHF_NEED_RECURSE | obj_type;
- classname = HvNAME(pkg);
+ classname = HvNAME_get(pkg);
len = strlen(classname);
/*
*/
for (i = 1; i < count; i++) {
+#ifdef USE_PTR_TABLE
+ char *fake_tag;
+#else
SV **svh;
+#endif
SV *rsv = ary[i];
SV *xsv;
+ SV *tag;
AV *av_hook = cxt->hook_seen;
if (!SvROK(rsv))
* Look in hseen and see if we have a tag already.
* Serialize entry if not done already, and get its tag.
*/
-
+
+#ifdef USE_PTR_TABLE
+ /* Fakery needed because ptr_table_fetch returns zero for a
+ failure, whereas the existing code assumes that it can
+ safely store a tag zero. So for ptr_tables we store tag+1
+ */
+ if ((fake_tag = ptr_table_fetch(cxt->pseen, xsv)))
+ goto sv_seen; /* Avoid moving code too far to the right */
+#else
if ((svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE)))
goto sv_seen; /* Avoid moving code too far to the right */
+#endif
TRACEME(("listed object %d at 0x%"UVxf" is unknown", i-1, PTR2UV(xsv)));
if ((ret = store(aTHX_ cxt, xsv))) /* Given by hook for us to store */
return ret;
+#ifdef USE_PTR_TABLE
+ fake_tag = ptr_table_fetch(cxt->pseen, xsv);
+ if (!sv)
+ CROAK(("Could not serialize item #%d from hook in %s", i, classname));
+#else
svh = hv_fetch(cxt->hseen, (char *) &xsv, sizeof(xsv), FALSE);
if (!svh)
CROAK(("Could not serialize item #%d from hook in %s", i, classname));
-
+#endif
/*
* It was the first time we serialized `xsv'.
*
* Replace entry with its tag (not a real SV, so no refcnt increment)
*/
- ary[i] = *svh;
+#ifdef USE_PTR_TABLE
+ tag = (SV *)--fake_tag;
+#else
+ tag = *svh;
+#endif
+ ary[i] = tag
TRACEME(("listed object %d at 0x%"UVxf" is tag #%"UVuf,
- i-1, PTR2UV(xsv), PTR2UV(*svh)));
+ i-1, PTR2UV(xsv), PTR2UV(tag)));
}
/*
char *classname;
I32 classnum;
- TRACEME(("store_blessed, type %d, class \"%s\"", type, HvNAME(pkg)));
+ TRACEME(("store_blessed, type %d, class \"%s\"", type, HvNAME_get(pkg)));
/*
* Look for a hook for this blessed SV and redirect to store_hook()
* This is a blessed SV without any serialization hook.
*/
- classname = HvNAME(pkg);
+ classname = HvNAME_get(pkg);
len = strlen(classname);
TRACEME(("blessed 0x%"UVxf" in %s, no hook: tagged #%d",
SV **svh;
int ret;
int type;
+#ifdef USE_PTR_TABLE
+ struct ptr_tbl *pseen = cxt->pseen;
+#else
HV *hseen = cxt->hseen;
+#endif
TRACEME(("store (0x%"UVxf")", PTR2UV(sv)));
* -- RAM, 14/09/1999
*/
+#ifdef USE_PTR_TABLE
+ svh = ptr_table_fetch(pseen, sv);
+#else
svh = hv_fetch(hseen, (char *) &sv, sizeof(sv), FALSE);
+#endif
if (svh) {
I32 tagval;
goto undef_special_case;
}
+#ifdef USE_PTR_TABLE
+ tagval = htonl(LOW_32BITS(((char *)svh)-1));
+#else
tagval = htonl(LOW_32BITS(*svh));
+#endif
TRACEME(("object 0x%"UVxf" seen as #%d", PTR2UV(sv), ntohl(tagval)));
*/
cxt->tagnum++;
+#ifdef USE_PTR_TABLE
+ ptr_table_store(pseen, sv, INT2PTR(SV*, 1 + cxt->tagnum));
+#else
if (!hv_store(hseen,
(char *) &sv, sizeof(sv), INT2PTR(SV*, cxt->tagnum), 0))
return -1;
+#endif
/*
* Store `sv' and everything beneath it, using appropriate routine.
* Store the transitive data closure of given object to disk.
* Returns 0 on error, a true value otherwise.
*/
-int pstore(pTHX_ PerlIO *f, SV *sv)
+static int pstore(pTHX_ PerlIO *f, SV *sv)
{
TRACEME(("pstore"));
return do_store(aTHX_ f, sv, 0, FALSE, (SV**) 0);
* Same as pstore(), but network order is used for integers and doubles are
* emitted as strings.
*/
-int net_pstore(pTHX_ PerlIO *f, SV *sv)
+static int net_pstore(pTHX_ PerlIO *f, SV *sv)
{
TRACEME(("net_pstore"));
return do_store(aTHX_ f, sv, 0, TRUE, (SV**) 0);
* Store the transitive data closure of given object to memory.
* Returns undef on error, a scalar value containing the data otherwise.
*/
-SV *mstore(pTHX_ SV *sv)
+static SV *mstore(pTHX_ SV *sv)
{
SV *out;
* Same as mstore(), but network order is used for integers and doubles are
* emitted as strings.
*/
-SV *net_mstore(pTHX_ SV *sv)
+static SV *net_mstore(pTHX_ SV *sv)
{
SV *out;
* Return an error via croak, since it is not possible that we get here
* under normal conditions, when facing a file produced via pstore().
*/
-static SV *retrieve_other(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_other(pTHX_ stcxt_t *cxt, const char *cname)
{
if (
cxt->ver_major != STORABLE_BIN_MAJOR &&
* Layout is SX_IX_BLESS <index> <object> with SX_IX_BLESS already read.
* <index> can be coded on either 1 or 5 bytes.
*/
-static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_idx_blessed(pTHX_ stcxt_t *cxt, const char *cname)
{
I32 idx;
- char *classname;
+ const char *classname;
SV **sva;
SV *sv;
* Layout is SX_BLESS <len> <classname> <object> with SX_BLESS already read.
* <len> can be coded on either 1 or 5 bytes.
*/
-static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_blessed(pTHX_ stcxt_t *cxt, const char *cname)
{
I32 len;
SV *sv;
* processing (since we won't have seen the magic object by the time the hook
* is called). See comments below for why it was done that way.
*/
-static SV *retrieve_hook(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
{
I32 len;
char buf[LG_BLESS + 1]; /* Avoid malloc() if possible */
* Retrieve reference to some other scalar.
* Layout is SX_REF <object>, with SX_REF already read.
*/
-static SV *retrieve_ref(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_ref(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *rv;
SV *sv;
* Retrieve weak reference to some other scalar.
* Layout is SX_WEAKREF <object>, with SX_WEAKREF already read.
*/
-static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
* Retrieve reference to some other scalar with overloading.
* Layout is SX_OVERLOAD <object>, with SX_OVERLOAD already read.
*/
-static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *rv;
SV *sv;
}
if (!Gv_AMG(stash)) {
SV *psv = newSVpvn("require ", 8);
- const char *package = HvNAME(stash);
+ const char *package = HvNAME_get(stash);
sv_catpv(psv, package);
TRACEME(("No overloading defined for package %s", package));
* Retrieve weak overloaded reference to some other scalar.
* Layout is SX_WEAKOVERLOADED <object>, with SX_WEAKOVERLOADED already read.
*/
-static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
* Retrieve tied array
* Layout is SX_TIED_ARRAY <object>, with SX_TIED_ARRAY already read.
*/
-static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *tv;
SV *sv;
* Retrieve tied hash
* Layout is SX_TIED_HASH <object>, with SX_TIED_HASH already read.
*/
-static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *tv;
SV *sv;
* Retrieve tied scalar
* Layout is SX_TIED_SCALAR <object>, with SX_TIED_SCALAR already read.
*/
-static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *tv;
SV *sv, *obj = NULL;
* Retrieve reference to value in a tied hash.
* Layout is SX_TIED_KEY <object> <key>, with SX_TIED_KEY already read.
*/
-static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *tv;
SV *sv;
* Retrieve reference to value in a tied array.
* Layout is SX_TIED_IDX <object> <idx>, with SX_TIED_IDX already read.
*/
-static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *tv;
SV *sv;
* The scalar is "long" in that <length> is larger than LG_SCALAR so it
* was not stored on a single byte.
*/
-static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, const char *cname)
{
I32 len;
SV *sv;
* The scalar is "short" so <length> is single byte. If it is 0, there
* is no <data> section.
*/
-static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, const char *cname)
{
int len;
SV *sv;
* Like retrieve_scalar(), but tag result as utf8.
* If we're retrieving UTF8 data in a non-UTF8 perl, croaks.
*/
-static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
* Like retrieve_lscalar(), but tag result as utf8.
* If we're retrieving UTF8 data in a non-UTF8 perl, croaks.
*/
-static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
* Retrieve defined integer.
* Layout is SX_INTEGER <data>, whith SX_INTEGER already read.
*/
-static SV *retrieve_integer(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_integer(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
IV iv;
* Retrieve defined integer in network order.
* Layout is SX_NETINT <data>, whith SX_NETINT already read.
*/
-static SV *retrieve_netint(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_netint(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
I32 iv;
* Retrieve defined double.
* Layout is SX_DOUBLE <data>, whith SX_DOUBLE already read.
*/
-static SV *retrieve_double(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_double(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
NV nv;
* Retrieve defined byte (small integer within the [-128, +127] range).
* Layout is SX_BYTE <data>, whith SX_BYTE already read.
*/
-static SV *retrieve_byte(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_byte(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv;
int siv;
*
* Return the undefined value.
*/
-static SV *retrieve_undef(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_undef(pTHX_ stcxt_t *cxt, const char *cname)
{
SV* sv;
*
* Return the immortal undefined value.
*/
-static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv = &PL_sv_undef;
*
* Return the immortal yes value.
*/
-static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv = &PL_sv_yes;
*
* Return the immortal no value.
*/
-static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, const char *cname)
{
SV *sv = &PL_sv_no;
*
* When we come here, SX_ARRAY has been read already.
*/
-static SV *retrieve_array(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_array(pTHX_ stcxt_t *cxt, const char *cname)
{
I32 len;
I32 i;
*
* When we come here, SX_HASH has been read already.
*/
-static SV *retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
{
I32 len;
I32 size;
*
* When we come here, SX_HASH has been read already.
*/
-static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname)
{
dVAR;
I32 len;
*
* Return a code reference.
*/
-static SV *retrieve_code(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
{
#if PERL_VERSION < 6
CROAK(("retrieve_code does not work with perl 5.005 or less\n"));
if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) {
SV* errsv = get_sv("@", TRUE);
- sv_setpv(errsv, ""); /* clear $@ */
+ sv_setpvn(errsv, "", 0); /* clear $@ */
PUSHMARK(sp);
XPUSHs(sv_2mortal(newSVsv(sub)));
PUTBACK;
*
* When we come here, SX_ARRAY has been read already.
*/
-static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, char *cname)
+static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname)
{
I32 len;
I32 i;
*
* When we come here, SX_HASH has been read already.
*/
-static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, char *cname)
+static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
{
I32 len;
I32 size;
*/
version_major = use_network_order >> 1;
- cxt->retrieve_vtbl = (SV*(**)(pTHX_ stcxt_t *cxt, char *cname)) (version_major ? sv_retrieve : sv_old_retrieve);
+ cxt->retrieve_vtbl = (SV*(**)(pTHX_ stcxt_t *cxt, const char *cname)) (version_major ? sv_retrieve : sv_old_retrieve);
TRACEME(("magic_check: netorder = 0x%x", use_network_order));
* root SV (which may be an AV or an HV for what we care).
* Returns null if there is a problem.
*/
-static SV *retrieve(pTHX_ stcxt_t *cxt, char *cname)
+static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname)
{
int type;
SV **svh;
*
* Retrieve data held in file and return the root object, undef on error.
*/
-SV *pretrieve(pTHX_ PerlIO *f)
+static SV *pretrieve(pTHX_ PerlIO *f)
{
TRACEME(("pretrieve"));
return do_retrieve(aTHX_ f, Nullsv, 0);
*
* Retrieve data held in scalar and return the root object, undef on error.
*/
-SV *mretrieve(pTHX_ SV *sv)
+static SV *mretrieve(pTHX_ SV *sv)
{
TRACEME(("mretrieve"));
return do_retrieve(aTHX_ (PerlIO*) 0, sv, 0);
* there. Not that efficient, but it should be faster than doing it from
* pure perl anyway.
*/
-SV *dclone(pTHX_ SV *sv)
+static SV *dclone(pTHX_ SV *sv)
{
dSTCXT;
int size;