#endif
PL_curcop = &PL_compiling; /* needed by ckWARN, right away */
- /* set read-only and try to insure than we wont see REFCNT==0
- very often */
-
- SvREADONLY_on(&PL_sv_undef);
- SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
-
- sv_setpv(&PL_sv_no,PL_No);
- /* value lookup in void context - happens to have the side effect
- of caching the numeric forms. However, as &PL_sv_no doesn't contain
- a string that is a valid numer, we have to turn the public flags by
- hand: */
- SvNV(&PL_sv_no);
- SvIV(&PL_sv_no);
- SvIOK_on(&PL_sv_no);
- SvNOK_on(&PL_sv_no);
- SvREADONLY_on(&PL_sv_no);
- SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
-
- sv_setpv(&PL_sv_yes,PL_Yes);
- SvNV(&PL_sv_yes);
- SvIV(&PL_sv_yes);
- SvREADONLY_on(&PL_sv_yes);
- SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
+ init_constants();
SvREADONLY_on(&PL_sv_placeholder);
SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
else all hell breaks loose in S_find_uninit_var(). */
Perl_av_create_and_push(aTHX_ &PL_regex_padav, newSVpvs(""));
PL_regex_pad = AvARRAY(PL_regex_padav);
+ Newxz(PL_stashpad, PL_stashpadmax, HV *);
#endif
#ifdef USE_REENTRANT_API
Perl_reentrant_init(aTHX);
/* We must account for everything. */
/* Destroy the main CV and syntax tree */
- /* Do this now, because destroying ops can cause new SVs to be generated
- in Perl_pad_swipe, and when running with -DDEBUG_LEAKING_SCALARS they
- PL_curcop to point to a valid op from which the filename structure
- member is copied. */
+ /* Set PL_curcop now, because destroying ops can cause new SVs
+ to be generated in Perl_pad_swipe, and when running with
+ -DDEBUG_LEAKING_SCALARS they expect PL_curcop to point to a valid
+ op from which the filename structure member is copied. */
PL_curcop = &PL_compiling;
if (PL_main_root) {
/* ensure comppad/curpad to refer to main's pad */
#endif
CopFILE_free(&PL_compiling);
- CopSTASH_free(&PL_compiling);
/* The exit() function will do everything that needs doing. */
return STATUS_EXIT;
* REGEXPs in the parent interpreter
* we need to manually ReREFCNT_dec for the clones
*/
- SvREFCNT_dec(PL_regex_padav);
- PL_regex_padav = NULL;
- PL_regex_pad = NULL;
+ {
+ I32 i = AvFILLp(PL_regex_padav);
+ SV **ary = AvARRAY(PL_regex_padav);
+
+ for (; i; i--) {
+ SvREFCNT_dec(ary[i]);
+ ary[i] = &PL_sv_undef;
+ }
+ }
+ Safefree(PL_stashpad);
#endif
+
SvREFCNT_dec(MUTABLE_SV(PL_stashcache));
PL_stashcache = NULL;
/* clear utf8 character classes */
SvREFCNT_dec(PL_utf8_alnum);
SvREFCNT_dec(PL_utf8_alpha);
+ SvREFCNT_dec(PL_utf8_blank);
SvREFCNT_dec(PL_utf8_space);
SvREFCNT_dec(PL_utf8_graph);
SvREFCNT_dec(PL_utf8_digit);
SvREFCNT_dec(PL_utf8_foldclosures);
PL_utf8_alnum = NULL;
PL_utf8_alpha = NULL;
+ PL_utf8_blank = NULL;
PL_utf8_space = NULL;
PL_utf8_graph = NULL;
PL_utf8_digit = NULL;
cophh_free(CopHINTHASH_get(&PL_compiling));
CopHINTHASH_set(&PL_compiling, cophh_new_empty());
CopFILE_free(&PL_compiling);
- CopSTASH_free(&PL_compiling);
/* Prepare to destruct main symbol table. */
(long)cxstack_ix + 1);
}
+#ifdef USE_ITHREADS
+ SvREFCNT_dec(PL_regex_padav);
+ PL_regex_padav = NULL;
+ PL_regex_pad = NULL;
+#endif
+
#ifdef PERL_IMPLICIT_CONTEXT
/* the entries in this list are allocated via SV PVX's, so get freed
* in sv_clean_all */
#endif
PL_sv_count = 0;
-#ifdef PERL_DEBUG_READONLY_OPS
- free(PL_slabs);
- PL_slabs = NULL;
- PL_slab_count = 0;
-#endif
-
#if defined(PERLIO_LAYERS)
/* No more IO - including error messages ! */
PerlIO_cleanup(aTHX);
Safefree(PL_origfilename);
PL_origfilename = NULL;
- Safefree(PL_reg_start_tmp);
- PL_reg_start_tmp = (char**)NULL;
- PL_reg_start_tmpl = 0;
Safefree(PL_reg_curpm);
Safefree(PL_reg_poscache);
free_tied_hv_pool();
#ifdef PERL_MAD
{
const char *s;
- if ((s = PerlEnv_getenv("PERL_XMLDUMP"))) {
+ if (!PL_tainting &&
+ (s = PerlEnv_getenv("PERL_XMLDUMP"))) {
PL_madskills = 1;
PL_minus_c = 1;
if (!s || !s[0])
call_list(oldscope, PL_initav);
}
#ifdef PERL_DEBUG_READONLY_OPS
- Perl_pending_Slabs_to_ro(aTHX);
+ if (PL_main_root && PL_main_root->op_slabbed)
+ Slab_to_ro(OpSLAB(PL_main_root));
#endif
}
CALLRUNOPS(aTHX);
}
my_exit(0);
- /* NOTREACHED */
+ assert(0); /* NOTREACHED */
}
/*
Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
{
GV* const gv = gv_fetchpvn_flags(name, len, flags, SVt_PVCV);
- /* XXX this is probably not what they think they're getting.
- * It has the same effect as "sub name;", i.e. just a forward
- * declaration! */
PERL_ARGS_ASSERT_GET_CVN_FLAGS;
+ /* XXX this is probably not what they think they're getting.
+ * It has the same effect as "sub name;", i.e. just a forward
+ * declaration! */
if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) {
- SV *const sv = newSVpvn_flags(name, len, flags & SVf_UTF8);
- return newSUB(start_subparse(FALSE, 0),
- newSVOP(OP_CONST, 0, sv),
- NULL, NULL);
+ return newSTUB(gv,0);
}
if (gv)
return GvCVu(gv);
FREETMPS;
JMPENV_POP;
my_exit_jump();
- /* NOTREACHED */
+ assert(0); /* NOTREACHED */
case 3:
if (PL_restartop) {
PL_restartjmpenv = NULL;
myop.op_flags |= OP_GIMME_REVERSE(flags);
if (flags & G_KEEPERR)
myop.op_flags |= OPf_SPECIAL;
+ if (PL_reg_state.re_reparsing)
+ myop.op_private = OPpEVAL_COPHH;
/* fail now; otherwise we could fail after the JMPENV_PUSH but
* before a PUSHEVAL, which corrupts the stack after a croak */
FREETMPS;
JMPENV_POP;
my_exit_jump();
- /* NOTREACHED */
+ assert(0); /* NOTREACHED */
case 3:
if (PL_restartop) {
PL_restartjmpenv = NULL;
" H Hash dump -- usurps values()\n"
" X Scratchpad allocation\n"
" D Cleaning up\n"
+ " S Op slab allocation\n"
" T Tokenising\n"
" R Include reference counts of dumped variables (eg when using -Ds)\n",
" J Do not s,t,P-debug (Jump over) opcodes within package DB\n"
"\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
"Version 5 port Copyright (c) 1994-2002, Andreas Kaiser, Ilya Zakharevich\n");
#endif
-#ifdef atarist
- PerlIO_printf(PerlIO_stdout(),
- "atariST series port, ++jrb bammi@cadence.com\n");
-#endif
#ifdef __BEOS__
PerlIO_printf(PerlIO_stdout(),
"BeOS port Copyright Tom Spindler, 1997-1999\n");
(void)sv_utf8_decode(sv);
}
}
+
+ if (PL_inplace && (!PL_argvgv || AvFILL(GvAV(PL_argvgv)) == -1))
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
+ "-i used with no filenames on the command line, "
+ "reading from STDIN");
}
STATIC void
PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS;
- PL_toptarget = newSV_type(SVt_PVFM);
+ PL_toptarget = newSV_type(SVt_PVIV);
sv_setpvs(PL_toptarget, "");
- PL_bodytarget = newSV_type(SVt_PVFM);
+ PL_bodytarget = newSV_type(SVt_PVIV);
sv_setpvs(PL_bodytarget, "");
PL_formtarget = PL_bodytarget;
CopLINE_set(PL_curcop, oldline);
JMPENV_POP;
my_exit_jump();
- /* NOTREACHED */
+ assert(0); /* NOTREACHED */
case 3:
if (PL_restartop) {
PL_curcop = &PL_compiling;
https://perl5.git.perl.org / perl5.git / blobdiff