sv_clear can manipulate the arena array directly too.

[p5sagit/p5-mst-13.2.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index fd1bccd..ed64242 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -60,11 +60,6 @@ PP(pp_wantarray)
     }
 }
 
-PP(pp_regcmaybe)
-{
-    return NORMAL;
-}
-
 PP(pp_regcreset)
 {
     /* XXXX Should store the old value to allow for tie/overload - and
@@ -940,11 +935,6 @@ PP(pp_grepstart)
     return ((LOGOP*)PL_op->op_next)->op_other;
 }
 
-PP(pp_mapstart)
-{
-    DIE(aTHX_ "panic: mapstart");      /* uses grepstart */
-}
-
 PP(pp_mapwhile)
 {
     dVAR; dSP;
@@ -1500,56 +1490,6 @@ PP(pp_xor)
        RETSETNO;
 }
 
-PP(pp_andassign)
-{
-    dSP;
-    if (!SvTRUE(TOPs))
-       RETURN;
-    else
-       RETURNOP(cLOGOP->op_other);
-}
-
-PP(pp_orassign)
-{
-    dSP;
-    if (SvTRUE(TOPs))
-       RETURN;
-    else
-       RETURNOP(cLOGOP->op_other);
-}
-
-PP(pp_dorassign)
-{
-    dSP;
-    register SV* sv;
-
-    sv = TOPs;
-    if (!sv || !SvANY(sv)) {
-       RETURNOP(cLOGOP->op_other);
-    }
-
-    switch (SvTYPE(sv)) {
-    case SVt_PVAV:
-       if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-           RETURN;
-       break;
-    case SVt_PVHV:
-       if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-           RETURN;
-       break;
-    case SVt_PVCV:
-       if (CvROOT(sv) || CvXSUB(sv))
-           RETURN;
-       break;
-    default:
-       SvGETMAGIC(sv);
-       if (SvOK(sv))
-           RETURN;
-    }
-
-    RETURNOP(cLOGOP->op_other);
-}
-
 PP(pp_caller)
 {
     dSP;
@@ -1729,11 +1669,6 @@ PP(pp_reset)
     RETURN;
 }
 
-PP(pp_lineseq)
-{
-    return NORMAL;
-}
-
 /* like pp_nextstate, but used instead when the debugger is active */
 
 PP(pp_dbstate)
@@ -1795,11 +1730,6 @@ PP(pp_dbstate)
        return NORMAL;
 }
 
-PP(pp_scope)
-{
-    return NORMAL;
-}
-
 PP(pp_enteriter)
 {
     dVAR; dSP; dMARK;
@@ -1963,24 +1893,33 @@ PP(pp_return)
     SV *sv;
     OP *retop;
 
-    if (PL_curstackinfo->si_type == PERLSI_SORT) {
-       if (cxstack_ix == PL_sortcxix
-           || dopoptosub(cxstack_ix) <= PL_sortcxix)
-       {
-           if (cxstack_ix > PL_sortcxix)
-               dounwind(PL_sortcxix);
-           AvARRAY(PL_curstack)[1] = *SP;
+    cxix = dopoptosub(cxstack_ix);
+    if (cxix < 0) {
+       if (CxMULTICALL(cxstack)) { /* In this case we must be in a
+                                    * sort block, which is a CXt_NULL
+                                    * not a CXt_SUB */
+           dounwind(0);
+           PL_stack_base[1] = *PL_stack_sp;
            PL_stack_sp = PL_stack_base + 1;
            return 0;
        }
+       else
+           DIE(aTHX_ "Can't return outside a subroutine");
     }
-
-    cxix = dopoptosub(cxstack_ix);
-    if (cxix < 0)
-       DIE(aTHX_ "Can't return outside a subroutine");
     if (cxix < cxstack_ix)
        dounwind(cxix);
 
+    if (CxMULTICALL(&cxstack[cxix])) {
+       gimme = cxstack[cxix].blk_gimme;
+       if (gimme == G_VOID)
+           PL_stack_sp = PL_stack_base;
+       else if (gimme == G_SCALAR) {
+           PL_stack_base[1] = *PL_stack_sp;
+           PL_stack_sp = PL_stack_base + 1;
+       }
+       return 0;
+    }
+
     POPBLOCK(cx,newpm);
     switch (CxTYPE(cx)) {
     case CXt_SUB:
@@ -2269,12 +2208,6 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
     return 0;
 }
 
-PP(pp_dump)
-{
-    return pp_goto();
-    /*NOTREACHED*/
-}
-
 PP(pp_goto)
 {
     dVAR; dSP;
@@ -2337,6 +2270,8 @@ PP(pp_goto)
                else
                    DIE(aTHX_ "Can't goto subroutine from an eval-block");
            }
+           else if (CxMULTICALL(cx))
+               DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)");
            if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
                /* put @_ back onto stack */
                AV* av = cx->blk_sub.argarray;
@@ -2549,7 +2484,7 @@ PP(pp_goto)
                    gotoprobe = PL_main_root;
                break;
            case CXt_SUB:
-               if (CvDEPTH(cx->blk_sub.cv)) {
+               if (CvDEPTH(cx->blk_sub.cv) && !CxMULTICALL(cx)) {
                    gotoprobe = CvROOT(cx->blk_sub.cv);
                    break;
                }
@@ -2781,6 +2716,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
 /* startop op_free() this to undo. */
 /* code Short string id of the caller. */
 {
+    /* FIXME - how much of this code is common with pp_entereval?  */
     dVAR; dSP;                         /* Make POPBLOCK work. */
     PERL_CONTEXT *cx;
     SV **newsp;
@@ -2793,6 +2729,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     char *safestr;
     int runtime;
     CV* runcv = Nullcv;        /* initialise to avoid compiler warnings */
+    STRLEN len;
 
     ENTER;
     lex_start(sv);
@@ -2821,8 +2758,9 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
        (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 */
-    safestr = savepv(tmpbuf);
-    SAVEDELETE(PL_defstash, safestr, strlen(safestr));
+    len = strlen(tmpbuf);
+    safestr = savepvn(tmpbuf, len);
+    SAVEDELETE(PL_defstash, safestr, len);
     SAVEHINTS();
 #ifdef OP_IN_REGISTER
     PL_opsave = op;
@@ -3376,7 +3314,7 @@ PP(pp_require)
        SETERRNO(0, SS_NORMAL);
 
     /* Assume success here to prevent recursive requirement. */
-    len = strlen(name);
+    /* name is never assigned to again, so len is still strlen(name)  */
     /* Check whether a hook in @INC has already filled %INC */
     if (!hook_sv) {
        (void)hv_store(GvHVn(PL_incgv), name, len, newSVpv(CopFILE(&PL_compiling),0),0);
@@ -3437,11 +3375,6 @@ PP(pp_require)
     return op;
 }
 
-PP(pp_dofile)
-{
-    return pp_require();
-}
-
 PP(pp_entereval)
 {
     dVAR; dSP;
@@ -3457,7 +3390,7 @@ PP(pp_entereval)
     CV* runcv;
     U32 seq;
 
-    if (!SvPV_const(sv,len))
+    if (!SvPV_nolen_const(sv))
        RETPUSHUNDEF;
     TAINT_PROPER("eval");
 
@@ -3485,8 +3418,9 @@ PP(pp_entereval)
        (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 */
-    safestr = savepv(tmpbuf);
-    SAVEDELETE(PL_defstash, safestr, strlen(safestr));
+    len = strlen(tmpbuf);
+    safestr = savepvn(tmpbuf, len);
+    SAVEDELETE(PL_defstash, safestr, len);
     SAVEHINTS();
     PL_hints = PL_op->op_targ;
     SAVESPTR(PL_compiling.cop_warnings);