EBCDIC conditional compilation fixes
authorKarl Williamson <khw@cpan.org>
Mon, 5 Mar 2018 18:16:15 +0000 (11:16 -0700)
committerKarl Williamson <khw@cpan.org>
Mon, 5 Mar 2018 18:22:14 +0000 (11:22 -0700)
The recent changes fixed by this commit neglected to take into account
EBCDIC differences.

Mostly, the algorithms apply only to ASCII platforms, so the EBCDIC is
ifdef'd out.  In a couple cases, the algorithm mostly applies, so the
scope of the ifdefs is smaller.

embed.fnc
embed.h
inline.h
proto.h
regexec.c

index bc57c1d..6c4f859 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -807,7 +807,9 @@ AndmoR      |bool   |is_utf8_invariant_string|NN const U8* const s              \
 AnidR  |bool   |is_utf8_invariant_string_loc|NN const U8* const s          \
                |STRLEN len                                                 \
                |NULLOK const U8 ** ep
+#ifndef EBCDIC
 AniR   |unsigned int|_variant_byte_number|PERL_UINTMAX_T word
+#endif
 #if defined(PERL_CORE) || defined(PERL_EXT)
 EinR   |Size_t |variant_under_utf8_count|NN const U8* const s              \
                |NN const U8* const e
diff --git a/embed.h b/embed.h
index 1e3e025..9bc1fdb 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -46,7 +46,6 @@
 #define _to_utf8_lower_flags(a,b,c,d,e,f,g)    Perl__to_utf8_lower_flags(aTHX_ a,b,c,d,e,f,g)
 #define _to_utf8_title_flags(a,b,c,d,e,f,g)    Perl__to_utf8_title_flags(aTHX_ a,b,c,d,e,f,g)
 #define _to_utf8_upper_flags(a,b,c,d,e,f,g)    Perl__to_utf8_upper_flags(aTHX_ a,b,c,d,e,f,g)
-#define _variant_byte_number   S__variant_byte_number
 #define amagic_call(a,b,c,d)   Perl_amagic_call(aTHX_ a,b,c,d)
 #define amagic_deref_call(a,b) Perl_amagic_deref_call(aTHX_ a,b)
 #define apply_attrs_string(a,b,c,d)    Perl_apply_attrs_string(aTHX_ a,b,c,d)
 #if !(defined(HAS_SIGACTION) && defined(SA_SIGINFO))
 #define csighandler            Perl_csighandler
 #endif
+#if !defined(EBCDIC)
+#define _variant_byte_number   S__variant_byte_number
+#endif
 #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
 #define my_chsize(a,b)         Perl_my_chsize(aTHX_ a,b)
 #endif
index bdc0923..549b798 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -476,6 +476,8 @@ S_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep)
     return TRUE;
 }
 
+#ifndef EBCDIC
+
 PERL_STATIC_INLINE unsigned int
 S__variant_byte_number(PERL_UINTMAX_T word)
 {
@@ -583,6 +585,7 @@ S__variant_byte_number(PERL_UINTMAX_T word)
     return (unsigned int) word;
 }
 
+#endif
 #if defined(PERL_CORE) || defined(PERL_EXT)
 
 /*
diff --git a/proto.h b/proto.h
index 1a1ac77..2259c77 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -138,11 +138,6 @@ PERL_CALLCONV UV   Perl__to_utf8_title_flags(pTHX_ const U8 *p, const U8* e, U8* u
 PERL_CALLCONV UV       Perl__to_utf8_upper_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, bool flags, const char * const file, const int line);
 #define PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS  \
        assert(p); assert(ustrp); assert(file)
-#ifndef PERL_NO_INLINE_FUNCTIONS
-PERL_STATIC_INLINE unsigned int        S__variant_byte_number(PERL_UINTMAX_T word)
-                       __attribute__warn_unused_result__;
-#endif
-
 PERL_CALLCONV void     Perl__warn_problematic_locale(void);
 PERL_CALLCONV_NO_RET void      Perl_abort_execution(pTHX_ const char * const msg, const char * const name)
                        __attribute__noreturn__;
@@ -3875,6 +3870,13 @@ PERL_CALLCONV_NO_RET int Perl_magic_regdatum_set(pTHX_ SV* sv, MAGIC* mg)
 #define PERL_ARGS_ASSERT_MAGIC_REGDATUM_SET    \
        assert(sv); assert(mg)
 
+#endif
+#if !defined(EBCDIC)
+#ifndef PERL_NO_INLINE_FUNCTIONS
+PERL_STATIC_INLINE unsigned int        S__variant_byte_number(PERL_UINTMAX_T word)
+                       __attribute__warn_unused_result__;
+#endif
+
 #endif
 #if !defined(HAS_GETENV_LEN)
 PERL_CALLCONV char*    Perl_getenv_len(pTHX_ const char *env_elem, unsigned long *len);
index 8b6642c..4a863d7 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -714,8 +714,15 @@ S_find_span_end(U8 * s, const U8 * send, const U8 span_byte)
                 continue;
             }
 
-            /* Here, at least one byte in the word isn't 'span_byte'.  This xor
-             * leaves 1 bits only in those non-matching bytes */
+            /* Here, at least one byte in the word isn't 'span_byte'. */
+
+#ifdef EBCDIC
+
+            break;
+
+#else
+
+            /* This xor leaves 1 bits only in those non-matching bytes */
             span_word ^= * (PERL_UINTMAX_T *) s;
 
             /* Make sure the upper bit of each non-matching byte is set.  This
@@ -727,6 +734,8 @@ S_find_span_end(U8 * s, const U8 * send, const U8 span_byte)
             /* That reduces the problem to what this function solves */
             return s + _variant_byte_number(span_word);
 
+#endif
+
         } while (s + PERL_WORDSIZE <= send);
     }
 
@@ -754,6 +763,8 @@ S_find_next_masked(U8 * s, const U8 * send, const U8 byte, const U8 mask)
     assert(send >= s);
     assert((byte & mask) == byte);
 
+#ifndef EBCDIC
+
     if ((STRLEN) (send - s) >= PERL_WORDSIZE
                           + PERL_WORDSIZE * PERL_IS_SUBWORD_ADDR(s)
                           - (PTR2nat(s) & PERL_WORD_BOUNDARY_MASK))
@@ -803,6 +814,8 @@ S_find_next_masked(U8 * s, const U8 * send, const U8 byte, const U8 mask)
         } while (s + PERL_WORDSIZE <= send);
     }
 
+#endif
+
     while (s < send) {
         if (((*s) & mask) == byte) {
             return s;
@@ -851,12 +864,20 @@ S_find_span_end_mask(U8 * s, const U8 * send, const U8 span_byte, const U8 mask)
                 continue;
             }
 
+#ifdef EBCDIC
+
+            break;
+
+#else
+
             masked ^= span_word;
             masked |= masked << 1;
             masked |= masked << 2;
             masked |= masked << 4;
             return s + _variant_byte_number(masked);
 
+#endif
+
         } while (s + PERL_WORDSIZE <= send);
     }