X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=aeaca4c607a93bcde7caafc333c96a6a29dfa20b;hb=249edfdff1b2b750e894ee5a0b6cb64d2640ca02;hp=2512979170aa6450e16a09f43192ee64f67443e2;hpb=7fd66d9d30123afaec1f02787836d8154d73e836;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 25129791..aeaca4c 100644 --- a/pp.c +++ b/pp.c @@ -46,7 +46,7 @@ typedef unsigned UBW; * have an integral type (except char) small enough to be represented * in a double without loss; that is, it has no 32-bit type. */ -#if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP) +#if LONGSIZE > 4 && defined(_CRAY) && !defined(_CRAYMPP) # define BW_BITS 32 # define BW_MASK ((1 << BW_BITS) - 1) # define BW_SIGN (1 << (BW_BITS - 1)) @@ -69,7 +69,11 @@ typedef unsigned UBW; * If they're not right on your machine, then pack() and unpack() * wouldn't work right anyway; you'll need to apply the Cray hack. * (I'd like to check them with #if, but you can't use sizeof() in - * the preprocessor.) + * the preprocessor.) --??? + */ +/* + The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE + defines are now in config.h. --Andy Dougherty April 1998 */ #define SIZE16 2 #define SIZE32 4 @@ -97,20 +101,26 @@ typedef unsigned UBW; # define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32) #endif +#ifndef PERL_OBJECT static void doencodes _((SV* sv, char* s, I32 len)); static SV* refto _((SV* sv)); static U32 seed _((void)); +#endif static bool srand_called = FALSE; /* variations on pp_null */ -#ifdef DONT_DECLARE_STD #ifdef I_UNISTD #include #endif -#else -extern pid_t getpid (void); + +/* XXX I can't imagine anyone who doesn't have this actually _needs_ + it, since pid_t is an integral type. + --AD 2/20/1998 +*/ +#ifdef NEED_GETPID_PROTO +extern Pid_t getpid (void); #endif PP(pp_stub) @@ -314,7 +324,11 @@ PP(pp_pos) } LvTYPE(TARG) = '.'; - LvTARG(TARG) = sv; + if (LvTARG(TARG) != sv) { + if (LvTARG(TARG)) + SvREFCNT_dec(LvTARG(TARG)); + LvTARG(TARG) = SvREFCNT_inc(sv); + } PUSHs(TARG); /* no SvSETMAGIC */ RETURN; } @@ -434,8 +448,13 @@ PP(pp_refgen) { djSP; dMARK; if (GIMME != G_ARRAY) { - MARK[1] = *SP; - SP = MARK + 1; + if (++MARK <= SP) + *MARK = *SP; + else + *MARK = &sv_undef; + *MARK = refto(*MARK); + SP = MARK; + RETURN; } EXTEND_MORTAL(SP - MARK); while (++MARK <= SP) @@ -443,7 +462,7 @@ PP(pp_refgen) RETURN; } -static SV* +STATIC SV* refto(SV *sv) { SV* rv; @@ -494,8 +513,14 @@ PP(pp_bless) if (MAXARG == 1) stash = curcop->cop_stash; - else - stash = gv_stashsv(POPs, TRUE); + else { + SV *ssv = POPs; + STRLEN len; + char *ptr = SvPV(ssv,len); + if (dowarn && len == 0) + warn("Explicit blessing to '' (assuming package main)"); + stash = gv_stashpvn(ptr, len, TRUE); + } (void)sv_bless(TOPs, stash); RETURN; @@ -505,40 +530,40 @@ PP(pp_gelem) { GV *gv; SV *sv; - SV *ref; + SV *tmpRef; char *elem; djSP; sv = POPs; elem = SvPV(sv, na); gv = (GV*)POPs; - ref = Nullsv; + tmpRef = Nullsv; sv = Nullsv; switch (elem ? *elem : '\0') { case 'A': if (strEQ(elem, "ARRAY")) - ref = (SV*)GvAV(gv); + tmpRef = (SV*)GvAV(gv); break; case 'C': if (strEQ(elem, "CODE")) - ref = (SV*)GvCVu(gv); + tmpRef = (SV*)GvCVu(gv); break; case 'F': if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */ - ref = (SV*)GvIOp(gv); + tmpRef = (SV*)GvIOp(gv); break; case 'G': if (strEQ(elem, "GLOB")) - ref = (SV*)gv; + tmpRef = (SV*)gv; break; case 'H': if (strEQ(elem, "HASH")) - ref = (SV*)GvHV(gv); + tmpRef = (SV*)GvHV(gv); break; case 'I': if (strEQ(elem, "IO")) - ref = (SV*)GvIOp(gv); + tmpRef = (SV*)GvIOp(gv); break; case 'N': if (strEQ(elem, "NAME")) @@ -550,11 +575,11 @@ PP(pp_gelem) break; case 'S': if (strEQ(elem, "SCALAR")) - ref = GvSV(gv); + tmpRef = GvSV(gv); break; } - if (ref) - sv = newRV(ref); + if (tmpRef) + sv = newRV(tmpRef); if (sv) sv_2mortal(sv); else @@ -750,7 +775,7 @@ PP(pp_undef) hv_undef((HV*)sv); break; case SVt_PVCV: - if (cv_const_sv((CV*)sv)) + if (dowarn && cv_const_sv((CV*)sv)) warn("Constant subroutine %s undefined", CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv))); /* FALL THROUGH */ @@ -761,7 +786,17 @@ PP(pp_undef) break; case SVt_PVGV: if (SvFAKE(sv)) - sv_setsv(sv, &sv_undef); + SvSetMagicSV(sv, &sv_undef); + else { + GP *gp; + gp_free((GV*)sv); + Newz(602, gp, 1, GP); + GvGP(sv) = gp_ref(gp); + GvSV(sv) = NEWSV(72,0); + GvLINE(sv) = curcop->cop_line; + GvEGV(sv) = (GV*)sv; + GvMULTI_on(sv); + } break; default: if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) { @@ -886,7 +921,7 @@ PP(pp_divide) PP(pp_modulo) { - djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { UV left; UV right; @@ -1372,7 +1407,7 @@ PP(pp_i_divide) PP(pp_i_modulo) { - djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -1568,7 +1603,7 @@ PP(pp_srand) RETPUSHYES; } -static U32 +STATIC U32 seed(void) { /* @@ -1760,6 +1795,7 @@ PP(pp_substr) djSP; dTARGET; SV *sv; I32 len; + I32 len_ok = 0; STRLEN curlen; I32 pos; I32 rem; @@ -1767,17 +1803,34 @@ PP(pp_substr) I32 lvalue = op->op_flags & OPf_MOD; char *tmps; I32 arybase = curcop->cop_arybase; + char *repl = 0; + STRLEN repl_len; - if (MAXARG > 2) + SvTAINTED_off(TARG); /* decontaminate */ + if (MAXARG > 3) { + /* pop off replacement string */ + sv = POPs; + repl = SvPV(sv, repl_len); + /* pop off length */ + sv = POPs; + if (SvOK(sv)) { + len = SvIV(sv); + len_ok++; + } + } else if (MAXARG == 3) { len = POPi; + len_ok++; + } + pos = POPi; sv = POPs; + PUTBACK; tmps = SvPV(sv, curlen); if (pos >= arybase) { pos -= arybase; rem = curlen-pos; fail = rem; - if (MAXARG > 2) { + if (len_ok) { if (len < 0) { rem += len; if (rem < 0) @@ -1789,7 +1842,7 @@ PP(pp_substr) } else { pos += curlen; - if (MAXARG < 3) + if (!len_ok) rem = curlen; else if (len >= 0) { rem = pos+len; @@ -1807,7 +1860,7 @@ PP(pp_substr) rem -= pos; } if (fail < 0) { - if (dowarn || lvalue) + if (dowarn || lvalue || repl) warn("substr outside of string"); RETPUSHUNDEF; } @@ -1833,11 +1886,18 @@ PP(pp_substr) } LvTYPE(TARG) = 'x'; - LvTARG(TARG) = sv; + if (LvTARG(TARG) != sv) { + if (LvTARG(TARG)) + SvREFCNT_dec(LvTARG(TARG)); + LvTARG(TARG) = SvREFCNT_inc(sv); + } LvTARGOFF(TARG) = pos; LvTARGLEN(TARG) = rem; } + else if (repl) + sv_insert(sv, pos, rem, repl, repl_len); } + SPAGAIN; PUSHs(TARG); /* avoid SvSETMAGIC here */ RETURN; } @@ -1854,6 +1914,7 @@ PP(pp_vec) unsigned long retnum; I32 len; + SvTAINTED_off(TARG); /* decontaminate */ offset *= size; /* turn into bit offset */ len = (offset + size + 7) / 8; if (offset < 0 || size < 1) @@ -1866,7 +1927,11 @@ PP(pp_vec) } LvTYPE(TARG) = 'v'; - LvTARG(TARG) = src; + if (LvTARG(TARG) != src) { + if (LvTARG(TARG)) + SvREFCNT_dec(LvTARG(TARG)); + LvTARG(TARG) = SvREFCNT_inc(src); + } LvTARGOFF(TARG) = offset; LvTARGLEN(TARG) = size; } @@ -2212,7 +2277,7 @@ PP(pp_aslice) if (SvTYPE(av) == SVt_PVAV) { if (lval && op->op_private & OPpLVAL_INTRO) { I32 max = -1; - for (svp = mark + 1; svp <= sp; svp++) { + for (svp = MARK + 1; svp <= SP; svp++) { elem = SvIVx(*svp); if (elem > max) max = elem; @@ -2230,7 +2295,7 @@ PP(pp_aslice) if (!svp || *svp == &sv_undef) DIE(no_aelem, elem); if (op->op_private & OPpLVAL_INTRO) - save_svref(svp); + save_aelem(av, elem, svp); } *MARK = svp ? *svp : &sv_undef; } @@ -2372,7 +2437,7 @@ PP(pp_hslice) if (!he || HeVAL(he) == &sv_undef) DIE(no_helem, SvPV(keysv, na)); if (op->op_private & OPpLVAL_INTRO) - save_svref(&HeVAL(he)); + save_helem(hv, keysv, &HeVAL(he)); } *MARK = he ? HeVAL(he) : &sv_undef; } @@ -2479,7 +2544,7 @@ PP(pp_anonhash) if (MARK < SP) sv_setsv(val, *++MARK); else if (dowarn) - warn("Odd number of elements in hash list"); + warn("Odd number of elements in hash assignment"); (void)hv_store_ent(hv,key,val,0); } SP = ORIGMARK; @@ -2821,7 +2886,7 @@ PP(pp_reverse) RETURN; } -static SV * +STATIC SV * mul128(SV *sv, U8 m) { STRLEN len; @@ -2830,11 +2895,11 @@ mul128(SV *sv, U8 m) U32 i = 0; if (!strnEQ(s, "0000", 4)) { /* need to grow sv */ - SV *New = newSVpv("0000000000", 10); + SV *tmpNew = newSVpv("0000000000", 10); - sv_catsv(New, sv); + sv_catsv(tmpNew, sv); SvREFCNT_dec(sv); /* free old sv */ - sv = New; + sv = tmpNew; s = SvPV(sv, len); } t = s + len - 1; @@ -2854,7 +2919,7 @@ PP(pp_unpack) { djSP; dPOPPOPssrl; - SV **oldsp = sp; + SV **oldsp = SP; I32 gimme = GIMME_V; SV *sv; STRLEN llen; @@ -3201,6 +3266,13 @@ PP(pp_unpack) Copy(s, &aint, 1, int); s += sizeof(int); sv = NEWSV(40, 0); +#ifdef __osf__ + /* Without the dummy below unpack("i", pack("i",-1)) + * return 0xFFffFFff instead of -1 for Digital Unix V4.0 + * cc with optimization turned on */ + (aint) ? + sv_setiv(sv, (IV)aint) : +#endif sv_setiv(sv, (IV)aint); PUSHs(sv_2mortal(sv)); } @@ -3538,12 +3610,12 @@ PP(pp_unpack) checksum = 0; } } - if (sp == oldsp && gimme == G_SCALAR) + if (SP == oldsp && gimme == G_SCALAR) PUSHs(&sv_undef); RETURN; } -static void +STATIC void doencodes(register SV *sv, register char *s, register I32 len) { char hunk[5]; @@ -3567,7 +3639,7 @@ doencodes(register SV *sv, register char *s, register I32 len) sv_catpvn(sv, "\n", 1); } -static SV * +STATIC SV * is_an_int(char *s, STRLEN l) { SV *result = newSVpv("", l); @@ -3615,7 +3687,7 @@ is_an_int(char *s, STRLEN l) return (result); } -static int +STATIC int div128(SV *pnum, bool *done) /* must be '\0' terminated */ @@ -4432,7 +4504,7 @@ PP(pp_threadsv) { djSP; #ifdef USE_THREADS - EXTEND(sp, 1); + EXTEND(SP, 1); if (op->op_private & OPpLVAL_INTRO) PUSHs(*save_threadsv(op->op_targ)); else