Smoke me/davem/rc stack1

MANIFEST

@@ -4731,6 +4731,7 @@ ext/XS-APItest/t/whichsig.t	XS::APItest: tests for whichsig() and variants
 ext/XS-APItest/t/win32.t	Test Win32 specific APIs
 ext/XS-APItest/t/xs_special_subs.t	Test that XS BEGIN/CHECK/INIT/END work
 ext/XS-APItest/t/xs_special_subs_require.t	for require too
+ext/XS-APItest/t/xsppwrap.t	Tests for XSPP_wrapped() macro
 ext/XS-APItest/t/xsub_h.t	Tests for XSUB.h
 ext/XS-APItest/typemap
 ext/XS-APItest/XSUB-redefined-macros.xs	XS code needing redefined macros.

autodoc.pl

@@ -138,6 +138,7 @@
 my $MRO_scn = 'MRO';
 my $multicall_scn = 'Multicall Functions';
 my $numeric_scn = 'Numeric Functions';
+my $rpp_scn = 'Reference-counted stack manipulation';
 
 # Now combined, as unclear which functions go where, but separate names kept
 # to avoid 1) other code changes; 2) in case it seems better to split again
@@ -320,6 +321,14 @@
             See L<perlform>.
             EOT
       },
+    $rpp_scn => {
+        header => <<~'EOT',
+            Functions for pushing and pulling items on the stack when the
+            stack is reference counted. They are intended as replacements
+            for the old PUSHs, POPi, EXTEND etc pp macros within pp
+            functions.
+            EOT
+      },
     $signals_scn => {},
     $site_scn => {
         header => <<~'EOT',
@@ -1713,7 +1722,7 @@ sub output {
 
         # We allow empty sections in perlintern.
         if (! $section_info && $podname eq 'perlapi') {
-            warn "Empty section '$section_name'; skipped";
+            warn "Empty section '$section_name' for $podname; skipped";
             next;
         }
 

av.c

@@ -42,8 +42,8 @@ Perl_av_reify(pTHX_ AV *av)
             SvREFCNT_inc_simple_void(sv);
     }
     key = AvARRAY(av) - AvALLOC(av);
-    while (key)
-        AvALLOC(av)[--key] = NULL;
+    if (key)
+        Zero(AvALLOC(av), key, SV*);
     AvREIFY_off(av);
     AvREAL_on(av);
 }
@@ -617,7 +617,6 @@ to it.
 void
 Perl_av_clear(pTHX_ AV *av)
 {
-    SSize_t extra;
     bool real;
     SSize_t orig_ix = 0;
 
@@ -662,12 +661,9 @@ Perl_av_clear(pTHX_ AV *av)
             SvREFCNT_dec(sv);
         }
     }
-    extra = AvARRAY(av) - AvALLOC(av);
-    if (extra) {
-        AvMAX(av) += extra;
-        AvARRAY(av) = AvALLOC(av);
-    }
     AvFILLp(av) = -1;
+    av_remove_offset(av);
+
     if (real) {
         /* disarm av's premature free guard */
         if (LIKELY(PL_tmps_ix == orig_ix))
@@ -886,6 +882,9 @@ Perl_av_unshift(pTHX_ AV *av, SSize_t num)
         AvMAX(av) += i;
         AvFILLp(av) += i;
         AvARRAY(av) = AvARRAY(av) - i;
+#ifdef PERL_RC_STACK
+        Zero(AvARRAY(av), i, SV*);
+#endif
     }
     if (num) {
         SV **ary;
@@ -939,8 +938,10 @@ Perl_av_shift(pTHX_ AV *av)
     if (AvFILL(av) < 0)
       return &PL_sv_undef;
     retval = *AvARRAY(av);
+#ifndef PERL_RC_STACK
     if (AvREAL(av))
         *AvARRAY(av) = NULL;
+#endif
     AvARRAY(av) = AvARRAY(av) + 1;
     AvMAX(av)--;
     AvFILLp(av)--;

cop.h

@@ -860,12 +860,14 @@ struct block_format {
     } STMT_END
 
 /* junk in @_ spells trouble when cloning CVs and in pp_caller(), so don't
- * leave any (a fast av_clear(ary), basically) */
+ * leave any (a fast av_clear(ary), basically).
+ * New code should probably be using Perl_clear_defarray_simple()
+ * and/or Perl_clear_defarray()
+ */
 #define CLEAR_ARGARRAY(ary) \
     STMT_START {							\
-        AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary);			\
-        AvARRAY(ary) = AvALLOC(ary);					\
         AvFILLp(ary) = -1;						\
+        av_remove_offset(ary);                                          \
     } STMT_END
 
 
@@ -1230,6 +1232,15 @@ struct stackinfo {
     I32			si_markoff;	/* offset where markstack begins for us.
                                          * currently used only with DEBUGGING,
                                          * but not #ifdef-ed for bincompat */
+
+#ifdef PERL_RC_STACK
+                                        /* index of first entry in the argument
+                                           stack which is not ref-counted. If
+                                           set to 0 (default), all stack
+                                           elements are ref-counted */
+    I32                 si_stack_nonrc_base;
+#endif
+
 #if defined DEBUGGING && !defined DEBUGGING_RE_ONLY
 /* high water mark: for checking if the stack was correctly extended /
  * tested for extension by each pp function */
@@ -1263,54 +1274,31 @@ typedef struct stackinfo PERL_SI;
 #  define PUSHSTACK_INIT_HWM(si) NOOP
 #endif
 
+/* for backcompat; use push_stackinfo() instead */
+
 #define PUSHSTACKi(type) \
-    STMT_START {							\
-        PERL_SI *next = PL_curstackinfo->si_next;			\
-        DEBUG_l({							\
-            int i = 0; PERL_SI *p = PL_curstackinfo;			\
-            while (p) { i++; p = p->si_prev; }				\
-            Perl_deb(aTHX_ "push STACKINFO %d in %s at %s:%d\n",        \
-                         i, SAFE_FUNCTION__, __FILE__, __LINE__);})        \
-        if (!next) {							\
-            next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1);	\
-            next->si_prev = PL_curstackinfo;				\
-            PL_curstackinfo->si_next = next;				\
-        }								\
-        next->si_type = type;						\
-        next->si_cxix = -1;						\
-        next->si_cxsubix = -1;						\
-        PUSHSTACK_INIT_HWM(next);                                       \
-        AvFILLp(next->si_stack) = 0;					\
-        SWITCHSTACK(PL_curstack,next->si_stack);			\
-        PL_curstackinfo = next;						\
-        SET_MARK_OFFSET;						\
+    STMT_START {		\
+        PL_stack_sp = sp;       \
+        push_stackinfo(type, 0);\
+        sp = PL_stack_sp ;      \
     } STMT_END
 
 #define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN)
 
-/* POPSTACK works with PL_stack_sp, so it may need to be bracketed by
+
+/* for backcompat; use pop_stackinfo() instead.
+ *
+ * POPSTACK works with PL_stack_sp, so it may need to be bracketed by
  * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */
-#define POPSTACK \
-    STMT_START {							\
-        dSP;								\
-        PERL_SI * const prev = PL_curstackinfo->si_prev;		\
-        DEBUG_l({							\
-            int i = -1; PERL_SI *p = PL_curstackinfo;			\
-            while (p) { i++; p = p->si_prev; }				\
-            Perl_deb(aTHX_ "pop  STACKINFO %d in %s at %s:%d\n",        \
-                         i, SAFE_FUNCTION__, __FILE__, __LINE__);})        \
-        if (!prev) {							\
-            Perl_croak_popstack();					\
-        }								\
-        SWITCHSTACK(PL_curstack,prev->si_stack);			\
-        /* don't free prev here, free them all at the END{} */		\
-        PL_curstackinfo = prev;						\
-    } STMT_END
+
+#define POPSTACK pop_stackinfo()
+
 
 #define POPSTACK_TO(s) \
     STMT_START {							\
         while (PL_curstack != s) {					\
             dounwind(-1);						\
+            rpp_obliterate_stack_to(0);					\
             POPSTACK;							\
         }								\
     } STMT_END

deb.c

@@ -133,13 +133,16 @@ Perl_debstackptrs(pTHX)     /* Currently unused in cpan and core */
  * and display the marks whose offsets are contained in addresses
  * PL_markstack[mark_min+1 .. mark_max] and whose values are in the range
  * of the stack values being displayed
+ * On PERL_RC_STACK builds, nonrc_base indicates the lowest
+ * non-reference-counted stack element (or 0 if none or not such a build).
+ * Display a vertical bar at this position.
  *
  * Only displays top 30 max
  */
 
 STATIC void
 S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max,
-        I32 mark_min, I32 mark_max)
+        I32 mark_min, I32 mark_max, I32 nonrc_base)
 {
 #ifdef DEBUGGING
     I32 i = stack_max - 30;
@@ -171,7 +174,11 @@ S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max,
         }
         if (i > stack_max)
             break;
+
         PerlIO_printf(Perl_debug_log, "%-4s  ", SvPEEK(stack_base[i]));
+
+        if (nonrc_base && nonrc_base == i + 1)
+            PerlIO_printf(Perl_debug_log, "|  ");
     }
     while (1);
     PerlIO_printf(Perl_debug_log, "\n");
@@ -182,6 +189,7 @@ S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max,
     PERL_UNUSED_ARG(stack_max);
     PERL_UNUSED_ARG(mark_min);
     PERL_UNUSED_ARG(mark_max);
+    PERL_UNUSED_ARG(nonrc_base);
 #endif /* DEBUGGING */
 }
 
@@ -206,7 +214,13 @@ Perl_debstack(pTHX)
                 0,
                 PL_stack_sp - PL_stack_base,
                 PL_curstackinfo->si_markoff,
-                PL_markstack_ptr - PL_markstack);
+                PL_markstack_ptr - PL_markstack,
+#ifdef PERL_RC_STACK
+                PL_curstackinfo->si_stack_nonrc_base
+#else
+                0
+#endif
+    );
 
 
 #endif /* SKIP_DEBUGGING */
@@ -254,8 +268,16 @@ Perl_deb_stack_all(pTHX)
             si_name_ix < C_ARRAY_LENGTH(si_names) ?
             si_names[si_name_ix] : "????";
         I32 ix;
-        PerlIO_printf(Perl_debug_log, "STACK %" IVdf ": %s\n",
-                                                (IV)si_ix, si_name);
+        PerlIO_printf(Perl_debug_log, "STACK %" IVdf ": %s%s\n",
+                                                (IV)si_ix, si_name,
+#ifdef PERL_RC_STACK
+            AvREAL(si->si_stack)
+                ? (si->si_stack_nonrc_base ? " (partial real)" : " (real)")
+                : ""
+#else
+                ""
+#endif
+        );
 
         for (ix=0; ix<=si->si_cxix; ix++) {
 
@@ -320,7 +342,10 @@ Perl_deb_stack_all(pTHX)
                     }
                     if (CxTYPE(&(si_n->si_cxstack[i])) == CXt_SUBST)
                         continue;
-                    cx_n = &(si_n->si_cxstack[i]);
+                    if (si_n->si_cxix >= 0)
+                        cx_n = &(si_n->si_cxstack[i]);
+                    else
+                        cx_n = NULL;
                     break;
                 }
 
@@ -333,7 +358,13 @@ Perl_deb_stack_all(pTHX)
                 }
 
                 deb_stack_n(AvARRAY(si->si_stack),
-                        stack_min, stack_max, mark_min, mark_max);
+                        stack_min, stack_max, mark_min, mark_max,
+#ifdef PERL_RC_STACK
+                        si->si_stack_nonrc_base
+#else
+                        0
+#endif
+                );
 
                 if (CxTYPE(cx) == CXt_EVAL || CxTYPE(cx) == CXt_SUB
                         || CxTYPE(cx) == CXt_FORMAT)

dist/threads/lib/threads.pm

@@ -5,7 +5,7 @@ use 5.008;
 use strict;
 use warnings;
 
-our $VERSION = '2.34';      # remember to update version in POD!
+our $VERSION = '2.35';      # remember to update version in POD below!
 my $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
@@ -134,7 +134,7 @@ threads - Perl interpreter-based threads
 
 =head1 VERSION
 
-This document describes threads version 2.34
+This document describes threads version 2.35
 
 =head1 WARNING
 

dist/threads/threads.xs

@@ -611,16 +611,20 @@ S_ithread_run(void * arg)
         int ii;
         int jmp_rc;
 
-        dSP;
+#ifdef PERL_RC_STACK
+        assert(rpp_stack_is_rc());
+#endif
+
         ENTER;
         SAVETMPS;
 
         /* Put args on the stack */
-        PUSHMARK(SP);
+        PUSHMARK(PL_stack_sp);
+        rpp_extend(len);
         for (ii=0; ii < len; ii++) {
-            XPUSHs(av_shift(params));
+            SV *sv = av_shift(params);
+            rpp_push_1(sv);
         }
-        PUTBACK;
 
         jmp_rc = S_jmpenv_run(aTHX_ 0, thread, &len, &exit_app, &exit_code);
 
@@ -633,12 +637,12 @@ S_ithread_run(void * arg)
 #endif
 
         /* Remove args from stack and put back in params array */
-        SPAGAIN;
         for (ii=len-1; ii >= 0; ii--) {
-            SV *sv = POPs;
+            SV *sv = *PL_stack_sp;
             if (jmp_rc == 0 && (thread->gimme & G_WANT) != G_VOID) {
                 av_store(params, ii, SvREFCNT_inc(sv));
             }
+            rpp_popfree_1();
         }
 
         FREETMPS;

doio.c

@@ -2225,7 +2225,6 @@ Perl_do_print(pTHX_ SV *sv, PerlIO *fp)
 I32
 Perl_my_stat_flags(pTHX_ const U32 flags)
 {
-    dSP;
     IO *io;
     GV* gv;
 
@@ -2265,7 +2264,7 @@ Perl_my_stat_flags(pTHX_ const U32 flags)
              == OPpFT_STACKED)
         return PL_laststatval;
     else {
-        SV* const sv = TOPs;
+        SV* const sv = *PL_stack_sp;
         const char *s, *d;
         STRLEN len;
         if ((gv = MAYBE_DEREF_GV_flags(sv,flags))) {
@@ -2302,10 +2301,9 @@ I32
 Perl_my_lstat_flags(pTHX_ const U32 flags)
 {
     static const char* const no_prev_lstat = "The stat preceding -l _ wasn't an lstat";
-    dSP;
     const char *file;
     STRLEN len;
-    SV* const sv = TOPs;
+    SV* const sv = *PL_stack_sp;
     bool isio = FALSE;
     if (PL_op->op_flags & OPf_REF) {
         if (cGVOP_gv == PL_defgv) {

doop.c

@@ -1183,8 +1183,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
  * values, or key-value pairs, depending on PL_op.
  */
 
-OP *
-Perl_do_kv(pTHX)
+PP_wrapped(do_kv, 1, 0)
 {
     dSP;
     HV * const keys = MUTABLE_HV(POPs);