This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5337delta: note that stadtx was removed
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 07a60f6..594d4ee 100644 (file)
--- a/op.c
+++ b/op.c
@@ -207,7 +207,10 @@ S_prune_chain_head(OP** op_p)
 
 /* rounds up to nearest pointer */
 #define SIZE_TO_PSIZE(x)       (((x) + sizeof(I32 *) - 1)/sizeof(I32 *))
-#define DIFF(o,p)              ((size_t)((I32 **)(p) - (I32**)(o)))
+
+#define DIFF(o,p)      \
+    (assert(((char *)(p) - (char *)(o)) % sizeof(I32**) == 0), \
+      ((size_t)((I32 **)(p) - (I32**)(o))))
 
 /* requires double parens and aTHX_ */
 #define DEBUG_S_warn(args)                                            \
@@ -215,20 +218,29 @@ S_prune_chain_head(OP** op_p)
        PerlIO_printf(Perl_debug_log, "%s", SvPVx_nolen(Perl_mess args)) \
     )
 
+/* opslot_size includes the size of the slot header, and an op can't be smaller than BASEOP */
+#define OPSLOT_SIZE_BASE (SIZE_TO_PSIZE(sizeof(OPSLOT)))
+
+/* the number of bytes to allocate for a slab with sz * sizeof(I32 **) space for op */
+#define OpSLABSizeBytes(sz) \
+    ((sz) * sizeof(I32 *) + STRUCT_OFFSET(OPSLAB, opslab_slots))
 
 /* malloc a new op slab (suitable for attaching to PL_compcv).
- * sz is in units of pointers */
+ * sz is in units of pointers from the beginning of opslab_opslots */
 
 static OPSLAB *
 S_new_slab(pTHX_ OPSLAB *head, size_t sz)
 {
     OPSLAB *slab;
+    size_t sz_bytes = OpSLABSizeBytes(sz);
 
     /* opslot_offset is only U16 */
-    assert(sz  < U16_MAX);
+    assert(sz < U16_MAX);
+    /* room for at least one op */
+    assert(sz >= OPSLOT_SIZE_BASE);
 
 #ifdef PERL_DEBUG_READONLY_OPS
-    slab = (OPSLAB *) mmap(0, sz * sizeof(I32 *),
+    slab = (OPSLAB *) mmap(0, sz_bytes,
                                   PROT_READ|PROT_WRITE,
                                   MAP_ANON|MAP_PRIVATE, -1, 0);
     DEBUG_m(PerlIO_printf(Perl_debug_log, "mapped %lu at %p\n",
@@ -238,7 +250,8 @@ S_new_slab(pTHX_ OPSLAB *head, size_t sz)
        abort();
     }
 #else
-    slab = (OPSLAB *)PerlMemShared_calloc(sz, sizeof(I32 *));
+    slab = (OPSLAB *)PerlMemShared_malloc(sz_bytes);
+    Zero(slab, sz_bytes, char);
 #endif
     slab->opslab_size = (U16)sz;
 
@@ -246,7 +259,7 @@ S_new_slab(pTHX_ OPSLAB *head, size_t sz)
     /* The context is unused in non-Windows */
     PERL_UNUSED_CONTEXT;
 #endif
-    slab->opslab_free_space = sz - DIFF(slab, &slab->opslab_slots);
+    slab->opslab_free_space = sz;
     slab->opslab_head = head ? head : slab;
     DEBUG_S_warn((aTHX_ "allocated new op slab sz 0x%x, %p, head slab %p",
         (unsigned int)slab->opslab_size, (void*)slab,
@@ -254,6 +267,44 @@ S_new_slab(pTHX_ OPSLAB *head, size_t sz)
     return slab;
 }
 
+#define OPSLOT_SIZE_TO_INDEX(sz) ((sz) - OPSLOT_SIZE_BASE)
+
+#define link_freed_op(slab, o) S_link_freed_op(aTHX_ slab, o)
+static void
+S_link_freed_op(pTHX_ OPSLAB *slab, OP *o) {
+    U16 sz = OpSLOT(o)->opslot_size;
+    U16 index = OPSLOT_SIZE_TO_INDEX(sz);
+
+    assert(sz >= OPSLOT_SIZE_BASE);
+    /* make sure the array is large enough to include ops this large */
+    if (!slab->opslab_freed) {
+        /* we don't have a free list array yet, make a new one */
+        slab->opslab_freed_size = index+1;
+        slab->opslab_freed = (OP**)PerlMemShared_calloc((slab->opslab_freed_size), sizeof(OP*));
+
+        if (!slab->opslab_freed)
+            croak_no_mem();
+    }
+    else if (index >= slab->opslab_freed_size) {
+        /* It's probably not worth doing exponential expansion here, the number of op sizes
+           is small.
+        */
+        /* We already have a list that isn't large enough, expand it */
+        size_t newsize = index+1;
+        OP **p = (OP **)PerlMemShared_realloc(slab->opslab_freed, newsize * sizeof(OP*));
+
+        if (!p)
+            croak_no_mem();
+
+        Zero(p+slab->opslab_freed_size, newsize - slab->opslab_freed_size, OP *);
+
+        slab->opslab_freed = p;
+        slab->opslab_freed_size = newsize;
+    }
+
+    o->op_next = slab->opslab_freed[index];
+    slab->opslab_freed[index] = o;
+}
 
 /* Returns a sz-sized block of memory (suitable for holding an op) from
  * a free slot in the chain of op slabs attached to PL_compcv.
@@ -268,7 +319,7 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
     OPSLAB *slab2;
     OPSLOT *slot;
     OP *o;
-    size_t opsz;
+    size_t sz_in_p; /* size in pointer units, including the OPSLOT header */
 
     /* We only allocate ops from the slab during subroutine compilation.
        We find the slab via PL_compcv, hence that must be non-NULL. It could
@@ -297,39 +348,36 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
     }
     else ++(head_slab = (OPSLAB *)CvSTART(PL_compcv))->opslab_refcnt;
 
-    opsz = SIZE_TO_PSIZE(sz);
-    sz = opsz + OPSLOT_HEADER_P;
+    sz_in_p = SIZE_TO_PSIZE(sz + OPSLOT_HEADER);
 
-    /* The slabs maintain a free list of OPs. In particular, constant folding
+    /* The head slab for each CV maintains a free list of OPs. In particular, constant folding
        will free up OPs, so it makes sense to re-use them where possible. A
        freed up slot is used in preference to a new allocation.  */
-    if (head_slab->opslab_freed) {
-       OP **too = &head_slab->opslab_freed;
-       o = *too;
-        DEBUG_S_warn((aTHX_ "found free op at %p, slab %p, head slab %p",
-            (void*)o,
-            (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset,
-            (void*)head_slab));
-
-       while (o && OpSLOT(o)->opslot_size < sz) {
-           DEBUG_S_warn((aTHX_ "Alas! too small"));
-           o = *(too = &o->op_next);
-           if (o) { DEBUG_S_warn((aTHX_ "found another free op at %p", (void*)o)); }
-       }
-       if (o) {
+    if (head_slab->opslab_freed &&
+        OPSLOT_SIZE_TO_INDEX(sz_in_p) < head_slab->opslab_freed_size) {
+        U16 base_index;
+
+        /* look for a large enough size with any freed ops */
+        for (base_index = OPSLOT_SIZE_TO_INDEX(sz_in_p);
+             base_index < head_slab->opslab_freed_size && !head_slab->opslab_freed[base_index];
+             ++base_index) {
+        }
+
+        if (base_index < head_slab->opslab_freed_size) {
+            /* found a freed op */
+            o = head_slab->opslab_freed[base_index];
+
             DEBUG_S_warn((aTHX_ "realloced  op at %p, slab %p, head slab %p",
-                (void*)o,
-                (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset,
-                (void*)head_slab));
-           *too = o->op_next;
-           Zero(o, opsz, I32 *);
+                          (void *)o, (void *)OpMySLAB(o), (void *)head_slab));
+           head_slab->opslab_freed[base_index] = o->op_next;
+           Zero(o, sz, char);
            o->op_slabbed = 1;
            goto gotit;
        }
     }
 
 #define INIT_OPSLOT(s) \
-           slot->opslot_offset = DIFF(slab2, slot) ;   \
+           slot->opslot_offset = DIFF(&slab2->opslab_slots, slot) ;    \
            slot->opslot_size = s;                      \
            slab2->opslab_free_space -= s;              \
            o = &slot->opslot_op;                       \
@@ -337,16 +385,17 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
 
     /* The partially-filled slab is next in the chain. */
     slab2 = head_slab->opslab_next ? head_slab->opslab_next : head_slab;
-    if (slab2->opslab_free_space  < sz) {
+    if (slab2->opslab_free_space < sz_in_p) {
        /* Remaining space is too small. */
        /* If we can fit a BASEOP, add it to the free chain, so as not
           to waste it. */
-       if (slab2->opslab_free_space >= SIZE_TO_PSIZE(sizeof(OP)) + OPSLOT_HEADER_P) {
+       if (slab2->opslab_free_space >= OPSLOT_SIZE_BASE) {
            slot = &slab2->opslab_slots;
            INIT_OPSLOT(slab2->opslab_free_space);
            o->op_type = OP_FREED;
-           o->op_next = head_slab->opslab_freed;
-           head_slab->opslab_freed = o;
+            DEBUG_S_warn((aTHX_ "linked unused op space at %p, slab %p, head slab %p",
+                          (void *)o, (void *)slab2, (void *)head_slab));
+            link_freed_op(head_slab, o);
        }
 
        /* Create a new slab.  Make this one twice as big. */
@@ -357,14 +406,12 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
        slab2->opslab_next = head_slab->opslab_next;
        head_slab->opslab_next = slab2;
     }
-    assert(slab2->opslab_size >= sz);
+    assert(slab2->opslab_size >= sz_in_p);
 
     /* Create a new op slot */
-    slot = (OPSLOT *)
-                ((I32 **)&slab2->opslab_slots
-                                + slab2->opslab_free_space - sz);
+    slot = OpSLOToff(slab2, slab2->opslab_free_space - sz_in_p);
     assert(slot >= &slab2->opslab_slots);
-    INIT_OPSLOT(sz);
+    INIT_OPSLOT(sz_in_p);
     DEBUG_S_warn((aTHX_ "allocating op at %p, slab %p, head slab %p",
         (void*)o, (void*)slab2, (void*)head_slab));
 
@@ -388,9 +435,9 @@ Perl_Slab_to_ro(pTHX_ OPSLAB *slab)
     slab->opslab_readonly = 1;
     for (; slab; slab = slab->opslab_next) {
        /*DEBUG_U(PerlIO_printf(Perl_debug_log,"mprotect ->ro %lu at %p\n",
-                             (unsigned long) slab->opslab_size, slab));*/
-       if (mprotect(slab, slab->opslab_size * sizeof(I32 *), PROT_READ))
-           Perl_warn(aTHX_ "mprotect for %p %lu failed with %d", slab,
+                             (unsigned long) slab->opslab_size, (void *)slab));*/
+       if (mprotect(slab, OpSLABSizeBytes(slab->opslab_size), PROT_READ))
+           Perl_warn(aTHX_ "mprotect for %p %lu failed with %d", (void *)slab,
                             (unsigned long)slab->opslab_size, errno);
     }
 }
@@ -406,10 +453,10 @@ Perl_Slab_to_rw(pTHX_ OPSLAB *const slab)
     slab2 = slab;
     for (; slab2; slab2 = slab2->opslab_next) {
        /*DEBUG_U(PerlIO_printf(Perl_debug_log,"mprotect ->rw %lu at %p\n",
-                             (unsigned long) size, slab2));*/
-       if (mprotect((void *)slab2, slab2->opslab_size * sizeof(I32 *),
+                             (unsigned long) size, (void *)slab2));*/
+       if (mprotect((void *)slab2, OpSLABSizeBytes(slab2->opslab_size),
                     PROT_READ|PROT_WRITE)) {
-           Perl_warn(aTHX_ "mprotect RW for %p %lu failed with %d", slab,
+           Perl_warn(aTHX_ "mprotect RW for %p %lu failed with %d", (void *)slab,
                             (unsigned long)slab2->opslab_size, errno);
        }
     }
@@ -463,12 +510,9 @@ Perl_Slab_Free(pTHX_ void *op)
     /* If this op is already freed, our refcount will get screwy. */
     assert(o->op_type != OP_FREED);
     o->op_type = OP_FREED;
-    o->op_next = slab->opslab_freed;
-    slab->opslab_freed = o;
+    link_freed_op(slab, o);
     DEBUG_S_warn((aTHX_ "freeing    op at %p, slab %p, head slab %p",
-        (void*)o,
-        (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset,
-        (void*)slab));
+        (void*)o, (void *)OpMySLAB(o), (void*)slab));
     OpslabREFCNT_dec_padok(slab);
 }
 
@@ -503,6 +547,7 @@ Perl_opslab_free(pTHX_ OPSLAB *slab)
     PERL_UNUSED_CONTEXT;
     DEBUG_S_warn((aTHX_ "freeing slab %p", (void*)slab));
     assert(slab->opslab_refcnt == 1);
+    PerlMemShared_free(slab->opslab_freed);
     do {
        slab2 = slab->opslab_next;
 #ifdef DEBUGGING
@@ -511,7 +556,7 @@ Perl_opslab_free(pTHX_ OPSLAB *slab)
 #ifdef PERL_DEBUG_READONLY_OPS
        DEBUG_m(PerlIO_printf(Perl_debug_log, "Deallocate slab at %p\n",
                                               (void*)slab));
-       if (munmap(slab, slab->opslab_size * sizeof(I32 *))) {
+       if (munmap(slab, OpSLABSizeBytes(slab->opslab_size))) {
            perror("munmap failed");
            abort();
        }
@@ -536,10 +581,8 @@ Perl_opslab_force_free(pTHX_ OPSLAB *slab)
     PERL_ARGS_ASSERT_OPSLAB_FORCE_FREE;
     slab2 = slab;
     do {
-        OPSLOT *slot = (OPSLOT*)
-                    ((I32**)&slab2->opslab_slots + slab2->opslab_free_space);
-        OPSLOT *end  = (OPSLOT*)
-                        ((I32**)slab2 + slab2->opslab_size);
+        OPSLOT *slot = OpSLOToff(slab2, slab2->opslab_free_space);
+        OPSLOT *end  = OpSLOToff(slab2, slab2->opslab_size);
        for (; slot < end;
                 slot = (OPSLOT*) ((I32**)slot + slot->opslot_size) )
         {
@@ -660,8 +703,6 @@ S_bad_type_pv(pTHX_ I32 n, const char *t, const OP *o, const OP *kid)
                 (int)n, PL_op_desc[(o)->op_type], t, OP_DESC(kid)), 0);
 }
 
-/* remove flags var, its unused in all callers, move to to right end since gv
-  and kid are always the same */
 STATIC void
 S_bad_type_gv(pTHX_ I32 n, GV *gv, const OP *kid, const char *t)
 {
@@ -683,12 +724,28 @@ S_no_bareword_allowed(pTHX_ OP *o)
     o->op_private &= ~OPpCONST_STRICT; /* prevent warning twice about the same OP */
 }
 
+void
+Perl_no_bareword_filehandle(pTHX_ const char *fhname) {
+    PERL_ARGS_ASSERT_NO_BAREWORD_FILEHANDLE;
+
+    if (strNE(fhname, "STDERR")
+        && strNE(fhname, "STDOUT")
+        && strNE(fhname, "STDIN")
+        && strNE(fhname, "_")
+        && strNE(fhname, "ARGV")
+        && strNE(fhname, "ARGVOUT")
+        && strNE(fhname, "DATA")) {
+        qerror(Perl_mess(aTHX_ "Bareword filehandle \"%s\" not allowed under 'no feature \"bareword_filehandles\"'", fhname));
+    }
+}
+
 /* "register" allocation */
 
 PADOFFSET
 Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
 {
     PADOFFSET off;
+    bool is_idfirst, is_default;
     const bool is_our = (PL_parser->in_my == KEY_our);
 
     PERL_ARGS_ASSERT_ALLOCMY;
@@ -697,21 +754,22 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
        Perl_croak(aTHX_ "panic: allocmy illegal flag bits 0x%" UVxf,
                   (UV)flags);
 
+    is_idfirst = flags & SVf_UTF8
+        ? isIDFIRST_utf8_safe((U8*)name + 1, name + len)
+        : isIDFIRST_A(name[1]);
+
+    /* $_, @_, etc. */
+    is_default = len == 2 && name[1] == '_';
+
     /* complain about "my $<special_var>" etc etc */
-    if (   len
-        && !(  is_our
-            || isALPHA(name[1])
-            || (   (flags & SVf_UTF8)
-                && isIDFIRST_utf8_safe((U8 *)name+1, name + len))
-            || (name[1] == '_' && len > 2)))
-    {
+    if (!is_our && (!is_idfirst || is_default)) {
         const char * const type =
               PL_parser->in_my == KEY_sigvar ? "subroutine signature" :
               PL_parser->in_my == KEY_state  ? "\"state\""     : "\"my\"";
 
        if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
         && isASCII(name[1])
-        && (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1]))) {
+        && (!isPRINT(name[1]) || memCHRs("\t\n\r\f", name[1]))) {
            /* diag_listed_as: Can't use global %s in %s */
            yyerror(Perl_form(aTHX_ "Can't use global %c^%c%.*s in %s",
                              name[0], toCTRL(name[1]),
@@ -748,7 +806,7 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
 }
 
 /*
-=head1 Optree Manipulation Functions
+=for apidoc_section $optree_manipulation
 
 =for apidoc alloccopstash
 
@@ -809,7 +867,6 @@ to from any optree.
 void
 Perl_op_free(pTHX_ OP *o)
 {
-    dVAR;
     OPCODE type;
     OP *top_op = o;
     OP *next_op = o;
@@ -983,7 +1040,6 @@ void
 Perl_op_clear(pTHX_ OP *o)
 {
 
-    dVAR;
 
     PERL_ARGS_ASSERT_OP_CLEAR;
 
@@ -1353,7 +1409,6 @@ other ops.
 void
 Perl_op_null(pTHX_ OP *o)
 {
-    dVAR;
 
     PERL_ARGS_ASSERT_OP_NULL;
 
@@ -1368,9 +1423,6 @@ void
 Perl_op_refcnt_lock(pTHX)
   PERL_TSA_ACQUIRE(PL_op_mutex)
 {
-#ifdef USE_ITHREADS
-    dVAR;
-#endif
     PERL_UNUSED_CONTEXT;
     OP_REFCNT_LOCK;
 }
@@ -1379,9 +1431,6 @@ void
 Perl_op_refcnt_unlock(pTHX)
   PERL_TSA_RELEASE(PL_op_mutex)
 {
-#ifdef USE_ITHREADS
-    dVAR;
-#endif
     PERL_UNUSED_CONTEXT;
     OP_REFCNT_UNLOCK;
 }
@@ -1395,7 +1444,7 @@ op_sibling nodes.  By analogy with the perl-level C<splice()> function, allows
 you to delete zero or more sequential nodes, replacing them with zero or
 more different nodes.  Performs the necessary op_first/op_last
 housekeeping on the parent node and op_sibling manipulation on the
-children.  The last deleted node will be marked as as the last node by
+children.  The last deleted node will be marked as the last node by
 updating the op_sibling/op_sibparent or op_moresib field as appropriate.
 
 Note that op_next is not manipulated, and nodes are not freed; that is the
@@ -1592,7 +1641,6 @@ S_op_sibling_newUNOP(pTHX_ OP *parent, OP *start, I32 type, I32 flags)
 LOGOP *
 Perl_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
 {
-    dVAR;
     LOGOP *logop;
     OP *kid = first;
     NewOp(1101, logop, 1, LOGOP);
@@ -2031,7 +2079,6 @@ Perl_scalar(pTHX_ OP *o)
 OP *
 Perl_scalarvoid(pTHX_ OP *arg)
 {
-    dVAR;
     OP *kid;
     SV* sv;
     OP *o = arg;
@@ -2837,7 +2884,6 @@ S_sprintf_is_multiconcatable(pTHX_ OP *o,struct sprintf_ismc_info *info)
 STATIC void
 S_maybe_multiconcat(pTHX_ OP *o)
 {
-    dVAR;
     OP *lastkidop;   /* the right-most of any kids unshifted onto o */
     OP *topop;       /* the top-most op in the concat tree (often equals o,
                         unless there are assign/stringify ops above it */
@@ -2915,6 +2961,18 @@ S_maybe_multiconcat(pTHX_ OP *o)
         targetop = OpSIBLING(topop);
         if (!targetop) /* probably some sort of syntax error */
             return;
+
+        /* don't optimise away assign in 'local $foo = ....' */
+        if (   (targetop->op_private & OPpLVAL_INTRO)
+            /* these are the common ops which do 'local', but
+             * not all */
+            && (   targetop->op_type == OP_GVSV
+                || targetop->op_type == OP_RV2SV
+                || targetop->op_type == OP_AELEM
+                || targetop->op_type == OP_HELEM
+                )
+        )
+            return;
     }
     else if (   topop->op_type == OP_CONCAT
              && (topop->op_flags & OPf_STACKED)
@@ -2940,7 +2998,7 @@ S_maybe_multiconcat(pTHX_ OP *o)
     }
 
     if (targetop) {
-        /* Can targetop (the LHS) if it's a padsv, be be optimised
+        /* Can targetop (the LHS) if it's a padsv, be optimised
          * away and use OPpTARGET_MY instead?
          */
         if (    (targetop->op_type == OP_PADSV)
@@ -3188,7 +3246,7 @@ S_maybe_multiconcat(pTHX_ OP *o)
      *  X .= Y
      *
      * otherwise we could be doing something like $x = "foo", which
-     * if treated as as a concat, would fail to COW.
+     * if treated as a concat, would fail to COW.
      */
     if (nargs + nconst + cBOOL(private_flags & OPpMULTICONCAT_APPEND) < 2)
         return;
@@ -4030,7 +4088,6 @@ S_vivifies(const OPCODE type)
 static void
 S_lvref(pTHX_ OP *o, I32 type)
 {
-    dVAR;
     OP *kid;
     OP * top_op = o;
 
@@ -4208,7 +4265,6 @@ op_lvalue().  The flags param has these bits:
 OP *
 Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 {
-    dVAR;
     OP *top_op = o;
 
     if (!o || (PL_parser && PL_parser->error_count))
@@ -4826,7 +4882,6 @@ S_refkids(pTHX_ OP *o, I32 type)
 OP *
 Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
 {
-    dVAR;
     OP * top_op = o;
 
     PERL_ARGS_ASSERT_DOREF;
@@ -5448,6 +5503,121 @@ Perl_invert(pTHX_ OP *o)
     return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o));
 }
 
+OP *
+Perl_cmpchain_start(pTHX_ I32 type, OP *left, OP *right)
+{
+    BINOP *bop;
+    OP *op;
+
+    if (!left)
+       left = newOP(OP_NULL, 0);
+    if (!right)
+       right = newOP(OP_NULL, 0);
+    scalar(left);
+    scalar(right);
+    NewOp(0, bop, 1, BINOP);
+    op = (OP*)bop;
+    ASSUME((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP);
+    OpTYPE_set(op, type);
+    cBINOPx(op)->op_flags = OPf_KIDS;
+    cBINOPx(op)->op_private = 2;
+    cBINOPx(op)->op_first = left;
+    cBINOPx(op)->op_last = right;
+    OpMORESIB_set(left, right);
+    OpLASTSIB_set(right, op);
+    return op;
+}
+
+OP *
+Perl_cmpchain_extend(pTHX_ I32 type, OP *ch, OP *right)
+{
+    BINOP *bop;
+    OP *op;
+
+    PERL_ARGS_ASSERT_CMPCHAIN_EXTEND;
+    if (!right)
+       right = newOP(OP_NULL, 0);
+    scalar(right);
+    NewOp(0, bop, 1, BINOP);
+    op = (OP*)bop;
+    ASSUME((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP);
+    OpTYPE_set(op, type);
+    if (ch->op_type != OP_NULL) {
+       UNOP *lch;
+       OP *nch, *cleft, *cright;
+       NewOp(0, lch, 1, UNOP);
+       nch = (OP*)lch;
+       OpTYPE_set(nch, OP_NULL);
+       nch->op_flags = OPf_KIDS;
+       cleft = cBINOPx(ch)->op_first;
+       cright = cBINOPx(ch)->op_last;
+       cBINOPx(ch)->op_first = NULL;
+       cBINOPx(ch)->op_last = NULL;
+       cBINOPx(ch)->op_private = 0;
+       cBINOPx(ch)->op_flags = 0;
+       cUNOPx(nch)->op_first = cright;
+       OpMORESIB_set(cright, ch);
+       OpMORESIB_set(ch, cleft);
+       OpLASTSIB_set(cleft, nch);
+       ch = nch;
+    }
+    OpMORESIB_set(right, op);
+    OpMORESIB_set(op, cUNOPx(ch)->op_first);
+    cUNOPx(ch)->op_first = right;
+    return ch;
+}
+
+OP *
+Perl_cmpchain_finish(pTHX_ OP *ch)
+{
+
+    PERL_ARGS_ASSERT_CMPCHAIN_FINISH;
+    if (ch->op_type != OP_NULL) {
+       OPCODE cmpoptype = ch->op_type;
+       ch = CHECKOP(cmpoptype, ch);
+       if(!ch->op_next && ch->op_type == cmpoptype)
+           ch = fold_constants(op_integerize(op_std_init(ch)));
+       return ch;
+    } else {
+       OP *condop = NULL;
+       OP *rightarg = cUNOPx(ch)->op_first;
+       cUNOPx(ch)->op_first = OpSIBLING(rightarg);
+       OpLASTSIB_set(rightarg, NULL);
+       while (1) {
+           OP *cmpop = cUNOPx(ch)->op_first;
+           OP *leftarg = OpSIBLING(cmpop);
+           OPCODE cmpoptype = cmpop->op_type;
+           OP *nextrightarg;
+           bool is_last;
+           is_last = !(cUNOPx(ch)->op_first = OpSIBLING(leftarg));
+           OpLASTSIB_set(cmpop, NULL);
+           OpLASTSIB_set(leftarg, NULL);
+           if (is_last) {
+               ch->op_flags = 0;
+               op_free(ch);
+               nextrightarg = NULL;
+           } else {
+               nextrightarg = newUNOP(OP_CMPCHAIN_DUP, 0, leftarg);
+               leftarg = newOP(OP_NULL, 0);
+           }
+           cBINOPx(cmpop)->op_first = leftarg;
+           cBINOPx(cmpop)->op_last = rightarg;
+           OpMORESIB_set(leftarg, rightarg);
+           OpLASTSIB_set(rightarg, cmpop);
+           cmpop->op_flags = OPf_KIDS;
+           cmpop->op_private = 2;
+           cmpop = CHECKOP(cmpoptype, cmpop);
+           if(!cmpop->op_next && cmpop->op_type == cmpoptype)
+               cmpop = op_integerize(op_std_init(cmpop));
+           condop = condop ? newLOGOP(OP_CMPCHAIN_AND, 0, cmpop, condop) :
+                       cmpop;
+           if (!nextrightarg)
+               return condop;
+           rightarg = nextrightarg;
+       }
+    }
+}
+
 /*
 =for apidoc op_scope
 
@@ -5465,7 +5635,6 @@ structure.
 OP *
 Perl_op_scope(pTHX_ OP *o)
 {
-    dVAR;
     if (o) {
        if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || TAINTING_get) {
            o = op_prepend_elem(OP_LINESEQ,
@@ -5633,7 +5802,7 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
 }
 
 /*
-=head1 Compile-time scope hooks
+=for apidoc_section $scope
 
 =for apidoc blockhook_register
 
@@ -5766,18 +5935,18 @@ Perl_localize(pTHX_ OP *o, I32 lex)
            bool sigil = FALSE;
 
            /* some heuristics to detect a potential error */
-           while (*s && (strchr(", \t\n", *s)))
+           while (*s && (memCHRs(", \t\n", *s)))
                s++;
 
            while (1) {
-               if (*s && (strchr("@$%", *s) || (!lex && *s == '*'))
+               if (*s && (memCHRs("@$%", *s) || (!lex && *s == '*'))
                       && *++s
                       && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s))) {
                    s++;
                    sigil = TRUE;
                    while (*s && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s)))
                        s++;
-                   while (*s && (strchr(", \t\n", *s)))
+                   while (*s && (memCHRs(", \t\n", *s)))
                        s++;
                }
                else
@@ -5811,9 +5980,17 @@ Perl_jmaybe(pTHX_ OP *o)
     PERL_ARGS_ASSERT_JMAYBE;
 
     if (o->op_type == OP_LIST) {
-       OP * const o2
-           = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL, SVt_PV)));
-       o = op_convert_list(OP_JOIN, 0, op_prepend_elem(OP_LIST, o2, o));
+        if (FEATURE_MULTIDIMENSIONAL_IS_ENABLED) {
+            OP * const o2
+                = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL, SVt_PV)));
+            o = op_convert_list(OP_JOIN, 0, op_prepend_elem(OP_LIST, o2, o));
+        }
+        else {
+            /* If the user disables this, then a warning might not be enough to alert
+               them to a possible change of behaviour here, so throw an exception.
+            */
+            yyerror("Multidimensional hash lookup is disabled");
+        }
     }
     return o;
 }
@@ -5843,7 +6020,6 @@ S_op_integerize(pTHX_ OP *o)
     /* integerize op. */
     if ((PL_opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER))
     {
-       dVAR;
        o->op_ppaddr = PL_ppaddr[++(o->op_type)];
     }
 
@@ -5855,9 +6031,10 @@ S_op_integerize(pTHX_ OP *o)
 }
 
 /* This function exists solely to provide a scope to limit
-   setjmp/longjmp() messing with auto variables.
+   setjmp/longjmp() messing with auto variables.  It cannot be inlined because
+   it uses setjmp
  */
-PERL_STATIC_INLINE int
+STATIC int
 S_fold_constants_eval(pTHX) {
     int ret = 0;
     dJMPENV;
@@ -5876,7 +6053,6 @@ S_fold_constants_eval(pTHX) {
 static OP *
 S_fold_constants(pTHX_ OP *const o)
 {
-    dVAR;
     OP *curop;
     OP *newop;
     I32 type = o->op_type;
@@ -6066,7 +6242,6 @@ S_fold_constants(pTHX_ OP *const o)
 static void
 S_gen_constant_list(pTHX_ OP *o)
 {
-    dVAR;
     OP *curop, *old_next;
     SV * const oldwarnhook = PL_warnhook;
     SV * const olddiehook  = PL_diehook;
@@ -6174,7 +6349,7 @@ S_gen_constant_list(pTHX_ OP *o)
 }
 
 /*
-=head1 Optree Manipulation Functions
+=for apidoc_section $optree_manipulation
 */
 
 /* List constructors */
@@ -6305,7 +6480,6 @@ C<op_convert_list> to make it the right type.
 OP *
 Perl_op_convert_list(pTHX_ I32 type, I32 flags, OP *o)
 {
-    dVAR;
     if (type < 0) type = -type, flags |= OPf_SPECIAL;
     if (!o || o->op_type != OP_LIST)
         o = force_list(o, 0);
@@ -6347,7 +6521,7 @@ Perl_op_convert_list(pTHX_ I32 type, I32 flags, OP *o)
 
 
 /*
-=head1 Optree construction
+=for apidoc_section $optree_construction
 
 =for apidoc newNULLLIST
 
@@ -6417,7 +6591,6 @@ See L</op_convert_list> for more information.
 OP *
 Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 {
-    dVAR;
     LISTOP *listop;
     /* Note that allocating an OP_PUSHMARK can die under Safe.pm if
      * pushmark is banned. So do it now while existing ops are in a
@@ -6469,7 +6642,6 @@ of C<op_private>.
 OP *
 Perl_newOP(pTHX_ I32 type, I32 flags)
 {
-    dVAR;
     OP *o;
 
     if (type == -OP_ENTEREVAL) {
@@ -6514,7 +6686,6 @@ of the constructed op tree.
 OP *
 Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
 {
-    dVAR;
     UNOP *unop;
 
     if (type == -OP_ENTEREVAL) {
@@ -6528,6 +6699,7 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
        || (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP
        || type == OP_SASSIGN
        || type == OP_ENTERTRY
+        || type == OP_ENTERTRYCATCH
        || type == OP_CUSTOM
        || type == OP_NULL );
 
@@ -6564,7 +6736,6 @@ initialised to C<aux>
 OP *
 Perl_newUNOP_AUX(pTHX_ I32 type, I32 flags, OP *first, UNOP_AUX_item *aux)
 {
-    dVAR;
     UNOP_AUX *unop;
 
     assert((PL_opargs[type] & OA_CLASS_MASK) == OA_UNOP_AUX
@@ -6603,7 +6774,6 @@ Supported optypes: C<OP_METHOD>.
 
 static OP*
 S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth) {
-    dVAR;
     METHOP *methop;
 
     assert((PL_opargs[type] & OA_CLASS_MASK) == OA_METHOP
@@ -6679,7 +6849,6 @@ by this function and become part of the constructed op tree.
 OP *
 Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 {
-    dVAR;
     BINOP *binop;
 
     ASSUME((PL_opargs[type] & OA_CLASS_MASK) == OA_BINOP
@@ -6800,18 +6969,19 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
      * One of the important characteristics to know about the input is whether
      * the transliteration may be done in place, or does a temporary need to be
      * allocated, then copied.  If the replacement for every character in every
-     * possible string takes up no more bytes than the the character it
+     * possible string takes up no more bytes than the character it
      * replaces, then it can be edited in place.  Otherwise the replacement
-     * could "grow", depending on the strings being processed.  Some inputs
-     * won't grow, and might even shrink under /d, but some inputs could grow,
-     * so we have to assume any given one might grow.  On very long inputs, the
-     * temporary could eat up a lot of memory, so we want to avoid it if
-     * possible.  For non-UTF-8 inputs, everything is single-byte, so can be
-     * edited in place, unless there is something in the pattern that could
-     * force it into UTF-8.  The inversion map makes it feasible to determine
-     * this.  Previous versions of this code pretty much punted on determining
-     * if UTF-8 could be edited in place.  Now, this code is rigorous in making
-     * that determination.
+     * could overwrite a byte we are about to read, depending on the strings
+     * being processed.  The comments and variable names here refer to this as
+     * "growing".  Some inputs won't grow, and might even shrink under /d, but
+     * some inputs could grow, so we have to assume any given one might grow.
+     * On very long inputs, the temporary could eat up a lot of memory, so we
+     * want to avoid it if possible.  For non-UTF-8 inputs, everything is
+     * single-byte, so can be edited in place, unless there is something in the
+     * pattern that could force it into UTF-8.  The inversion map makes it
+     * feasible to determine this.  Previous versions of this code pretty much
+     * punted on determining if UTF-8 could be edited in place.  Now, this code
+     * is rigorous in making that determination.
      *
      * Another characteristic we need to know is whether the lhs and rhs are
      * identical.  If so, and no other flags are present, the only effect of
@@ -6848,9 +7018,9 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     const bool squash     = cBOOL(o->op_private & OPpTRANS_SQUASH);
     const bool del        = cBOOL(o->op_private & OPpTRANS_DELETE);
 
-    /* Set to true if there is some character < 256 in the lhs that maps to >
-     * 255.  If so, a non-UTF-8 match string can be forced into requiring to be
-     * in UTF-8 by a tr/// operation. */
+    /* Set to true if there is some character < 256 in the lhs that maps to
+     * above 255.  If so, a non-UTF-8 match string can be forced into being in
+     * UTF-8 by a tr/// operation. */
     bool can_force_utf8 = FALSE;
 
     /* What is the maximum expansion factor in UTF-8 transliterations.  If a
@@ -6858,14 +7028,14 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
      * expansion factor is 1.5.  This number is used at runtime to calculate
      * how much space to allocate for non-inplace transliterations.  Without
      * this number, the worst case is 14, which is extremely unlikely to happen
-     * in real life, and would require significant memory overhead. */
+     * in real life, and could require significant memory overhead. */
     NV max_expansion = 1.;
 
     UV t_range_count, r_range_count, min_range_count;
     UV* t_array;
     SV* t_invlist;
     UV* r_map;
-    UV r_cp, t_cp;
+    UV r_cp = 0, t_cp = 0;
     UV t_cp_end = (UV) -1;
     UV r_cp_end;
     Size_t len;
@@ -6892,30 +7062,29 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
      * these up into smaller chunks, but doesn't merge any together.  This
      * makes it easy to find the instances it's looking for.  A second pass is
      * done after this has been determined which merges things together to
-     * shrink the table for runtime.  For ASCII platforms, the table is
-     * trivial, given below, and uses the fundamental characteristics of UTF-8
-     * to construct the values.  For EBCDIC, it isn't so, and we rely on a
-     * table constructed by the perl script that generates these kinds of
-     * things */
-#ifndef EBCDIC
+     * shrink the table for runtime.  The table below is used for both ASCII
+     * and EBCDIC platforms.  On EBCDIC, the byte length is not monotonically
+     * increasing for code points below 256.  To correct for that, the macro
+     * CP_ADJUST defined below converts those code points to ASCII in the first
+     * pass, and we use the ASCII partition values.  That works because the
+     * growth factor will be unaffected, which is all that is calculated during
+     * the first pass. */
     UV PL_partition_by_byte_length[] = {
         0,
-        0x80,
-        (32 * (1UL << (    UTF_ACCUMULATION_SHIFT))),
-        (16 * (1UL << (2 * UTF_ACCUMULATION_SHIFT))),
-        ( 8 * (1UL << (3 * UTF_ACCUMULATION_SHIFT))),
-        ( 4 * (1UL << (4 * UTF_ACCUMULATION_SHIFT))),
-        ( 2 * (1UL << (5 * UTF_ACCUMULATION_SHIFT)))
+        0x80,   /* Below this is 1 byte representations */
+        (32 * (1UL << (    UTF_ACCUMULATION_SHIFT))),   /* 2 bytes below this */
+        (16 * (1UL << (2 * UTF_ACCUMULATION_SHIFT))),   /* 3 bytes below this */
+        ( 8 * (1UL << (3 * UTF_ACCUMULATION_SHIFT))),   /* 4 bytes below this */
+        ( 4 * (1UL << (4 * UTF_ACCUMULATION_SHIFT))),   /* 5 bytes below this */
+        ( 2 * (1UL << (5 * UTF_ACCUMULATION_SHIFT)))    /* 6 bytes below this */
 
 #  ifdef UV_IS_QUAD
                                                     ,
-        ( ((UV) 1U << (6 * UTF_ACCUMULATION_SHIFT)))
+        ( ((UV) 1U << (6 * UTF_ACCUMULATION_SHIFT)))    /* 7 bytes below this */
 #  endif
 
     };
 
-#endif
-
     PERL_ARGS_ASSERT_PMTRANS;
 
     PL_hints |= HINT_BLOCK_SCOPE;
@@ -7013,6 +7182,20 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 
     t_invlist = _new_invlist(1);
 
+    /* Initialize to a single range */
+    t_invlist = _add_range_to_invlist(t_invlist, 0, UV_MAX);
+
+    /* For the first pass, the lhs is partitioned such that the
+     * number of UTF-8 bytes required to represent a code point in each
+     * partition is the same as the number for any other code point in
+     * that partion.  We copy the pre-compiled partion. */
+    len = C_ARRAY_LENGTH(PL_partition_by_byte_length);
+    invlist_extend(t_invlist, len);
+    t_array = invlist_array(t_invlist);
+    Copy(PL_partition_by_byte_length, t_array, len, UV);
+    invlist_set_len(t_invlist, len, *(get_invlist_offset_addr(t_invlist)));
+    Newx(r_map, len + 1, UV);
+
     /* Parse the (potentially adjusted) input, creating the inversion map.
      * This is done in two passes.  The first pass is to determine if the
      * transliteration can be done in place.  The inversion map it creates
@@ -7020,31 +7203,29 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
      * output of the second pass, which starts with a more compact table and
      * allows more ranges to be merged */
     for (pass2 = 0; pass2 < 2; pass2++) {
-
-        /* Initialize to a single range */
-        t_invlist = _add_range_to_invlist(t_invlist, 0, UV_MAX);
-
-        /* In the second pass, we just have the single range */
-
         if (pass2) {
+            /* Initialize to a single range */
+            t_invlist = _add_range_to_invlist(t_invlist, 0, UV_MAX);
+
+            /* In the second pass, we just have the single range */
             len = 1;
             t_array = invlist_array(t_invlist);
         }
-        else {
 
-            /* But in the first pass, the lhs is partitioned such that the
-             * number of UTF-8 bytes required to represent a code point in each
-             * partition is the same as the number for any other code point in
-             * that partion.  We copy the pre-compiled partion. */
-            len = C_ARRAY_LENGTH(PL_partition_by_byte_length);
-            invlist_extend(t_invlist, len);
-            t_array = invlist_array(t_invlist);
-            Copy(PL_partition_by_byte_length, t_array, len, UV);
-            invlist_set_len(t_invlist,
-                            len,
-                            *(get_invlist_offset_addr(t_invlist)));
-            Newx(r_map, len + 1, UV);
-        }
+/* As noted earlier, we convert EBCDIC code points to Unicode in the first pass
+ * so as to get the well-behaved length 1 vs length 2 boundary.  Only code
+ * points below 256 differ between the two character sets in this regard.  For
+ * these, we also can't have any ranges, as they have to be individually
+ * converted. */
+#ifdef EBCDIC
+#  define CP_ADJUST(x)          ((pass2) ? (x) : NATIVE_TO_UNI(x))
+#  define FORCE_RANGE_LEN_1(x)  ((pass2) ? 0 : ((x) < 256))
+#  define CP_SKIP(x)            ((pass2) ? UVCHR_SKIP(x) : OFFUNISKIP(x))
+#else
+#  define CP_ADJUST(x)          (x)
+#  define FORCE_RANGE_LEN_1(x)  0
+#  define CP_SKIP(x)            UVCHR_SKIP(x)
+#endif
 
         /* And the mapping of each of the ranges is initialized.  Initially,
          * everything is TR_UNLISTED. */
@@ -7105,7 +7286,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
          * This routine modifies traditional inversion maps to reserve two
          * mappings:
          *
-         *  TR_UNLISTED (or -1) indicates that the no code point in the range
+         *  TR_UNLISTED (or -1) indicates that no code point in the range
          *      is listed in the tr/// searchlist.  At runtime, these are
          *      always passed through unchanged.  In the inversion map, all
          *      points in the range are mapped to -1, instead of increasing,
@@ -7179,7 +7360,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 
                     /* Here, not in the middle of a range, and not UTF-8.  The
                      * next code point is the single byte where we're at */
-                    t_cp = *t;
+                    t_cp = CP_ADJUST(*t);
                     t_range_count = 1;
                     t++;
                 }
@@ -7190,7 +7371,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                      * next code point is the next UTF-8 char in the input.  We
                      * know the input is valid, because the toker constructed
                      * it */
-                    t_cp = valid_utf8_to_uvchr(t, &t_char_len);
+                    t_cp = CP_ADJUST(valid_utf8_to_uvchr(t, &t_char_len));
                     t += t_char_len;
 
                     /* UTF-8 strings (only) have been parsed in toke.c to have
@@ -7198,7 +7379,9 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                      * the first element of a range.  If so, get the final
                      * element and calculate the range size.  If not, the range
                      * size is 1 */
-                    if (t < tend && *t == RANGE_INDICATOR) {
+                    if (   t < tend && *t == RANGE_INDICATOR
+                        && ! FORCE_RANGE_LEN_1(t_cp))
+                    {
                         t++;
                         t_range_count = valid_utf8_to_uvchr(t, &t_char_len)
                                       - t_cp + 1;
@@ -7230,16 +7413,18 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                 }
                 else {
                     if (! rstr_utf8) {
-                        r_cp = *r;
+                        r_cp = CP_ADJUST(*r);
                         r_range_count = 1;
                         r++;
                     }
                     else {
                         Size_t r_char_len;
 
-                        r_cp = valid_utf8_to_uvchr(r, &r_char_len);
+                        r_cp = CP_ADJUST(valid_utf8_to_uvchr(r, &r_char_len));
                         r += r_char_len;
-                        if (r < rend && *r == RANGE_INDICATOR) {
+                        if (   r < rend && *r == RANGE_INDICATOR
+                            && ! FORCE_RANGE_LEN_1(r_cp))
+                        {
                             r++;
                             r_range_count = valid_utf8_to_uvchr(r,
                                                     &r_char_len) - r_cp + 1;
@@ -7308,7 +7493,12 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
             t_cp_end = MIN(IV_MAX, t_cp + span - 1);
 
             if (r_cp == TR_SPECIAL_HANDLING) {
-                r_cp_end = TR_SPECIAL_HANDLING;
+
+                /* If unmatched lhs code points map to the final map, use that
+                 * value.  This being set to TR_SPECIAL_HANDLING indicates that
+                 * we don't have a final map: unmatched lhs code points are
+                 * simply deleted */
+                r_cp_end = (del) ? TR_SPECIAL_HANDLING : final_map;
             }
             else {
                 r_cp_end = MIN(IV_MAX, r_cp + span - 1);
@@ -7338,6 +7528,13 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                  * we use the above sample data.  The t_cp chunk must be any
                  * contiguous subset of M, N, O, P, and/or Q.
                  *
+                 * In the first pass, calculate if there is any possible input
+                 * string that has a character whose transliteration will be
+                 * longer than it.  If none, the transliteration may be done
+                 * in-place, as it can't write over a so-far unread byte.
+                 * Otherwise, a copy must first be made.  This could be
+                 * expensive for long inputs.
+                 *
                  * In the first pass, the t_invlist has been partitioned so
                  * that all elements in any single range have the same number
                  * of bytes in their UTF-8 representations.  And the r space is
@@ -7359,21 +7556,31 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                  * code point in the rhs against any code point in the lhs. */
                 if ( ! pass2
                     && r_cp_end != TR_SPECIAL_HANDLING
-                    && UVCHR_SKIP(t_cp_end) < UVCHR_SKIP(r_cp_end))
+                    && CP_SKIP(t_cp_end) < CP_SKIP(r_cp_end))
                 {
-                    /* Consider tr/\xCB/\X{E000}/.  The maximum expansion
-                     * factor is 1 byte going to 3 if the lhs is not UTF-8, but
-                     * 2 bytes going to 3 if it is in UTF-8.  We could pass two
-                     * different values so doop could choose based on the
-                     * UTF-8ness of the target.  But khw thinks (perhaps
-                     * wrongly) that is overkill.  It is used only to make sure
-                     * we malloc enough space.  If no target string can force
-                     * the result to be UTF-8, then we don't have to worry
-                     * about this */
+                    /* Here, we will need to make a copy of the input string
+                     * before doing the transliteration.  The worst possible
+                     * case is an expansion ratio of 14:1. This is rare, and
+                     * we'd rather allocate only the necessary amount of extra
+                     * memory for that copy.  We can calculate the worst case
+                     * for this particular transliteration is by keeping track
+                     * of the expansion factor for each range.
+                     *
+                     * Consider tr/\xCB/\X{E000}/.  The maximum expansion
+                     * factor is 1 byte going to 3 if the target string is not
+                     * UTF-8, but 2 bytes going to 3 if it is in UTF-8.  We
+                     * could pass two different values so doop could choose
+                     * based on the UTF-8ness of the target.  But khw thinks
+                     * (perhaps wrongly) that is overkill.  It is used only to
+                     * make sure we malloc enough space.
+                     *
+                     * If no target string can force the result to be UTF-8,
+                     * then we don't have to worry about the case of the target
+                     * string not being UTF-8 */
                     NV t_size = (can_force_utf8 && t_cp < 256)
                                 ? 1
-                                : UVCHR_SKIP(t_cp_end);
-                    NV ratio = UVCHR_SKIP(r_cp_end) / t_size;
+                                : CP_SKIP(t_cp_end);
+                    NV ratio = CP_SKIP(r_cp_end) / t_size;
 
                     o->op_private |= OPpTRANS_GROWS;
 
@@ -7406,8 +7613,8 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                      * is if it 'grows'.  But in the 2nd pass, there's no
                      * reason to not merge */
                     if (   (i > 0 && (   pass2
-                                      || UVCHR_SKIP(t_array[i-1])
-                                                        == UVCHR_SKIP(t_cp)))
+                                      || CP_SKIP(t_array[i-1])
+                                                            == CP_SKIP(t_cp)))
                         && (   (   r_cp == TR_SPECIAL_HANDLING
                                 && r_map[i-1] == TR_SPECIAL_HANDLING)
                             || (   r_cp != TR_SPECIAL_HANDLING
@@ -7427,7 +7634,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                     adjacent_to_range_above = TRUE;
                     if (i + 1 < len)
                     if (    (   pass2
-                             || UVCHR_SKIP(t_cp) == UVCHR_SKIP(t_array[i+1]))
+                             || CP_SKIP(t_cp) == CP_SKIP(t_array[i+1]))
                         && (   (   r_cp == TR_SPECIAL_HANDLING
                                 && r_map[i+1] == (UV) TR_SPECIAL_HANDLING)
                             || (   r_cp != TR_SPECIAL_HANDLING
@@ -7852,13 +8059,14 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
         }
         else {
             /* no more replacement chars than search chars */
+        }
 #endif
 
     }
 
     DEBUG_y(PerlIO_printf(Perl_debug_log,
             "/d=%d, /s=%d, /c=%d, identical=%d, grows=%d,"
-            " use_svop=%d, can_force_utf8=%d,\nexpansion=%g\n",
+            " use_svop=%d, can_force_utf8=%d,\nexpansion=%" NVgf "\n",
             del, squash, complement,
             cBOOL(o->op_private & OPpTRANS_IDENTICAL),
             cBOOL(o->op_private & OPpTRANS_USE_SVOP),
@@ -7894,7 +8102,6 @@ and, shifted up eight bits, the eight bits of C<op_private>.
 OP *
 Perl_newPMOP(pTHX_ I32 type, I32 flags)
 {
-    dVAR;
     PMOP *pmop;
 
     assert((PL_opargs[type] & OA_CLASS_MASK) == OA_PMOP
@@ -7950,7 +8157,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
     } else {
        SV * const repointer = &PL_sv_undef;
        av_push(PL_regex_padav, repointer);
-       pmop->op_pmoffset = av_tindex(PL_regex_padav);
+       pmop->op_pmoffset = av_top_index(PL_regex_padav);
        PL_regex_pad = AvARRAY(PL_regex_padav);
     }
 #endif
@@ -8019,22 +8226,22 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
     is_compiletime = 1;
     has_code = 0;
     if (expr->op_type == OP_LIST) {
-        OP *this_o;
-        for (this_o = cLISTOPx(expr)->op_first; this_o; this_o = OpSIBLING(this_o)) {
-            if (this_o->op_type == OP_NULL && (this_o->op_flags & OPf_SPECIAL)) {
+        OP *child;
+        for (child = cLISTOPx(expr)->op_first; child; child = OpSIBLING(child)) {
+            if (child->op_type == OP_NULL && (child->op_flags & OPf_SPECIAL)) {
                 has_code = 1;
-                assert(!this_o->op_next);
-                if (UNLIKELY(!OpHAS_SIBLING(this_o))) {
+                assert(!child->op_next);
+                if (UNLIKELY(!OpHAS_SIBLING(child))) {
                     assert(PL_parser && PL_parser->error_count);
                     /* This can happen with qr/ (?{(^{})/.  Just fake up
                        the op we were expecting to see, to avoid crashing
                        elsewhere.  */
-                    op_sibling_splice(expr, this_o, 0,
+                    op_sibling_splice(expr, child, 0,
                               newSVOP(OP_CONST, 0, &PL_sv_no));
                 }
-                this_o->op_next = OpSIBLING(this_o);
+                child->op_next = OpSIBLING(child);
             }
-            else if (this_o->op_type != OP_CONST && this_o->op_type != OP_PUSHMARK)
+            else if (child->op_type != OP_CONST && child->op_type != OP_PUSHMARK)
             is_compiletime = 0;
         }
     }
@@ -8047,42 +8254,42 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
      * also, mark any arrays as LIST/REF */
 
     if (expr->op_type == OP_LIST) {
-       OP *o;
-       for (o = cLISTOPx(expr)->op_first; o; o = OpSIBLING(o)) {
+        OP *child;
+        for (child = cLISTOPx(expr)->op_first; child; child = OpSIBLING(child)) {
 
-            if (o->op_type == OP_PADAV || o->op_type == OP_RV2AV) {
-                assert( !(o->op_flags  & OPf_WANT));
+            if (child->op_type == OP_PADAV || child->op_type == OP_RV2AV) {
+                assert( !(child->op_flags  & OPf_WANT));
                 /* push the array rather than its contents. The regex
                  * engine will retrieve and join the elements later */
-                o->op_flags |= (OPf_WANT_LIST | OPf_REF);
+                child->op_flags |= (OPf_WANT_LIST | OPf_REF);
                 continue;
             }
 
-           if (!(o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)))
-               continue;
-           o->op_next = NULL; /* undo temporary hack from above */
-           scalar(o);
-           LINKLIST(o);
-           if (cLISTOPo->op_first->op_type == OP_LEAVE) {
-               LISTOP *leaveop = cLISTOPx(cLISTOPo->op_first);
-               /* skip ENTER */
-               assert(leaveop->op_first->op_type == OP_ENTER);
-               assert(OpHAS_SIBLING(leaveop->op_first));
-               o->op_next = OpSIBLING(leaveop->op_first);
-               /* skip leave */
-               assert(leaveop->op_flags & OPf_KIDS);
-               assert(leaveop->op_last->op_next == (OP*)leaveop);
-               leaveop->op_next = NULL; /* stop on last op */
-               op_null((OP*)leaveop);
-           }
-           else {
-               /* skip SCOPE */
-               OP *scope = cLISTOPo->op_first;
-               assert(scope->op_type == OP_SCOPE);
-               assert(scope->op_flags & OPf_KIDS);
-               scope->op_next = NULL; /* stop on last op */
-               op_null(scope);
-           }
+            if (!(child->op_type == OP_NULL && (child->op_flags & OPf_SPECIAL)))
+                continue;
+            child->op_next = NULL; /* undo temporary hack from above */
+            scalar(child);
+            LINKLIST(child);
+            if (cLISTOPx(child)->op_first->op_type == OP_LEAVE) {
+                LISTOP *leaveop = cLISTOPx(cLISTOPx(child)->op_first);
+                /* skip ENTER */
+                assert(leaveop->op_first->op_type == OP_ENTER);
+                assert(OpHAS_SIBLING(leaveop->op_first));
+                child->op_next = OpSIBLING(leaveop->op_first);
+                /* skip leave */
+                assert(leaveop->op_flags & OPf_KIDS);
+                assert(leaveop->op_last->op_next == (OP*)leaveop);
+                leaveop->op_next = NULL; /* stop on last op */
+                op_null((OP*)leaveop);
+            }
+            else {
+                /* skip SCOPE */
+                OP *scope = cLISTOPx(child)->op_first;
+                assert(scope->op_type == OP_SCOPE);
+                assert(scope->op_flags & OPf_KIDS);
+                scope->op_next = NULL; /* stop on last op */
+                op_null(scope);
+            }
 
             /* XXX optimize_optree() must be called on o before
              * CALL_PEEP(), as currently S_maybe_multiconcat() can't
@@ -8092,16 +8299,16 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor)
              * to the same optree later (where hopefully it won't do any
              * harm as it can't convert an op to multiconcat if it's
              * already been converted */
-            optimize_optree(o);
-
-           /* have to peep the DOs individually as we've removed it from
-            * the op_next chain */
-           CALL_PEEP(o);
-            S_prune_chain_head(&(o->op_next));
-           if (is_compiletime)
-               /* runtime finalizes as part of finalizing whole tree */
-               finalize_optree(o);
-       }
+            optimize_optree(child);
+
+            /* have to peep the DOs individually as we've removed it from
+             * the op_next chain */
+            CALL_PEEP(child);
+            S_prune_chain_head(&(child->op_next));
+            if (is_compiletime)
+                /* runtime finalizes as part of finalizing whole tree */
+                finalize_optree(child);
+        }
     }
     else if (expr->op_type == OP_PADAV || expr->op_type == OP_RV2AV) {
         assert( !(expr->op_flags  & OPf_WANT));
@@ -8381,7 +8588,6 @@ takes ownership of one reference to it.
 OP *
 Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
 {
-    dVAR;
     SVOP *svop;
 
     PERL_ARGS_ASSERT_NEWSVOP;
@@ -8437,7 +8643,6 @@ This function only exists if Perl has been compiled to use ithreads.
 OP *
 Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
 {
-    dVAR;
     PADOP *padop;
 
     PERL_ARGS_ASSERT_NEWPADOP;
@@ -8505,7 +8710,6 @@ have been allocated using C<PerlMemShared_malloc>.
 OP *
 Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
 {
-    dVAR;
     const bool utf8 = cBOOL(flags & SVf_UTF8);
     PVOP *pvop;
 
@@ -8687,7 +8891,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 }
 
 /*
-=head1 Embedding Functions
+=for apidoc_section $embedding
 
 =for apidoc load_module
 
@@ -8720,6 +8924,14 @@ than C<use>.
 =for apidoc Amnh||PERL_LOADMOD_NOIMPORT
 =for apidoc Amnh||PERL_LOADMOD_IMPORT_OPS
 
+=for apidoc vload_module
+Like C<L</load_module>> but the arguments are an encapsulated argument list.
+
+=for apidoc load_module_nocontext
+Like C<L</load_module>> but does not take a thread context (C<aTHX>) parameter,
+so is used in situations where the caller doesn't already have the thread
+context.
+
 =cut */
 
 void
@@ -8827,7 +9039,7 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin)
 }
 
 /*
-=head1 Optree construction
+=for apidoc_section $optree_construction
 
 =for apidoc newSLICEOP
 
@@ -8923,7 +9135,6 @@ S_assignment_type(pTHX_ const OP *o)
 static OP *
 S_newONCEOP(pTHX_ OP *initop, OP *padop)
 {
-    dVAR;
     const PADOFFSET target = padop->op_targ;
     OP *const other = newOP(OP_PADSV,
                            padop->op_flags
@@ -9187,7 +9398,6 @@ is consumed by this function and becomes part of the returned op tree.
 OP *
 Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 {
-    dVAR;
     const U32 seq = intro_my();
     const U32 utf8 = flags & SVf_UTF8;
     COP *cop;
@@ -9338,7 +9548,6 @@ S_search_const(pTHX_ OP *o)
 STATIC OP *
 S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 {
-    dVAR;
     LOGOP *logop;
     OP *o;
     OP *first;
@@ -9550,7 +9759,6 @@ this function and become part of the constructed op tree.
 OP *
 Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
 {
-    dVAR;
     LOGOP *logop;
     OP *start;
     OP *o;
@@ -9609,6 +9817,63 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
 }
 
 /*
+=for apidoc newTRYCATCHOP
+
+Constructs and returns a conditional execution statement that implements
+the C<try>/C<catch> semantics.  First the op tree in C<tryblock> is executed,
+inside a context that traps exceptions.  If an exception occurs then the
+optree in C<catchblock> is executed, with the trapped exception set into the
+lexical variable given by C<catchvar> (which must be an op of type
+C<OP_PADSV>).  All the optrees are consumed by this function and become part
+of the returned op tree. 
+
+The C<flags> argument is currently ignored.
+
+=cut
+ */
+
+OP *
+Perl_newTRYCATCHOP(pTHX_ I32 flags, OP *tryblock, OP *catchvar, OP *catchblock)
+{
+    OP *o, *catchop;
+
+    PERL_ARGS_ASSERT_NEWTRYCATCHOP;
+    assert(catchvar->op_type == OP_PADSV);
+
+    PERL_UNUSED_ARG(flags);
+
+    /* The returned optree is shaped as:
+     *   LISTOP leavetrycatch
+     *       LOGOP entertrycatch
+     *       LISTOP poptry
+     *           $tryblock here
+     *       LOGOP catch
+     *           $catchblock here
+     */
+
+    if(tryblock->op_type != OP_LINESEQ)
+        tryblock = op_convert_list(OP_LINESEQ, 0, tryblock);
+    OpTYPE_set(tryblock, OP_POPTRY);
+
+    /* Manually construct a naked LOGOP.
+     * Normally if we call newLOGOP the returned value is a UNOP(OP_NULL)
+     * containing the LOGOP we wanted as its op_first */
+    catchop = (OP *)alloc_LOGOP(OP_CATCH, newOP(OP_NULL, 0), catchblock);
+    OpMORESIB_set(cUNOPx(catchop)->op_first, catchblock);
+    OpLASTSIB_set(catchblock, catchop);
+
+    /* Inject the catchvar's pad offset into the OP_CATCH targ */
+    cLOGOPx(catchop)->op_targ = catchvar->op_targ;
+    op_free(catchvar);
+
+    /* Build the optree structure */
+    o = newLISTOP(OP_LIST, 0, tryblock, catchop);
+    o = op_convert_list(OP_ENTERTRYCATCH, 0, o);
+
+    return o;
+}
+
+/*
 =for apidoc newRANGE
 
 Constructs and returns a C<range> op, with subordinate C<flip> and
@@ -9804,7 +10069,6 @@ OP *
 Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop,
        OP *expr, OP *block, OP *cont, I32 has_my)
 {
-    dVAR;
     OP *redo;
     OP *next = NULL;
     OP *listop;
@@ -9928,7 +10192,6 @@ automatically.
 OP *
 Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
 {
-    dVAR;
     LOOP *loop;
     OP *wop;
     PADOFFSET padoff = 0;
@@ -10026,7 +10289,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
      * keep it in-place if there's space */
     if (loop->op_slabbed
         &&    OpSLOT(loop)->opslot_size
-            < SIZE_TO_PSIZE(sizeof(LOOP)) + OPSLOT_HEADER_P)
+            < SIZE_TO_PSIZE(sizeof(LOOP) + OPSLOT_HEADER))
     {
         /* no space; allocate new op */
        LOOP *tmp;
@@ -10151,7 +10414,6 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block,
                   I32 enter_opcode, I32 leave_opcode,
                   PADOFFSET entertarg)
 {
-    dVAR;
     LOGOP *enterop;
     OP *o;
 
@@ -10422,7 +10684,7 @@ static void const_av_xsub(pTHX_ CV* cv);
 
 /*
 
-=head1 Optree Manipulation Functions
+=for apidoc_section $optree_manipulation
 
 =for apidoc cv_const_sv
 
@@ -10647,7 +10909,6 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        if (CvNAMED(*spot))
            hek = CvNAME_HEK(*spot);
        else {
-            dVAR;
            U32 hash;
            PERL_HASH(hash, PadnamePV(name)+1, PadnameLEN(name)-1);
            CvNAME_HEK_set(*spot, hek =
@@ -10807,7 +11068,6 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (!CvNAME_HEK(cv)) {
        if (hek) (void)share_hek_hek(hek);
        else {
-            dVAR;
            U32 hash;
            PERL_HASH(hash, PadnamePV(name)+1, PadnameLEN(name)-1);
            hek = share_hek(PadnamePV(name)+1,
@@ -10971,7 +11231,7 @@ this function.
 
 If C<o_is_gv> is false and C<o> is null, then the subroutine will
 be anonymous.  If C<o_is_gv> is false and C<o> is non-null, then C<o>
-must point to a C<const> op, which will be consumed by this function,
+must point to a C<const> OP, which will be consumed by this function,
 and its string value supplies a name for the subroutine.  The name may
 be qualified or unqualified, and if it is unqualified then a default
 stash will be selected in some manner.  If C<o_is_gv> is true, then C<o>
@@ -11002,6 +11262,17 @@ time this function returns, making it erroneous for the caller to make
 any use of the returned pointer.  It is the caller's responsibility to
 ensure that it knows which of these situations applies.
 
+=for apidoc newATTRSUB
+Construct a Perl subroutine, also performing some surrounding jobs.
+
+This is the same as L<perlintern/C<newATTRSUB_x>> with its C<o_is_gv> parameter set to
+FALSE.  This means that if C<o> is null, the new sub will be anonymous; otherwise
+the name will be derived from C<o> in the way described (as with all other
+details) in L<perlintern/C<newATTRSUB_x>>.
+
+=for apidoc newSUB
+Like C<L</newATTRSUB>>, but without attributes.
+
 =cut
 */
 
@@ -11314,7 +11585,6 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
                assert(CvGV(cv) == gv);
            }
            else {
-               dVAR;
                U32 hash;
                PERL_HASH(hash, name, namlen);
                CvNAME_HEK_set(cv,
@@ -11385,7 +11655,6 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
        if (isGV(gv))
             CvGV_set(cv, gv);
        else {
-            dVAR;
            U32 hash;
            PERL_HASH(hash, name, namlen);
            CvNAME_HEK_set(cv, share_hek(name,
@@ -11531,32 +11800,10 @@ S_process_special_blocks(pTHX_ I32 floor, const char *const fullname,
             (void)CvGV(cv);
            if (floor) LEAVE_SCOPE(floor);
            ENTER;
-
-            SAVEVPTR(PL_curcop);
-            if (PL_curcop == &PL_compiling) {
-                /* Avoid pushing the "global" &PL_compiling onto the
-                 * context stack. For example, a stack trace inside
-                 * nested use's would show all calls coming from whoever
-                 * most recently updated PL_compiling.cop_file and
-                 * cop_line.  So instead, temporarily set PL_curcop to a
-                 * private copy of &PL_compiling. PL_curcop will soon be
-                 * set to point back to &PL_compiling anyway but only
-                 * after the temp value has been pushed onto the context
-                 * stack as blk_oldcop.
-                 * This is slightly hacky, but necessary. Note also
-                 * that in the brief window before PL_curcop is set back
-                 * to PL_compiling, IN_PERL_COMPILETIME/IN_PERL_RUNTIME
-                 * will give the wrong answer.
-                 */
-                Newx(PL_curcop, 1, COP);
-                StructCopy(&PL_compiling, PL_curcop, COP);
-                PL_curcop->op_slabbed = 0;
-                SAVEFREEPV(PL_curcop);
-            }
-
             PUSHSTACKi(PERLSI_REQUIRE);
            SAVECOPFILE(&PL_compiling);
            SAVECOPLINE(&PL_compiling);
+           SAVEVPTR(PL_curcop);
 
            DEBUG_x( dump_sub(gv) );
            Perl_av_create_and_push(aTHX_ &PL_beginav, MUTABLE_SV(cv));
@@ -12075,7 +12322,6 @@ Perl_newANONATTRSUB(pTHX_ I32 floor, OP *proto, OP *attrs, OP *block)
 OP *
 Perl_oopsAV(pTHX_ OP *o)
 {
-    dVAR;
 
     PERL_ARGS_ASSERT_OOPSAV;
 
@@ -12101,7 +12347,6 @@ Perl_oopsAV(pTHX_ OP *o)
 OP *
 Perl_oopsHV(pTHX_ OP *o)
 {
-    dVAR;
 
     PERL_ARGS_ASSERT_OOPSHV;
 
@@ -12129,7 +12374,6 @@ Perl_oopsHV(pTHX_ OP *o)
 OP *
 Perl_newAVREF(pTHX_ OP *o)
 {
-    dVAR;
 
     PERL_ARGS_ASSERT_NEWAVREF;
 
@@ -12154,7 +12398,6 @@ Perl_newGVREF(pTHX_ I32 type, OP *o)
 OP *
 Perl_newHVREF(pTHX_ OP *o)
 {
-    dVAR;
 
     PERL_ARGS_ASSERT_NEWHVREF;
 
@@ -12172,7 +12415,6 @@ OP *
 Perl_newCVREF(pTHX_ I32 flags, OP *o)
 {
     if (o->op_type == OP_PADANY) {
-       dVAR;
         OpTYPE_set(o, OP_PADCV);
     }
     return newUNOP(OP_RV2CV, flags, scalar(o));
@@ -12181,7 +12423,6 @@ Perl_newCVREF(pTHX_ I32 flags, OP *o)
 OP *
 Perl_newSVREF(pTHX_ OP *o)
 {
-    dVAR;
 
     PERL_ARGS_ASSERT_NEWSVREF;
 
@@ -12456,7 +12697,6 @@ Perl_ck_concat(pTHX_ OP *o)
 OP *
 Perl_ck_spair(pTHX_ OP *o)
 {
-    dVAR;
 
     PERL_ARGS_ASSERT_CK_SPAIR;
 
@@ -12555,7 +12795,6 @@ Perl_ck_eof(pTHX_ OP *o)
 OP *
 Perl_ck_eval(pTHX_ OP *o)
 {
-    dVAR;
 
     PERL_ARGS_ASSERT_CK_EVAL;
 
@@ -12616,6 +12855,69 @@ Perl_ck_eval(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_trycatch(pTHX_ OP *o)
+{
+    LOGOP *enter;
+    OP *to_free = NULL;
+    OP *trykid, *catchkid;
+    OP *catchroot, *catchstart;
+
+    PERL_ARGS_ASSERT_CK_TRYCATCH;
+
+    trykid = cUNOPo->op_first;
+    if(trykid->op_type == OP_NULL || trykid->op_type == OP_PUSHMARK) {
+        to_free = trykid;
+        trykid = OpSIBLING(trykid);
+    }
+    catchkid = OpSIBLING(trykid);
+
+    assert(trykid->op_type == OP_POPTRY);
+    assert(catchkid->op_type == OP_CATCH);
+
+    /* cut whole sibling chain free from o */
+    op_sibling_splice(o, NULL, -1, NULL);
+    if(to_free)
+        op_free(to_free);
+    op_free(o);
+
+    enter = alloc_LOGOP(OP_ENTERTRYCATCH, NULL, NULL);
+
+    /* establish postfix order */
+    enter->op_next = (OP*)enter;
+
+    o = op_prepend_elem(OP_LINESEQ, (OP*)enter, trykid);
+    op_append_elem(OP_LINESEQ, (OP*)o, catchkid);
+
+    OpTYPE_set(o, OP_LEAVETRYCATCH);
+
+    /* The returned optree is actually threaded up slightly nonobviously in
+     * terms of its ->op_next pointers.
+     *
+     * This way, if the tryblock dies, its retop points at the OP_CATCH, but
+     * if it does not then its leavetry skips over that and continues
+     * execution past it.
+     */
+
+    /* First, link up the actual body of the catch block */
+    catchroot = OpSIBLING(cUNOPx(catchkid)->op_first);
+    catchstart = LINKLIST(catchroot);
+    cLOGOPx(catchkid)->op_other = catchstart;
+
+    o->op_next = LINKLIST(o);
+
+    /* die within try block should jump to the catch */
+    enter->op_other = catchkid;
+
+    /* after try block that doesn't die, just skip straight to leavetrycatch */
+    trykid->op_next = o;
+
+    /* after catch block, skip back up to the leavetrycatch */
+    catchroot->op_next = o;
+
+    return o;
+}
+
+OP *
 Perl_ck_exec(pTHX_ OP *o)
 {
     PERL_ARGS_ASSERT_CK_EXEC;
@@ -12661,7 +12963,6 @@ Perl_ck_exists(pTHX_ OP *o)
 OP *
 Perl_ck_rvconst(pTHX_ OP *o)
 {
-    dVAR;
     SVOP * const kid = (SVOP*)cUNOPo->op_first;
 
     PERL_ARGS_ASSERT_CK_RVCONST;
@@ -12756,7 +13057,6 @@ Perl_ck_rvconst(pTHX_ OP *o)
 OP *
 Perl_ck_ftst(pTHX_ OP *o)
 {
-    dVAR;
     const I32 type = o->op_type;
 
     PERL_ARGS_ASSERT_CK_FTST;
@@ -12926,6 +13226,11 @@ Perl_ck_fun(pTHX_ OP *o)
                    {
                        OP * const newop = newGVOP(OP_GV, 0,
                            gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVIO));
+                        /* a first argument is handled by toke.c, ideally we'd
+                         just check here but several ops don't use ck_fun() */
+                        if (!FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED && numargs > 1) {
+                            no_bareword_filehandle(SvPVX(cSVOPx_sv((SVOP*)kid)));
+                        }
                         /* replace kid with newop in chain */
                         op_sibling_splice(o, prev_kid, 1, newop);
                        op_free(kid);
@@ -13298,7 +13603,6 @@ Perl_ck_listiob(pTHX_ OP *o)
 OP *
 Perl_ck_smartmatch(pTHX_ OP *o)
 {
-    dVAR;
     PERL_ARGS_ASSERT_CK_SMARTMATCH;
     if (0 == (o->op_flags & OPf_SPECIAL)) {
        OP *first  = cBINOPo->op_first;
@@ -13363,7 +13667,6 @@ S_maybe_targlex(pTHX_ OP *o)
 OP *
 Perl_ck_sassign(pTHX_ OP *o)
 {
-    dVAR;
     OP * const kid = cBINOPo->op_first;
 
     PERL_ARGS_ASSERT_CK_SASSIGN;
@@ -13645,7 +13948,6 @@ Perl_ck_require(pTHX_ OP *o)
          SV * const sv = kid->op_sv;
          U32 const was_readonly = SvREADONLY(sv);
          if (kid->op_private & OPpCONST_BARE) {
-            dVAR;
            const char *end;
             HEK *hek;
 
@@ -13690,7 +13992,6 @@ Perl_ck_require(pTHX_ OP *o)
                SvREFCNT_dec_NN(sv);
            }
            else {
-                dVAR;
                 HEK *hek;
                if (was_readonly) SvREADONLY_off(sv);
                PERL_HASH(hash, s, len);
@@ -13743,7 +14044,6 @@ Perl_ck_return(pTHX_ OP *o)
 OP *
 Perl_ck_select(pTHX_ OP *o)
 {
-    dVAR;
     OP* kid;
 
     PERL_ARGS_ASSERT_CK_SELECT;
@@ -13985,7 +14285,6 @@ S_simplify_sort(pTHX_ OP *o)
 OP *
 Perl_ck_split(pTHX_ OP *o)
 {
-    dVAR;
     OP *kid;
     OP *sibs;
 
@@ -14364,7 +14663,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
                continue;
            case '_':
                /* _ must be at the end */
-               if (proto[1] && !strchr(";@%", proto[1]))
+               if (proto[1] && !memCHRs(";@%", proto[1]))
                    goto oops;
                 /* FALLTHROUGH */
            case '$':
@@ -14941,7 +15240,7 @@ Perl_ck_subr(pTHX_ OP *o)
        if (CvISXSUB(cv) || !CvROOT(cv))
            S_entersub_alloc_targ(aTHX_ o);
        if (!namegv) {
-           /* The original call checker API guarantees that a GV will be
+           /* The original call checker API guarantees that a GV will
               be provided with the right name.  So, if the old API was
               used (or the REQUIRE_GV flag was passed), we have to reify
               the CV’s GV, unless this is an anonymous sub.  This is not
@@ -15001,6 +15300,9 @@ Perl_ck_trunc(pTHX_ OP *o)
        {
            o->op_flags |= OPf_SPECIAL;
            kid->op_private &= ~OPpCONST_STRICT;
+            if (!FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED) {
+                no_bareword_filehandle(SvPVX(cSVOPx_sv(kid)));
+            }
        }
     }
     return ck_fun(o);
@@ -15043,7 +15345,6 @@ Perl_ck_tell(pTHX_ OP *o)
 OP *
 Perl_ck_each(pTHX_ OP *o)
 {
-    dVAR;
     OP *kid = o->op_flags & OPf_KIDS ? cUNOPo->op_first : NULL;
     const unsigned orig_type  = o->op_type;
 
@@ -15539,11 +15840,15 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, int *scalars_p)
         goto do_next;
 
     case OP_UNDEF:
-        /* undef counts as a scalar on the RHS:
-         *   (undef, $x) = ...;         # only 1 scalar on LHS: always safe
+        /* undef on LHS following a var is significant, e.g.
+         *    my $x = 1;
+         *    @a = (($x, undef) = (2 => $x));
+         *    # @a shoul be (2,1) not (2,2)
+         *
+         * undef on RHS counts as a scalar:
          *   ($x, $y)    = (undef, $x); # 2 scalars on RHS: unsafe
          */
-        if (rhs)
+        if ((!rhs && *scalars_p) || rhs)
             (*scalars_p)++;
         flags = AAS_SAFE_SCALAR;
         break;
@@ -15580,7 +15885,7 @@ S_aassign_scan(pTHX_ OP* o, bool rhs, int *scalars_p)
         }
 
         /* if its an unrecognised, non-dangerous op, assume that it
-         * it the cause of at least one safe scalar */
+         * is the cause of at least one safe scalar */
         (*scalars_p)++;
         flags = AAS_SAFE_SCALAR;
         break;
@@ -15734,7 +16039,6 @@ S_inplace_aassign(pTHX_ OP *o) {
 STATIC void
 S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
 {
-    dVAR;
     int pass;
     UNOP_AUX_item *arg_buf = NULL;
     bool reset_start_targ  = FALSE; /* start->op_targ needs zeroing */
@@ -15762,12 +16066,11 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
         bool next_is_hash    = FALSE; /* is the next lookup to be a hash? */
         bool is_last         = FALSE; /* no more derefs to follow */
         bool maybe_aelemfast = FALSE; /* we can replace with aelemfast? */
+        UV action_word       = 0;     /* all actions so far */
         UNOP_AUX_item *arg     = arg_buf;
         UNOP_AUX_item *action_ptr = arg_buf;
 
-        if (pass)
-            action_ptr->uv = 0;
-        arg++;
+        arg++; /* reserve slot for first action word */
 
         switch (action) {
         case MDEREF_HV_gvsv_vivify_rv2hv_helem:
@@ -16158,16 +16461,16 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
                     arg--;
             }
 
-            if (pass)
-                action_ptr->uv |= (action << (action_ix * MDEREF_SHIFT));
+            action_word |= (action << (action_ix * MDEREF_SHIFT));
             action_ix++;
             action_count++;
-            /* if there's no space for the next action, create a new slot
+            /* if there's no space for the next action, reserve a new slot
              * for it *before* we start adding args for that action */
             if ((action_ix + 1) * MDEREF_SHIFT > UVSIZE*8) {
-                action_ptr = arg;
                 if (pass)
-                    arg->uv = 0;
+                    action_ptr->uv = action_word;
+                action_word = 0;
+                action_ptr = arg;
                 arg++;
                 action_ix = 0;
             }
@@ -16175,6 +16478,12 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
 
         /* success! */
 
+        if (!action_ix)
+            /* slot reserved for next action word not now needed */
+            arg--;
+        else if (pass)
+            action_ptr->uv = action_word;
+
         if (pass) {
             OP *mderef;
             OP *p, *q;
@@ -16524,7 +16833,6 @@ S_check_for_bool_cxt(OP*o, bool safe_and, U8 bool_flag, U8 maybe_flag)
 void
 Perl_rpeep(pTHX_ OP *o)
 {
-    dVAR;
     OP* oldop = NULL;
     OP* oldoldop = NULL;
     OP** defer_queue[MAX_DEFERRED]; /* small queue of deferred branches */
@@ -17377,6 +17685,7 @@ Perl_rpeep(pTHX_ OP *o)
         case OP_AND:
        case OP_OR:
        case OP_DOR:
+       case OP_CMPCHAIN_AND:
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
            while (o->op_next && (   o->op_type == o->op_next->op_type
@@ -17713,7 +18022,7 @@ Perl_rpeep(pTHX_ OP *o)
                 || !r                      /* .... = (); */
                 || !(l & ~AAS_SAFE_SCALAR) /* (undef, pos()) = ...; */
                 || !(r & ~AAS_SAFE_SCALAR) /* ... = (1,2,length,undef); */
-                || (lscalars < 2)          /* ($x, undef) = ... */
+                || (lscalars < 2)          /* (undef, $x) = ... */
             ) {
                 NOOP; /* always safe */
             }
@@ -17829,7 +18138,7 @@ Perl_peep(pTHX_ OP *o)
 }
 
 /*
-=head1 Custom Operators
+=for apidoc_section $custom
 
 =for apidoc Perl_custom_op_xop
 Return the XOP structure for a given custom op.  This macro should be
@@ -17933,6 +18242,7 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
        else
            xop = INT2PTR(XOP *, SvIV(HeVAL(he)));
     }
+
     {
        XOPRETANY any;
        if(field == XOPe_xop_ptr) {
@@ -17954,7 +18264,10 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
                    any.xop_peep = xop->xop_peep;
                    break;
                default:
-                   NOT_REACHED; /* NOTREACHED */
+                  field_panic:
+                    Perl_croak(aTHX_
+                        "panic: custom_op_get_field(): invalid field %d\n",
+                        (int)field);
                    break;
                }
            } else {
@@ -17972,17 +18285,11 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
                    any.xop_peep = XOPd_xop_peep;
                    break;
                default:
-                   NOT_REACHED; /* NOTREACHED */
+                    goto field_panic;
                    break;
                }
            }
        }
-        /* On some platforms (HP-UX, IA64) gcc emits a warning for this function:
-         * op.c: In function 'Perl_custom_op_get_field':
-         * op.c:...: warning: 'any.xop_name' may be used uninitialized in this function [-Wmaybe-uninitialized]
-         * This is because on those platforms (with -DEBUGGING) NOT_REACHED
-         * expands to assert(0), which expands to ((0) ? (void)0 :
-         * __assert(...)), and gcc doesn't know that __assert can never return. */
        return any;
     }
 }
@@ -18233,7 +18540,7 @@ Perl_report_redefined_cv(pTHX_ const SV *name, const CV *old_cv,
 }
 
 /*
-=head1 Hook manipulation
+=for apidoc_section $hook
 
 These functions provide convenient and thread-safe means of manipulating
 hook variables.
@@ -18298,7 +18605,6 @@ void
 Perl_wrap_op_checker(pTHX_ Optype opcode,
     Perl_check_t new_checker, Perl_check_t *old_checker_p)
 {
-    dVAR;
 
     PERL_UNUSED_CONTEXT;
     PERL_ARGS_ASSERT_WRAP_OP_CHECKER;