PL_stashcache = newHV();
PL_patchlevel = newSVpvs("v" PERL_VERSION_STRING);
+ PL_apiversion = newSVpvs("v" PERL_API_VERSION_STRING);
#ifdef HAS_MMAP
if (!PL_mmap_page_size) {
/* Need to flush since END blocks can produce output */
my_fflush_all();
- if (CALL_FPTR(PL_threadhook)(aTHX)) {
+ if (PL_threadhook(aTHX)) {
/* Threads hook has vetoed further cleanup */
PL_veto_cleanup = TRUE;
return STATUS_EXIT;
PL_main_root = NULL;
}
PL_main_start = NULL;
+ /* note that PL_main_cv isn't usually actually freed at this point,
+ * due to the CvOUTSIDE refs from subs compiled within it. It will
+ * get freed once all the subs are freed in sv_clean_all(), for
+ * destruct_level > 0 */
SvREFCNT_dec(PL_main_cv);
PL_main_cv = NULL;
PL_dirty = TRUE;
*/
sv_clean_objs();
PL_sv_objcount = 0;
- if (PL_defoutgv && !SvREFCNT(PL_defoutgv))
- PL_defoutgv = NULL; /* may have been freed */
}
/* unhook hooks which will soon be, or use, destroyed data */
return STATUS_EXIT;
}
- /* reset so print() ends up where we expect */
- setdefout(NULL);
-
#ifdef USE_ITHREADS
/* the syntax tree is shared between clones
* so op_free(PL_main_root) only ReREFCNT_dec's
Safefree(PL_inplace);
PL_inplace = NULL;
SvREFCNT_dec(PL_patchlevel);
+ SvREFCNT_dec(PL_apiversion);
if (PL_e_script) {
SvREFCNT_dec(PL_e_script);
/* Prepare to destruct main symbol table. */
hv = PL_defstash;
+ /* break ref loop *:: <=> %:: */
+ (void)hv_delete(hv, "main::", 6, G_DISCARD);
PL_defstash = 0;
SvREFCNT_dec(hv);
SvREFCNT_dec(PL_curstname);
(long)cxstack_ix + 1);
}
+#ifdef PERL_IMPLICIT_CONTEXT
+ /* the entries in this list are allocated via SV PVX's, so get freed
+ * in sv_clean_all */
+ Safefree(PL_my_cxt_list);
+#endif
+
/* Now absolutely destruct everything, somehow or other, loops or no. */
/* the 2 is for PL_fdpid and PL_strtab */
Safefree(array);
HvARRAY(PL_strtab) = 0;
HvTOTALKEYS(PL_strtab) = 0;
- HvFILL(PL_strtab) = 0;
}
SvREFCNT_dec(PL_strtab);
PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
" flags=0x%"UVxf
" refcnt=%"UVuf pTHX__FORMAT "\n"
- "\tallocated at %s:%d %s %s%s; serial %"UVuf"\n",
+ "\tallocated at %s:%d %s %s (parent 0x%"UVxf");"
+ "serial %"UVuf"\n",
(void*)sv, (UV)sv->sv_flags, (UV)sv->sv_refcnt
pTHX__VALUE,
sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
sv->sv_debug_inpad ? "for" : "by",
sv->sv_debug_optype ?
PL_op_name[sv->sv_debug_optype]: "(none)",
- sv->sv_debug_cloned ? " (cloned)" : "",
+ PTR2UV(sv->sv_debug_parent),
sv->sv_debug_serial
);
#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
Safefree(PL_psig_name);
PL_psig_name = (SV**)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 */
# ifdef PERL_DONT_CREATE_GVSV
" PERL_DONT_CREATE_GVSV"
# endif
+# ifdef PERL_EXTERNAL_GLOB
+ " PERL_EXTERNAL_GLOB"
+# endif
# ifdef PERL_IS_MINIPERL
" PERL_IS_MINIPERL"
# endif
/* now parse the script */
SETERRNO(0,SS_NORMAL);
- if (yyparse() || PL_parser->error_count) {
+ if (yyparse(GRAMPROG) || PL_parser->error_count) {
if (PL_minus_c)
Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
else {
#endif
ENTER;
+ PL_restartjmpenv = NULL;
PL_restartop = 0;
return NULL;
}
/* do it */
if (PL_restartop) {
+ PL_restartjmpenv = NULL;
PL_op = PL_restartop;
PL_restartop = 0;
CALLRUNOPS(aTHX);
/* NOTREACHED */
case 3:
if (PL_restartop) {
+ PL_restartjmpenv = NULL;
PL_op = PL_restartop;
PL_restartop = 0;
goto redo_body;
/* NOTREACHED */
case 3:
if (PL_restartop) {
+ PL_restartjmpenv = NULL;
PL_op = PL_restartop;
PL_restartop = 0;
goto redo_body;
/* This message really ought to be max 23 lines.
* Removed -h because the user already knows that option. Others? */
+ /* Grouped as 6 lines per C string literal, to keep under the ANSI C 89
+ minimum of 509 character string literals. */
static const char * const usage_msg[] = {
-"-0[octal] specify record separator (\\0, if no argument)",
-"-a autosplit mode with -n or -p (splits $_ into @F)",
-"-C[number/list] enables the listed Unicode features",
-"-c check syntax only (runs BEGIN and CHECK blocks)",
-"-d[:debugger] run program under debugger",
-"-D[number/list] set debugging flags (argument is a bit mask or alphabets)",
-"-e program one line of program (several -e's allowed, omit programfile)",
-"-E program like -e, but enables all optional features",
-"-f don't do $sitelib/sitecustomize.pl at startup",
-"-F/pattern/ split() pattern for -a switch (//'s are optional)",
-"-i[extension] edit <> files in place (makes backup if extension supplied)",
-"-Idirectory specify @INC/#include directory (several -I's allowed)",
-"-l[octal] enable line ending processing, specifies line terminator",
-"-[mM][-]module execute \"use/no module...\" before executing program",
-"-n assume \"while (<>) { ... }\" loop around program",
-"-p assume loop like -n but print line also, like sed",
-"-s enable rudimentary parsing for switches after programfile",
-"-S look for programfile using PATH environment variable",
-"-t enable tainting warnings",
-"-T enable tainting checks",
-"-u dump core after parsing program",
-"-U allow unsafe operations",
-"-v print version, patchlevel and license",
-"-V[:variable] print configuration summary (or a single Config.pm variable)",
-"-w enable many useful warnings (RECOMMENDED)",
-"-W enable all warnings",
-"-x[directory] ignore text before #!perl line (optionally cd to directory)",
-"-X disable all warnings",
-"\n",
+" -0[octal] specify record separator (\\0, if no argument)\n"
+" -a autosplit mode with -n or -p (splits $_ into @F)\n"
+" -C[number/list] enables the listed Unicode features\n"
+" -c check syntax only (runs BEGIN and CHECK blocks)\n"
+" -d[:debugger] run program under debugger\n"
+" -D[number/list] set debugging flags (argument is a bit mask or alphabets)\n",
+" -e program one line of program (several -e's allowed, omit programfile)\n"
+" -E program like -e, but enables all optional features\n"
+" -f don't do $sitelib/sitecustomize.pl at startup\n"
+" -F/pattern/ split() pattern for -a switch (//'s are optional)\n"
+" -i[extension] edit <> files in place (makes backup if extension supplied)\n"
+" -Idirectory specify @INC/#include directory (several -I's allowed)\n",
+" -l[octal] enable line ending processing, specifies line terminator\n"
+" -[mM][-]module execute \"use/no module...\" before executing program\n"
+" -n assume \"while (<>) { ... }\" loop around program\n"
+" -p assume loop like -n but print line also, like sed\n"
+" -s enable rudimentary parsing for switches after programfile\n"
+" -S look for programfile using PATH environment variable\n",
+" -t enable tainting warnings\n"
+" -T enable tainting checks\n"
+" -u dump core after parsing program\n"
+" -U allow unsafe operations\n"
+" -v print version, patchlevel and license\n"
+" -V[:variable] print configuration summary (or a single Config.pm variable)\n",
+" -w enable many useful warnings\n"
+" -W enable all warnings\n"
+" -x[directory] ignore text before #!perl line (optionally cd to directory)\n"
+" -X disable all warnings\n"
+" \n"
+"Run 'perldoc perl' for more help with Perl.\n\n",
NULL
};
const char * const *p = usage_msg;
+ PerlIO *out = PerlIO_stdout();
PERL_ARGS_ASSERT_USAGE;
- PerlIO_printf(PerlIO_stdout(),
- "\nUsage: %s [switches] [--] [programfile] [arguments]",
+ PerlIO_printf(out,
+ "\nUsage: %s [switches] [--] [programfile] [arguments]\n",
name);
while (*p)
- PerlIO_printf(PerlIO_stdout(), "\n %s", *p++);
-
- PerlIO_printf(PerlIO_stdout(),
- "Run 'perldoc perl' for more help with Perl.\n\n"
- );
+ PerlIO_puts(out, *p++);
}
/* convert a string of -D options (or digits) into an int.
Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
{
static const char * const usage_msgd[] = {
- " Debugging flag values: (see also -d)",
- " p Tokenizing and parsing (with v, displays parse stack)",
- " s Stack snapshots (with v, displays all stacks)",
- " l Context (loop) stack processing",
- " t Trace execution",
- " o Method and overloading resolution",
- " c String/numeric conversions",
- " P Print profiling info, source file input state",
- " m Memory and SV allocation",
- " f Format processing",
- " r Regular expression parsing and execution",
- " x Syntax tree dump",
- " u Tainting checks",
- " H Hash dump -- usurps values()",
- " X Scratchpad allocation",
- " D Cleaning up",
- " T Tokenising",
- " R Include reference counts of dumped variables (eg when using -Ds)",
- " J Do not s,t,P-debug (Jump over) opcodes within package DB",
- " v Verbose: use in conjunction with other flags",
- " 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",
+ " Debugging flag values: (see also -d)\n"
+ " p Tokenizing and parsing (with v, displays parse stack)\n"
+ " s Stack snapshots (with v, displays all stacks)\n"
+ " l Context (loop) stack processing\n"
+ " t Trace execution\n"
+ " o Method and overloading resolution\n",
+ " c String/numeric conversions\n"
+ " P Print profiling info, source file input state\n"
+ " m Memory and SV allocation\n"
+ " f Format processing\n"
+ " r Regular expression parsing and execution\n"
+ " x Syntax tree dump\n",
+ " u Tainting checks\n"
+ " H Hash dump -- usurps values()\n"
+ " X Scratchpad allocation\n"
+ " D Cleaning up\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"
+ " v Verbose: use in conjunction with other flags\n"
+ " C Copy On Write\n"
+ " A Consistency checks on internal structures\n"
+ " q quiet - currently only suppresses the 'EXECUTING' message\n"
+ " M trace smart match resolution\n"
+ " B dump suBroutine definitions, including special Blocks like BEGIN\n",
NULL
};
int i = 0;
}
else if (givehelp) {
const char *const *p = usage_msgd;
- while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
+ while (*p) PerlIO_puts(PerlIO_stdout(), *p++);
}
# ifdef EBCDIC
if ((i & DEBUG_p_FLAG) && ckWARN_d(WARN_DEBUGGING))
}
void
+Perl_init_dbargs(pTHX)
+{
+ AV *const args = PL_dbargs = GvAV(gv_AVadd((gv_fetchpvs("DB::args",
+ GV_ADDMULTI,
+ SVt_PVAV))));
+
+ if (AvREAL(args)) {
+ /* Someone has already created it.
+ It might have entries, and if we just turn off AvREAL(), they will
+ "leak" until global destruction. */
+ av_clear(args);
+ }
+ AvREAL_off(PL_dbargs); /* XXX should be REIFY (see av.h) */
+}
+
+void
Perl_init_debugger(pTHX)
{
dVAR;
HV * const ostash = PL_curstash;
PL_curstash = PL_debstash;
- PL_dbargs = GvAV(gv_AVadd((gv_fetchpvs("DB::args", GV_ADDMULTI,
- SVt_PVAV))));
- AvREAL_off(PL_dbargs);
+
+ Perl_init_dbargs(aTHX);
PL_DBgv = gv_fetchpvs("DB::DB", GV_ADDMULTI, SVt_PVGV);
PL_DBline = gv_fetchpvs("DB::dbline", GV_ADDMULTI, SVt_PVAV);
PL_DBsub = gv_HVadd(gv_fetchpvs("DB::sub", GV_ADDMULTI, SVt_PVHV));
PL_DBsingle = GvSV((gv_fetchpvs("DB::single", GV_ADDMULTI, SVt_PV)));
- sv_setiv(PL_DBsingle, 0);
+ if (!SvIOK(PL_DBsingle))
+ sv_setiv(PL_DBsingle, 0);
PL_DBtrace = GvSV((gv_fetchpvs("DB::trace", GV_ADDMULTI, SVt_PV)));
- sv_setiv(PL_DBtrace, 0);
+ if (!SvIOK(PL_DBtrace))
+ sv_setiv(PL_DBtrace, 0);
PL_DBsignal = GvSV((gv_fetchpvs("DB::signal", GV_ADDMULTI, SVt_PV)));
- sv_setiv(PL_DBsignal, 0);
+ if (!SvIOK(PL_DBsignal))
+ sv_setiv(PL_DBsignal, 0);
PL_curstash = ostash;
}
https://perl5.git.perl.org / perl5.git / blobdiff