X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/8c90d3a9c79a9471ef12dde584263fc38571cf46..db9e73fd89ca2f9aade540ea03261f21bf885a8c:/perl.c diff --git a/perl.c b/perl.c index d14da14..422a548 100644 --- a/perl.c +++ b/perl.c @@ -3,7 +3,7 @@ * * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 - * 2013, 2014, 2015, 2016, 2017, 2018, 2019 by Larry Wall and others + * 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -96,6 +96,7 @@ S_init_tls_and_interp(PerlInterpreter *my_perl) HINTS_REFCNT_INIT; LOCALE_INIT; USER_PROP_MUTEX_INIT; + ENV_INIT; MUTEX_INIT(&PL_dollarzero_mutex); MUTEX_INIT(&PL_my_ctx_mutex); # endif @@ -216,26 +217,6 @@ Initializes a new Perl interpreter. See L. =cut */ -static void -S_fixup_platform_bugs(void) -{ -#if defined(__GLIBC__) && IVSIZE == 8 \ - && ( __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 8)) - { - IV l = 3; - IV r = -10; - /* Cannot do this check with inlined IV constants since - * that seems to work correctly even with the buggy glibc. */ - if (l % r == -3) { - dTHX; - /* Yikes, we have the bug. - * Patch in the workaround version. */ - PL_ppaddr[OP_I_MODULO] = &Perl_pp_i_modulo_glibc_bugfix; - } - } -#endif -} - void perl_construct(pTHXx) { @@ -262,7 +243,10 @@ perl_construct(pTHXx) SvREADONLY_on(&PL_sv_placeholder); SvREFCNT(&PL_sv_placeholder) = SvREFCNT_IMMORTAL; - PL_sighandlerp = (Sighandler_t) Perl_sighandler; + PL_sighandlerp = Perl_sighandler; + PL_sighandler1p = Perl_sighandler1; + PL_sighandler3p = Perl_sighandler3; + #ifdef PERL_USES_PL_PIDSTATUS PL_pidstatus = newHV(); #endif @@ -293,8 +277,6 @@ perl_construct(pTHXx) init_ids(); - S_fixup_platform_bugs(); - JMPENV_BOOTSTRAP; STATUS_ALL_SUCCESS; @@ -1194,9 +1176,76 @@ perl_destruct(pTHXx) PL_warn_locale = NULL; #endif - if (!specialWARN(PL_compiling.cop_warnings)) - PerlMemShared_free(PL_compiling.cop_warnings); - PL_compiling.cop_warnings = NULL; + SvREFCNT_dec(PL_AboveLatin1); + PL_AboveLatin1 = NULL; + SvREFCNT_dec(PL_Assigned_invlist); + PL_Assigned_invlist = NULL; + SvREFCNT_dec(PL_GCB_invlist); + PL_GCB_invlist = NULL; + SvREFCNT_dec(PL_HasMultiCharFold); + PL_HasMultiCharFold = NULL; + SvREFCNT_dec(PL_InMultiCharFold); + PL_InMultiCharFold = NULL; + SvREFCNT_dec(PL_Latin1); + PL_Latin1 = NULL; + SvREFCNT_dec(PL_LB_invlist); + PL_LB_invlist = NULL; + SvREFCNT_dec(PL_SB_invlist); + PL_SB_invlist = NULL; + SvREFCNT_dec(PL_SCX_invlist); + PL_SCX_invlist = NULL; + SvREFCNT_dec(PL_UpperLatin1); + PL_UpperLatin1 = NULL; + SvREFCNT_dec(PL_in_some_fold); + PL_in_some_fold = NULL; + SvREFCNT_dec(PL_utf8_idcont); + PL_utf8_idcont = NULL; + SvREFCNT_dec(PL_utf8_idstart); + PL_utf8_idstart = NULL; + SvREFCNT_dec(PL_utf8_perl_idcont); + PL_utf8_perl_idcont = NULL; + SvREFCNT_dec(PL_utf8_perl_idstart); + PL_utf8_perl_idstart = NULL; + SvREFCNT_dec(PL_utf8_xidcont); + PL_utf8_xidcont = NULL; + SvREFCNT_dec(PL_utf8_xidstart); + PL_utf8_xidstart = NULL; + SvREFCNT_dec(PL_WB_invlist); + PL_WB_invlist = NULL; + SvREFCNT_dec(PL_utf8_toupper); + PL_utf8_toupper = NULL; + SvREFCNT_dec(PL_utf8_totitle); + PL_utf8_totitle = NULL; + SvREFCNT_dec(PL_utf8_tolower); + PL_utf8_tolower = NULL; + SvREFCNT_dec(PL_utf8_tofold); + PL_utf8_tofold = NULL; + SvREFCNT_dec(PL_utf8_tosimplefold); + PL_utf8_tosimplefold = NULL; + SvREFCNT_dec(PL_utf8_charname_begin); + PL_utf8_charname_begin = NULL; + SvREFCNT_dec(PL_utf8_charname_continue); + PL_utf8_charname_continue = NULL; + SvREFCNT_dec(PL_utf8_mark); + PL_utf8_mark = NULL; + SvREFCNT_dec(PL_InBitmap); + PL_InBitmap = NULL; + SvREFCNT_dec(PL_CCC_non0_non230); + PL_CCC_non0_non230 = NULL; + SvREFCNT_dec(PL_Private_Use); + PL_Private_Use = NULL; + + for (i = 0; i < POSIX_CC_COUNT; i++) { + SvREFCNT_dec(PL_XPosix_ptrs[i]); + PL_XPosix_ptrs[i] = NULL; + + if (i != _CC_CASED) { /* A copy of Alpha */ + SvREFCNT_dec(PL_Posix_ptrs[i]); + PL_Posix_ptrs[i] = NULL; + } + } + + free_and_set_cop_warnings(&PL_compiling, NULL); cophh_free(CopHINTHASH_get(&PL_compiling)); CopHINTHASH_set(&PL_compiling, cophh_new_empty()); CopFILE_free(&PL_compiling); @@ -2232,10 +2281,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) #endif (s = PerlEnv_getenv("PERL5OPT"))) { - /* s points to static memory in getenv(), which may be overwritten at - * any time; use a mortal copy instead */ - s = SvPVX(sv_2mortal(newSVpv(s, 0))); - while (isSPACE(*s)) s++; if (*s == '-' && *(s+1) == 'T') { @@ -2264,7 +2309,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit) d = s; if (!*s) break; - if (!strchr("CDIMUdmtwW", *s)) + if (!memCHRs("CDIMUdmtwW", *s)) Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s); while (++s && *s) { if (isSPACE(*s)) { @@ -3105,6 +3150,7 @@ as C, with the obvious exception of C. See L. The C flag can be used if you only need eval_sv() to execute code specified by a string, but not catch any errors. +=for apidoc Amnh||G_RETHROW =cut */ @@ -3360,6 +3406,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp) " B dump suBroutine definitions, including special Blocks like BEGIN\n", " L trace some locale setting information--for Perl core development\n", " i trace PerlIO layer processing\n", + " y trace y///, tr/// compilation and execution\n", NULL }; UV uv = 0; @@ -3368,7 +3415,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[] = "psltocPmfrxuUHXDSTRJvCAqMBLi"; + static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMBLiy"; for (; isWORDCHAR(**s); (*s)++) { const char * const d = strchr(debopts,**s); @@ -3691,16 +3738,12 @@ Perl_moreswitches(pTHX_ const char *s) return s; case 'W': PL_dowarn = G_WARN_ALL_ON|G_WARN_ON; - if (!specialWARN(PL_compiling.cop_warnings)) - PerlMemShared_free(PL_compiling.cop_warnings); - PL_compiling.cop_warnings = pWARN_ALL ; + free_and_set_cop_warnings(&PL_compiling, pWARN_ALL); s++; return s; case 'X': PL_dowarn = G_WARN_ALL_OFF; - if (!specialWARN(PL_compiling.cop_warnings)) - PerlMemShared_free(PL_compiling.cop_warnings); - PL_compiling.cop_warnings = pWARN_NONE ; + free_and_set_cop_warnings(&PL_compiling, pWARN_NONE); s++; return s; case '*': @@ -3789,7 +3832,7 @@ S_minus_v(pTHX) #endif PerlIO_printf(PIO_stdout, - "\n\nCopyright 1987-2019, Larry Wall\n"); + "\n\nCopyright 1987-2020, Larry Wall\n"); #ifdef MSDOS PerlIO_printf(PIO_stdout, "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n"); @@ -5200,7 +5243,7 @@ Perl_my_failure_exit(pTHX) * success/warning codes to fatal with out changing * the POSIX status code. The severity makes VMS native * status handling work, while UNIX mode programs use the - * the POSIX exit codes. + * POSIX exit codes. */ if ((STATUS_NATIVE & (STS$K_SEVERE|STS$K_ERROR)) == 0) { STATUS_NATIVE &= STS$M_COND_ID;