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 d5bb802..ed64242 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1490,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;
@@ -1949,6 +1899,8 @@ PP(pp_return)
                                     * 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
@@ -1957,8 +1909,16 @@ PP(pp_return)
     if (cxix < cxstack_ix)
        dounwind(cxix);
 
-    if (CxMULTICALL(&cxstack[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)) {
@@ -2756,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;
@@ -2768,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);
@@ -2796,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;
@@ -3351,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);
@@ -3427,7 +3390,7 @@ PP(pp_entereval)
     CV* runcv;
     U32 seq;
 
-    if (!SvPV_const(sv,len))
+    if (!SvPV_nolen_const(sv))
        RETPUSHUNDEF;
     TAINT_PROPER("eval");
 
@@ -3455,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);