This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make regen for the IBM/CRAY fp
[perl5.git] / pp_hot.c
index ca90c1e..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;
     }
@@ -382,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);
@@ -830,7 +831,7 @@ PP(pp_aelemfast)
     /* inlined av_fetch() for simple cases ... */
     if (!SvRMAGICAL(av) && key >= 0 && key <= AvFILLp(av)) {
         sv = AvARRAY(av)[key];
-        if (sv && !SvIS_FREED(sv)) {
+        if (sv) {
             PUSHs(sv);
             RETURN;
         }
@@ -859,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() */
@@ -3011,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;
        }
@@ -3193,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;
            }
@@ -3826,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) {
@@ -4032,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;