This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Partially pessimise in-place sorting
[perl5.git] / cop.h
diff --git a/cop.h b/cop.h
index d346d87..b371379 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -175,8 +175,8 @@ associated with the key.
 /*
 =for apidoc Amx|SV *|cophh_fetch_pvs|const COPHH *cophh|const char *key|U32 flags
 
-Like L</cophh_fetch_pvn>, but takes a literal string instead of a
-string/length pair, and no precomputed hash.
+Like L</cophh_fetch_pvn>, but takes a C<NUL>-terminated literal string instead
+of a string/length pair, and no precomputed hash.
 
 =cut
 */
@@ -281,8 +281,8 @@ be stored with referential integrity, but will be coerced to strings.
 /*
 =for apidoc Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|const char *key|SV *value|U32 flags
 
-Like L</cophh_store_pvn>, but takes a literal string instead of a
-string/length pair, and no precomputed hash.
+Like L</cophh_store_pvn>, but takes a C<NUL>-terminated literal string instead
+of a string/length pair, and no precomputed hash.
 
 =cut
 */
@@ -338,8 +338,8 @@ hash of the key string, or zero if it has not been precomputed.
 /*
 =for apidoc Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|const char *key|U32 flags
 
-Like L</cophh_delete_pvn>, but takes a literal string instead of a
-string/length pair, and no precomputed hash.
+Like L</cophh_delete_pvn>, but takes a C<NUL>-terminated literal string instead
+of a string/length pair, and no precomputed hash.
 
 =cut
 */
@@ -478,8 +478,8 @@ associated with the key.
 /*
 =for apidoc Am|SV *|cop_hints_fetch_pvs|const COP *cop|const char *key|U32 flags
 
-Like L</cop_hints_fetch_pvn>, but takes a literal string instead of a
-string/length pair, and no precomputed hash.
+Like L</cop_hints_fetch_pvn>, but takes a C<NUL>-terminated literal string
+instead of a string/length pair, and no precomputed hash.
 
 =cut
 */
@@ -609,10 +609,10 @@ struct block_format {
 /* Restore old @_ */
 #define CX_POP_SAVEARRAY(cx)                                           \
     STMT_START {                                                       \
-        AV *av = GvAV(PL_defgv);                                        \
+        AV *cx_pop_savearray_av = GvAV(PL_defgv);                       \
        GvAV(PL_defgv) = cx->blk_sub.savearray;                         \
         cx->blk_sub.savearray = NULL;                                   \
-        SvREFCNT_dec(av);                                              \
+        SvREFCNT_dec(cx_pop_savearray_av);                             \
     } STMT_END
 
 /* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't
@@ -707,26 +707,6 @@ struct block_givwhen {
         SV *defsv_save; /* the original $_ */
 };
 
-#define CX_PUSHWHEN(cx)                                                \
-       cx->blk_givwhen.leave_op = cLOGOP->op_other;
-
-#define CX_PUSHGIVEN(cx, orig_var)                                      \
-        CX_PUSHWHEN(cx);                                                \
-        cx->blk_givwhen.defsv_save = orig_var;
-
-#define CX_POPWHEN(cx)                                                  \
-        assert(CxTYPE(cx) == CXt_WHEN);                                 \
-       NOOP;
-
-#define CX_POPGIVEN(cx)                                                 \
-    STMT_START {                                                       \
-        SV *sv = GvSV(PL_defgv);                                        \
-        assert(CxTYPE(cx) == CXt_GIVEN);                                \
-        GvSV(PL_defgv) = cx->blk_givwhen.defsv_save;                    \
-        cx->blk_givwhen.defsv_save = NULL;                              \
-        SvREFCNT_dec(sv);                                               \
-    } STMT_END
-
 
 
 /* context common to subroutines, evals and loops */
@@ -759,6 +739,7 @@ struct block {
 #define blk_gimme      cx_u.cx_blk.blku_gimme
 #define blk_u16                cx_u.cx_blk.blku_u16
 #define blk_oldsaveix   cx_u.cx_blk.blku_oldsaveix
+#define blk_old_tmpsfloor cx_u.cx_blk.blku_old_tmpsfloor
 #define blk_sub                cx_u.cx_blk.blk_u.blku_sub
 #define blk_format     cx_u.cx_blk.blk_u.blku_format
 #define blk_eval       cx_u.cx_blk.blk_u.blku_eval
@@ -866,12 +847,12 @@ struct context {
 
 /* be careful of the ordering of these five. Macros like CxTYPE_is_LOOP,
  * CxFOREACH compare ranges */
-#define CXt_LOOP_ARY   4 /* for (@ary)     {} */
-#define CXt_LOOP_LAZYSV        5 /* for ('a'..'z') {} */
-#define CXt_LOOP_LAZYIV        6 /* for (1..9)     {} */
-#define CXt_LOOP_LIST  7 /* for (1,2,3)    {} */
-#define CXt_LOOP_PLAIN 8 /*                {} */
-
+#define CXt_LOOP_ARY   4 /* for (@ary)     { ...; } */
+#define CXt_LOOP_LAZYSV        5 /* for ('a'..'z') { ...; } */
+#define CXt_LOOP_LAZYIV        6 /* for (1..9)     { ...; } */
+#define CXt_LOOP_LIST  7 /* for (1,2,3)    { ...; } */
+#define CXt_LOOP_PLAIN 8 /* while (...)    { ...; }
+                             or plain block { ...; } */
 #define CXt_SUB                9
 #define CXt_FORMAT     10
 #define CXt_EVAL       11
@@ -1074,8 +1055,8 @@ typedef struct stackinfo PERL_SI;
        }                                                               \
     } STMT_END
 
-#define IN_PERL_COMPILETIME    (PL_curcop == &PL_compiling)
-#define IN_PERL_RUNTIME                (PL_curcop != &PL_compiling)
+#define IN_PERL_COMPILETIME    cBOOL(PL_curcop == &PL_compiling)
+#define IN_PERL_RUNTIME                cBOOL(PL_curcop != &PL_compiling)
 
 
 
@@ -1101,13 +1082,8 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 */
 
 #define dMULTICALL \
-    SV **newsp;                        /* set by cx_popblock */                \
-    PERL_CONTEXT *cx;                                                  \
-    CV *multicall_cv;                                                  \
-    OP *multicall_cop;                                                 \
-    bool multicall_oldcatch;                                           \
-    I32 saveix_floor;                                                   \
-    U8 hasargs = 0             /* used by CX_PUSHSUB */
+    OP  *multicall_cop;                                                        \
+    bool multicall_oldcatch
 
 #define PUSH_MULTICALL(the_cv) \
     PUSH_MULTICALL_FLAGS(the_cv, 0)
@@ -1117,24 +1093,22 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 
 #define PUSH_MULTICALL_FLAGS(the_cv, flags) \
     STMT_START {                                                       \
+        PERL_CONTEXT *cx;                                              \
        CV * const _nOnclAshIngNamE_ = the_cv;                          \
        CV * const cv = _nOnclAshIngNamE_;                              \
        PADLIST * const padlist = CvPADLIST(cv);                        \
        multicall_oldcatch = CATCH_GET;                                 \
        CATCH_SET(TRUE);                                                \
        PUSHSTACKi(PERLSI_MULTICALL);                                   \
-       cx = cx_pushblock((CXt_SUB|CXp_MULTICALL|flags), gimme,         \
+       cx = cx_pushblock((CXt_SUB|CXp_MULTICALL|flags), (U8)gimme,     \
                   PL_stack_sp, PL_savestack_ix);                       \
-       cx_pushsub(cx, cv, NULL, cBOOL(hasargs));                       \
+        cx_pushsub(cx, cv, NULL, 0);                                    \
        SAVEOP();                                                       \
-        saveix_floor = PL_savestack_ix;                                 \
         if (!(flags & CXp_SUB_RE_FAKE))                                 \
             CvDEPTH(cv)++;                                             \
        if (CvDEPTH(cv) >= 2)                                           \
            Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));                  \
        PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));                       \
-       multicall_cv = cv;                                              \
-        PERL_UNUSED_VAR(multicall_cv); /* for API */                    \
        multicall_cop = CvSTART(cv);                                    \
     } STMT_END
 
@@ -1142,18 +1116,15 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
     STMT_START {                                                       \
        PL_op = multicall_cop;                                          \
        CALLRUNOPS(aTHX);                                               \
-        cx = CX_CUR();                                                 \
-        LEAVE_SCOPE(saveix_floor);                                      \
     } STMT_END
 
 #define POP_MULTICALL \
     STMT_START {                                                       \
+        PERL_CONTEXT *cx;                                              \
        cx = CX_CUR();                                                  \
        CX_LEAVE_SCOPE(cx);                                             \
         cx_popsub_common(cx);                                           \
-        newsp = PL_stack_base + cx->blk_oldsp;                          \
         gimme = cx->blk_gimme;                                          \
-        PERL_UNUSED_VAR(newsp); /* for API */                           \
         PERL_UNUSED_VAR(gimme); /* for API */                           \
        cx_popblock(cx);                                                \
        CX_POP(cx);                                                     \
@@ -1170,17 +1141,16 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
        CV * const _nOnclAshIngNamE_ = the_cv;                          \
        CV * const cv = _nOnclAshIngNamE_;                              \
        PADLIST * const padlist = CvPADLIST(cv);                        \
-       cx = CX_CUR();                                                  \
+        PERL_CONTEXT *cx = CX_CUR();                                   \
        assert(CxMULTICALL(cx));                                        \
         cx_popsub_common(cx);                                           \
        cx->cx_type = (CXt_SUB|CXp_MULTICALL|flags);                    \
-        cx_pushsub(cx, cv, NULL, cBOOL(hasargs));                      \
+        cx_pushsub(cx, cv, NULL, 0);                                   \
         if (!(flags & CXp_SUB_RE_FAKE))                                 \
             CvDEPTH(cv)++;                                             \
        if (CvDEPTH(cv) >= 2)                                           \
            Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));                  \
        PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));                       \
-       multicall_cv = cv;                                              \
        multicall_cop = CvSTART(cv);                                    \
     } STMT_END
 /*