X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/378b4d0f82057e5af983d31c5b48b7f10f4758b3..d6ee8587bdce64301e0540956a01c5b2c8b18f9b:/util.c

diff --git a/util.c b/util.c
index 929c776..6a53cff 100644
--- a/util.c
+++ b/util.c
@@ -854,7 +854,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
 {
     dVAR;
     register const unsigned char *big;
-    register I32 pos;
+    U32 pos = 0; /* hush a gcc warning */
     register I32 previous;
     register I32 first;
     register const unsigned char *little;
@@ -862,8 +862,8 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
     register const unsigned char *littleend;
     bool found = FALSE;
     const MAGIC * mg;
-    I32 *screamfirst;
-    I32 *screamnext;
+    const void *screamnext_raw = NULL; /* hush a gcc warning */
+    bool cant_find = FALSE; /* hush a gcc warning */
 
     PERL_ARGS_ASSERT_SCREAMINSTR;
 
@@ -873,12 +873,37 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
     assert(SvTYPE(littlestr) == SVt_PVMG);
     assert(SvVALID(littlestr));
 
-    screamfirst = (I32 *)mg->mg_ptr;
-    screamnext = screamfirst + 256;
+    if (mg->mg_private == 1) {
+	const U8 *const screamfirst = (U8 *)mg->mg_ptr;
+	const U8 *const screamnext = screamfirst + 256;
 
-    pos = *old_posp == -1
-	? screamfirst[BmRARE(littlestr)] : screamnext[*old_posp];
-    if (pos == -1) {
+	screamnext_raw = (const void *)screamnext;
+
+	pos = *old_posp == -1
+	    ? screamfirst[BmRARE(littlestr)] : screamnext[*old_posp];
+	cant_find = pos == (U8)~0;
+    } else if (mg->mg_private == 2) {
+	const U16 *const screamfirst = (U16 *)mg->mg_ptr;
+	const U16 *const screamnext = screamfirst + 256;
+
+	screamnext_raw = (const void *)screamnext;
+
+	pos = *old_posp == -1
+	    ? screamfirst[BmRARE(littlestr)] : screamnext[*old_posp];
+	cant_find = pos == (U16)~0;
+    } else if (mg->mg_private == 4) {
+	const U32 *const screamfirst = (U32 *)mg->mg_ptr;
+	const U32 *const screamnext = screamfirst + 256;
+
+	screamnext_raw = (const void *)screamnext;
+
+	pos = *old_posp == -1
+	    ? screamfirst[BmRARE(littlestr)] : screamnext[*old_posp];
+	cant_find = pos == (U32)~0;
+    } else
+	Perl_croak(aTHX_ "panic: unknown study size %u", mg->mg_private);
+
+    if (cant_find) {
       cant_find:
 	if ( BmRARE(littlestr) == '\n'
 	     && BmPREVIOUS(littlestr) == SvCUR(littlestr) - 1) {
@@ -909,14 +934,31 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
 #endif
 	return NULL;
     }
-    while (pos < previous + start_shift) {
-	pos = screamnext[pos];
-	if (pos == -1)
-	    goto cant_find;
+    if (mg->mg_private == 1) {
+	const U8 *const screamnext = (const U8 *const) screamnext_raw;
+	while ((I32)pos < previous + start_shift) {
+	    pos = screamnext[pos];
+	    if (pos == (U8)~0)
+		goto cant_find;
+	}
+    } else if (mg->mg_private == 2) {
+	const U16 *const screamnext = (const U16 *const) screamnext_raw;
+	while ((I32)pos < previous + start_shift) {
+	    pos = screamnext[pos];
+	    if (pos == (U16)~0)
+		goto cant_find;
+	}
+    } else if (mg->mg_private == 4) {
+	const U32 *const screamnext = (const U32 *const) screamnext_raw;
+	while ((I32)pos < previous + start_shift) {
+	    pos = screamnext[pos];
+	    if (pos == (U32)~0)
+		goto cant_find;
+	}
     }
     big -= previous;
-    do {
-	if (pos >= stop_pos) break;
+    while (1) {
+	if ((I32)pos >= stop_pos) break;
 	if (big[pos] == first) {
 	    const unsigned char *s = little;
 	    const unsigned char *x = big + pos + 1;
@@ -926,13 +968,25 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
 		++s;
 	    }
 	    if (s == littleend) {
-		*old_posp = pos;
+		*old_posp = (I32)pos;
 		if (!last) return (char *)(big+pos);
 		found = TRUE;
 	    }
 	}
-	pos = screamnext[pos];
-    } while (pos != -1);
+	if (mg->mg_private == 1) {
+	    pos = ((const U8 *const)screamnext_raw)[pos];
+	    if (pos == (U8)~0)
+		break;
+	} else if (mg->mg_private == 2) {
+	    pos = ((const U16 *const)screamnext_raw)[pos];
+	    if (pos == (U16)~0)
+		break;
+	} else if (mg->mg_private == 4) {
+	    pos = ((const U32 *const)screamnext_raw)[pos];
+	    if (pos == (U32)~0)
+		break;
+	}
+    };
     if (last && found)
 	return (char *)(big+(*old_posp));
   check_tail:
@@ -4487,6 +4541,11 @@ dotted_decimal_version:
 	    }
 	}
 
+	/* and we never support negative versions */
+	if ( *d == '-') {
+		BADVERSION(s,errstr,"Invalid version format (negative version number)");                
+	}
+
 	/* consume all of the integer part */
 	while (isDIGIT(*d))
 	    d++;
@@ -4505,9 +4564,6 @@ dotted_decimal_version:
 	    /* found just an integer */
 	    goto version_prescan_finish;
 	}
-	else if ( *d == '-') {
-		BADVERSION(s,errstr,"Invalid version format (negative version number)");                
-	}
 	else if ( d == s ) {
 	    /* didn't find either integer or period */
 	    BADVERSION(s,errstr,"Invalid version format (non-numeric data)");
@@ -5533,7 +5589,7 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
 }
 #else
 /* In any case have a stub so that there's code corresponding
- * to the my_socketpair in global.sym. */
+ * to the my_socketpair in embed.fnc. */
 int
 Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
 #ifdef HAS_SOCKETPAIR
@@ -5814,10 +5870,10 @@ Perl_init_global_struct(pTHX)
 #  undef PERLVARA
 #  undef PERLVARI
 #  undef PERLVARIC
-#  define PERLVAR(var,type) /**/
-#  define PERLVARA(var,n,type) /**/
-#  define PERLVARI(var,type,init) plvarsp->var = init;
-#  define PERLVARIC(var,type,init) plvarsp->var = init;
+#  define PERLVAR(prefix,var,type) /**/
+#  define PERLVARA(prefix,var,n,type) /**/
+#  define PERLVARI(prefix,var,type,init) plvarsp->prefix##var = init;
+#  define PERLVARIC(prefix,var,type,init) plvarsp->prefix##var = init;
 #  include "perlvars.h"
 #  undef PERLVAR
 #  undef PERLVARA