make regen for the IBM/CRAY fp

[perl5.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index d7fa3d2..ee908c5 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -130,7 +130,7 @@ PP(pp_sassign)
     */
     SV *left = POPs; SV *right = TOPs;
 
-    if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
+    if (PL_op->op_private & OPpASSIGN_BACKWARDS) { /* {or,and,dor}assign */
        SV * const temp = left;
        left = right; right = temp;
     }
@@ -284,8 +284,11 @@ PP(pp_concat)
     }
     else { /* $l .= $r   and   left == TARG */
        if (!SvOK(left)) {
-           if (left == right && ckWARN(WARN_UNINITIALIZED)) /* $l .= $l */
-               report_uninit(right);
+            if ((left == right                          /* $l .= $l */
+                 || (PL_op->op_private & OPpTARGET_MY)) /* $l = $l . $r */
+                && ckWARN(WARN_UNINITIALIZED)
+                )
+                report_uninit(left);
            sv_setpvs(left, "");
        }
         else {
@@ -379,7 +382,8 @@ PP(pp_padrange)
                     | (count << SAVE_TIGHT_SHIFT)
                     | SAVEt_CLEARPADRANGE);
         STATIC_ASSERT_STMT(OPpPADRANGE_COUNTMASK + 1 == (1 << OPpPADRANGE_COUNTSHIFT));
-        assert((payload >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)) == base);
+        assert((payload >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT))
+                == (Size_t)base);
         {
             dSS_ADD;
             SS_ADD_UV(payload);
@@ -816,13 +820,30 @@ PP(pp_aelemfast)
     AV * const av = PL_op->op_type == OP_AELEMFAST_LEX
        ? MUTABLE_AV(PAD_SV(PL_op->op_targ)) : GvAVn(cGVOP_gv);
     const U32 lval = PL_op->op_flags & OPf_MOD;
-    SV** const svp = av_fetch(av, (I8)PL_op->op_private, lval);
-    SV *sv = (svp ? *svp : &PL_sv_undef);
+    const I8 key   = (I8)PL_op->op_private;
+    SV** svp;
+    SV *sv;
 
-    if (UNLIKELY(!svp && lval))
-        DIE(aTHX_ PL_no_aelem, (int)(I8)PL_op->op_private);
+    assert(SvTYPE(av) == SVt_PVAV);
 
     EXTEND(SP, 1);
+
+    /* inlined av_fetch() for simple cases ... */
+    if (!SvRMAGICAL(av) && key >= 0 && key <= AvFILLp(av)) {
+        sv = AvARRAY(av)[key];
+        if (sv) {
+            PUSHs(sv);
+            RETURN;
+        }
+    }
+
+    /* ... else do it the hard way */
+    svp = av_fetch(av, key, lval);
+    sv = (svp ? *svp : &PL_sv_undef);
+
+    if (UNLIKELY(!svp && lval))
+        DIE(aTHX_ PL_no_aelem, (int)key);
+
     if (!lval && SvRMAGICAL(av) && SvGMAGICAL(sv)) /* see note in pp_helem() */
        mg_get(sv);
     PUSHs(sv);
@@ -839,25 +860,6 @@ PP(pp_join)
     RETURN;
 }
 
-PP(pp_pushre)
-{
-    dSP;
-#ifdef DEBUGGING
-    /*
-     * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
-     * will be enough to hold an OP*.
-     */
-    SV* const sv = sv_newmortal();
-    sv_upgrade(sv, SVt_PVLV);
-    LvTYPE(sv) = '/';
-    Copy(&PL_op, &LvTARGOFF(sv), 1, OP*);
-    XPUSHs(sv);
-#else
-    XPUSHs(MUTABLE_SV(PL_op));
-#endif
-    RETURN;
-}
-
 /* Oversized hot code. */
 
 /* also used for: pp_say() */
@@ -2991,10 +2993,7 @@ PP(pp_subst)
        if (DO_UTF8(TARG) && !doutf8) {
             nsv = sv_newmortal();
             SvSetSV(nsv, dstr);
-            if (IN_ENCODING)
-                 sv_recode_to_utf8(nsv, _get_encoding());
-            else
-                 sv_utf8_upgrade(nsv);
+            sv_utf8_upgrade(nsv);
             c = SvPV_const(nsv, clen);
             doutf8 = TRUE;
        }
@@ -3173,13 +3172,7 @@ PP(pp_subst)
              first = FALSE;
            }
            else {
-               if (IN_ENCODING) {
-                   if (!nsv) nsv = sv_newmortal();
-                   sv_copypv(nsv, repl);
-                   if (!DO_UTF8(nsv)) sv_recode_to_utf8(nsv, _get_encoding());
-                   sv_catsv(dstr, nsv);
-               }
-               else sv_catsv(dstr, repl);
+               sv_catsv(dstr, repl);
                if (UNLIKELY(SvTAINTED(repl)))
                    rxtainted |= SUBST_TAINT_REPL;
            }
@@ -3623,6 +3616,8 @@ Perl_leave_adjust_stacks(pTHX_ SV **from_sp, SV **to_sp, U8 gimme, int pass)
 }
 
 
+/* also tail-called by pp_return */
+
 PP(pp_leavesub)
 {
     U8 gimme;
@@ -3804,7 +3799,10 @@ PP(pp_entersub)
        else {
           try_autoload:
            autogv = gv_autoload_pvn(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
-                                  GvNAMEUTF8(gv) ? SVf_UTF8 : 0);
+                                     (GvNAMEUTF8(gv) ? SVf_UTF8 : 0)
+                                    |(PL_op->op_flags & OPf_REF
+                                       ? GV_AUTOLOAD_ISMETHOD
+                                       : 0));
             cv = autogv ? GvCV(autogv) : NULL;
        }
        if (!cv) {
@@ -4010,6 +4008,28 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
     }
 }
 
+
+
+/* like croak, but report in context of caller */
+
+void
+Perl_croak_caller(const char *pat, ...)
+{
+    dTHX;
+    va_list args;
+    const PERL_CONTEXT *cx = caller_cx(0, NULL);
+
+    /* make error appear at call site */
+    assert(cx);
+    PL_curcop = cx->blk_oldcop;
+
+    va_start(args, pat);
+    vcroak(pat, &args);
+    NOT_REACHED; /* NOTREACHED */
+    va_end(args);
+}
+
+
 PP(pp_aelem)
 {
     dSP;