diff options
| -rw-r--r-- | win32/Makefile | 10 | ||||
| -rw-r--r-- | win32/config.bc | 2 | ||||
| -rw-r--r-- | win32/config.vc | 2 | ||||
| -rw-r--r-- | win32/config_H.bc | 2 | ||||
| -rw-r--r-- | win32/config_H.vc | 2 | ||||
| -rw-r--r-- | win32/makedef.pl | 33 | ||||
| -rw-r--r-- | win32/makefile.mk | 6 | ||||
| -rw-r--r-- | win32/perllib.c | 4 | ||||
| -rw-r--r-- | win32/win32.c | 80 | ||||
| -rw-r--r-- | win32/win32.h | 10 | ||||
| -rw-r--r-- | win32/win32iop.h | 7 | ||||
| -rw-r--r-- | win32/win32thread.h | 2 |
12 files changed, 143 insertions, 17 deletions
diff --git a/win32/Makefile b/win32/Makefile index d2e464145a..8993691b42 100644 --- 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 5dd96fd8e8..9896631d4a 100644 --- 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 d34b1f93fb..b34900092b 100644 --- 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 61fb5a3241..328efec605 100644 --- 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 4634072a4e..f69a4717d3 100644 --- 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 03a42395ce..c82ded0230 100644 --- 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 2b7dc8ccbe..03788c731e 100644 --- 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 848360698b..c24941f111 100644 --- 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 4551679f58..f31e5a8f7f 100644 --- 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 18bf8a2e96..54e98551aa 100644 --- 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 a60194d0f0..bd70def18e 100644 --- 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 1807f3bc46..66f216876f 100644 --- 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 |