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

5 files changed, 24 insertions, 19 deletions

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)