MYMALLOC for Win32:

1. Initialize malloc_mutex before it is used (all platforms!)
2. Adjust #ifdef muddle to allow MYMALLOC and win32_ to coexist
3. Tweak win32/config*.* to define MYMALLOC
4. Provide sbrk() in terms of VirtualAlloc().

Also fixup -MT (perl95) build to handle Perl_current_thread
via call to DLL (as though an extension).

p4raw-id: //depot/ansiperl@259

diff --git a/win32/Makefile b/win32/Makefile
index d2e4641..8993691 100644 (file)
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -20,7 +20,7 @@ CORECCOPT=
 
 #
 # uncomment next line if you want debug version of perl (big,slow)
-#CFG=Debug
+CFG=Debug
 
 #
 # set the install locations of the compiler include/libraries
@@ -166,7 +166,8 @@ CORE_C=     ..\av.c         \
        ..\taint.c      \
        ..\toke.c       \
        ..\universal.c  \
-       ..\util.c
+       ..\util.c       \
+       ..\malloc.c
 
 CORE_OBJ= ..\av.obj    \
        ..\deb.obj      \
@@ -193,7 +194,8 @@ CORE_OBJ= ..\av.obj \
        ..\taint.obj    \
        ..\toke.obj     \
        ..\universal.obj\
-       ..\util.obj
+       ..\util.obj     \
+       ..\malloc.obj      
 
 WIN32_C = perllib.c \
        win32.c \
@@ -335,7 +337,7 @@ $(WIN32_OBJ) : $(CORE_H)
 $(CORE_OBJ)  : $(CORE_H)
 $(DLL_OBJ)   : $(CORE_H) 
 
-perldll.def : $(MINIPERL) $(CONFIGPM)
+perldll.def : $(MINIPERL) $(CONFIGPM) makedef.pl
        $(MINIPERL) -w makedef.pl $(DEFINES) $(CCTYPE) > perldll.def
 
 $(PERLDLL): perldll.def $(CORE_OBJ) $(WIN32_OBJ) $(DLL_OBJ)

diff --git a/win32/config.bc b/win32/config.bc
index 5dd96fd..9896631 100644 (file)
--- a/win32/config.bc
+++ b/win32/config.bc
@@ -162,7 +162,7 @@ d_msgctl='define'
 d_msgget='define'
 d_msgrcv='define'
 d_msgsnd='define'
-d_mymalloc='undef'
+d_mymalloc='define'
 d_nice='undef'
 d_oldarchlib='undef'
 d_oldsock='undef'

diff --git a/win32/config.vc b/win32/config.vc
index d34b1f9..b349000 100644 (file)
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -162,7 +162,7 @@ d_msgctl='define'
 d_msgget='define'
 d_msgrcv='define'
 d_msgsnd='define'
-d_mymalloc='undef'
+d_mymalloc='define'
 d_nice='undef'
 d_oldarchlib='undef'
 d_oldsock='undef'

diff --git a/win32/config_H.bc b/win32/config_H.bc
index 61fb5a3..328efec 100644 (file)
--- a/win32/config_H.bc
+++ b/win32/config_H.bc
@@ -1654,7 +1654,7 @@
 /* MYMALLOC:
  *     This symbol, if defined, indicates that we're using our own malloc.
  */
-/*#define MYMALLOC                     /**/
+#define MYMALLOC                       /**/
 
 /* OLDARCHLIB:
  *     This variable, if defined, holds the name of the directory in

diff --git a/win32/config_H.vc b/win32/config_H.vc
index 4634072..f69a471 100644 (file)
--- a/win32/config_H.vc
+++ b/win32/config_H.vc
@@ -1654,7 +1654,7 @@
 /* MYMALLOC:
  *     This symbol, if defined, indicates that we're using our own malloc.
  */
-/*#define MYMALLOC                     /**/
+#define MYMALLOC                       /**/
 
 /* OLDARCHLIB:
  *     This variable, if defined, holds the name of the directory in

diff --git a/win32/makedef.pl b/win32/makedef.pl
index 03a4239..c82ded0 100644 (file)
--- a/win32/makedef.pl
+++ b/win32/makedef.pl
@@ -20,10 +20,23 @@ while (@ARGV && $ARGV[0] =~ /^-/)
   $define{$1} = 1 if ($flag =~ /^-D(\w+)$/);
  } 
 
+open(CFG,'config.h') || die "Cannot open config.h:$!";
+while (<CFG>)
+ {
+  $define{$1} = 1 if /^\s*#\s*define\s+(MYMALLOC)\b/;
+ }
+close(CFG);
+
 warn join(' ',keys %define)."\n";
 
 my $CCTYPE = shift || "MSVC";
 
+print "LIBRARY Perl\n";
+print "DESCRIPTION 'Perl interpreter, export autogenerated'\n";
+print "CODE LOADONCALL\n";
+print "DATA LOADONCALL NONSHARED MULTIPLE\n";
+print "EXPORTS\n";
+
 $skip_sym=<<'!END!OF!SKIP!';
 Perl_block_type
 Perl_additem
@@ -143,6 +156,20 @@ Perl_cshname
 Perl_opsave
 !END!OF!SKIP!
 
+if ($define{'MYMALLOC'})
+ {
+  $skip_sym .= <<'!END!OF!SKIP!';
+Perl_safefree
+Perl_safemalloc
+Perl_saferealloc
+Perl_safecalloc
+!END!OF!SKIP!
+  emit_symbol('Perl_malloc');
+  emit_symbol('Perl_free');
+  emit_symbol('Perl_realloc');
+  emit_symbol('Perl_calloc');
+ }
+
 unless ($define{'USE_THREADS'})
  {
   $skip_sym .= <<'!END!OF!SKIP!';
@@ -193,12 +220,6 @@ unless ($define{'USE_THREADS'})
 # sticks in front of them.
 
 
-print "LIBRARY Perl\n";
-print "DESCRIPTION 'Perl interpreter, export autogenerated'\n";
-print "CODE LOADONCALL\n";
-print "DATA LOADONCALL NONSHARED MULTIPLE\n";
-print "EXPORTS\n";
-
 open (GLOBAL, "<../global.sym") || die "failed to open global.sym" . $!;
 while (<GLOBAL>) {
        my $symbol;

diff --git a/win32/makefile.mk b/win32/makefile.mk
index 2b7dc8c..03788c7 100644 (file)
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -234,7 +234,8 @@ CORE_C=     ..\av.c         \
        ..\taint.c      \
        ..\toke.c       \
        ..\universal.c  \
-       ..\util.c
+       ..\util.c       \
+       ..\malloc.c
 
 CORE_OBJ= ..\av.obj    \
        ..\deb.obj      \
@@ -261,7 +262,8 @@ CORE_OBJ= ..\av.obj \
        ..\taint.obj    \
        ..\toke.obj     \
        ..\universal.obj\
-       ..\util.obj
+       ..\util.obj     \
+       ..\malloc.obj
 
 WIN32_C = perllib.c \
        win32.c \

diff --git a/win32/perllib.c b/win32/perllib.c
index 8483606..c24941f 100644 (file)
--- a/win32/perllib.c
+++ b/win32/perllib.c
@@ -15,6 +15,10 @@ RunPerl(int argc, char **argv, char **env, void *iosubsystem)
     int exitstatus;
     PerlInterpreter *my_perl;
 
+#ifdef USE_THREADS
+    MUTEX_INIT(&malloc_mutex); 
+#endif
+
     PERL_SYS_INIT(&argc,&argv);
 
     perl_init_i18nl10n(1);

diff --git a/win32/win32.c b/win32/win32.c
index 4551679..f31e5a8 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -1303,6 +1303,85 @@ win32_putchar(int c)
     return putchar(c);
 }
 
+#ifdef MYMALLOC
+
+#ifndef USE_PERL_SBRK
+
+static char *committed = NULL;
+static char *base      = NULL;
+static char *reserved  = NULL;
+static char *brk       = NULL;
+static DWORD pagesize  = 0;
+static DWORD allocsize = 0;
+
+void *
+sbrk(int need)
+{
+ void *result;
+ if (!pagesize)
+  {SYSTEM_INFO info;
+   GetSystemInfo(&info);
+   /* Pretend page size is larger so we don't perpetually
+    * call the OS to commit just one page ...
+    */
+   pagesize = info.dwPageSize << 3;
+   allocsize = info.dwAllocationGranularity;
+  }
+ /* This scheme fails eventually if request for contiguous
+  * block is denied so reserve big blocks - this is only 
+  * address space not memory ...
+  */
+ if (brk+need >= reserved)
+  {
+   DWORD size = 64*1024*1024;
+   char *addr;
+   if (committed && reserved && committed < reserved)
+    {
+     /* Commit last of previous chunk cannot span allocations */
+     addr = VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE);
+     if (addr)
+      committed = reserved;
+    }
+   /* Reserve some (more) space 
+    * Note this is a little sneaky, 1st call passes NULL as reserved
+    * so lets system choose where we start, subsequent calls pass
+    * the old end address so ask for a contiguous block
+    */
+   addr  = VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
+   if (addr)
+    {
+     reserved = addr+size;
+     if (!base)
+      base = addr;
+     if (!committed)
+      committed = base;
+     if (!brk)
+      brk = committed;
+    }
+   else
+    {
+     return (void *) -1;
+    }
+  }
+ result = brk;
+ brk += need;
+ if (brk > committed)
+  {
+   DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
+   char *addr = VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
+   if (addr)
+    {
+     committed += size;
+    }
+   else
+    return (void *) -1;
+  }
+ return result;
+}
+
+#endif
+#endif
+
 DllExport void*
 win32_malloc(size_t size)
 {
@@ -1327,6 +1406,7 @@ win32_free(void *block)
     free(block);
 }
 
+
 int
 win32_open_osfhandle(long handle, int flags)
 {

diff --git a/win32/win32.h b/win32/win32.h
index 18bf8a2..54e9855 100644 (file)
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -145,4 +145,14 @@ typedef  char *            caddr_t;        /* In malloc.c (core address). */
 #include <sys/socket.h>
 #include <netdb.h>
 
+#ifdef MYMALLOC
+#define EMBEDMYMALLOC  /**/
+/* #define USE_PERL_SBRK       /**/
+/* #define PERL_SBRK_VIA_MALLOC        /**/
+#endif
+
+#ifdef PERLDLL
+#define PERL_CORE
+#endif
+
 #endif /* _INC_WIN32_PERL5 */

diff --git a/win32/win32iop.h b/win32/win32iop.h
index a60194d..bd70def 100644 (file)
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -219,10 +219,17 @@ END_EXTERN_C
 #define puts                   win32_puts
 #define getchar                        win32_getchar
 #define putchar                        win32_putchar
+
+#if !defined(MYMALLOC) || !defined(PERLDLL)
+#undef malloc
+#undef calloc
+#undef realloc
+#undef free
 #define malloc                 win32_malloc
 #define calloc                 win32_calloc
 #define realloc                        win32_realloc
 #define free                   win32_free
+#endif
 
 #define pipe(fd)               win32_pipe((fd), 512, O_BINARY)
 #define pause()                        win32_sleep((32767L << 16) + 32767)

diff --git a/win32/win32thread.h b/win32/win32thread.h
index 1807f3b..66f2168 100644 (file)
--- a/win32/win32thread.h
+++ b/win32/win32thread.h
@@ -108,7 +108,7 @@ typedef THREAD_RET_TYPE thread_func_t(void *);
 
 START_EXTERN_C
 
-#ifdef PERLDLL
+#if defined(PERLDLL) && defined(_DLL)
 extern __declspec(thread) struct thread *Perl_current_thread;
 #define SET_THR(t)             (Perl_current_thread = t)
 #define THR                    Perl_current_thread