{
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
SvREFCNT_dec(PL_utf8_foldable);
SvREFCNT_dec(PL_utf8_foldclosures);
SvREFCNT_dec(PL_AboveLatin1);
+ SvREFCNT_dec(PL_InBitmap);
SvREFCNT_dec(PL_UpperLatin1);
SvREFCNT_dec(PL_Latin1);
SvREFCNT_dec(PL_NonL1NonFinalFold);
PL_utf8_idcont = NULL;
PL_utf8_foldclosures = NULL;
PL_AboveLatin1 = NULL;
+ PL_InBitmap = NULL;
PL_HasMultiCharFold = NULL;
PL_Latin1 = NULL;
PL_NonL1NonFinalFold = NULL;
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);
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, SVfARG(*inc0), 0,
+ "BEGIN { my $f = q%c./%"SVf"/buildcustomize.pl%c; "
+ "do {local $!; -f $f }"
+ " and do $f || die $@ || qq '$f: $!' }",
0, SVfARG(*inc0), 0));
}
# else
#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;
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)));
CALLRUNOPS(aTHX);
}
my_exit(0);
- /* NOTREACHED */
- assert(0);
+ assert(0); /* NOTREACHED */
}
/*
/* See G_* flags in cop.h */
/* null terminated arg list */
{
- dVAR;
dSP;
PERL_ARGS_ASSERT_CALL_ARGV;
FREETMPS;
JMPENV_POP;
my_exit_jump();
- /* NOTREACHED */
- assert(0);
+ assert(0); /* NOTREACHED */
case 3:
if (PL_restartop) {
PL_restartjmpenv = NULL;
FREETMPS;
JMPENV_POP;
my_exit_jump();
- /* NOTREACHED */
- assert(0);
+ assert(0); /* NOTREACHED */
case 3:
if (PL_restartop) {
PL_restartjmpenv = NULL;
/*
=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;
}
}
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) {
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;
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.
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. */
#ifndef NO_TAINT_SUPPORT
- dVAR;
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
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;
CopLINE_set(PL_curcop, oldline);
JMPENV_POP;
my_exit_jump();
- /* NOTREACHED */
- assert(0);
+ assert(0); /* NOTREACHED */
case 3:
if (PL_restartop) {
PL_curcop = &PL_compiling;
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');