This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make two functions for 5.005 backcompat MATHOMS
[perl5.git] / inline.h
index 99fe4ad..35983d8 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -321,7 +321,7 @@ S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char
 /*
 
 Return true if the supplied filename has a newline character
-immediately before the final NUL.
+immediately before the first (hopefully only) NUL.
 
 My original look at this incorrectly used the len from SvPV(), but
 that's incorrect, since we allow for a NUL in pv[len-1].
@@ -418,12 +418,12 @@ S_cx_pushblock(pTHX_ U8 type, U8 gimme, SV** sp, I32 saveix)
     cx->cx_type        = type;
     cx->blk_gimme      = gimme;
     cx->blk_oldsaveix  = saveix;
-    cx->blk_oldsp      = sp - PL_stack_base;
+    cx->blk_oldsp      = (I32)(sp - PL_stack_base);
     cx->blk_oldcop     = PL_curcop;
-    cx->blk_oldmarksp  = PL_markstack_ptr - PL_markstack;
+    cx->blk_oldmarksp  = (I32)(PL_markstack_ptr - PL_markstack);
     cx->blk_oldscopesp = PL_scopestack_ix;
     cx->blk_oldpm      = PL_curpm;
-    cx->cx_u.cx_blk.blku_old_tmpsfloor = PL_tmps_floor;
+    cx->blk_old_tmpsfloor = PL_tmps_floor;
 
     PL_tmps_floor        = PL_tmps_ix;
     CX_DEBUG(cx, "PUSH");
@@ -450,7 +450,7 @@ S_cx_popblock(pTHX_ PERL_CONTEXT *cx)
     assert(   (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx))
             || PL_savestack_ix == cx->blk_oldsaveix);
     PL_curcop     = cx->blk_oldcop;
-    PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
+    PL_tmps_floor = cx->blk_old_tmpsfloor;
 }
 
 /* Continue a block elsewhere (e.g. NEXT, REDO, GOTO).
@@ -480,12 +480,7 @@ S_cx_pushsub(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, bool hasargs)
 
     PERL_ARGS_ASSERT_CX_PUSHSUB;
 
-    ENTRY_PROBE(CvNAMED(cv)
-                    ? HEK_KEY(CvNAME_HEK(cv))
-                    : GvENAME(CvGV(cv)),
-                CopFILE((const COP *)CvSTART(cv)),
-                CopLINE((const COP *)CvSTART(cv)),
-                CopSTASHPV((const COP *)CvSTART(cv)));
+    PERL_DTRACE_PROBE_ENTRY(cv);
     cx->blk_sub.cv = cv;
     cx->blk_sub.olddepth = CvDEPTH(cv);
     cx->blk_sub.prevcomppad = PL_comppad;
@@ -545,12 +540,7 @@ S_cx_popsub(pTHX_ PERL_CONTEXT *cx)
     PERL_ARGS_ASSERT_CX_POPSUB;
     assert(CxTYPE(cx) == CXt_SUB);
 
-    RETURN_PROBE(CvNAMED(cx->blk_sub.cv)
-                    ? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv))
-                    : GvENAME(CvGV(cx->blk_sub.cv)),
-            CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),
-            CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),
-            CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv)));
+    PERL_DTRACE_PROBE_RETURN(cx->blk_sub.cv);
 
     if (CxHASARGS(cx))
         cx_popsub_args(cx);
@@ -708,6 +698,54 @@ S_cx_poploop(pTHX_ PERL_CONTEXT *cx)
     }
 }
 
+
+PERL_STATIC_INLINE void
+S_cx_pushwhen(pTHX_ PERL_CONTEXT *cx)
+{
+    PERL_ARGS_ASSERT_CX_PUSHWHEN;
+
+    cx->blk_givwhen.leave_op = cLOGOP->op_other;
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_popwhen(pTHX_ PERL_CONTEXT *cx)
+{
+    PERL_ARGS_ASSERT_CX_POPWHEN;
+    assert(CxTYPE(cx) == CXt_WHEN);
+
+    PERL_UNUSED_ARG(cx);
+    /* currently NOOP */
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_pushgiven(pTHX_ PERL_CONTEXT *cx, SV *orig_defsv)
+{
+    PERL_ARGS_ASSERT_CX_PUSHGIVEN;
+
+    cx->blk_givwhen.leave_op = cLOGOP->op_other;
+    cx->blk_givwhen.defsv_save = orig_defsv;
+}
+
+
+PERL_STATIC_INLINE void
+S_cx_popgiven(pTHX_ PERL_CONTEXT *cx)
+{
+    SV *sv;
+
+    PERL_ARGS_ASSERT_CX_POPGIVEN;
+    assert(CxTYPE(cx) == CXt_GIVEN);
+
+    sv = GvSV(PL_defgv);
+    GvSV(PL_defgv) = cx->blk_givwhen.defsv_save;
+    cx->blk_givwhen.defsv_save = NULL;
+    SvREFCNT_dec(sv);
+}
+
+
+
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */