#include "perl.h"
#include "patchlevel.h" /* for local_patches */
#include "XSUB.h"
+#include "charclass_invlists.h"
#ifdef NETWARE
#include "nwutil.h"
}
void
-Perl_sys_term()
+Perl_sys_term(void)
{
dVAR;
if (!PL_veto_cleanup) {
Zero(PL_sv_consts, SV_CONSTS_COUNT, SV*);
-#if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
- _dyld_lookup_and_bind
- ("__environ", (unsigned long *) &environ_pointer, NULL);
-#endif /* environ */
-
#ifndef PERL_MICRO
# ifdef USE_ENVIRON_ARRAY
PL_origenviron = environ;
/* Start with 1 bucket, for DFS. It's unlikely we'll need more. */
HvMAX(PL_registered_mros) = 0;
+ PL_XPosix_ptrs[_CC_ASCII] = _new_invlist_C_array(ASCII_invlist);
+ PL_XPosix_ptrs[_CC_ALPHANUMERIC] = _new_invlist_C_array(XPosixAlnum_invlist);
+ PL_XPosix_ptrs[_CC_ALPHA] = _new_invlist_C_array(XPosixAlpha_invlist);
+ PL_XPosix_ptrs[_CC_BLANK] = _new_invlist_C_array(XPosixBlank_invlist);
+ PL_XPosix_ptrs[_CC_CASED] = _new_invlist_C_array(Cased_invlist);
+ PL_XPosix_ptrs[_CC_CNTRL] = _new_invlist_C_array(XPosixCntrl_invlist);
+ PL_XPosix_ptrs[_CC_DIGIT] = _new_invlist_C_array(XPosixDigit_invlist);
+ PL_XPosix_ptrs[_CC_GRAPH] = _new_invlist_C_array(XPosixGraph_invlist);
+ PL_XPosix_ptrs[_CC_LOWER] = _new_invlist_C_array(XPosixLower_invlist);
+ PL_XPosix_ptrs[_CC_PRINT] = _new_invlist_C_array(XPosixPrint_invlist);
+ PL_XPosix_ptrs[_CC_PUNCT] = _new_invlist_C_array(XPosixPunct_invlist);
+ PL_XPosix_ptrs[_CC_SPACE] = _new_invlist_C_array(XPerlSpace_invlist);
+ PL_XPosix_ptrs[_CC_PSXSPC] = _new_invlist_C_array(XPosixSpace_invlist);
+ PL_XPosix_ptrs[_CC_UPPER] = _new_invlist_C_array(XPosixUpper_invlist);
+ PL_XPosix_ptrs[_CC_VERTSPACE] = _new_invlist_C_array(VertSpace_invlist);
+ PL_XPosix_ptrs[_CC_WORDCHAR] = _new_invlist_C_array(XPosixWord_invlist);
+ PL_XPosix_ptrs[_CC_XDIGIT] = _new_invlist_C_array(XPosixXDigit_invlist);
+
ENTER;
}
{
const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
if (s) {
- const int i = atoi(s);
+ int i;
+ if (strEQ(s, "-1")) { /* Special case: modperl folklore. */
+ i = -1;
+ } else {
+ i = grok_atou(s, NULL);
+ }
#ifdef DEBUGGING
if (destruct_level < i) destruct_level = i;
#endif
msg.msg_name = NULL;
msg.msg_namelen = 0;
msg.msg_iov = vec;
- msg.msg_iovlen = sizeof(vec)/sizeof(vec[0]);
+ msg.msg_iovlen = C_ARRAY_LENGTH(vec);
vec[0].iov_base = (void*)⌖
vec[0].iov_len = sizeof(target);
SvREFCNT_dec(PL_utf8_tofold);
SvREFCNT_dec(PL_utf8_idstart);
SvREFCNT_dec(PL_utf8_idcont);
+ SvREFCNT_dec(PL_utf8_foldable);
SvREFCNT_dec(PL_utf8_foldclosures);
SvREFCNT_dec(PL_AboveLatin1);
SvREFCNT_dec(PL_UpperLatin1);
PL_NonL1NonFinalFold = NULL;
PL_UpperLatin1 = NULL;
for (i = 0; i < POSIX_CC_COUNT; i++) {
- SvREFCNT_dec(PL_Posix_ptrs[i]);
- PL_Posix_ptrs[i] = NULL;
-
- SvREFCNT_dec(PL_L1Posix_ptrs[i]);
- PL_L1Posix_ptrs[i] = NULL;
-
SvREFCNT_dec(PL_XPosix_ptrs[i]);
PL_XPosix_ptrs[i] = NULL;
}
PL_debug &= ~ DEBUG_m_FLAG;
}
while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header))
- safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next));
+ safesysfree(PERL_MEMORY_DEBUG_HEADER_SIZE + (char *)(aTHXx->Imemory_debug_header.next));
PL_debug = old_debug;
}
}
void
Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr)
{
- dVAR;
Renew(PL_exitlist, PL_exitlistlen+1, PerlExitListEntry);
PL_exitlist[PL_exitlistlen].fn = fn;
PL_exitlist[PL_exitlistlen].ptr = ptr;
{
const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG");
- if (s && (atoi(s) == 1)) {
+ if (s && (grok_atou(s, NULL) == 1)) {
unsigned char *seed= PERL_HASH_SEED;
unsigned char *seed_end= PERL_HASH_SEED + PERL_HASH_SEED_BYTES;
PerlIO_printf(Perl_debug_log, "HASH_FUNCTION = %s HASH_SEED = 0x", PERL_HASH_FUNC);
* --jhi */
const char *s = NULL;
int i;
- const UV mask =
- ~(UV)(PTRSIZE == 4 ? 3 : PTRSIZE == 8 ? 7 : PTRSIZE == 16 ? 15 : 0);
+ const UV mask = ~(UV)(PTRSIZE-1);
/* Do the mask check only if the args seem like aligned. */
const UV aligned =
(mask < ~(UV)0) && ((PTR2UV(argv[0]) & mask) == PTR2UV(argv[0]));
break;
case 1:
STATUS_ALL_FAILURE;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case 2:
/* my_exit() was called */
while (PL_scopestack_ix > oldscope)
# ifdef NO_TAINT_SUPPORT
" NO_TAINT_SUPPORT"
# endif
+# ifdef PERL_BOOL_AS_CHAR
+ " PERL_BOOL_AS_CHAR"
+# endif
# ifdef PERL_DISABLE_PMC
" PERL_DISABLE_PMC"
# endif
break;
case 't':
-#if SILENT_NO_TAINT_SUPPORT
+#if defined(SILENT_NO_TAINT_SUPPORT)
/* silently ignore */
-#elif NO_TAINT_SUPPORT
+#elif defined(NO_TAINT_SUPPORT)
Perl_croak_nocontext("This perl was compiled without taint support. "
"Cowardly refusing to run with -t or -T flags");
#else
s++;
goto reswitch;
case 'T':
-#if SILENT_NO_TAINT_SUPPORT
+#if defined(SILENT_NO_TAINT_SUPPORT)
/* silently ignore */
-#elif NO_TAINT_SUPPORT
+#elif defined(NO_TAINT_SUPPORT)
Perl_croak_nocontext("This perl was compiled without taint support. "
"Cowardly refusing to run with -t or -T flags");
#else
case 'E':
PL_minus_E = TRUE;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case 'e':
forbid_setid('e', FALSE);
if (!PL_e_script) {
if (strEQ(s, "help"))
usage();
s--;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
default:
Perl_croak(aTHX_ "Unrecognized switch: -%s (-h will show valid options)",s);
}
while (isSPACE(*s))
s++;
if (*s == '-' && *(s+1) == 'T') {
-#if SILENT_NO_TAINT_SUPPORT
+#if defined(SILENT_NO_TAINT_SUPPORT)
/* silently ignore */
-#elif NO_TAINT_SUPPORT
+#elif defined(NO_TAINT_SUPPORT)
Perl_croak_nocontext("This perl was compiled without taint support. "
"Cowardly refusing to run with -t or -T flags");
#else
}
}
if (*d == 't') {
-#if SILENT_NO_TAINT_SUPPORT
+#if defined(SILENT_NO_TAINT_SUPPORT)
/* silently ignore */
-#elif NO_TAINT_SUPPORT
+#elif defined(NO_TAINT_SUPPORT)
Perl_croak_nocontext("This perl was compiled without taint support. "
"Cowardly refusing to run with -t or -T flags");
#else
it should be reported immediately as a build failure. */
(void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
Perl_newSVpvf(aTHX_
- "BEGIN { do {local $!; -f q%c%"SVf"/buildcustomize.pl%c} and do q%c%"SVf"/buildcustomize.pl%c || die $@ }",
- 0, *inc0, 0,
- 0, *inc0, 0));
+ "BEGIN { do {local $!; -f q%c./%"SVf
+ "/buildcustomize.pl%c} and do q%c./%"SVf
+ "/buildcustomize.pl%c || die $@ }",
+ 0, SVfARG(*inc0), 0,
+ 0, SVfARG(*inc0), 0));
}
# else
/* SITELIB_EXP is a function call on Win32. */
(void)Perl_av_create_and_unshift_one(aTHX_ &PL_preambleav,
Perl_newSVpvf(aTHX_
"BEGIN { do {local $!; -f q%c%s/sitecustomize.pl%c} && do q%c%s/sitecustomize.pl%c }",
- 0, sitelib, 0,
- 0, sitelib, 0));
+ 0, SVfARG(sitelib), 0,
+ 0, SVfARG(sitelib), 0));
assert (SvREFCNT(sitelib_sv) == 1);
SvREFCNT_dec(sitelib_sv);
}
}
}
-#ifdef PERL_MAD
- {
- const char *s;
- if (!TAINTING_get &&
- (s = PerlEnv_getenv("PERL_XMLDUMP"))) {
- PL_madskills = 1;
- PL_minus_c = 1;
- if (!s || !s[0])
- PL_xmlfp = PerlIO_stdout();
- else {
- PL_xmlfp = PerlIO_open(s, "w");
- if (!PL_xmlfp)
- Perl_croak(aTHX_ "Can't open %s", s);
- }
- my_setenv("PERL_XMLDUMP", NULL); /* hide from subprocs */
- }
- }
-
- {
- const char *s;
- if ((s = PerlEnv_getenv("PERL_MADSKILLS"))) {
- PL_madskills = atoi(s);
- my_setenv("PERL_MADSKILLS", NULL); /* hide from subprocs */
- }
- }
-#endif
lex_start(linestr_sv, rsfp, lex_start_flags);
SvREFCNT_dec(linestr_sv);
#ifdef MYMALLOC
{
const char *s;
- if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
- dump_mstats("after compilation:");
+ if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && grok_atou(s, NULL) >= 2)
+ dump_mstats("after compilation:");
}
#endif
int
perl_run(pTHXx)
{
- dVAR;
I32 oldscope;
int ret = 0;
dJMPENV;
case 0: /* normal completion */
redo_body:
run_body(oldscope);
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case 2: /* my_exit() */
while (PL_scopestack_ix > oldscope)
LEAVE;
STATIC void
S_run_body(pTHX_ I32 oldscope)
{
- dVAR;
DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support (0x%x).\n",
PL_sawampersand ? "Enabling" : "Omitting",
(unsigned int)(PL_sawampersand)));
if (!PL_restartop) {
-#ifdef PERL_MAD
- if (PL_xmlfp) {
- xmldump_all();
- exit(0); /* less likely to core dump than my_exit(0) */
- }
-#endif
#ifdef DEBUGGING
if (DEBUG_x_TEST || DEBUG_B_TEST)
dump_all_perl(!DEBUG_B_TEST);
/* See G_* flags in cop.h */
/* null terminated arg list */
{
- dVAR;
dSP;
PERL_ARGS_ASSERT_CALL_ARGV;
break;
case 1:
STATUS_ALL_FAILURE;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case 2:
/* my_exit() was called */
SET_CURSTASH(PL_defstash);
break;
case 1:
STATUS_ALL_FAILURE;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case 2:
/* my_exit() was called */
SET_CURSTASH(PL_defstash);
/*
=for apidoc p||eval_pv
-Tells Perl to C<eval> the given string and return an SV* result.
+Tells Perl to C<eval> the given string in scalar context and return an SV* result.
=cut
*/
SV*
Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
{
- dVAR;
SV* sv = newSVpv(p, 0);
PERL_ARGS_ASSERT_EVAL_PV;
void
Perl_require_pv(pTHX_ const char *pv)
{
- dVAR;
dSP;
SV* sv;
" 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",
+ " L trace some locale setting information--for Perl core development\n",
NULL
};
int i = 0;
if (isALPHA(**s)) {
/* if adding extra options, remember to update DEBUG_MASK */
- static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMB";
+ static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAqMBL";
for (; isWORDCHAR(**s); (*s)++) {
const char * const d = strchr(debopts,**s);
}
}
else if (isDIGIT(**s)) {
- i = atoi(*s);
+ const char* e;
+ i = grok_atou(*s, &e);
+ if (e)
+ *s = e;
for (; isWORDCHAR(**s); (*s)++) ;
}
else if (givehelp) {
return s;
case 'M':
forbid_setid('M', FALSE); /* XXX ? */
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case 'm':
forbid_setid('m', FALSE); /* XXX ? */
if (*++s) {
return s;
case 't':
case 'T':
-#if SILENT_NO_TAINT_SUPPORT
+#if defined(SILENT_NO_TAINT_SUPPORT)
/* silently ignore */
-#elif NO_TAINT_SUPPORT
+#elif defined(NO_TAINT_SUPPORT)
Perl_croak_nocontext("This perl was compiled without taint support. "
"Cowardly refusing to run with -t or -T flags");
#else
"\nThis is perl " STRINGIFY(PERL_REVISION)
", version " STRINGIFY(PERL_VERSION)
", subversion " STRINGIFY(PERL_SUBVERSION)
- " (%"SVf") built for " ARCHNAME, level
+ " (%"SVf") built for " ARCHNAME, SVfARG(level)
);
SvREFCNT_dec_NN(level);
}
#endif
PerlIO_printf(PIO_stdout,
- "\n\nCopyright 1987-2013, Larry Wall\n");
+ "\n\nCopyright 1987-2014, Larry Wall\n");
#ifdef MSDOS
PerlIO_printf(PIO_stdout,
"\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
void
Perl_my_unexec(pTHX)
{
- PERL_UNUSED_CONTEXT;
#ifdef UNEXEC
SV * prog = newSVpv(BIN_EXP, 0);
SV * file = newSVpv(PL_origfilename, 0);
/* unexec prints msg to stderr in case of failure */
PerlProc_exit(status);
#else
+ PERL_UNUSED_CONTEXT;
# ifdef VMS
lib$signal(SS$_DEBUG); /* ssdef.h #included from vmsish.h */
# elif defined(WIN32) || defined(__CYGWIN__)
- Perl_croak(aTHX_ "dump is not supported");
+ Perl_croak_nocontext("dump is not supported");
# else
ABORT(); /* for use with undump */
# endif
STATIC void
S_init_interp(pTHX)
{
- dVAR;
#ifdef MULTIPLICITY
# define PERLVAR(prefix,var,type)
# define PERLVARA(prefix,var,n,type)
STATIC void
S_init_main_stash(pTHX)
{
- dVAR;
GV *gv;
PL_curstash = PL_defstash = (HV *)SvREFCNT_inc_simple_NN(newHV());
{
int fdscript = -1;
PerlIO *rsfp = NULL;
- dVAR;
Stat_t tmpstatbuf;
+ int fd;
PERL_ARGS_ASSERT_OPEN_SCRIPT;
if (strnEQ(scriptname, "/dev/fd/", 8) && isDIGIT(scriptname[8]) ) {
const char *s = scriptname + 8;
- fdscript = atoi(s);
- while (isDIGIT(*s))
- s++;
+ const char* e;
+ fdscript = grok_atou(s, &e);
+ s = e;
if (*s) {
/* PSz 18 Feb 04
* Tell apart "normal" usage of fdscript, e.g.
const char * const err = "Failed to create a fake bit bucket";
if (strEQ(scriptname, BIT_BUCKET)) {
#ifdef HAS_MKSTEMP /* Hopefully mkstemp() is safe here. */
+ int old_umask = umask(0600);
int tmpfd = mkstemp(tmpname);
+ umask(old_umask);
if (tmpfd > -1) {
scriptname = tmpname;
close(tmpfd);
Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
CopFILE(PL_curcop), Strerror(errno));
}
+ fd = PerlIO_fileno(rsfp);
#if defined(HAS_FCNTL) && defined(F_SETFD)
- /* ensure close-on-exec */
- fcntl(PerlIO_fileno(rsfp), F_SETFD, 1);
+ if (fd >= 0) {
+ /* ensure close-on-exec */
+ if (fcntl(fd, F_SETFD, 1) < 0) {
+ Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
+ CopFILE(PL_curcop), Strerror(errno));
+ }
+ }
#endif
- if (PerlLIO_fstat(PerlIO_fileno(rsfp), &tmpstatbuf) >= 0
- && S_ISDIR(tmpstatbuf.st_mode))
+ if (fd < 0 ||
+ (PerlLIO_fstat(fd, &tmpstatbuf) >= 0
+ && S_ISDIR(tmpstatbuf.st_mode)))
Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
CopFILE(PL_curcop),
Strerror(EISDIR));
if (my_euid != my_uid || my_egid != my_gid) { /* (suidperl doesn't exist, in fact) */
dVAR;
-
- PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf); /* may be either wrapped or real suid */
- if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
- ||
- (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
- )
+ int fd = PerlIO_fileno(rsfp);
+ if (fd < 0) {
+ Perl_croak(aTHX_ "Illegal suidscript");
+ } else {
+ if (PerlLIO_fstat(fd, &PL_statbuf) < 0) { /* may be either wrapped or real suid */
+ Perl_croak(aTHX_ "Illegal suidscript");
+ }
+ }
+ if ((my_euid != my_uid && my_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
+ ||
+ (my_egid != my_gid && my_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
+ )
if (!PL_do_undump)
Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
STATIC void
S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
{
- dVAR;
const char *s;
const char *s2;
{
/* no need to do anything here any more if we don't
* do tainting. */
-#if !NO_TAINT_SUPPORT
- dVAR;
+#ifndef NO_TAINT_SUPPORT
const Uid_t my_uid = PerlProc_getuid();
const Uid_t my_euid = PerlProc_geteuid();
const Gid_t my_gid = PerlProc_getgid();
const Gid_t my_egid = PerlProc_getegid();
+ PERL_UNUSED_CONTEXT;
+
/* Should not happen: */
CHECK_MALLOC_TAINT(my_uid && (my_euid != my_uid || my_egid != my_gid));
TAINTING_set( TAINTING_get | (my_uid && (my_euid != my_uid || my_egid != my_gid)) );
* if -T are the first chars together; otherwise one gets
* "Too late" message. */
if ( argc > 1 && argv[1][0] == '-'
- && (argv[1][1] == 't' || argv[1][1] == 'T') )
+ && isALPHA_FOLD_EQ(argv[1][1], 't'))
return 1;
return 0;
}
STATIC void
S_forbid_setid(pTHX_ const char flag, const bool suidscript) /* g */
{
- dVAR;
char string[3] = "-x";
const char *message = "program input from stdin";
+ PERL_UNUSED_CONTEXT;
if (flag) {
string[1] = flag;
message = string;
void
Perl_init_debugger(pTHX)
{
- dVAR;
HV * const ostash = PL_curstash;
PL_curstash = (HV *)SvREFCNT_inc_simple(PL_debstash);
void
Perl_init_stacks(pTHX)
{
- dVAR;
/* start with 128-item stack and 8K cxstack */
PL_curstackinfo = new_stackinfo(REASONABLE(128),
REASONABLE(8192/sizeof(PERL_CONTEXT) - 1));
STATIC void
S_nuke_stacks(pTHX)
{
- dVAR;
while (PL_curstackinfo->si_next)
PL_curstackinfo = PL_curstackinfo->si_next;
while (PL_curstackinfo) {
STATIC void
S_init_predump_symbols(pTHX)
{
- dVAR;
GV *tmpgv;
IO *io;
void
Perl_init_argv_symbols(pTHX_ int argc, char **argv)
{
- dVAR;
-
PERL_ARGS_ASSERT_INIT_ARGV_SYMBOLS;
argc--,argv++; /* skip name of script */
STATIC void
S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env)
{
+#ifdef USE_ITHREADS
dVAR;
+#endif
GV* tmpgv;
PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS;
STATIC void
S_init_perllib(pTHX)
{
- dVAR;
#ifndef VMS
const char *perl5lib = NULL;
#endif
STATIC SV *
S_incpush_if_exists(pTHX_ AV *const av, SV *dir, SV *const stem)
{
- dVAR;
Stat_t tmpstatbuf;
PERL_ARGS_ASSERT_INCPUSH_IF_EXISTS;
STATIC void
S_incpush(pTHX_ const char *const dir, STRLEN len, U32 flags)
{
- dVAR;
#ifndef PERL_IS_MINIPERL
const U8 using_sub_dirs
= (U8)flags & (INCPUSH_ADD_VERSIONED_SUB_DIRS
#ifdef PERL_IS_MINIPERL
const Size_t extra = 0;
#else
- Size_t extra = av_len(av) + 1;
+ Size_t extra = av_tindex(av) + 1;
#endif
av_unshift(inc, extra + push_basedir);
if (push_basedir)
void
Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
{
- dVAR;
SV *atsv;
volatile const line_t oldline = PL_curcop ? CopLINE(PL_curcop) : 0;
CV *cv;
PERL_ARGS_ASSERT_CALL_LIST;
- while (av_len(paramList) >= 0) {
+ while (av_tindex(paramList) >= 0) {
cv = MUTABLE_CV(av_shift(paramList));
if (PL_savebegin) {
if (paramList == PL_beginav) {
Perl_av_create_and_push(aTHX_ &PL_unitcheckav_save, MUTABLE_SV(cv));
}
} else {
- if (!PL_madskills)
- SAVEFREESV(cv);
+ SAVEFREESV(cv);
}
JMPENV_PUSH(ret);
switch (ret) {
case 0:
-#ifdef PERL_MAD
- if (PL_madskills)
- PL_madskills |= 16384;
-#endif
CALL_LIST_BODY(cv);
-#ifdef PERL_MAD
- if (PL_madskills)
- PL_madskills &= ~16384;
-#endif
atsv = ERRSV;
(void)SvPV_const(atsv, len);
if (len) {
break;
case 1:
STATUS_ALL_FAILURE;
- /* FALL THROUGH */
+ /* FALLTHROUGH */
case 2:
/* my_exit() was called */
while (PL_scopestack_ix > oldscope)
void
Perl_my_exit(pTHX_ U32 status)
{
- dVAR;
if (PL_exit_flags & PERL_EXIT_ABORT) {
abort();
}
void
Perl_my_failure_exit(pTHX)
{
- dVAR;
#ifdef VMS
/* We have been called to fall on our sword. The desired exit code
* should be already set in STATUS_UNIX, but could be shifted over
STATIC void
S_my_exit_jump(pTHX)
{
- dVAR;
-
if (PL_e_script) {
SvREFCNT_dec(PL_e_script);
PL_e_script = NULL;
static I32
read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
{
- dVAR;
const char * const p = SvPVX_const(PL_e_script);
const char *nl = strchr(p, '\n');
https://perl5.git.perl.org / perl5.git / blobdiff