better glibc i_modulo bug handling

pp-i-modulo code currently detects a glibc bug at runtime, at the 1st
exec of each I_MODULO op.  This is suboptimal; the bug should be
detectable early, and PL_ppaddr[I_MODULO] updated just once, before
any optrees are built.

Then, because we avoid the need to fixup I_MODULO ops in already built
optrees, we can drop the !PERL_DEBUG_READONLY_OPS limitation on the
alternative/workaround I_MODULO implementation that avoids the bug.

perl.c:

bug detection code is copied from PP(i_modulo),
into S_fixup_platform_bugs(), and called from perl_construct().
It patches Perl_pp_i_modulo_1() into PL_ppaddr[I_MODULO] when needed.

pp.c:

PP(i_modulo_0), the original implementation, is renamed to PP(i_modulo)

PP(i_modulo_1), the bug-fix workaround, is renamed _glibc_bugfix
                it is #ifdefd as before, but dropping !PERL_DEBUG_READONLY_OPS

PP(i_modulo) - the 1st-exec switcher code, is dropped

ocode.pl:

Two i_modulo entries are added to @raw_alias.
- 1st alias:  Perl_pp_i_modulo		    => 'i_modulo'
- 2nd alt:    Perl_pp_i_modulo_glibc_bugfix => 'i_modulo'

1st is a restatement of the default alias/mapping that would be
created without the line.  2nd line is then seen as alternative to the
explicit mapping set by 1st.

Alternative functions are written to pp_proto.h after the standard
Perl_pp_* list, and include #if-cond, #endif wrappings, as was
specified by 2nd @raw_alias addition.

Changes tested by inserting '1 ||' into the 3 ifdefs and bug-detection code.

TODO:

In pp_proto.h generation, the #ifdef wrapping code which handles the
alternative functions looks like it should also be used for the
non-alternate functions.  In particular, there are a handful of
pp-function prototypes that should be wrapped with #ifdef HAS_SOCKET.
That said, there have been no problem reports, so I left it alone.

TonyC: make S_fixup_platform_bugs static, porting/libperl.t was failing.

Author: jimc

perl.c

@@ -214,6 +214,26 @@ Initializes a new Perl interpreter.  See L<perlembed>.
 =cut
 */
 
+static void
+S_fixup_platform_bugs(void)
+{
+#if defined(__GLIBC__) && IVSIZE == 8 \
+    && ( __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 8))
+    {
+        IV l =   3;
+        IV r = -10;
+        /* Cannot do this check with inlined IV constants since
+         * that seems to work correctly even with the buggy glibc. */
+        if (l % r == -3) {
+            dTHX;
+            /* Yikes, we have the bug.
+             * Patch in the workaround version. */
+            PL_ppaddr[OP_I_MODULO] = &Perl_pp_i_modulo_glibc_bugfix;
+        }
+    }
+#endif
+}
+
 void
 perl_construct(pTHXx)
 {
@@ -251,6 +271,8 @@ perl_construct(pTHXx)
 
     init_ids();
 
+    S_fixup_platform_bugs();
+
     JMPENV_BOOTSTRAP;
     STATUS_ALL_SUCCESS;
 

pp.c

@@ -2785,13 +2785,7 @@ PP(pp_i_divide)
     }
 }
 
-#if defined(__GLIBC__) && IVSIZE == 8 && !defined(PERL_DEBUG_READONLY_OPS) \
-    && ( __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 8))
-STATIC
-PP(pp_i_modulo_0)
-#else
 PP(pp_i_modulo)
-#endif
 {
      /* This is the vanilla old i_modulo. */
      dSP; dATARGET;
@@ -2809,11 +2803,10 @@ PP(pp_i_modulo)
      }
 }
 
-#if defined(__GLIBC__) && IVSIZE == 8 && !defined(PERL_DEBUG_READONLY_OPS) \
+#if defined(__GLIBC__) && IVSIZE == 8 \
     && ( __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 8))
-STATIC
-PP(pp_i_modulo_1)
 
+PP(pp_i_modulo_glibc_bugfix)
 {
      /* This is the i_modulo with the workaround for the _moddi3 bug
       * in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
@@ -2832,49 +2825,6 @@ PP(pp_i_modulo_1)
 	  RETURN;
      }
 }
-
-PP(pp_i_modulo)
-{
-     dVAR; dSP; dATARGET;
-     tryAMAGICbin_MG(modulo_amg, AMGf_assign);
-     {
-	  dPOPTOPiirl_nomg;
-	  if (!right)
-	       DIE(aTHX_ "Illegal modulus zero");
-	  /* The assumption is to use hereafter the old vanilla version... */
-	  PL_op->op_ppaddr =
-	       PL_ppaddr[OP_I_MODULO] =
-	           Perl_pp_i_modulo_0;
-	  /* .. but if we have glibc, we might have a buggy _moddi3
-	   * (at least glibc 2.2.5 is known to have this bug), in other
-	   * words our integer modulus with negative quad as the second
-	   * argument might be broken.  Test for this and re-patch the
-	   * opcode dispatch table if that is the case, remembering to
-	   * also apply the workaround so that this first round works
-	   * right, too.  See [perl #9402] for more information. */
-	  {
-	       IV l =   3;
-	       IV r = -10;
-	       /* Cannot do this check with inlined IV constants since
-		* that seems to work correctly even with the buggy glibc. */
-	       if (l % r == -3) {
-		    /* Yikes, we have the bug.
-		     * Patch in the workaround version. */
-		    PL_op->op_ppaddr =
-			 PL_ppaddr[OP_I_MODULO] =
-			     &Perl_pp_i_modulo_1;
-		    /* Make certain we work right this time, too. */
-		    right = PERL_ABS(right);
-	       }
-	  }
-	  /* avoid FPE_INTOVF on some platforms when left is IV_MIN */
-	  if (right == -1)
-	      SETi( 0 );
-	  else
-	      SETi( left % right );
-	  RETURN;
-     }
-}
 #endif
 
 PP(pp_i_add)

pp_proto.h

@@ -293,4 +293,9 @@ PERL_CALLCONV OP *Perl_pp_warn(pTHX);
 PERL_CALLCONV OP *Perl_pp_xor(pTHX);
 PERL_CALLCONV OP *Perl_unimplemented_op(pTHX);
 
+/* alternative functions */
+#if defined(__GLIBC__) && IVSIZE == 8  && ( __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 8))
+PERL_CALLCONV OP *Perl_pp_i_modulo_glibc_bugfix(pTHX);
+#endif
+
 /* ex: set ro: */

regen/opcode.pl

@@ -71,9 +71,9 @@ BEGIN
     $args{$key} = $args;
 }
 
-# Set up aliases
+# Set up aliases, and alternative funcs
 
-my %alias;
+my (%alias, %alts);
 
 # Format is "this function" => "does these op names"
 my @raw_alias = (
@@ -139,16 +139,25 @@ BEGIN
 		 Perl_pp_shostent => [qw(snetent sprotoent sservent)],
 		 Perl_pp_aelemfast => ['aelemfast_lex'],
 		 Perl_pp_grepstart => ['mapstart'],
+
+		 # 2 i_modulo mappings: 2nd is alt, needs 1st (explicit default) to not override the default
+		 Perl_pp_i_modulo  => ['i_modulo'],
+		 Perl_pp_i_modulo_glibc_bugfix => {
+                     'i_modulo' =>
+                         '#if defined(__GLIBC__) && IVSIZE == 8 '.
+                         ' && ( __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 8))' },
 		);
 
 while (my ($func, $names) = splice @raw_alias, 0, 2) {
     if (ref $names eq 'ARRAY') {
 	foreach (@$names) {
-	    $alias{$_} = [$func, ''];
+            defined $alias{$_}
+            ? $alts{$_} : $alias{$_} = [$func, ''];
 	}
     } else {
 	while (my ($opname, $cond) = each %$names) {
-	    $alias{$opname} = [$func, $cond];
+            defined $alias{$opname}
+            ? $alts{$opname} : $alias{$opname} = [$func, $cond];
 	}
     }
 }
@@ -1251,6 +1260,14 @@ sub gen_op_is_macro {
 	++$funcs{$name};
     }
     print $pp "PERL_CALLCONV OP *$_(pTHX);\n" foreach sort keys %funcs;
+
+    print $pp "\n/* alternative functions */\n" if keys %alts;
+    for my $fn (sort keys %alts) {
+        my ($x, $cond) = @{$alts{$fn}};
+        print $pp "$cond\n" if $cond;
+        print $pp "PERL_CALLCONV OP *$x(pTHX);\n";
+        print $pp "#endif\n" if $cond;
+    }
 }
 
 print $oc "\n\n";