diff options
| -rw-r--r-- | embed.h | 10 | ||||
| -rwxr-xr-x | embed.pl | 4 | ||||
| -rw-r--r-- | objXSUB.h | 2 | ||||
| -rw-r--r-- | op.c | 14 | ||||
| -rw-r--r-- | perlapi.c | 2 | ||||
| -rw-r--r-- | proto.h | 3 | ||||
| -rw-r--r-- | win32/Makefile | 3 | ||||
| -rw-r--r-- | win32/makefile.mk | 3 | ||||
| -rw-r--r-- | xsutils.c | 75 |
9 files changed, 49 insertions, 67 deletions
@@ -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 @@ -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) @@ -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 @@ -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; } @@ -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 @@ -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 01159c7620..f700ada1b9 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 01f0d7d615..23dde72392 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 @@ -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); } |