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.

1 files changed, 20 insertions, 9 deletions

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;