EBCDIC conditional compilation fixes

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.

diff --git a/embed.fnc b/embed.fnc
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)
@@ -778,6 +777,9 @@
 #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

diff --git a/inline.h b/inline.h
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__;
@@ -3876,6 +3871,13 @@ PERL_CALLCONV_NO_RET int Perl_magic_regdatum_set(pTHX_ SV* sv, MAGIC* mg)
        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);
 #define PERL_ARGS_ASSERT_GETENV_LEN    \

diff --git a/regexec.c b/regexec.c
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);
     }