develooper Front page | perl.perl5.changes | Postings from March 2018

[perl.git] branch blead updated. v5.27.9-109-g23a7ee81e1

From:
Karl Williamson
Date:
March 5, 2018 18:22
Subject:
[perl.git] branch blead updated. v5.27.9-109-g23a7ee81e1
Message ID:
E1esukc-0001pi-T8@git.dc.perl.space
In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/23a7ee81e1f64dbbde529a3010a311ed7e872fcf?hp=a2d13ee089a08f2c4ac0472a6d54e14e83a4eab4>

- Log -----------------------------------------------------------------
commit 23a7ee81e1f64dbbde529a3010a311ed7e872fcf
Author: Karl Williamson <khw@cpan.org>
Date:   Mon Mar 5 11:16:15 2018 -0700

    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.

commit 290746ac426c1396497786818282dc2d1330cf79
Author: Karl Williamson <khw@cpan.org>
Date:   Mon Mar 5 11:12:14 2018 -0700

    regexec.c: White-space only
    
    Properly indent preprocessor directives

commit 2c5c8af5a935f2bbfcaa421d2ed8964aaa3edd7a
Author: Karl Williamson <khw@cpan.org>
Date:   Mon Mar 5 11:08:58 2018 -0700

    inline.h: White-space only
    
    Properly indent preprocessor directives

-----------------------------------------------------------------------

Summary of changes:
 embed.fnc |  2 ++
 embed.h   |  4 +++-
 inline.h  | 21 ++++++++++++---------
 proto.h   | 12 +++++++-----
 regexec.c | 33 +++++++++++++++++++++++++++------
 5 files changed, 51 insertions(+), 21 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index bc57c1d7e7..6c4f859583 100644
--- 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 1e3e025e62..9bc1fdb3cc 100644
--- 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 3cd90e5712..549b798ecf 100644
--- a/inline.h
+++ b/inline.h
@@ -385,18 +385,18 @@ S_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep)
 #ifndef EBCDIC
 
 /* This looks like 0x010101... */
-#define PERL_COUNT_MULTIPLIER   (~ (UINTMAX_C(0)) / 0xFF)
+#  define PERL_COUNT_MULTIPLIER   (~ (UINTMAX_C(0)) / 0xFF)
 
 /* This looks like 0x808080... */
-#define PERL_VARIANTS_WORD_MASK (PERL_COUNT_MULTIPLIER * 0x80)
-#define PERL_WORDSIZE            sizeof(PERL_COUNT_MULTIPLIER)
-#define PERL_WORD_BOUNDARY_MASK (PERL_WORDSIZE - 1)
+#  define PERL_VARIANTS_WORD_MASK (PERL_COUNT_MULTIPLIER * 0x80)
+#  define PERL_WORDSIZE            sizeof(PERL_COUNT_MULTIPLIER)
+#  define PERL_WORD_BOUNDARY_MASK (PERL_WORDSIZE - 1)
 
 /* Evaluates to 0 if 'x' is at a word boundary; otherwise evaluates to 1, by
  * or'ing together the lowest bits of 'x'.  Hopefully the final term gets
  * optimized out completely on a 32-bit system, and its mask gets optimized out
  * on a 64-bit system */
-#define PERL_IS_SUBWORD_ADDR(x) (1 & (       PTR2nat(x)                       \
+#  define PERL_IS_SUBWORD_ADDR(x) (1 & (       PTR2nat(x)                     \
                                       |   (  PTR2nat(x) >> 1)                 \
                                       | ( ( (PTR2nat(x)                       \
                                            & PERL_WORD_BOUNDARY_MASK) >> 2))))
@@ -438,19 +438,19 @@ S_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep)
                     return FALSE;
                 }
 
-#if   BYTEORDER == 0x1234 || BYTEORDER == 0x12345678    \
-   || BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
+#  if   BYTEORDER == 0x1234 || BYTEORDER == 0x12345678    \
+     || BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
 
                 *ep = x + _variant_byte_number(* (PERL_UINTMAX_T *) x);
                 assert(*ep >= s && *ep < send);
 
                 return FALSE;
 
-#else   /* If weird byte order, drop into next loop to do byte-at-a-time
+#  else   /* If weird byte order, drop into next loop to do byte-at-a-time
            checks. */
 
                 break;
-#endif
+#  endif
             }
 
             x += PERL_WORDSIZE;
@@ -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 1a1ac7793c..2259c77e4c 100644
--- 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);
diff --git a/regexec.c b/regexec.c
index 488bbd8386..4a863d7730 100644
--- a/regexec.c
+++ b/regexec.c
@@ -587,17 +587,17 @@ S_find_next_ascii(char * s, const char * send, const bool utf8_target)
             PERL_UINTMAX_T complemented = ~ * (PERL_UINTMAX_T *) s;
             if (complemented & PERL_VARIANTS_WORD_MASK)  {
 
-#if   BYTEORDER == 0x1234 || BYTEORDER == 0x12345678    \
-   || BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
+#  if   BYTEORDER == 0x1234 || BYTEORDER == 0x12345678    \
+     || BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
 
                 s += _variant_byte_number(complemented);
                 return s;
 
-#else   /* If weird byte order, drop into next loop to do byte-at-a-time
+#  else   /* If weird byte order, drop into next loop to do byte-at-a-time
            checks. */
 
                 break;
-#endif
+#  endif
             }
 
             s += PERL_WORDSIZE;
@@ -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);
     }
 

-- 
Perl5 Master Repository



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About