various fixups for windows

p4raw-id: //depot/perl@4101

diff --git a/embed.h b/embed.h
index 266a691..ab68e0e 100644 (file)
--- 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 (executable)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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);
 }