1N/A * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 1N/A * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others 1N/A * You may distribute under the terms of either the GNU General Public 1N/A * License or the Artistic License, as specified in the README file. 1N/A * Now far ahead the Road has gone, 1N/A * And I must follow, if I can, 1N/A * Pursuing it with eager feet, 1N/A * Until it joins some larger way 1N/A * Where many paths and errands meet. 1N/A * And whither then? I cannot say. 1N/A restore in regcomp, where marked with XXXX. */ 1N/A /* prevent recompiling under /o and ithreads. */ 1N/A /* Check against the last compiled regexp. */ 1N/A /* XXX runtime compiled output needs to move to the pad */ 1N/A /* XXX can't change the optree at runtime either */ 1N/A {
/* Update the pos() information. */ 1N/A /* need to jump to the next word */ 1N/A else if (*s ==
'\n')
1N/A else if (*s ==
'\n')
1N/A case 7: *t++ = *s++;
1N/A case 6: *t++ = *s++;
1N/A case 5: *t++ = *s++;
1N/A case 4: *t++ = *s++;
1N/A case 3: *t++ = *s++;
1N/A case 2: *t++ = *s++;
1N/A case 1: *t++ = *s++;
1N/A if ( !((*t++ = *s++) & ~
31) )
1N/A if ( !((*t++ = *s++) & ~
31) )
1N/A /* If the field is marked with ^ and the value is undefined, 1N/A /* overflow evidence */ 1N/A /* Formats aren't yet marked for locales, so assume "yes". */ 1N/A if (
arg) {
/* repeat until fields exhausted? */ 1N/A /* SAVE_DEFSV does *not* suffice here for USE_5005THREADS */ 1N/A /* first, move source pointer to the next item in the source list */ 1N/A /* if there are new items, push them into the destination list */ 1N/A /* might need to make room back there first */ 1N/A /* XXX this implementation is very pessimal because the stack 1N/A * is repeatedly extended for every set of items. Is possible 1N/A * to do this without any stack extension or copying at all 1N/A * by maintaining a separate list over which the map iterates 1N/A * (like foreach does). --gsar */ 1N/A /* everything in the stack after the destination list moves 1N/A * towards the end the stack by the amount of room needed */ 1N/A /* items to shift up (accounting for the moved source pointer) */ 1N/A /* This optimization is by Ben Tilly and it does 1N/A * things differently from what Sarathy (gsar) 1N/A * is describing. The downside of this optimization is 1N/A * that leaves "holes" (uninitialized and hopefully unused areas) 1N/A * to the Perl stack, but on the other hand this 1N/A * shouldn't be a problem. If Sarathy's idea gets 1N/A * implemented, this optimization should become 1N/A * irrelevant. --jhi */ 1N/A /* copy the new items down to the destination list */ 1N/A /* scalar context: we don't care about which values map returns 1N/A * (we use undef here). And so we certainly don't want to do mortal 1N/A * copies of meaningless values. */ 1N/A /* set $_ to the new source item */ 1N/A/* This code tries to decide if "$left .. $right" should use the 1N/A magical string increment, or if the range is numeric (we make 1N/A an exception for .."0" [#18165]). AMS 20021031. */ 1N/A assert(
cxix >= 0);
/* We should only be called from inside subs */ 1N/A /* Note: we don't need to restore the base context info till the end. */ 1N/A continue;
/* not break */ 1N/A /* LEAVE could clobber PL_curcop (see save_re_context()) 1N/A * XXX it might be better to find a way to avoid messing with 1N/A * PL_curcop in save_re_context() instead, but this is a more 1N/A * minimal fix --GSAR */ 1N/A /* we may be in a higher stacklevel, so dig down deeper */ 1N/A /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the 1N/A field below is defined for any cx. */ 1N/A /* So is ccstack[dbcxix]. */ 1N/A /* eval BLOCK (try blocks have old_namesv == 0) */ 1N/A /* XXX only hints propagated via op_private are currently 1N/A * visible (others are not easily accessible, since they 1N/A * use the global PL_hints) */ 1N/A/* like pp_nextstate, but used instead when the debugger is active */ 1N/A /* don't do recursive DB::DB call */ 1N/A#
endif /* USE_5005THREADS */ 1N/A POPLOOP(
cx);
/* Stack values are safe: release loop vars ... */ 1N/A /* Unassume the success we assumed earlier. */ 1N/A /* Stack values are safe: */ 1N/A /* Stack values are safe: */ 1N/A /* clear off anything above the scope we're re-entering, but 1N/A * save the rest until after a possible continue block */ 1N/A static char too_deep[] =
"Target of goto is too deeply nested";
1N/A /* First try all the kids at this level, since that's likeliest. */ 1N/A /* This egregious kludge implements goto &subroutine */ 1N/A /* autoloaded stub? */ 1N/A /* First do some returnish stuff. */ 1N/A DIE(
aTHX_ "Can't goto subroutine outside a subroutine");
1N/A DIE(
aTHX_ "Can't goto subroutine from an eval-string");
1N/A /* put @_ back onto stack */ 1N/A#
endif /* USE_5005THREADS */ 1N/A /* abandon @_ if it got reified */ 1N/A else if (
CvXSUB(
cv)) {
/* put GvAV(defgv) back onto stack */ 1N/A /* Now do some callish stuff. */ 1N/A /* For reified @_, delay freeing till return from new sub */ 1N/A#
endif /* PERL_XSUB_OLDSTYLE */ 1N/A /* Push a mark for the start of arglist */ 1N/A /* Pop the current context like a decent sub should */ 1N/A /* Do _not_ use PUTBACK, keep the XSUB's return stack! */ 1N/A /* Mark is at the end of the stack. */ 1N/A#
endif /* USE_5005THREADS */ 1N/A#
endif /* USE_5005THREADS */ 1N/A#
endif /* USE_5005THREADS */ 1N/A * We do not care about using sv to call CV; 1N/A * it's for informational purposes only. 1N/A /* else fall through */ 1N/A /* if we're leaving an eval, check before we pop any frames 1N/A that we're not going to punt, otherwise the error 1N/A DIE(
aTHX_ "Can't \"goto\" into the middle of a foreach loop");
1N/A /* pop unwanted frames */ 1N/A /* push wanted frames */ 1N/A /* Eventually we may want to stack the needed arguments 1N/A * for each op. For now, we punt on the hard ones. */ 1N/A DIE(
aTHX_ "Can't \"goto\" into the middle of a foreach loop");
1N/A --
match;
/* was fractional--truncate other way */ 1N/A /* Normally, the leavetry at the end of this block of ops will 1N/A * pop an op off the return stack and continue there. By setting 1N/A * the op to Nullop, we force an exit from the inner runops() 1N/A /* die caught by an inner eval - continue inner loop */ 1N/A /* a die in this eval - continue in outer loop */ 1N/A/* sv Text to convert to OP tree. */ 1N/A/* startop op_free() this to undo. */ 1N/A/* code Short string id of the caller. */ 1N/A dSP;
/* Make POPBLOCK work. */ 1N/A /* switch to eval mode */ 1N/A /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up 1N/A deleting the eval's FILEGV from the stash before gv_check() runs 1N/A (i.e. before run-time proper). To work around the coredump that 1N/A ensues, we always turn GvMULTI_on for any globals that were 1N/A introduced within evals. See force_ident(). GSAR 96-10-12 */ 1N/A /* we get here either during compilation, or via pp_regcomp at runtime */ 1N/A /* XXX DAPM do this properly one year */ 1N/A=for apidoc find_runcv 1N/ALocate the CV corresponding to the currently executing sub or eval. 1N/AIf db_seqp is non_null, skip CVs that are in the DB package and populate 1N/A*db_seqp with the cop sequence number at the point that the DB:: code was 1N/Aentered. (allows debuggers to eval in the scope of the breakpoint rather 1N/Athan in in the scope of the debuger itself). 1N/A /* skip DB:: code */ 1N/A * In the last case, startop is non-null, and contains the address of 1N/A * a pointer that should be set to the just-compiled code. 1N/A * outside is the lexically enclosing CV (if any) that invoked us. 1N/A/* With USE_5005THREADS, eval_owner must be held on entry to doeval */ 1N/A#
endif /* USE_5005THREADS */ 1N/A /* set up a scratch pad */ 1N/A /* make sure we compile in the right package */ 1N/A /* try to compile it */ 1N/A#
endif /* USE_5005THREADS */ 1N/A /* Set the context for this new optree. 1N/A * If the last op is an OP_REQUIRE, force scalar context. 1N/A * Otherwise, propagate the context from the eval(). */ 1N/A /* Register with debugger: */ 1N/A /* compiled okay, so do it */ 1N/A#
endif /* USE_5005THREADS */ 1N/A#
endif /* !PERL_DISABLE_PMC */ 1N/A /* help out with the "use 5.6" confusion */ 1N/A "this is only v%d.%d.%d, stopped",
1N/A "this is only v%d.%d.%d, stopped",
1N/A /* prepare to compile file */ 1N/A /* reading from a child process doesn't 1N/A nest -- when returning from reading 1N/A the inner module, the outer one is 1N/A unreadable (closed?) I've tried to 1N/A save the gv to manage the lifespan of 1N/A the pipe, but this didn't help. XXX */ 1N/A /* We consider paths of the form :a:b ambiguous and interpret them first 1N/A as global then as local 1N/A /* Assume success here to prevent recursive requirement. */ 1N/A /* Check whether a hook in @INC has already filled %INC */ 1N/A /* switch to eval mode */ 1N/A#
endif /* USE_5005THREADS */ 1N/A /* Store and reset encoding. */ 1N/A /* Restore encoding. */ 1N/A /* switch to eval mode */ 1N/A /* XXX For C<eval "...">s within BEGIN {} blocks, this ends up 1N/A deleting the eval's FILEGV from the stash before gv_check() runs 1N/A (i.e. before run-time proper). To work around the coredump that 1N/A ensues, we always turn GvMULTI_on for any globals that were 1N/A introduced within evals. See force_ident(). GSAR 96-10-12 */ 1N/A /* special case: an eval '' executed within the DB package gets lexically 1N/A * placed in the first non-DB CV rather than the current CV - this 1N/A * allows the debugger to execute code, find lexicals etc, in the 1N/A * scope of the code being debugged. Passing &seq gets find_runcv 1N/A * to do the dirty work for us */ 1N/A /* prepare to compile string */ 1N/A#
endif /* USE_5005THREADS */ 1N/A /* in case LEAVE wipes old return values */ 1N/A /* Unassume the success we assumed earlier. */ 1N/A /* die_where() did LEAVE, or we won't be here */ 1N/A /* in case LEAVE wipes old return values */ 1N/A int maxops =
12;
/* FF_LINEMARK + FF_END + 10 (\0 without preceding \n) */ 1N/A /* estimate the buffer size needed */ 1N/A if (*s ==
'\n' || *s ==
'@' || *s ==
'^')
1N/A case ' ':
case '\t':
1N/A }
/* else FALL THROUGH */ 1N/A *
fpc++ =
2;
/* skip the @* or ^* */ 1N/A else if (*s ==
'#' || (*s ==
'.' && s[
1] ==
'#')) {
1N/A else if (*s ==
'0' && s[
1] ==
'#') {
/* Zero padded decimals */ 1N/A s++;
/* skip the '0' first */ 1N/A while (*++s ==
'>') ;
1N/A else if (*s ==
'|') {
1N/A while (*++s ==
'|') ;
1N/A while (*++s ==
'<') ;
1N/A if (*s ==
'.' && s[
1] ==
'.' && s[
2] ==
'.') {
1N/A {
/* need to jump to the next word */ 1N/A DIE(
aTHX_ "Repeated format line will never terminate (~~ and @#)");
1N/A /* Can value be printed in fldsize chars, using %*.*f ? */ 1N/A /* I was having segfault trouble under Linux 2.2.5 after a 1N/A parse error occured. (Had to hack around it with a test 1N/A for PL_error_count == 0.) Solaris doesn't segfault -- 1N/A not sure where the trouble is yet. XXX */ 1N/A/* perhaps someone can come up with a better name for 1N/A this? it is not really "absolute", per se ... */