better glibc i_modulo bug handling
authorjimc <jim.cromie@gmail.com>
Tue, 15 Mar 2016 04:02:52 +0000 (22:02 -0600)
committerTony Cook <tony@develop-help.com>
Tue, 17 May 2016 06:37:49 +0000 (16:37 +1000)
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.

perl.c
pp.c
pp_proto.h
regen/opcode.pl

diff --git a/perl.c b/perl.c
index 52ed1bd..671e355 100644 (file)
--- a/perl.c
+++ b/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;
 
diff --git a/pp.c b/pp.c
index 4a2cde0..0fff0d9 100644 (file)
--- a/pp.c
+++ b/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)
index f919313..17241d3 100644 (file)
@@ -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: */
index 82454bb..edb9f4d 100755 (executable)
@@ -71,9 +71,9 @@ while (<OPS>) {
     $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 @@ my @raw_alias = (
                 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 @@ my $pp = open_new('pp_proto.h', '>',
        ++$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";