In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/40653c20251c480725942b064751eecc8af62eb6?hp=84d03adf4b941899c10e7644b4dcc13dfd13a7ee>
- Log ----------------------------------------------------------------- commit 40653c20251c480725942b064751eecc8af62eb6 Author: Father Chrysostomos <[email protected]> Date: Sat Sep 20 00:43:28 2014 -0700 [perl #121983] #error with ro ops and no threads PERL_DEBUG_READONLY_OPS is designed to catch modifications of op trees at run time, to make sure that perl is doing things safely under threads. (Op trees are shared between threads.) On non-threaded perls, ops are modified regularly, which is perfectly safe, so PERL_DEBUG_READONLY_OPS does not make any sense, and is guar- anteed to crash. Forcing a compilation error with cpp directives makes it obvious that it is not intended for this PERL_DEBUG_READONLY_OPS mode to work with- out USE_ITHREADS. M perl.h commit 5988f3061bb4e71b2048c7b82f098bfa943a07d7 Author: Father Chrysostomos <[email protected]> Date: Fri Sep 19 22:15:52 2014 -0700 [perl #122799] Always turn off CvNAMED in cvgv-set Instead of turning off the flag only when we need to turn it off (when there is a hek, which is the only time it should be on), just turn it off unconditionally. This gets Scope::Upper working once more. While it is arguably the moduleâs fault, itâs still a good idea to make cvgv_set robust. CvNAMED should never be on after calling it, regardless of the previous state of the CV. M gv.c commit 365c7d0c5cb1cae07e9bacec13b5debcd4ead9eb Author: Daniel Dragan <[email protected]> Date: Fri Sep 19 17:44:07 2014 -0400 Perl_scalarvoid remove duplicate SvNV call M op.c commit 3c04c629833dfd451520ff903a3eeb3f5da57fef Author: Daniel Dragan <[email protected]> Date: Fri Sep 19 17:43:11 2014 -0400 more factoring out in S_utf8_mg_pos_cache_update Flip the inputs to keep_earlier, this way one 1 copy of the keep_earlier three way square exists in machine code. Removing the float casts would make the calculation more efficient since truncating precsion asm op dont have to happen after every calculation but I'm not sure about side effects. Float casts are from commit ab455f6077 with no background provided. M sv.c commit 7bd545ae148a40a1c2a552370bb224b64d860406 Author: Daniel Dragan <[email protected]> Date: Thu Sep 18 20:33:22 2014 -0400 factor out more in S_utf8_mg_pos_cache_update M sv.c commit 73ecc8cb698116fbf9083ebd625b85eff621e01c Author: Daniel Dragan <[email protected]> Date: Thu Sep 18 20:32:20 2014 -0400 factor out FP heavy code in utf8_mg_pos_cache_update Visual C 2003 and 6 couldn't factor this FP math heavy expression out with -O1, and it appeared twice in machine code, so do it by hand. M sv.c ----------------------------------------------------------------------- Summary of changes: gv.c | 2 +- op.c | 3 ++- perl.h | 4 ++++ sv.c | 65 ++++++++++++++++++++++++++++++----------------------------------- 4 files changed, 37 insertions(+), 37 deletions(-) diff --git a/gv.c b/gv.c index 73fb7da..04013a5 100644 --- a/gv.c +++ b/gv.c @@ -234,10 +234,10 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv) } else if ((hek = CvNAME_HEK(cv))) { unshare_hek(hek); - CvNAMED_off(cv); CvLEXICAL_off(cv); } + CvNAMED_off(cv); SvANY(cv)->xcv_gv_u.xcv_gv = gv; assert(!CvCVGV_RC(cv)); diff --git a/op.c b/op.c index 163b6a8..7e7d667 100644 --- a/op.c +++ b/op.c @@ -1730,6 +1730,7 @@ Perl_scalarvoid(pTHX_ OP *o) no_bareword_allowed(o); else { if (ckWARN(WARN_VOID)) { + NV nv; /* don't warn on optimised away booleans, eg * use constant Foo, 5; Foo || print; */ if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT) @@ -1737,7 +1738,7 @@ Perl_scalarvoid(pTHX_ OP *o) /* the constants 0 and 1 are permitted as they are conventionally used as dummies in constructs like 1 while some_condition_with_side_effects; */ - else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0)) + else if (SvNIOK(sv) && ((nv = SvNV(sv)) == 0.0 || nv == 1.0)) useless = NULL; else if (SvPOK(sv)) { SV * const dsv = newSVpvs(""); diff --git a/perl.h b/perl.h index d711b20..5615b96 100644 --- a/perl.h +++ b/perl.h @@ -2663,6 +2663,10 @@ typedef SV PADNAME; # define PERL_SAWAMPERSAND #endif +#if defined(PERL_DEBUG_READONLY_OPS) && !defined(USE_ITHREADS) +# error PERL_DEBUG_READONLY_OPS only works with ithreads +#endif + #include "handy.h" #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) diff --git a/sv.c b/sv.c index 04c2826..566c0e6 100644 --- a/sv.c +++ b/sv.c @@ -7375,6 +7375,7 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN b cache[3] = byte; } } else { +/* float casts necessary? XXX */ #define THREEWAY_SQUARE(a,b,c,d) \ ((float)((d) - (c))) * ((float)((d) - (c))) \ + ((float)((c) - (b))) * ((float)((c) - (b))) \ @@ -7395,46 +7396,40 @@ S_utf8_mg_pos_cache_update(pTHX_ SV *const sv, MAGIC **const mgp, const STRLEN b if (keep_later < keep_earlier) { cache[2] = cache[0]; cache[3] = cache[1]; - cache[0] = utf8; - cache[1] = byte; - } - else { - cache[0] = utf8; - cache[1] = byte; - } - } - else if (byte > cache[3]) { - /* New position is between the existing pair of pairs. */ - const float keep_earlier - = THREEWAY_SQUARE(0, cache[3], byte, blen); - const float keep_later - = THREEWAY_SQUARE(0, byte, cache[1], blen); - - if (keep_later < keep_earlier) { - cache[2] = utf8; - cache[3] = byte; - } - else { - cache[0] = utf8; - cache[1] = byte; } + cache[0] = utf8; + cache[1] = byte; } else { - /* New position is before the existing pair of pairs. */ - const float keep_earlier - = THREEWAY_SQUARE(0, byte, cache[3], blen); - const float keep_later - = THREEWAY_SQUARE(0, byte, cache[1], blen); - - if (keep_later < keep_earlier) { - cache[2] = utf8; - cache[3] = byte; + const float keep_later = THREEWAY_SQUARE(0, byte, cache[1], blen); + float b, c, keep_earlier; + if (byte > cache[3]) { + /* New position is between the existing pair of pairs. */ + b = cache[3]; + c = byte; + } else { + /* New position is before the existing pair of pairs. */ + b = byte; + c = cache[3]; + } + keep_earlier = THREEWAY_SQUARE(0, b, c, blen); + if (byte > cache[3]) { + if (keep_later < keep_earlier) { + cache[2] = utf8; + cache[3] = byte; + } + else { + cache[0] = utf8; + cache[1] = byte; + } } else { - cache[0] = cache[2]; - cache[1] = cache[3]; - cache[2] = utf8; - cache[3] = byte; + if (! (keep_later < keep_earlier)) { + cache[0] = cache[2]; + cache[1] = cache[3]; + } + cache[2] = utf8; + cache[3] = byte; } } } -- Perl5 Master Repository
