/*
* A ship then new they built for him
* of mithril and of elven-glass
- * --from Bilbo's song of Eärendil
+ * --from Bilbo's song of Eärendil
*
* [p.236 of _The Lord of the Rings_, II/i: "Many Meetings"]
*/
JMPENV_PUSH(x);
PERL_UNUSED_VAR(x);
if (PL_endav && !PL_minus_c) {
- PL_phase = PERL_PHASE_END;
+ PERL_SET_PHASE(PERL_PHASE_END);
call_list(PL_scopestack_ix, PL_endav);
}
JMPENV_POP;
* destruct_level > 0 */
SvREFCNT_dec(PL_main_cv);
PL_main_cv = NULL;
- PL_phase = PERL_PHASE_DESTRUCT;
+ PERL_SET_PHASE(PERL_PHASE_DESTRUCT);
/* Tell PerlIO we are about to tear things apart in case
we have layers which are using resources that should
/* defgv, aka *_ should be taken care of elsewhere */
- /* clean up after study() */
- SvREFCNT_dec(PL_lastscream);
- PL_lastscream = NULL;
- Safefree(PL_screamfirst);
- PL_screamfirst = 0;
- Safefree(PL_screamnext);
- PL_screamnext = 0;
-
/* float buffer */
Safefree(PL_efloatbuf);
PL_efloatbuf = NULL;
for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvANY(sva))) {
svend = &sva[SvREFCNT(sva)];
for (sv = sva + 1; sv < svend; ++sv) {
- if (SvTYPE(sv) != SVTYPEMASK) {
+ if (SvTYPE(sv) != (svtype)SVTYPEMASK) {
PerlIO_printf(Perl_debug_log, "leaked: sv=0x%p"
" flags=0x%"UVxf
" refcnt=%"UVuf pTHX__FORMAT "\n"
call_list(oldscope, PL_unitcheckav);
}
if (PL_checkav) {
- PL_phase = PERL_PHASE_CHECK;
+ PERL_SET_PHASE(PERL_PHASE_CHECK);
call_list(oldscope, PL_checkav);
}
ret = 0;
call_list(oldscope, PL_unitcheckav);
}
if (PL_checkav) {
- PL_phase = PERL_PHASE_CHECK;
+ PERL_SET_PHASE(PERL_PHASE_CHECK);
call_list(oldscope, PL_checkav);
}
ret = STATUS_EXIT;
# ifdef DEBUGGING
" DEBUGGING"
# endif
+# ifdef HOMEGROWN_POSIX_SIGNALS
+ " HOMEGROWN_POSIX_SIGNALS"
+# endif
# ifdef NO_MATHOMS
" NO_MATHOMS"
# endif
# ifdef PERL_USE_SAFE_PUTENV
" PERL_USE_SAFE_PUTENV"
# endif
+# ifdef UNLINK_ALL_VERSIONS
+ " UNLINK_ALL_VERSIONS"
+# endif
# ifdef USE_ATTRIBUTES_FOR_PERLIO
" USE_ATTRIBUTES_FOR_PERLIO"
# endif
# ifdef USE_FAST_STDIO
" USE_FAST_STDIO"
# endif
+# ifdef USE_LOCALE
+ " USE_LOCALE"
+# endif
+# ifdef USE_LOCALE_CTYPE
+ " USE_LOCALE_CTYPE"
+# endif
# ifdef USE_PERL_ATOF
" USE_PERL_ATOF"
# endif
SV *linestr_sv = newSV_type(SVt_PVIV);
bool add_read_e_script = FALSE;
- PL_phase = PERL_PHASE_START;
+ PERL_SET_PHASE(PERL_PHASE_START);
SvGROW(linestr_sv, 80);
sv_setpvs(linestr_sv,"");
PL_curstash = PL_defstash;
if (!(PL_exit_flags & PERL_EXIT_DESTRUCT_END) &&
PL_endav && !PL_minus_c) {
- PL_phase = PERL_PHASE_END;
+ PERL_SET_PHASE(PERL_PHASE_END);
call_list(oldscope, PL_endav);
}
#ifdef MYMALLOC
if (PERLDB_SINGLE && PL_DBsingle)
sv_setiv(PL_DBsingle, 1);
if (PL_initav) {
- PL_phase = PERL_PHASE_INIT;
+ PERL_SET_PHASE(PERL_PHASE_INIT);
call_list(oldscope, PL_initav);
}
#ifdef PERL_DEBUG_READONLY_OPS
/* do it */
- PL_phase = PERL_PHASE_RUN;
+ PERL_SET_PHASE(PERL_PHASE_RUN);
if (PL_restartop) {
PL_restartjmpenv = NULL;
=for apidoc p||get_av
-Returns the AV of the specified Perl array. C<flags> are passed to
-C<gv_fetchpv>. If C<GV_ADD> is set and the
+Returns the AV of the specified Perl global or package array with the given
+name (so it won't work on lexical variables). C<flags> are passed
+to C<gv_fetchpv>. If C<GV_ADD> is set and the
Perl variable does not exist then it will be created. If C<flags> is zero
and the variable does not exist then NULL is returned.
+Perl equivalent: C<@{"$name"}>.
+
=cut
*/
=for apidoc p||call_argv
-Performs a callback to the specified Perl sub. See L<perlcall>.
+Performs a callback to the specified named and package-scoped Perl subroutine
+with C<argv> (a NULL-terminated array of strings) as arguments. See L<perlcall>.
+
+Approximate Perl equivalent: C<&{"$sub_name"}(@$argv)>.
=cut
*/
{
dVAR;
#ifdef MULTIPLICITY
-# define PERLVAR(var,type)
-# define PERLVARA(var,n,type)
+# define PERLVAR(prefix,var,type)
+# define PERLVARA(prefix,var,n,type)
# if defined(PERL_IMPLICIT_CONTEXT)
-# define PERLVARI(var,type,init) aTHX->var = init;
-# define PERLVARIC(var,type,init) aTHX->var = init;
+# define PERLVARI(prefix,var,type,init) aTHX->prefix##var = init;
+# define PERLVARIC(prefix,var,type,init) aTHX->prefix##var = init;
# else
-# define PERLVARI(var,type,init) PERL_GET_INTERP->var = init;
-# define PERLVARIC(var,type,init) PERL_GET_INTERP->var = init;
+# define PERLVARI(prefix,var,type,init) PERL_GET_INTERP->var = init;
+# define PERLVARIC(prefix,var,type,init) PERL_GET_INTERP->var = init;
# endif
# include "intrpvar.h"
# undef PERLVAR
# undef PERLVARI
# undef PERLVARIC
#else
-# define PERLVAR(var,type)
-# define PERLVARA(var,n,type)
-# define PERLVARI(var,type,init) PL_##var = init;
-# define PERLVARIC(var,type,init) PL_##var = init;
+# define PERLVAR(prefix,var,type)
+# define PERLVARA(prefix,var,n,type)
+# define PERLVARI(prefix,var,type,init) PL_##var = init;
+# define PERLVARIC(prefix,var,type,init) PL_##var = init;
# include "intrpvar.h"
# undef PERLVAR
# undef PERLVARA
"leak" until global destruction. */
av_clear(args);
}
- AvREAL_off(PL_dbargs); /* XXX should be REIFY (see av.h) */
+ AvREIFY_only(PL_dbargs);
}
void
#endif /* !PERL_MICRO */
}
TAINT_NOT;
- if ((tmpgv = gv_fetchpvs("$", GV_ADD|GV_NOTQUAL, SVt_PV))) {
- SvREADONLY_off(GvSV(tmpgv));
- sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
- SvREADONLY_on(GvSV(tmpgv));
- }
#ifdef THREADS_HAVE_PIDS
PL_ppid = (IV)getppid();
#endif
PERL_ARGS_ASSERT_INCPUSH_USE_SEP;
+ /* perl compiled with -DPERL_RELOCATABLE_INCPUSH will ignore the len
+ * argument to incpush_use_sep. This allows creation of relocatable
+ * Perl distributions that patch the binary at install time. Those
+ * distributions will have to provide their own relocation tools; this
+ * is not a feature otherwise supported by core Perl.
+ */
+#ifndef PERL_RELOCATABLE_INCPUSH
if (!len)
+#endif
len = strlen(p);
end = p + len;
https://perl5.git.perl.org / perl5.git / blobdiff