This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "postpone perl_parse() exit(0) bugfix"
[perl5.git] / sv_inline.h
index 2c2eff2..5743348 100644 (file)
@@ -735,9 +735,9 @@ Perl_SvPADSTALE_off(SV *sv)
 
 /*
 =for apidoc_section $SV
-=for apidoc SvIV
-=for apidoc_item SvIVx
+=for apidoc      SvIV
 =for apidoc_item SvIV_nomg
+=for apidoc_item SvIVx
 
 These each coerce the given SV to IV and return it.  The returned value in many
 circumstances will get stored in C<sv>'s IV slot, but not in all cases.  (Use
@@ -750,9 +750,9 @@ guaranteed to evaluate C<sv> only once.
 
 C<SvIV_nomg> is the same as C<SvIV>, but does not perform 'get' magic.
 
-=for apidoc SvNV
-=for apidoc_item SvNVx
+=for apidoc      SvNV
 =for apidoc_item SvNV_nomg
+=for apidoc_item SvNVx
 
 These each coerce the given SV to NV and return it.  The returned value in many
 circumstances will get stored in C<sv>'s NV slot, but not in all cases.  (Use
@@ -765,9 +765,9 @@ guaranteed to evaluate C<sv> only once.
 
 C<SvNV_nomg> is the same as C<SvNV>, but does not perform 'get' magic.
 
-=for apidoc SvUV
-=for apidoc_item SvUVx
+=for apidoc      SvUV
 =for apidoc_item SvUV_nomg
+=for apidoc_item SvUVx
 
 These each coerce the given SV to UV and return it.  The returned value in many
 circumstances will get stored in C<sv>'s UV slot, but not in all cases.  (Use
@@ -849,6 +849,110 @@ S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
 }
 #endif
 
+PERL_STATIC_INLINE char *
+Perl_sv_pvutf8n_force_wrapper(pTHX_ SV * const sv, STRLEN * const lp, const U32 dummy)
+{
+    /* This is just so can be passed to Perl_SvPV_helper() as a function
+     * pointer with the same signature as all the other such pointers, and
+     * having hence an unused parameter */
+    PERL_ARGS_ASSERT_SV_PVUTF8N_FORCE_WRAPPER;
+    PERL_UNUSED_ARG(dummy);
+
+    return sv_pvutf8n_force(sv, lp);
+}
+
+PERL_STATIC_INLINE char *
+Perl_sv_pvbyten_force_wrapper(pTHX_ SV * const sv, STRLEN * const lp, const U32 dummy)
+{
+    /* This is just so can be passed to Perl_SvPV_helper() as a function
+     * pointer with the same signature as all the other such pointers, and
+     * having hence an unused parameter */
+    PERL_ARGS_ASSERT_SV_PVBYTEN_FORCE_WRAPPER;
+    PERL_UNUSED_ARG(dummy);
+
+    return sv_pvbyten_force(sv, lp);
+}
+
+PERL_STATIC_INLINE char *
+Perl_SvPV_helper(pTHX_
+                 SV * const sv,
+                 STRLEN * const lp,
+                 const U32 flags,
+                 const PL_SvPVtype type,
+                 char * (*non_trivial)(pTHX_ SV *, STRLEN * const, const U32),
+                 const bool or_null,
+                 const U32 return_flags
+                )
+{
+    /* 'type' should be known at compile time, so this is reduced to a single
+     * conditional at runtime */
+    if (   (type == SvPVbyte_type_      && SvPOK_byte_nog(sv))
+        || (type == SvPVforce_type_     && SvPOK_pure_nogthink(sv))
+        || (type == SvPVutf8_type_      && SvPOK_utf8_nog(sv))
+        || (type == SvPVnormal_type_    && SvPOK_nog(sv))
+        || (type == SvPVutf8_pure_type_ && SvPOK_utf8_pure_nogthink(sv))
+        || (type == SvPVbyte_pure_type_ && SvPOK_byte_pure_nogthink(sv))
+   ) {
+        if (lp) {
+            *lp = SvCUR(sv);
+        }
+
+        /* Similarly 'return_flags is known at compile time, so this becomes
+         * branchless */
+        if (return_flags & SV_MUTABLE_RETURN) {
+            return SvPVX_mutable(sv);
+        }
+        else if(return_flags & SV_CONST_RETURN) {
+            return (char *) SvPVX_const(sv);
+        }
+        else {
+            return SvPVX(sv);
+        }
+    }
+
+    if (or_null) {  /* This is also known at compile time */
+        if (flags & SV_GMAGIC) {    /* As is this */
+            SvGETMAGIC(sv);
+        }
+
+        if (! SvOK(sv)) {
+            if (lp) {   /* As is this */
+                *lp = 0;
+            }
+
+            return NULL;
+        }
+    }
+
+    /* Can't trivially handle this, call the function */
+    return non_trivial(aTHX_ sv, lp, (flags|return_flags));
+}
+
+/*
+=for apidoc newRV_noinc
+
+Creates an RV wrapper for an SV.  The reference count for the original
+SV is B<not> incremented.
+
+=cut
+*/
+
+PERL_STATIC_INLINE SV *
+Perl_newRV_noinc(pTHX_ SV *const tmpRef)
+{
+    SV *sv = newSV_type(SVt_IV);
+
+    PERL_ARGS_ASSERT_NEWRV_NOINC;
+
+    SvTEMP_off(tmpRef);
+
+    /* inlined, simplified sv_setrv_noinc(sv, tmpRef); */
+    SvRV_set(sv, tmpRef);
+    SvROK_on(sv);
+
+    return sv;
+}
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */