[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