projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Pod typos, pod2man bugs, and miscellaneous installation comments
[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();
b328e6b9 347 gv_fullname(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();
b328e6b9 357 gv_fullname(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) {
1169 tainted = TRUE;
1170 SvTAINT(sv); /* Anything from the outside world...*/
1171 }
1172 if (type == OP_GLOB) {
1173 char *tmps;
1174
c07a80fd 1175 if (SvCUR(sv) > 0 && SvCUR(rs) > 0) {
1176 tmps = SvEND(sv) - 1;
1177 if (*tmps == *SvPVX(rs)) {
1178 *tmps = '\0';
1179 SvCUR(sv)--;
1180 }
1181 }
a0d0e21e 1182 for (tmps = SvPVX(sv); *tmps; tmps++)
1183 if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
1184 strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
1185 break;
1186 if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) {
1187 (void)POPs; /* Unmatched wildcard? Chuck it... */
1188 continue;
1189 }
1190 }
1191 if (GIMME == G_ARRAY) {
1192 if (SvLEN(sv) - SvCUR(sv) > 20) {
1193 SvLEN_set(sv, SvCUR(sv)+1);
1194 Renew(SvPVX(sv), SvLEN(sv), char);
1195 }
1196 sv = sv_2mortal(NEWSV(58, 80));
1197 continue;
1198 }
1199 else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
1200 /* try to reclaim a bit of scalar space (only on 1st alloc) */
1201 if (SvCUR(sv) < 60)
1202 SvLEN_set(sv, 80);
1203 else
1204 SvLEN_set(sv, SvCUR(sv)+40); /* allow some slop */
1205 Renew(SvPVX(sv), SvLEN(sv), char);
1206 }
1207 RETURN;
1208 }
1209}
1210
1211PP(pp_enter)
1212{
1213 dSP;
1214 register CONTEXT *cx;
1215 I32 gimme;
1216
1217 /*
1218 * We don't just use the GIMME macro here because it assumes there's
1219 * already a context, which ain't necessarily so at initial startup.
1220 */
1221
1222 if (op->op_flags & OPf_KNOW)
1223 gimme = op->op_flags & OPf_LIST;
1224 else if (cxstack_ix >= 0)
1225 gimme = cxstack[cxstack_ix].blk_gimme;
1226 else
1227 gimme = G_SCALAR;
1228
1229 ENTER;
1230
1231 SAVETMPS;
1232 PUSHBLOCK(cx, CXt_BLOCK, sp);
1233
1234 RETURN;
1235}
1236
1237PP(pp_helem)
1238{
1239 dSP;
760ac839 1240 HE* he;
a0d0e21e 1241 SV *keysv = POPs;
a0d0e21e 1242 HV *hv = (HV*)POPs;
1243 I32 lval = op->op_flags & OPf_MOD;
1244
1245 if (SvTYPE(hv) != SVt_PVHV)
1246 RETPUSHUNDEF;
760ac839 1247 he = hv_fetch_ent(hv, keysv, lval, 0);
a0d0e21e 1248 if (lval) {
760ac839 1249 if (!he || HeVAL(he) == &sv_undef)
1250 DIE(no_helem, SvPV(keysv, na));
a0d0e21e 1251 if (op->op_private & OPpLVAL_INTRO)
760ac839 1252 save_svref(&HeVAL(he));
02a9e968 1253 else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
760ac839 1254 provide_ref(op, HeVAL(he));
a0d0e21e 1255 }
760ac839 1256 PUSHs(he ? HeVAL(he) : &sv_undef);
a0d0e21e 1257 RETURN;
1258}
1259
1260PP(pp_leave)
1261{
1262 dSP;
1263 register CONTEXT *cx;
1264 register SV **mark;
1265 SV **newsp;
1266 PMOP *newpm;
1267 I32 gimme;
1268
1269 if (op->op_flags & OPf_SPECIAL) {
1270 cx = &cxstack[cxstack_ix];
1271 cx->blk_oldpm = curpm; /* fake block should preserve $1 et al */
1272 }
1273
1274 POPBLOCK(cx,newpm);
1275
1276 if (op->op_flags & OPf_KNOW)
1277 gimme = op->op_flags & OPf_LIST;
1278 else if (cxstack_ix >= 0)
1279 gimme = cxstack[cxstack_ix].blk_gimme;
1280 else
1281 gimme = G_SCALAR;
1282
1283 if (gimme == G_SCALAR) {
1284 if (op->op_private & OPpLEAVE_VOID)
1285 SP = newsp;
1286 else {
1287 MARK = newsp + 1;
1288 if (MARK <= SP)
1289 if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
1290 *MARK = TOPs;
1291 else
1292 *MARK = sv_mortalcopy(TOPs);
1293 else {
1294 MEXTEND(mark,0);
1295 *MARK = &sv_undef;
1296 }
1297 SP = MARK;
1298 }
1299 }
1300 else {
1301 for (mark = newsp + 1; mark <= SP; mark++)
1302 if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
1303 *mark = sv_mortalcopy(*mark);
1304 /* in case LEAVE wipes old return values */
1305 }
1306 curpm = newpm; /* Don't pop $1 et al till now */
1307
1308 LEAVE;
1309
1310 RETURN;
1311}
1312
1313PP(pp_iter)
1314{
1315 dSP;
1316 register CONTEXT *cx;
1317 SV *sv;
4633a7c4 1318 AV* av;
a0d0e21e 1319
1320 EXTEND(sp, 1);
1321 cx = &cxstack[cxstack_ix];
1322 if (cx->cx_type != CXt_LOOP)
1323 DIE("panic: pp_iter");
4633a7c4 1324 av = cx->blk_loop.iterary;
67955e0c 1325 if (av == curstack && cx->blk_loop.iterix >= cx->blk_oldsp)
4633a7c4 1326 RETPUSHNO;
a0d0e21e 1327
4633a7c4 1328 if (cx->blk_loop.iterix >= AvFILL(av))
a0d0e21e 1329 RETPUSHNO;
1330
4633a7c4 1331 if (sv = AvARRAY(av)[++cx->blk_loop.iterix]) {
a0d0e21e 1332 SvTEMP_off(sv);
1333 *cx->blk_loop.itervar = sv;
1334 }
1335 else
1336 *cx->blk_loop.itervar = &sv_undef;
1337
1338 RETPUSHYES;
1339}
1340
1341PP(pp_subst)
1342{
1343 dSP; dTARG;
1344 register PMOP *pm = cPMOP;
1345 PMOP *rpm = pm;
1346 register SV *dstr;
1347 register char *s;
1348 char *strend;
1349 register char *m;
1350 char *c;
1351 register char *d;
1352 STRLEN clen;
1353 I32 iters = 0;
1354 I32 maxiters;
1355 register I32 i;
1356 bool once;
1357 char *orig;
1358 I32 safebase;
1359 register REGEXP *rx = pm->op_pmregexp;
1360 STRLEN len;
1361 int force_on_match = 0;
4633a7c4 1362 I32 oldsave = savestack_ix;
a0d0e21e 1363
1364 if (pm->op_pmflags & PMf_CONST) /* known replacement string? */
1365 dstr = POPs;
1366 if (op->op_flags & OPf_STACKED)
1367 TARG = POPs;
1368 else {
1369 TARG = GvSV(defgv);
1370 EXTEND(SP,1);
1371 }
1372 s = SvPV(TARG, len);
8e07c86e 1373 if (!SvPOKp(TARG) || SvREADONLY(TARG) || (SvTYPE(TARG) == SVt_PVGV))
a0d0e21e 1374 force_on_match = 1;
1375
1376 force_it:
1377 if (!pm || !s)
1378 DIE("panic: do_subst");
1379
1380 strend = s + len;
1381 maxiters = (strend - s) + 10;
1382
1383 if (!rx->prelen && curpm) {
1384 pm = curpm;
1385 rx = pm->op_pmregexp;
1386 }
1387 safebase = ((!rx || !rx->nparens) && !sawampersand);
1388 if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
1389 SAVEINT(multiline);
1390 multiline = pm->op_pmflags & PMf_MULTILINE;
1391 }
1392 orig = m = s;
1393 if (pm->op_pmshort) {
1394 if (pm->op_pmflags & PMf_SCANFIRST) {
1395 if (SvSCREAM(TARG)) {
1396 if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
1397 goto nope;
1398 else if (!(s = screaminstr(TARG, pm->op_pmshort)))
1399 goto nope;
1400 }
1401 else if (!(s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
1402 pm->op_pmshort)))
1403 goto nope;
1404 if (s && rx->regback >= 0) {
1405 ++BmUSEFUL(pm->op_pmshort);
1406 s -= rx->regback;
1407 if (s < m)
1408 s = m;
1409 }
1410 else
1411 s = m;
1412 }
1413 else if (!multiline) {
1414 if (*SvPVX(pm->op_pmshort) != *s ||
236988e4 1415 memcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
a0d0e21e 1416 if (pm->op_pmflags & PMf_FOLD) {
1417 if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
1418 goto nope;
1419 }
1420 else
1421 goto nope;
1422 }
1423 }
1424 if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
1425 SvREFCNT_dec(pm->op_pmshort);
1426 pm->op_pmshort = Nullsv; /* opt is being useless */
1427 }
1428 }
1429 once = !(rpm->op_pmflags & PMf_GLOBAL);
1430 if (rpm->op_pmflags & PMf_CONST) { /* known replacement string? */
1431 c = SvPV(dstr, clen);
1432 if (clen <= rx->minlen) {
1433 /* can do inplace substitution */
e50aee73 1434 if (pregexec(rx, s, strend, orig, 0,
a0d0e21e 1435 SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
1436 if (force_on_match) {
1437 force_on_match = 0;
1438 s = SvPV_force(TARG, len);
1439 goto force_it;
1440 }
1441 if (rx->subbase) /* oops, no we can't */
1442 goto long_way;
1443 d = s;
1444 curpm = pm;
1445 SvSCREAM_off(TARG); /* disable possible screamer */
1446 if (once) {
1447 m = rx->startp[0];
1448 d = rx->endp[0];
1449 s = orig;
1450 if (m - s > strend - d) { /* faster to shorten from end */
1451 if (clen) {
1452 Copy(c, m, clen, char);
1453 m += clen;
1454 }
1455 i = strend - d;
1456 if (i > 0) {
1457 Move(d, m, i, char);
1458 m += i;
1459 }
1460 *m = '\0';
1461 SvCUR_set(TARG, m - s);
1462 (void)SvPOK_only(TARG);
1463 SvSETMAGIC(TARG);
1464 PUSHs(&sv_yes);
4633a7c4 1465 LEAVE_SCOPE(oldsave);
a0d0e21e 1466 RETURN;
1467 }
1468 /*SUPPRESS 560*/
1469 else if (i = m - s) { /* faster from front */
1470 d -= clen;
1471 m = d;
1472 sv_chop(TARG, d-i);
1473 s += i;
1474 while (i--)
1475 *--d = *--s;
1476 if (clen)
1477 Copy(c, m, clen, char);
1478 (void)SvPOK_only(TARG);
1479 SvSETMAGIC(TARG);
1480 PUSHs(&sv_yes);
4633a7c4 1481 LEAVE_SCOPE(oldsave);
a0d0e21e 1482 RETURN;
1483 }
1484 else if (clen) {
1485 d -= clen;
1486 sv_chop(TARG, d);
1487 Copy(c, d, clen, char);
1488 (void)SvPOK_only(TARG);
1489 SvSETMAGIC(TARG);
1490 PUSHs(&sv_yes);
4633a7c4 1491 LEAVE_SCOPE(oldsave);
a0d0e21e 1492 RETURN;
1493 }
1494 else {
1495 sv_chop(TARG, d);
1496 (void)SvPOK_only(TARG);
1497 SvSETMAGIC(TARG);
1498 PUSHs(&sv_yes);
4633a7c4 1499 LEAVE_SCOPE(oldsave);
a0d0e21e 1500 RETURN;
1501 }
1502 /* NOTREACHED */
1503 }
1504 do {
1505 if (iters++ > maxiters)
1506 DIE("Substitution loop");
1507 m = rx->startp[0];
1508 /*SUPPRESS 560*/
1509 if (i = m - s) {
1510 if (s != d)
1511 Move(s, d, i, char);
1512 d += i;
1513 }
1514 if (clen) {
1515 Copy(c, d, clen, char);
1516 d += clen;
1517 }
1518 s = rx->endp[0];
e50aee73 1519 } while (pregexec(rx, s, strend, orig, s == m,
a0d0e21e 1520 Nullsv, TRUE)); /* (don't match same null twice) */
1521 if (s != d) {
1522 i = strend - s;
1523 SvCUR_set(TARG, d - SvPVX(TARG) + i);
1524 Move(s, d, i+1, char); /* include the Null */
1525 }
1526 (void)SvPOK_only(TARG);
1527 SvSETMAGIC(TARG);
1528 PUSHs(sv_2mortal(newSViv((I32)iters)));
4633a7c4 1529 LEAVE_SCOPE(oldsave);
a0d0e21e 1530 RETURN;
1531 }
1532 PUSHs(&sv_no);
4633a7c4 1533 LEAVE_SCOPE(oldsave);
a0d0e21e 1534 RETURN;
1535 }
1536 }
1537 else
1538 c = Nullch;
e50aee73 1539 if (pregexec(rx, s, strend, orig, 0,
a0d0e21e 1540 SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
1541 long_way:
1542 if (force_on_match) {
1543 force_on_match = 0;
1544 s = SvPV_force(TARG, len);
1545 goto force_it;
1546 }
1547 dstr = NEWSV(25, sv_len(TARG));
1548 sv_setpvn(dstr, m, s-m);
1549 curpm = pm;
1550 if (!c) {
1551 register CONTEXT *cx;
1552 PUSHSUBST(cx);
1553 RETURNOP(cPMOP->op_pmreplroot);
1554 }
1555 do {
1556 if (iters++ > maxiters)
1557 DIE("Substitution loop");
1558 if (rx->subbase && rx->subbase != orig) {
1559 m = s;
1560 s = orig;
1561 orig = rx->subbase;
1562 s = orig + (m - s);
1563 strend = s + (strend - m);
1564 }
1565 m = rx->startp[0];
1566 sv_catpvn(dstr, s, m-s);
1567 s = rx->endp[0];
1568 if (clen)
1569 sv_catpvn(dstr, c, clen);
1570 if (once)
1571 break;
e50aee73 1572 } while (pregexec(rx, s, strend, orig, s == m, Nullsv,
a0d0e21e 1573 safebase));
1574 sv_catpvn(dstr, s, strend - s);
748a9306 1575
4633a7c4 1576 (void)SvOOK_off(TARG);
cb0b1708 1577 Safefree(SvPVX(TARG));
748a9306 1578 SvPVX(TARG) = SvPVX(dstr);
1579 SvCUR_set(TARG, SvCUR(dstr));
1580 SvLEN_set(TARG, SvLEN(dstr));
1581 SvPVX(dstr) = 0;
1582 sv_free(dstr);
1583
a0d0e21e 1584 (void)SvPOK_only(TARG);
1585 SvSETMAGIC(TARG);
1586 PUSHs(sv_2mortal(newSViv((I32)iters)));
4633a7c4 1587 LEAVE_SCOPE(oldsave);
a0d0e21e 1588 RETURN;
1589 }
1590 PUSHs(&sv_no);
4633a7c4 1591 LEAVE_SCOPE(oldsave);
a0d0e21e 1592 RETURN;
1593
1594nope:
1595 ++BmUSEFUL(pm->op_pmshort);
1596 PUSHs(&sv_no);
4633a7c4 1597 LEAVE_SCOPE(oldsave);
a0d0e21e 1598 RETURN;
1599}
1600
1601PP(pp_grepwhile)
1602{
1603 dSP;
1604
1605 if (SvTRUEx(POPs))
1606 stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
1607 ++*markstack_ptr;
1608 LEAVE; /* exit inner scope */
1609
1610 /* All done yet? */
1611 if (stack_base + *markstack_ptr > sp) {
1612 I32 items;
1613
1614 LEAVE; /* exit outer scope */
1615 (void)POPMARK; /* pop src */
1616 items = --*markstack_ptr - markstack_ptr[-1];
1617 (void)POPMARK; /* pop dst */
1618 SP = stack_base + POPMARK; /* pop original mark */
1619 if (GIMME != G_ARRAY) {
1620 dTARGET;
1621 XPUSHi(items);
1622 RETURN;
1623 }
1624 SP += items;
1625 RETURN;
1626 }
1627 else {
1628 SV *src;
1629
1630 ENTER; /* enter inner scope */
1631 SAVESPTR(curpm);
1632
1633 src = stack_base[*markstack_ptr];
1634 SvTEMP_off(src);
1635 GvSV(defgv) = src;
1636
1637 RETURNOP(cLOGOP->op_other);
1638 }
1639}
1640
1641PP(pp_leavesub)
1642{
1643 dSP;
1644 SV **mark;
1645 SV **newsp;
1646 PMOP *newpm;
1647 I32 gimme;
1648 register CONTEXT *cx;
1649
1650 POPBLOCK(cx,newpm);
1651 POPSUB(cx);
1652
1653 if (gimme == G_SCALAR) {
1654 MARK = newsp + 1;
1655 if (MARK <= SP)
1656 if (SvFLAGS(TOPs) & SVs_TEMP)
1657 *MARK = TOPs;
1658 else
1659 *MARK = sv_mortalcopy(TOPs);
1660 else {
1661 MEXTEND(mark,0);
1662 *MARK = &sv_undef;
1663 }
1664 SP = MARK;
1665 }
1666 else {
1667 for (mark = newsp + 1; mark <= SP; mark++)
1668 if (!(SvFLAGS(*mark) & SVs_TEMP))
1669 *mark = sv_mortalcopy(*mark);
1670 /* in case LEAVE wipes old return values */
1671 }
1672
1673 if (cx->blk_sub.hasargs) { /* You don't exist; go away. */
1674 AV* av = cx->blk_sub.argarray;
1675
1676 av_clear(av);
1677 AvREAL_off(av);
1678 }
1679 curpm = newpm; /* Don't pop $1 et al till now */
1680
1681 LEAVE;
1682 PUTBACK;
1683 return pop_return();
1684}
1685
1686PP(pp_entersub)
1687{
1688 dSP; dPOPss;
1689 GV *gv;
1690 HV *stash;
1691 register CV *cv;
1692 register CONTEXT *cx;
5d94fbed 1693 I32 gimme;
67955e0c 1694 I32 hasargs = (op->op_flags & OPf_STACKED) != 0;
a0d0e21e 1695
1696 if (!sv)
1697 DIE("Not a CODE reference");
1698 switch (SvTYPE(sv)) {
1699 default:
1700 if (!SvROK(sv)) {
748a9306 1701 char *sym;
1702
a0d0e21e 1703 if (sv == &sv_yes) /* unfound import, ignore */
1704 RETURN;
1705 if (!SvOK(sv))
1706 DIE(no_usym, "a subroutine");
748a9306 1707 sym = SvPV(sv,na);
a0d0e21e 1708 if (op->op_private & HINT_STRICT_REFS)
748a9306 1709 DIE(no_symref, sym, "a subroutine");
1710 cv = perl_get_cv(sym, TRUE);
a0d0e21e 1711 break;
1712 }
1713 cv = (CV*)SvRV(sv);
1714 if (SvTYPE(cv) == SVt_PVCV)
1715 break;
1716 /* FALL THROUGH */
1717 case SVt_PVHV:
1718 case SVt_PVAV:
1719 DIE("Not a CODE reference");
1720 case SVt_PVCV:
1721 cv = (CV*)sv;
1722 break;
1723 case SVt_PVGV:
1724 if (!(cv = GvCV((GV*)sv)))
1725 cv = sv_2cv(sv, &stash, &gv, TRUE);
1726 break;
1727 }
1728
1729 ENTER;
1730 SAVETMPS;
1731
1732 retry:
1733 if (!cv)
1734 DIE("Not a CODE reference");
1735
1736 if (!CvROOT(cv) && !CvXSUB(cv)) {
1737 if (gv = CvGV(cv)) {
4633a7c4 1738 SV *tmpstr;
a0d0e21e 1739 GV *ngv;
4633a7c4 1740 if (SvFAKE(cv) && GvCV(gv) != cv) { /* autoloaded stub? */
1741 cv = GvCV(gv);
1742 if (SvTYPE(sv) == SVt_PVGV) {
1743 SvREFCNT_dec(GvCV((GV*)sv));
1744 GvCV((GV*)sv) = (CV*)SvREFCNT_inc((SV*)cv);
1745 }
1746 goto retry;
1747 }
1748 tmpstr = sv_newmortal();
b328e6b9 1749 gv_efullname(tmpstr, gv, Nullch);
a0d0e21e 1750 ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD");
1751 if (ngv && ngv != gv && (cv = GvCV(ngv))) { /* One more chance... */
1752 gv = ngv;
1753 sv_setsv(GvSV(CvGV(cv)), tmpstr); /* Set CV's $AUTOLOAD */
c07a80fd 1754 if (tainting)
1755 sv_unmagic(GvSV(CvGV(cv)), 't');
a0d0e21e 1756 goto retry;
1757 }
1758 else
1759 DIE("Undefined subroutine &%s called",SvPVX(tmpstr));
1760 }
1761 DIE("Undefined subroutine called");
1762 }
1763
4633a7c4 1764 gimme = GIMME;
67955e0c 1765 if ((op->op_private & OPpENTERSUB_DB)) {
a0d0e21e 1766 sv = GvSV(DBsub);
1767 save_item(sv);
67955e0c 1768 gv = CvGV(cv);
1769 if ( CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)
1770 || strEQ(GvNAME(gv), "END") ) {
a5f75d66 1771 /* GV is potentially non-unique */
748a9306 1772 sv_setsv(sv, newRV((SV*)cv));
a5f75d66 1773 }
748a9306 1774 else {
b328e6b9 1775 gv_efullname(sv, gv, Nullch);
748a9306 1776 }
a0d0e21e 1777 cv = GvCV(DBsub);
67955e0c 1778 if (CvXSUB(cv)) curcopdb = curcop;
a0d0e21e 1779 if (!cv)
1780 DIE("No DBsub routine");
1781 }
1782
1783 if (CvXSUB(cv)) {
1784 if (CvOLDSTYLE(cv)) {
ecfc5424 1785 I32 (*fp3)_((int,int,int));
a0d0e21e 1786 dMARK;
1787 register I32 items = SP - MARK;
67955e0c 1788 /* We dont worry to copy from @_. */
a0d0e21e 1789 while (sp > mark) {
1790 sp[1] = sp[0];
1791 sp--;
1792 }
1793 stack_sp = mark + 1;
ecfc5424 1794 fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
1795 items = (*fp3)(CvXSUBANY(cv).any_i32,
1796 MARK - stack_base + 1,
1797 items);
a0d0e21e 1798 stack_sp = stack_base + items;
1799 }
1800 else {
748a9306 1801 I32 markix = TOPMARK;
1802
a0d0e21e 1803 PUTBACK;
67955e0c 1804
1805 if (!hasargs) {
1806 /* Need to copy @_ to stack. Alternative may be to
1807 * switch stack to @_, and copy return values
1808 * back. This would allow popping @_ in XSUB, e.g.. XXXX */
1809 AV* av = GvAV(defgv);
1810 I32 items = AvFILL(av) + 1;
1811
1812 if (items) {
1813 /* Mark is at the end of the stack. */
1814 EXTEND(sp, items);
1815 Copy(AvARRAY(av), sp + 1, items, SV*);
1816 sp += items;
1817 PUTBACK ;
1818 }
1819 }
1820 if (curcopdb) { /* We assume that the first
1821 XSUB in &DB::sub is the
1822 called one. */
1823 SAVESPTR(curcop);
1824 curcop = curcopdb;
1825 curcopdb = NULL;
1826 }
1827 /* Do we need to open block here? XXXX */
a0d0e21e 1828 (void)(*CvXSUB(cv))(cv);
748a9306 1829
1830 /* Enforce some sanity in scalar context. */
5d94fbed 1831 if (gimme == G_SCALAR && ++markix != stack_sp - stack_base ) {
748a9306 1832 if (markix > stack_sp - stack_base)
1833 *(stack_base + markix) = &sv_undef;
1834 else
1835 *(stack_base + markix) = *stack_sp;
1836 stack_sp = stack_base + markix;
1837 }
a0d0e21e 1838 }
1839 LEAVE;
1840 return NORMAL;
1841 }
1842 else {
1843 dMARK;
1844 register I32 items = SP - MARK;
a0d0e21e 1845 AV* padlist = CvPADLIST(cv);
1846 SV** svp = AvARRAY(padlist);
1847 push_return(op->op_next);
1848 PUSHBLOCK(cx, CXt_SUB, MARK);
1849 PUSHSUB(cx);
1850 CvDEPTH(cv)++;
1851 if (CvDEPTH(cv) < 2)
1852 (void)SvREFCNT_inc(cv);
1853 else { /* save temporaries on recursion? */
1854 if (CvDEPTH(cv) == 100 && dowarn)
1855 warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv)));
1856 if (CvDEPTH(cv) > AvFILL(padlist)) {
1857 AV *av;
1858 AV *newpad = newAV();
4aa0a1f7 1859 SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
a0d0e21e 1860 I32 ix = AvFILL((AV*)svp[1]);
1861 svp = AvARRAY(svp[0]);
748a9306 1862 for ( ;ix > 0; ix--) {
a0d0e21e 1863 if (svp[ix] != &sv_undef) {
748a9306 1864 char *name = SvPVX(svp[ix]);
1865 if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* outer lexical? */
1866 av_store(newpad, ix,
4aa0a1f7 1867 SvREFCNT_inc(oldpad[ix]) );
748a9306 1868 }
1869 else { /* our own lexical */
1870 if (*name == '@')
1871 av_store(newpad, ix, sv = (SV*)newAV());
1872 else if (*name == '%')
1873 av_store(newpad, ix, sv = (SV*)newHV());
1874 else
1875 av_store(newpad, ix, sv = NEWSV(0,0));
1876 SvPADMY_on(sv);
1877 }
a0d0e21e 1878 }
1879 else {
748a9306 1880 av_store(newpad, ix, sv = NEWSV(0,0));
a0d0e21e 1881 SvPADTMP_on(sv);
1882 }
1883 }
1884 av = newAV(); /* will be @_ */
1885 av_extend(av, 0);
1886 av_store(newpad, 0, (SV*)av);
1887 AvFLAGS(av) = AVf_REIFY;
1888 av_store(padlist, CvDEPTH(cv), (SV*)newpad);
1889 AvFILL(padlist) = CvDEPTH(cv);
1890 svp = AvARRAY(padlist);
1891 }
1892 }
1893 SAVESPTR(curpad);
1894 curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
1895 if (hasargs) {
1896 AV* av = (AV*)curpad[0];
1897 SV** ary;
1898
1899 if (AvREAL(av)) {
1900 av_clear(av);
1901 AvREAL_off(av);
1902 }
1903 cx->blk_sub.savearray = GvAV(defgv);
1904 cx->blk_sub.argarray = av;
1905 GvAV(defgv) = cx->blk_sub.argarray;
1906 ++MARK;
1907
1908 if (items > AvMAX(av) + 1) {
1909 ary = AvALLOC(av);
1910 if (AvARRAY(av) != ary) {
1911 AvMAX(av) += AvARRAY(av) - AvALLOC(av);
1912 SvPVX(av) = (char*)ary;
1913 }
1914 if (items > AvMAX(av) + 1) {
1915 AvMAX(av) = items - 1;
1916 Renew(ary,items,SV*);
1917 AvALLOC(av) = ary;
1918 SvPVX(av) = (char*)ary;
1919 }
1920 }
1921 Copy(MARK,AvARRAY(av),items,SV*);
1922 AvFILL(av) = items - 1;
1923
1924 while (items--) {
1925 if (*MARK)
1926 SvTEMP_off(*MARK);
1927 MARK++;
1928 }
1929 }
1930 RETURNOP(CvSTART(cv));
1931 }
1932}
1933
1934PP(pp_aelem)
1935{
1936 dSP;
1937 SV** svp;
748a9306 1938 I32 elem = POPi;
a0d0e21e 1939 AV *av = (AV*)POPs;
1940 I32 lval = op->op_flags & OPf_MOD;
1941
748a9306 1942 if (elem > 0)
1943 elem -= curcop->cop_arybase;
a0d0e21e 1944 if (SvTYPE(av) != SVt_PVAV)
1945 RETPUSHUNDEF;
1946 svp = av_fetch(av, elem, lval);
1947 if (lval) {
1948 if (!svp || *svp == &sv_undef)
1949 DIE(no_aelem, elem);
1950 if (op->op_private & OPpLVAL_INTRO)
1951 save_svref(svp);
02a9e968 1952 else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
1953 provide_ref(op, *svp);
a0d0e21e 1954 }
1955 PUSHs(svp ? *svp : &sv_undef);
1956 RETURN;
1957}
1958
02a9e968 1959void
1960provide_ref(op, sv)
1961OP* op;
1962SV* sv;
1963{
1964 if (SvGMAGICAL(sv))
1965 mg_get(sv);
1966 if (!SvOK(sv)) {
1967 if (SvREADONLY(sv))
1968 croak(no_modify);
1969 (void)SvUPGRADE(sv, SVt_RV);
1970 SvRV(sv) = (op->op_private & OPpDEREF_HV ?
1971 (SV*)newHV() : (SV*)newAV());
1972 SvROK_on(sv);
1973 SvSETMAGIC(sv);
1974 }
1975}
1976
a0d0e21e 1977PP(pp_method)
1978{
1979 dSP;
1980 SV* sv;
1981 SV* ob;
1982 GV* gv;
1983 SV* nm;
1984
1985 nm = TOPs;
1986 sv = *(stack_base + TOPMARK + 1);
1987
1988 gv = 0;
16d20bd9 1989 if (SvGMAGICAL(sv))
1990 mg_get(sv);
a0d0e21e 1991 if (SvROK(sv))
16d20bd9 1992 ob = (SV*)SvRV(sv);
a0d0e21e 1993 else {
1994 GV* iogv;
1995 char* packname = 0;
67955e0c 1996 STRLEN packlen;
a0d0e21e 1997
1998 if (!SvOK(sv) ||
67955e0c 1999 !(packname = SvPV(sv, packlen)) ||
a0d0e21e 2000 !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
2001 !(ob=(SV*)GvIO(iogv)))
2002 {
2003 char *name = SvPV(nm, na);
2004 HV *stash;
2005 if (!packname || !isALPHA(*packname))
2006DIE("Can't call method \"%s\" without a package or object reference", name);
67955e0c 2007 if (!(stash = gv_stashpvn(packname, packlen, FALSE))) {
2008 if (gv_stashpvn("UNIVERSAL", 9, FALSE))
2009 stash = gv_stashpvn(packname, packlen, TRUE);
a0d0e21e 2010 else
2011 DIE("Can't call method \"%s\" in empty package \"%s\"",
2012 name, packname);
2013 }
2014 gv = gv_fetchmethod(stash,name);
2015 if (!gv)
2016 DIE("Can't locate object method \"%s\" via package \"%s\"",
2017 name, packname);
67955e0c 2018 SETs((SV*)gv);
a0d0e21e 2019 RETURN;
2020 }
67955e0c 2021 *(stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
a0d0e21e 2022 }
2023
2024 if (!ob || !SvOBJECT(ob)) {
2025 char *name = SvPV(nm, na);
2026 DIE("Can't call method \"%s\" on unblessed reference", name);
2027 }
2028
2029 if (!gv) { /* nothing cached */
2030 char *name = SvPV(nm, na);
2031 gv = gv_fetchmethod(SvSTASH(ob),name);
2032 if (!gv)
2033 DIE("Can't locate object method \"%s\" via package \"%s\"",
2034 name, HvNAME(SvSTASH(ob)));
2035 }
2036
67955e0c 2037 SETs((SV*)gv);
a0d0e21e 2038 RETURN;
2039}
2040
Unnamed repository; edit this file to name it for gitweb.