[Orca-checkins] r456 - in trunk/orca: . packages/Storable-2.14 packages/Storable-2.15
blair at orcaware.com
blair at orcaware.com
Mon May 30 18:10:13 PDT 2005
Author: blair at orcaware.com
Date: Mon May 30 17:56:56 2005
New Revision: 456
Added:
trunk/orca/packages/Storable-2.15/
- copied from r455, trunk/orca/packages/Storable-2.14/
Removed:
trunk/orca/packages/Storable-2.14/
Modified:
trunk/orca/configure.in
trunk/orca/packages/Storable-2.15/ChangeLog
trunk/orca/packages/Storable-2.15/MANIFEST
trunk/orca/packages/Storable-2.15/Storable.pm
trunk/orca/packages/Storable-2.15/Storable.xs
Log:
Upgrade Storable from 2.14 to 2.15 and require the new version for
Orca.
* configure.in:
Bump Storable's version number to 2.15.
* packages/Storable-2.15:
Renamed from packages/Storable-2.14. Directory contents updated
from Storable-2.15.tar.gz.
Modified: trunk/orca/configure.in
==============================================================================
--- trunk/orca/configure.in (original)
+++ trunk/orca/configure.in Mon May 30 17:56:56 2005
@@ -37,8 +37,8 @@
MATH_INTERVALSEARCH_VER=1.05
RRDTOOL_DIR=rrdtool-1.0.50
RRDTOOL_VER=1.000502
-STORABLE_DIR=Storable-2.14
-STORABLE_VER=2.14
+STORABLE_DIR=Storable-2.15
+STORABLE_VER=2.15
TIME_HIRES_DIR=Time-HiRes-1.68
TIME_HIRES_VER=1.68
Modified: trunk/orca/packages/Storable-2.15/ChangeLog
==============================================================================
--- trunk/orca/packages/Storable-2.14/ChangeLog (original)
+++ trunk/orca/packages/Storable-2.15/ChangeLog Mon May 30 17:56:56 2005
@@ -1,3 +1,9 @@
+Mon May 23 22:48:49 IST 2005 Abhijit Menon-Sen <ams at wiw.org>
+
+ Version 2.15
+
+ Minor changes to address a couple of compile problems.
+
Mon Apr 25 07:29:14 IST 2005 Abhijit Menon-Sen <ams at wiw.org>
Version 2.14
Modified: trunk/orca/packages/Storable-2.15/MANIFEST
==============================================================================
--- trunk/orca/packages/Storable-2.14/MANIFEST (original)
+++ trunk/orca/packages/Storable-2.15/MANIFEST Mon May 30 17:56:56 2005
@@ -25,6 +25,7 @@
t/interwork56.t Test combatibility kludge for 64bit data under 5.6.x
t/just_plain_nasty.t Corner case corner.
t/lock.t See if Storable works
+t/sig_die.t See if Storable works
t/make_56_interwork.pl Make test data for interwork56.t
t/make_downgrade.pl Make test data for downgrade.t
t/malice.t See if Storable copes with corrupt files
Modified: trunk/orca/packages/Storable-2.15/Storable.pm
==============================================================================
--- trunk/orca/packages/Storable-2.14/Storable.pm (original)
+++ trunk/orca/packages/Storable-2.15/Storable.pm Mon May 30 17:56:56 2005
@@ -21,14 +21,17 @@
use AutoLoader;
use vars qw($canonical $forgive_me $VERSION);
-$VERSION = '2.14';
+$VERSION = '2.15';
*AUTOLOAD = \&AutoLoader::AUTOLOAD; # Grrr...
#
# Use of Log::Agent is optional
#
-eval "use Log::Agent";
+{
+ local $SIG{__DIE__};
+ eval "use Log::Agent";
+}
require Carp;
Modified: trunk/orca/packages/Storable-2.15/Storable.xs
==============================================================================
--- trunk/orca/packages/Storable-2.14/Storable.xs (original)
+++ trunk/orca/packages/Storable-2.15/Storable.xs Mon May 30 17:56:56 2005
@@ -21,17 +21,10 @@
#include "ppport.h" /* handle old perls */
#endif
-#ifndef NETWARE
#if 0
#define DEBUGME /* Debug mode, turns assertions on as well */
#define DASSERT /* Assertion mode */
#endif
-#else /* NETWARE */
-#if 0 /* On NetWare USE_PERLIO is not used */
-#define DEBUGME /* Debug mode, turns assertions on as well */
-#define DASSERT /* Assertion mode */
-#endif
-#endif
/*
* Pre PerlIO time when none of USE_PERLIO and PERLIO_IS_STDIO is defined
@@ -101,14 +94,16 @@
} STMT_END
#endif
-#ifdef HASATTRIBUTE
-# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
-# define PERL_UNUSED_DECL
+#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
@@ -119,6 +114,28 @@
#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
@@ -309,6 +326,10 @@
#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
@@ -319,7 +340,16 @@
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 */
@@ -1050,17 +1080,17 @@
static int store_other(pTHX_ stcxt_t *cxt, SV *sv);
static int store_blessed(pTHX_ stcxt_t *cxt, SV *sv, int type, HV *pkg);
-#define SV_STORE_TYPE (const int (* const)(pTHX_ stcxt_t *cxt, SV *sv))
+typedef int (*sv_store_t)(pTHX_ stcxt_t *cxt, SV *sv);
-static const int (* const sv_store[])(pTHX_ stcxt_t *cxt, SV *sv) = {
- SV_STORE_TYPE store_ref, /* svis_REF */
- SV_STORE_TYPE store_scalar, /* svis_SCALAR */
- SV_STORE_TYPE store_array, /* svis_ARRAY */
- SV_STORE_TYPE store_hash, /* svis_HASH */
- SV_STORE_TYPE store_tied, /* svis_TIED */
- SV_STORE_TYPE store_tied_item, /* svis_TIED_ITEM */
- SV_STORE_TYPE store_code, /* svis_CODE */
- SV_STORE_TYPE store_other, /* svis_OTHER */
+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 */
+ (sv_store_t)store_hash, /* svis_HASH */
+ (sv_store_t)store_tied, /* svis_TIED */
+ (sv_store_t)store_tied_item, /* svis_TIED_ITEM */
+ (sv_store_t)store_code, /* svis_CODE */
+ (sv_store_t)store_other, /* svis_OTHER */
};
#define SV_STORE(x) (*sv_store[x])
@@ -1086,39 +1116,39 @@
static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, char *cname);
static SV *retrieve_other(pTHX_ stcxt_t *cxt, char *cname);
-#define SV_RETRIEVE_TYPE (const SV* (* const)(pTHX_ stcxt_t *cxt, char *cname))
+typedef SV* (*sv_retrieve_t)(pTHX_ stcxt_t *cxt, char *name);
-static const SV *(* const sv_old_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
- 0, /* SX_OBJECT -- entry unused dynamically */
- SV_RETRIEVE_TYPE retrieve_lscalar, /* SX_LSCALAR */
- SV_RETRIEVE_TYPE old_retrieve_array, /* SX_ARRAY -- for pre-0.6 binaries */
- SV_RETRIEVE_TYPE old_retrieve_hash, /* SX_HASH -- for pre-0.6 binaries */
- SV_RETRIEVE_TYPE retrieve_ref, /* SX_REF */
- SV_RETRIEVE_TYPE retrieve_undef, /* SX_UNDEF */
- SV_RETRIEVE_TYPE retrieve_integer, /* SX_INTEGER */
- SV_RETRIEVE_TYPE retrieve_double, /* SX_DOUBLE */
- SV_RETRIEVE_TYPE retrieve_byte, /* SX_BYTE */
- SV_RETRIEVE_TYPE retrieve_netint, /* SX_NETINT */
- SV_RETRIEVE_TYPE retrieve_scalar, /* SX_SCALAR */
- SV_RETRIEVE_TYPE retrieve_tied_array, /* SX_ARRAY */
- SV_RETRIEVE_TYPE retrieve_tied_hash, /* SX_HASH */
- SV_RETRIEVE_TYPE retrieve_tied_scalar, /* SX_SCALAR */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_SV_UNDEF not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_SV_YES not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_SV_NO not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_BLESS not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_IX_BLESS not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_HOOK not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_OVERLOADED not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_TIED_KEY not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_TIED_IDX not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_UTF8STR not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_LUTF8STR not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_FLAG_HASH not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_CODE not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_WEAKREF not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_WEAKOVERLOAD not supported */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_ERROR */
+static const sv_retrieve_t sv_old_retrieve[] = {
+ 0, /* SX_OBJECT -- entry unused dynamically */
+ (sv_retrieve_t)retrieve_lscalar, /* SX_LSCALAR */
+ (sv_retrieve_t)old_retrieve_array, /* SX_ARRAY -- for pre-0.6 binaries */
+ (sv_retrieve_t)old_retrieve_hash, /* SX_HASH -- for pre-0.6 binaries */
+ (sv_retrieve_t)retrieve_ref, /* SX_REF */
+ (sv_retrieve_t)retrieve_undef, /* SX_UNDEF */
+ (sv_retrieve_t)retrieve_integer, /* SX_INTEGER */
+ (sv_retrieve_t)retrieve_double, /* SX_DOUBLE */
+ (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_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_BLESS not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_IX_BLESS not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_HOOK not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_OVERLOADED not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_TIED_KEY not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_TIED_IDX not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_UTF8STR not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_LUTF8STR not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_FLAG_HASH not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_CODE not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_WEAKREF not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_WEAKOVERLOAD not supported */
+ (sv_retrieve_t)retrieve_other, /* SX_ERROR */
};
static SV *retrieve_array(pTHX_ stcxt_t *cxt, char *cname);
@@ -1137,37 +1167,37 @@
static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, char *cname);
static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, char *cname);
-static const SV *(* const sv_retrieve[])(pTHX_ stcxt_t *cxt, char *cname) = {
+static const sv_retrieve_t sv_retrieve[] = {
0, /* SX_OBJECT -- entry unused dynamically */
- SV_RETRIEVE_TYPE retrieve_lscalar, /* SX_LSCALAR */
- SV_RETRIEVE_TYPE retrieve_array, /* SX_ARRAY */
- SV_RETRIEVE_TYPE retrieve_hash, /* SX_HASH */
- SV_RETRIEVE_TYPE retrieve_ref, /* SX_REF */
- SV_RETRIEVE_TYPE retrieve_undef, /* SX_UNDEF */
- SV_RETRIEVE_TYPE retrieve_integer, /* SX_INTEGER */
- SV_RETRIEVE_TYPE retrieve_double, /* SX_DOUBLE */
- SV_RETRIEVE_TYPE retrieve_byte, /* SX_BYTE */
- SV_RETRIEVE_TYPE retrieve_netint, /* SX_NETINT */
- SV_RETRIEVE_TYPE retrieve_scalar, /* SX_SCALAR */
- SV_RETRIEVE_TYPE retrieve_tied_array, /* SX_ARRAY */
- SV_RETRIEVE_TYPE retrieve_tied_hash, /* SX_HASH */
- SV_RETRIEVE_TYPE retrieve_tied_scalar, /* SX_SCALAR */
- SV_RETRIEVE_TYPE retrieve_sv_undef, /* SX_SV_UNDEF */
- SV_RETRIEVE_TYPE retrieve_sv_yes, /* SX_SV_YES */
- SV_RETRIEVE_TYPE retrieve_sv_no, /* SX_SV_NO */
- SV_RETRIEVE_TYPE retrieve_blessed, /* SX_BLESS */
- SV_RETRIEVE_TYPE retrieve_idx_blessed, /* SX_IX_BLESS */
- SV_RETRIEVE_TYPE retrieve_hook, /* SX_HOOK */
- SV_RETRIEVE_TYPE retrieve_overloaded, /* SX_OVERLOAD */
- SV_RETRIEVE_TYPE retrieve_tied_key, /* SX_TIED_KEY */
- SV_RETRIEVE_TYPE retrieve_tied_idx, /* SX_TIED_IDX */
- SV_RETRIEVE_TYPE retrieve_utf8str, /* SX_UTF8STR */
- SV_RETRIEVE_TYPE retrieve_lutf8str, /* SX_LUTF8STR */
- SV_RETRIEVE_TYPE retrieve_flag_hash, /* SX_HASH */
- SV_RETRIEVE_TYPE retrieve_code, /* SX_CODE */
- SV_RETRIEVE_TYPE retrieve_weakref, /* SX_WEAKREF */
- SV_RETRIEVE_TYPE retrieve_weakoverloaded, /* SX_WEAKOVERLOAD */
- SV_RETRIEVE_TYPE retrieve_other, /* SX_ERROR */
+ (sv_retrieve_t)retrieve_lscalar, /* SX_LSCALAR */
+ (sv_retrieve_t)retrieve_array, /* SX_ARRAY */
+ (sv_retrieve_t)retrieve_hash, /* SX_HASH */
+ (sv_retrieve_t)retrieve_ref, /* SX_REF */
+ (sv_retrieve_t)retrieve_undef, /* SX_UNDEF */
+ (sv_retrieve_t)retrieve_integer, /* SX_INTEGER */
+ (sv_retrieve_t)retrieve_double, /* SX_DOUBLE */
+ (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_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_blessed, /* SX_BLESS */
+ (sv_retrieve_t)retrieve_idx_blessed, /* SX_IX_BLESS */
+ (sv_retrieve_t)retrieve_hook, /* SX_HOOK */
+ (sv_retrieve_t)retrieve_overloaded, /* SX_OVERLOAD */
+ (sv_retrieve_t)retrieve_tied_key, /* SX_TIED_KEY */
+ (sv_retrieve_t)retrieve_tied_idx, /* SX_TIED_IDX */
+ (sv_retrieve_t)retrieve_utf8str, /* SX_UTF8STR */
+ (sv_retrieve_t)retrieve_lutf8str, /* SX_LUTF8STR */
+ (sv_retrieve_t)retrieve_flag_hash, /* SX_HASH */
+ (sv_retrieve_t)retrieve_code, /* SX_CODE */
+ (sv_retrieve_t)retrieve_weakref, /* SX_WEAKREF */
+ (sv_retrieve_t)retrieve_weakoverloaded, /* SX_WEAKOVERLOAD */
+ (sv_retrieve_t)retrieve_other, /* SX_ERROR */
};
#define RETRIEVE(c,x) (*(c)->retrieve_vtbl[(x) >= SX_ERROR ? SX_ERROR : (x)])
@@ -1242,9 +1272,13 @@
* 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
@@ -1263,8 +1297,10 @@
*/
#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
@@ -1318,11 +1354,13 @@
* 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);
@@ -1340,12 +1378,21 @@
* -- 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;
@@ -1399,6 +1446,10 @@
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
@@ -1611,6 +1662,8 @@
{
GV *gv;
SV *sv;
+ const char *hvname = HvNAME_get(pkg);
+
/*
* The following code is the same as the one performed by UNIVERSAL::can
@@ -1620,10 +1673,10 @@
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));
}
/*
@@ -1631,7 +1684,7 @@
* 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;
}
@@ -1647,8 +1700,9 @@
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);
}
/*
@@ -1662,7 +1716,8 @@
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);
}
/*
@@ -1681,8 +1736,9 @@
{
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
@@ -1692,15 +1748,15 @@
* 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;
}
}
@@ -2234,8 +2290,8 @@
* 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);
/*
@@ -2281,7 +2337,7 @@
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;
@@ -2411,7 +2467,7 @@
*/
for (i = 0; i < len; i++) {
- char *key;
+ char *key = 0;
I32 len;
unsigned char flags;
#ifdef HV_ITERNEXT_WANTPLACEHOLDERS
@@ -2503,8 +2559,8 @@
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;
}
@@ -2809,7 +2865,7 @@
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.
@@ -2860,7 +2916,7 @@
}
flags = SHF_NEED_RECURSE | obj_type;
- classname = HvNAME(pkg);
+ classname = HvNAME_get(pkg);
len = strlen(classname);
/*
@@ -2943,9 +2999,14 @@
*/
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))
@@ -2957,9 +3018,18 @@
* 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)));
@@ -2986,10 +3056,15 @@
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'.
*
@@ -3019,9 +3094,14 @@
* 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)));
}
/*
@@ -3204,7 +3284,7 @@
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()
@@ -3219,11 +3299,11 @@
* 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",
- PTR2UV(sv), class, cxt->tagnum));
+ PTR2UV(sv), classname, cxt->tagnum));
/*
* Determine whether it is the first time we see that class name (in which
@@ -3386,7 +3466,11 @@
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)));
@@ -3402,7 +3486,11 @@
* -- 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;
@@ -3436,7 +3524,11 @@
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)));
@@ -3457,9 +3549,13 @@
*/
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.
@@ -4445,7 +4541,7 @@
}
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));
@@ -5327,7 +5423,7 @@
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;
@@ -5591,7 +5687,7 @@
*/
version_major = use_network_order >> 1;
- cxt->retrieve_vtbl = (SV*(**)()) (version_major ? sv_retrieve : sv_old_retrieve);
+ cxt->retrieve_vtbl = (SV*(**)(pTHX_ stcxt_t *cxt, char *cname)) (version_major ? sv_retrieve : sv_old_retrieve);
TRACEME(("magic_check: netorder = 0x%x", use_network_order));
More information about the Orca-checkins
mailing list