From: Gurusamy Sarathy <gsar@cpan.org>
Date: Wed, 27 May 1998 12:50:34 +0000 (+0000)
Subject: [asperl] add AS patch#21 (misc. fixes)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=58a50f6288bdd18f3f469352f83c5e7ade50ee7a;p=p5sagit%2Fp5-mst-13.2.git

[asperl] add AS patch#21 (misc. fixes)

p4raw-id: //depot/asperl@1036
---

diff --git a/ObjXSub.h b/ObjXSub.h
index 43f360c..f0c8c3a 100644
--- a/ObjXSub.h
+++ b/ObjXSub.h
@@ -896,6 +896,8 @@
 #define dump_all            pPerl->Perl_dump_all
 #undef  dump_eval
 #define dump_eval           pPerl->Perl_dump_eval
+#undef  dump_fds
+#define dump_fds            pPerl->Perl_dump_fds
 #undef  dump_form
 #define dump_form           pPerl->Perl_dump_form
 #undef  dump_gv
@@ -1403,6 +1405,8 @@
 #define pad_swipe           pPerl->Perl_pad_swipe
 #undef  peep
 #define peep                pPerl->Perl_peep
+#undef  perl_atexit
+#define perl_atexit         pPerl->perl_atexit
 #undef  perl_call_argv
 #define perl_call_argv      pPerl->perl_call_argv
 #undef  perl_call_method
diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm
index 3b5dbb3..f1102aa 100644
--- a/lib/ExtUtils/MM_Unix.pm
+++ b/lib/ExtUtils/MM_Unix.pm
@@ -370,9 +370,12 @@ sub cflags {
 
     if ($self->{CAPI}) {
         $self->{CCFLAGS} =~ s/-DPERL_OBJECT(\s|$)//;
-        $self->{CCFLAGS} =~ s/-TP(\s|$)//;
-        $self->{OPTIMIZE} =~ s/-TP(\s|$)//;
         $self->{CCFLAGS} .= '-DPERL_CAPI';
+        if ($Is_Win32 && $Config{'cc'} =~ /^cl.exe/i) {
+            # Turn off C++ mode of the MSC compiler
+            $self->{CCFLAGS} =~ s/-TP(\s|$)//;
+            $self->{OPTIMIZE} =~ s/-TP(\s|$)//;
+        }
     }
     return $self->{CFLAGS} = qq{
 CCFLAGS = $self->{CCFLAGS}
diff --git a/objpp.h b/objpp.h
index 4bc40cd..32f0603 100644
--- a/objpp.h
+++ b/objpp.h
@@ -325,6 +325,8 @@
 #define dump_form         CPerlObj::Perl_dump_form
 #undef  dump_gv
 #define dump_gv           CPerlObj::Perl_dump_gv
+#undef  dump_mstats
+#define dump_mstats       CPerlObj::Perl_dump_mstats
 #undef  dump_op
 #define dump_op           CPerlObj::Perl_dump_op
 #undef  dump_pm
@@ -710,7 +712,9 @@
 #undef  my_lstat
 #define my_lstat          CPerlObj::Perl_my_lstat
 #undef  my_memcmp
-#define my_memcmp         CPerlObj::my_memcmp
+#define my_memcmp         CPerlObj::Perl_my_memcmp
+#undef  my_memset
+#define my_memset         CPerlObj::Perl_my_memset
 #undef  my_pclose
 #define my_pclose         CPerlObj::Perl_my_pclose
 #undef  my_popen
diff --git a/perl.h b/perl.h
index 34f68b2..a1122a6 100644
--- a/perl.h
+++ b/perl.h
@@ -1824,6 +1824,16 @@ typedef enum {
 #define PERLVARI(var,type,init) type var;
 #define PERLVARIC(var,type,init) type var;
 
+/* Interpreter exitlist entry */
+typedef struct exitlistentry {
+#ifdef PERL_OBJECT
+    void (*fn) _((CPerlObj*, void*));
+#else
+    void (*fn) _((void*));
+#endif
+    void *ptr;
+} PerlExitListEntry;
+
 #ifdef PERL_OBJECT
 extern "C" CPerlObj* perl_alloc _((IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*));
 
@@ -1842,16 +1852,6 @@ public:
 	void* operator new(size_t nSize, IPerlMem *pvtbl);
 #endif /* PERL_OBJECT */
 
-/* Interpreter exitlist entry */
-typedef struct exitlistentry {
-#ifdef PERL_OBJECT
-    void (*fn) _((CPerlObj*, void*));
-#else
-    void (*fn) _((void*));
-#endif
-    void *ptr;
-} PerlExitListEntry;
-
 #ifdef PERL_GLOBAL_STRUCT
 struct perl_vars {
 #include "perlvars.h"
diff --git a/win32/GenCAPI.pl b/win32/GenCAPI.pl
index fe30933..67b3de4 100644
--- a/win32/GenCAPI.pl
+++ b/win32/GenCAPI.pl
@@ -50,15 +50,13 @@ debprofdump
 debop
 debstack
 debstackptrs
-deb_place_holder
-deb_growlevel_place_holder
-debprofdump_place_holder
-debop_place_holder
-debstack_place_holder
-debstackptrs_place_holder
+dump_fds
+dump_mstats
 fprintf
 find_threadsv
 magic_mutexfree
+my_memcmp
+my_memset
 my_pclose
 my_popen
 my_swap
@@ -291,7 +289,7 @@ ENDCODE
 #undef $name
 extern "C" $type $name ($args)
 {
-    return pPerl->perl_atexit(fn, ptr);
+    pPerl->perl_atexit(fn, ptr);
 }
 ENDCODE
                 print OUTFILE "#endif\n" unless ($separateObj == 0);
@@ -1179,11 +1177,11 @@ char ** _Perl_op_name ();
 #define Perl_op_name (_Perl_op_name())
 
 #undef Perl_no_modify
-char ** _Perl_no_modify ();
+char * _Perl_no_modify ();
 #define Perl_no_modify (_Perl_no_modify())
 
 #undef Perl_opargs
-char ** _Perl_opargs ();
+U32 * _Perl_opargs ();
 #define Perl_opargs (_Perl_opargs())
 
 
diff --git a/win32/Makefile b/win32/Makefile
index 335485a..c793676 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -143,9 +143,9 @@ OPTIMIZE	= -Od $(RUNTIME)d -Zi -D_DEBUG -DDEBUGGING
 LINK_DBG	= -debug -pdb:none
 !ELSE
 !  IF "$(CCTYPE)" == "MSVC20"
-OPTIMIZE	= -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE	= -O2 $(RUNTIME) -DNDEBUG
 !  ELSE
-OPTIMIZE	= -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE	= -O2 $(RUNTIME) -DNDEBUG
 !  ENDIF
 LINK_DBG	= -release
 !ENDIF
diff --git a/win32/makefile.mk b/win32/makefile.mk
index f74c1be..b557cdf 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -226,9 +226,9 @@ OPTIMIZE	= -Od $(RUNTIME)d -Zi -D_DEBUG -DDEBUGGING
 LINK_DBG	= -debug -pdb:none
 .ELSE
 .IF "$(CCTYPE)" == "MSVC20"
-OPTIMIZE	= -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE	= -O2 $(RUNTIME) -DNDEBUG
 .ELSE
-OPTIMIZE	= -Od $(RUNTIME) -DNDEBUG
+OPTIMIZE	= -O2 $(RUNTIME) -DNDEBUG
 .ENDIF
 LINK_DBG	= -release
 .ENDIF
@@ -300,9 +300,11 @@ EXTUTILSDIR	= $(LIBDIR)\extutils
 .IF "$(OBJECT)" == "-DPERL_OBJECT"
 PERLIMPLIB	= ..\perlcore.lib
 PERLDLL		= ..\perlcore.dll
+CAPILIB		= $(COREDIR)\PerlCAPI.lib
 .ELSE
 PERLIMPLIB	= ..\perl.lib
 PERLDLL		= ..\perl.dll
+CAPILIB		=
 .ENDIF
 
 MINIPERL	= ..\miniperl.exe
@@ -553,7 +555,7 @@ CFG_VARS	=					\
 # Top targets
 #
 
-all : $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) $(X2P) \
+all : $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) $(CAPILIB) $(X2P) \
 	$(EXTENSION_DLL)
 
 $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c
@@ -753,6 +755,18 @@ $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM)
 	cd $(EXTDIR)\$(*B) && $(XSUBPP) dl_win32.xs > $(*B).c
 	$(XCOPY) $(EXTDIR)\$(*B)\dlutils.c .
 
+!IF "$(OBJECT)" == "-DPERL_OBJECT"
+PerlCAPI.cpp : $(MINIPERL)
+	$(MINIPERL) GenCAPI.pl $(COREDIR)
+
+PerlCAPI$(o) : PerlCAPI.cpp
+	$(CC) $(CFLAGS_O) -MT -UPERLDLL -DWIN95FIX -c \
+	    $(OBJOUT_FLAG)PerlCAPI$(o) PerlCAPI.cpp
+
+$(CAPILIB) : PerlCAPI.cpp PerlCAPI$(o)
+	lib /OUT:$(CAPILIB) PerlCAPI$(o)
+!ENDIF
+
 $(EXTDIR)\DynaLoader\dl_win32.xs: dl_win32.xs
 	copy dl_win32.xs $(EXTDIR)\DynaLoader\dl_win32.xs
 
diff --git a/win32/win32.c b/win32/win32.c
index d4be76a..56a462a 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -978,18 +978,34 @@ win32_getenv(const char *name)
     DWORD needlen;
     if (!curitem)
 	New(1305,curitem,curlen,char);
-    if (!(needlen = GetEnvironmentVariable(name,curitem,curlen)))
-	return Nullch;
-    while (needlen > curlen) {
-	Renew(curitem,needlen,char);
-	curlen = needlen;
-	needlen = GetEnvironmentVariable(name,curitem,curlen);
+
+    needlen = GetEnvironmentVariable(name,curitem,curlen);
+    if (needlen != 0) {
+	while (needlen > curlen) {
+	    Renew(curitem,needlen,char);
+	    curlen = needlen;
+	    needlen = GetEnvironmentVariable(name,curitem,curlen);
+	}
     }
-    if (curitem == NULL)
+    else
     {
-	if (strcmp("PERL5DB", name) == 0)
+	/* allow any environment variables that begin with 'PERL5'
+	   to be stored in the registry
+	*/
+	if(curitem != NULL)
+	    *curitem = '\0';
+
+	if (strncmp(name, "PERL5", 5) == 0) {
+	    if (curitem != NULL) {
+		Safefree(curitem);
+		curitem = NULL;
+	    }
 	    curitem = GetRegStr(name, &curitem, &curlen);
+	}
     }
+    if(curitem != NULL && *curitem == '\0')
+	return Nullch;
+
     return curitem;
 }
 
@@ -1186,6 +1202,10 @@ win32_crypt(const char *txt, const char *salt)
 }
 #endif
 
+#ifdef _M_IX86
+#define USE_FIXED_OSFHANDLE
+#endif
+
 #ifdef USE_FIXED_OSFHANDLE
 
 EXTERN_C int __cdecl _alloc_osfhnd(void);
diff --git a/win32/win32sck.c b/win32/win32sck.c
index bcf180a..74af5d7 100644
--- a/win32/win32sck.c
+++ b/win32/win32sck.c
@@ -28,6 +28,7 @@ extern CPerlObj* pPerl;
 #include "XSUB.h"
 #endif
 
+#include "Win32iop.h"
 #include <sys/socket.h>
 #include <fcntl.h>
 #include <sys/stat.h>
@@ -36,7 +37,7 @@ extern CPerlObj* pPerl;
 
 /* thanks to Beverly Brown	(beverly@datacube.com) */
 #ifdef USE_SOCKETS_AS_HANDLES
-#	define OPEN_SOCKET(x)	_open_osfhandle(x,O_RDWR|O_BINARY)
+#	define OPEN_SOCKET(x)	win32_open_osfhandle(x,O_RDWR|O_BINARY)
 #	define TO_SOCKET(x)	_get_osfhandle(x)
 #else
 #	define OPEN_SOCKET(x)	(x)