lib/perl5db.pl: Generalize for EBCDIC

[perl5.git] / inline.h

diff --git a/inline.h b/inline.h
index dd0eae6..1124412 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -25,6 +25,14 @@ S_av_top_index(pTHX_ AV *av)
 
 /* ------------------------------- cv.h ------------------------------- */
 
+PERL_STATIC_INLINE GV *
+S_CvGV(pTHX_ CV *sv)
+{
+    return CvNAMED(sv)
+       ? Perl_cvgv_from_hek(aTHX_ sv)
+       : ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_gv;
+}
+
 PERL_STATIC_INLINE I32 *
 S_CvDEPTHp(const CV * const sv)
 {
@@ -82,6 +90,41 @@ S_MgBYTEPOS(pTHX_ MAGIC *mg, SV *sv, const char *s, STRLEN len)
 }
 #endif
 
+/* ------------------------------- pad.h ------------------------------ */
+
+#if defined(PERL_IN_PAD_C) || defined(PERL_IN_OP_C)
+PERL_STATIC_INLINE bool
+PadnameIN_SCOPE(const PADNAME * const pn, const U32 seq)
+{
+    /* is seq within the range _LOW to _HIGH ?
+     * This is complicated by the fact that PL_cop_seqmax
+     * may have wrapped around at some point */
+    if (COP_SEQ_RANGE_LOW(pn) == PERL_PADSEQ_INTRO)
+       return FALSE; /* not yet introduced */
+
+    if (COP_SEQ_RANGE_HIGH(pn) == PERL_PADSEQ_INTRO) {
+    /* in compiling scope */
+       if (
+           (seq >  COP_SEQ_RANGE_LOW(pn))
+           ? (seq - COP_SEQ_RANGE_LOW(pn) < (U32_MAX >> 1))
+           : (COP_SEQ_RANGE_LOW(pn) - seq > (U32_MAX >> 1))
+       )
+           return TRUE;
+    }
+    else if (
+       (COP_SEQ_RANGE_LOW(pn) > COP_SEQ_RANGE_HIGH(pn))
+       ?
+           (  seq >  COP_SEQ_RANGE_LOW(pn)
+           || seq <= COP_SEQ_RANGE_HIGH(pn))
+
+       :    (  seq >  COP_SEQ_RANGE_LOW(pn)
+            && seq <= COP_SEQ_RANGE_HIGH(pn))
+    )
+       return TRUE;
+    return FALSE;
+}
+#endif
+
 /* ----------------------------- regexp.h ----------------------------- */
 
 PERL_STATIC_INLINE struct regexp *
@@ -148,27 +191,15 @@ SvAMAGIC_off(SV *sv)
 }
 
 PERL_STATIC_INLINE U32
-S_SvPADTMP_on(SV *sv)
-{
-    assert(!(SvFLAGS(sv) & SVs_PADMY));
-    return SvFLAGS(sv) |= SVs_PADTMP;
-}
-PERL_STATIC_INLINE U32
-S_SvPADTMP_off(SV *sv)
-{
-    assert(!(SvFLAGS(sv) & SVs_PADMY));
-    return SvFLAGS(sv) &= ~SVs_PADTMP;
-}
-PERL_STATIC_INLINE U32
 S_SvPADSTALE_on(SV *sv)
 {
-    assert(SvFLAGS(sv) & SVs_PADMY);
+    assert(!(SvFLAGS(sv) & SVs_PADTMP));
     return SvFLAGS(sv) |= SVs_PADSTALE;
 }
 PERL_STATIC_INLINE U32
 S_SvPADSTALE_off(SV *sv)
 {
-    assert(SvFLAGS(sv) & SVs_PADMY);
+    assert(!(SvFLAGS(sv) & SVs_PADTMP));
     return SvFLAGS(sv) &= ~SVs_PADSTALE;
 }
 #if defined(PERL_CORE) || defined (PERL_EXT)
@@ -188,17 +219,16 @@ S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
 /* ------------------------------- handy.h ------------------------------- */
 
 /* saves machine code for a common noreturn idiom typically used in Newx*() */
-#ifdef __clang__
-#pragma clang diagnostic push
-#pragma clang diagnostic ignored "-Wunused-function"
+#ifdef GCC_DIAG_PRAGMA
+GCC_DIAG_IGNORE(-Wunused-function) /* Intentionally left semicolonless. */
 #endif
 static void
 S_croak_memory_wrap(void)
 {
     Perl_croak_nocontext("%s",PL_memory_wrap);
 }
-#ifdef __clang__
-#pragma clang diagnostic pop
+#ifdef GCC_DIAG_PRAGMA
+GCC_DIAG_RESTORE /* Intentionally left semicolonless. */
 #endif
 
 /* ------------------------------- utf8.h ------------------------------- */
@@ -252,6 +282,8 @@ S__is_utf8_char_slow(const U8 *s, const U8 *e)
 /* ------------------------------- perl.h ----------------------------- */
 
 /*
+=head1 Miscellaneous Functions
+
 =for apidoc AiR|bool|is_safe_syscall|const char *pv|STRLEN len|const char *what|const char *op_name
 
 Test that the given C<pv> doesn't contain any internal C<NUL> characters.
@@ -272,7 +304,7 @@ S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char
 
     PERL_ARGS_ASSERT_IS_SAFE_SYSCALL;
 
-    if (pv && len > 1) {
+    if (len > 1) {
         char *null_at;
         if (UNLIKELY((null_at = (char *)memchr(pv, 0, len-1)) != NULL)) {
                 SETERRNO(ENOENT, LIB_INVARG);
@@ -318,6 +350,57 @@ S_should_warn_nl(const char *pv) {
 
 #endif
 
+/* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */
+
+#define MAX_CHARSET_NAME_LENGTH 2
+
+PERL_STATIC_INLINE const char *
+get_regex_charset_name(const U32 flags, STRLEN* const lenp)
+{
+    /* Returns a string that corresponds to the name of the regex character set
+     * given by 'flags', and *lenp is set the length of that string, which
+     * cannot exceed MAX_CHARSET_NAME_LENGTH characters */
+
+    *lenp = 1;
+    switch (get_regex_charset(flags)) {
+        case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS;
+        case REGEX_LOCALE_CHARSET:  return LOCALE_PAT_MODS;
+        case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS;
+       case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS;
+       case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
+           *lenp = 2;
+           return ASCII_MORE_RESTRICT_PAT_MODS;
+    }
+    /* The NOT_REACHED; hides an assert() which has a rather complex
+     * definition in perl.h. */
+    NOT_REACHED; /* NOTREACHED */
+    return "?";            /* Unknown */
+}
+
+/*
+
+Return false if any get magic is on the SV other than taint magic.
+
+*/
+
+PERL_STATIC_INLINE bool
+S_sv_only_taint_gmagic(SV *sv) {
+    MAGIC *mg = SvMAGIC(sv);
+
+    PERL_ARGS_ASSERT_SV_ONLY_TAINT_GMAGIC;
+
+    while (mg) {
+        if (mg->mg_type != PERL_MAGIC_taint
+            && !(mg->mg_flags & MGf_GSKIP)
+            && mg->mg_virtual->svt_get) {
+            return FALSE;
+        }
+        mg = mg->mg_moremagic;
+    }
+
+    return TRUE;
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd