[PATCH] better glibc i-modulo bug handling #15318
Labels
Comments
From @jimcCreated by @jimcbetter glibc i_modulo bug handling pp-i-modulo code currently detects a glibc bug at runtime, at the 1st Then, because we avoid the need to fixup I_MODULO ops in already built Perl Info |
From @tonycozOn Tue May 10 07:54:00 2016, yoduh wrote:
The patch appears to have been mangled somewhere along the way, possibly by pasting the raw message as text into gmail. Could you please attach the patch separately? Thanks, |
|
The RT System itself - Status changed from 'new' to 'open' |
From @jimcOn Sun, May 15, 2016 at 6:17 PM, Tony Cook via RT
meh attaching. is there a reason attachments in RT get shown as
|
From @jimc0001-better-glibc-i_modulo-bug-handling.patchFrom 0e6f59cd27b000d8936d44fe1506ac38e7e2a374 Mon Sep 17 00:00:00 2001
From: jimc <jim.cromie@gmail.com>
Date: Mon, 14 Mar 2016 22:02:52 -0600
Subject: [PATCH] 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.
---
perl.c | 22 ++++++++++++++++++++++
pp.c | 54 ++----------------------------------------------------
pp_proto.h | 5 +++++
regen/opcode.pl | 25 +++++++++++++++++++++----
4 files changed, 50 insertions(+), 56 deletions(-)
diff --git a/perl.c b/perl.c
index 52ed1bd..c779c0f 100644
--- a/perl.c
+++ b/perl.c
@@ -215,6 +215,26 @@ Initializes a new Perl interpreter. See L<perlembed>.
*/
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)
{
dVAR;
@@ -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
--- 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)
diff --git a/pp_proto.h b/pp_proto.h
index f919313..17241d3 100644
--- a/pp_proto.h
+++ b/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: */
diff --git a/regen/opcode.pl b/regen/opcode.pl
index 82454bb..edb9f4d 100755
--- a/regen/opcode.pl
+++ b/regen/opcode.pl
@@ -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";
--
2.5.5
|
From @tonycozOn Mon May 16 08:41:15 2016, yoduh wrote:
Applied as 0927ade with the addition of making S_fixup_platform_bugs() static, since porting/libperl.t complained about it.
gmail attaches the files with Content-Disposition "attachment", if they're attached with that as "inline" they're inlined (unless they're too large). Tony |
|
@tonycoz - Status changed from 'open' to 'pending release' |
From @khwilliamsonThank you for filing this report. You have helped make Perl better. With the release today of Perl 5.26.0, this and 210 other issues have been Perl 5.26.0 may be downloaded via: If you find that the problem persists, feel free to reopen this ticket. |
|
@khwilliamson - Status changed from 'pending release' to 'resolved' |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Migrated from rt.perl.org#128112 (status was 'resolved')
Searchable as RT128112$
The text was updated successfully, but these errors were encountered: