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