X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=2512979170aa6450e16a09f43192ee64f67443e2;hb=7fd66d9d30123afaec1f02787836d8154d73e836;hp=819aea781770b94a5e4c633021e24eb402c4b976;hpb=12f917ad6d7e3aea6f84bc265d3b6d1b415c7598;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 819aea7..25129791 100644 --- a/pp.c +++ b/pp.c @@ -24,7 +24,7 @@ */ #ifdef CXUX_BROKEN_CONSTANT_CONVERT static double UV_MAX_cxux = ((double)UV_MAX); -#endif +#endif /* * Types used in bitwise operations. @@ -141,7 +141,16 @@ PP(pp_padav) if (GIMME == G_ARRAY) { I32 maxarg = AvFILL((AV*)TARG) + 1; EXTEND(SP, maxarg); - Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*); + if (SvMAGICAL(TARG)) { + U32 i; + for (i=0; i < maxarg; i++) { + SV **svp = av_fetch((AV*)TARG, i, FALSE); + SP[i+1] = (svp) ? *svp : &sv_undef; + } + } + else { + Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*); + } SP += maxarg; } else { @@ -189,7 +198,7 @@ PP(pp_padany) PP(pp_rv2gv) { djSP; dTOPss; - + if (SvROK(sv)) { wasref: sv = SvRV(sv); @@ -297,7 +306,7 @@ PP(pp_av2arylen) PP(pp_pos) { djSP; dTARGET; dPOPss; - + if (op->op_flags & OPf_MOD) { if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); @@ -310,7 +319,7 @@ PP(pp_pos) RETURN; } else { - MAGIC* mg; + MAGIC* mg; if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { mg = mg_find(sv, 'g'); @@ -351,9 +360,54 @@ PP(pp_prototype) SV *ret; ret = &sv_undef; + if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) { + char *s = SvPVX(TOPs); + if (strnEQ(s, "CORE::", 6)) { + int code; + + code = keyword(s + 6, SvCUR(TOPs) - 6); + if (code < 0) { /* Overridable. */ +#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2) + int i = 0, n = 0, seen_question = 0; + I32 oa; + char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */ + + while (i < MAXO) { /* The slow way. */ + if (strEQ(s + 6, op_name[i]) || strEQ(s + 6, op_desc[i])) + goto found; + i++; + } + goto nonesuch; /* Should not happen... */ + found: + oa = opargs[i] >> OASHIFT; + while (oa) { + if (oa & OA_OPTIONAL) { + seen_question = 1; + str[n++] = ';'; + } else if (seen_question) + goto set; /* XXXX system, exec */ + if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF + && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) { + str[n++] = '\\'; + } + /* What to do with R ((un)tie, tied, (sys)read, recv)? */ + str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)]; + oa = oa >> 4; + } + str[n++] = '\0'; + ret = sv_2mortal(newSVpv(str, n - 1)); + } else if (code) /* Non-Overridable */ + goto set; + else { /* None such */ + nonesuch: + croak("Cannot find an opnumber for \"%s\"", s+6); + } + } + } cv = sv_2cv(TOPs, &stash, &gv, FALSE); if (cv && SvPOK(cv)) ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv))); + set: SETs(ret); RETURN; } @@ -374,7 +428,7 @@ PP(pp_srefgen) djSP; *SP = refto(*SP); RETURN; -} +} PP(pp_refgen) { @@ -422,7 +476,7 @@ PP(pp_ref) sv = POPs; if (sv && SvGMAGICAL(sv)) - mg_get(sv); + mg_get(sv); if (!sv || !SvROK(sv)) RETPUSHNO; @@ -514,6 +568,7 @@ PP(pp_gelem) PP(pp_study) { djSP; dPOPss; + register UNOP *unop = cUNOP; register unsigned char *s; register I32 pos; register I32 ch; @@ -521,6 +576,14 @@ PP(pp_study) register I32 *snext; STRLEN len; + if(unop->op_first && unop->op_first->op_type == OP_PUSHRE) { + PMOP *pm = (PMOP *)unop->op_first; + SV *rv = sv_newmortal(); + sv = newSVrv(rv, "Regexp"); + sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0); + RETURNX(PUSHs(rv)); + } + if (sv == lastscream) { if (SvSCREAM(sv)) RETPUSHYES; @@ -581,7 +644,7 @@ PP(pp_trans) if (op->op_flags & OPf_STACKED) sv = POPs; else { - sv = GvSV(defgv); + sv = DEFSV; EXTEND(SP,1); } TARG = sv_newmortal(); @@ -619,7 +682,7 @@ PP(pp_chomp) { djSP; dMARK; dTARGET; register I32 count = 0; - + while (SP > MARK) count += do_chomp(POPs); PUSHi(count); @@ -775,7 +838,7 @@ PP(pp_postdec) PP(pp_pow) { - djSP; dATARGET; tryAMAGICbin(pow,opASSIGN); + djSP; dATARGET; tryAMAGICbin(pow,opASSIGN); { dPOPTOPnnrl; SETn( pow( left, right) ); @@ -785,7 +848,7 @@ PP(pp_pow) PP(pp_multiply) { - djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); { dPOPTOPnnrl; SETn( left * right ); @@ -795,7 +858,7 @@ PP(pp_multiply) PP(pp_divide) { - djSP; dATARGET; tryAMAGICbin(div,opASSIGN); + djSP; dATARGET; tryAMAGICbin(div,opASSIGN); { dPOPPOPnnrl; double value; @@ -928,7 +991,7 @@ PP(pp_repeat) PP(pp_subtract) { - djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); + djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); { dPOPTOPnnrl_ul; SETn( left - right ); @@ -938,7 +1001,7 @@ PP(pp_subtract) PP(pp_left_shift) { - djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); + djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); { IBW shift = POPi; if (op->op_private & HINT_INTEGER) { @@ -957,7 +1020,7 @@ PP(pp_left_shift) PP(pp_right_shift) { - djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); + djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); { IBW shift = POPi; if (op->op_private & HINT_INTEGER) { @@ -976,7 +1039,7 @@ PP(pp_right_shift) PP(pp_lt) { - djSP; tryAMAGICbinSET(lt,0); + djSP; tryAMAGICbinSET(lt,0); { dPOPnv; SETs(boolSV(TOPn < value)); @@ -986,7 +1049,7 @@ PP(pp_lt) PP(pp_gt) { - djSP; tryAMAGICbinSET(gt,0); + djSP; tryAMAGICbinSET(gt,0); { dPOPnv; SETs(boolSV(TOPn > value)); @@ -996,7 +1059,7 @@ PP(pp_gt) PP(pp_le) { - djSP; tryAMAGICbinSET(le,0); + djSP; tryAMAGICbinSET(le,0); { dPOPnv; SETs(boolSV(TOPn <= value)); @@ -1006,7 +1069,7 @@ PP(pp_le) PP(pp_ge) { - djSP; tryAMAGICbinSET(ge,0); + djSP; tryAMAGICbinSET(ge,0); { dPOPnv; SETs(boolSV(TOPn >= value)); @@ -1016,7 +1079,7 @@ PP(pp_ge) PP(pp_ne) { - djSP; tryAMAGICbinSET(ne,0); + djSP; tryAMAGICbinSET(ne,0); { dPOPnv; SETs(boolSV(TOPn != value)); @@ -1026,7 +1089,7 @@ PP(pp_ne) PP(pp_ncmp) { - djSP; dTARGET; tryAMAGICbin(ncmp,0); + djSP; dTARGET; tryAMAGICbin(ncmp,0); { dPOPTOPnnrl; I32 value; @@ -1048,7 +1111,7 @@ PP(pp_ncmp) PP(pp_slt) { - djSP; tryAMAGICbinSET(slt,0); + djSP; tryAMAGICbinSET(slt,0); { dPOPTOPssrl; int cmp = ((op->op_private & OPpLOCALE) @@ -1061,7 +1124,7 @@ PP(pp_slt) PP(pp_sgt) { - djSP; tryAMAGICbinSET(sgt,0); + djSP; tryAMAGICbinSET(sgt,0); { dPOPTOPssrl; int cmp = ((op->op_private & OPpLOCALE) @@ -1074,7 +1137,7 @@ PP(pp_sgt) PP(pp_sle) { - djSP; tryAMAGICbinSET(sle,0); + djSP; tryAMAGICbinSET(sle,0); { dPOPTOPssrl; int cmp = ((op->op_private & OPpLOCALE) @@ -1087,7 +1150,7 @@ PP(pp_sle) PP(pp_sge) { - djSP; tryAMAGICbinSET(sge,0); + djSP; tryAMAGICbinSET(sge,0); { dPOPTOPssrl; int cmp = ((op->op_private & OPpLOCALE) @@ -1100,7 +1163,7 @@ PP(pp_sge) PP(pp_seq) { - djSP; tryAMAGICbinSET(seq,0); + djSP; tryAMAGICbinSET(seq,0); { dPOPTOPssrl; SETs(boolSV(sv_eq(left, right))); @@ -1110,7 +1173,7 @@ PP(pp_seq) PP(pp_sne) { - djSP; tryAMAGICbinSET(sne,0); + djSP; tryAMAGICbinSET(sne,0); { dPOPTOPssrl; SETs(boolSV(!sv_eq(left, right))); @@ -1133,16 +1196,16 @@ PP(pp_scmp) PP(pp_bit_and) { - djSP; dATARGET; tryAMAGICbin(band,opASSIGN); + djSP; dATARGET; tryAMAGICbin(band,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { if (op->op_private & HINT_INTEGER) { - IBW value = SvIV(left) & SvIV(right); + IBW value = SvIV(left) & SvIV(right); SETi(BWi(value)); } else { - UBW value = SvUV(left) & SvUV(right); + UBW value = SvUV(left) & SvUV(right); SETu(BWu(value)); } } @@ -1156,16 +1219,16 @@ PP(pp_bit_and) PP(pp_bit_xor) { - djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); + djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { if (op->op_private & HINT_INTEGER) { - IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); + IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right); SETi(BWi(value)); } else { - UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); + UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right); SETu(BWu(value)); } } @@ -1179,16 +1242,16 @@ PP(pp_bit_xor) PP(pp_bit_or) { - djSP; dATARGET; tryAMAGICbin(bor,opASSIGN); + djSP; dATARGET; tryAMAGICbin(bor,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { if (op->op_private & HINT_INTEGER) { - IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); + IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right); SETi(BWi(value)); } else { - UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); + UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right); SETu(BWu(value)); } } @@ -1243,7 +1306,7 @@ PP(pp_not) PP(pp_complement) { - djSP; dTARGET; tryAMAGICun(compl); + djSP; dTARGET; tryAMAGICun(compl); { dTOPss; if (SvNIOKp(sv)) { @@ -1286,7 +1349,7 @@ PP(pp_complement) PP(pp_i_multiply) { - djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); { dPOPTOPiirl; SETi( left * right ); @@ -1296,7 +1359,7 @@ PP(pp_i_multiply) PP(pp_i_divide) { - djSP; dATARGET; tryAMAGICbin(div,opASSIGN); + djSP; dATARGET; tryAMAGICbin(div,opASSIGN); { dPOPiv; if (value == 0) @@ -1309,7 +1372,7 @@ PP(pp_i_divide) PP(pp_i_modulo) { - djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); + djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); { dPOPTOPiirl; if (!right) @@ -1321,7 +1384,7 @@ PP(pp_i_modulo) PP(pp_i_add) { - djSP; dATARGET; tryAMAGICbin(add,opASSIGN); + djSP; dATARGET; tryAMAGICbin(add,opASSIGN); { dPOPTOPiirl; SETi( left + right ); @@ -1331,7 +1394,7 @@ PP(pp_i_add) PP(pp_i_subtract) { - djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); + djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); { dPOPTOPiirl; SETi( left - right ); @@ -1341,7 +1404,7 @@ PP(pp_i_subtract) PP(pp_i_lt) { - djSP; tryAMAGICbinSET(lt,0); + djSP; tryAMAGICbinSET(lt,0); { dPOPTOPiirl; SETs(boolSV(left < right)); @@ -1351,7 +1414,7 @@ PP(pp_i_lt) PP(pp_i_gt) { - djSP; tryAMAGICbinSET(gt,0); + djSP; tryAMAGICbinSET(gt,0); { dPOPTOPiirl; SETs(boolSV(left > right)); @@ -1361,7 +1424,7 @@ PP(pp_i_gt) PP(pp_i_le) { - djSP; tryAMAGICbinSET(le,0); + djSP; tryAMAGICbinSET(le,0); { dPOPTOPiirl; SETs(boolSV(left <= right)); @@ -1371,7 +1434,7 @@ PP(pp_i_le) PP(pp_i_ge) { - djSP; tryAMAGICbinSET(ge,0); + djSP; tryAMAGICbinSET(ge,0); { dPOPTOPiirl; SETs(boolSV(left >= right)); @@ -1381,7 +1444,7 @@ PP(pp_i_ge) PP(pp_i_eq) { - djSP; tryAMAGICbinSET(eq,0); + djSP; tryAMAGICbinSET(eq,0); { dPOPTOPiirl; SETs(boolSV(left == right)); @@ -1391,7 +1454,7 @@ PP(pp_i_eq) PP(pp_i_ne) { - djSP; tryAMAGICbinSET(ne,0); + djSP; tryAMAGICbinSET(ne,0); { dPOPTOPiirl; SETs(boolSV(left != right)); @@ -1401,7 +1464,7 @@ PP(pp_i_ne) PP(pp_i_ncmp) { - djSP; dTARGET; tryAMAGICbin(ncmp,0); + djSP; dTARGET; tryAMAGICbin(ncmp,0); { dPOPTOPiirl; I32 value; @@ -1428,7 +1491,7 @@ PP(pp_i_negate) PP(pp_atan2) { - djSP; dTARGET; tryAMAGICbin(atan2,0); + djSP; dTARGET; tryAMAGICbin(atan2,0); { dPOPTOPnnrl; SETn(atan2(left, right)); @@ -1744,7 +1807,7 @@ PP(pp_substr) rem -= pos; } if (fail < 0) { - if (dowarn || lvalue) + if (dowarn || lvalue) warn("substr outside of string"); RETPUSHUNDEF; } @@ -1772,7 +1835,7 @@ PP(pp_substr) LvTYPE(TARG) = 'x'; LvTARG(TARG) = sv; LvTARGOFF(TARG) = pos; - LvTARGLEN(TARG) = rem; + LvTARGLEN(TARG) = rem; } } PUSHs(TARG); /* avoid SvSETMAGIC here */ @@ -1804,8 +1867,8 @@ PP(pp_vec) LvTYPE(TARG) = 'v'; LvTARG(TARG) = src; - LvTARGOFF(TARG) = offset; - LvTARGLEN(TARG) = size; + LvTARGOFF(TARG) = offset; + LvTARGLEN(TARG) = size; } if (len > srclen) { if (size <= 8) @@ -1848,7 +1911,7 @@ PP(pp_vec) } } - sv_setiv(TARG, (IV)retnum); + sv_setuv(TARG, (UV)retnum); PUSHs(TARG); RETURN; } @@ -2189,7 +2252,7 @@ PP(pp_each) HE *entry; I32 gimme = GIMME_V; I32 realhv = (SvTYPE(hash) == SVt_PVHV); - + PUTBACK; /* might clobber stack_sp */ entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash); @@ -2437,13 +2500,25 @@ PP(pp_splice) I32 after; I32 diff; SV **tmparyval = 0; + MAGIC *mg; + + if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) { + *MARK-- = mg->mg_obj; + PUSHMARK(MARK); + PUTBACK; + ENTER; + perl_call_method("SPLICE",GIMME_V); + LEAVE; + SPAGAIN; + RETURN; + } SP++; if (++MARK < SP) { offset = i = SvIVx(*MARK); if (offset < 0) - offset += AvFILL(ary) + 1; + offset += AvFILLp(ary) + 1; else offset -= curcop->cop_arybase; if (offset < 0) @@ -2460,9 +2535,9 @@ PP(pp_splice) offset = 0; length = AvMAX(ary) + 1; } - if (offset > AvFILL(ary) + 1) - offset = AvFILL(ary) + 1; - after = AvFILL(ary) + 1 - (offset + length); + if (offset > AvFILLp(ary) + 1) + offset = AvFILLp(ary) + 1; + after = AvFILLp(ary) + 1 - (offset + length); if (after < 0) { /* not that much array */ length += after; /* offset+length now in array */ after = 0; @@ -2510,7 +2585,7 @@ PP(pp_splice) SvREFCNT_dec(*dst++); /* free them now */ } } - AvFILL(ary) += diff; + AvFILLp(ary) += diff; /* pull up or down? */ @@ -2531,7 +2606,7 @@ PP(pp_splice) dst = src + diff; /* diff is negative */ Move(src, dst, after, SV*); } - dst = &AvARRAY(ary)[AvFILL(ary)+1]; + dst = &AvARRAY(ary)[AvFILLp(ary)+1]; /* avoid later double free */ } i = -diff; @@ -2565,15 +2640,15 @@ PP(pp_splice) } SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */ AvMAX(ary) += diff; - AvFILL(ary) += diff; + AvFILLp(ary) += diff; } else { - if (AvFILL(ary) + diff >= AvMAX(ary)) /* oh, well */ - av_extend(ary, AvFILL(ary) + diff); - AvFILL(ary) += diff; + if (AvFILLp(ary) + diff >= AvMAX(ary)) /* oh, well */ + av_extend(ary, AvFILLp(ary) + diff); + AvFILLp(ary) += diff; if (after) { - dst = AvARRAY(ary) + AvFILL(ary); + dst = AvARRAY(ary) + AvFILLp(ary); src = dst - diff; for (i = after; i; i--) { *dst-- = *src--; @@ -2624,12 +2699,25 @@ PP(pp_push) djSP; dMARK; dORIGMARK; dTARGET; register AV *ary = (AV*)*++MARK; register SV *sv = &sv_undef; + MAGIC *mg; - for (++MARK; MARK <= SP; MARK++) { - sv = NEWSV(51, 0); - if (*MARK) - sv_setsv(sv, *MARK); - av_push(ary, sv); + if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) { + *MARK-- = mg->mg_obj; + PUSHMARK(MARK); + PUTBACK; + ENTER; + perl_call_method("PUSH",G_SCALAR|G_DISCARD); + LEAVE; + SPAGAIN; + } + else { + /* Why no pre-extend of ary here ? */ + for (++MARK; MARK <= SP; MARK++) { + sv = NEWSV(51, 0); + if (*MARK) + sv_setsv(sv, *MARK); + av_push(ary, sv); + } } SP = ORIGMARK; PUSHi( AvFILL(ary) + 1 ); @@ -2667,14 +2755,25 @@ PP(pp_unshift) register AV *ary = (AV*)*++MARK; register SV *sv; register I32 i = 0; + MAGIC *mg; - av_unshift(ary, SP - MARK); - while (MARK < SP) { - sv = NEWSV(27, 0); - sv_setsv(sv, *++MARK); - (void)av_store(ary, i++, sv); + if (SvRMAGICAL(ary) && (mg = mg_find((SV*)ary,'P'))) { + *MARK-- = mg->mg_obj; + PUSHMARK(MARK); + PUTBACK; + ENTER; + perl_call_method("UNSHIFT",G_SCALAR|G_DISCARD); + LEAVE; + SPAGAIN; + } + else { + av_unshift(ary, SP - MARK); + while (MARK < SP) { + sv = NEWSV(27, 0); + sv_setsv(sv, *++MARK); + (void)av_store(ary, i++, sv); + } } - SP = ORIGMARK; PUSHi( AvFILL(ary) + 1 ); RETURN; @@ -2705,7 +2804,7 @@ PP(pp_reverse) if (SP - MARK > 1) do_join(TARG, &sv_no, MARK, SP); else - sv_setsv(TARG, (SP > MARK) ? *SP : GvSV(defgv)); + sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV); up = SvPV_force(TARG, len); if (len > 1) { down = SvPVX(TARG) + len - 1; @@ -3052,7 +3151,7 @@ PP(pp_unpack) s += SIZE16; #ifdef HAS_NTOHS if (datumtype == 'n') - aushort = ntohs(aushort); + aushort = PerlSock_ntohs(aushort); #endif #ifdef HAS_VTOHS if (datumtype == 'v') @@ -3070,7 +3169,7 @@ PP(pp_unpack) sv = NEWSV(39, 0); #ifdef HAS_NTOHS if (datumtype == 'n') - aushort = ntohs(aushort); + aushort = PerlSock_ntohs(aushort); #endif #ifdef HAS_VTOHS if (datumtype == 'v') @@ -3171,7 +3270,7 @@ PP(pp_unpack) s += SIZE32; #ifdef HAS_NTOHL if (datumtype == 'N') - aulong = ntohl(aulong); + aulong = PerlSock_ntohl(aulong); #endif #ifdef HAS_VTOHL if (datumtype == 'V') @@ -3191,7 +3290,7 @@ PP(pp_unpack) s += SIZE32; #ifdef HAS_NTOHL if (datumtype == 'N') - aulong = ntohl(aulong); + aulong = PerlSock_ntohl(aulong); #endif #ifdef HAS_VTOHL if (datumtype == 'V') @@ -3225,7 +3324,7 @@ PP(pp_unpack) case 'w': EXTEND(SP, len); EXTEND_MORTAL(len); - { + { UV auv = 0; U32 bytes = 0; @@ -3517,9 +3616,9 @@ is_an_int(char *s, STRLEN l) } static int -div128(SV *pnum, char *done) +div128(SV *pnum, bool *done) /* must be '\0' terminated */ - + { STRLEN len; char *s = SvPV(pnum, len); @@ -3801,7 +3900,7 @@ PP(pp_pack) fromstr = NEXTFROM; ashort = (I16)SvIV(fromstr); #ifdef HAS_HTONS - ashort = htons(ashort); + ashort = PerlSock_htons(ashort); #endif CAT16(cat, &ashort); } @@ -3867,7 +3966,7 @@ PP(pp_pack) SV *norm; STRLEN len; bool done; - + /* Copy string and check for compliance */ from = SvPV(fromstr, len); if ((norm = is_an_int(from, len)) == NULL) @@ -3913,7 +4012,7 @@ PP(pp_pack) fromstr = NEXTFROM; aulong = SvUV(fromstr); #ifdef HAS_HTONL - aulong = htonl(aulong); + aulong = PerlSock_htonl(aulong); #endif CAT32(cat, &aulong); } @@ -4011,6 +4110,7 @@ PP(pp_pack) } #undef NEXTFROM + PP(pp_split) { djSP; dTARG; @@ -4034,6 +4134,8 @@ PP(pp_split) AV *oldstack = curstack; I32 gimme = GIMME_V; I32 oldsave = savestack_ix; + I32 make_mortal = 1; + MAGIC *mg = (MAGIC *) NULL; #ifdef DEBUGGING Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*); @@ -4059,15 +4161,24 @@ PP(pp_split) ary = Nullav; if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) { realarray = 1; - if (!AvREAL(ary)) { - AvREAL_on(ary); - for (i = AvFILL(ary); i >= 0; i--) - AvARRAY(ary)[i] = &sv_undef; /* don't free mere refs */ - } + PUTBACK; av_extend(ary,0); av_clear(ary); - /* temporarily switch stacks */ - SWITCHSTACK(curstack, ary); + SPAGAIN; + if (SvRMAGICAL(ary) && (mg = mg_find((SV *) ary, 'P'))) { + PUSHMARK(SP); + XPUSHs(mg->mg_obj); + } + else { + if (!AvREAL(ary)) { + AvREAL_on(ary); + for (i = AvFILLp(ary); i >= 0; i--) + AvARRAY(ary)[i] = &sv_undef; /* don't free mere refs */ + } + /* temporarily switch stacks */ + SWITCHSTACK(curstack, ary); + make_mortal = 0; + } } base = SP - stack_base; orig = s; @@ -4100,7 +4211,7 @@ PP(pp_split) dstr = NEWSV(30, m-s); sv_setpvn(dstr, s, m-s); - if (!realarray) + if (make_mortal) sv_2mortal(dstr); XPUSHs(dstr); @@ -4120,16 +4231,18 @@ PP(pp_split) break; dstr = NEWSV(30, m-s); sv_setpvn(dstr, s, m-s); - if (!realarray) + if (make_mortal) sv_2mortal(dstr); XPUSHs(dstr); s = m; } } - else if (pm->op_pmshort && !rx->nparens) { - i = SvCUR(pm->op_pmshort); - if (i == 1) { - i = *SvPVX(pm->op_pmshort); + else if (rx->check_substr && !rx->nparens + && (rx->reganch & ROPT_CHECK_ALL) + && !(rx->reganch & ROPT_ANCH)) { + i = SvCUR(rx->check_substr); + if (i == 1 && !SvTAIL(rx->check_substr)) { + i = *SvPVX(rx->check_substr); while (--limit) { /*SUPPRESS 530*/ for (m = s; m < strend && *m != i; m++) ; @@ -4137,7 +4250,7 @@ PP(pp_split) break; dstr = NEWSV(30, m-s); sv_setpvn(dstr, s, m-s); - if (!realarray) + if (make_mortal) sv_2mortal(dstr); XPUSHs(dstr); s = m + 1; @@ -4147,12 +4260,12 @@ PP(pp_split) #ifndef lint while (s < strend && --limit && (m=fbm_instr((unsigned char*)s, (unsigned char*)strend, - pm->op_pmshort)) ) + rx->check_substr)) ) #endif { dstr = NEWSV(31, m-s); sv_setpvn(dstr, s, m-s); - if (!realarray) + if (make_mortal) sv_2mortal(dstr); XPUSHs(dstr); s = m + i; @@ -4162,9 +4275,9 @@ PP(pp_split) else { maxiters += (strend - s) * rx->nparens; while (s < strend && --limit && - pregexec(rx, s, strend, orig, 1, Nullsv, TRUE)) + regexec_flags(rx, s, strend, orig, 1, Nullsv, NULL, 0)) { - TAINT_IF(rx->exec_tainted); + TAINT_IF(RX_MATCH_TAINTED(rx)); if (rx->subbase && rx->subbase != orig) { m = s; @@ -4176,7 +4289,7 @@ PP(pp_split) m = rx->startp[0]; dstr = NEWSV(32, m-s); sv_setpvn(dstr, s, m-s); - if (!realarray) + if (make_mortal) sv_2mortal(dstr); XPUSHs(dstr); if (rx->nparens) { @@ -4189,7 +4302,7 @@ PP(pp_split) } else dstr = NEWSV(33, 0); - if (!realarray) + if (make_mortal) sv_2mortal(dstr); XPUSHs(dstr); } @@ -4197,16 +4310,17 @@ PP(pp_split) s = rx->endp[0]; } } + LEAVE_SCOPE(oldsave); iters = (SP - stack_base) - base; if (iters > maxiters) DIE("Split loop"); - + /* keep field after final delim? */ if (s < strend || (iters && origlimit)) { dstr = NEWSV(34, strend-s); sv_setpvn(dstr, s, strend-s); - if (!realarray) + if (make_mortal) sv_2mortal(dstr); XPUSHs(dstr); iters++; @@ -4215,18 +4329,37 @@ PP(pp_split) while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) iters--, SP--; } + if (realarray) { - SWITCHSTACK(ary, oldstack); - if (SvSMAGICAL(ary)) { + if (!mg) { + SWITCHSTACK(ary, oldstack); + if (SvSMAGICAL(ary)) { + PUTBACK; + mg_set((SV*)ary); + SPAGAIN; + } + if (gimme == G_ARRAY) { + EXTEND(SP, iters); + Copy(AvARRAY(ary), SP + 1, iters, SV*); + SP += iters; + RETURN; + } + } + else { PUTBACK; - mg_set((SV*)ary); + ENTER; + perl_call_method("PUSH",G_SCALAR|G_DISCARD); + LEAVE; SPAGAIN; - } - if (gimme == G_ARRAY) { - EXTEND(SP, iters); - Copy(AvARRAY(ary), SP + 1, iters, SV*); - SP += iters; - RETURN; + if (gimme == G_ARRAY) { + /* EXTEND should not be needed - we just popped them */ + EXTEND(SP, iters); + for (i=0; i < iters; i++) { + SV **svp = av_fetch(ary, i, FALSE); + PUSHs((svp) ? *svp : &sv_undef); + } + RETURN; + } } } else { @@ -4247,7 +4380,7 @@ unlock_condpair(void *svv) { dTHR; MAGIC *mg = mg_find((SV*)svv, 'm'); - + if (!mg) croak("panic: unlock_condpair unlocking non-mutex"); MUTEX_LOCK(MgMUTEXP(mg)); @@ -4268,7 +4401,7 @@ PP(pp_lock) SV *retsv = sv; #ifdef USE_THREADS MAGIC *mg; - + if (SvROK(sv)) sv = SvRV(sv); @@ -4299,16 +4432,13 @@ PP(pp_threadsv) { djSP; #ifdef USE_THREADS - SV **svp = av_fetch(thr->magicals, op->op_targ, FALSE); - if (!svp) - croak("panic: pp_threadsv"); EXTEND(sp, 1); if (op->op_private & OPpLVAL_INTRO) - PUSHs(save_svref(svp)); + PUSHs(*save_threadsv(op->op_targ)); else - PUSHs(*svp); + PUSHs(THREADSV(op->op_targ)); + RETURN; #else DIE("tried to access per-thread data in non-threaded perl"); #endif /* USE_THREADS */ - RETURN; }