-w interacts badly with -Dt
[perl.git] / pp_hot.c
1 /*    pp_hot.c
2  *
3  *    Copyright (c) 1991-1997, Larry Wall
4  *
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.
7  *
8  */
9
10 /*
11  * Then he heard Merry change the note, and up went the Horn-cry of Buckland,
12  * shaking the air.
13  *
14  *            Awake!  Awake!  Fear, Fire, Foes!  Awake!
15  *                     Fire, Foes!  Awake!
16  */
17
18 #include "EXTERN.h"
19 #include "perl.h"
20
21 /* Hot code. */
22
23 PP(pp_const)
24 {
25     dSP;
26     XPUSHs(cSVOP->op_sv);
27     RETURN;
28 }
29
30 PP(pp_nextstate)
31 {
32     curcop = (COP*)op;
33     TAINT_NOT;          /* Each statement is presumed innocent */
34     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
35     FREETMPS;
36     return NORMAL;
37 }
38
39 PP(pp_gvsv)
40 {
41     dSP;
42     EXTEND(sp,1);
43     if (op->op_private & OPpLVAL_INTRO)
44         PUSHs(save_scalar(cGVOP->op_gv));
45     else
46         PUSHs(GvSV(cGVOP->op_gv));
47     RETURN;
48 }
49
50 PP(pp_null)
51 {
52     return NORMAL;
53 }
54
55 PP(pp_pushmark)
56 {
57     PUSHMARK(stack_sp);
58     return NORMAL;
59 }
60
61 PP(pp_stringify)
62 {
63     dSP; dTARGET;
64     STRLEN len;
65     char *s;
66     s = SvPV(TOPs,len);
67     sv_setpvn(TARG,s,len);
68     SETTARG;
69     RETURN;
70 }
71
72 PP(pp_gv)
73 {
74     dSP;
75     XPUSHs((SV*)cGVOP->op_gv);
76     RETURN;
77 }
78
79 PP(pp_gelem)
80 {
81     GV *gv;
82     SV *sv;
83     SV *ref;
84     char *elem;
85     dSP;
86
87     sv = POPs;
88     elem = SvPV(sv, na);
89     gv = (GV*)POPs;
90     ref = Nullsv;
91     sv = Nullsv;
92     switch (elem ? *elem : '\0')
93     {
94     case 'A':
95         if (strEQ(elem, "ARRAY"))
96             ref = (SV*)GvAV(gv);
97         break;
98     case 'C':
99         if (strEQ(elem, "CODE"))
100             ref = (SV*)GvCVu(gv);
101         break;
102     case 'F':
103         if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
104             ref = (SV*)GvIOp(gv);
105         break;
106     case 'G':
107         if (strEQ(elem, "GLOB"))
108             ref = (SV*)gv;
109         break;
110     case 'H':
111         if (strEQ(elem, "HASH"))
112             ref = (SV*)GvHV(gv);
113         break;
114     case 'I':
115         if (strEQ(elem, "IO"))
116             ref = (SV*)GvIOp(gv);
117         break;
118     case 'N':
119         if (strEQ(elem, "NAME"))
120             sv = newSVpv(GvNAME(gv), GvNAMELEN(gv));
121         break;
122     case 'P':
123         if (strEQ(elem, "PACKAGE"))
124             sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
125         break;
126     case 'S':
127         if (strEQ(elem, "SCALAR"))
128             ref = GvSV(gv);
129         break;
130     }
131     if (ref)
132         sv = newRV(ref);
133     if (sv)
134         sv_2mortal(sv);
135     else
136         sv = &sv_undef;
137     XPUSHs(sv);
138     RETURN;
139 }
140
141 PP(pp_and)
142 {
143     dSP;
144     if (!SvTRUE(TOPs))
145         RETURN;
146     else {
147         --SP;
148         RETURNOP(cLOGOP->op_other);
149     }
150 }
151
152 PP(pp_sassign)
153 {
154     dSP; dPOPTOPssrl;
155     MAGIC *mg;
156
157     if (op->op_private & OPpASSIGN_BACKWARDS) {
158         SV *temp;
159         temp = left; left = right; right = temp;
160     }
161     if (tainting && tainted && !SvTAINTED(left))
162         TAINT_NOT;
163     SvSetMagicSV(right, left);
164     SETs(right);
165     RETURN;
166 }
167
168 PP(pp_cond_expr)
169 {
170     dSP;
171     if (SvTRUEx(POPs))
172         RETURNOP(cCONDOP->op_true);
173     else
174         RETURNOP(cCONDOP->op_false);
175 }
176
177 PP(pp_unstack)
178 {
179     I32 oldsave;
180     TAINT_NOT;          /* Each statement is presumed innocent */
181     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
182     FREETMPS;
183     oldsave = scopestack[scopestack_ix - 1];
184     LEAVE_SCOPE(oldsave);
185     return NORMAL;
186 }
187
188 PP(pp_concat)
189 {
190   dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
191   {
192     dPOPTOPssrl;
193     STRLEN len;
194     char *s;
195     if (TARG != left) {
196         s = SvPV(left,len);
197         sv_setpvn(TARG,s,len);
198     }
199     else if (SvGMAGICAL(TARG))
200         mg_get(TARG);
201     else if (!SvOK(TARG) && SvTYPE(TARG) <= SVt_PVMG) {
202         sv_setpv(TARG, "");     /* Suppress warning. */
203         s = SvPV_force(TARG, len);
204     }
205     s = SvPV(right,len);
206     if (SvOK(TARG))
207         sv_catpvn(TARG,s,len);
208     else
209         sv_setpvn(TARG,s,len);  /* suppress warning */
210     SETTARG;
211     RETURN;
212   }
213 }
214
215 PP(pp_padsv)
216 {
217     dSP; dTARGET;
218     XPUSHs(TARG);
219     if (op->op_flags & OPf_MOD) {
220         if (op->op_private & OPpLVAL_INTRO)
221             SAVECLEARSV(curpad[op->op_targ]);
222         else if (op->op_private & OPpDEREF)
223             vivify_ref(curpad[op->op_targ], op->op_private & OPpDEREF);
224     }
225     RETURN;
226 }
227
228 PP(pp_readline)
229 {
230     last_in_gv = (GV*)(*stack_sp--);
231     return do_readline();
232 }
233
234 PP(pp_eq)
235 {
236     dSP; tryAMAGICbinSET(eq,0); 
237     {
238       dPOPnv;
239       SETs(boolSV(TOPn == value));
240       RETURN;
241     }
242 }
243
244 PP(pp_preinc)
245 {
246     dSP;
247     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
248         croak(no_modify);
249     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
250         SvIVX(TOPs) != IV_MAX)
251     {
252         ++SvIVX(TOPs);
253         SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
254     }
255     else
256         sv_inc(TOPs);
257     SvSETMAGIC(TOPs);
258     return NORMAL;
259 }
260
261 PP(pp_or)
262 {
263     dSP;
264     if (SvTRUE(TOPs))
265         RETURN;
266     else {
267         --SP;
268         RETURNOP(cLOGOP->op_other);
269     }
270 }
271
272 PP(pp_add)
273 {
274     dSP; dATARGET; tryAMAGICbin(add,opASSIGN); 
275     {
276       dPOPTOPnnrl_ul;
277       SETn( left + right );
278       RETURN;
279     }
280 }
281
282 PP(pp_aelemfast)
283 {
284     dSP;
285     AV *av = GvAV((GV*)cSVOP->op_sv);
286     SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD);
287     PUSHs(svp ? *svp : &sv_undef);
288     RETURN;
289 }
290
291 PP(pp_join)
292 {
293     dSP; dMARK; dTARGET;
294     MARK++;
295     do_join(TARG, *MARK, MARK, SP);
296     SP = MARK;
297     SETs(TARG);
298     RETURN;
299 }
300
301 PP(pp_pushre)
302 {
303     dSP;
304 #ifdef DEBUGGING
305     /*
306      * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
307      * will be enough to hold an OP*.
308      */
309     SV* sv = sv_newmortal();
310     sv_upgrade(sv, SVt_PVLV);
311     LvTYPE(sv) = '/';
312     Copy(&op, &LvTARGOFF(sv), 1, OP*);
313     XPUSHs(sv);
314 #else
315     XPUSHs((SV*)op);
316 #endif
317     RETURN;
318 }
319
320 /* Oversized hot code. */
321
322 PP(pp_print)
323 {
324     dSP; dMARK; dORIGMARK;
325     GV *gv;
326     IO *io;
327     register PerlIO *fp;
328     MAGIC *mg;
329
330     if (op->op_flags & OPf_STACKED)
331         gv = (GV*)*++MARK;
332     else
333         gv = defoutgv;
334     if (SvMAGICAL(gv) && (mg = mg_find((SV*)gv, 'q'))) {
335         if (MARK == ORIGMARK) {
336             EXTEND(SP, 1);
337             ++MARK;
338             Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
339             ++SP;
340         }
341         PUSHMARK(MARK - 1);
342         *MARK = mg->mg_obj;
343         PUTBACK;
344         ENTER;
345         perl_call_method("PRINT", G_SCALAR);
346         LEAVE;
347         SPAGAIN;
348         MARK = ORIGMARK + 1;
349         *MARK = *SP;
350         SP = MARK;
351         RETURN;
352     }
353     if (!(io = GvIO(gv))) {
354         if (dowarn) {
355             SV* sv = sv_newmortal();
356             gv_fullname3(sv, gv, Nullch);
357             warn("Filehandle %s never opened", SvPV(sv,na));
358         }
359
360         SETERRNO(EBADF,RMS$_IFI);
361         goto just_say_no;
362     }
363     else if (!(fp = IoOFP(io))) {
364         if (dowarn)  {
365             SV* sv = sv_newmortal();
366             gv_fullname3(sv, gv, Nullch);
367             if (IoIFP(io))
368                 warn("Filehandle %s opened only for input", SvPV(sv,na));
369             else
370                 warn("print on closed filehandle %s", SvPV(sv,na));
371         }
372         SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
373         goto just_say_no;
374     }
375     else {
376         MARK++;
377         if (ofslen) {
378             while (MARK <= SP) {
379                 if (!do_print(*MARK, fp))
380                     break;
381                 MARK++;
382                 if (MARK <= SP) {
383                     if (PerlIO_write(fp, ofs, ofslen) == 0 || PerlIO_error(fp)) {
384                         MARK--;
385                         break;
386                     }
387                 }
388             }
389         }
390         else {
391             while (MARK <= SP) {
392                 if (!do_print(*MARK, fp))
393                     break;
394                 MARK++;
395             }
396         }
397         if (MARK <= SP)
398             goto just_say_no;
399         else {
400             if (orslen)
401                 if (PerlIO_write(fp, ors, orslen) == 0 || PerlIO_error(fp))
402                     goto just_say_no;
403
404             if (IoFLAGS(io) & IOf_FLUSH)
405                 if (PerlIO_flush(fp) == EOF)
406                     goto just_say_no;
407         }
408     }
409     SP = ORIGMARK;
410     PUSHs(&sv_yes);
411     RETURN;
412
413   just_say_no:
414     SP = ORIGMARK;
415     PUSHs(&sv_undef);
416     RETURN;
417 }
418
419 PP(pp_rv2av)
420 {
421     dSP; dPOPss;
422     AV *av;
423
424     if (SvROK(sv)) {
425       wasref:
426         av = (AV*)SvRV(sv);
427         if (SvTYPE(av) != SVt_PVAV)
428             DIE("Not an ARRAY reference");
429         if (op->op_private & OPpLVAL_INTRO)
430             av = (AV*)save_svref((SV**)sv);
431         if (op->op_flags & OPf_REF) {
432             PUSHs((SV*)av);
433             RETURN;
434         }
435     }
436     else {
437         if (SvTYPE(sv) == SVt_PVAV) {
438             av = (AV*)sv;
439             if (op->op_flags & OPf_REF) {
440                 PUSHs((SV*)av);
441                 RETURN;
442             }
443         }
444         else {
445             GV *gv;
446             
447             if (SvTYPE(sv) != SVt_PVGV) {
448                 char *sym;
449
450                 if (SvGMAGICAL(sv)) {
451                     mg_get(sv);
452                     if (SvROK(sv))
453                         goto wasref;
454                 }
455                 if (!SvOK(sv)) {
456                     if (op->op_flags & OPf_REF ||
457                       op->op_private & HINT_STRICT_REFS)
458                         DIE(no_usym, "an ARRAY");
459                     if (dowarn)
460                         warn(warn_uninit);
461                     if (GIMME == G_ARRAY)
462                         RETURN;
463                     RETPUSHUNDEF;
464                 }
465                 sym = SvPV(sv,na);
466                 if (op->op_private & HINT_STRICT_REFS)
467                     DIE(no_symref, sym, "an ARRAY");
468                 gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVAV);
469             } else {
470                 gv = (GV*)sv;
471             }
472             av = GvAVn(gv);
473             if (op->op_private & OPpLVAL_INTRO)
474                 av = save_ary(gv);
475             if (op->op_flags & OPf_REF) {
476                 PUSHs((SV*)av);
477                 RETURN;
478             }
479         }
480     }
481
482     if (GIMME == G_ARRAY) {
483         I32 maxarg = AvFILL(av) + 1;
484         EXTEND(SP, maxarg);
485         Copy(AvARRAY(av), SP+1, maxarg, SV*);
486         SP += maxarg;
487     }
488     else {
489         dTARGET;
490         I32 maxarg = AvFILL(av) + 1;
491         PUSHi(maxarg);
492     }
493     RETURN;
494 }
495
496 PP(pp_rv2hv)
497 {
498     dSP; dTOPss;
499     HV *hv;
500
501     if (SvROK(sv)) {
502       wasref:
503         hv = (HV*)SvRV(sv);
504         if (SvTYPE(hv) != SVt_PVHV)
505             DIE("Not a HASH reference");
506         if (op->op_private & OPpLVAL_INTRO)
507             hv = (HV*)save_svref((SV**)sv);
508         if (op->op_flags & OPf_REF) {
509             SETs((SV*)hv);
510             RETURN;
511         }
512     }
513     else {
514         if (SvTYPE(sv) == SVt_PVHV) {
515             hv = (HV*)sv;
516             if (op->op_flags & OPf_REF) {
517                 SETs((SV*)hv);
518                 RETURN;
519             }
520         }
521         else {
522             GV *gv;
523             
524             if (SvTYPE(sv) != SVt_PVGV) {
525                 char *sym;
526
527                 if (SvGMAGICAL(sv)) {
528                     mg_get(sv);
529                     if (SvROK(sv))
530                         goto wasref;
531                 }
532                 if (!SvOK(sv)) {
533                     if (op->op_flags & OPf_REF ||
534                       op->op_private & HINT_STRICT_REFS)
535                         DIE(no_usym, "a HASH");
536                     if (dowarn)
537                         warn(warn_uninit);
538                     if (GIMME == G_ARRAY) {
539                         SP--;
540                         RETURN;
541                     }
542                     RETSETUNDEF;
543                 }
544                 sym = SvPV(sv,na);
545                 if (op->op_private & HINT_STRICT_REFS)
546                     DIE(no_symref, sym, "a HASH");
547                 gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PVHV);
548             } else {
549                 gv = (GV*)sv;
550             }
551             hv = GvHVn(gv);
552             if (op->op_private & OPpLVAL_INTRO)
553                 hv = save_hash(gv);
554             if (op->op_flags & OPf_REF) {
555                 SETs((SV*)hv);
556                 RETURN;
557             }
558         }
559     }
560
561     if (GIMME == G_ARRAY) { /* array wanted */
562         *stack_sp = (SV*)hv;
563         return do_kv(ARGS);
564     }
565     else {
566         dTARGET;
567         if (HvFILL(hv))
568             sv_setpvf(TARG, "%ld/%ld",
569                       (long)HvFILL(hv), (long)HvMAX(hv) + 1);
570         else
571             sv_setiv(TARG, 0);
572         SETTARG;
573         RETURN;
574     }
575 }
576
577 PP(pp_aassign)
578 {
579     dSP;
580     SV **lastlelem = stack_sp;
581     SV **lastrelem = stack_base + POPMARK;
582     SV **firstrelem = stack_base + POPMARK + 1;
583     SV **firstlelem = lastrelem + 1;
584
585     register SV **relem;
586     register SV **lelem;
587
588     register SV *sv;
589     register AV *ary;
590
591     I32 gimme;
592     HV *hash;
593     I32 i;
594     int magic;
595
596     delaymagic = DM_DELAY;              /* catch simultaneous items */
597
598     /* If there's a common identifier on both sides we have to take
599      * special care that assigning the identifier on the left doesn't
600      * clobber a value on the right that's used later in the list.
601      */
602     if (op->op_private & OPpASSIGN_COMMON) {
603         for (relem = firstrelem; relem <= lastrelem; relem++) {
604             /*SUPPRESS 560*/
605             if (sv = *relem) {
606                 TAINT_NOT;      /* Each item is independent */
607                 *relem = sv_mortalcopy(sv);
608             }
609         }
610     }
611
612     relem = firstrelem;
613     lelem = firstlelem;
614     ary = Null(AV*);
615     hash = Null(HV*);
616     while (lelem <= lastlelem) {
617         TAINT_NOT;              /* Each item stands on its own, taintwise. */
618         sv = *lelem++;
619         switch (SvTYPE(sv)) {
620         case SVt_PVAV:
621             ary = (AV*)sv;
622             magic = SvMAGICAL(ary) != 0;
623             
624             av_clear(ary);
625             av_extend(ary, lastrelem - relem);
626             i = 0;
627             while (relem <= lastrelem) {        /* gobble up all the rest */
628                 sv = NEWSV(28,0);
629                 assert(*relem);
630                 sv_setsv(sv,*relem);
631                 *(relem++) = sv;
632                 (void)av_store(ary,i++,sv);
633                 if (magic)
634                     mg_set(sv);
635                 TAINT_NOT;
636             }
637             break;
638         case SVt_PVHV: {
639                 SV *tmpstr;
640
641                 hash = (HV*)sv;
642                 magic = SvMAGICAL(hash) != 0;
643                 hv_clear(hash);
644
645                 while (relem < lastrelem) {     /* gobble up all the rest */
646                     STRLEN len;
647                     if (*relem)
648                         sv = *(relem++);
649                     else
650                         sv = &sv_no, relem++;
651                     tmpstr = NEWSV(29,0);
652                     if (*relem)
653                         sv_setsv(tmpstr,*relem);        /* value */
654                     *(relem++) = tmpstr;
655                     (void)hv_store_ent(hash,sv,tmpstr,0);
656                     if (magic)
657                         mg_set(tmpstr);
658                     TAINT_NOT;
659                 }
660                 if (relem == lastrelem)
661                     warn("Odd number of elements in hash list");
662             }
663             break;
664         default:
665             if (SvTHINKFIRST(sv)) {
666                 if (SvREADONLY(sv) && curcop != &compiling) {
667                     if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
668                         DIE(no_modify);
669                     if (relem <= lastrelem)
670                         relem++;
671                     break;
672                 }
673                 if (SvROK(sv))
674                     sv_unref(sv);
675             }
676             if (relem <= lastrelem) {
677                 sv_setsv(sv, *relem);
678                 *(relem++) = sv;
679             }
680             else
681                 sv_setsv(sv, &sv_undef);
682             SvSETMAGIC(sv);
683             break;
684         }
685     }
686     if (delaymagic & ~DM_DELAY) {
687         if (delaymagic & DM_UID) {
688 #ifdef HAS_SETRESUID
689             (void)setresuid(uid,euid,(Uid_t)-1);
690 #else
691 #  ifdef HAS_SETREUID
692             (void)setreuid(uid,euid);
693 #  else
694 #    ifdef HAS_SETRUID
695             if ((delaymagic & DM_UID) == DM_RUID) {
696                 (void)setruid(uid);
697                 delaymagic &= ~DM_RUID;
698             }
699 #    endif /* HAS_SETRUID */
700 #    ifdef HAS_SETEUID
701             if ((delaymagic & DM_UID) == DM_EUID) {
702                 (void)seteuid(uid);
703                 delaymagic &= ~DM_EUID;
704             }
705 #    endif /* HAS_SETEUID */
706             if (delaymagic & DM_UID) {
707                 if (uid != euid)
708                     DIE("No setreuid available");
709                 (void)setuid(uid);
710             }
711 #  endif /* HAS_SETREUID */
712 #endif /* HAS_SETRESUID */
713             uid = (int)getuid();
714             euid = (int)geteuid();
715         }
716         if (delaymagic & DM_GID) {
717 #ifdef HAS_SETRESGID
718             (void)setresgid(gid,egid,(Gid_t)-1);
719 #else
720 #  ifdef HAS_SETREGID
721             (void)setregid(gid,egid);
722 #  else
723 #    ifdef HAS_SETRGID
724             if ((delaymagic & DM_GID) == DM_RGID) {
725                 (void)setrgid(gid);
726                 delaymagic &= ~DM_RGID;
727             }
728 #    endif /* HAS_SETRGID */
729 #    ifdef HAS_SETEGID
730             if ((delaymagic & DM_GID) == DM_EGID) {
731                 (void)setegid(gid);
732                 delaymagic &= ~DM_EGID;
733             }
734 #    endif /* HAS_SETEGID */
735             if (delaymagic & DM_GID) {
736                 if (gid != egid)
737                     DIE("No setregid available");
738                 (void)setgid(gid);
739             }
740 #  endif /* HAS_SETREGID */
741 #endif /* HAS_SETRESGID */
742             gid = (int)getgid();
743             egid = (int)getegid();
744         }
745         tainting |= (uid && (euid != uid || egid != gid));
746     }
747     delaymagic = 0;
748
749     gimme = GIMME_V;
750     if (gimme == G_VOID)
751         SP = firstrelem - 1;
752     else if (gimme == G_SCALAR) {
753         dTARGET;
754         SP = firstrelem;
755         SETi(lastrelem - firstrelem + 1);
756     }
757     else {
758         if (ary || hash)
759             SP = lastrelem;
760         else
761             SP = firstrelem + (lastlelem - firstlelem);
762         lelem = firstlelem + (relem - firstrelem);
763         while (relem <= SP)
764             *relem++ = (lelem <= lastlelem) ? *lelem++ : &sv_undef;
765     }
766     RETURN;
767 }
768
769 PP(pp_match)
770 {
771     dSP; dTARG;
772     register PMOP *pm = cPMOP;
773     register char *t;
774     register char *s;
775     char *strend;
776     I32 global;
777     I32 safebase;
778     char *truebase;
779     register REGEXP *rx = pm->op_pmregexp;
780     I32 gimme = GIMME;
781     STRLEN len;
782     I32 minmatch = 0;
783     I32 oldsave = savestack_ix;
784     I32 update_minmatch = 1;
785
786     if (op->op_flags & OPf_STACKED)
787         TARG = POPs;
788     else {
789         TARG = GvSV(defgv);
790         EXTEND(SP,1);
791     }
792     s = SvPV(TARG, len);
793     strend = s + len;
794     if (!s)
795         DIE("panic: do_match");
796     TAINT_NOT;
797
798     if (pm->op_pmflags & PMf_USED) {
799         if (gimme == G_ARRAY)
800             RETURN;
801         RETPUSHNO;
802     }
803
804     if (!rx->prelen && curpm) {
805         pm = curpm;
806         rx = pm->op_pmregexp;
807     }
808     truebase = t = s;
809     if (global = pm->op_pmflags & PMf_GLOBAL) {
810         rx->startp[0] = 0;
811         if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
812             MAGIC* mg = mg_find(TARG, 'g');
813             if (mg && mg->mg_len >= 0) {
814                 rx->endp[0] = rx->startp[0] = s + mg->mg_len; 
815                 minmatch = (mg->mg_flags & MGf_MINMATCH);
816                 update_minmatch = 0;
817             }
818         }
819     }
820     if (!rx->nparens && !global)
821         gimme = G_SCALAR;                       /* accidental array context? */
822     safebase = (((gimme == G_ARRAY) || global || !rx->nparens)
823                 && !sawampersand);
824     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
825         SAVEINT(multiline);
826         multiline = pm->op_pmflags & PMf_MULTILINE;
827     }
828
829 play_it_again:
830     if (global && rx->startp[0]) {
831         t = s = rx->endp[0];
832         if ((s + rx->minlen) > strend)
833             goto nope;
834         if (update_minmatch++)
835             minmatch = (s == rx->startp[0]);
836     }
837     if (pm->op_pmshort) {
838         if (pm->op_pmflags & PMf_SCANFIRST) {
839             if (SvSCREAM(TARG)) {
840                 if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
841                     goto nope;
842                 else if (!(s = screaminstr(TARG, pm->op_pmshort)))
843                     goto nope;
844                 else if (pm->op_pmflags & PMf_ALL)
845                     goto yup;
846             }
847             else if (!(s = fbm_instr((unsigned char*)s,
848               (unsigned char*)strend, pm->op_pmshort)))
849                 goto nope;
850             else if (pm->op_pmflags & PMf_ALL)
851                 goto yup;
852             if (s && rx->regback >= 0) {
853                 ++BmUSEFUL(pm->op_pmshort);
854                 s -= rx->regback;
855                 if (s < t)
856                     s = t;
857             }
858             else
859                 s = t;
860         }
861         else if (!multiline) {
862             if (*SvPVX(pm->op_pmshort) != *s
863                 || (pm->op_pmslen > 1
864                     && memNE(SvPVX(pm->op_pmshort), s, pm->op_pmslen)))
865                 goto nope;
866         }
867         if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
868             SvREFCNT_dec(pm->op_pmshort);
869             pm->op_pmshort = Nullsv;    /* opt is being useless */
870         }
871     }
872     if (pregexec(rx, s, strend, truebase, minmatch,
873                  SvSCREAM(TARG) ? TARG : Nullsv, safebase))
874     {
875         curpm = pm;
876         if (pm->op_pmflags & PMf_ONCE)
877             pm->op_pmflags |= PMf_USED;
878         goto gotcha;
879     }
880     else
881         goto ret_no;
882     /*NOTREACHED*/
883
884   gotcha:
885     TAINT_IF(rx->exec_tainted);
886     if (gimme == G_ARRAY) {
887         I32 iters, i, len;
888
889         iters = rx->nparens;
890         if (global && !iters)
891             i = 1;
892         else
893             i = 0;
894         EXTEND(SP, iters + i);
895         EXTEND_MORTAL(iters + i);
896         for (i = !i; i <= iters; i++) {
897             PUSHs(sv_newmortal());
898             /*SUPPRESS 560*/
899             if ((s = rx->startp[i]) && rx->endp[i] ) {
900                 len = rx->endp[i] - s;
901                 sv_setpvn(*SP, s, len);
902             }
903         }
904         if (global) {
905             truebase = rx->subbeg;
906             strend = rx->subend;
907             if (rx->startp[0] && rx->startp[0] == rx->endp[0])
908                 ++rx->endp[0];
909             goto play_it_again;
910         }
911         LEAVE_SCOPE(oldsave);
912         RETURN;
913     }
914     else {
915         if (global) {
916             MAGIC* mg = 0;
917             if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
918                 mg = mg_find(TARG, 'g');
919             if (!mg) {
920                 sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
921                 mg = mg_find(TARG, 'g');
922             }
923             if (rx->startp[0]) {
924                 mg->mg_len = rx->endp[0] - rx->subbeg;
925                 if (rx->startp[0] == rx->endp[0])
926                     mg->mg_flags |= MGf_MINMATCH;
927                 else
928                     mg->mg_flags &= ~MGf_MINMATCH;
929             }
930         }
931         LEAVE_SCOPE(oldsave);
932         RETPUSHYES;
933     }
934
935 yup:
936     TAINT_IF(rx->exec_tainted);
937     ++BmUSEFUL(pm->op_pmshort);
938     curpm = pm;
939     if (pm->op_pmflags & PMf_ONCE)
940         pm->op_pmflags |= PMf_USED;
941     Safefree(rx->subbase);
942     rx->subbase = Nullch;
943     if (global) {
944         rx->subbeg = truebase;
945         rx->subend = strend;
946         rx->startp[0] = s;
947         rx->endp[0] = s + SvCUR(pm->op_pmshort);
948         goto gotcha;
949     }
950     if (sawampersand) {
951         char *tmps;
952
953         tmps = rx->subbase = savepvn(t, strend-t);
954         rx->subbeg = tmps;
955         rx->subend = tmps + (strend-t);
956         tmps = rx->startp[0] = tmps + (s - t);
957         rx->endp[0] = tmps + SvCUR(pm->op_pmshort);
958     }
959     LEAVE_SCOPE(oldsave);
960     RETPUSHYES;
961
962 nope:
963     if (pm->op_pmshort)
964         ++BmUSEFUL(pm->op_pmshort);
965
966 ret_no:
967     if (global && !(pm->op_pmflags & PMf_CONTINUE)) {
968         if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
969             MAGIC* mg = mg_find(TARG, 'g');
970             if (mg)
971                 mg->mg_len = -1;
972         }
973     }
974     LEAVE_SCOPE(oldsave);
975     if (gimme == G_ARRAY)
976         RETURN;
977     RETPUSHNO;
978 }
979
980 OP *
981 do_readline()
982 {
983     dSP; dTARGETSTACKED;
984     register SV *sv;
985     STRLEN tmplen = 0;
986     STRLEN offset;
987     PerlIO *fp;
988     register IO *io = GvIO(last_in_gv);
989     register I32 type = op->op_type;
990     I32 gimme = GIMME_V;
991     MAGIC *mg;
992
993     if (SvMAGICAL(last_in_gv) && (mg = mg_find((SV*)last_in_gv, 'q'))) {
994         PUSHMARK(SP);
995         XPUSHs(mg->mg_obj);
996         PUTBACK;
997         ENTER;
998         perl_call_method("READLINE", gimme);
999         LEAVE;
1000         SPAGAIN;
1001         if (gimme == G_SCALAR)
1002             SvSetMagicSV_nosteal(TARG, TOPs);
1003         RETURN;
1004     }
1005     fp = Nullfp;
1006     if (io) {
1007         fp = IoIFP(io);
1008         if (!fp) {
1009             if (IoFLAGS(io) & IOf_ARGV) {
1010                 if (IoFLAGS(io) & IOf_START) {
1011                     IoFLAGS(io) &= ~IOf_START;
1012                     IoLINES(io) = 0;
1013                     if (av_len(GvAVn(last_in_gv)) < 0) {
1014                         SV *tmpstr = newSVpv("-", 1); /* assume stdin */
1015                         av_push(GvAVn(last_in_gv), tmpstr);
1016                     }
1017                 }
1018                 fp = nextargv(last_in_gv);
1019                 if (!fp) { /* Note: fp != IoIFP(io) */
1020                     (void)do_close(last_in_gv, FALSE); /* now it does*/
1021                     IoFLAGS(io) |= IOf_START;
1022                 }
1023             }
1024             else if (type == OP_GLOB) {
1025                 SV *tmpcmd = NEWSV(55, 0);
1026                 SV *tmpglob = POPs;
1027                 ENTER;
1028                 SAVEFREESV(tmpcmd);
1029 #ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */
1030            /* since spawning off a process is a real performance hit */
1031                 {
1032 #include <descrip.h>
1033 #include <lib$routines.h>
1034 #include <nam.h>
1035 #include <rmsdef.h>
1036                     char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'};
1037                     char vmsspec[NAM$C_MAXRSS+1];
1038                     char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
1039                     char tmpfnam[L_tmpnam] = "SYS$SCRATCH:";
1040                     $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;");
1041                     PerlIO *tmpfp;
1042                     STRLEN i;
1043                     struct dsc$descriptor_s wilddsc
1044                        = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
1045                     struct dsc$descriptor_vs rsdsc
1046                        = {sizeof rslt, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, rslt};
1047                     unsigned long int cxt = 0, sts = 0, ok = 1, hasdir = 0, hasver = 0, isunix = 0;
1048
1049                     /* We could find out if there's an explicit dev/dir or version
1050                        by peeking into lib$find_file's internal context at
1051                        ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
1052                        but that's unsupported, so I don't want to do it now and
1053                        have it bite someone in the future. */
1054                     strcat(tmpfnam,tmpnam(NULL));
1055                     cp = SvPV(tmpglob,i);
1056                     for (; i; i--) {
1057                        if (cp[i] == ';') hasver = 1;
1058                        if (cp[i] == '.') {
1059                            if (sts) hasver = 1;
1060                            else sts = 1;
1061                        }
1062                        if (cp[i] == '/') {
1063                           hasdir = isunix = 1;
1064                           break;
1065                        }
1066                        if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') {
1067                            hasdir = 1;
1068                            break;
1069                        }
1070                     }
1071                     if ((tmpfp = PerlIO_open(tmpfnam,"w+","fop=dlt")) != NULL) {
1072                         ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
1073                         if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
1074                         while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
1075                                                     &dfltdsc,NULL,NULL,NULL))&1)) {
1076                             end = rstr + (unsigned long int) *rslt;
1077                             if (!hasver) while (*end != ';') end--;
1078                             *(end++) = '\n';  *end = '\0';
1079                             for (cp = rstr; *cp; cp++) *cp = _tolower(*cp);
1080                             if (hasdir) {
1081                               if (isunix) trim_unixpath(rstr,SvPVX(tmpglob),1);
1082                               begin = rstr;
1083                             }
1084                             else {
1085                                 begin = end;
1086                                 while (*(--begin) != ']' && *begin != '>') ;
1087                                 ++begin;
1088                             }
1089                             ok = (PerlIO_puts(tmpfp,begin) != EOF);
1090                         }
1091                         if (cxt) (void)lib$find_file_end(&cxt);
1092                         if (ok && sts != RMS$_NMF &&
1093                             sts != RMS$_DNF && sts != RMS$_FNF) ok = 0;
1094                         if (!ok) {
1095                             if (!(sts & 1)) {
1096                               SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts);
1097                             }
1098                             PerlIO_close(tmpfp);
1099                             fp = NULL;
1100                         }
1101                         else {
1102                            PerlIO_rewind(tmpfp);
1103                            IoTYPE(io) = '<';
1104                            IoIFP(io) = fp = tmpfp;
1105                            IoFLAGS(io) &= ~IOf_UNTAINT;  /* maybe redundant */
1106                         }
1107                     }
1108                 }
1109 #else /* !VMS */
1110 #ifdef DOSISH
1111 #ifdef OS2
1112                 sv_setpv(tmpcmd, "for a in ");
1113                 sv_catsv(tmpcmd, tmpglob);
1114                 sv_catpv(tmpcmd, "; do echo \"$a\\0\\c\"; done |");
1115 #else
1116                 sv_setpv(tmpcmd, "perlglob ");
1117                 sv_catsv(tmpcmd, tmpglob);
1118                 sv_catpv(tmpcmd, " |");
1119 #endif /* !OS2 */
1120 #else /* !DOSISH */
1121 #if defined(CSH)
1122                 sv_setpvn(tmpcmd, cshname, cshlen);
1123                 sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
1124                 sv_catsv(tmpcmd, tmpglob);
1125                 sv_catpv(tmpcmd, "' 2>/dev/null |");
1126 #else
1127                 sv_setpv(tmpcmd, "echo ");
1128                 sv_catsv(tmpcmd, tmpglob);
1129 #if 'z' - 'a' == 25
1130                 sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
1131 #else
1132                 sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
1133 #endif
1134 #endif /* !CSH */
1135 #endif /* !DOSISH */
1136                 (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),
1137                               FALSE, 0, 0, Nullfp);
1138                 fp = IoIFP(io);
1139 #endif /* !VMS */
1140                 LEAVE;
1141             }
1142         }
1143         else if (type == OP_GLOB)
1144             SP--;
1145     }
1146     if (!fp) {
1147         if (dowarn && io && !(IoFLAGS(io) & IOf_START))
1148             warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
1149         if (gimme == G_SCALAR) {
1150             (void)SvOK_off(TARG);
1151             PUSHTARG;
1152         }
1153         RETURN;
1154     }
1155     if (gimme == G_SCALAR) {
1156         sv = TARG;
1157         if (SvROK(sv))
1158             sv_unref(sv);
1159         (void)SvUPGRADE(sv, SVt_PV);
1160         tmplen = SvLEN(sv);     /* remember if already alloced */
1161         if (!tmplen)
1162             Sv_Grow(sv, 80);    /* try short-buffering it */
1163         if (type == OP_RCATLINE)
1164             offset = SvCUR(sv);
1165         else
1166             offset = 0;
1167     }
1168     else {
1169         sv = sv_2mortal(NEWSV(57, 80));
1170         offset = 0;
1171     }
1172     for (;;) {
1173         if (!sv_gets(sv, fp, offset)) {
1174             PerlIO_clearerr(fp);
1175             if (IoFLAGS(io) & IOf_ARGV) {
1176                 fp = nextargv(last_in_gv);
1177                 if (fp)
1178                     continue;
1179                 (void)do_close(last_in_gv, FALSE);
1180                 IoFLAGS(io) |= IOf_START;
1181             }
1182             else if (type == OP_GLOB) {
1183                 if (do_close(last_in_gv, FALSE) & ~0xFF)
1184                     warn("internal error: glob failed");
1185             }
1186             if (gimme == G_SCALAR) {
1187                 (void)SvOK_off(TARG);
1188                 PUSHTARG;
1189             }
1190             RETURN;
1191         }
1192         /* This should not be marked tainted if the fp is marked clean */
1193         if (!(IoFLAGS(io) & IOf_UNTAINT)) {
1194             TAINT;
1195             SvTAINTED_on(sv);
1196         }
1197         IoLINES(io)++;
1198         SvSETMAGIC(sv);
1199         XPUSHs(sv);
1200         if (type == OP_GLOB) {
1201             char *tmps;
1202
1203             if (SvCUR(sv) > 0 && SvCUR(rs) > 0) {
1204                 tmps = SvEND(sv) - 1;
1205                 if (*tmps == *SvPVX(rs)) {
1206                     *tmps = '\0';
1207                     SvCUR(sv)--;
1208                 }
1209             }
1210             for (tmps = SvPVX(sv); *tmps; tmps++)
1211                 if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
1212                     strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
1213                         break;
1214             if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) {
1215                 (void)POPs;             /* Unmatched wildcard?  Chuck it... */
1216                 continue;
1217             }
1218         }
1219         if (gimme == G_ARRAY) {
1220             if (SvLEN(sv) - SvCUR(sv) > 20) {
1221                 SvLEN_set(sv, SvCUR(sv)+1);
1222                 Renew(SvPVX(sv), SvLEN(sv), char);
1223             }
1224             sv = sv_2mortal(NEWSV(58, 80));
1225             continue;
1226         }
1227         else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
1228             /* try to reclaim a bit of scalar space (only on 1st alloc) */
1229             if (SvCUR(sv) < 60)
1230                 SvLEN_set(sv, 80);
1231             else
1232                 SvLEN_set(sv, SvCUR(sv)+40);    /* allow some slop */
1233             Renew(SvPVX(sv), SvLEN(sv), char);
1234         }
1235         RETURN;
1236     }
1237 }
1238
1239 PP(pp_enter)
1240 {
1241     dSP;
1242     register CONTEXT *cx;
1243     I32 gimme = OP_GIMME(op, -1);
1244
1245     if (gimme == -1) {
1246         if (cxstack_ix >= 0)
1247             gimme = cxstack[cxstack_ix].blk_gimme;
1248         else
1249             gimme = G_SCALAR;
1250     }
1251
1252     ENTER;
1253
1254     SAVETMPS;
1255     PUSHBLOCK(cx, CXt_BLOCK, sp);
1256
1257     RETURN;
1258 }
1259
1260 PP(pp_helem)
1261 {
1262     dSP;
1263     HE* he;
1264     SV *keysv = POPs;
1265     HV *hv = (HV*)POPs;
1266     U32 lval = op->op_flags & OPf_MOD;
1267     U32 defer = op->op_private & OPpLVAL_DEFER;
1268
1269     if (SvTYPE(hv) != SVt_PVHV)
1270         RETPUSHUNDEF;
1271     he = hv_fetch_ent(hv, keysv, lval && !defer, 0);
1272     if (lval) {
1273         if (!he || HeVAL(he) == &sv_undef) {
1274             SV* lv;
1275             SV* key2;
1276             if (!defer)
1277                 DIE(no_helem, SvPV(keysv, na));
1278             lv = sv_newmortal();
1279             sv_upgrade(lv, SVt_PVLV);
1280             LvTYPE(lv) = 'y';
1281             sv_magic(lv, key2 = newSVsv(keysv), 'y', Nullch, 0);
1282             SvREFCNT_dec(key2); /* sv_magic() increments refcount */
1283             LvTARG(lv) = SvREFCNT_inc(hv);
1284             LvTARGLEN(lv) = 1;
1285             PUSHs(lv);
1286             RETURN;
1287         }
1288         if (op->op_private & OPpLVAL_INTRO) {
1289             if (HvNAME(hv) && isGV(HeVAL(he)))
1290                 save_gp((GV*)HeVAL(he), !(op->op_flags & OPf_SPECIAL));
1291             else
1292                 save_svref(&HeVAL(he));
1293         }
1294         else if (op->op_private & OPpDEREF)
1295             vivify_ref(HeVAL(he), op->op_private & OPpDEREF);
1296     }
1297     PUSHs(he ? HeVAL(he) : &sv_undef);
1298     RETURN;
1299 }
1300
1301 PP(pp_leave)
1302 {
1303     dSP;
1304     register CONTEXT *cx;
1305     register SV **mark;
1306     SV **newsp;
1307     PMOP *newpm;
1308     I32 gimme;
1309
1310     if (op->op_flags & OPf_SPECIAL) {
1311         cx = &cxstack[cxstack_ix];
1312         cx->blk_oldpm = curpm;  /* fake block should preserve $1 et al */
1313     }
1314
1315     POPBLOCK(cx,newpm);
1316
1317     gimme = OP_GIMME(op, -1);
1318     if (gimme == -1) {
1319         if (cxstack_ix >= 0)
1320             gimme = cxstack[cxstack_ix].blk_gimme;
1321         else
1322             gimme = G_SCALAR;
1323     }
1324
1325     TAINT_NOT;
1326     if (gimme == G_VOID)
1327         SP = newsp;
1328     else if (gimme == G_SCALAR) {
1329         MARK = newsp + 1;
1330         if (MARK <= SP)
1331             if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
1332                 *MARK = TOPs;
1333             else
1334                 *MARK = sv_mortalcopy(TOPs);
1335         else {
1336             MEXTEND(mark,0);
1337             *MARK = &sv_undef;
1338         }
1339         SP = MARK;
1340     }
1341     else if (gimme == G_ARRAY) {
1342         /* in case LEAVE wipes old return values */
1343         for (mark = newsp + 1; mark <= SP; mark++) {
1344             if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
1345                 *mark = sv_mortalcopy(*mark);
1346                 TAINT_NOT;      /* Each item is independent */
1347             }
1348         }
1349     }
1350     curpm = newpm;      /* Don't pop $1 et al till now */
1351
1352     LEAVE;
1353
1354     RETURN;
1355 }
1356
1357 PP(pp_iter)
1358 {
1359     dSP;
1360     register CONTEXT *cx;
1361     SV* sv;
1362     AV* av;
1363
1364     EXTEND(sp, 1);
1365     cx = &cxstack[cxstack_ix];
1366     if (cx->cx_type != CXt_LOOP)
1367         DIE("panic: pp_iter");
1368
1369     av = cx->blk_loop.iterary;
1370     if (cx->blk_loop.iterix >= (av == curstack ? cx->blk_oldsp : AvFILL(av)))
1371         RETPUSHNO;
1372
1373     SvREFCNT_dec(*cx->blk_loop.itervar);
1374
1375     if (sv = AvARRAY(av)[++cx->blk_loop.iterix])
1376         SvTEMP_off(sv);
1377     else
1378         sv = &sv_undef;
1379     if (av != curstack && SvIMMORTAL(sv)) {
1380         SV *lv = cx->blk_loop.iterlval;
1381         if (lv && SvREFCNT(lv) > 1) {
1382             SvREFCNT_dec(lv);
1383             lv = Nullsv;
1384         }
1385         if (lv)
1386             SvREFCNT_dec(LvTARG(lv));
1387         else {
1388             lv = cx->blk_loop.iterlval = NEWSV(26, 0);
1389             sv_upgrade(lv, SVt_PVLV);
1390             LvTYPE(lv) = 'y';
1391             sv_magic(lv, Nullsv, 'y', Nullch, 0);
1392         }
1393         LvTARG(lv) = SvREFCNT_inc(av);
1394         LvTARGOFF(lv) = cx->blk_loop.iterix;
1395         LvTARGLEN(lv) = -1;
1396         sv = (SV*)lv;
1397     }
1398
1399     *cx->blk_loop.itervar = SvREFCNT_inc(sv);
1400     RETPUSHYES;
1401 }
1402
1403 PP(pp_subst)
1404 {
1405     dSP; dTARG;
1406     register PMOP *pm = cPMOP;
1407     PMOP *rpm = pm;
1408     register SV *dstr;
1409     register char *s;
1410     char *strend;
1411     register char *m;
1412     char *c;
1413     register char *d;
1414     STRLEN clen;
1415     I32 iters = 0;
1416     I32 maxiters;
1417     register I32 i;
1418     bool once;
1419     bool rxtainted;
1420     char *orig;
1421     I32 safebase;
1422     register REGEXP *rx = pm->op_pmregexp;
1423     STRLEN len;
1424     int force_on_match = 0;
1425     I32 oldsave = savestack_ix;
1426
1427     /* known replacement string? */
1428     dstr = (pm->op_pmflags & PMf_CONST) ? POPs : Nullsv;
1429     if (op->op_flags & OPf_STACKED)
1430         TARG = POPs;
1431     else {
1432         TARG = GvSV(defgv);
1433         EXTEND(SP,1);
1434     }
1435     if (SvREADONLY(TARG)
1436         || (SvTYPE(TARG) > SVt_PVLV
1437             && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
1438         croak(no_modify);
1439     s = SvPV(TARG, len);
1440     if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
1441         force_on_match = 1;
1442     TAINT_NOT;
1443
1444   force_it:
1445     if (!pm || !s)
1446         DIE("panic: do_subst");
1447
1448     strend = s + len;
1449     maxiters = (strend - s) + 10;
1450
1451     if (!rx->prelen && curpm) {
1452         pm = curpm;
1453         rx = pm->op_pmregexp;
1454     }
1455     safebase = (!rx->nparens && !sawampersand);
1456     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
1457         SAVEINT(multiline);
1458         multiline = pm->op_pmflags & PMf_MULTILINE;
1459     }
1460     orig = m = s;
1461     if (pm->op_pmshort) {
1462         if (pm->op_pmflags & PMf_SCANFIRST) {
1463             if (SvSCREAM(TARG)) {
1464                 if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
1465                     goto nope;
1466                 else if (!(s = screaminstr(TARG, pm->op_pmshort)))
1467                     goto nope;
1468             }
1469             else if (!(s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
1470               pm->op_pmshort)))
1471                 goto nope;
1472             if (s && rx->regback >= 0) {
1473                 ++BmUSEFUL(pm->op_pmshort);
1474                 s -= rx->regback;
1475                 if (s < m)
1476                     s = m;
1477             }
1478             else
1479                 s = m;
1480         }
1481         else if (!multiline) {
1482             if (*SvPVX(pm->op_pmshort) != *s
1483                 || (pm->op_pmslen > 1
1484                     && memNE(SvPVX(pm->op_pmshort), s, pm->op_pmslen)))
1485                 goto nope;
1486         }
1487         if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
1488             SvREFCNT_dec(pm->op_pmshort);
1489             pm->op_pmshort = Nullsv;    /* opt is being useless */
1490         }
1491     }
1492
1493     /* only replace once? */
1494     once = !(rpm->op_pmflags & PMf_GLOBAL);
1495
1496     /* known replacement string? */
1497     c = dstr ? SvPV(dstr, clen) : Nullch;
1498
1499     /* can do inplace substitution? */
1500     if (c && clen <= rx->minlen && safebase) {
1501         if (! pregexec(rx, s, strend, orig, 0,
1502                        SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
1503             PUSHs(&sv_no);
1504             LEAVE_SCOPE(oldsave);
1505             RETURN;
1506         }
1507         if (force_on_match) {
1508             force_on_match = 0;
1509             s = SvPV_force(TARG, len);
1510             goto force_it;
1511         }
1512         d = s;
1513         curpm = pm;
1514         SvSCREAM_off(TARG);     /* disable possible screamer */
1515         if (once) {
1516             rxtainted = rx->exec_tainted;
1517             m = rx->startp[0];
1518             d = rx->endp[0];
1519             s = orig;
1520             if (m - s > strend - d) {  /* faster to shorten from end */
1521                 if (clen) {
1522                     Copy(c, m, clen, char);
1523                     m += clen;
1524                 }
1525                 i = strend - d;
1526                 if (i > 0) {
1527                     Move(d, m, i, char);
1528                     m += i;
1529                 }
1530                 *m = '\0';
1531                 SvCUR_set(TARG, m - s);
1532             }
1533             /*SUPPRESS 560*/
1534             else if (i = m - s) {       /* faster from front */
1535                 d -= clen;
1536                 m = d;
1537                 sv_chop(TARG, d-i);
1538                 s += i;
1539                 while (i--)
1540                     *--d = *--s;
1541                 if (clen)
1542                     Copy(c, m, clen, char);
1543             }
1544             else if (clen) {
1545                 d -= clen;
1546                 sv_chop(TARG, d);
1547                 Copy(c, d, clen, char);
1548             }
1549             else {
1550                 sv_chop(TARG, d);
1551             }
1552             TAINT_IF(rxtainted);
1553             PUSHs(&sv_yes);
1554         }
1555         else {
1556             rxtainted = 0;
1557             do {
1558                 if (iters++ > maxiters)
1559                     DIE("Substitution loop");
1560                 rxtainted |= rx->exec_tainted;
1561                 m = rx->startp[0];
1562                 /*SUPPRESS 560*/
1563                 if (i = m - s) {
1564                     if (s != d)
1565                         Move(s, d, i, char);
1566                     d += i;
1567                 }
1568                 if (clen) {
1569                     Copy(c, d, clen, char);
1570                     d += clen;
1571                 }
1572                 s = rx->endp[0];
1573             } while (pregexec(rx, s, strend, orig, s == m,
1574                               Nullsv, TRUE)); /* don't match same null twice */
1575             if (s != d) {
1576                 i = strend - s;
1577                 SvCUR_set(TARG, d - SvPVX(TARG) + i);
1578                 Move(s, d, i+1, char);          /* include the NUL */
1579             }
1580             TAINT_IF(rxtainted);
1581             PUSHs(sv_2mortal(newSViv((I32)iters)));
1582         }
1583         (void)SvPOK_only(TARG);
1584         SvSETMAGIC(TARG);
1585         SvTAINT(TARG);
1586         LEAVE_SCOPE(oldsave);
1587         RETURN;
1588     }
1589
1590     if (pregexec(rx, s, strend, orig, 0,
1591                  SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
1592         if (force_on_match) {
1593             force_on_match = 0;
1594             s = SvPV_force(TARG, len);
1595             goto force_it;
1596         }
1597         rxtainted = rx->exec_tainted;
1598         dstr = NEWSV(25, sv_len(TARG));
1599         sv_setpvn(dstr, m, s-m);
1600         curpm = pm;
1601         if (!c) {
1602             register CONTEXT *cx;
1603             PUSHSUBST(cx);
1604             RETURNOP(cPMOP->op_pmreplroot);
1605         }
1606         do {
1607             if (iters++ > maxiters)
1608                 DIE("Substitution loop");
1609             rxtainted |= rx->exec_tainted;
1610             if (rx->subbase && rx->subbase != orig) {
1611                 m = s;
1612                 s = orig;
1613                 orig = rx->subbase;
1614                 s = orig + (m - s);
1615                 strend = s + (strend - m);
1616             }
1617             m = rx->startp[0];
1618             sv_catpvn(dstr, s, m-s);
1619             s = rx->endp[0];
1620             if (clen)
1621                 sv_catpvn(dstr, c, clen);
1622             if (once)
1623                 break;
1624         } while (pregexec(rx, s, strend, orig, s == m, Nullsv, safebase));
1625         sv_catpvn(dstr, s, strend - s);
1626
1627         TAINT_IF(rxtainted);
1628
1629         (void)SvOOK_off(TARG);
1630         Safefree(SvPVX(TARG));
1631         SvPVX(TARG) = SvPVX(dstr);
1632         SvCUR_set(TARG, SvCUR(dstr));
1633         SvLEN_set(TARG, SvLEN(dstr));
1634         SvPVX(dstr) = 0;
1635         sv_free(dstr);
1636
1637         (void)SvPOK_only(TARG);
1638         SvSETMAGIC(TARG);
1639         SvTAINT(TARG);
1640         PUSHs(sv_2mortal(newSViv((I32)iters)));
1641         LEAVE_SCOPE(oldsave);
1642         RETURN;
1643     }
1644     goto ret_no;
1645
1646 nope:
1647     ++BmUSEFUL(pm->op_pmshort);
1648
1649 ret_no:
1650     PUSHs(&sv_no);
1651     LEAVE_SCOPE(oldsave);
1652     RETURN;
1653 }
1654
1655 PP(pp_grepwhile)
1656 {
1657     dSP;
1658
1659     if (SvTRUEx(POPs))
1660         stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
1661     ++*markstack_ptr;
1662     LEAVE;                                      /* exit inner scope */
1663
1664     /* All done yet? */
1665     if (stack_base + *markstack_ptr > sp) {
1666         I32 items;
1667         I32 gimme = GIMME_V;
1668
1669         LEAVE;                                  /* exit outer scope */
1670         (void)POPMARK;                          /* pop src */
1671         items = --*markstack_ptr - markstack_ptr[-1];
1672         (void)POPMARK;                          /* pop dst */
1673         SP = stack_base + POPMARK;              /* pop original mark */
1674         if (gimme == G_SCALAR) {
1675             dTARGET;
1676             XPUSHi(items);
1677         }
1678         else if (gimme == G_ARRAY)
1679             SP += items;
1680         RETURN;
1681     }
1682     else {
1683         SV *src;
1684
1685         ENTER;                                  /* enter inner scope */
1686         SAVESPTR(curpm);
1687
1688         src = stack_base[*markstack_ptr];
1689         SvTEMP_off(src);
1690         GvSV(defgv) = src;
1691
1692         RETURNOP(cLOGOP->op_other);
1693     }
1694 }
1695
1696 PP(pp_leavesub)
1697 {
1698     dSP;
1699     SV **mark;
1700     SV **newsp;
1701     PMOP *newpm;
1702     I32 gimme;
1703     register CONTEXT *cx;
1704     struct block_sub cxsub;
1705
1706     POPBLOCK(cx,newpm);
1707     POPSUB1(cx);        /* Delay POPSUB2 until stack values are safe */
1708  
1709     TAINT_NOT;
1710     if (gimme == G_SCALAR) {
1711         MARK = newsp + 1;
1712         if (MARK <= SP)
1713             *MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
1714         else {
1715             MEXTEND(MARK, 0);
1716             *MARK = &sv_undef;
1717         }
1718         SP = MARK;
1719     }
1720     else if (gimme == G_ARRAY) {
1721         for (MARK = newsp + 1; MARK <= SP; MARK++) {
1722             if (!SvTEMP(*MARK)) {
1723                 *MARK = sv_mortalcopy(*MARK);
1724                 TAINT_NOT;      /* Each item is independent */
1725             }
1726         }
1727     }
1728     PUTBACK;
1729     
1730     POPSUB2();          /* Stack values are safe: release CV and @_ ... */
1731     curpm = newpm;      /* ... and pop $1 et al */
1732
1733     LEAVE;
1734     return pop_return();
1735 }
1736
1737 PP(pp_entersub)
1738 {
1739     dSP; dPOPss;
1740     GV *gv;
1741     HV *stash;
1742     register CV *cv;
1743     register CONTEXT *cx;
1744     I32 gimme;
1745     bool hasargs = (op->op_flags & OPf_STACKED) != 0;
1746
1747     if (!sv)
1748         DIE("Not a CODE reference");
1749     switch (SvTYPE(sv)) {
1750     default:
1751         if (!SvROK(sv)) {
1752             char *sym;
1753
1754             if (sv == &sv_yes)          /* unfound import, ignore */
1755                 RETURN;
1756             if (SvGMAGICAL(sv)) {
1757                 mg_get(sv);
1758                 sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
1759             }
1760             else
1761                 sym = SvPV(sv, na);
1762             if (!sym)
1763                 DIE(no_usym, "a subroutine");
1764             if (op->op_private & HINT_STRICT_REFS)
1765                 DIE(no_symref, sym, "a subroutine");
1766             cv = perl_get_cv(sym, TRUE);
1767             break;
1768         }
1769         cv = (CV*)SvRV(sv);
1770         if (SvTYPE(cv) == SVt_PVCV)
1771             break;
1772         /* FALL THROUGH */
1773     case SVt_PVHV:
1774     case SVt_PVAV:
1775         DIE("Not a CODE reference");
1776     case SVt_PVCV:
1777         cv = (CV*)sv;
1778         break;
1779     case SVt_PVGV:
1780         if (!(cv = GvCVu((GV*)sv)))
1781             cv = sv_2cv(sv, &stash, &gv, TRUE);
1782         break;
1783     }
1784
1785     ENTER;
1786     SAVETMPS;
1787
1788   retry:
1789     if (!cv)
1790         DIE("Not a CODE reference");
1791
1792     if (!CvROOT(cv) && !CvXSUB(cv)) {
1793         GV* autogv;
1794         SV* subname;
1795
1796         /* anonymous or undef'd function leaves us no recourse */
1797         if (CvANON(cv) || !(gv = CvGV(cv)))
1798             DIE("Undefined subroutine called");
1799         /* autoloaded stub? */
1800         if (cv != GvCV(gv)) {
1801             cv = GvCV(gv);
1802             goto retry;
1803         }
1804         /* should call AUTOLOAD now? */
1805         if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
1806                                    FALSE)))
1807         {
1808             cv = GvCV(autogv);
1809             goto retry;
1810         }
1811         /* sorry */
1812         subname = sv_newmortal();
1813         gv_efullname3(subname, gv, Nullch);
1814         DIE("Undefined subroutine &%s called", SvPVX(subname));
1815     }
1816
1817     gimme = GIMME_V;
1818     if ((op->op_private & OPpENTERSUB_DB) && GvCV(DBsub) && !CvNODEBUG(cv)) {
1819         SV *oldsv = sv;
1820         sv = GvSV(DBsub);
1821         save_item(sv);
1822         gv = CvGV(cv);
1823         if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED))
1824              || strEQ(GvNAME(gv), "END") 
1825              || ((GvCV(gv) != cv) && /* Could be imported, and old sub redefined. */
1826                  !( (SvTYPE(oldsv) == SVt_PVGV) && (GvCV((GV*)oldsv) == cv)
1827                     && (gv = (GV*)oldsv) ))) { /* Use GV from the stack as a fallback. */
1828             /* GV is potentially non-unique, or contain different CV. */
1829             sv_setsv(sv, newRV((SV*)cv));
1830         }
1831         else {
1832             gv_efullname3(sv, gv, Nullch);
1833         }
1834         cv = GvCV(DBsub);
1835         if (CvXSUB(cv)) curcopdb = curcop;
1836         if (!cv)
1837             DIE("No DBsub routine");
1838     }
1839
1840     if (CvXSUB(cv)) {
1841         if (CvOLDSTYLE(cv)) {
1842             I32 (*fp3)_((int,int,int));
1843             dMARK;
1844             register I32 items = SP - MARK;
1845                                         /* We dont worry to copy from @_. */
1846             while (sp > mark) {
1847                 sp[1] = sp[0];
1848                 sp--;
1849             }
1850             stack_sp = mark + 1;
1851             fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
1852             items = (*fp3)(CvXSUBANY(cv).any_i32, 
1853                            MARK - stack_base + 1,
1854                            items);
1855             stack_sp = stack_base + items;
1856         }
1857         else {
1858             I32 markix = TOPMARK;
1859
1860             PUTBACK;
1861
1862             if (!hasargs) {
1863                 /* Need to copy @_ to stack. Alternative may be to
1864                  * switch stack to @_, and copy return values
1865                  * back. This would allow popping @_ in XSUB, e.g.. XXXX */
1866                 AV* av = GvAV(defgv);
1867                 I32 items = AvFILL(av) + 1;
1868
1869                 if (items) {
1870                     /* Mark is at the end of the stack. */
1871                     EXTEND(sp, items);
1872                     Copy(AvARRAY(av), sp + 1, items, SV*);
1873                     sp += items;
1874                     PUTBACK ;               
1875                 }
1876             }
1877             if (curcopdb) {             /* We assume that the first
1878                                            XSUB in &DB::sub is the
1879                                            called one. */
1880                 SAVESPTR(curcop);
1881                 curcop = curcopdb;
1882                 curcopdb = NULL;
1883             }
1884             /* Do we need to open block here? XXXX */
1885             (void)(*CvXSUB(cv))(cv);
1886
1887             /* Enforce some sanity in scalar context. */
1888             if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
1889                 if (markix > stack_sp - stack_base)
1890                     *(stack_base + markix) = &sv_undef;
1891                 else
1892                     *(stack_base + markix) = *stack_sp;
1893                 stack_sp = stack_base + markix;
1894             }
1895         }
1896         LEAVE;
1897         return NORMAL;
1898     }
1899     else {
1900         dMARK;
1901         register I32 items = SP - MARK;
1902         AV* padlist = CvPADLIST(cv);
1903         SV** svp = AvARRAY(padlist);
1904         push_return(op->op_next);
1905         PUSHBLOCK(cx, CXt_SUB, MARK);
1906         PUSHSUB(cx);
1907         CvDEPTH(cv)++;
1908         if (CvDEPTH(cv) < 2)
1909             (void)SvREFCNT_inc(cv);
1910         else {  /* save temporaries on recursion? */
1911             if (CvDEPTH(cv) == 100 && dowarn 
1912                   && !(perldb && cv == GvCV(DBsub)))
1913                 sub_crush_depth(cv);
1914             if (CvDEPTH(cv) > AvFILL(padlist)) {
1915                 AV *av;
1916                 AV *newpad = newAV();
1917                 SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
1918                 I32 ix = AvFILL((AV*)svp[1]);
1919                 svp = AvARRAY(svp[0]);
1920                 for ( ;ix > 0; ix--) {
1921                     if (svp[ix] != &sv_undef) {
1922                         char *name = SvPVX(svp[ix]);
1923                         if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */
1924                             || *name == '&')              /* anonymous code? */
1925                         {
1926                             av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
1927                         }
1928                         else {                          /* our own lexical */
1929                             if (*name == '@')
1930                                 av_store(newpad, ix, sv = (SV*)newAV());
1931                             else if (*name == '%')
1932                                 av_store(newpad, ix, sv = (SV*)newHV());
1933                             else
1934                                 av_store(newpad, ix, sv = NEWSV(0,0));
1935                             SvPADMY_on(sv);
1936                         }
1937                     }
1938                     else {
1939                         av_store(newpad, ix, sv = NEWSV(0,0));
1940                         SvPADTMP_on(sv);
1941                     }
1942                 }
1943                 av = newAV();           /* will be @_ */
1944                 av_extend(av, 0);
1945                 av_store(newpad, 0, (SV*)av);
1946                 AvFLAGS(av) = AVf_REIFY;
1947                 av_store(padlist, CvDEPTH(cv), (SV*)newpad);
1948                 AvFILL(padlist) = CvDEPTH(cv);
1949                 svp = AvARRAY(padlist);
1950             }
1951         }
1952         SAVESPTR(curpad);
1953         curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
1954         if (hasargs) {
1955             AV* av = (AV*)curpad[0];
1956             SV** ary;
1957
1958             if (AvREAL(av)) {
1959                 av_clear(av);
1960                 AvREAL_off(av);
1961             }
1962             cx->blk_sub.savearray = GvAV(defgv);
1963             cx->blk_sub.argarray = av;
1964             GvAV(defgv) = (AV*)SvREFCNT_inc(av);
1965             ++MARK;
1966
1967             if (items > AvMAX(av) + 1) {
1968                 ary = AvALLOC(av);
1969                 if (AvARRAY(av) != ary) {
1970                     AvMAX(av) += AvARRAY(av) - AvALLOC(av);
1971                     SvPVX(av) = (char*)ary;
1972                 }
1973                 if (items > AvMAX(av) + 1) {
1974                     AvMAX(av) = items - 1;
1975                     Renew(ary,items,SV*);
1976                     AvALLOC(av) = ary;
1977                     SvPVX(av) = (char*)ary;
1978                 }
1979             }
1980             Copy(MARK,AvARRAY(av),items,SV*);
1981             AvFILL(av) = items - 1;
1982             
1983             while (items--) {
1984                 if (*MARK)
1985                     SvTEMP_off(*MARK);
1986                 MARK++;
1987             }
1988         }
1989         RETURNOP(CvSTART(cv));
1990     }
1991 }
1992
1993 void
1994 sub_crush_depth(cv)
1995 CV* cv;
1996 {
1997     if (CvANON(cv))
1998         warn("Deep recursion on anonymous subroutine");
1999     else {
2000         SV* tmpstr = sv_newmortal();
2001         gv_efullname3(tmpstr, CvGV(cv), Nullch);
2002         warn("Deep recursion on subroutine \"%s\"", SvPVX(tmpstr));
2003     }
2004 }
2005
2006 PP(pp_aelem)
2007 {
2008     dSP;
2009     SV** svp;
2010     I32 elem = POPi;
2011     AV* av = (AV*)POPs;
2012     U32 lval = op->op_flags & OPf_MOD;
2013     U32 defer = (op->op_private & OPpLVAL_DEFER) && (elem > AvFILL(av));
2014
2015     if (elem > 0)
2016         elem -= curcop->cop_arybase;
2017     if (SvTYPE(av) != SVt_PVAV)
2018         RETPUSHUNDEF;
2019     svp = av_fetch(av, elem, lval && !defer);
2020     if (lval) {
2021         if (!svp || *svp == &sv_undef) {
2022             SV* lv;
2023             if (!defer)
2024                 DIE(no_aelem, elem);
2025             lv = sv_newmortal();
2026             sv_upgrade(lv, SVt_PVLV);
2027             LvTYPE(lv) = 'y';
2028             sv_magic(lv, Nullsv, 'y', Nullch, 0);
2029             LvTARG(lv) = SvREFCNT_inc(av);
2030             LvTARGOFF(lv) = elem;
2031             LvTARGLEN(lv) = 1;
2032             PUSHs(lv);
2033             RETURN;
2034         }
2035         if (op->op_private & OPpLVAL_INTRO)
2036             save_svref(svp);
2037         else if (op->op_private & OPpDEREF)
2038             vivify_ref(*svp, op->op_private & OPpDEREF);
2039     }
2040     PUSHs(svp ? *svp : &sv_undef);
2041     RETURN;
2042 }
2043
2044 void
2045 vivify_ref(sv, to_what)
2046 SV* sv;
2047 U32 to_what;
2048 {
2049     if (SvGMAGICAL(sv))
2050         mg_get(sv);
2051     if (!SvOK(sv)) {
2052         if (SvREADONLY(sv))
2053             croak(no_modify);
2054         if (SvTYPE(sv) < SVt_RV)
2055             sv_upgrade(sv, SVt_RV);
2056         else if (SvTYPE(sv) >= SVt_PV) {
2057             (void)SvOOK_off(sv);
2058             Safefree(SvPVX(sv));
2059             SvLEN(sv) = SvCUR(sv) = 0;
2060         }
2061         switch (to_what) {
2062         case OPpDEREF_SV:
2063             SvRV(sv) = newSV(0);
2064             break;
2065         case OPpDEREF_AV:
2066             SvRV(sv) = (SV*)newAV();
2067             break;
2068         case OPpDEREF_HV:
2069             SvRV(sv) = (SV*)newHV();
2070             break;
2071         }
2072         SvROK_on(sv);
2073         SvSETMAGIC(sv);
2074     }
2075 }
2076
2077 PP(pp_method)
2078 {
2079     dSP;
2080     SV* sv;
2081     SV* ob;
2082     GV* gv;
2083     HV* stash;
2084     char* name;
2085     char* packname;
2086     STRLEN packlen;
2087
2088     name = SvPV(TOPs, na);
2089     sv = *(stack_base + TOPMARK + 1);
2090     
2091     if (SvGMAGICAL(sv))
2092         mg_get(sv);
2093     if (SvROK(sv))
2094         ob = (SV*)SvRV(sv);
2095     else {
2096         GV* iogv;
2097
2098         packname = Nullch;
2099         if (!SvOK(sv) ||
2100             !(packname = SvPV(sv, packlen)) ||
2101             !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
2102             !(ob=(SV*)GvIO(iogv)))
2103         {
2104             if (!packname || !isIDFIRST(*packname))
2105   DIE("Can't call method \"%s\" without a package or object reference", name);
2106             stash = gv_stashpvn(packname, packlen, TRUE);
2107             goto fetch;
2108         }
2109         *(stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
2110     }
2111
2112     if (!ob || !SvOBJECT(ob))
2113         DIE("Can't call method \"%s\" on unblessed reference", name);
2114
2115     stash = SvSTASH(ob);
2116
2117   fetch:
2118     gv = gv_fetchmethod(stash, name);
2119     if (!gv) {
2120         char* leaf = name;
2121         char* sep = Nullch;
2122         char* p;
2123
2124         for (p = name; *p; p++) {
2125             if (*p == '\'')
2126                 sep = p, leaf = p + 1;
2127             else if (*p == ':' && *(p + 1) == ':')
2128                 sep = p, leaf = p + 2;
2129         }
2130         if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
2131             packname = HvNAME(sep ? curcop->cop_stash : stash);
2132             packlen = strlen(packname);
2133         }
2134         else {
2135             packname = name;
2136             packlen = sep - name;
2137         }
2138         DIE("Can't locate object method \"%s\" via package \"%.*s\"",
2139             leaf, (int)packlen, packname);
2140     }
2141     SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv);
2142     RETURN;
2143 }