3 * Copyright (c) 1991-2003, Larry Wall
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
11 * Then he heard Merry change the note, and up went the Horn-cry of Buckland,
14 * Awake! Awake! Fear, Fire, Foes! Awake!
19 #define PERL_IN_PP_HOT_C
33 PL_curcop = (COP*)PL_op;
34 TAINT_NOT; /* Each statement is presumed innocent */
35 PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
44 if (PL_op->op_private & OPpLVAL_INTRO)
45 PUSHs(save_scalar(cGVOP_gv));
47 PUSHs(GvSV(cGVOP_gv));
58 PL_curcop = (COP*)PL_op;
64 PUSHMARK(PL_stack_sp);
79 XPUSHs((SV*)cGVOP_gv);
90 RETURNOP(cLOGOP->op_other);
98 if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
100 temp = left; left = right; right = temp;
102 if (PL_tainting && PL_tainted && !SvTAINTED(left))
104 SvSetMagicSV(right, left);
113 RETURNOP(cLOGOP->op_other);
115 RETURNOP(cLOGOP->op_next);
121 TAINT_NOT; /* Each statement is presumed innocent */
122 PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
124 oldsave = PL_scopestack[PL_scopestack_ix - 1];
125 LEAVE_SCOPE(oldsave);
131 dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
138 char* rpv = SvPV(right, rlen); /* mg_get(right) happens here */
139 bool rbyte = !SvUTF8(right), rcopied = FALSE;
141 if (TARG == right && right != left) {
142 right = sv_2mortal(newSVpvn(rpv, rlen));
143 rpv = SvPV(right, rlen); /* no point setting UTF8 here */
148 lpv = SvPV(left, llen); /* mg_get(left) may happen here */
149 lbyte = !SvUTF8(left);
150 sv_setpvn(TARG, lpv, llen);
156 else { /* TARG == left */
157 if (SvGMAGICAL(left))
158 mg_get(left); /* or mg_get(left) may happen here */
161 lpv = SvPV_nomg(left, llen);
162 lbyte = !SvUTF8(left);
165 #if defined(PERL_Y2KWARN)
166 if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K) && SvOK(TARG)) {
167 if (llen >= 2 && lpv[llen - 2] == '1' && lpv[llen - 1] == '9'
168 && (llen == 2 || !isDIGIT(lpv[llen - 3])))
170 Perl_warner(aTHX_ packWARN(WARN_Y2K), "Possible Y2K bug: %s",
171 "about to append an integer to '19'");
176 if (lbyte != rbyte) {
178 sv_utf8_upgrade_nomg(TARG);
181 right = sv_2mortal(newSVpvn(rpv, rlen));
182 sv_utf8_upgrade_nomg(right);
183 rpv = SvPV(right, rlen);
186 sv_catpvn_nomg(TARG, rpv, rlen);
197 if (PL_op->op_flags & OPf_MOD) {
198 if (PL_op->op_private & OPpLVAL_INTRO)
199 SAVECLEARSV(PAD_SVl(PL_op->op_targ));
200 else if (PL_op->op_private & OPpDEREF) {
202 vivify_ref(PAD_SVl(PL_op->op_targ), PL_op->op_private & OPpDEREF);
211 tryAMAGICunTARGET(iter, 0);
212 PL_last_in_gv = (GV*)(*PL_stack_sp--);
213 if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
214 if (SvROK(PL_last_in_gv) && SvTYPE(SvRV(PL_last_in_gv)) == SVt_PVGV)
215 PL_last_in_gv = (GV*)SvRV(PL_last_in_gv);
218 XPUSHs((SV*)PL_last_in_gv);
221 PL_last_in_gv = (GV*)(*PL_stack_sp--);
224 return do_readline();
229 dSP; tryAMAGICbinSET(eq,0);
230 #ifndef NV_PRESERVES_UV
231 if (SvROK(TOPs) && SvROK(TOPm1s)) {
233 SETs(boolSV(SvRV(TOPs) == SvRV(TOPp1s)));
237 #ifdef PERL_PRESERVE_IVUV
240 /* Unless the left argument is integer in range we are going
241 to have to use NV maths. Hence only attempt to coerce the
242 right argument if we know the left is integer. */
245 bool auvok = SvUOK(TOPm1s);
246 bool buvok = SvUOK(TOPs);
248 if (auvok == buvok) { /* ## IV == IV or UV == UV ## */
249 /* Casting IV to UV before comparison isn't going to matter
250 on 2s complement. On 1s complement or sign&magnitude
251 (if we have any of them) it could to make negative zero
252 differ from normal zero. As I understand it. (Need to
253 check - is negative zero implementation defined behaviour
255 UV buv = SvUVX(POPs);
256 UV auv = SvUVX(TOPs);
258 SETs(boolSV(auv == buv));
261 { /* ## Mixed IV,UV ## */
265 /* == is commutative so doesn't matter which is left or right */
267 /* top of stack (b) is the iv */
276 /* As uv is a UV, it's >0, so it cannot be == */
280 /* we know iv is >= 0 */
281 SETs(boolSV((UV)iv == SvUVX(uvp)));
289 SETs(boolSV(TOPn == value));
297 if (SvTYPE(TOPs) > SVt_PVLV)
298 DIE(aTHX_ PL_no_modify);
299 if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
300 && SvIVX(TOPs) != IV_MAX)
303 SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
305 else /* Do all the PERL_PRESERVE_IVUV conditionals in sv_inc */
318 RETURNOP(cLOGOP->op_other);
324 /* Most of this is lifted straight from pp_defined */
329 if (!sv || !SvANY(sv)) {
331 RETURNOP(cLOGOP->op_other);
334 switch (SvTYPE(sv)) {
336 if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
340 if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
344 if (CvROOT(sv) || CvXSUB(sv))
355 RETURNOP(cLOGOP->op_other);
360 dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN);
361 useleft = USE_LEFT(TOPm1s);
362 #ifdef PERL_PRESERVE_IVUV
363 /* We must see if we can perform the addition with integers if possible,
364 as the integer code detects overflow while the NV code doesn't.
365 If either argument hasn't had a numeric conversion yet attempt to get
366 the IV. It's important to do this now, rather than just assuming that
367 it's not IOK as a PV of "9223372036854775806" may not take well to NV
368 addition, and an SV which is NOK, NV=6.0 ought to be coerced to
369 integer in case the second argument is IV=9223372036854775806
370 We can (now) rely on sv_2iv to do the right thing, only setting the
371 public IOK flag if the value in the NV (or PV) slot is truly integer.
373 A side effect is that this also aggressively prefers integer maths over
374 fp maths for integer values.
376 How to detect overflow?
378 C 99 section 6.2.6.1 says
380 The range of nonnegative values of a signed integer type is a subrange
381 of the corresponding unsigned integer type, and the representation of
382 the same value in each type is the same. A computation involving
383 unsigned operands can never overflow, because a result that cannot be
384 represented by the resulting unsigned integer type is reduced modulo
385 the number that is one greater than the largest value that can be
386 represented by the resulting type.
390 which I read as "unsigned ints wrap."
392 signed integer overflow seems to be classed as "exception condition"
394 If an exceptional condition occurs during the evaluation of an
395 expression (that is, if the result is not mathematically defined or not
396 in the range of representable values for its type), the behavior is
399 (6.5, the 5th paragraph)
401 I had assumed that on 2s complement machines signed arithmetic would
402 wrap, hence coded pp_add and pp_subtract on the assumption that
403 everything perl builds on would be happy. After much wailing and
404 gnashing of teeth it would seem that irix64 knows its ANSI spec well,
405 knows that it doesn't need to, and doesn't. Bah. Anyway, the all-
406 unsigned code below is actually shorter than the old code. :-)
411 /* Unless the left argument is integer in range we are going to have to
412 use NV maths. Hence only attempt to coerce the right argument if
413 we know the left is integer. */
421 /* left operand is undef, treat as zero. + 0 is identity,
422 Could SETi or SETu right now, but space optimise by not adding
423 lots of code to speed up what is probably a rarish case. */
425 /* Left operand is defined, so is it IV? */
428 if ((auvok = SvUOK(TOPm1s)))
431 register IV aiv = SvIVX(TOPm1s);
434 auvok = 1; /* Now acting as a sign flag. */
435 } else { /* 2s complement assumption for IV_MIN */
443 bool result_good = 0;
446 bool buvok = SvUOK(TOPs);
451 register IV biv = SvIVX(TOPs);
458 /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
459 else "IV" now, independent of how it came in.
460 if a, b represents positive, A, B negative, a maps to -A etc
465 all UV maths. negate result if A negative.
466 add if signs same, subtract if signs differ. */
472 /* Must get smaller */
478 /* result really should be -(auv-buv). as its negation
479 of true value, need to swap our result flag */
496 if (result <= (UV)IV_MIN)
499 /* result valid, but out of range for IV. */
504 } /* Overflow, drop through to NVs. */
511 /* left operand is undef, treat as zero. + 0.0 is identity. */
515 SETn( value + TOPn );
523 AV *av = GvAV(cGVOP_gv);
524 U32 lval = PL_op->op_flags & OPf_MOD;
525 SV** svp = av_fetch(av, PL_op->op_private, lval);
526 SV *sv = (svp ? *svp : &PL_sv_undef);
528 if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */
529 sv = sv_mortalcopy(sv);
538 do_join(TARG, *MARK, MARK, SP);
549 * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
550 * will be enough to hold an OP*.
552 SV* sv = sv_newmortal();
553 sv_upgrade(sv, SVt_PVLV);
555 Copy(&PL_op, &LvTARGOFF(sv), 1, OP*);
563 /* Oversized hot code. */
567 dSP; dMARK; dORIGMARK;
573 if (PL_op->op_flags & OPf_STACKED)
578 if (gv && (io = GvIO(gv))
579 && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
582 if (MARK == ORIGMARK) {
583 /* If using default handle then we need to make space to
584 * pass object as 1st arg, so move other args up ...
588 Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
592 *MARK = SvTIED_obj((SV*)io, mg);
595 call_method("PRINT", G_SCALAR);
603 if (!(io = GvIO(gv))) {
604 if ((GvEGV(gv)) && (io = GvIO(GvEGV(gv)))
605 && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
607 if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
608 report_evil_fh(gv, io, PL_op->op_type);
609 SETERRNO(EBADF,RMS_IFI);
612 else if (!(fp = IoOFP(io))) {
613 if (ckWARN2(WARN_CLOSED, WARN_IO)) {
615 report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
616 else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
617 report_evil_fh(gv, io, PL_op->op_type);
619 SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI);
624 if (PL_ofs_sv && SvOK(PL_ofs_sv)) {
626 if (!do_print(*MARK, fp))
630 if (!do_print(PL_ofs_sv, fp)) { /* $, */
639 if (!do_print(*MARK, fp))
647 if (PL_ors_sv && SvOK(PL_ors_sv))
648 if (!do_print(PL_ors_sv, fp)) /* $\ */
651 if (IoFLAGS(io) & IOf_FLUSH)
652 if (PerlIO_flush(fp) == EOF)
673 tryAMAGICunDEREF(to_av);
676 if (SvTYPE(av) != SVt_PVAV)
677 DIE(aTHX_ "Not an ARRAY reference");
678 if (PL_op->op_flags & OPf_REF) {
683 if (GIMME == G_SCALAR)
684 Perl_croak(aTHX_ "Can't return array to lvalue scalar context");
688 else if (PL_op->op_flags & OPf_MOD
689 && PL_op->op_private & OPpLVAL_INTRO)
690 Perl_croak(aTHX_ PL_no_localize_ref);
693 if (SvTYPE(sv) == SVt_PVAV) {
695 if (PL_op->op_flags & OPf_REF) {
700 if (GIMME == G_SCALAR)
701 Perl_croak(aTHX_ "Can't return array to lvalue"
710 if (SvTYPE(sv) != SVt_PVGV) {
714 if (SvGMAGICAL(sv)) {
720 if (PL_op->op_flags & OPf_REF ||
721 PL_op->op_private & HINT_STRICT_REFS)
722 DIE(aTHX_ PL_no_usym, "an ARRAY");
723 if (ckWARN(WARN_UNINITIALIZED))
725 if (GIMME == G_ARRAY) {
732 if ((PL_op->op_flags & OPf_SPECIAL) &&
733 !(PL_op->op_flags & OPf_MOD))
735 gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVAV);
737 && (!is_gv_magical(sym,len,0)
738 || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV))))
744 if (PL_op->op_private & HINT_STRICT_REFS)
745 DIE(aTHX_ PL_no_symref, sym, "an ARRAY");
746 gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
753 if (PL_op->op_private & OPpLVAL_INTRO)
755 if (PL_op->op_flags & OPf_REF) {
760 if (GIMME == G_SCALAR)
761 Perl_croak(aTHX_ "Can't return array to lvalue"
769 if (GIMME == G_ARRAY) {
770 I32 maxarg = AvFILL(av) + 1;
771 (void)POPs; /* XXXX May be optimized away? */
773 if (SvRMAGICAL(av)) {
775 for (i=0; i < (U32)maxarg; i++) {
776 SV **svp = av_fetch(av, i, FALSE);
777 SP[i+1] = (svp) ? *svp : &PL_sv_undef;
781 Copy(AvARRAY(av), SP+1, maxarg, SV*);
785 else if (GIMME_V == G_SCALAR) {
787 I32 maxarg = AvFILL(av) + 1;
800 tryAMAGICunDEREF(to_hv);
803 if (SvTYPE(hv) != SVt_PVHV)
804 DIE(aTHX_ "Not a HASH reference");
805 if (PL_op->op_flags & OPf_REF) {
810 if (GIMME == G_SCALAR)
811 Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
815 else if (PL_op->op_flags & OPf_MOD
816 && PL_op->op_private & OPpLVAL_INTRO)
817 Perl_croak(aTHX_ PL_no_localize_ref);
820 if (SvTYPE(sv) == SVt_PVHV) {
822 if (PL_op->op_flags & OPf_REF) {
827 if (GIMME == G_SCALAR)
828 Perl_croak(aTHX_ "Can't return hash to lvalue"
837 if (SvTYPE(sv) != SVt_PVGV) {
841 if (SvGMAGICAL(sv)) {
847 if (PL_op->op_flags & OPf_REF ||
848 PL_op->op_private & HINT_STRICT_REFS)
849 DIE(aTHX_ PL_no_usym, "a HASH");
850 if (ckWARN(WARN_UNINITIALIZED))
852 if (GIMME == G_ARRAY) {
859 if ((PL_op->op_flags & OPf_SPECIAL) &&
860 !(PL_op->op_flags & OPf_MOD))
862 gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PVHV);
864 && (!is_gv_magical(sym,len,0)
865 || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV))))
871 if (PL_op->op_private & HINT_STRICT_REFS)
872 DIE(aTHX_ PL_no_symref, sym, "a HASH");
873 gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
880 if (PL_op->op_private & OPpLVAL_INTRO)
882 if (PL_op->op_flags & OPf_REF) {
887 if (GIMME == G_SCALAR)
888 Perl_croak(aTHX_ "Can't return hash to lvalue"
896 if (GIMME == G_ARRAY) { /* array wanted */
897 *PL_stack_sp = (SV*)hv;
903 Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf,
904 (IV)HvFILL(hv), (IV)HvMAX(hv) + 1);
914 S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
920 if (ckWARN(WARN_MISC)) {
921 if (relem == firstrelem &&
923 (SvTYPE(SvRV(*relem)) == SVt_PVAV ||
924 SvTYPE(SvRV(*relem)) == SVt_PVHV))
926 Perl_warner(aTHX_ packWARN(WARN_MISC),
927 "Reference found where even-sized list expected");
930 Perl_warner(aTHX_ packWARN(WARN_MISC),
931 "Odd number of elements in hash assignment");
934 tmpstr = NEWSV(29,0);
935 didstore = hv_store_ent(hash,*relem,tmpstr,0);
936 if (SvMAGICAL(hash)) {
937 if (SvSMAGICAL(tmpstr))
949 SV **lastlelem = PL_stack_sp;
950 SV **lastrelem = PL_stack_base + POPMARK;
951 SV **firstrelem = PL_stack_base + POPMARK + 1;
952 SV **firstlelem = lastrelem + 1;
965 PL_delaymagic = DM_DELAY; /* catch simultaneous items */
967 /* If there's a common identifier on both sides we have to take
968 * special care that assigning the identifier on the left doesn't
969 * clobber a value on the right that's used later in the list.
971 if (PL_op->op_private & (OPpASSIGN_COMMON)) {
972 EXTEND_MORTAL(lastrelem - firstrelem + 1);
973 for (relem = firstrelem; relem <= lastrelem; relem++) {
976 TAINT_NOT; /* Each item is independent */
977 *relem = sv_mortalcopy(sv);
987 while (lelem <= lastlelem) {
988 TAINT_NOT; /* Each item stands on its own, taintwise. */
990 switch (SvTYPE(sv)) {
993 magic = SvMAGICAL(ary) != 0;
995 av_extend(ary, lastrelem - relem);
997 while (relem <= lastrelem) { /* gobble up all the rest */
1001 sv_setsv(sv,*relem);
1003 didstore = av_store(ary,i++,sv);
1013 case SVt_PVHV: { /* normal hash */
1017 magic = SvMAGICAL(hash) != 0;
1020 while (relem < lastrelem) { /* gobble up all the rest */
1025 sv = &PL_sv_no, relem++;
1026 tmpstr = NEWSV(29,0);
1028 sv_setsv(tmpstr,*relem); /* value */
1029 *(relem++) = tmpstr;
1030 didstore = hv_store_ent(hash,sv,tmpstr,0);
1032 if (SvSMAGICAL(tmpstr))
1039 if (relem == lastrelem) {
1040 do_oddball(hash, relem, firstrelem);
1046 if (SvIMMORTAL(sv)) {
1047 if (relem <= lastrelem)
1051 if (relem <= lastrelem) {
1052 sv_setsv(sv, *relem);
1056 sv_setsv(sv, &PL_sv_undef);
1061 if (PL_delaymagic & ~DM_DELAY) {
1062 if (PL_delaymagic & DM_UID) {
1063 #ifdef HAS_SETRESUID
1064 (void)setresuid(PL_uid,PL_euid,(Uid_t)-1);
1066 # ifdef HAS_SETREUID
1067 (void)setreuid(PL_uid,PL_euid);
1070 if ((PL_delaymagic & DM_UID) == DM_RUID) {
1071 (void)setruid(PL_uid);
1072 PL_delaymagic &= ~DM_RUID;
1074 # endif /* HAS_SETRUID */
1076 if ((PL_delaymagic & DM_UID) == DM_EUID) {
1077 (void)seteuid(PL_uid);
1078 PL_delaymagic &= ~DM_EUID;
1080 # endif /* HAS_SETEUID */
1081 if (PL_delaymagic & DM_UID) {
1082 if (PL_uid != PL_euid)
1083 DIE(aTHX_ "No setreuid available");
1084 (void)PerlProc_setuid(PL_uid);
1086 # endif /* HAS_SETREUID */
1087 #endif /* HAS_SETRESUID */
1088 PL_uid = PerlProc_getuid();
1089 PL_euid = PerlProc_geteuid();
1091 if (PL_delaymagic & DM_GID) {
1092 #ifdef HAS_SETRESGID
1093 (void)setresgid(PL_gid,PL_egid,(Gid_t)-1);
1095 # ifdef HAS_SETREGID
1096 (void)setregid(PL_gid,PL_egid);
1099 if ((PL_delaymagic & DM_GID) == DM_RGID) {
1100 (void)setrgid(PL_gid);
1101 PL_delaymagic &= ~DM_RGID;
1103 # endif /* HAS_SETRGID */
1105 if ((PL_delaymagic & DM_GID) == DM_EGID) {
1106 (void)setegid(PL_gid);
1107 PL_delaymagic &= ~DM_EGID;
1109 # endif /* HAS_SETEGID */
1110 if (PL_delaymagic & DM_GID) {
1111 if (PL_gid != PL_egid)
1112 DIE(aTHX_ "No setregid available");
1113 (void)PerlProc_setgid(PL_gid);
1115 # endif /* HAS_SETREGID */
1116 #endif /* HAS_SETRESGID */
1117 PL_gid = PerlProc_getgid();
1118 PL_egid = PerlProc_getegid();
1120 PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
1125 if (gimme == G_VOID)
1126 SP = firstrelem - 1;
1127 else if (gimme == G_SCALAR) {
1130 SETi(lastrelem - firstrelem + 1);
1136 SP = firstrelem + (lastlelem - firstlelem);
1137 lelem = firstlelem + (relem - firstrelem);
1139 *relem++ = (lelem <= lastlelem) ? *lelem++ : &PL_sv_undef;
1147 register PMOP *pm = cPMOP;
1148 SV *rv = sv_newmortal();
1149 SV *sv = newSVrv(rv, "Regexp");
1150 if (pm->op_pmdynflags & PMdf_TAINTED)
1152 sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
1159 register PMOP *pm = cPMOP;
1165 I32 r_flags = REXEC_CHECKED;
1166 char *truebase; /* Start of string */
1167 register REGEXP *rx = PM_GETRE(pm);
1172 I32 oldsave = PL_savestack_ix;
1173 I32 update_minmatch = 1;
1174 I32 had_zerolen = 0;
1176 if (PL_op->op_flags & OPf_STACKED)
1183 PUTBACK; /* EVAL blocks need stack_sp. */
1184 s = SvPV(TARG, len);
1187 DIE(aTHX_ "panic: pp_match");
1188 rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
1189 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
1192 RX_MATCH_UTF8_set(rx, DO_UTF8(TARG));
1194 /* PMdf_USED is set after a ?? matches once */
1195 if (pm->op_pmdynflags & PMdf_USED) {
1197 if (gimme == G_ARRAY)
1202 /* empty pattern special-cased to use last successful pattern if possible */
1203 if (!rx->prelen && PL_curpm) {
1208 if (rx->minlen > (I32)len)
1213 /* XXXX What part of this is needed with true \G-support? */
1214 if ((global = dynpm->op_pmflags & PMf_GLOBAL)) {
1216 if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
1217 MAGIC* mg = mg_find(TARG, PERL_MAGIC_regex_global);
1218 if (mg && mg->mg_len >= 0) {
1219 if (!(rx->reganch & ROPT_GPOS_SEEN))
1220 rx->endp[0] = rx->startp[0] = mg->mg_len;
1221 else if (rx->reganch & ROPT_ANCH_GPOS) {
1222 r_flags |= REXEC_IGNOREPOS;
1223 rx->endp[0] = rx->startp[0] = mg->mg_len;
1225 minmatch = (mg->mg_flags & MGf_MINMATCH);
1226 update_minmatch = 0;
1230 if ((!global && rx->nparens)
1231 || SvTEMP(TARG) || PL_sawampersand)
1232 r_flags |= REXEC_COPY_STR;
1234 r_flags |= REXEC_SCREAM;
1236 if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
1237 SAVEINT(PL_multiline);
1238 PL_multiline = pm->op_pmflags & PMf_MULTILINE;
1242 if (global && rx->startp[0] != -1) {
1243 t = s = rx->endp[0] + truebase;
1244 if ((s + rx->minlen) > strend)
1246 if (update_minmatch++)
1247 minmatch = had_zerolen;
1249 if (rx->reganch & RE_USE_INTUIT &&
1250 DO_UTF8(TARG) == ((rx->reganch & ROPT_UTF8) != 0)) {
1251 PL_bostr = truebase;
1252 s = CALLREG_INTUIT_START(aTHX_ rx, TARG, s, strend, r_flags, NULL);
1256 if ( (rx->reganch & ROPT_CHECK_ALL)
1258 && ((rx->reganch & ROPT_NOSCAN)
1259 || !((rx->reganch & RE_INTUIT_TAIL)
1260 && (r_flags & REXEC_SCREAM)))
1261 && !SvROK(TARG)) /* Cannot trust since INTUIT cannot guess ^ */
1264 if (CALLREGEXEC(aTHX_ rx, s, strend, truebase, minmatch, TARG, NULL, r_flags))
1267 if (dynpm->op_pmflags & PMf_ONCE)
1268 dynpm->op_pmdynflags |= PMdf_USED;
1277 RX_MATCH_TAINTED_on(rx);
1278 TAINT_IF(RX_MATCH_TAINTED(rx));
1279 if (gimme == G_ARRAY) {
1280 I32 nparens, i, len;
1282 nparens = rx->nparens;
1283 if (global && !nparens)
1287 SPAGAIN; /* EVAL blocks could move the stack. */
1288 EXTEND(SP, nparens + i);
1289 EXTEND_MORTAL(nparens + i);
1290 for (i = !i; i <= nparens; i++) {
1291 PUSHs(sv_newmortal());
1293 if ((rx->startp[i] != -1) && rx->endp[i] != -1 ) {
1294 len = rx->endp[i] - rx->startp[i];
1295 if (rx->endp[i] < 0 || rx->startp[i] < 0 ||
1296 len < 0 || len > strend - s)
1297 DIE(aTHX_ "panic: pp_match start/end pointers");
1298 s = rx->startp[i] + truebase;
1299 sv_setpvn(*SP, s, len);
1300 if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
1305 if (dynpm->op_pmflags & PMf_CONTINUE) {
1307 if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
1308 mg = mg_find(TARG, PERL_MAGIC_regex_global);
1310 sv_magic(TARG, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0);
1311 mg = mg_find(TARG, PERL_MAGIC_regex_global);
1313 if (rx->startp[0] != -1) {
1314 mg->mg_len = rx->endp[0];
1315 if (rx->startp[0] == rx->endp[0])
1316 mg->mg_flags |= MGf_MINMATCH;
1318 mg->mg_flags &= ~MGf_MINMATCH;
1321 had_zerolen = (rx->startp[0] != -1
1322 && rx->startp[0] == rx->endp[0]);
1323 PUTBACK; /* EVAL blocks may use stack */
1324 r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
1329 LEAVE_SCOPE(oldsave);
1335 if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
1336 mg = mg_find(TARG, PERL_MAGIC_regex_global);
1338 sv_magic(TARG, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0);
1339 mg = mg_find(TARG, PERL_MAGIC_regex_global);
1341 if (rx->startp[0] != -1) {
1342 mg->mg_len = rx->endp[0];
1343 if (rx->startp[0] == rx->endp[0])
1344 mg->mg_flags |= MGf_MINMATCH;
1346 mg->mg_flags &= ~MGf_MINMATCH;
1349 LEAVE_SCOPE(oldsave);
1353 yup: /* Confirmed by INTUIT */
1355 RX_MATCH_TAINTED_on(rx);
1356 TAINT_IF(RX_MATCH_TAINTED(rx));
1358 if (dynpm->op_pmflags & PMf_ONCE)
1359 dynpm->op_pmdynflags |= PMdf_USED;
1360 if (RX_MATCH_COPIED(rx))
1361 Safefree(rx->subbeg);
1362 RX_MATCH_COPIED_off(rx);
1363 rx->subbeg = Nullch;
1365 rx->subbeg = truebase;
1366 rx->startp[0] = s - truebase;
1367 if (RX_MATCH_UTF8(rx)) {
1368 char *t = (char*)utf8_hop((U8*)s, rx->minlen);
1369 rx->endp[0] = t - truebase;
1372 rx->endp[0] = s - truebase + rx->minlen;
1374 rx->sublen = strend - truebase;
1377 if (PL_sawampersand) {
1379 #ifdef PERL_COPY_ON_WRITE
1380 if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) {
1382 PerlIO_printf(Perl_debug_log,
1383 "Copy on write: pp_match $& capture, type %d, truebase=%p, t=%p, difference %d\n",
1384 (int) SvTYPE(TARG), truebase, t,
1387 rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
1388 rx->subbeg = SvPVX(rx->saved_copy) + (t - truebase);
1389 assert (SvPOKp(rx->saved_copy));
1394 rx->subbeg = savepvn(t, strend - t);
1395 #ifdef PERL_COPY_ON_WRITE
1396 rx->saved_copy = Nullsv;
1399 rx->sublen = strend - t;
1400 RX_MATCH_COPIED_on(rx);
1401 off = rx->startp[0] = s - t;
1402 rx->endp[0] = off + rx->minlen;
1404 else { /* startp/endp are used by @- @+. */
1405 rx->startp[0] = s - truebase;
1406 rx->endp[0] = s - truebase + rx->minlen;
1408 rx->nparens = rx->lastparen = 0; /* used by @- and @+ */
1409 LEAVE_SCOPE(oldsave);
1414 if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) {
1415 if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
1416 MAGIC* mg = mg_find(TARG, PERL_MAGIC_regex_global);
1421 LEAVE_SCOPE(oldsave);
1422 if (gimme == G_ARRAY)
1428 Perl_do_readline(pTHX)
1430 dSP; dTARGETSTACKED;
1435 register IO *io = GvIO(PL_last_in_gv);
1436 register I32 type = PL_op->op_type;
1437 I32 gimme = GIMME_V;
1440 if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
1442 XPUSHs(SvTIED_obj((SV*)io, mg));
1445 call_method("READLINE", gimme);
1448 if (gimme == G_SCALAR) {
1450 SvSetSV_nosteal(TARG, result);
1459 if (IoFLAGS(io) & IOf_ARGV) {
1460 if (IoFLAGS(io) & IOf_START) {
1462 if (av_len(GvAVn(PL_last_in_gv)) < 0) {
1463 IoFLAGS(io) &= ~IOf_START;
1464 do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp);
1465 sv_setpvn(GvSV(PL_last_in_gv), "-", 1);
1466 SvSETMAGIC(GvSV(PL_last_in_gv));
1471 fp = nextargv(PL_last_in_gv);
1472 if (!fp) { /* Note: fp != IoIFP(io) */
1473 (void)do_close(PL_last_in_gv, FALSE); /* now it does*/
1476 else if (type == OP_GLOB)
1477 fp = Perl_start_glob(aTHX_ POPs, io);
1479 else if (type == OP_GLOB)
1481 else if (ckWARN(WARN_IO) && IoTYPE(io) == IoTYPE_WRONLY) {
1482 report_evil_fh(PL_last_in_gv, io, OP_phoney_OUTPUT_ONLY);
1486 if (ckWARN2(WARN_GLOB, WARN_CLOSED)
1487 && (!io || !(IoFLAGS(io) & IOf_START))) {
1488 if (type == OP_GLOB)
1489 Perl_warner(aTHX_ packWARN(WARN_GLOB),
1490 "glob failed (can't start child: %s)",
1493 report_evil_fh(PL_last_in_gv, io, PL_op->op_type);
1495 if (gimme == G_SCALAR) {
1496 /* undef TARG, and push that undefined value */
1497 if (type != OP_RCATLINE) {
1498 SV_CHECK_THINKFIRST_COW_DROP(TARG);
1506 if (gimme == G_SCALAR) {
1510 (void)SvUPGRADE(sv, SVt_PV);
1511 tmplen = SvLEN(sv); /* remember if already alloced */
1512 if (!tmplen && !SvREADONLY(sv))
1513 Sv_Grow(sv, 80); /* try short-buffering it */
1515 if (type == OP_RCATLINE && SvOK(sv)) {
1518 (void)SvPV_force(sv, n_a);
1524 sv = sv_2mortal(NEWSV(57, 80));
1528 /* This should not be marked tainted if the fp is marked clean */
1529 #define MAYBE_TAINT_LINE(io, sv) \
1530 if (!(IoFLAGS(io) & IOf_UNTAINT)) { \
1535 /* delay EOF state for a snarfed empty file */
1536 #define SNARF_EOF(gimme,rs,io,sv) \
1537 (gimme != G_SCALAR || SvCUR(sv) \
1538 || (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs))
1542 if (!sv_gets(sv, fp, offset)
1543 && (type == OP_GLOB || SNARF_EOF(gimme, PL_rs, io, sv)))
1545 PerlIO_clearerr(fp);
1546 if (IoFLAGS(io) & IOf_ARGV) {
1547 fp = nextargv(PL_last_in_gv);
1550 (void)do_close(PL_last_in_gv, FALSE);
1552 else if (type == OP_GLOB) {
1553 if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_GLOB)) {
1554 Perl_warner(aTHX_ packWARN(WARN_GLOB),
1555 "glob failed (child exited with status %d%s)",
1556 (int)(STATUS_CURRENT >> 8),
1557 (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
1560 if (gimme == G_SCALAR) {
1561 if (type != OP_RCATLINE) {
1562 SV_CHECK_THINKFIRST_COW_DROP(TARG);
1568 MAYBE_TAINT_LINE(io, sv);
1571 MAYBE_TAINT_LINE(io, sv);
1573 IoFLAGS(io) |= IOf_NOLINE;
1577 if (type == OP_GLOB) {
1580 if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
1581 tmps = SvEND(sv) - 1;
1582 if (*tmps == *SvPVX(PL_rs)) {
1587 for (tmps = SvPVX(sv); *tmps; tmps++)
1588 if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
1589 strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
1591 if (*tmps && PerlLIO_lstat(SvPVX(sv), &PL_statbuf) < 0) {
1592 (void)POPs; /* Unmatched wildcard? Chuck it... */
1596 if (gimme == G_ARRAY) {
1597 if (SvLEN(sv) - SvCUR(sv) > 20) {
1598 SvLEN_set(sv, SvCUR(sv)+1);
1599 Renew(SvPVX(sv), SvLEN(sv), char);
1601 sv = sv_2mortal(NEWSV(58, 80));
1604 else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
1605 /* try to reclaim a bit of scalar space (only on 1st alloc) */
1609 SvLEN_set(sv, SvCUR(sv)+40); /* allow some slop */
1610 Renew(SvPVX(sv), SvLEN(sv), char);
1619 register PERL_CONTEXT *cx;
1620 I32 gimme = OP_GIMME(PL_op, -1);
1623 if (cxstack_ix >= 0)
1624 gimme = cxstack[cxstack_ix].blk_gimme;
1632 PUSHBLOCK(cx, CXt_BLOCK, SP);
1644 U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
1645 U32 defer = PL_op->op_private & OPpLVAL_DEFER;
1647 #ifdef PERL_COPY_ON_WRITE
1648 U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvUVX(keysv) : 0;
1650 U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0;
1654 if (SvTYPE(hv) == SVt_PVHV) {
1655 if (PL_op->op_private & OPpLVAL_INTRO) {
1658 /* does the element we're localizing already exist? */
1660 /* can we determine whether it exists? */
1662 || mg_find((SV*)hv, PERL_MAGIC_env)
1663 || ( (mg = mg_find((SV*)hv, PERL_MAGIC_tied))
1664 /* Try to preserve the existenceness of a tied hash
1665 * element by using EXISTS and DELETE if possible.
1666 * Fallback to FETCH and STORE otherwise */
1667 && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg))))
1668 && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
1669 && gv_fetchmethod_autoload(stash, "DELETE", TRUE)
1671 ) ? hv_exists_ent(hv, keysv, 0) : 1;
1674 he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
1675 svp = he ? &HeVAL(he) : 0;
1681 if (!svp || *svp == &PL_sv_undef) {
1686 DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
1688 lv = sv_newmortal();
1689 sv_upgrade(lv, SVt_PVLV);
1691 sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, Nullch, 0);
1692 SvREFCNT_dec(key2); /* sv_magic() increments refcount */
1693 LvTARG(lv) = SvREFCNT_inc(hv);
1698 if (PL_op->op_private & OPpLVAL_INTRO) {
1699 if (HvNAME(hv) && isGV(*svp))
1700 save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
1704 char *key = SvPV(keysv, keylen);
1705 SAVEDELETE(hv, savepvn(key,keylen), keylen);
1707 save_helem(hv, keysv, svp);
1710 else if (PL_op->op_private & OPpDEREF)
1711 vivify_ref(*svp, PL_op->op_private & OPpDEREF);
1713 sv = (svp ? *svp : &PL_sv_undef);
1714 /* This makes C<local $tied{foo} = $tied{foo}> possible.
1715 * Pushing the magical RHS on to the stack is useless, since
1716 * that magic is soon destined to be misled by the local(),
1717 * and thus the later pp_sassign() will fail to mg_get() the
1718 * old value. This should also cure problems with delayed
1719 * mg_get()s. GSAR 98-07-03 */
1720 if (!lval && SvGMAGICAL(sv))
1721 sv = sv_mortalcopy(sv);
1729 register PERL_CONTEXT *cx;
1735 if (PL_op->op_flags & OPf_SPECIAL) {
1736 cx = &cxstack[cxstack_ix];
1737 cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */
1742 gimme = OP_GIMME(PL_op, -1);
1744 if (cxstack_ix >= 0)
1745 gimme = cxstack[cxstack_ix].blk_gimme;
1751 if (gimme == G_VOID)
1753 else if (gimme == G_SCALAR) {
1756 if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
1759 *MARK = sv_mortalcopy(TOPs);
1762 *MARK = &PL_sv_undef;
1766 else if (gimme == G_ARRAY) {
1767 /* in case LEAVE wipes old return values */
1768 for (mark = newsp + 1; mark <= SP; mark++) {
1769 if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
1770 *mark = sv_mortalcopy(*mark);
1771 TAINT_NOT; /* Each item is independent */
1775 PL_curpm = newpm; /* Don't pop $1 et al till now */
1785 register PERL_CONTEXT *cx;
1791 cx = &cxstack[cxstack_ix];
1792 if (CxTYPE(cx) != CXt_LOOP)
1793 DIE(aTHX_ "panic: pp_iter");
1795 itersvp = CxITERVAR(cx);
1796 av = cx->blk_loop.iterary;
1797 if (SvTYPE(av) != SVt_PVAV) {
1798 /* iterate ($min .. $max) */
1799 if (cx->blk_loop.iterlval) {
1800 /* string increment */
1801 register SV* cur = cx->blk_loop.iterlval;
1803 char *max = SvPV((SV*)av, maxlen);
1804 if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
1805 if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
1806 /* safe to reuse old SV */
1807 sv_setsv(*itersvp, cur);
1811 /* we need a fresh SV every time so that loop body sees a
1812 * completely new SV for closures/references to work as
1814 SvREFCNT_dec(*itersvp);
1815 *itersvp = newSVsv(cur);
1817 if (strEQ(SvPVX(cur), max))
1818 sv_setiv(cur, 0); /* terminate next time */
1825 /* integer increment */
1826 if (cx->blk_loop.iterix > cx->blk_loop.itermax)
1829 /* don't risk potential race */
1830 if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
1831 /* safe to reuse old SV */
1832 sv_setiv(*itersvp, cx->blk_loop.iterix++);
1836 /* we need a fresh SV every time so that loop body sees a
1837 * completely new SV for closures/references to work as they
1839 SvREFCNT_dec(*itersvp);
1840 *itersvp = newSViv(cx->blk_loop.iterix++);
1846 if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av)))
1849 SvREFCNT_dec(*itersvp);
1851 if (SvMAGICAL(av) || AvREIFY(av)) {
1852 SV **svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
1859 sv = AvARRAY(av)[++cx->blk_loop.iterix];
1865 if (av != PL_curstack && sv == &PL_sv_undef) {
1866 SV *lv = cx->blk_loop.iterlval;
1867 if (lv && SvREFCNT(lv) > 1) {
1872 SvREFCNT_dec(LvTARG(lv));
1874 lv = cx->blk_loop.iterlval = NEWSV(26, 0);
1875 sv_upgrade(lv, SVt_PVLV);
1877 sv_magic(lv, Nullsv, PERL_MAGIC_defelem, Nullch, 0);
1879 LvTARG(lv) = SvREFCNT_inc(av);
1880 LvTARGOFF(lv) = cx->blk_loop.iterix;
1881 LvTARGLEN(lv) = (STRLEN)UV_MAX;
1885 *itersvp = SvREFCNT_inc(sv);
1892 register PMOP *pm = cPMOP;
1908 register REGEXP *rx = PM_GETRE(pm);
1910 int force_on_match = 0;
1911 I32 oldsave = PL_savestack_ix;
1913 bool doutf8 = FALSE;
1914 #ifdef PERL_COPY_ON_WRITE
1919 /* known replacement string? */
1920 dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
1921 if (PL_op->op_flags & OPf_STACKED)
1928 #ifdef PERL_COPY_ON_WRITE
1929 /* Awooga. Awooga. "bool" types that are actually char are dangerous,
1930 because they make integers such as 256 "false". */
1931 is_cow = SvIsCOW(TARG) ? TRUE : FALSE;
1934 sv_force_normal_flags(TARG,0);
1937 #ifdef PERL_COPY_ON_WRITE
1941 || (SvTYPE(TARG) > SVt_PVLV
1942 && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
1943 DIE(aTHX_ PL_no_modify);
1946 s = SvPV(TARG, len);
1947 if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
1949 rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
1950 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
1955 RX_MATCH_UTF8_set(rx, DO_UTF8(TARG));
1959 DIE(aTHX_ "panic: pp_subst");
1962 slen = RX_MATCH_UTF8(rx) ? utf8_length((U8*)s, (U8*)strend) : len;
1963 maxiters = 2 * slen + 10; /* We can match twice at each
1964 position, once with zero-length,
1965 second time with non-zero. */
1967 if (!rx->prelen && PL_curpm) {
1971 r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand)
1972 ? REXEC_COPY_STR : 0;
1974 r_flags |= REXEC_SCREAM;
1975 if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
1976 SAVEINT(PL_multiline);
1977 PL_multiline = pm->op_pmflags & PMf_MULTILINE;
1980 if (rx->reganch & RE_USE_INTUIT) {
1982 s = CALLREG_INTUIT_START(aTHX_ rx, TARG, s, strend, r_flags, NULL);
1986 /* How to do it in subst? */
1987 /* if ( (rx->reganch & ROPT_CHECK_ALL)
1989 && ((rx->reganch & ROPT_NOSCAN)
1990 || !((rx->reganch & RE_INTUIT_TAIL)
1991 && (r_flags & REXEC_SCREAM))))
1996 /* only replace once? */
1997 once = !(rpm->op_pmflags & PMf_GLOBAL);
1999 /* known replacement string? */
2001 /* replacement needing upgrading? */
2002 if (DO_UTF8(TARG) && !doutf8) {
2003 nsv = sv_newmortal();
2006 sv_recode_to_utf8(nsv, PL_encoding);
2008 sv_utf8_upgrade(nsv);
2009 c = SvPV(nsv, clen);
2013 c = SvPV(dstr, clen);
2014 doutf8 = DO_UTF8(dstr);
2022 /* can do inplace substitution? */
2024 #ifdef PERL_COPY_ON_WRITE
2027 && (I32)clen <= rx->minlen && (once || !(r_flags & REXEC_COPY_STR))
2028 && !(rx->reganch & ROPT_LOOKBEHIND_SEEN)
2029 && (!doutf8 || SvUTF8(TARG))) {
2030 if (!CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL,
2031 r_flags | REXEC_CHECKED))
2035 LEAVE_SCOPE(oldsave);
2038 #ifdef PERL_COPY_ON_WRITE
2039 if (SvIsCOW(TARG)) {
2040 assert (!force_on_match);
2044 if (force_on_match) {
2046 s = SvPV_force(TARG, len);
2051 SvSCREAM_off(TARG); /* disable possible screamer */
2053 rxtainted |= RX_MATCH_TAINTED(rx);
2054 m = orig + rx->startp[0];
2055 d = orig + rx->endp[0];
2057 if (m - s > strend - d) { /* faster to shorten from end */
2059 Copy(c, m, clen, char);
2064 Move(d, m, i, char);
2068 SvCUR_set(TARG, m - s);
2071 else if ((i = m - s)) { /* faster from front */
2079 Copy(c, m, clen, char);
2084 Copy(c, d, clen, char);
2089 TAINT_IF(rxtainted & 1);
2095 if (iters++ > maxiters)
2096 DIE(aTHX_ "Substitution loop");
2097 rxtainted |= RX_MATCH_TAINTED(rx);
2098 m = rx->startp[0] + orig;
2102 Move(s, d, i, char);
2106 Copy(c, d, clen, char);
2109 s = rx->endp[0] + orig;
2110 } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m,
2112 /* don't match same null twice */
2113 REXEC_NOT_FIRST|REXEC_IGNOREPOS));
2116 SvCUR_set(TARG, d - SvPVX(TARG) + i);
2117 Move(s, d, i+1, char); /* include the NUL */
2119 TAINT_IF(rxtainted & 1);
2121 PUSHs(sv_2mortal(newSViv((I32)iters)));
2123 (void)SvPOK_only_UTF8(TARG);
2124 TAINT_IF(rxtainted);
2125 if (SvSMAGICAL(TARG)) {
2133 LEAVE_SCOPE(oldsave);
2137 if (CALLREGEXEC(aTHX_ rx, s, strend, orig, 0, TARG, NULL,
2138 r_flags | REXEC_CHECKED))
2140 if (force_on_match) {
2142 s = SvPV_force(TARG, len);
2145 #ifdef PERL_COPY_ON_WRITE
2148 rxtainted |= RX_MATCH_TAINTED(rx);
2149 dstr = NEWSV(25, len);
2150 sv_setpvn(dstr, m, s-m);
2155 register PERL_CONTEXT *cx;
2158 RETURNOP(cPMOP->op_pmreplroot);
2160 r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
2162 if (iters++ > maxiters)
2163 DIE(aTHX_ "Substitution loop");
2164 rxtainted |= RX_MATCH_TAINTED(rx);
2165 if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
2170 strend = s + (strend - m);
2172 m = rx->startp[0] + orig;
2173 if (doutf8 && !SvUTF8(dstr))
2174 sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
2176 sv_catpvn(dstr, s, m-s);
2177 s = rx->endp[0] + orig;
2179 sv_catpvn(dstr, c, clen);
2182 } while (CALLREGEXEC(aTHX_ rx, s, strend, orig, s == m,
2183 TARG, NULL, r_flags));
2184 if (doutf8 && !DO_UTF8(TARG))
2185 sv_catpvn_utf8_upgrade(dstr, s, strend - s, nsv);
2187 sv_catpvn(dstr, s, strend - s);
2189 #ifdef PERL_COPY_ON_WRITE
2190 /* The match may make the string COW. If so, brilliant, because that's
2191 just saved us one malloc, copy and free - the regexp has donated
2192 the old buffer, and we malloc an entirely new one, rather than the
2193 regexp malloc()ing a buffer and copying our original, only for
2194 us to throw it away here during the substitution. */
2195 if (SvIsCOW(TARG)) {
2196 sv_force_normal_flags(TARG, SV_COW_DROP_PV);
2200 (void)SvOOK_off(TARG);
2202 Safefree(SvPVX(TARG));
2204 SvPVX(TARG) = SvPVX(dstr);
2205 SvCUR_set(TARG, SvCUR(dstr));
2206 SvLEN_set(TARG, SvLEN(dstr));
2207 doutf8 |= DO_UTF8(dstr);
2211 TAINT_IF(rxtainted & 1);
2213 PUSHs(sv_2mortal(newSViv((I32)iters)));
2215 (void)SvPOK_only(TARG);
2218 TAINT_IF(rxtainted);
2221 LEAVE_SCOPE(oldsave);
2230 LEAVE_SCOPE(oldsave);
2239 PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
2240 ++*PL_markstack_ptr;
2241 LEAVE; /* exit inner scope */
2244 if (PL_stack_base + *PL_markstack_ptr > SP) {
2246 I32 gimme = GIMME_V;
2248 LEAVE; /* exit outer scope */
2249 (void)POPMARK; /* pop src */
2250 items = --*PL_markstack_ptr - PL_markstack_ptr[-1];
2251 (void)POPMARK; /* pop dst */
2252 SP = PL_stack_base + POPMARK; /* pop original mark */
2253 if (gimme == G_SCALAR) {
2257 else if (gimme == G_ARRAY)
2264 ENTER; /* enter inner scope */
2267 src = PL_stack_base[*PL_markstack_ptr];
2271 RETURNOP(cLOGOP->op_other);
2282 register PERL_CONTEXT *cx;
2288 if (gimme == G_SCALAR) {
2291 if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
2293 *MARK = SvREFCNT_inc(TOPs);
2298 sv = SvREFCNT_inc(TOPs); /* FREETMPS could clobber it */
2300 *MARK = sv_mortalcopy(sv);
2305 *MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
2309 *MARK = &PL_sv_undef;
2313 else if (gimme == G_ARRAY) {
2314 for (MARK = newsp + 1; MARK <= SP; MARK++) {
2315 if (!SvTEMP(*MARK)) {
2316 *MARK = sv_mortalcopy(*MARK);
2317 TAINT_NOT; /* Each item is independent */
2324 POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
2325 PL_curpm = newpm; /* ... and pop $1 et al */
2328 return pop_return();
2331 /* This duplicates the above code because the above code must not
2332 * get any slower by more conditions */
2340 register PERL_CONTEXT *cx;
2347 if (cx->blk_sub.lval & OPpENTERSUB_INARGS) {
2348 /* We are an argument to a function or grep().
2349 * This kind of lvalueness was legal before lvalue
2350 * subroutines too, so be backward compatible:
2351 * cannot report errors. */
2353 /* Scalar context *is* possible, on the LHS of -> only,
2354 * as in f()->meth(). But this is not an lvalue. */
2355 if (gimme == G_SCALAR)
2357 if (gimme == G_ARRAY) {
2358 if (!CvLVALUE(cx->blk_sub.cv))
2359 goto temporise_array;
2360 EXTEND_MORTAL(SP - newsp);
2361 for (mark = newsp + 1; mark <= SP; mark++) {
2364 else if (SvFLAGS(*mark) & (SVs_PADTMP | SVf_READONLY))
2365 *mark = sv_mortalcopy(*mark);
2367 /* Can be a localized value subject to deletion. */
2368 PL_tmps_stack[++PL_tmps_ix] = *mark;
2369 (void)SvREFCNT_inc(*mark);
2374 else if (cx->blk_sub.lval) { /* Leave it as it is if we can. */
2375 /* Here we go for robustness, not for speed, so we change all
2376 * the refcounts so the caller gets a live guy. Cannot set
2377 * TEMP, so sv_2mortal is out of question. */
2378 if (!CvLVALUE(cx->blk_sub.cv)) {
2383 DIE(aTHX_ "Can't modify non-lvalue subroutine call");
2385 if (gimme == G_SCALAR) {
2389 if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
2394 DIE(aTHX_ "Can't return %s from lvalue subroutine",
2395 SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
2396 : "a readonly value" : "a temporary");
2398 else { /* Can be a localized value
2399 * subject to deletion. */
2400 PL_tmps_stack[++PL_tmps_ix] = *mark;
2401 (void)SvREFCNT_inc(*mark);
2404 else { /* Should not happen? */
2409 DIE(aTHX_ "%s returned from lvalue subroutine in scalar context",
2410 (MARK > SP ? "Empty array" : "Array"));
2414 else if (gimme == G_ARRAY) {
2415 EXTEND_MORTAL(SP - newsp);
2416 for (mark = newsp + 1; mark <= SP; mark++) {
2417 if (*mark != &PL_sv_undef
2418 && SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
2419 /* Might be flattened array after $#array = */
2425 DIE(aTHX_ "Can't return a %s from lvalue subroutine",
2426 SvREADONLY(TOPs) ? "readonly value" : "temporary");
2429 /* Can be a localized value subject to deletion. */
2430 PL_tmps_stack[++PL_tmps_ix] = *mark;
2431 (void)SvREFCNT_inc(*mark);
2437 if (gimme == G_SCALAR) {
2441 if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
2443 *MARK = SvREFCNT_inc(TOPs);
2448 sv = SvREFCNT_inc(TOPs); /* FREETMPS could clobber it */
2450 *MARK = sv_mortalcopy(sv);
2455 *MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
2459 *MARK = &PL_sv_undef;
2463 else if (gimme == G_ARRAY) {
2465 for (MARK = newsp + 1; MARK <= SP; MARK++) {
2466 if (!SvTEMP(*MARK)) {
2467 *MARK = sv_mortalcopy(*MARK);
2468 TAINT_NOT; /* Each item is independent */
2476 POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
2477 PL_curpm = newpm; /* ... and pop $1 et al */
2480 return pop_return();
2485 S_get_db_sub(pTHX_ SV **svp, CV *cv)
2487 SV *dbsv = GvSV(PL_DBsub);
2489 if (!PERLDB_SUB_NN) {
2493 if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
2494 || strEQ(GvNAME(gv), "END")
2495 || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
2496 !( (SvTYPE(*svp) == SVt_PVGV) && (GvCV((GV*)*svp) == cv)
2497 && (gv = (GV*)*svp) ))) {
2498 /* Use GV from the stack as a fallback. */
2499 /* GV is potentially non-unique, or contain different CV. */
2500 SV *tmp = newRV((SV*)cv);
2501 sv_setsv(dbsv, tmp);
2505 gv_efullname3(dbsv, gv, Nullch);
2509 (void)SvUPGRADE(dbsv, SVt_PVIV);
2510 (void)SvIOK_on(dbsv);
2511 SAVEIV(SvIVX(dbsv));
2512 SvIVX(dbsv) = PTR2IV(cv); /* Do it the quickest way */
2516 PL_curcopdb = PL_curcop;
2517 cv = GvCV(PL_DBsub);
2527 register PERL_CONTEXT *cx;
2529 bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
2532 DIE(aTHX_ "Not a CODE reference");
2533 switch (SvTYPE(sv)) {
2534 /* This is overwhelming the most common case: */
2536 if (!(cv = GvCVu((GV*)sv)))
2537 cv = sv_2cv(sv, &stash, &gv, FALSE);
2549 if (sv == &PL_sv_yes) { /* unfound import, ignore */
2551 SP = PL_stack_base + POPMARK;
2554 if (SvGMAGICAL(sv)) {
2558 sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
2561 sym = SvPV(sv, n_a);
2563 DIE(aTHX_ PL_no_usym, "a subroutine");
2564 if (PL_op->op_private & HINT_STRICT_REFS)
2565 DIE(aTHX_ PL_no_symref, sym, "a subroutine");
2566 cv = get_cv(sym, TRUE);
2571 SV **sp = &sv; /* Used in tryAMAGICunDEREF macro. */
2572 tryAMAGICunDEREF(to_cv);
2575 if (SvTYPE(cv) == SVt_PVCV)
2580 DIE(aTHX_ "Not a CODE reference");
2581 /* This is the second most common case: */
2591 if (!CvROOT(cv) && !CvXSUB(cv)) {
2596 if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
2597 if (CvASSERTION(cv) && PL_DBassertion)
2598 sv_setiv(PL_DBassertion, 1);
2600 cv = get_db_sub(&sv, cv);
2602 DIE(aTHX_ "No DBsub routine");
2605 if (!(CvXSUB(cv))) {
2606 /* This path taken at least 75% of the time */
2608 register I32 items = SP - MARK;
2609 AV* padlist = CvPADLIST(cv);
2610 push_return(PL_op->op_next);
2611 PUSHBLOCK(cx, CXt_SUB, MARK);
2614 /* XXX This would be a natural place to set C<PL_compcv = cv> so
2615 * that eval'' ops within this sub know the correct lexical space.
2616 * Owing the speed considerations, we choose instead to search for
2617 * the cv using find_runcv() when calling doeval().
2619 if (CvDEPTH(cv) < 2)
2620 (void)SvREFCNT_inc(cv);
2622 PERL_STACK_OVERFLOW_CHECK();
2623 pad_push(padlist, CvDEPTH(cv), 1);
2625 PAD_SET_CUR(padlist, CvDEPTH(cv));
2632 DEBUG_S(PerlIO_printf(Perl_debug_log,
2633 "%p entersub preparing @_\n", thr));
2635 av = (AV*)PAD_SVl(0);
2637 /* @_ is normally not REAL--this should only ever
2638 * happen when DB::sub() calls things that modify @_ */
2643 cx->blk_sub.savearray = GvAV(PL_defgv);
2644 GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
2645 CX_CURPAD_SAVE(cx->blk_sub);
2646 cx->blk_sub.argarray = av;
2649 if (items > AvMAX(av) + 1) {
2651 if (AvARRAY(av) != ary) {
2652 AvMAX(av) += AvARRAY(av) - AvALLOC(av);
2653 SvPVX(av) = (char*)ary;
2655 if (items > AvMAX(av) + 1) {
2656 AvMAX(av) = items - 1;
2657 Renew(ary,items,SV*);
2659 SvPVX(av) = (char*)ary;
2662 Copy(MARK,AvARRAY(av),items,SV*);
2663 AvFILLp(av) = items - 1;
2671 /* warning must come *after* we fully set up the context
2672 * stuff so that __WARN__ handlers can safely dounwind()
2675 if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)
2676 && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
2677 sub_crush_depth(cv);
2679 DEBUG_S(PerlIO_printf(Perl_debug_log,
2680 "%p entersub returning %p\n", thr, CvSTART(cv)));
2682 RETURNOP(CvSTART(cv));
2685 #ifdef PERL_XSUB_OLDSTYLE
2686 if (CvOLDSTYLE(cv)) {
2687 I32 (*fp3)(int,int,int);
2689 register I32 items = SP - MARK;
2690 /* We dont worry to copy from @_. */
2695 PL_stack_sp = mark + 1;
2696 fp3 = (I32(*)(int,int,int))CvXSUB(cv);
2697 items = (*fp3)(CvXSUBANY(cv).any_i32,
2698 MARK - PL_stack_base + 1,
2700 PL_stack_sp = PL_stack_base + items;
2703 #endif /* PERL_XSUB_OLDSTYLE */
2705 I32 markix = TOPMARK;
2710 /* Need to copy @_ to stack. Alternative may be to
2711 * switch stack to @_, and copy return values
2712 * back. This would allow popping @_ in XSUB, e.g.. XXXX */
2715 av = GvAV(PL_defgv);
2716 items = AvFILLp(av) + 1; /* @_ is not tieable */
2719 /* Mark is at the end of the stack. */
2721 Copy(AvARRAY(av), SP + 1, items, SV*);
2726 /* We assume first XSUB in &DB::sub is the called one. */
2728 SAVEVPTR(PL_curcop);
2729 PL_curcop = PL_curcopdb;
2732 /* Do we need to open block here? XXXX */
2733 (void)(*CvXSUB(cv))(aTHX_ cv);
2735 /* Enforce some sanity in scalar context. */
2736 if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) {
2737 if (markix > PL_stack_sp - PL_stack_base)
2738 *(PL_stack_base + markix) = &PL_sv_undef;
2740 *(PL_stack_base + markix) = *PL_stack_sp;
2741 PL_stack_sp = PL_stack_base + markix;
2748 assert (0); /* Cannot get here. */
2749 /* This is deliberately moved here as spaghetti code to keep it out of the
2756 /* anonymous or undef'd function leaves us no recourse */
2757 if (CvANON(cv) || !(gv = CvGV(cv)))
2758 DIE(aTHX_ "Undefined subroutine called");
2760 /* autoloaded stub? */
2761 if (cv != GvCV(gv)) {
2764 /* should call AUTOLOAD now? */
2767 if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
2774 sub_name = sv_newmortal();
2775 gv_efullname3(sub_name, gv, Nullch);
2776 DIE(aTHX_ "Undefined subroutine &%"SVf" called", sub_name);
2780 DIE(aTHX_ "Not a CODE reference");
2786 Perl_sub_crush_depth(pTHX_ CV *cv)
2789 Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine");
2791 SV* tmpstr = sv_newmortal();
2792 gv_efullname3(tmpstr, CvGV(cv), Nullch);
2793 Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
2803 IV elem = SvIV(elemsv);
2805 U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
2806 U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
2809 if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
2810 Perl_warner(aTHX_ packWARN(WARN_MISC), "Use of reference \"%"SVf"\" as array index", elemsv);
2812 elem -= PL_curcop->cop_arybase;
2813 if (SvTYPE(av) != SVt_PVAV)
2815 svp = av_fetch(av, elem, lval && !defer);
2817 if (!svp || *svp == &PL_sv_undef) {
2820 DIE(aTHX_ PL_no_aelem, elem);
2821 lv = sv_newmortal();
2822 sv_upgrade(lv, SVt_PVLV);
2824 sv_magic(lv, Nullsv, PERL_MAGIC_defelem, Nullch, 0);
2825 LvTARG(lv) = SvREFCNT_inc(av);
2826 LvTARGOFF(lv) = elem;
2831 if (PL_op->op_private & OPpLVAL_INTRO)
2832 save_aelem(av, elem, svp);
2833 else if (PL_op->op_private & OPpDEREF)
2834 vivify_ref(*svp, PL_op->op_private & OPpDEREF);
2836 sv = (svp ? *svp : &PL_sv_undef);
2837 if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */
2838 sv = sv_mortalcopy(sv);
2844 Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
2850 Perl_croak(aTHX_ PL_no_modify);
2851 if (SvTYPE(sv) < SVt_RV)
2852 sv_upgrade(sv, SVt_RV);
2853 else if (SvTYPE(sv) >= SVt_PV) {
2854 (void)SvOOK_off(sv);
2855 Safefree(SvPVX(sv));
2856 SvLEN(sv) = SvCUR(sv) = 0;
2860 SvRV(sv) = NEWSV(355,0);
2863 SvRV(sv) = (SV*)newAV();
2866 SvRV(sv) = (SV*)newHV();
2881 if (SvTYPE(rsv) == SVt_PVCV) {
2887 SETs(method_common(sv, Null(U32*)));
2895 U32 hash = SvUVX(sv);
2897 XPUSHs(method_common(sv, &hash));
2902 S_method_common(pTHX_ SV* meth, U32* hashp)
2911 SV *packsv = Nullsv;
2914 name = SvPV(meth, namelen);
2915 sv = *(PL_stack_base + TOPMARK + 1);
2918 Perl_croak(aTHX_ "Can't call method \"%s\" on an undefined value", name);
2927 /* this isn't a reference */
2930 if(SvOK(sv) && (packname = SvPV(sv, packlen))) {
2932 he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
2934 stash = (HV*)SvIV(HeVAL(he));
2941 !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
2942 !(ob=(SV*)GvIO(iogv)))
2944 /* this isn't the name of a filehandle either */
2946 ((UTF8_IS_START(*packname) && DO_UTF8(sv))
2947 ? !isIDFIRST_utf8((U8*)packname)
2948 : !isIDFIRST(*packname)
2951 Perl_croak(aTHX_ "Can't call method \"%s\" %s", name,
2952 SvOK(sv) ? "without a package or object reference"
2953 : "on an undefined value");
2955 /* assume it's a package name */
2956 stash = gv_stashpvn(packname, packlen, FALSE);
2960 SV* ref = newSViv((IV)stash);
2961 hv_store(PL_stashcache, packname, packlen, ref, 0);
2965 /* it _is_ a filehandle name -- replace with a reference */
2966 *(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
2969 /* if we got here, ob should be a reference or a glob */
2970 if (!ob || !(SvOBJECT(ob)
2971 || (SvTYPE(ob) == SVt_PVGV && (ob = (SV*)GvIO((GV*)ob))
2974 Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
2978 stash = SvSTASH(ob);
2981 /* NOTE: stash may be null, hope hv_fetch_ent and
2982 gv_fetchmethod can cope (it seems they can) */
2984 /* shortcut for simple names */
2986 HE* he = hv_fetch_ent(stash, meth, 0, *hashp);
2988 gv = (GV*)HeVAL(he);
2989 if (isGV(gv) && GvCV(gv) &&
2990 (!GvCVGEN(gv) || GvCVGEN(gv) == PL_sub_generation))
2991 return (SV*)GvCV(gv);
2995 gv = gv_fetchmethod(stash ? stash : (HV*)packsv, name);
2998 /* This code tries to figure out just what went wrong with
2999 gv_fetchmethod. It therefore needs to duplicate a lot of
3000 the internals of that function. We can't move it inside
3001 Perl_gv_fetchmethod_autoload(), however, since that would
3002 cause UNIVERSAL->can("NoSuchPackage::foo") to croak, and we
3009 for (p = name; *p; p++) {
3011 sep = p, leaf = p + 1;
3012 else if (*p == ':' && *(p + 1) == ':')
3013 sep = p, leaf = p + 2;
3015 if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
3016 /* the method name is unqualified or starts with SUPER:: */
3017 packname = sep ? CopSTASHPV(PL_curcop) :
3018 stash ? HvNAME(stash) : packname;
3019 packlen = strlen(packname);
3022 /* the method name is qualified */
3024 packlen = sep - name;
3027 /* we're relying on gv_fetchmethod not autovivifying the stash */
3028 if (gv_stashpvn(packname, packlen, FALSE)) {
3030 "Can't locate object method \"%s\" via package \"%.*s\"",
3031 leaf, (int)packlen, packname);
3035 "Can't locate object method \"%s\" via package \"%.*s\""
3036 " (perhaps you forgot to load \"%.*s\"?)",
3037 leaf, (int)packlen, packname, (int)packlen, packname);
3040 return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;