From: Gurusamy Sarathy <gsar@cpan.org>
Date: Tue, 7 Sep 1999 17:25:07 +0000 (+0000)
Subject: various fixups for windows
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=349fd7b7286e5fa0d4cd22565b1943fa16790eac;p=p5sagit%2Fp5-mst-13.2.git

various fixups for windows

p4raw-id: //depot/perl@4101
---

diff --git a/embed.h b/embed.h
index 266a691..ab68e0e 100644
--- a/embed.h
+++ b/embed.h
@@ -1005,9 +1005,6 @@
 #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
 #define isa_lookup		S_isa_lookup
 #endif
-#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT)
-#define modify_SV_attributes	S_modify_SV_attributes
-#endif
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 #define mess_alloc		S_mess_alloc
 #  if defined(LEAKTEST)
@@ -2333,9 +2330,6 @@
 #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
 #define isa_lookup(a,b,c,d)	S_isa_lookup(aTHX_ a,b,c,d)
 #endif
-#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT)
-#define modify_SV_attributes(a,b,c,d)	S_modify_SV_attributes(aTHX_ a,b,c,d)
-#endif
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 #define mess_alloc()		S_mess_alloc(aTHX)
 #  if defined(LEAKTEST)
@@ -4549,10 +4543,6 @@
 #define S_isa_lookup		CPerlObj::S_isa_lookup
 #define isa_lookup		S_isa_lookup
 #endif
-#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT)
-#define S_modify_SV_attributes	CPerlObj::S_modify_SV_attributes
-#define modify_SV_attributes	S_modify_SV_attributes
-#endif
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 #define S_mess_alloc		CPerlObj::S_mess_alloc
 #define mess_alloc		S_mess_alloc
diff --git a/embed.pl b/embed.pl
index 63d5fdd..5f0711f 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2038,10 +2038,6 @@ s	|I32	|win32_textfilter	|int idx|SV *sv|int maxlen
 s	|SV*|isa_lookup	|HV *stash|const char *name|int len|int level
 #endif
 
-#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT)
-s	|int|modify_SV_attributes|SV *sv|SV **retlist|SV **attrlist|int numattrs
-#endif
-
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 s	|SV*	|mess_alloc
 #  if defined(LEAKTEST)
diff --git a/objXSUB.h b/objXSUB.h
index 02ad66e..437a219 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -3584,8 +3584,6 @@
 #endif
 #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
 #endif
-#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT)
-#endif
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 #  if defined(LEAKTEST)
 #  endif
diff --git a/op.c b/op.c
index babe0d7..0053bdd 100644
--- a/op.c
+++ b/op.c
@@ -1267,19 +1267,19 @@ Perl_mod(pTHX_ OP *o, I32 type)
 		    if (kid->op_type == OP_METHOD_NAMED
 			|| kid->op_type == OP_METHOD)
 		    {
-			OP *new;
+			OP *newop;
 
 			if (kid->op_sibling || kid->op_next != kid) {
 			    yyerror("panic: unexpected optree near method call");
 			    break;
 			}
 			
-			NewOp(1101, new, 1, OP);
-			new->op_type = OP_RV2CV;
-			new->op_ppaddr = PL_ppaddr[OP_RV2CV];
-			new->op_next = new;
-			kid->op_sibling = new;
-			new->op_private |= OPpLVAL_INTRO;
+			NewOp(1101, newop, 1, OP);
+			newop->op_type = OP_RV2CV;
+			newop->op_ppaddr = PL_ppaddr[OP_RV2CV];
+			newop->op_next = newop;
+			kid->op_sibling = newop;
+			newop->op_private |= OPpLVAL_INTRO;
 			break;
 		    }
 		    
diff --git a/perlapi.c b/perlapi.c
index 0e54575..f04706c 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -4869,8 +4869,6 @@ Perl_boot_core_xsutils(pTHXo)
 #endif
 #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
 #endif
-#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT)
-#endif
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 #  if defined(LEAKTEST)
 #  endif
diff --git a/proto.h b/proto.h
index 5ae0636..ddb3142 100644
--- a/proto.h
+++ b/proto.h
@@ -980,9 +980,6 @@ STATIC I32	S_win32_textfilter(pTHX_ int idx, SV *sv, int maxlen);
 #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT)
 STATIC SV*	S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level);
 #endif
-#if defined(PERL_IN_XSUTILS_C) || defined(PERL_DECL_PROT)
-STATIC int	S_modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs);
-#endif
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 STATIC SV*	S_mess_alloc(pTHX);
 #  if defined(LEAKTEST)
diff --git a/win32/Makefile b/win32/Makefile
index 01159c7..f700ada 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -432,7 +432,8 @@ MICROCORE_SRC	=		\
 		..\toke.c	\
 		..\universal.c	\
 		..\utf8.c	\
-		..\util.c
+		..\util.c	\
+		..\xsutils.c
 
 EXTRACORE_SRC	= $(EXTRACORE_SRC) perllib.c
 
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 01f0d7d..23dde72 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -546,7 +546,8 @@ MICROCORE_SRC	=		\
 		..\toke.c	\
 		..\universal.c	\
 		..\utf8.c	\
-		..\util.c
+		..\util.c	\
+		..\xsutils.c
 
 EXTRACORE_SRC	+= perllib.c
 
diff --git a/xsutils.c b/xsutils.c
index 14f9d0f..ea717d9 100644
--- a/xsutils.c
+++ b/xsutils.c
@@ -6,8 +6,43 @@
  * Contributed by Spider Boardman (spider.boardman@orb.nashua.nh.us).
  */
 
-STATIC int
-S_modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs)
+/* package attributes; */
+void XS_attributes__warn_reserved(pTHXo_ CV *cv);
+void XS_attributes_reftype(pTHXo_ CV *cv);
+void XS_attributes__modify_attrs(pTHXo_ CV *cv);
+void XS_attributes__guess_stash(pTHXo_ CV *cv);
+void XS_attributes__fetch_attrs(pTHXo_ CV *cv);
+void XS_attributes_bootstrap(pTHXo_ CV *cv);
+
+
+/*
+ * Note that only ${pkg}::bootstrap definitions should go here.
+ * This helps keep down the start-up time, which is especially
+ * relevant for users who don't invoke any features which are
+ * (partially) implemented here.
+ *
+ * The various bootstrap definitions can take care of doing
+ * package-specific newXS() calls.  Since the layout of the
+ * bundled lib/*.pm files is in a version-specific directory,
+ * version checks in these bootstrap calls are optional.
+ */
+
+void
+Perl_boot_core_xsutils(pTHX)
+{
+    char *file = __FILE__;
+
+    newXS("attributes::bootstrap",	XS_attributes_bootstrap,	file);
+}
+
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#endif  /* PERL_OBJECT */
+
+#include "XSUB.h"
+
+static int
+modify_SV_attributes(pTHXo_ SV *sv, SV **retlist, SV **attrlist, int numattrs)
 {
     SV *attr;
     char *name;
@@ -70,40 +105,6 @@ S_modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs)
 }
 
 
-/* package attributes; */
-void XS_attributes__warn_reserved(pTHXo_ CV *cv);
-void XS_attributes_reftype(pTHXo_ CV *cv);
-void XS_attributes__modify_attrs(pTHXo_ CV *cv);
-void XS_attributes__guess_stash(pTHXo_ CV *cv);
-void XS_attributes__fetch_attrs(pTHXo_ CV *cv);
-void XS_attributes_bootstrap(pTHXo_ CV *cv);
-
-
-/*
- * Note that only ${pkg}::bootstrap definitions should go here.
- * This helps keep down the start-up time, which is especially
- * relevant for users who don't invoke any features which are
- * (partially) implemented here.
- *
- * The various bootstrap definitions can take care of doing
- * package-specific newXS() calls.  Since the layout of the
- * bundled lib/*.pm files is in a version-specific directory,
- * version checks in these bootstrap calls are optional.
- */
-
-void
-Perl_boot_core_xsutils(pTHX)
-{
-    char *file = __FILE__;
-
-    newXS("attributes::bootstrap",	XS_attributes_bootstrap,	file);
-}
-
-#ifdef PERL_OBJECT
-#define NO_XSLOCKS
-#endif  /* PERL_OBJECT */
-
-#include "XSUB.h"
 
 /* package attributes; */
 
@@ -137,7 +138,7 @@ usage:
 	goto usage;
     sv = SvRV(rv);
     if (items > 1)
-	XSRETURN(modify_SV_attributes(sv, &ST(0), &ST(1), items-1));
+	XSRETURN(modify_SV_attributes(aTHXo_ sv, &ST(0), &ST(1), items-1));
 
     XSRETURN(0);
 }