From fecade69c526caa9c157a2405486b9089047fc72 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Thu, 19 Jan 2023 14:11:28 +0000 Subject: eval_sv(): call pp_entereval() via runops Like the previous commit which did it for amagic_call() and call_sv(), this commit makes executing the faked-up OP_ENTEREVAL be executed as part of the runops loop rather than as a separate call. This is to allow shortly fixing up for a reference-counted stack. (CALLRUNOPS() will reify the stack if necessary, while the raw call to pp_entereval() won't fix up the stack unless its part of the runops loop too.) However, this is a bit more complex than call_sv() etc in that there is a good reason for calling pp_entereval() separately. The faked up OP_ENTEREVAL has its op_next set to NULL - this is the op which would normally be returned on failure of the eval compilation. By seeing whether the retuned value from pp_entereval() is NULL or not, eval_sv() can tell whether compilation failed. On the other hand, if pp_entereval() was made to be called as part of the runops loop, then the runops loop *always* finishes with PL_op set to NULL. So we can no lo longer distinguish between compile-failed and compile-succeeded-and-eval-ran-to-completion. This commit moves the entereval into the runops loop, but restores the ability to distinguish in a slightly hacky way. It adds a new private flag for OP_ENTEREVAL - OPpEVAL_EVALSV - which indicates to pp_entereval() that it was called from eval_sv(). And of course eval_sv() sets this flag on the OPpEVAL_EVALSV op it fakes up. If pp_entereval() fails to compile, then if that flag is set, it pushes a null pointer onto the argument stack before returning. Thus by checking whether *PL_stack_sp is NULL or not on return from CALLRUNOPS(), eval_sv() regains the ability to distinguish the two cases. --- perl.c | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) (limited to 'perl.c') diff --git a/perl.c b/perl.c index dc40aa04ad..ad941061bb 100644 --- a/perl.c +++ b/perl.c @@ -3226,6 +3226,9 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) SAVEOP(); PL_op = (OP*)&myop; Zero(&myop, 1, UNOP); + myop.op_ppaddr = PL_ppaddr[OP_ENTEREVAL]; + myop.op_type = OP_ENTEREVAL; + { dSP; oldmark = SP - PL_stack_base; @@ -3241,8 +3244,9 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) if (flags & G_KEEPERR) myop.op_flags |= OPf_SPECIAL; + myop.op_private = (OPpEVAL_EVALSV); /* tell pp_entereval we're the caller */ if (flags & G_RE_REPARSING) - myop.op_private = (OPpEVAL_COPHH | OPpEVAL_RE_REPARSING); + myop.op_private |= (OPpEVAL_COPHH | OPpEVAL_RE_REPARSING); /* fail now; otherwise we could fail after the JMPENV_PUSH but * before a cx_pusheval(), which corrupts the stack after a croak */ @@ -3251,13 +3255,15 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) JMPENV_PUSH(ret); switch (ret) { case 0: - redo_body: - if (PL_op == (OP*)(&myop)) { - PL_op = PL_ppaddr[OP_ENTEREVAL](aTHX); - if (!PL_op) - goto fail; /* failed in compilation */ - } CALLRUNOPS(aTHX); + if (!*PL_stack_sp) { + /* In the presence of the OPpEVAL_EVALSV flag, + * pp_entereval() pushes a NULL pointer onto the stack to + * indicate compilation failure */ + PL_stack_sp--; + goto fail; + } + redone_body: retval = PL_stack_sp - (PL_stack_base + oldmark); if (!(flags & G_KEEPERR)) { CLEAR_ERRSV(); @@ -3278,14 +3284,19 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) PL_restartjmpenv = NULL; PL_op = PL_restartop; PL_restartop = 0; - goto redo_body; + CALLRUNOPS(aTHX); + goto redone_body; } fail: if (flags & G_RETHROW) { JMPENV_POP; croak_sv(ERRSV); } - + /* Should be nothing left in stack frame apart from a possible + * scalar context undef. Assert it's safe to reset the stack */ + assert( PL_stack_sp == PL_stack_base + oldmark + || (PL_stack_sp == PL_stack_base + oldmark + 1 + && *PL_stack_sp == &PL_sv_undef)); PL_stack_sp = PL_stack_base + oldmark; if ((flags & G_WANT) == G_LIST) retval = 0; -- cgit v1.2.1