X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a9bc755754f0db5e848e65dfd2e63a96af50ffd4..2626e112ed2a75058c6a5e98cce21f1af08a8ace:/pp.c diff --git a/pp.c b/pp.c index 8710b54..863478d 100644 --- a/pp.c +++ b/pp.c @@ -1,6 +1,6 @@ /* pp.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -29,8 +29,11 @@ typedef int IBW; typedef unsigned UBW; -static SV* refto _((SV* sv)); static void doencodes _((SV* sv, char* s, I32 len)); +static SV* refto _((SV* sv)); +static U32 seed _((void)); + +static bool srand_called = FALSE; /* variations on pp_null */ @@ -89,7 +92,8 @@ PP(pp_padhv) else { SV* sv = sv_newmortal(); if (HvFILL((HV*)TARG)) { - sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1); + sprintf(buf, "%ld/%ld", + (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG)+1); sv_setpv(sv, buf); } else @@ -119,8 +123,6 @@ PP(pp_rv2gv) GvIOp(gv) = (IO *)sv; SvREFCNT_inc(sv); sv = (SV*) gv; - } else if (SvTYPE(sv) == SVt_PVCV) { - sv = (SV*) CvGV(sv); } else if (SvTYPE(sv) != SVt_PVGV) DIE("Not a GLOB reference"); } @@ -137,6 +139,8 @@ PP(pp_rv2gv) if (op->op_flags & OPf_REF || op->op_private & HINT_STRICT_REFS) DIE(no_usym, "a symbol"); + if (dowarn) + warn(warn_uninit); RETSETUNDEF; } sym = SvPV(sv, na); @@ -179,6 +183,8 @@ PP(pp_rv2sv) if (op->op_flags & OPf_REF || op->op_private & HINT_STRICT_REFS) DIE(no_usym, "a SCALAR"); + if (dowarn) + warn(warn_uninit); RETSETUNDEF; } sym = SvPV(sv, na); @@ -376,13 +382,12 @@ PP(pp_study) register I32 ch; register I32 *sfirst; register I32 *snext; - I32 retval; STRLEN len; - s = (unsigned char*)(SvPV(sv, len)); - pos = len; - if (sv == lastscream) - SvSCREAM_off(sv); + if (sv == lastscream) { + if (SvSCREAM(sv)) + RETPUSHYES; + } else { if (lastscream) { SvSCREAM_off(lastscream); @@ -390,10 +395,11 @@ PP(pp_study) } lastscream = SvREFCNT_inc(sv); } - if (pos <= 0) { - retval = 0; - goto ret; - } + + s = (unsigned char*)(SvPV(sv, len)); + pos = len; + if (pos <= 0) + RETPUSHNO; if (pos > maxscream) { if (maxscream < 0) { maxscream = pos + 80; @@ -427,10 +433,7 @@ PP(pp_study) SvSCREAM_on(sv); sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */ - retval = 1; - ret: - XPUSHs(sv_2mortal(newSViv((I32)retval))); - RETURN; + RETPUSHYES; } PP(pp_trans) @@ -521,8 +524,10 @@ PP(pp_undef) dSP; SV *sv; - if (!op->op_private) + if (!op->op_private) { + EXTEND(SP, 1); RETPUSHUNDEF; + } sv = POPs; if (!sv) @@ -545,16 +550,19 @@ PP(pp_undef) hv_undef((HV*)sv); break; case SVt_PVCV: + if (!CvANON((CV*)sv) && cv_const_sv((CV*)sv)) + warn("Constant subroutine %s undefined", + GvENAME(CvGV((CV*)sv))); + /* FALL THROUGH */ + case SVt_PVFM: cv_undef((CV*)sv); - sub_generation++; break; case SVt_PVGV: - if (SvFAKE(sv)) { - sv_setsv(sv, &sv_undef); - break; - } + if (SvFAKE(sv)) + sv_setsv(sv, &sv_undef); + break; default: - if (SvPOK(sv) && SvLEN(sv)) { + if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) { (void)SvOOK_off(sv); Safefree(SvPVX(sv)); SvPV_set(sv, Nullch); @@ -570,6 +578,8 @@ PP(pp_undef) PP(pp_predec) { dSP; + if (SvREADONLY(TOPs)) + croak(no_modify); if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MIN) { @@ -585,6 +595,8 @@ PP(pp_predec) PP(pp_postinc) { dSP; dTARGET; + if (SvREADONLY(TOPs)) + croak(no_modify); sv_setsv(TARG, TOPs); if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MAX) @@ -604,6 +616,8 @@ PP(pp_postinc) PP(pp_postdec) { dSP; dTARGET; + if(SvREADONLY(TOPs)) + croak(no_modify); sv_setsv(TARG, TOPs); if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && SvIVX(TOPs) != IV_MIN) @@ -853,12 +867,16 @@ PP(pp_ncmp) dPOPTOPnnrl; I32 value; - if (left > right) - value = 1; + if (left == right) + value = 0; else if (left < right) value = -1; - else - value = 0; + else if (left > right) + value = 1; + else { + SETs(&sv_undef); + RETURN; + } SETi(value); RETURN; } @@ -1130,6 +1148,8 @@ PP(pp_i_modulo) dSP; dATARGET; tryAMAGICbin(mod,opASSIGN); { dPOPTOPiirl; + if (!right) + DIE("Illegal modulus zero"); SETi( left % right ); RETURN; } @@ -1286,6 +1306,10 @@ PP(pp_rand) value = POPn; if (value == 0.0) value = 1.0; + if (!srand_called) { + (void)srand((unsigned)seed()); + srand_called = TRUE; + } #if RANDBITS == 31 value = rand() * value / 2147483648.0; #else @@ -1306,38 +1330,44 @@ PP(pp_rand) PP(pp_srand) { dSP; - I32 anum; + UV anum; + if (MAXARG < 1) + anum = seed(); + else + anum = POPu; + (void)srand((unsigned)anum); + srand_called = TRUE; + EXTEND(SP, 1); + RETPUSHYES; +} - if (MAXARG < 1) { +static U32 +seed() +{ + U32 u; #ifdef VMS # include - unsigned int when[2]; - _ckvmssts(sys$gettim(when)); - anum = when[0] ^ when[1]; + unsigned int when[2]; + _ckvmssts(sys$gettim(when)); + u = when[0] ^ when[1]; #else # ifdef HAS_GETTIMEOFDAY - struct timeval when; - gettimeofday(&when,(struct timezone *) 0); - anum = when.tv_sec ^ when.tv_usec; + struct timeval when; + gettimeofday(&when,(struct timezone *) 0); + u = when.tv_sec ^ when.tv_usec; # else - Time_t when; - (void)time(&when); - anum = when; + Time_t when; + (void)time(&when); + u = when; # endif #endif -#if !defined(PLAN9) /* XXX Plan9 assembler chokes on this; fix coming soon */ - /* 17-Jul-1996 bailey@genetics.upenn.edu */ - /* What is a good hashing algorithm here? */ - anum ^= ( ( 269 * (U32)getpid()) - ^ (26107 * (U32)&when) - ^ (73819 * (U32)stack_sp)); +#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */ + /* What is a good hashing algorithm here? */ + u ^= ( ( 269 * (U32)getpid()) + ^ (26107 * (U32)&when) + ^ (73819 * (U32)stack_sp)); #endif - } - else - anum = POPi; - (void)srand(anum); - EXTEND(SP, 1); - RETPUSHYES; + return u; } PP(pp_exp) @@ -1387,15 +1417,28 @@ PP(pp_sqrt) PP(pp_int) { dSP; dTARGET; - double value; - value = POPn; - if (value >= 0.0) - (void)modf(value, &value); - else { - (void)modf(-value, &value); - value = -value; + { + double value = TOPn; + IV iv; + + if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) { + iv = SvIVX(TOPs); + SETi(iv); + } + else { + if (value >= 0.0) + (void)modf(value, &value); + else { + (void)modf(-value, &value); + value = -value; + } + iv = I_V(value); + if (iv == value) + SETi(iv); + else + SETn(value); + } } - XPUSHn(value); RETURN; } @@ -1403,15 +1446,22 @@ PP(pp_abs) { dSP; dTARGET; tryAMAGICun(abs); { - double value; - value = POPn; - - if (value < 0.0) - value = -value; - - XPUSHn(value); - RETURN; + double value = TOPn; + IV iv; + + if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) && + (iv = SvIVX(TOPs)) != IV_MIN) { + if (iv < 0) + iv = -iv; + SETi(iv); + } + else { + if (value < 0.0) + value = -value; + SETn(value); + } } + RETURN; } PP(pp_hex) @@ -1588,7 +1638,7 @@ PP(pp_vec) } } - sv_setiv(TARG, (I32)retnum); + sv_setiv(TARG, (IV)retnum); PUSHs(TARG); RETURN; } @@ -2100,7 +2150,7 @@ PP(pp_lslice) if (ix >= max || !(*lelem = firstrelem[ix])) *lelem = &sv_undef; } - if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem))) + if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem))) is_something_there = TRUE; } if (is_something_there) @@ -2698,7 +2748,7 @@ PP(pp_unpack) if (aint >= 128) /* fake up signed chars */ aint -= 256; sv = NEWSV(36, 0); - sv_setiv(sv, (I32)aint); + sv_setiv(sv, (IV)aint); PUSHs(sv_2mortal(sv)); } } @@ -2719,7 +2769,7 @@ PP(pp_unpack) while (len-- > 0) { auint = *s++ & 255; sv = NEWSV(37, 0); - sv_setiv(sv, (I32)auint); + sv_setiv(sv, (IV)auint); PUSHs(sv_2mortal(sv)); } } @@ -2742,7 +2792,7 @@ PP(pp_unpack) Copy(s, &ashort, 1, I16); s += sizeof(I16); sv = NEWSV(38, 0); - sv_setiv(sv, (I32)ashort); + sv_setiv(sv, (IV)ashort); PUSHs(sv_2mortal(sv)); } } @@ -2783,7 +2833,7 @@ PP(pp_unpack) if (datumtype == 'v') aushort = vtohs(aushort); #endif - sv_setiv(sv, (I32)aushort); + sv_setiv(sv, (IV)aushort); PUSHs(sv_2mortal(sv)); } } @@ -2809,7 +2859,7 @@ PP(pp_unpack) Copy(s, &aint, 1, int); s += sizeof(int); sv = NEWSV(40, 0); - sv_setiv(sv, (I32)aint); + sv_setiv(sv, (IV)aint); PUSHs(sv_2mortal(sv)); } } @@ -2835,10 +2885,7 @@ PP(pp_unpack) Copy(s, &auint, 1, unsigned int); s += sizeof(unsigned int); sv = NEWSV(41, 0); - if (auint <= I32_MAX) - sv_setiv(sv, (I32)auint); - else - sv_setnv(sv, (double)auint); + sv_setuv(sv, (UV)auint); PUSHs(sv_2mortal(sv)); } } @@ -2864,7 +2911,7 @@ PP(pp_unpack) Copy(s, &along, 1, I32); s += sizeof(I32); sv = NEWSV(42, 0); - sv_setiv(sv, (I32)along); + sv_setiv(sv, (IV)along); PUSHs(sv_2mortal(sv)); } } @@ -2899,7 +2946,6 @@ PP(pp_unpack) while (len-- > 0) { Copy(s, &aulong, 1, U32); s += sizeof(U32); - sv = NEWSV(43, 0); #ifdef HAS_NTOHL if (datumtype == 'N') aulong = ntohl(aulong); @@ -2908,7 +2954,8 @@ PP(pp_unpack) if (datumtype == 'V') aulong = vtohl(aulong); #endif - sv_setnv(sv, (double)aulong); + sv = NEWSV(43, 0); + sv_setuv(sv, (UV)aulong); PUSHs(sv_2mortal(sv)); } } @@ -2953,7 +3000,8 @@ PP(pp_unpack) char decn[sizeof(UV) * 3 + 1]; char *t; - (void) sprintf(decn, "%0*ld", sizeof(decn) - 1, auv); + (void) sprintf(decn, "%0*ld", + (int)sizeof(decn) - 1, auv); sv = newSVpv(decn, 0); while (s < strend) { sv = mul128(sv, *s & 0x7f); @@ -3015,7 +3063,7 @@ PP(pp_unpack) s += sizeof(unsigned Quad_t); } sv = NEWSV(43, 0); - sv_setiv(sv, (IV)auquad); + sv_setuv(sv, (UV)auquad); PUSHs(sv_2mortal(sv)); } break; @@ -3699,7 +3747,8 @@ PP(pp_split) STRLEN len; register char *s = SvPV(sv, len); char *strend = s + len; - register PMOP *pm = (PMOP*)POPs; + register PMOP *pm; + register REGEXP *rx; register SV *dstr; register char *m; I32 iters = 0; @@ -3710,12 +3759,17 @@ PP(pp_split) I32 realarray = 0; I32 base; AV *oldstack = curstack; - register REGEXP *rx = pm->op_pmregexp; I32 gimme = GIMME; I32 oldsave = savestack_ix; +#ifdef DEBUGGING + Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*); +#else + pm = (PMOP*)POPs; +#endif if (!pm || !s) DIE("panic: do_split"); + rx = pm->op_pmregexp; TAINT_IF((pm->op_pmflags & PMf_LOCALE) && (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE))); @@ -3795,7 +3849,7 @@ PP(pp_split) s = m; } } - else if (pm->op_pmshort) { + else if (pm->op_pmshort && !rx->nparens) { i = SvCUR(pm->op_pmshort); if (i == 1) { i = *SvPVX(pm->op_pmshort);