X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=7872c1e0dcc909510350b3269095eeba8b391d50;hb=a3bcc51ebd4e201d85a37d8410b7a375b8d94244;hp=7acc1da8da591a52bdb7a9a77ae9e3594cfcb5a2;hpb=126c71c82576d5dc652db25ca9e3f8e18442c4fd;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 7acc1da..7872c1e 100644 --- a/pp.c +++ b/pp.c @@ -106,15 +106,7 @@ PP(pp_padhv) RETURNOP(do_kv()); } else if (gimme == G_SCALAR) { - SV* sv = sv_newmortal(); - if (SvRMAGICAL(TARG) && mg_find(TARG, PERL_MAGIC_tied)) - Perl_croak(aTHX_ "Can't provide tied hash usage; " - "use keys(%%hash) to test if empty"); - if (HvFILL((HV*)TARG)) - Perl_sv_setpvf(aTHX_ sv, "%ld/%ld", - (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1); - else - sv_setiv(sv, 0); + SV* sv = Perl_hv_scalar((HV*)TARG); SETs(sv); } RETURN; @@ -594,8 +586,12 @@ PP(pp_gelem) sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv)); break; case 'P': - if (strEQ(elem, "PACKAGE")) - sv = newSVpv(HvNAME(GvSTASH(gv)), 0); + if (strEQ(elem, "PACKAGE")) { + if (HvNAME(GvSTASH(gv))) + sv = newSVpv(HvNAME(GvSTASH(gv)), 0); + else + sv = newSVpv("__ANON__",0); + } break; case 'S': if (strEQ(elem, "SCALAR")) @@ -968,6 +964,7 @@ PP(pp_pow) register unsigned int highbit = 8 * sizeof(UV); register unsigned int lowbit = 0; register unsigned int diff; + bool odd_power = (bool)(power & 1); while ((diff = (highbit - lowbit) >> 1)) { if (baseuv & ~((1 << (lowbit + diff)) - 1)) lowbit += diff; @@ -990,7 +987,7 @@ PP(pp_pow) } } SP--; - if (baseuok || !(power & 1)) + if (baseuok || !odd_power) /* answer is positive */ SETu( result ); else if (result <= (UV)IV_MAX) @@ -2723,87 +2720,6 @@ PP(pp_srand) RETPUSHYES; } -STATIC U32 -S_seed(pTHX) -{ - /* - * This is really just a quick hack which grabs various garbage - * values. It really should be a real hash algorithm which - * spreads the effect of every input bit onto every output bit, - * if someone who knows about such things would bother to write it. - * Might be a good idea to add that function to CORE as well. - * No numbers below come from careful analysis or anything here, - * except they are primes and SEED_C1 > 1E6 to get a full-width - * value from (tv_sec * SEED_C1 + tv_usec). The multipliers should - * probably be bigger too. - */ -#if RANDBITS > 16 -# define SEED_C1 1000003 -#define SEED_C4 73819 -#else -# define SEED_C1 25747 -#define SEED_C4 20639 -#endif -#define SEED_C2 3 -#define SEED_C3 269 -#define SEED_C5 26107 - -#ifndef PERL_NO_DEV_RANDOM - int fd; -#endif - U32 u; -#ifdef VMS -# include - /* when[] = (low 32 bits, high 32 bits) of time since epoch - * in 100-ns units, typically incremented ever 10 ms. */ - unsigned int when[2]; -#else -# ifdef HAS_GETTIMEOFDAY - struct timeval when; -# else - Time_t when; -# endif -#endif - -/* This test is an escape hatch, this symbol isn't set by Configure. */ -#ifndef PERL_NO_DEV_RANDOM -#ifndef PERL_RANDOM_DEVICE - /* /dev/random isn't used by default because reads from it will block - * if there isn't enough entropy available. You can compile with - * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there - * is enough real entropy to fill the seed. */ -# define PERL_RANDOM_DEVICE "/dev/urandom" -#endif - fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0); - if (fd != -1) { - if (PerlLIO_read(fd, &u, sizeof u) != sizeof u) - u = 0; - PerlLIO_close(fd); - if (u) - return u; - } -#endif - -#ifdef VMS - _ckvmssts(sys$gettim(when)); - u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1]; -#else -# ifdef HAS_GETTIMEOFDAY - PerlProc_gettimeofday(&when,NULL); - u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec; -# else - (void)time(&when); - u = (U32)SEED_C1 * when; -# endif -#endif - u += SEED_C3 * (U32)PerlProc_getpid(); - u += SEED_C4 * (U32)PTR2UV(PL_stack_sp); -#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */ - u += SEED_C5 * (U32)PTR2UV(&when); -#endif - return u; -} - PP(pp_exp) { dSP; dTARGET; tryAMAGICun(exp); @@ -2848,28 +2764,6 @@ PP(pp_sqrt) } } -/* - * There are strange code-generation bugs caused on sparc64 by gcc-2.95.2. - * These need to be revisited when a newer toolchain becomes available. - */ -#if defined(__sparc64__) && defined(__GNUC__) -# if __GNUC__ < 2 || (__GNUC__ == 2 && __GNUC_MINOR__ < 96) -# undef SPARC64_MODF_WORKAROUND -# define SPARC64_MODF_WORKAROUND 1 -# endif -#endif - -#if defined(SPARC64_MODF_WORKAROUND) -static NV -sparc64_workaround_modf(NV theVal, NV *theIntRes) -{ - NV res, ret; - ret = Perl_modf(theVal, &res); - *theIntRes = res; - return ret; -} -#endif - PP(pp_int) { dSP; dTARGET; tryAMAGICun(int); @@ -2893,34 +2787,15 @@ PP(pp_int) if (value < (NV)UV_MAX + 0.5) { SETu(U_V(value)); } else { -#if defined(SPARC64_MODF_WORKAROUND) - (void)sparc64_workaround_modf(value, &value); -#elif defined(HAS_MODFL_POW32_BUG) -/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */ - NV offset = Perl_modf(value, &value); - (void)Perl_modf(offset, &offset); - value += offset; -#else - (void)Perl_modf(value, &value); -#endif - SETn(value); + SETn(Perl_floor(value)); } } else { if (value > (NV)IV_MIN - 0.5) { SETi(I_V(value)); } else { -#if defined(SPARC64_MODF_WORKAROUND) - (void)sparc64_workaround_modf(-value, &value); -#elif defined(HAS_MODFL_POW32_BUG) -/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */ - NV offset = Perl_modf(-value, &value); - (void)Perl_modf(offset, &offset); - value += offset; -#else - (void)Perl_modf(-value, &value); -#endif - SETn(-value); + /* This is maint, and we don't have Perl_ceil in perl.h */ + SETn(-Perl_floor(-value)); } } } @@ -3187,6 +3062,8 @@ PP(pp_substr) sv_upgrade(TARG, SVt_PVLV); sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0); } + else + (void)SvOK_off(TARG); LvTYPE(TARG) = 'x'; if (LvTARG(TARG) != sv) { @@ -4549,7 +4426,7 @@ PP(pp_split) s++; } } - if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) { + if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) { SAVEINT(PL_multiline); PL_multiline = pm->op_pmflags & PMf_MULTILINE; } @@ -4654,13 +4531,13 @@ PP(pp_split) } else { maxiters += slen * rx->nparens; - while (s < strend && --limit -/* && (!rx->check_substr - || ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend, - 0, NULL)))) -*/ && CALLREGEXEC(aTHX_ rx, s, strend, orig, - 1 /* minend */, sv, NULL, 0)) + while (s < strend && --limit) { + PUTBACK; + i = CALLREGEXEC(aTHX_ rx, s, strend, orig, 1 , sv, NULL, 0); + SPAGAIN; + if (i == 0) + break; TAINT_IF(RX_MATCH_TAINTED(rx)); if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) { m = s; @@ -4699,7 +4576,6 @@ PP(pp_split) } } s = rx->endp[0] + orig; - PUTBACK; } }