In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/0927ade08b4a98671d253366f66b984dc77ed512?hp=38c8d7b116b8e618c4f230cd34234e218e5eb6c8>
- Log ----------------------------------------------------------------- commit 0927ade08b4a98671d253366f66b984dc77ed512 Author: jimc <[email protected]> Date: Mon Mar 14 22:02:52 2016 -0600 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. ----------------------------------------------------------------------- Summary of changes: 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..671e355 100644 --- 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 --- 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"; -- Perl5 Master Repository
