Use PerlMemShared for CopSTASHPV and CopFILE. MUCH harder than it sounds!

Need to use CopXXXXX macros everywhere and add CopSTASH_free
Add new scope type and add support for it to scope.c and scope stack
dup-er in sv.c. Add savesharedpv().
Also zealous version of Win32's vmem.h to catch all the abuses.
With this t/op/fork.t passes even with zealous checking and 
checker is point a finger at various threads/shared issues.

PL_curcop->cop_io is still an issue.

p4raw-id: //depot/perlio@14259

18 files changed, 133 insertions, 73 deletions

diff --git a/cop.h b/cop.h
index 0040cbeac9..7e2b3a9127 100644
--- a/cop.h
+++ b/cop.h
@@ -30,13 +30,13 @@ struct cop {
 #  define CopFILE(c)		((c)->cop_file)
 #  define CopFILEGV(c)		(CopFILE(c) \
 				 ? gv_fetchfile(CopFILE(c)) : Nullgv)
-#  define CopFILE_set(c,pv)	((c)->cop_file = savepv(pv))
+#  define CopFILE_set(c,pv)	((c)->cop_file = savesharedpv(pv))
 #  define CopFILESV(c)		(CopFILE(c) \
 				 ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
 #  define CopFILEAV(c)		(CopFILE(c) \
 				 ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
 #  define CopSTASHPV(c)		((c)->cop_stashpv)
-#  define CopSTASHPV_set(c,pv)	((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
+#  define CopSTASHPV_set(c,pv)	((c)->cop_stashpv = savesharedpv(pv))
 #  define CopSTASH(c)		(CopSTASHPV(c) \
 				 ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
 #  define CopSTASH_set(c,hv)	CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
@@ -44,6 +44,8 @@ struct cop {
 				 && (CopSTASHPV(c) == HvNAME(hv)	\
 				     || (CopSTASHPV(c) && HvNAME(hv)	\
 					 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
+#  define CopSTASH_free(c)	PerlMemShared_free(CopSTASHPV(c))      
+#  define CopFILE_free(c)	(PerlMemShared_free(CopFILE(c)),(CopFILE(c) = Nullch))      
 #else
 #  define CopFILEGV(c)		((c)->cop_filegv)
 #  define CopFILEGV_set(c,gv)	((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
@@ -57,6 +59,9 @@ struct cop {
    /* cop_stash is not refcounted */
 #  define CopSTASHPV_set(c,pv)	CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
 #  define CopSTASH_eq(c,hv)	(CopSTASH(c) == (hv))
+#  define CopSTASH_free(c)	
+#  define CopFILE_free(c)	(SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = Nullgv))
+
 #endif /* USE_ITHREADS */
 
 #define CopSTASH_ne(c,hv)	(!CopSTASH_eq(c,hv))
diff --git a/embed.fnc b/embed.fnc
index f5fcac6cd4..a9d1dcc8ca 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -613,6 +613,7 @@ p	|void	|rxres_save	|void** rsp|REGEXP* prx
 p	|I32	|same_dirent	|char* a|char* b
 #endif
 Apd	|char*	|savepv		|const char* sv
+Apd	|char*	|savesharedpv	|const char* sv
 Apd	|char*	|savepvn	|const char* sv|I32 len
 Ap	|void	|savestack_grow
 Ap	|void	|save_aelem	|AV* av|I32 idx|SV **sptr
@@ -628,6 +629,7 @@ p	|void	|save_freeop	|OP* o
 Ap	|void	|save_freepv	|char* pv
 Ap	|void	|save_generic_svref|SV** sptr
 Ap	|void	|save_generic_pvref|char** str
+Ap	|void	|save_shared_pvref|char** str
 Ap	|void	|save_gp	|GV* gv|I32 empty
 Ap	|HV*	|save_hash	|GV* gv
 Ap	|void	|save_helem	|HV* hv|SV *key|SV **sptr
diff --git a/embed.h b/embed.h
index cbd880ed45..bbae4f1e70 100644
--- a/embed.h
+++ b/embed.h
@@ -578,6 +578,7 @@
 #define same_dirent		Perl_same_dirent
 #endif
 #define savepv			Perl_savepv
+#define savesharedpv		Perl_savesharedpv
 #define savepvn			Perl_savepvn
 #define savestack_grow		Perl_savestack_grow
 #define save_aelem		Perl_save_aelem
@@ -593,6 +594,7 @@
 #define save_freepv		Perl_save_freepv
 #define save_generic_svref	Perl_save_generic_svref
 #define save_generic_pvref	Perl_save_generic_pvref
+#define save_shared_pvref	Perl_save_shared_pvref
 #define save_gp			Perl_save_gp
 #define save_hash		Perl_save_hash
 #define save_helem		Perl_save_helem
@@ -2128,6 +2130,7 @@
 #define same_dirent(a,b)	Perl_same_dirent(aTHX_ a,b)
 #endif
 #define savepv(a)		Perl_savepv(aTHX_ a)
+#define savesharedpv(a)		Perl_savesharedpv(aTHX_ a)
 #define savepvn(a,b)		Perl_savepvn(aTHX_ a,b)
 #define savestack_grow()	Perl_savestack_grow(aTHX)
 #define save_aelem(a,b,c)	Perl_save_aelem(aTHX_ a,b,c)
@@ -2143,6 +2146,7 @@
 #define save_freepv(a)		Perl_save_freepv(aTHX_ a)
 #define save_generic_svref(a)	Perl_save_generic_svref(aTHX_ a)
 #define save_generic_pvref(a)	Perl_save_generic_pvref(aTHX_ a)
+#define save_shared_pvref(a)	Perl_save_shared_pvref(aTHX_ a)
 #define save_gp(a,b)		Perl_save_gp(aTHX_ a,b)
 #define save_hash(a)		Perl_save_hash(aTHX_ a)
 #define save_helem(a,b,c)	Perl_save_helem(aTHX_ a,b,c)
diff --git a/global.sym b/global.sym
index 5f0c9dec83..ae33a7aee8 100644
--- a/global.sym
+++ b/global.sym
@@ -351,6 +351,7 @@ Perl_rninstr
 Perl_rsignal
 Perl_rsignal_state
 Perl_savepv
+Perl_savesharedpv
 Perl_savepvn
 Perl_savestack_grow
 Perl_save_aelem
@@ -365,6 +366,7 @@ Perl_save_freesv
 Perl_save_freepv
 Perl_save_generic_svref
 Perl_save_generic_pvref
+Perl_save_shared_pvref
 Perl_save_gp
 Perl_save_hash
 Perl_save_helem
diff --git a/op.c b/op.c
index 2230aaf243..57e7784b2e 100644
--- a/op.c
+++ b/op.c
@@ -878,11 +878,7 @@ clear_pmop:
 		    pmop = pmop->op_pmnext;
 		}
 	    }
-#ifdef USE_ITHREADS
-	    Safefree(PmopSTASHPV(cPMOPo));
-#else
-	    /* NOTE: PMOP.op_pmstash is not refcounted */
-#endif
+	    PmopSTASH_free(cPMOPo);
 	}
 	cPMOPo->op_pmreplroot = Nullop;
         /* we use the "SAFE" version of the PM_ macros here
@@ -913,18 +909,20 @@ clear_pmop:
 STATIC void
 S_cop_free(pTHX_ COP* cop)
 {
-    Safefree(cop->cop_label);
-#ifdef USE_ITHREADS
-    Safefree(CopFILE(cop));		/* XXX share in a pvtable? */
-    Safefree(CopSTASHPV(cop));		/* XXX share in a pvtable? */
-#else
-    /* NOTE: COP.cop_stash is not refcounted */
-    SvREFCNT_dec(CopFILEGV(cop));
-#endif
+    Safefree(cop->cop_label);   /* FIXME: treaddead ??? */
+    CopFILE_free(cop);
+    CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
 	SvREFCNT_dec(cop->cop_warnings);
-    if (! specialCopIO(cop->cop_io))
+    if (! specialCopIO(cop->cop_io)) {
+#ifdef USE_ITHREADS
+	STRLEN len;
+        char *s = SvPV(cop->cop_io,len);
+	Perl_warn(aTHX_ "io='%.*s'",(int) len,s);
+#else
 	SvREFCNT_dec(cop->cop_io);
+#endif
+    }
 }
 
 void
@@ -5171,11 +5169,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
 	SAVESPTR(PL_curstash);
 	SAVECOPSTASH(PL_curcop);
 	PL_curstash = stash;
-#ifdef USE_ITHREADS
-	CopSTASHPV(PL_curcop) = stash ? HvNAME(stash) : Nullch;
-#else
-	CopSTASH(PL_curcop) = stash;
-#endif
+	CopSTASH_set(PL_curcop,stash);
     }
 
     cv = newXS(name, const_sv_xsub, __FILE__);
diff --git a/op.h b/op.h
index 2bfdced273..5c8e3674f1 100644
--- a/op.h
+++ b/op.h
@@ -299,17 +299,21 @@ struct pmop {
 #define PMf_COMPILETIME	(PMf_MULTILINE|PMf_SINGLELINE|PMf_LOCALE|PMf_FOLD|PMf_EXTENDED)
 
 #ifdef USE_ITHREADS
+
 #  define PmopSTASHPV(o)	((o)->op_pmstashpv)
-#  define PmopSTASHPV_set(o,pv)	((o)->op_pmstashpv = ((pv) ? savepv(pv) : Nullch))
+#  define PmopSTASHPV_set(o,pv)	(PmopSTASHPV(o) = savesharedpv(pv))
 #  define PmopSTASH(o)		(PmopSTASHPV(o) \
 				 ? gv_stashpv(PmopSTASHPV(o),GV_ADD) : Nullhv)
-#  define PmopSTASH_set(o,hv)	PmopSTASHPV_set(o, (hv) ? HvNAME(hv) : Nullch)
+#  define PmopSTASH_set(o,hv)	PmopSTASHPV_set(o, ((hv) ? HvNAME(hv) : Nullch))
+#  define PmopSTASH_free(o)	PerlMemShared_free(PmopSTASHPV(o))
+
 #else
 #  define PmopSTASH(o)		((o)->op_pmstash)
 #  define PmopSTASH_set(o,hv)	((o)->op_pmstash = (hv))
 #  define PmopSTASHPV(o)	(PmopSTASH(o) ? HvNAME(PmopSTASH(o)) : Nullch)
    /* op_pmstash is not refcounted */
 #  define PmopSTASHPV_set(o,pv)	PmopSTASH_set((o), gv_stashpv(pv,GV_ADD))
+#  define PmopSTASH_free(o)    
 #endif
 
 struct svop {
diff --git a/perl.c b/perl.c
index e7f7ad6c85..d7e3ace6df 100644
--- a/perl.c
+++ b/perl.c
@@ -696,15 +696,8 @@ perl_destruct(pTHXx)
     if (!specialCopIO(PL_compiling.cop_io))
 	SvREFCNT_dec(PL_compiling.cop_io);
     PL_compiling.cop_io = Nullsv;
-#ifdef USE_ITHREADS
-    Safefree(CopFILE(&PL_compiling));
-    CopFILE(&PL_compiling) = Nullch;
-    Safefree(CopSTASHPV(&PL_compiling));
-#else
-    SvREFCNT_dec(CopFILEGV(&PL_compiling));
-    CopFILEGV(&PL_compiling) = Nullgv;
-    /* cop_stash is not refcounted */
-#endif
+    CopFILE_free(&PL_compiling);
+    CopSTASH_free(&PL_compiling);
 
     /* Prepare to destruct main symbol table.  */
 
@@ -2717,11 +2710,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
 	}
     }
 
-#   ifdef USE_ITHREADS
-        Safefree(CopFILE(PL_curcop));
-#   else
-        SvREFCNT_dec(CopFILEGV(PL_curcop));
-#   endif
+    CopFILE_free(PL_curcop);
     CopFILE_set(PL_curcop, PL_origfilename);
     if (strEQ(PL_origfilename,"-"))
 	scriptname = "";
diff --git a/proto.h b/proto.h
index 0bdb25cd74..5068b43435 100644
--- a/proto.h
+++ b/proto.h
@@ -641,6 +641,7 @@ PERL_CALLCONV void	Perl_rxres_save(pTHX_ void** rsp, REGEXP* prx);
 PERL_CALLCONV I32	Perl_same_dirent(pTHX_ char* a, char* b);
 #endif
 PERL_CALLCONV char*	Perl_savepv(pTHX_ const char* sv);
+PERL_CALLCONV char*	Perl_savesharedpv(pTHX_ const char* sv);
 PERL_CALLCONV char*	Perl_savepvn(pTHX_ const char* sv, I32 len);
 PERL_CALLCONV void	Perl_savestack_grow(pTHX);
 PERL_CALLCONV void	Perl_save_aelem(pTHX_ AV* av, I32 idx, SV **sptr);
@@ -656,6 +657,7 @@ PERL_CALLCONV void	Perl_save_freeop(pTHX_ OP* o);
 PERL_CALLCONV void	Perl_save_freepv(pTHX_ char* pv);
 PERL_CALLCONV void	Perl_save_generic_svref(pTHX_ SV** sptr);
 PERL_CALLCONV void	Perl_save_generic_pvref(pTHX_ char** str);
+PERL_CALLCONV void	Perl_save_shared_pvref(pTHX_ char** str);
 PERL_CALLCONV void	Perl_save_gp(pTHX_ GV* gv, I32 empty);
 PERL_CALLCONV HV*	Perl_save_hash(pTHX_ GV* gv);
 PERL_CALLCONV void	Perl_save_helem(pTHX_ HV* hv, SV *key, SV **sptr);
@@ -1105,7 +1107,7 @@ STATIC I32	S_dopoptoeval(pTHX_ I32 startingblock);
 STATIC I32	S_dopoptolabel(pTHX_ char *label);
 STATIC I32	S_dopoptoloop(pTHX_ I32 startingblock);
 STATIC I32	S_dopoptosub(pTHX_ I32 startingblock);
-STATIC I32	S_dopoptosub_at(pTHX_ PERL_CONTEXT* cxstk, I32 startingblock);
+STATIC I32	S_dopoptosub_at(pTHX_ PERL_CONTEXT* cxstk, I32 startingblock
);
 STATIC void	S_save_lines(pTHX_ AV *array, SV *sv);
 STATIC OP*	S_doeval(pTHX_ int gimme, OP** startop);
 STATIC PerlIO *	S_doopen_pmc(pTHX_ const char *name, const char *mode);
diff --git a/scope.c b/scope.c
index e976f3c9fa..59adddf66f 100644
--- a/scope.c
+++ b/scope.c
@@ -254,6 +254,18 @@ Perl_save_generic_pvref(pTHX_ char **str)
     SSPUSHINT(SAVEt_GENERIC_PVREF);
 }
 
+/* Like save_generic_pvref(), but uses PerlMemShared_free() rather than Safefree().
+ * Can be used to restore a shared global char* to its prior
+ * contents, freeing new value. */
+void
+Perl_save_shared_pvref(pTHX_ char **str)
+{
+    SSCHECK(3);
+    SSPUSHPTR(str);
+    SSPUSHPTR(*str);
+    SSPUSHINT(SAVEt_SHARED_PVREF);
+}
+
 void
 Perl_save_gp(pTHX_ GV *gv, I32 empty)
 {
@@ -657,6 +669,14 @@ Perl_leave_scope(pTHX_ I32 base)
 		*(char**)ptr = str;
 	    }
 	    break;
+	case SAVEt_SHARED_PVREF:		/* shared pv */
+	    str = (char*)SSPOPPTR;
+	    ptr = SSPOPPTR;
+	    if (*(char**)ptr != str) {
+		PerlMemShared_free(*(char**)ptr);
+		*(char**)ptr = str;
+	    }
+	    break;
 	case SAVEt_GENERIC_SVREF:		/* generic sv */
 	    value = (SV*)SSPOPPTR;
 	    ptr = SSPOPPTR;
diff --git a/scope.h b/scope.h
index f0abb724b3..6efeb5ebbb 100644
--- a/scope.h
+++ b/scope.h
@@ -35,6 +35,7 @@
 #define SAVEt_GENERIC_PVREF	34
 #define SAVEt_PADSV		35
 #define SAVEt_MORTALIZESV	36
+#define SAVEt_SHARED_PVREF	37
 
 #ifndef SCOPE_SAVES_SIGNAL_MASK
 #define SCOPE_SAVES_SIGNAL_MASK 0
@@ -117,6 +118,7 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 #define SAVECLEARSV(sv)	save_clearsv(SOFT_CAST(SV**)&(sv))
 #define SAVEGENERICSV(s)	save_generic_svref((SV**)&(s))
 #define SAVEGENERICPV(s)	save_generic_pvref((char**)&(s))
+#define SAVESHAREDPV(s)		save_shared_pvref((char**)&(s))
 #define SAVEDELETE(h,k,l) \
 	  save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l))
 #define SAVEDESTRUCTOR(f,p) \
@@ -160,9 +162,9 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 
 #ifdef USE_ITHREADS
 #  define SAVECOPSTASH(c)	SAVEPPTR(CopSTASHPV(c))
-#  define SAVECOPSTASH_FREE(c)	SAVEGENERICPV(CopSTASHPV(c))
+#  define SAVECOPSTASH_FREE(c)	SAVESHAREDPV(CopSTASHPV(c))
 #  define SAVECOPFILE(c)	SAVEPPTR(CopFILE(c))
-#  define SAVECOPFILE_FREE(c)	SAVEGENERICPV(CopFILE(c))
+#  define SAVECOPFILE_FREE(c)	SAVESHAREDPV(CopFILE(c))
 #else
 #  define SAVECOPSTASH(c)	SAVESPTR(CopSTASH(c))
 #  define SAVECOPSTASH_FREE(c)	SAVECOPSTASH(c)	/* XXX not refcounted */
diff --git a/sv.c b/sv.c
index 3de686f40e..0cd86d6e39 100644
--- a/sv.c
+++ b/sv.c
@@ -9361,8 +9361,9 @@ Perl_any_dup(pTHX_ void *v, PerlInterpreter *proto_perl)
     /* see if it is part of the interpreter structure */
     if (v >= (void*)proto_perl && v < (void*)(proto_perl+1))
 	ret = (void*)(((char*)aTHX) + (((char*)v) - (char*)proto_perl));
-    else
+    else {
 	ret = v;
+    }
 
     return ret;
 }
@@ -9415,6 +9416,12 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 	    ptr = POPPTR(ss,ix);
 	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
 	    break;
+	case SAVEt_SHARED_PVREF:		/* char* in shared space */
+	    c = (char*)POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = savesharedpv(c);
+	    ptr = POPPTR(ss,ix);
+	    TOPPTR(nss,ix) = any_dup(ptr, proto_perl);
+	    break;
         case SAVEt_GENERIC_SVREF:		/* generic sv */
         case SAVEt_SVREF:			/* scalar reference */
 	    sv = (SV*)POPPTR(ss,ix);
@@ -9784,15 +9791,21 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     SvNVX(&PL_sv_yes)		= 1;
     ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes);
 
-    /* create shared string table */
+    /* create (a non-shared!) shared string table */
     PL_strtab		= newHV();
     HvSHAREKEYS_off(PL_strtab);
     hv_ksplit(PL_strtab, 512);
     ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab);
 
-    PL_compiling		= proto_perl->Icompiling;
-    PL_compiling.cop_stashpv	= SAVEPV(PL_compiling.cop_stashpv);
-    PL_compiling.cop_file	= SAVEPV(PL_compiling.cop_file);
+    PL_compiling = proto_perl->Icompiling;
+
+    /* These two PVs will be free'd special way so must set them same way op.c does */
+    PL_compiling.cop_stashpv = savesharedpv(PL_compiling.cop_stashpv);
+    ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_stashpv, PL_compiling.cop_stashpv);
+
+    PL_compiling.cop_file    = savesharedpv(PL_compiling.cop_file);
+    ptr_table_store(PL_ptr_table, proto_perl->Icompiling.cop_file, PL_compiling.cop_file);
+
     ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling);
     if (!specialWARN(PL_compiling.cop_warnings))
 	PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings, param);
diff --git a/toke.c b/toke.c
index 8382333788..c0384addc7 100644
--- a/toke.c
+++ b/toke.c
@@ -514,11 +514,7 @@ S_incline(pTHX_ char *s)
     ch = *t;
     *t = '\0';
     if (t - s > 0) {
-#ifdef USE_ITHREADS
-	Safefree(CopFILE(PL_curcop));
-#else
-	SvREFCNT_dec(CopFILEGV(PL_curcop));
-#endif
+	CopFILE_free(PL_curcop);
 	CopFILE_set(PL_curcop, s);
     }
     *t = ch;
diff --git a/util.c b/util.c
index 6a0ff448a2..83b9026d8d 100644
--- a/util.c
+++ b/util.c
@@ -891,10 +891,11 @@ Copy a string to a safe spot.  This does not use an SV.
 char *
 Perl_savepv(pTHX_ const char *sv)
 {
-    register char *newaddr;
-
-    New(902,newaddr,strlen(sv)+1,char);
-    (void)strcpy(newaddr,sv);
+    register char *newaddr = sv;
+    if (sv) {
+	New(902,newaddr,strlen(sv)+1,char);
+	(void)strcpy(newaddr,sv);
+    } 
     return newaddr;
 }
 
@@ -920,6 +921,27 @@ Perl_savepvn(pTHX_ const char *sv, register I32 len)
     return newaddr;
 }
 
+/*
+=for apidoc savesharedpv
+
+Copy a string to a safe spot in memory shared between threads.
+This does not use an SV.
+
+=cut
+*/
+char *
+Perl_savesharedpv(pTHX_ const char *sv)
+{
+    register char *newaddr = sv;
+    if (sv) {
+	newaddr = PerlMemShared_malloc(strlen(sv)+1);
+    	(void)strcpy(newaddr,sv);
+    }
+    return newaddr;
+}
+
+
+
 /* the SV for Perl_form() and mess() is not kept in an arena */
 
 STATIC SV *
diff --git a/win32/config_H.vc b/win32/config_H.vc
index 2afea67030..f85db9018c 100644
--- a/win32/config_H.vc
+++ b/win32/config_H.vc
@@ -13,7 +13,7 @@
 /*
  * Package name      : perl5
  * Source directory  : 
- * Configuration time: Fri Jan 11 12:16:33 2002
+ * Configuration time: Mon Jan 14 15:39:13 2002
  * Configured by     : nick
  * Target system     : 
  */
@@ -733,12 +733,6 @@
  */
 /*#define I_MEMORY		/**/
 
-/* I_NDBM:
- *	This symbol, if defined, indicates that <ndbm.h> exists and should
- *	be included.
- */
-/*#define I_NDBM	/**/
-
 /* I_NET_ERRNO:
  *	This symbol, if defined, indicates that <net/errno.h> exists and 
  *	should be included.
@@ -3420,6 +3414,12 @@
 /*#define SETUID_SCRIPTS_ARE_SECURE_NOW	/**/
 /*#define DOSUID		/**/
 
+/* I_NDBM:
+ *	This symbol, if defined, indicates that <ndbm.h> exists and should
+ *	be included.
+ */
+/*#define I_NDBM	/**/
+
 /* I_STDARG:
  *	This symbol, if defined, indicates that <stdarg.h> exists and should
  *	be included.
diff --git a/win32/perlhost.h b/win32/perlhost.h
index 7a6fc437fc..d8288852b3 100644
--- a/win32/perlhost.h
+++ b/win32/perlhost.h
@@ -216,9 +216,7 @@ protected:
     static long num_hosts;
 public:
     inline  int LastHost(void) { return num_hosts == 1L; };
-#ifdef CHECK_HOST_INTERP
     struct interpreter *host_perl;
-#endif
 };
 
 long CPerlHost::num_hosts = 0L;
@@ -244,12 +242,12 @@ inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl)
 
 inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl)
 {
-    return STRUCT2PTR(piPerl, m_hostperlMemShared);
+    return STRUCT2RAWPTR(piPerl, m_hostperlMemShared);
 }
 
 inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl)
 {
-    return STRUCT2PTR(piPerl, m_hostperlMemParse);
+    return STRUCT2RAWPTR(piPerl, m_hostperlMemParse);
 }
 
 inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl)
diff --git a/win32/vmem.h b/win32/vmem.h
index a60459dfe1..712a76edad 100644
--- a/win32/vmem.h
+++ b/win32/vmem.h
@@ -200,15 +200,17 @@ void VMem::Free(void* pMem)
     if (pMem) {
 	PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)(((char*)pMem)-sizeof(MEMORY_BLOCK_HEADER));
         if (ptr->owner != this) {
-#if 0
-	    int *nowhere = NULL;
-            *nowhere = 0;
-#else
 	    if (ptr->owner) {
-	        ptr->owner->Free(pMem);	
+#if 1
+		dTHX;
+	    	int *nowhere = NULL;
+	    	Perl_warn(aTHX_ "Free to wrong pool %p not %p",this,ptr->owner);
+            	*nowhere = 0;
+#else
+                ptr->owner->Free(pMem);	
+#endif
 	    }
 	    return;
-#endif
         }
 	GetLock();
 	UnlinkBlock(ptr);
diff --git a/win32/win32.c b/win32/win32.c
index 246c0c8a47..40b7511296 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -1759,6 +1759,7 @@ win32_async_check(pTHX)
 	    break;
 	}
     }
+    w32_poll_count = 0;
 
     /* Above or other stuff may have set a signal flag */
     if (PL_sig_pending) {
@@ -4561,6 +4562,7 @@ Perl_sys_intern_init(pTHX)
 #  endif
     w32_init_socktype		= 0;
     w32_timerid                 = 0;
+    w32_poll_count              = 0;
     if (my_perl == PL_curinterp) {
         /* Force C runtime signal stuff to set its console handler */
 	signal(SIGINT,&win32_csighandler);
@@ -4603,6 +4605,7 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst)
     Newz(1313, dst->pseudo_children, 1, child_tab);
     dst->thr_intern.Winit_socktype = 0;
     dst->timerid                 = 0;
+    dst->poll_count              = 0;
 }
 #  endif /* USE_ITHREADS */
 #endif /* HAVE_INTERP_INTERN */
diff --git a/win32/win32.h b/win32/win32.h
index c20c2f7250..036db755ec 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -383,11 +383,12 @@ struct interp_intern {
     struct thread_intern	thr_intern;
 #endif
     UINT	timerid;
-    HANDLE	msg_event;
+    unsigned 	poll_count;
 };
 
 DllExport int win32_async_check(pTHX);
 
+#define WIN32_POLL_INTERVAL 32768
 #define PERL_ASYNC_CHECK() if (w32_do_async || PL_sig_pending) win32_async_check(aTHX)
 
 #define w32_perlshell_tokens	(PL_sys_intern.perlshell_tokens)
@@ -405,7 +406,8 @@ DllExport int win32_async_check(pTHX);
 #define w32_pseudo_child_handles	(w32_pseudo_children->handles)
 #define w32_internal_host		(PL_sys_intern.internal_host)
 #define w32_timerid			(PL_sys_intern.timerid)
-#define w32_do_async			(w32_timerid != 0)
+#define w32_poll_count			(PL_sys_intern.poll_count)
+#define w32_do_async			(w32_poll_count++ > WIN32_POLL_INTERVAL)
 #ifdef USE_5005THREADS
 #  define w32_strerror_buffer	(thr->i.Wstrerror_buffer)
 #  define w32_getlogin_buffer	(thr->i.Wgetlogin_buffer)