Integrate win32 branch back into mainline.

p4raw-id: //depot/perl@322

27 files changed, 104 insertions, 77 deletions

diff --git a/EXTERN.h b/EXTERN.h
index 228ed52406..1c10f643b9 100644
--- a/EXTERN.h
+++ b/EXTERN.h
@@ -24,7 +24,7 @@
 #  define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly
 #else
 #  if (defined(_MSC_VER) && defined(_WIN32)) || (defined(__BORLANDC__) && defined(__WIN32__))
-#    ifdef PERLDLL
+#    ifdef PERL_CORE
 #      define EXT extern __declspec(dllexport)
 #      define dEXT 
 #      define EXTCONST extern __declspec(dllexport) const
diff --git a/XSUB.h b/XSUB.h
index c7c3f6d80e..054b4cc7f7 100644
--- a/XSUB.h
+++ b/XSUB.h
@@ -15,7 +15,11 @@
 
 #define dXSI32 I32 ix = XSANY.any_i32
 
-#define XSRETURN(off) stack_sp = stack_base + ax + ((off) - 1); return
+#define XSRETURN(off)					\
+    STMT_START {					\
+	stack_sp = stack_base + ax + ((off) - 1);	\
+	return;						\
+    } STMT_END
 
 /* Simple macros to put new mortal values onto the stack.   */
 /* Typically used to return values from XS functions.       */
diff --git a/embed.h b/embed.h
index b577200f98..541fcf757e 100644
--- a/embed.h
+++ b/embed.h
@@ -254,7 +254,6 @@
 #define he_root			Perl_he_root
 #define hexdigit		Perl_hexdigit
 #define hints			Perl_hints
-#define hoistmust		Perl_hoistmust
 #define hv_clear		Perl_hv_clear
 #define hv_delayfree_ent	Perl_hv_delayfree_ent
 #define hv_delete		Perl_hv_delete
@@ -911,6 +910,8 @@
 #define rsignal_save		Perl_rsignal_save
 #define rsignal_state		Perl_rsignal_state
 #define runops			Perl_runops
+#define runops_debug		Perl_runops_debug
+#define runops_standard		Perl_runops_standard
 #define rxres_free		Perl_rxres_free
 #define rxres_restore		Perl_rxres_restore
 #define rxres_save		Perl_rxres_save
diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c
index 58006789ef..422b3d1bf9 100644
--- a/ext/DynaLoader/dlutils.c
+++ b/ext/DynaLoader/dlutils.c
@@ -26,7 +26,7 @@ static int dl_debug = 0;	/* value copied from $DynaLoader::dl_error */
 
 
 static void
-dl_generic_private_init()	/* called by dl_*.xs dl_private_init() */
+dl_generic_private_init(void)	/* called by dl_*.xs dl_private_init() */
 {
     char *perl_dl_nonlazy;
 #ifdef DEBUGGING
@@ -44,16 +44,8 @@ dl_generic_private_init()	/* called by dl_*.xs dl_private_init() */
 
 
 /* SaveError() takes printf style args and saves the result in LastError */
-#ifdef STANDARD_C
 static void
 SaveError(char* pat, ...)
-#else
-/*VARARGS0*/
-static void
-SaveError(pat, va_alist)
-    char *pat;
-    va_dcl
-#endif
 {
     va_list args;
     char *message;
diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h
index 5bc629f402..ac2dc36b01 100644
--- a/ext/SDBM_File/sdbm/sdbm.h
+++ b/ext/SDBM_File/sdbm/sdbm.h
@@ -49,7 +49,7 @@ typedef struct {
 
 extern datum nullitem;
 
-#if defined(__STDC__) || defined(__cplusplus)
+#if defined(__STDC__) || defined(__cplusplus) || defined(CAN_PROTOTYPE)
 #define proto(p) p
 #else
 #define proto(p) ()
diff --git a/hv.c b/hv.c
index e495e91769..12c17483fd 100644
--- a/hv.c
+++ b/hv.c
@@ -16,8 +16,8 @@
 
 static void hsplit _((HV *hv));
 static void hfreeentries _((HV *hv));
-
-static HE* more_he(void);
+static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store));
+static HE* more_he _((void));
 
 static HE*
 new_he(void)
@@ -217,10 +217,7 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
 }
 
 static void
-hv_magic_check (hv, needs_copy, needs_store)
-HV *hv;
-bool *needs_copy;
-bool *needs_store;
+hv_magic_check (HV *hv, bool *needs_copy, bool *needs_store)
 {
     MAGIC *mg = SvMAGIC(hv);
     *needs_copy = FALSE;
diff --git a/installperl b/installperl
index e999d3bdbf..465b48d171 100755
--- a/installperl
+++ b/installperl
@@ -84,6 +84,17 @@ if ($d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
 -x 't/TEST'		|| warn "WARNING: You've never run 'make test'!!!",
 	"  (Installing anyway.)\n";
 
+if ($^O eq 'MSWin32') {
+
+-f 'perl.' . $dlext || die "No perl DLL built\n";
+
+# Install the DLL
+
+safe_unlink("$installbin/perl.$dlext");
+copy("perl.$dlext", "$installbin/perl.$dlext");
+chmod(0755, "$installbin/perl.$dlext");
+}
+
 # First we install the version-numbered executables.
 
 safe_unlink("$installbin/perl$ver$exe_ext");
@@ -256,7 +267,7 @@ if (! $versiononly || !($installprivlib =~ m/\Q$]/)) {
 
 if (!$versiononly) {
 
-    $dirsep = ($^O eq 'os2') ? ';' : ':' ;
+    $dirsep = ($^O eq 'os2' || $^O eq 'MSWin32') ? ';' : ':' ;
     ($path = $ENV{"PATH"}) =~ s:\\:/:g ;
     @path = split(/$dirsep/, $path);
     @otherperls = ();
@@ -302,7 +313,7 @@ sub unlink {
 
     foreach $name (@names) {
 	next unless -e $name;
-	chmod 0777, $name if $^O eq 'os2';
+	chmod 0777, $name if ($^O eq 'os2' || $^O eq 'MSWin32');
 	print STDERR "  unlink $name\n";
 	( CORE::unlink($name) and ++$cnt 
 	  or warn "Couldn't unlink $name: $!\n" ) unless $nonono;
@@ -315,7 +326,7 @@ sub safe_unlink {
     local @names = @_;
     foreach $name (@names) {
 	next unless -e $name;
-	chmod 0777, $name if $^O eq 'os2';
+	chmod 0777, $name if ($^O eq 'os2' || $^O eq 'MSWin32');
 	print STDERR "  unlink $name\n";
 	next if CORE::unlink($name);
 	warn "Couldn't unlink $name: $!\n";
@@ -383,9 +394,11 @@ sub copy {
 
 sub samepath {
     local($p1, $p2) = @_;
-    local($dev1, $ino1, $dev2, $ino2);
+
+    return (lc($p1) eq lc($p2)) if ($^O eq 'MSWin32');
 
     if ($p1 ne $p2) {
+	local($dev1, $ino1, $dev2, $ino2);
 	($dev1, $ino1) = stat($p1);
 	($dev2, $ino2) = stat($p2);
 	($dev1 == $dev2 && $ino1 == $ino2);
@@ -414,7 +427,9 @@ sub installlib {
 
     my $installlib = $installprivlib;
     if ($dir =~ /^auto/ ||
-	  ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1})) {
+	  ($name =~ /^(.*)\.(?:pm|pod)$/ && $archpms{$1}) ||
+	  ($name =~ /^(.*)\.(?:h|lib)$/i && $^O eq 'MSWin32')
+       ) {
         $installlib = $installarchlib;
 	return unless $do_installarchlib;
     } else {
diff --git a/mg.c b/mg.c
index b7b09d34a1..8a7cfdda14 100644
--- a/mg.c
+++ b/mg.c
@@ -1733,10 +1733,10 @@ Signal_t
 sighandler(int sig)
 {
     dSP;
-    GV *gv;
+    GV *gv = Nullgv;
     HV *st;
     SV *sv, *tSv = Sv;
-    CV *cv;
+    CV *cv = Nullcv;
     AV *oldstack;
     OP *myop = op;
     U32 flags = 0;
@@ -1788,8 +1788,11 @@ sighandler(int sig)
     if (!cv || !CvROOT(cv)) {
 	if (dowarn)
 	    warn("SIG%s handler \"%s\" not defined.\n",
-		sig_name[sig], GvENAME(gv) );
-	return;
+		sig_name[sig], (gv ? GvENAME(gv)
+				: ((cv && CvGV(cv))
+				   ? GvENAME(CvGV(cv))
+				   : "__ANON__")));
+	goto cleanup;
     }
 
     oldstack = curstack;
@@ -1812,6 +1815,7 @@ sighandler(int sig)
     perl_call_sv((SV*)cv, G_DISCARD);
 
     SWITCHSTACK(signalstack, oldstack);
+cleanup:
     if (flags & 1)
 	savestack_ix -= 8; /* Unprotect save in progress. */
     if (flags & 2) {
diff --git a/op.c b/op.c
index 6c29226e6b..a922a2bf86 100644
--- a/op.c
+++ b/op.c
@@ -531,8 +531,7 @@ find_threadsv(char *name)
 	case '\'':
 	    sawampersand = TRUE;
 	    SvREADONLY_on(sv);
-	    sv_magic(sv, 0, 0, name, 1); 
-	    break;
+	    /* FALL THROUGH */
 	default:
 	    sv_magic(sv, 0, 0, name, 1); 
 	}
@@ -3434,7 +3433,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 	if (PERLDB_SUBLINE && curstash != debstash) {
 	    SV *sv = NEWSV(0,0);
 	    SV *tmpstr = sv_newmortal();
-	    static GV *db_postponed;
+	    GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
 	    CV *cv;
 	    HV *hv;
 
@@ -3443,9 +3442,6 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 		    (long)curcop->cop_line);
 	    gv_efullname3(tmpstr, gv, Nullch);
 	    hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
-	    if (!db_postponed) {
-		db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
-	    }
 	    hv = GvHVn(db_postponed);
 	    if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
 		  && (cv = GvCV(db_postponed))) {
@@ -4414,7 +4410,7 @@ ck_shift(OP *o)
 	
 	op_free(o);
 #ifdef USE_THREADS
-	if (subline > 0) {
+	if (!CvUNIQUE(compcv)) {
 	    argop = newOP(OP_PADAV, OPf_REF);
 	    argop->op_targ = 0;		/* curpad[0] is @_ */
 	}
@@ -4425,7 +4421,7 @@ ck_shift(OP *o)
 	}
 #else
 	argop = newUNOP(OP_RV2AV, 0,
-	    scalar(newGVOP(OP_GV, 0, subline > 0 ?
+	    scalar(newGVOP(OP_GV, 0, !CvUNIQUE(compcv) ?
 			   defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
 #endif /* USE_THREADS */
 	return newUNOP(type, 0, scalar(argop));
diff --git a/perl.h b/perl.h
index 0ffb04c74b..e68ecf6a88 100644
--- a/perl.h
+++ b/perl.h
@@ -254,6 +254,8 @@ register struct op *op asm(stringify(OP_IN_REGISTER));
 #   include <stdlib.h>
 #endif
 
+#define MEM_SIZE Size_t
+
 /* This comes after <stdlib.h> so we don't try to change the standard
  * library prototypes; we'll use our own in proto.h instead. */
 
@@ -264,12 +266,20 @@ register struct op *op asm(stringify(OP_IN_REGISTER));
 #	define calloc  Mycalloc
 #	define realloc Myremalloc
 #	define free    Myfree
+Malloc_t Mymalloc _((MEM_SIZE nbytes));
+Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size));
+Malloc_t Myrealloc _((Malloc_t where, MEM_SIZE nbytes));
+Free_t   Myfree _((Malloc_t where));
 #   endif
 #   ifdef EMBEDMYMALLOC
 #	define malloc  Perl_malloc
 #	define calloc  Perl_calloc
 #	define realloc Perl_realloc
 #	define free    Perl_free
+Malloc_t Perl_malloc _((MEM_SIZE nbytes));
+Malloc_t Perl_calloc _((MEM_SIZE elements, MEM_SIZE size));
+Malloc_t Perl_realloc _((Malloc_t where, MEM_SIZE nbytes));
+Free_t   Perl_free _((Malloc_t where));
 #   endif
 
 #   undef safemalloc
@@ -283,8 +293,6 @@ register struct op *op asm(stringify(OP_IN_REGISTER));
 
 #endif /* MYMALLOC */
 
-#define MEM_SIZE Size_t
-
 #if defined(STANDARD_C) && defined(I_STDDEF)
 #   include <stddef.h>
 #   define STRUCT_OFFSET(s,m)  offsetof(s,m)
diff --git a/perly.c b/perly.c
index 9ae4211943..7117566c20 100644
--- a/perly.c
+++ b/perly.c
@@ -1767,7 +1767,7 @@ case 56:
 { char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, na);
 			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
 			      || strEQ(name, "INIT"))
-			  { CvUNIQUE_on(compcv); subline = -subline; }
+			      CvUNIQUE_on(compcv);
 			  yyval.opval = yyvsp[0].opval; }
 break;
 case 57:
diff --git a/perly.y b/perly.y
index fa0e0f5f59..481a2ccad6 100644
--- a/perly.y
+++ b/perly.y
@@ -291,7 +291,7 @@ startformsub:	/* NULL */	/* start a format subroutine scope */
 subname	:	WORD	{ char *name = SvPV(((SVOP*)$1)->op_sv, na);
 			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
 			      || strEQ(name, "INIT"))
-			  { CvUNIQUE_on(compcv); subline = -subline; }
+			      CvUNIQUE_on(compcv);
 			  $$ = $1; }
 	;
 
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index aa1e82eac8..887f827381 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -2856,10 +2856,12 @@ argument.
 Shifts the first value of the array off and returns it, shortening the
 array by 1 and moving everything down.  If there are no elements in the
 array, returns the undefined value.  If ARRAY is omitted, shifts the
-@ARGV array in the main program, and the @_ array in subroutines.
-(This is determined lexically.)  See also unshift(), push(), and pop().
-Shift() and unshift() do the same thing to the left end of an array
-that pop() and push() do to the right end.
+@_ array within the lexical scope of subroutines and formats, and the
+@ARGV array at file scopes or within the lexical scopes established by
+the C<eval ''>, C<BEGIN {}>, C<END {}>, and C<INIT {}> constructs.
+See also unshift(), push(), and pop().  Shift() and unshift() do the
+same thing to the left end of an array that pop() and push() do to the
+right end.
 
 =item shmctl ID,CMD,ARG
 
diff --git a/pp_ctl.c b/pp_ctl.c
index d9f985e8e4..834f0c0dad 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1050,11 +1050,14 @@ die_where(char *message)
 	    if (svp) {
 		if (!SvIOK(*svp)) {
 		    static char prefix[] = "\t(in cleanup) ";
+		    SV *err = ERRSV;
 		    sv_upgrade(*svp, SVt_IV);
 		    (void)SvIOK_only(*svp);
-		    SvGROW(ERRSV, SvCUR(ERRSV)+sizeof(prefix)+klen);
-		    sv_catpvn(ERRSV, prefix, sizeof(prefix)-1);
-		    sv_catpvn(ERRSV, message, klen);
+		    if (!SvPOK(err))
+			sv_setpv(err,"");
+		    SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
+		    sv_catpvn(err, prefix, sizeof(prefix)-1);
+		    sv_catpvn(err, message, klen);
 		}
 		sv_inc(*svp);
 	    }
diff --git a/proto.h b/proto.h
index 202331be98..7b47a93099 100644
--- a/proto.h
+++ b/proto.h
@@ -568,13 +568,6 @@ int	yylex _((void));
 int	yyparse _((void));
 int	yywarn _((char* s));
 
-#if defined(MYMALLOC) || !defined(STANDARD_C)
-Malloc_t malloc _((MEM_SIZE nbytes));
-Malloc_t calloc _((MEM_SIZE elements, MEM_SIZE size));
-Malloc_t realloc _((Malloc_t where, MEM_SIZE nbytes));
-Free_t   free _((Malloc_t where));
-#endif
-
 #ifndef MYMALLOC
 Malloc_t safemalloc _((MEM_SIZE nbytes));
 Malloc_t safecalloc _((MEM_SIZE elements, MEM_SIZE size));
diff --git a/regcomp.h b/regcomp.h
index 2a00d40b6f..fe29b2dd06 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -440,12 +440,6 @@ const static char reg_off_by_arg[] = {
 };
 #endif
 
-struct reg_data {
-    U32 count;
-    U8 *what;
-    void* data[1];
-};
-
 #define REG_SEEN_ZERO_LEN	1
 #define REG_SEEN_LOOKBEHIND	2
 #define REG_SEEN_GPOS		4
diff --git a/regexp.h b/regexp.h
index 2f7aa02b3d..7137ffc329 100644
--- a/regexp.h
+++ b/regexp.h
@@ -17,6 +17,12 @@ struct regnode {
 
 typedef struct regnode regnode;
 
+struct reg_data {
+    U32 count;
+    U8 *what;
+    void* data[1];
+};
+
 typedef struct regexp {
 	I32 refcnt;
 	char **startp;
diff --git a/t/op/sort.t b/t/op/sort.t
index c792bbb48e..a6829e01e4 100755
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -2,7 +2,7 @@
 
 # $RCSfile: sort.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:24 $
 
-print "1..19\n";
+print "1..21\n";
 
 sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 }
 
@@ -91,3 +91,14 @@ print ($@ =~ /redefine active sort/ ? "ok 18\n" : "not ok 18\n");
 	       };
 eval { @b = sort twoface 4,1 };
 print $@ ? "$@" : "not ok 19\n";
+
+eval <<'CODE';
+    my @result = sort main'backwards 'one', 'two';
+CODE
+print $@ ? "not ok 20\n# $@" : "ok 20\n";
+
+eval <<'CODE';
+    # "sort 'one', 'two'" should not try to parse "'one" as a sort sub
+    my @result = sort 'one', 'two';
+CODE
+print $@ ? "not ok 21\n# $@" : "ok 21\n";
diff --git a/toke.c b/toke.c
index 95be7df498..dbb273a263 100644
--- a/toke.c
+++ b/toke.c
@@ -500,7 +500,7 @@ force_next(I32 type)
 }
 
 static char *
-force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_tick)
+force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
 {
     register char *s;
     STRLEN len;
@@ -509,7 +509,7 @@ force_word(register char *start, int token, int check_keyword, int allow_pack, i
     s = start;
     if (isIDFIRST(*s) ||
 	(allow_pack && *s == ':') ||
-	(allow_tick && *s == '\'') )
+	(allow_initial_tick && *s == '\'') )
     {
 	s = scan_word(s, tokenbuf, sizeof tokenbuf, allow_pack, &len);
 	if (check_keyword && keyword(tokenbuf, len))
@@ -3542,7 +3542,7 @@ yylex(void)
 	    if (*s == ';' || *s == ')')		/* probably a close */
 		croak("sort is now a reserved word");
 	    expect = XTERM;
-	    s = force_word(s,WORD,TRUE,TRUE,TRUE);
+	    s = force_word(s,WORD,TRUE,TRUE,FALSE);
 	    LOP(OP_SORT,XREF);
 
 	case KEY_split:
diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index e3c100b45d..7514f16803 100644
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -1770,7 +1770,7 @@ case 56:
 { char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, na);
 			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
 			      || strEQ(name, "INIT"))
-			  { CvUNIQUE_on(compcv); subline = -subline; }
+			      CvUNIQUE_on(compcv);
 			  yyval.opval = yyvsp[0].opval; }
 break;
 case 57:
diff --git a/win32/Makefile b/win32/Makefile
index 91a417da2f..e2d3d446c2 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -52,7 +52,7 @@ RUNTIME  = -MD
 INCLUDES = -I.\include -I. -I..
 #PCHFLAGS = -Fp"$(INTDIR)/modules.pch" -YX 
 DEFINES  = -DWIN32 -D_CONSOLE $(BUILDOPT)
-LOCDEFS  = -DPERLDLL $(CORECCOPT)
+LOCDEFS  = -DPERLDLL -DPERL_CORE $(CORECCOPT)
 SUBSYS   = console
 
 !IF "$(RUNTIME)" == "-MD"
diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs
index 7b227e299c..cf6797e5fe 100644
--- a/win32/dl_win32.xs
+++ b/win32/dl_win32.xs
@@ -28,7 +28,7 @@ calls.
 #include "dlutils.c"	/* SaveError() etc	*/
 
 static void
-dl_private_init()
+dl_private_init(void)
 {
     (void)dl_generic_private_init();
 }
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 03788c731e..7bbf0bb426 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -55,7 +55,7 @@ CCLIBDIR = $(CCHOME)\lib
 CC = bcc32
 LINK32 = tlink32
 LIB32 = tlib
-IMPLIB = implib
+IMPLIB = implib -c
 
 #
 # Options
@@ -64,7 +64,7 @@ RUNTIME  = -D_RTLDLL
 INCLUDES = -I.\include -I. -I.. -I$(CCINCDIR)
 #PCHFLAGS = -H -H$(INTDIR)\bcmoduls.pch 
 DEFINES  = -DWIN32 $(BUILDOPT) 
-LOCDEFS  = -DPERLDLL
+LOCDEFS  = -DPERLDLL -DPERL_CORE
 SUBSYS   = console
 LIBC = cw32mti.lib
 LIBFILES = import32.lib $(LIBC) odbc32.lib odbccp32.lib
@@ -97,7 +97,7 @@ RUNTIME  = -MD
 INCLUDES = -I.\include -I. -I..
 #PCHFLAGS = -Fp$(INTDIR)\vcmoduls.pch -YX 
 DEFINES  = -DWIN32 -D_CONSOLE $(BUILDOPT)
-LOCDEFS  = -DPERLDLL
+LOCDEFS  = -DPERLDLL -DPERL_CORE
 SUBSYS   = console
 
 .IF "$(RUNTIME)" == "-MD"
diff --git a/win32/win32.h b/win32/win32.h
index 2e31d0e3ba..d0dde7e53f 100644
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -151,7 +151,7 @@ typedef  char *		caddr_t;	/* In malloc.c (core address). */
 /* #define PERL_SBRK_VIA_MALLOC	/**/
 #endif
 
-#ifdef PERLDLL
+#if defined(PERLDLL) && !defined(PERL_CORE)
 #define PERL_CORE
 #endif
 
diff --git a/win32/win32iop.h b/win32/win32iop.h
index bd70def18e..533370e99e 100644
--- a/win32/win32iop.h
+++ b/win32/win32iop.h
@@ -220,7 +220,7 @@ END_EXTERN_C
 #define getchar			win32_getchar
 #define putchar			win32_putchar
 
-#if !defined(MYMALLOC) || !defined(PERLDLL)
+#if !defined(MYMALLOC) || !defined(PERL_CORE)
 #undef malloc
 #undef calloc
 #undef realloc
diff --git a/win32/win32thread.c b/win32/win32thread.c
index 3e63327638..039f8b4b6f 100644
--- a/win32/win32thread.c
+++ b/win32/win32thread.c
@@ -1,15 +1,15 @@
 #include "EXTERN.h"
 #include "perl.h"
 
-__declspec(thread) struct thread *Perl_current_thread = NULL;
+__declspec(thread) struct perl_thread *Perl_current_thread = NULL;
 
 void
-Perl_setTHR(struct thread *t)
+Perl_setTHR(struct perl_thread *t)
 {
  Perl_current_thread = t;
 }
 
-struct thread *
+struct perl_thread *
 Perl_getTHR(void)
 {
  return Perl_current_thread;
diff --git a/win32/win32thread.h b/win32/win32thread.h
index 0d92ffc96f..591184b007 100644
--- a/win32/win32thread.h
+++ b/win32/win32thread.h
@@ -97,7 +97,7 @@ typedef HANDLE perl_mutex;
 	}							\
     } STMT_END
 
-#define THR ((struct perl_thread *) TlsGetValue(thr_key))
+
 #define THREAD_CREATE(t, f)	Perl_thread_create(t, f)
 #define THREAD_POST_CREATE(t)	NOOP
 #define THREAD_RET_TYPE		DWORD WINAPI
@@ -109,7 +109,7 @@ typedef THREAD_RET_TYPE thread_func_t(void *);
 START_EXTERN_C
 
 #if defined(PERLDLL) && (!defined(__BORLANDC__) || defined(_DLL))
-extern __declspec(thread) struct thread *Perl_current_thread;
+extern __declspec(thread) struct perl_thread *Perl_current_thread;
 #define SET_THR(t)   		(Perl_current_thread = t)
 #define THR			Perl_current_thread
 #else
@@ -122,6 +122,7 @@ int Perl_thread_create _((struct perl_thread *thr, thread_func_t *fn));
 void Perl_set_thread_self _((struct perl_thread *thr));
 struct perl_thread *Perl_getTHR _((void));
 void Perl_setTHR _((struct perl_thread *t));
+
 END_EXTERN_C
 
 #define INIT_THREADS NOOP