cleaner logic in op.c, also avoids QNX optimizer bug (from Norton

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

diff --git a/op.c b/op.c
index d6a16db..3d70756 100644 (file)
--- a/op.c
+++ b/op.c
@@ -159,7 +159,7 @@ Perl_pad_allocmy(pTHX_ char *name)
            }
        }
        if (PL_in_my == KEY_our) {
-           while (off <= top) {
+           do {
                if ((sv = svp[off])
                    && sv != &PL_sv_undef
                    && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
@@ -171,8 +171,7 @@ Perl_pad_allocmy(pTHX_ char *name)
                        "(Did you mean \"local\" instead of \"our\"?)\n");
                    break;
                }
-               --off;
-           }
+           } while ( off-- > 0 );
        }
     }
     off = pad_alloc(OP_PADSV, SVs_PADMY);
@@ -356,8 +355,9 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
                if (CxREALEVAL(cx))
                    saweval = i;
                break;
+           case OP_DOFILE:
            case OP_REQUIRE:
-               /* require must have its own scope */
+               /* require/do must have their own scope */
                return 0;
            }
            break;
@@ -1821,7 +1821,6 @@ S_dup_attrlist(pTHX_ OP *o)
 STATIC void
 S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
 {
-    OP *modname;       /* for 'use' */
     SV *stashsv;
 
     /* fake up C<use attributes $pkg,$rv,@attrs> */
@@ -1831,19 +1830,18 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
        stashsv = newSVpv(HvNAME(stash), 0);
     else
        stashsv = &PL_sv_no;
+
 #define ATTRSMODULE "attributes"
-    modname = newSVOP(OP_CONST, 0,
-                     newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1));
-    modname->op_private |= OPpCONST_BARE;
-    /* that flag is required to make 'use' work right */
-    utilize(1, start_subparse(FALSE, 0),
-           Nullop, /* version */
-           modname,
-           prepend_elem(OP_LIST,
-                        newSVOP(OP_CONST, 0, stashsv),
-                        prepend_elem(OP_LIST,
-                                     newSVOP(OP_CONST, 0, newRV(target)),
-                                     dup_attrlist(attrs))));
+
+    Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
+                    newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1),
+                    Nullsv,
+                    prepend_elem(OP_LIST,
+                                 newSVOP(OP_CONST, 0, stashsv),
+                                 prepend_elem(OP_LIST,
+                                              newSVOP(OP_CONST, 0,
+                                                      newRV(target)),
+                                              dup_attrlist(attrs))));
     LEAVE;
 }
 
@@ -3175,6 +3173,58 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     PL_expect = XSTATE;
 }
 
+void
+Perl_load_module(pTHX_ U32 flags, SV *name, SV *ver, ...)
+{
+    va_list args;
+    va_start(args, ver);
+    vload_module(flags, name, ver, &args);
+    va_end(args);
+}
+
+#ifdef PERL_IMPLICIT_CONTEXT
+void
+Perl_load_module_nocontext(U32 flags, SV *name, SV *ver, ...)
+{
+    dTHX;
+    va_list args;
+    va_start(args, ver);
+    vload_module(flags, name, ver, &args);
+    va_end(args);
+}
+#endif
+
+void
+Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
+{
+    OP *modname, *veop, *imop;
+
+    modname = newSVOP(OP_CONST, 0, name);
+    modname->op_private |= OPpCONST_BARE;
+    if (ver) {
+       veop = newSVOP(OP_CONST, 0, ver);
+    }
+    else
+       veop = Nullop;
+    if (flags & PERL_LOADMOD_NOIMPORT) {
+       imop = sawparens(newNULLLIST());
+    }
+    else if (flags & PERL_LOADMOD_IMPORT_OPS) {
+       imop = va_arg(*args, OP*);
+    }
+    else {
+       SV *sv;
+       imop = Nullop;
+       sv = va_arg(*args, SV*);
+       while (sv) {
+           imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
+           sv = va_arg(*args, SV*);
+       }
+    }
+    utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+           veop, modname, imop);
+}
+
 OP *
 Perl_dofile(pTHX_ OP *term)
 {
@@ -5510,11 +5560,10 @@ Perl_ck_glob(pTHX_ OP *o)
 #if !defined(PERL_EXTERNAL_GLOB)
     /* XXX this can be tightened up and made more failsafe. */
     if (!gv) {
-       OP *modname = newSVOP(OP_CONST, 0, newSVpvn("File::Glob", 10));
-       modname->op_private |= OPpCONST_BARE;
        ENTER;
-       utilize(1, start_subparse(FALSE, 0), Nullop, modname,
-               newSVOP(OP_CONST, 0, newSVpvn(":globally", 9)));
+       Perl_load_module(aTHX_ 0, newSVpvn("File::Glob", 10), Nullsv,
+                        /* null-terminated import list */
+                        newSVpvn(":globally", 9), Nullsv);
        gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
        LEAVE;
     }
@@ -5786,6 +5835,36 @@ Perl_ck_null(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_open(pTHX_ OP *o)
+{
+    HV *table = GvHV(PL_hintgv);
+    if (table) {
+       SV **svp;
+       I32 mode;
+       svp = hv_fetch(table, "open_IN", 7, FALSE);
+       if (svp && *svp) {
+           mode = mode_from_discipline(*svp);
+           if (mode & O_BINARY)
+               o->op_private |= OPpOPEN_IN_RAW;
+           else if (mode & O_TEXT)
+               o->op_private |= OPpOPEN_IN_CRLF;
+       }
+
+       svp = hv_fetch(table, "open_OUT", 8, FALSE);
+       if (svp && *svp) {
+           mode = mode_from_discipline(*svp);
+           if (mode & O_BINARY)
+               o->op_private |= OPpOPEN_OUT_RAW;
+           else if (mode & O_TEXT)
+               o->op_private |= OPpOPEN_OUT_CRLF;
+       }
+    }
+    if (o->op_type == OP_BACKTICK)
+       return o;
+    return ck_fun(o);
+}
+
+OP *
 Perl_ck_repeat(pTHX_ OP *o)
 {
     if (cBINOPo->op_first->op_flags & OPf_PARENS) {
@@ -5812,7 +5891,13 @@ Perl_ck_require(pTHX_ OP *o)
                    --SvCUR(kid->op_sv);
                }
            }
-           sv_catpvn(kid->op_sv, ".pm", 3);
+           if (SvREADONLY(kid->op_sv)) {
+               SvREADONLY_off(kid->op_sv);
+               sv_catpvn(kid->op_sv, ".pm", 3);
+               SvREADONLY_on(kid->op_sv);
+           }
+           else
+               sv_catpvn(kid->op_sv, ".pm", 3);
        }
     }
     return ck_fun(o);
@@ -6304,19 +6389,16 @@ Perl_peep(pTHX_ register OP *o)
                o->op_targ = ix;
            }
 #endif
-           /* FALL THROUGH */
-       case OP_UC:
-       case OP_UCFIRST:
-       case OP_LC:
-       case OP_LCFIRST:
+           o->op_seq = PL_op_seqmax++;
+           break;
+
        case OP_CONCAT:
-       case OP_JOIN:
-       case OP_QUOTEMETA:
            if (o->op_next && o->op_next->op_type == OP_STRINGIFY) {
                if (o->op_next->op_private & OPpTARGET_MY) {
                    if (o->op_flags & OPf_STACKED) /* chained concats */
                        goto ignore_optimization;
                    else {
+                       /* assert(PL_opargs[o->op_type] & OA_TARGLEX); */
                        o->op_targ = o->op_next->op_targ;
                        o->op_next->op_targ = 0;
                        o->op_private |= OPpTARGET_MY;