patch@27385 - VMS thread fixes (was: threads and VMS)
[p5sagit/p5-mst-13.2.git] / pp_ctl.c
index 1ebea19..7ff4858 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -75,7 +75,7 @@ PP(pp_regcomp)
     dSP;
     register PMOP *pm = (PMOP*)cLOGOP->op_other;
     SV *tmpstr;
-    MAGIC *mg = Null(MAGIC*);
+    MAGIC *mg = NULL;
 
     /* prevent recompiling under /o and ithreads. */
 #if defined(USE_ITHREADS)
@@ -133,7 +133,7 @@ PP(pp_regcomp)
        {
            if (PM_GETRE(pm)) {
                ReREFCNT_dec(PM_GETRE(pm));
-               PM_SETRE(pm, Null(REGEXP*));    /* crucial if regcomp aborts */
+               PM_SETRE(pm, NULL);     /* crucial if regcomp aborts */
            }
            if (PL_op->op_flags & OPf_SPECIAL)
                PL_reginterp_cnt = I32_MAX; /* Mark as safe.  */
@@ -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
@@ -383,7 +386,7 @@ Perl_rxres_free(pTHX_ void **rsp)
        }
 #endif
        Safefree(p);
-       *rsp = Null(void*);
+       *rsp = NULL;
     }
 }
 
@@ -1763,7 +1766,7 @@ PP(pp_dbstate)
        hasargs = 0;
        SPAGAIN;
 
-       if (CvXSUB(cv)) {
+       if (CvISXSUB(cv)) {
            CvDEPTH(cv)++;
            PUSHMARK(SP);
            (void)(*CvXSUB(cv))(aTHX_ cv);
@@ -1913,7 +1916,7 @@ PP(pp_leaveloop)
 
     TAINT_NOT;
     if (gimme == G_VOID)
-       ; /* do nothing */
+       /*EMPTY*/; /* do nothing */
     else if (gimme == G_SCALAR) {
        if (mark < SP)
            *++newsp = sv_mortalcopy(*SP);
@@ -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)
@@ -2352,7 +2355,7 @@ PP(pp_goto)
                    PAD_SVl(0) = (SV*)(cx->blk_sub.argarray = av);
                }
            }
-           else if (CvXSUB(cv)) {      /* put GvAV(defgv) back onto stack */
+           else if (CvISXSUB(cv)) {    /* put GvAV(defgv) back onto stack */
                AV* const av = GvAV(PL_defgv);
                items = AvFILLp(av) + 1;
                EXTEND(SP, items+1); /* @_ could have been extended. */
@@ -2369,47 +2372,27 @@ PP(pp_goto)
            /* Now do some callish stuff. */
            SAVETMPS;
            SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
-           if (CvXSUB(cv)) {
-               OP* retop = cx->blk_sub.retop;
+           if (CvISXSUB(cv)) {
+               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;
@@ -2417,11 +2400,11 @@ PP(pp_goto)
                    cx->blk_sub.hasargs = 0;
                }
                cx->blk_sub.cv = cv;
-               cx->blk_sub.olddepth = (U16)CvDEPTH(cv);
+               cx->blk_sub.olddepth = CvDEPTH(cv);
 
                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;
@@ -3018,7 +3012,7 @@ S_check_type_and_open(pTHX_ const char *name, const char *mode)
     Stat_t st;
     const int st_rc = PerlLIO_stat(name, &st);
     if (st_rc < 0) {
-       return Nullfp;
+       return NULL;
     }
 
     if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
@@ -3203,14 +3197,14 @@ 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)) {
                                        PerlIO_close(IoOFP(io));
                                    }
-                                   IoIFP(io) = Nullfp;
-                                   IoOFP(io) = Nullfp;
+                                   IoIFP(io) = NULL;
+                                   IoOFP(io) = NULL;
                                }
                            }
 
@@ -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;