/* pp_ctl.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* Now far ahead the Road has gone,
* And I must follow, if I can,
* Pursuing it with eager feet,
* Until it joins some larger way
* Where many paths and errands meet.
* And whither then? I cannot say.
*/
#include "EXTERN.h"
#define PERL_IN_PP_CTL_C
#include "perl.h"
#ifndef WORD_ALIGN
#endif
{
dSP;
if (cxix < 0)
case G_ARRAY:
case G_SCALAR:
default:
}
}
{
return NORMAL;
}
{
restore in regcomp, where marked with XXXX. */
PL_reginterp_cnt = 0;
return NORMAL;
}
{
dSP;
register char *t;
/* prevent recompiling under /o and ithreads. */
#if defined(USE_ITHREADS) || defined(USE_5005THREADS)
#endif
}
if (mg) {
}
else {
/* Check against the last compiled regexp. */
{
}
else {
}
Safefree(t);
PL_reginterp_cnt = 0; /* XXXX Be extra paranoid - needed
}
}
#ifndef INCOMPLETE_TAINTS
if (PL_tainting) {
if (PL_tainted)
else
}
#endif
else
/* XXX runtime compiled output needs to move to the pad */
#if !defined(USE_ITHREADS) && !defined(USE_5005THREADS)
/* XXX can't change the optree at runtime either */
#endif
}
}
{
dSP;
if(old)
}
/* Are we done */
{
else
}
(void)SvPOK_only_UTF8(targ);
}
}
m = s;
s = orig;
s = orig + (m - s);
}
if (m > s) {
else
}
{ /* Update the pos() information. */
I32 i;
}
i = m - orig;
sv_pos_b2u(sv, &i);
}
}
void
{
U32 i;
if (!p)
else
*rsp = (void*)p;
}
}
}
void
{
U32 i;
if (RX_MATCH_COPIED(rx))
RX_MATCH_COPIED_set(rx, *p);
*p++ = 0;
}
}
void
{
if (p) {
Safefree(p);
}
}
{
register char *t;
register char *f;
register char *s;
register char *send;
char *fmt;
bool oneline;
if (SvREADONLY(tmpForm)) {
}
else
if (parseres)
return parseres;
}
if (DO_UTF8(PL_formtarget))
targ_is_utf8 = TRUE;
t += len;
/* need to jump to the next word */
for (;;) {
DEBUG_f( {
char *name = "???";
arg = -1;
switch (*fpc) {
}
if (arg >= 0)
else
} );
switch (*fpc++) {
case FF_LINEMARK:
linemark = t;
lines++;
break;
case FF_LITERAL:
*t = '\0';
t = SvEND(PL_formtarget);
break;
}
*t = '\0';
t = SvEND(PL_formtarget);
targ_is_utf8 = TRUE;
}
while (arg--)
*t++ = *f++;
break;
case FF_SKIP:
f += *fpc++;
break;
case FF_FETCH:
f += arg;
else {
if (ckWARN(WARN_SYNTAX))
}
break;
case FF_CHECKNL:
}
else
while (s < send) {
if (*s & ~31)
else if (*s == '\n')
break;
s++;
}
item_is_utf8 = TRUE;
break;
}
}
while (s < send) {
if (*s & ~31)
else if (*s == '\n')
break;
s++;
}
break;
case FF_CHECKCHOP:
while (s < send) {
if (*s == '\r') {
chophere = s;
break;
}
if (*s++ & ~31)
}
}
else {
if (isSPACE(*s)) {
if (chopspace)
chophere = s;
if (*s == '\r')
break;
}
else {
if (*s & ~31)
if (strchr(PL_chopset, *s))
chophere = s + 1;
}
s++;
}
}
item_is_utf8 = TRUE;
break;
}
}
while (s < send) {
if (*s == '\r') {
chophere = s;
break;
}
if (*s++ & ~31)
}
}
else {
if (isSPACE(*s)) {
if (chopspace)
chophere = s;
if (*s == '\r')
break;
}
else {
if (*s & ~31)
if (strchr(PL_chopset, *s))
chophere = s + 1;
}
s++;
}
}
break;
case FF_SPACE:
if (arg) {
while (arg-- > 0)
*t++ = ' ';
}
break;
case FF_HALFSPACE:
if (arg) {
arg /= 2;
while (arg-- > 0)
*t++ = ' ';
}
break;
case FF_ITEM:
s = item;
if (item_is_utf8) {
if (!targ_is_utf8) {
*t = '\0';
t = SvEND(PL_formtarget);
targ_is_utf8 = TRUE;
}
while (arg--) {
if (UTF8_IS_CONTINUED(*s)) {
switch (skip) {
default:
s += skip;
t += skip;
break;
case 7: *t++ = *s++;
case 6: *t++ = *s++;
case 5: *t++ = *s++;
case 4: *t++ = *s++;
case 3: *t++ = *s++;
case 2: *t++ = *s++;
case 1: *t++ = *s++;
}
}
else {
if ( !((*t++ = *s++) & ~31) )
t[-1] = ' ';
}
}
break;
}
if (targ_is_utf8 && !item_is_utf8) {
*t = '\0';
for (; t < SvEND(PL_formtarget); t++) {
#ifdef EBCDIC
int ch = *t;
#else
if (!(*t & ~31))
#endif
*t = ' ';
}
break;
}
while (arg--) {
#ifdef EBCDIC
int ch = *t++ = *s++;
#else
if ( !((*t++ = *s++) & ~31) )
#endif
t[-1] = ' ';
}
break;
case FF_CHOP:
s = chophere;
if (chopspace) {
while (*s && isSPACE(*s))
s++;
}
SvSETMAGIC(sv);
break;
case FF_LINESNGL:
chopspace = 0;
goto ff_line;
case FF_LINEGLOB:
if (itemsize) {
while (s < send) {
if (*s++ == '\n') {
if (oneline) {
chophere = s;
break;
} else {
if (s == send) {
itemsize--;
} else
lines++;
}
}
}
if (targ_is_utf8)
if (oneline) {
} else
if (chopped)
if (item_is_utf8)
targ_is_utf8 = TRUE;
}
break;
case FF_0DECIMAL:
#if defined(USE_LONG_DOUBLE)
#else
#endif
goto ff_dec;
case FF_DECIMAL:
#if defined(USE_LONG_DOUBLE)
#else
#endif
/* If the field is marked with ^ and the value is undefined,
blank it out. */
while (arg--)
*t++ = ' ';
break;
}
/* overflow evidence */
while (arg--)
*t++ = '#';
break;
}
/* Formats aren't yet marked for locales, so assume "yes". */
{
}
t += fieldsize;
break;
case FF_NEWLINE:
f++;
while (t-- > linemark && *t == ' ') ;
t++;
*t++ = '\n';
break;
case FF_BLANK:
if (gotsome) {
if (arg) { /* repeat until fields exhausted? */
*t = '\0';
if (lines == 200) {
}
if (targ_is_utf8)
}
}
else {
t = linemark;
lines--;
}
break;
case FF_MORE:
s = chophere;
if (chopspace) {
s++;
}
if (s < send) {
if (arg) {
while (arg-- > 0)
*t++ = ' ';
}
s = t - 3;
s--;
}
*s++ = '.';
*s++ = '.';
*s++ = '.';
}
break;
case FF_END:
*t = '\0';
if (targ_is_utf8)
}
}
}
{
dSP;
(void)POPMARK;
}
pp_pushmark(); /* push dst */
pp_pushmark(); /* push src */
ENTER; /* enter outer scope */
/* SAVE_DEFSV does *not* suffice here for USE_5005THREADS */
ENTER; /* enter inner scope */
pp_pushmark(); /* push top */
}
{
}
{
dSP;
/* first, move source pointer to the next item in the source list */
++PL_markstack_ptr[-1];
/* if there are new items, push them into the destination list */
/* might need to make room back there first */
/* XXX this implementation is very pessimal because the stack
* is repeatedly extended for every set of items. Is possible
* to do this without any stack extension or copying at all
* by maintaining a separate list over which the map iterates
* (like foreach does). --gsar */
/* everything in the stack after the destination list moves
* towards the end the stack by the amount of room needed */
/* items to shift up (accounting for the moved source pointer) */
/* This optimization is by Ben Tilly and it does
* things differently from what Sarathy (gsar)
* is describing. The downside of this optimization is
* that leaves "holes" (uninitialized and hopefully unused areas)
* to the Perl stack, but on the other hand this
* shouldn't be a problem. If Sarathy's idea gets
* implemented, this optimization should become
* irrelevant. --jhi */
*PL_markstack_ptr += shift;
while (count--)
}
/* copy the new items down to the destination list */
while (items-- > 0)
}
else {
/* scalar context: we don't care about which values map returns
* (we use undef here). And so we certainly don't want to do mortal
* copies of meaningless values. */
while (items-- > 0) {
(void)POPs;
*dst-- = &PL_sv_undef;
}
}
}
LEAVE; /* exit inner scope */
/* All done yet? */
(void)POPMARK; /* pop top */
LEAVE; /* exit outer scope */
(void)POPMARK; /* pop src */
(void)POPMARK; /* pop dst */
}
}
else {
ENTER; /* enter inner scope */
/* set $_ to the new source item */
}
}
/* Range stuff. */
{
return NORMAL;
else
return NORMAL;
}
{
dSP;
}
else {
int flip = 0;
if (GvIO(PL_last_in_gv)) {
}
else {
}
} else {
}
if (flip) {
}
else {
SP--;
}
}
}
}
/* This code tries to decide if "$left .. $right" should use the
magical string increment, or if the range is numeric (we make
an exception for .."0" [#18165]). AMS 20021031. */
{
dSP;
register IV i, j;
if (SvGMAGICAL(left))
if (SvGMAGICAL(right))
if (max >= i) {
j = max - i + 1;
EXTEND_MORTAL(j);
}
else
j = 0;
while (j--) {
}
}
else {
break;
}
}
}
else {
int flop = 0;
if (GvIO(PL_last_in_gv)) {
}
else {
}
}
else {
}
if (flop) {
}
}
}
/* Control. */
static char *context_name[] = {
"pseudo-block",
"subroutine",
"eval",
"loop",
"substitution",
"block",
"format"
};
{
register I32 i;
for (i = cxstack_ix; i >= 0; i--) {
case CXt_SUBST:
case CXt_SUB:
case CXt_FORMAT:
case CXt_EVAL:
case CXt_NULL:
if (ckWARN(WARN_EXITING))
return -1;
break;
case CXt_LOOP:
continue;
}
return i;
}
}
return i;
}
{
}
{
if (cxix < 0)
return G_VOID;
case G_VOID:
return G_VOID;
case G_SCALAR:
return G_SCALAR;
case G_ARRAY:
return G_ARRAY;
default:
/* NOTREACHED */
return 0;
}
}
{
else
return 0;
}
{
}
{
I32 i;
for (i = startingblock; i >= 0; i--) {
default:
continue;
case CXt_EVAL:
case CXt_SUB:
case CXt_FORMAT:
return i;
}
}
return i;
}
{
I32 i;
for (i = startingblock; i >= 0; i--) {
default:
continue;
case CXt_EVAL:
return i;
}
}
return i;
}
{
I32 i;
for (i = startingblock; i >= 0; i--) {
case CXt_SUBST:
case CXt_SUB:
case CXt_FORMAT:
case CXt_EVAL:
case CXt_NULL:
if (ckWARN(WARN_EXITING))
return -1;
break;
case CXt_LOOP:
return i;
}
}
return i;
}
void
{
while (cxstack_ix > cxix) {
/* Note: we don't need to restore the base context info till the end. */
case CXt_SUBST:
continue; /* not break */
case CXt_SUB:
break;
case CXt_EVAL:
break;
case CXt_LOOP:
break;
case CXt_NULL:
break;
case CXt_FORMAT:
break;
}
cxstack_ix--;
}
}
void
{
if (PL_in_eval)
else if (PL_errors)
else
}
OP *
{
if (PL_in_eval) {
if (message) {
if (PL_in_eval & EVAL_KEEPERR) {
char *e = Nullch;
e = Nullch;
}
if (!e) {
}
}
}
else {
}
}
&& PL_curstackinfo->si_prev)
{
dounwind(-1);
}
if (cxix >= 0) {
if (cxix < cxstack_ix)
if (!message)
my_exit(1);
}
*++newsp = &PL_sv_undef;
PL_stack_sp = newsp;
/* LEAVE could clobber PL_curcop (see save_re_context())
* XXX it might be better to find a way to avoid messing with
* PL_curcop in save_re_context() instead, but this is a more
* minimal fix --GSAR */
if (optype == OP_REQUIRE) {
}
return pop_return();
}
}
if (!message)
/* NOTREACHED */
return 0;
}
{
else
}
{
dSP;
else
}
{
dSP;
else
}
{
dSP;
char *stashname;
if (MAXARG)
for (;;) {
/* we may be in a higher stacklevel, so dig down deeper */
}
if (cxix < 0) {
}
}
count++;
if (!count--)
break;
}
/* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
field below is defined for any cx. */
}
if (!stashname)
PUSHs(&PL_sv_undef);
else {
}
}
if (!stashname)
PUSHs(&PL_sv_undef);
else
if (!MAXARG)
/* So is ccstack[dbcxix]. */
}
else {
}
}
else {
}
PUSHs(&PL_sv_undef);
else
/* eval STRING */
}
/* require */
}
/* eval BLOCK (try blocks have old_namesv == 0) */
else {
PUSHs(&PL_sv_undef);
PUSHs(&PL_sv_undef);
}
}
else {
PUSHs(&PL_sv_undef);
PUSHs(&PL_sv_undef);
}
{
if (!PL_dbargs) {
SVt_PVAV)));
}
}
/* XXX only hints propagated via op_private are currently
* visible (others are not easily accessible, since they
* use the global PL_hints) */
{
if (old_warnings == pWARN_NONE ||
else if (old_warnings == pWARN_ALL ||
else
}
}
{
dSP;
char *tmps;
if (MAXARG < 1)
tmps = "";
else
}
{
return NORMAL;
}
/* like pp_nextstate, but used instead when the debugger is active */
{
TAINT_NOT; /* Each statement is presumed innocent */
{
dSP;
if (!cv)
/* don't do recursive DB::DB call */
return NORMAL;
PL_debug = 0;
hasargs = 0;
PUSHSUB_DB(cx);
}
else
return NORMAL;
}
{
return NORMAL;
}
{
#ifdef USE_ITHREADS
void *iterdata;
#endif
#ifdef USE_5005THREADS
SAVEGENERICSV(*svp);
}
else
#endif /* USE_5005THREADS */
#ifndef USE_ITHREADS
#else
cxtype |= CXp_PADVAR;
#endif
}
else {
SAVEGENERICSV(*svp);
#ifdef USE_ITHREADS
#endif
}
#ifdef USE_ITHREADS
#else
#endif
}
else {
}
}
}
else {
}
}
{
dSP;
}
{
dSP;
; /* do nothing */
else
*++newsp = &PL_sv_undef;
}
else {
TAINT_NOT; /* Each item is independent */
}
}
return NORMAL;
}
{
if (cxstack_ix == PL_sortcxix
{
if (cxstack_ix > PL_sortcxix)
return 0;
}
}
if (cxix < 0)
if (cxix < cxstack_ix)
case CXt_SUB:
cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
break;
case CXt_EVAL:
if (!(PL_in_eval & EVAL_KEEPERR))
clear_errsv = TRUE;
if (CxTRYBLOCK(cx))
break;
lex_end();
if (optype == OP_REQUIRE &&
{
/* Unassume the success we assumed earlier. */
}
break;
case CXt_FORMAT:
break;
default:
}
if (popsub2) {
sv_2mortal(*newsp);
}
else {
}
}
else
}
else
}
else
*++newsp = &PL_sv_undef;
}
TAINT_NOT; /* Each item is independent */
}
}
PL_stack_sp = newsp;
/* Stack values are safe: */
if (popsub2) {
cxstack_ix--;
}
else
if (clear_errsv)
return pop_return();
}
{
dSP;
if (cxix < 0)
}
else {
if (cxix < 0)
}
if (cxix < cxstack_ix)
cxstack_ix++; /* temporarily protect top context */
case CXt_LOOP:
break;
case CXt_SUB:
nextop = pop_return();
break;
case CXt_EVAL:
nextop = pop_return();
break;
case CXt_FORMAT:
nextop = pop_return();
break;
default:
}
else
*++newsp = &PL_sv_undef;
}
TAINT_NOT; /* Each item is independent */
}
}
cxstack_ix--;
/* Stack values are safe: */
switch (pop2) {
case CXt_LOOP:
break;
case CXt_SUB:
break;
}
return nextop;
}
{
if (cxix < 0)
}
else {
if (cxix < 0)
}
if (cxix < cxstack_ix)
/* clear off anything above the scope we're re-entering, but
* save the rest until after a possible continue block */
if (PL_scopestack_ix < inner)
}
{
if (cxix < 0)
}
else {
if (cxix < 0)
}
if (cxix < cxstack_ix)
}
{
o->op_type == OP_LEAVELOOP ||
o->op_type == OP_LEAVESUB ||
o->op_type == OP_LEAVETRY)
{
}
*ops = 0;
/* First try all the kids at this level, since that's likeliest. */
return kid;
}
if (kid == PL_lastgotoprobe)
continue;
else
}
return o;
}
}
*ops = 0;
return 0;
}
{
return pp_goto();
/*NOTREACHED*/
}
{
dSP;
char *label;
label = 0;
/* This egregious kludge implements goto &subroutine */
if (gv) {
/* autoloaded stub? */
goto retry;
goto retry;
tmpstr = sv_newmortal();
}
}
/* First do some returnish stuff. */
if (cxix < 0)
if (cxix < cxstack_ix)
if (CxREALEVAL(cx))
mark = PL_stack_sp;
/* put @_ back onto stack */
PL_stack_sp++;
PL_stack_sp += items;
#ifndef USE_5005THREADS
#endif /* USE_5005THREADS */
/* abandon @_ if it got reified */
}
else
}
#ifdef USE_5005THREADS
#else
#endif
PL_stack_sp++;
PL_stack_sp += items;
}
/* Now do some callish stuff. */
/* For reified @_, delay freeing till return from new sub */
if (oldav)
#ifdef PERL_XSUB_OLDSTYLE
if (CvOLDSTYLE(cv)) {
SP--;
}
items);
}
else
#endif /* PERL_XSUB_OLDSTYLE */
{
PL_stack_sp--; /* There is no cv arg. */
/* Push a mark for the start of arglist */
/* Pop the current context like a decent sub should */
/* Do _not_ use PUTBACK, keep the XSUB's return stack! */
}
return pop_return();
}
else {
}
(void)SvREFCNT_inc(cv);
else {
}
#ifdef USE_5005THREADS
if (items) {
/* Mark is at the end of the stack. */
PUTBACK ;
}
}
#endif /* USE_5005THREADS */
#ifndef USE_5005THREADS
#endif /* USE_5005THREADS */
{
#ifndef USE_5005THREADS
#endif /* USE_5005THREADS */
++mark;
}
}
}
while (items--) {
if (*mark)
SvTEMP_off(*mark);
mark++;
}
}
if (PERLDB_SUB) { /* Checking curstash breaks DProf. */
/*
* We do not care about using sv to call CV;
* it's for informational purposes only.
*/
if (PERLDB_SUB_NN) {
} else {
}
if ( PERLDB_GOTO
PUSHMARK( PL_stack_sp );
PL_stack_sp--;
}
}
}
}
else {
}
}
if (! do_dump)
}
else
/* find label */
PL_lastgotoprobe = 0;
*enterops = 0;
case CXt_EVAL:
leaving_eval = TRUE;
if (!CxTRYBLOCK(cx)) {
gotoprobe = (last_eval_cx ?
last_eval_cx = cx;
break;
}
/* else fall through */
case CXt_LOOP:
break;
case CXt_SUBST:
continue;
case CXt_BLOCK:
if (ix) {
} else
break;
case CXt_SUB:
break;
}
/* FALL THROUGH */
case CXt_FORMAT:
case CXt_NULL:
default:
if (ix)
break;
}
if (gotoprobe) {
if (retop)
break;
}
}
if (!retop)
/* if we're leaving an eval, check before we pop any frames
that we're not going to punt, otherwise the error
won't be caught */
I32 i;
for (i = 1; enterops[i]; i++)
}
/* pop unwanted frames */
if (ix < cxstack_ix) {
if (ix < 0)
ix = 0;
}
/* push wanted frames */
/* Eventually we may want to stack the needed arguments
* for each op. For now, we punt on the hard ones. */
}
}
}
if (do_dump) {
#ifdef VMS
#endif
PL_do_undump = TRUE;
my_unexec();
PL_restartop = 0; /* hmm, must be GNU unexec().. */
}
}
{
dSP;
if (MAXARG < 1)
anum = 0;
else {
#ifdef VMS
anum = 0;
#endif
}
PUSHs(&PL_sv_undef);
}
#ifdef NOTYET
{
dSP;
if (value < 0.0) {
--match; /* was fractional--truncate other way */
}
if (match < 0)
match = 0;
}
{
dSP;
if (PL_multiline)
else {
if (match < 0)
match = 0;
}
}
#endif
/* Eval. */
STATIC void
{
register char *t;
while (s && s < send) {
t = strchr(s, '\n');
if (t)
t++;
else
t = send;
s = t;
}
}
#ifdef PERL_FLEXIBLE_EXCEPTIONS
STATIC void *
{
return docatch_body();
}
#endif
STATIC void *
{
return NULL;
}
{
int ret;
#ifdef DEBUGGING
#endif
PL_op = o;
/* Normally, the leavetry at the end of this block of ops will
* pop an op off the return stack and continue there. By setting
* the op to Nullop, we force an exit from the inner runops()
* loop. DAPM.
*/
retop = pop_return();
#ifdef PERL_FLEXIBLE_EXCEPTIONS
#else
#endif
switch (ret) {
case 0:
#ifndef PERL_FLEXIBLE_EXCEPTIONS
docatch_body();
#endif
break;
case 3:
/* die caught by an inner eval - continue inner loop */
PL_restartop = 0;
goto redo_body;
}
/* a die in this eval - continue in outer loop */
if (!PL_restartop)
break;
/* FALL THROUGH */
default:
/* NOTREACHED */
}
return retop;
}
OP *
/* sv Text to convert to OP tree. */
/* startop op_free() this to undo. */
/* code Short string id of the caller. */
{
dSP; /* Make POPBLOCK work. */
char *safestr;
int runtime;
/* switch to eval mode */
if (IN_PERL_COMPILETIME) {
}
code, (unsigned long)++PL_evalseq,
}
else
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
deleting the eval's FILEGV from the stash before gv_check() runs
(i.e. before run-time proper). To work around the coredump that
ensues, we always turn GvMULTI_on for any globals that were
introduced within evals. See force_ident(). GSAR 96-10-12 */
SAVEHINTS();
#ifdef OP_IN_REGISTER
#else
#endif
/* we get here either during compilation, or via pp_regcomp at runtime */
if (runtime)
if (runtime)
else
lex_end();
/* XXX DAPM do this properly one year */
if (IN_PERL_COMPILETIME)
#ifdef OP_IN_REGISTER
#endif
return rop;
}
/*
=for apidoc find_runcv
Locate the CV corresponding to the currently executing sub or eval.
If db_seqp is non_null, skip CVs that are in the DB package and populate
*db_seqp with the cop sequence number at the point that the DB:: code was
entered. (allows debuggers to eval in the scope of the breakpoint rather
than in in the scope of the debuger itself).
=cut
*/
CV*
{
if (db_seqp)
/* skip DB:: code */
continue;
}
return cv;
}
return PL_compcv;
}
}
return PL_main_cv;
}
* In the last case, startop is non-null, and contains the address of
* a pointer that should be set to the just-compiled code.
* outside is the lexically enclosing CV (if any) that invoked us.
*/
/* With USE_5005THREADS, eval_owner must be held on entry to doeval */
{
dSP;
: EVAL_INEVAL);
#ifdef USE_5005THREADS
#endif /* USE_5005THREADS */
/* set up a scratch pad */
/* make sure we compile in the right package */
}
PL_beginav = newAV();
/* try to compile it */
PL_error_count = 0;
PL_curcop->cop_arybase = 0;
else
if (PL_eval_root) {
}
if (!startop) {
pop_return();
}
lex_end();
if (optype == OP_REQUIRE) {
}
else if (startop) {
}
else {
if (!*msg) {
}
}
#ifdef USE_5005THREADS
PL_eval_owner = 0;
#endif /* USE_5005THREADS */
}
CopLINE_set(&PL_compiling, 0);
if (startop) {
*startop = PL_eval_root;
} else
/* Set the context for this new optree.
* If the last op is an OP_REQUIRE, force scalar context.
* Otherwise, propagate the context from the eval(). */
== OP_REQUIRE)
else
/* Register with debugger: */
if (cv) {
dSP;
}
}
/* compiled okay, so do it */
#ifdef USE_5005THREADS
PL_eval_owner = 0;
#endif /* USE_5005THREADS */
}
{
#ifndef PERL_DISABLE_PMC
}
else {
{
}
else {
}
}
}
else {
}
return fp;
#else
#endif /* !PERL_DISABLE_PMC */
}
{
dSP;
char *name;
int filter_has_file = 0;
if (s < end) {
s += len;
if (s < end) {
s += len;
if (s < end)
}
}
if (PERL_REVISION < rev
|| (PERL_REVISION == rev
&& (PERL_VERSION < ver
|| (PERL_VERSION == ver
&& PERL_SUBVERSION < sver))))
{
}
}
{
/* help out with the "use 5.6" confusion */
"this is only v%d.%d.%d, stopped",
}
else {
"this is only v%d.%d.%d, stopped",
}
}
}
}
TAINT_PROPER("require");
*svp != &PL_sv_undef)
/* prepare to compile file */
if (path_is_absolute(name)) {
}
#ifdef MACOS_TRADITIONAL
if (!tryrsfp) {
if (path_is_absolute(newname)) {
}
}
#endif
if (!tryrsfp) {
I32 i;
#ifdef VMS
char *unixname;
#endif
{
int count;
&& !sv_isobject(loader))
{
}
tryrsfp = 0;
if (sv_isobject(loader))
else
if (count > 0) {
int i = 0;
}
if (io) {
/* reading from a child process doesn't
nest -- when returning from reading
the inner module, the outer one is
unreadable (closed?) I've tried to
save the gv to manage the lifespan of
the pipe, but this didn't help. XXX */
(void)SvREFCNT_inc(filter_child_proc);
}
else {
}
}
}
if (i < count) {
}
}
filter_sub = arg;
(void)SvREFCNT_inc(filter_sub);
if (i < count) {
filter_state = SP[i];
(void)SvREFCNT_inc(filter_state);
}
if (tryrsfp == 0) {
}
}
SP--;
}
if (tryrsfp) {
break;
}
filter_has_file = 0;
if (filter_child_proc) {
filter_child_proc = 0;
}
if (filter_state) {
filter_state = 0;
}
if (filter_sub) {
filter_sub = 0;
}
}
else {
if (!path_is_absolute(name)
#ifdef MACOS_TRADITIONAL
/* We consider paths of the form :a:b ambiguous and interpret them first
as global then as local
*/
#endif
) {
#ifdef MACOS_TRADITIONAL
#else
#ifdef VMS
char *unixdir;
continue;
#else
#endif
#endif
TAINT_PROPER("require");
if (tryrsfp) {
tryname += 2;
break;
}
}
}
}
}
}
if (!tryrsfp) {
if (namesv) { /* did we lookup @INC? */
I32 i;
}
}
}
}
else
/* Assume success here to prevent recursive requirement. */
/* Check whether a hook in @INC has already filled %INC */
0 );
}
SAVEHINTS();
PL_hints = 0;
if (PL_dowarn & G_WARN_ALL_ON)
else if (PL_dowarn & G_WARN_ALL_OFF)
else if (PL_taint_warn)
else
if (filter_sub || filter_child_proc) {
}
/* switch to eval mode */
CopLINE_set(&PL_compiling, 0);
#ifdef USE_5005THREADS
while (PL_eval_owner)
PL_eval_owner = thr;
#endif /* USE_5005THREADS */
/* Store and reset encoding. */
/* Restore encoding. */
return op;
}
{
return pp_require();
}
{
dSP;
char *safestr;
TAINT_PROPER("eval");
/* switch to eval mode */
(unsigned long)++PL_evalseq,
}
else
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
deleting the eval's FILEGV from the stash before gv_check() runs
(i.e. before run-time proper). To work around the coredump that
ensues, we always turn GvMULTI_on for any globals that were
introduced within evals. See force_ident(). GSAR 96-10-12 */
SAVEHINTS();
else {
}
else {
}
/* special case: an eval '' executed within the DB package gets lexically
* placed in the first non-DB CV rather than the current CV - this
* allows the debugger to execute code, find lexicals etc, in the
* scope of the code being debugged. Passing &seq gets find_runcv
* to do the dirty work for us */
/* prepare to compile string */
#ifdef USE_5005THREADS
while (PL_eval_owner)
PL_eval_owner = thr;
#endif /* USE_5005THREADS */
}
}
{
dSP;
retop = pop_return();
else
}
else {
*MARK = &PL_sv_undef;
}
}
else {
/* in case LEAVE wipes old return values */
TAINT_NOT; /* Each item is independent */
}
}
}
#ifdef DEBUGGING
#endif
lex_end();
if (optype == OP_REQUIRE &&
{
/* Unassume the success we assumed earlier. */
/* die_where() did LEAVE, or we won't be here */
}
else {
if (!(save_flags & OPf_SPECIAL))
}
}
{
dSP;
}
{
dSP;
retop = pop_return();
else
}
else {
*MARK = &PL_sv_undef;
}
}
else {
/* in case LEAVE wipes old return values */
TAINT_NOT; /* Each item is independent */
}
}
}
}
{
bool ischop;
if (len == 0)
/* estimate the buffer size needed */
if (*s == '\n' || *s == '@' || *s == '^')
maxops += 10;
}
s = base;
if (s < send) {
*fpc++ = FF_LINEMARK;
base = s;
}
while (s <= send) {
switch (*s++) {
default:
skipspaces = 0;
continue;
case '~':
if (*s == '~') {
*s = ' ';
}
s[-1] = ' ';
/* FALL THROUGH */
case ' ': case '\t':
skipspaces++;
continue;
case 0:
if (s < send) {
skipspaces = 0;
continue;
} /* else FALL THROUGH */
case '\n':
skipspaces++;
arg -= skipspaces;
if (arg) {
if (postspace)
*fpc++ = FF_LITERAL;
}
if (s <= send)
skipspaces--;
if (skipspaces) {
}
skipspaces = 0;
if (s <= send)
*fpc++ = FF_NEWLINE;
if (noblank) {
if (repeat)
else
arg = 0;
}
if (s < send) {
*fpc++ = FF_LINEMARK;
base = s;
}
else
s++;
continue;
case '@':
case '^':
if (postspace) {
}
if (arg) {
*fpc++ = FF_LITERAL;
}
base = s - 1;
if (*s == '*') {
s++;
if (ischop) {
*fpc++ = FF_LINESNGL;
} else
*fpc++ = FF_LINEGLOB;
}
else if (*s == '#' || (*s == '.' && s[1] == '#')) {
base = s - 1;
while (*s == '#')
s++;
if (*s == '.') {
char *f;
s++;
f = s;
while (*s == '#')
s++;
arg |= 256 + (s - f);
}
*fpc++ = FF_DECIMAL;
}
else if (*s == '0' && s[1] == '#') { /* Zero padded decimals */
base = s - 1;
s++; /* skip the '0' first */
while (*s == '#')
s++;
if (*s == '.') {
char *f;
s++;
f = s;
while (*s == '#')
s++;
arg |= 256 + (s - f);
}
*fpc++ = FF_0DECIMAL;
}
else {
if (*s == '>') {
while (*++s == '>') ;
}
else if (*s == '|') {
while (*++s == '|') ;
}
else {
if (*s == '<')
while (*++s == '<') ;
}
if (*s == '.' && s[1] == '.' && s[2] == '.') {
s += 3;
}
if (prespace)
if (ismore)
if (ischop)
}
base = s;
skipspaces = 0;
continue;
}
}
{ /* need to jump to the next word */
int z;
}
return 0;
}
STATIC bool
{
/* Can value be printed in fldsize chars, using %*.*f ? */
if (frcsize & 256)
intsize--;
frcsize &= 255;
if( value >= 0 ){
} else {
}
return res;
}
static I32
{
int len = 0;
/* I was having segfault trouble under Linux 2.2.5 after a
parse error occured. (Had to hack around it with a test
for PL_error_count == 0.) Solaris doesn't segfault --
not sure where the trouble is yet. XXX */
if (filter_has_file) {
}
if (filter_sub && len >= 0) {
dSP;
int count;
if (filter_state) {
}
if (count > 0) {
}
}
}
if (len <= 0) {
if (filter_child_proc) {
}
if (filter_state) {
}
if (filter_sub) {
}
}
return len;
}
/* perhaps someone can come up with a better name for
this? it is not really "absolute", per se ... */
static bool
{
#ifdef MACOS_TRADITIONAL
|| (*name == ':'))
#else
#endif
{
return TRUE;
}
else
return FALSE;
}