X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=e595a0a28951f6c81f96daaa22d8c8ad9e07c41d;hb=b212a3c602c7ab2fcce55cf1027f73c6280d3b7b;hp=567ca758e692ec4d520e0d91f59effb1e69f1fde;hpb=e51b748d59d52facf20e9112aeddc1f4fcaca3d1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.c b/perl.c index 567ca75..e595a0a 100644 --- a/perl.c +++ b/perl.c @@ -985,7 +985,6 @@ perl_destruct(pTHXx) /* clear utf8 character classes */ SvREFCNT_dec(PL_utf8_alnum); - SvREFCNT_dec(PL_utf8_alnumc); SvREFCNT_dec(PL_utf8_ascii); SvREFCNT_dec(PL_utf8_alpha); SvREFCNT_dec(PL_utf8_space); @@ -1005,7 +1004,6 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_utf8_idstart); SvREFCNT_dec(PL_utf8_idcont); PL_utf8_alnum = NULL; - PL_utf8_alnumc = NULL; PL_utf8_ascii = NULL; PL_utf8_alpha = NULL; PL_utf8_space = NULL; @@ -1228,14 +1226,18 @@ perl_destruct(pTHXx) Safefree(PL_reg_poscache); free_tied_hv_pool(); Safefree(PL_op_mask); - Safefree(PL_psig_ptr); - PL_psig_ptr = (SV**)NULL; Safefree(PL_psig_name); PL_psig_name = (SV**)NULL; - Safefree(PL_bitcount); - PL_bitcount = NULL; + PL_psig_ptr = (SV**)NULL; Safefree(PL_psig_pend); PL_psig_pend = (int*)NULL; + { + /* We need to NULL PL_psig_pend first, so that + signal handlers know not to use it */ + int *psig_save = PL_psig_pend; + PL_psig_pend = (int*)NULL; + Safefree(psig_save); + } PL_formfeed = NULL; nuke_stacks(); PL_tainting = FALSE; @@ -1766,26 +1768,23 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) # ifdef NO_MATHOMS " NO_MATHOMS" # endif +# ifdef PERL_DISABLE_PMC + " PERL_DISABLE_PMC" +# endif # ifdef PERL_DONT_CREATE_GVSV " PERL_DONT_CREATE_GVSV" # endif +# ifdef PERL_IS_MINIPERL + " PERL_IS_MINIPERL" +# endif # ifdef PERL_MALLOC_WRAP " PERL_MALLOC_WRAP" # endif # ifdef PERL_MEM_LOG " PERL_MEM_LOG" # endif -# ifdef PERL_MEM_LOG_ENV - " PERL_MEM_LOG_ENV" -# endif -# ifdef PERL_MEM_LOG_ENV_FD - " PERL_MEM_LOG_ENV_FD" -# endif -# ifdef PERL_MEM_LOG_STDERR - " PERL_MEM_LOG_STDERR" -# endif -# ifdef PERL_MEM_LOG_TIMESTAMP - " PERL_MEM_LOG_TIMESTAMP" +# ifdef PERL_MEM_LOG_NOIMPL + " PERL_MEM_LOG_NOIMPL" # endif # ifdef PERL_USE_DEVEL " PERL_USE_DEVEL" @@ -1944,10 +1943,15 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) } } -#ifdef USE_SITECUSTOMIZE +#if defined(USE_SITECUSTOMIZE) && !defined(PERL_IS_MINIPERL) if (!minus_f) { + /* SITELIB_EXP is a function call on Win32. + The games with local $! are to avoid setting errno if there is no + sitecustomize script. */ + const char *const sitelib = SITELIB_EXP; (void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav, - Perl_newSVpvf(aTHX_ "BEGIN { do '%s/sitecustomize.pl' }", SITELIB_EXP)); + Perl_newSVpvf(aTHX_ + "BEGIN { do {local $!; -f '%s/sitecustomize.pl'} && do '%s/sitecustomize.pl' }", sitelib, sitelib)); } #endif @@ -2051,6 +2055,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) #if defined(__SYMBIAN32__) PL_unicode = PERL_UNICODE_STD_FLAG; /* See PERL_SYMBIAN_CONSOLE_UTF8. */ #endif +# ifndef PERL_IS_MINIPERL if (PL_unicode) { /* Requires init_predump_symbols(). */ if (!(PL_unicode & PERL_UNICODE_LOCALE_FLAG) || PL_utf8locale) { @@ -2089,6 +2094,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) } } } +#endif { const char *s; @@ -2255,8 +2261,9 @@ S_run_body(pTHX_ I32 oldscope) exit(0); /* less likely to core dump than my_exit(0) */ } #endif - DEBUG_x(dump_all()); #ifdef DEBUGGING + if (DEBUG_x_TEST || DEBUG_B_TEST) + dump_all_perl(!DEBUG_B_TEST); if (!DEBUG_q_TEST) PERL_DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n")); #endif @@ -2486,9 +2493,13 @@ Perl_call_method(pTHX_ const char *methname, I32 flags) /* name of the subroutine */ /* See G_* flags in cop.h */ { + STRLEN len; PERL_ARGS_ASSERT_CALL_METHOD; - return call_sv(sv_2mortal(newSVpv(methname,0)), flags | G_METHOD); + len = strlen(methname); + + /* XXX: sv_2mortal(newSVpvn_share(methname, len)) can be faster */ + return call_sv(newSVpvn_flags(methname, len, SVs_TEMP), flags | G_METHOD); } /* May be called with any of a CV, a GV, or an SV containing the name. */ @@ -2865,6 +2876,8 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp) " C Copy On Write", " A Consistency checks on internal structures", " q quiet - currently only suppresses the 'EXECUTING' message", + " M trace smart match resolution", + " B dump suBroutine definitions, including special Blocks like BEGIN", NULL }; int i = 0; @@ -2873,7 +2886,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp) if (isALPHA(**s)) { /* if adding extra options, remember to update DEBUG_MASK */ - static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAq"; + static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMB"; for (; isALNUM(**s); (*s)++) { const char * const d = strchr(debopts,**s); @@ -3276,10 +3289,6 @@ Perl_moreswitches(pTHX_ const char *s) PerlIO_printf(PerlIO_stdout(), "BS2000 (POSIX) port by Start Amadeus GmbH, 1998-1999\n"); #endif -#ifdef __MINT__ - PerlIO_printf(PerlIO_stdout(), - "MiNT port by Guido Flohr, 1997-1999\n"); -#endif #ifdef EPOC PerlIO_printf(PerlIO_stdout(), "EPOC port by Olaf Flebbe, 1999-2002\n"); @@ -3938,11 +3947,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register if ((tmpgv = gv_fetchpvs("0", GV_ADD|GV_NOTQUAL, SVt_PV))) { sv_setpv(GvSV(tmpgv),PL_origfilename); - { - GV * const gv = gv_fetchpv("0", GV_ADD, SVt_PV); - if (gv) - sv_magic(GvSV(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, "0", 1); - } } if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) { HV *hv; @@ -4056,6 +4060,10 @@ S_init_perllib(pTHX) #endif /* VMS */ } +#ifndef PERL_IS_MINIPERL + /* miniperl gets just -I..., the split of $ENV{PERL5LIB}, and "." in @INC + (and not the architecture specific directories from $ENV{PERL5LIB}) */ + /* Use the ~-expanded versions of APPLLIB (undocumented), ARCHLIB PRIVLIB SITEARCH SITELIB VENDORARCH and VENDORLIB */ @@ -4186,6 +4194,7 @@ S_init_perllib(pTHX) INCPUSH_ADD_OLD_VERS|INCPUSH_ADD_ARCHONLY_SUB_DIRS |INCPUSH_CAN_RELOCATE); #endif +#endif /* !PERL_IS_MINIPERL */ if (!PL_tainting) S_incpush(aTHX_ STR_WITH_LEN("."), 0);