patch@27385 - VMS thread fixes (was: threads and VMS)
[p5sagit/p5-mst-13.2.git] / pp_ctl.c
index 80113a4..7ff4858 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -304,6 +304,7 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx)
 {
     UV *p = (UV*)*rsp;
     U32 i;
+    PERL_UNUSED_CONTEXT;
 
     if (!p || p[1] < rx->nparens) {
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -341,6 +342,7 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
 {
     UV *p = (UV*)*rsp;
     U32 i;
+    PERL_UNUSED_CONTEXT;
 
     RX_MATCH_COPY_FREE(rx);
     RX_MATCH_COPIED_set(rx, *p);
@@ -367,6 +369,7 @@ void
 Perl_rxres_free(pTHX_ void **rsp)
 {
     UV * const p = (UV*)*rsp;
+    PERL_UNUSED_CONTEXT;
 
     if (p) {
 #ifdef PERL_POISON
@@ -2314,7 +2317,7 @@ PP(pp_goto)
            }
 
            /* First do some returnish stuff. */
-           (void)SvREFCNT_inc(cv); /* avoid premature free during unwind */
+           SvREFCNT_inc_simple_void(cv); /* avoid premature free during unwind */
            FREETMPS;
            cxix = dopoptosub(cxstack_ix);
            if (cxix < 0)
@@ -2370,46 +2373,26 @@ PP(pp_goto)
            SAVETMPS;
            SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
            if (CvISXSUB(cv)) {
-               OP* retop = cx->blk_sub.retop;
+               OP* const retop = cx->blk_sub.retop;
+               SV **newsp;
+               I32 gimme;
                if (reified) {
                    I32 index;
                    for (index=0; index<items; index++)
                        sv_2mortal(SP[-index]);
                }
-#ifdef PERL_XSUB_OLDSTYLE
-               if (CvOLDSTYLE(cv)) {
-                   I32 (*fp3)(int,int,int);
-                   while (SP > mark) {
-                       SP[1] = SP[0];
-                       SP--;
-                   }
-                   fp3 = (I32(*)(int,int,int))CvXSUB(cv);
-                   items = (*fp3)(CvXSUBANY(cv).any_i32,
-                                  mark - PL_stack_base + 1,
-                                  items);
-                   SP = PL_stack_base + items;
-               }
-               else
-#endif /* PERL_XSUB_OLDSTYLE */
-               {
-                   SV **newsp;
-                   I32 gimme;
 
-                   /* XS subs don't have a CxSUB, so pop it */
-                   POPBLOCK(cx, PL_curpm);
-                   /* Push a mark for the start of arglist */
-                   PUSHMARK(mark);
-                   PUTBACK;
-                   (void)(*CvXSUB(cv))(aTHX_ cv);
-                   /* Put these at the bottom since the vars are set but not used */
-                   PERL_UNUSED_VAR(newsp);
-                   PERL_UNUSED_VAR(gimme);
-               }
+               /* XS subs don't have a CxSUB, so pop it */
+               POPBLOCK(cx, PL_curpm);
+               /* Push a mark for the start of arglist */
+               PUSHMARK(mark);
+               PUTBACK;
+               (void)(*CvXSUB(cv))(aTHX_ cv);
                LEAVE;
                return retop;
            }
            else {
-               AV* padlist = CvPADLIST(cv);
+               AV* const padlist = CvPADLIST(cv);
                if (CxTYPE(cx) == CXt_EVAL) {
                    PL_in_eval = cx->blk_eval.old_in_eval;
                    PL_eval_root = cx->blk_eval.old_eval_root;
@@ -2421,7 +2404,7 @@ PP(pp_goto)
 
                CvDEPTH(cv)++;
                if (CvDEPTH(cv) < 2)
-                   (void)SvREFCNT_inc(cv);
+                   SvREFCNT_inc_void_NN(cv);
                else {
                    if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION))
                        sub_crush_depth(cv);
@@ -2431,16 +2414,15 @@ PP(pp_goto)
                PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
                if (cx->blk_sub.hasargs)
                {
-                   AV* av = (AV*)PAD_SVl(0);
-                   SV** ary;
+                   AV* const av = (AV*)PAD_SVl(0);
 
                    cx->blk_sub.savearray = GvAV(PL_defgv);
-                   GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
+                   GvAV(PL_defgv) = (AV*)SvREFCNT_inc_simple(av);
                    CX_CURPAD_SAVE(cx->blk_sub);
                    cx->blk_sub.argarray = av;
 
                    if (items >= AvMAX(av) + 1) {
-                       ary = AvALLOC(av);
+                       SV **ary = AvALLOC(av);
                        if (AvARRAY(av) != ary) {
                            AvMAX(av) += AvARRAY(av) - AvALLOC(av);
                            SvPV_set(av, (char*)ary);
@@ -2473,8 +2455,6 @@ PP(pp_goto)
                     * it's for informational purposes only.
                     */
                    SV * const sv = GvSV(PL_DBsub);
-                   CV *gotocv;
-
                    save_item(sv);
                    if (PERLDB_SUB_NN) {
                        const int type = SvTYPE(sv);
@@ -2485,11 +2465,13 @@ PP(pp_goto)
                    } else {
                        gv_efullname3(sv, CvGV(cv), NULL);
                    }
-                   if (  PERLDB_GOTO
-                         && (gotocv = get_cv("DB::goto", FALSE)) ) {
-                       PUSHMARK( PL_stack_sp );
-                       call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG);
-                       PL_stack_sp--;
+                   if (PERLDB_GOTO) {
+                       CV * const gotocv = get_cv("DB::goto", FALSE);
+                       if (gotocv) {
+                           PUSHMARK( PL_stack_sp );
+                           call_sv((SV*)gotocv, G_SCALAR | G_NODEBUG);
+                           PL_stack_sp--;
+                       }
                    }
                }
                RETURNOP(CvSTART(cv));
@@ -2643,7 +2625,13 @@ PP(pp_exit)
 #endif
     }
     PL_exit_flags |= PERL_EXIT_EXPECTED;
+#ifdef PERL_MAD
+    /* KLUDGE: disable exit 0 in BEGIN blocks when we're just compiling */
+    if (anum || !(PL_minus_c && PL_madskills))
+       my_exit(anum);
+#else
     my_exit(anum);
+#endif
     PUSHs(&PL_sv_undef);
     RETURN;
 }
@@ -2814,7 +2802,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     (*startop)->op_ppaddr = PL_ppaddr[OP_NULL];
     lex_end();
     /* XXX DAPM do this properly one year */
-    *padp = (AV*)SvREFCNT_inc(PL_comppad);
+    *padp = (AV*)SvREFCNT_inc_simple(PL_comppad);
     LEAVE;
     if (IN_PERL_COMPILETIME)
        PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
@@ -2896,14 +2884,15 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     cxstack[cxstack_ix].blk_eval.cv = PL_compcv;
 
     CvOUTSIDE_SEQ(PL_compcv) = seq;
-    CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outside);
+    CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc_simple(outside);
 
     /* set up a scratch pad */
 
     CvPADLIST(PL_compcv) = pad_new(padnew_SAVE);
 
 
-    SAVEMORTALIZESV(PL_compcv);        /* must remain until end of current statement */
+    if (!PL_madskills)
+       SAVEMORTALIZESV(PL_compcv);     /* must remain until end of current statement */
 
     /* make sure we compile in the right package */
 
@@ -2916,6 +2905,11 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
     SAVEFREESV(PL_beginav);
     SAVEI32(PL_error_count);
 
+#ifdef PERL_MAD
+    SAVEI32(PL_madskills);
+    PL_madskills = 0;
+#endif
+
     /* try to compile it */
 
     PL_eval_root = NULL;
@@ -3203,7 +3197,7 @@ PP(pp_require)
                                       save the gv to manage the lifespan of
                                       the pipe, but this didn't help. XXX */
                                    filter_child_proc = (GV *)arg;
-                                   (void)SvREFCNT_inc(filter_child_proc);
+                                   SvREFCNT_inc_simple_void(filter_child_proc);
                                }
                                else {
                                    if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
@@ -3221,11 +3215,11 @@ PP(pp_require)
 
                        if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVCV) {
                            filter_sub = arg;
-                           (void)SvREFCNT_inc(filter_sub);
+                           SvREFCNT_inc_void_NN(filter_sub);
 
                            if (i < count) {
                                filter_state = SP[i];
-                               (void)SvREFCNT_inc(filter_state);
+                               SvREFCNT_inc_simple_void(filter_state);
                            }
 
                            if (!tryrsfp) {
@@ -3360,7 +3354,7 @@ PP(pp_require)
     } else {
        SV** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
        if (!svp)
-           (void)hv_store(GvHVn(PL_incgv), name, len, SvREFCNT_inc(hook_sv), 0 );
+           (void)hv_store(GvHVn(PL_incgv), name, len, SvREFCNT_inc_simple(hook_sv), 0 );
     }
 
     ENTER;
@@ -3673,11 +3667,10 @@ PP(pp_leavegiven)
     I32 gimme;
     SV **newsp;
     PMOP *newpm;
-    SV **mark;
+    PERL_UNUSED_CONTEXT;
 
     POPBLOCK(cx,newpm);
     assert(CxTYPE(cx) == CXt_GIVEN);
-    mark = newsp;
 
     SP = newsp;
     PUTBACK;