This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In struct regexp replace the two arrays of I32s accessed via startp
[perl5.git] / pp_hot.c
CommitLineData
a0d0e21e
LW
1/* pp_hot.c
2 *
4bb101f2 3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
fdf8c088 4 * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
a0d0e21e
LW
5 *
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
8 *
9 */
10
11/*
12 * Then he heard Merry change the note, and up went the Horn-cry of Buckland,
13 * shaking the air.
14 *
15 * Awake! Awake! Fear, Fire, Foes! Awake!
16 * Fire, Foes! Awake!
17 */
18
166f8a29
DM
19/* This file contains 'hot' pp ("push/pop") functions that
20 * execute the opcodes that make up a perl program. A typical pp function
21 * expects to find its arguments on the stack, and usually pushes its
22 * results onto the stack, hence the 'pp' terminology. Each OP structure
23 * contains a pointer to the relevant pp_foo() function.
24 *
25 * By 'hot', we mean common ops whose execution speed is critical.
26 * By gathering them together into a single file, we encourage
27 * CPU cache hits on hot code. Also it could be taken as a warning not to
28 * change any code in this file unless you're sure it won't affect
29 * performance.
30 */
31
a0d0e21e 32#include "EXTERN.h"
864dbfa3 33#define PERL_IN_PP_HOT_C
a0d0e21e
LW
34#include "perl.h"
35
36/* Hot code. */
37
38PP(pp_const)
39{
97aff369 40 dVAR;
39644a26 41 dSP;
0282be92
RGS
42 if ( PL_op->op_flags & OPf_SPECIAL )
43 /* This is a const op added to hold the hints hash for
44 pp_entereval. The hash can be modified by the code
45 being eval'ed, so we return a copy instead. */
46 XPUSHs(sv_2mortal((SV*)Perl_hv_copy_hints_hv(aTHX_ (HV*)cSVOP_sv)));
47 else
48 /* Normal const. */
49 XPUSHs(cSVOP_sv);
a0d0e21e
LW
50 RETURN;
51}
52
53PP(pp_nextstate)
54{
97aff369 55 dVAR;
533c011a 56 PL_curcop = (COP*)PL_op;
a0d0e21e 57 TAINT_NOT; /* Each statement is presumed innocent */
3280af22 58 PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
a0d0e21e
LW
59 FREETMPS;
60 return NORMAL;
61}
62
63PP(pp_gvsv)
64{
97aff369 65 dVAR;
39644a26 66 dSP;
924508f0 67 EXTEND(SP,1);
533c011a 68 if (PL_op->op_private & OPpLVAL_INTRO)
1d7c1841 69 PUSHs(save_scalar(cGVOP_gv));
a0d0e21e 70 else
c69033f2 71 PUSHs(GvSVn(cGVOP_gv));
a0d0e21e
LW
72 RETURN;
73}
74
75PP(pp_null)
76{
97aff369 77 dVAR;
a0d0e21e
LW
78 return NORMAL;
79}
80
7399586d
HS
81PP(pp_setstate)
82{
97aff369 83 dVAR;
7399586d
HS
84 PL_curcop = (COP*)PL_op;
85 return NORMAL;
86}
87
a0d0e21e
LW
88PP(pp_pushmark)
89{
97aff369 90 dVAR;
3280af22 91 PUSHMARK(PL_stack_sp);
a0d0e21e
LW
92 return NORMAL;
93}
94
95PP(pp_stringify)
96{
97aff369 97 dVAR; dSP; dTARGET;
6050d10e 98 sv_copypv(TARG,TOPs);
a0d0e21e
LW
99 SETTARG;
100 RETURN;
101}
102
103PP(pp_gv)
104{
97aff369 105 dVAR; dSP;
1d7c1841 106 XPUSHs((SV*)cGVOP_gv);
a0d0e21e
LW
107 RETURN;
108}
109
110PP(pp_and)
111{
97aff369 112 dVAR; dSP;
a0d0e21e
LW
113 if (!SvTRUE(TOPs))
114 RETURN;
115 else {
c960fc3b
SP
116 if (PL_op->op_type == OP_AND)
117 --SP;
a0d0e21e
LW
118 RETURNOP(cLOGOP->op_other);
119 }
120}
121
122PP(pp_sassign)
123{
97aff369 124 dVAR; dSP; dPOPTOPssrl;
748a9306 125
533c011a 126 if (PL_op->op_private & OPpASSIGN_BACKWARDS) {
0bd48802
AL
127 SV * const temp = left;
128 left = right; right = temp;
a0d0e21e 129 }
952306ac
RGS
130 else if (PL_op->op_private & OPpASSIGN_STATE) {
131 if (SvPADSTALE(right))
132 SvPADSTALE_off(right);
133 else
134 RETURN; /* ignore assignment */
135 }
3280af22 136 if (PL_tainting && PL_tainted && !SvTAINTED(left))
a0d0e21e 137 TAINT_NOT;
e26df76a 138 if (PL_op->op_private & OPpASSIGN_CV_TO_GV) {
6136c704 139 SV * const cv = SvRV(left);
e26df76a
NC
140 const U32 cv_type = SvTYPE(cv);
141 const U32 gv_type = SvTYPE(right);
6136c704 142 const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM;
e26df76a
NC
143
144 if (!got_coderef) {
145 assert(SvROK(cv));
146 }
147
ae6d515f 148 /* Can do the optimisation if right (LVALUE) is not a typeglob,
e26df76a
NC
149 left (RVALUE) is a reference to something, and we're in void
150 context. */
151 if (!got_coderef && gv_type != SVt_PVGV && GIMME_V == G_VOID) {
152 /* Is the target symbol table currently empty? */
6136c704 153 GV * const gv = gv_fetchsv(right, GV_NOINIT, SVt_PVGV);
bb112e5a 154 if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) {
e26df76a
NC
155 /* Good. Create a new proxy constant subroutine in the target.
156 The gv becomes a(nother) reference to the constant. */
157 SV *const value = SvRV(cv);
158
159 SvUPGRADE((SV *)gv, SVt_RV);
1ccdb730 160 SvPCS_IMPORTED_on(gv);
e26df76a 161 SvRV_set(gv, value);
b37c2d43 162 SvREFCNT_inc_simple_void(value);
e26df76a
NC
163 SETs(right);
164 RETURN;
165 }
166 }
167
168 /* Need to fix things up. */
169 if (gv_type != SVt_PVGV) {
170 /* Need to fix GV. */
171 right = (SV*)gv_fetchsv(right, GV_ADD, SVt_PVGV);
172 }
173
174 if (!got_coderef) {
175 /* We've been returned a constant rather than a full subroutine,
176 but they expect a subroutine reference to apply. */
177 ENTER;
b37c2d43 178 SvREFCNT_inc_void(SvRV(cv));
e26df76a
NC
179 /* newCONSTSUB takes a reference count on the passed in SV
180 from us. We set the name to NULL, otherwise we get into
181 all sorts of fun as the reference to our new sub is
182 donated to the GV that we're about to assign to.
183 */
184 SvRV_set(left, (SV *)newCONSTSUB(GvSTASH(right), NULL,
185 SvRV(cv)));
186 SvREFCNT_dec(cv);
187 LEAVE;
e26df76a
NC
188 }
189
ae6d515f
RGS
190 if (strEQ(GvNAME(right),"isa")) {
191 GvCVGEN(right) = 0;
192 ++PL_sub_generation;
193 }
e26df76a 194 }
54310121 195 SvSetMagicSV(right, left);
a0d0e21e
LW
196 SETs(right);
197 RETURN;
198}
199
200PP(pp_cond_expr)
201{
97aff369 202 dVAR; dSP;
a0d0e21e 203 if (SvTRUEx(POPs))
1a67a97c 204 RETURNOP(cLOGOP->op_other);
a0d0e21e 205 else
1a67a97c 206 RETURNOP(cLOGOP->op_next);
a0d0e21e
LW
207}
208
209PP(pp_unstack)
210{
97aff369 211 dVAR;
a0d0e21e
LW
212 I32 oldsave;
213 TAINT_NOT; /* Each statement is presumed innocent */
3280af22 214 PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
a0d0e21e 215 FREETMPS;
3280af22 216 oldsave = PL_scopestack[PL_scopestack_ix - 1];
a0d0e21e
LW
217 LEAVE_SCOPE(oldsave);
218 return NORMAL;
219}
220
a0d0e21e
LW
221PP(pp_concat)
222{
97aff369 223 dVAR; dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
748a9306
LW
224 {
225 dPOPTOPssrl;
8d6d96c1
HS
226 bool lbyte;
227 STRLEN rlen;
d4c19fe8 228 const char *rpv = NULL;
a6b599c7 229 bool rbyte = FALSE;
a9c4fd4e 230 bool rcopied = FALSE;
8d6d96c1
HS
231
232 if (TARG == right && right != left) {
c75ab21a
RH
233 /* mg_get(right) may happen here ... */
234 rpv = SvPV_const(right, rlen);
235 rbyte = !DO_UTF8(right);
8d6d96c1 236 right = sv_2mortal(newSVpvn(rpv, rlen));
349d4f2f 237 rpv = SvPV_const(right, rlen); /* no point setting UTF-8 here */
db79b45b 238 rcopied = TRUE;
8d6d96c1 239 }
7889fe52 240
8d6d96c1 241 if (TARG != left) {
a9c4fd4e 242 STRLEN llen;
5c144d81 243 const char* const lpv = SvPV_const(left, llen); /* mg_get(left) may happen here */
90f5826e 244 lbyte = !DO_UTF8(left);
8d6d96c1
HS
245 sv_setpvn(TARG, lpv, llen);
246 if (!lbyte)
247 SvUTF8_on(TARG);
248 else
249 SvUTF8_off(TARG);
250 }
251 else { /* TARG == left */
a9c4fd4e 252 STRLEN llen;
5b295bef 253 SvGETMAGIC(left); /* or mg_get(left) may happen here */
c75ab21a
RH
254 if (!SvOK(TARG)) {
255 if (left == right && ckWARN(WARN_UNINITIALIZED))
256 report_uninit(right);
c69006e4 257 sv_setpvn(left, "", 0);
c75ab21a 258 }
10516c54 259 (void)SvPV_nomg_const(left, llen); /* Needed to set UTF8 flag */
90f5826e
ST
260 lbyte = !DO_UTF8(left);
261 if (IN_BYTES)
262 SvUTF8_off(TARG);
8d6d96c1 263 }
a12c0f56 264
c75ab21a
RH
265 /* or mg_get(right) may happen here */
266 if (!rcopied) {
267 rpv = SvPV_const(right, rlen);
268 rbyte = !DO_UTF8(right);
269 }
8d6d96c1
HS
270 if (lbyte != rbyte) {
271 if (lbyte)
272 sv_utf8_upgrade_nomg(TARG);
273 else {
db79b45b
JH
274 if (!rcopied)
275 right = sv_2mortal(newSVpvn(rpv, rlen));
8d6d96c1 276 sv_utf8_upgrade_nomg(right);
349d4f2f 277 rpv = SvPV_const(right, rlen);
69b47968 278 }
a0d0e21e 279 }
8d6d96c1 280 sv_catpvn_nomg(TARG, rpv, rlen);
43ebc500 281
a0d0e21e
LW
282 SETTARG;
283 RETURN;
748a9306 284 }
a0d0e21e
LW
285}
286
287PP(pp_padsv)
288{
97aff369 289 dVAR; dSP; dTARGET;
a0d0e21e 290 XPUSHs(TARG);
533c011a
NIS
291 if (PL_op->op_flags & OPf_MOD) {
292 if (PL_op->op_private & OPpLVAL_INTRO)
952306ac
RGS
293 if (!(PL_op->op_private & OPpPAD_STATE))
294 SAVECLEARSV(PAD_SVl(PL_op->op_targ));
a62b51b8 295 if (PL_op->op_private & OPpDEREF) {
8ec5e241 296 PUTBACK;
dd2155a4 297 vivify_ref(PAD_SVl(PL_op->op_targ), PL_op->op_private & OPpDEREF);
8ec5e241
NIS
298 SPAGAIN;
299 }
4633a7c4 300 }
a0d0e21e
LW
301 RETURN;
302}
303
304PP(pp_readline)
305{
97aff369 306 dVAR;
f5284f61 307 tryAMAGICunTARGET(iter, 0);
3280af22 308 PL_last_in_gv = (GV*)(*PL_stack_sp--);
8efb3254 309 if (SvTYPE(PL_last_in_gv) != SVt_PVGV) {
1c846c1f 310 if (SvROK(PL_last_in_gv) && SvTYPE(SvRV(PL_last_in_gv)) == SVt_PVGV)
f5284f61 311 PL_last_in_gv = (GV*)SvRV(PL_last_in_gv);
8efb3254 312 else {
f5284f61
IZ
313 dSP;
314 XPUSHs((SV*)PL_last_in_gv);
315 PUTBACK;
cea2e8a9 316 pp_rv2gv();
f5284f61 317 PL_last_in_gv = (GV*)(*PL_stack_sp--);
f5284f61
IZ
318 }
319 }
a0d0e21e
LW
320 return do_readline();
321}
322
323PP(pp_eq)
324{
97aff369 325 dVAR; dSP; tryAMAGICbinSET(eq,0);
4c9fe80f 326#ifndef NV_PRESERVES_UV
0bdaccee 327 if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
e61d22ef
NC
328 SP--;
329 SETs(boolSV(SvRV(TOPs) == SvRV(TOPp1s)));
4c9fe80f
AS
330 RETURN;
331 }
332#endif
28e5dec8
JH
333#ifdef PERL_PRESERVE_IVUV
334 SvIV_please(TOPs);
335 if (SvIOK(TOPs)) {
4c9fe80f
AS
336 /* Unless the left argument is integer in range we are going
337 to have to use NV maths. Hence only attempt to coerce the
338 right argument if we know the left is integer. */
28e5dec8
JH
339 SvIV_please(TOPm1s);
340 if (SvIOK(TOPm1s)) {
0bd48802
AL
341 const bool auvok = SvUOK(TOPm1s);
342 const bool buvok = SvUOK(TOPs);
a12c0f56 343
1605159e
NC
344 if (auvok == buvok) { /* ## IV == IV or UV == UV ## */
345 /* Casting IV to UV before comparison isn't going to matter
346 on 2s complement. On 1s complement or sign&magnitude
347 (if we have any of them) it could to make negative zero
348 differ from normal zero. As I understand it. (Need to
349 check - is negative zero implementation defined behaviour
350 anyway?). NWC */
0bd48802
AL
351 const UV buv = SvUVX(POPs);
352 const UV auv = SvUVX(TOPs);
28e5dec8 353
28e5dec8
JH
354 SETs(boolSV(auv == buv));
355 RETURN;
356 }
357 { /* ## Mixed IV,UV ## */
1605159e 358 SV *ivp, *uvp;
28e5dec8 359 IV iv;
28e5dec8 360
1605159e 361 /* == is commutative so doesn't matter which is left or right */
28e5dec8 362 if (auvok) {
1605159e
NC
363 /* top of stack (b) is the iv */
364 ivp = *SP;
365 uvp = *--SP;
366 } else {
367 uvp = *SP;
368 ivp = *--SP;
369 }
370 iv = SvIVX(ivp);
d4c19fe8 371 if (iv < 0)
1605159e
NC
372 /* As uv is a UV, it's >0, so it cannot be == */
373 SETs(&PL_sv_no);
d4c19fe8
AL
374 else
375 /* we know iv is >= 0 */
376 SETs(boolSV((UV)iv == SvUVX(uvp)));
28e5dec8
JH
377 RETURN;
378 }
379 }
380 }
381#endif
a0d0e21e 382 {
cab190d4
JD
383#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
384 dPOPTOPnnrl;
385 if (Perl_isnan(left) || Perl_isnan(right))
386 RETSETNO;
387 SETs(boolSV(left == right));
388#else
a0d0e21e 389 dPOPnv;
54310121 390 SETs(boolSV(TOPn == value));
cab190d4 391#endif
a0d0e21e
LW
392 RETURN;
393 }
394}
395
396PP(pp_preinc)
397{
97aff369 398 dVAR; dSP;
f39684df 399 if (SvTYPE(TOPs) >= SVt_PVGV && SvTYPE(TOPs) != SVt_PVLV)
d470f89e 400 DIE(aTHX_ PL_no_modify);
3510b4a1
NC
401 if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
402 && SvIVX(TOPs) != IV_MAX)
55497cff 403 {
45977657 404 SvIV_set(TOPs, SvIVX(TOPs) + 1);
55497cff 405 SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
748a9306 406 }
28e5dec8 407 else /* Do all the PERL_PRESERVE_IVUV conditionals in sv_inc */
748a9306 408 sv_inc(TOPs);
a0d0e21e
LW
409 SvSETMAGIC(TOPs);
410 return NORMAL;
411}
412
413PP(pp_or)
414{
97aff369 415 dVAR; dSP;
a0d0e21e
LW
416 if (SvTRUE(TOPs))
417 RETURN;
418 else {
c960fc3b
SP
419 if (PL_op->op_type == OP_OR)
420 --SP;
a0d0e21e
LW
421 RETURNOP(cLOGOP->op_other);
422 }
423}
424
25a55bd7 425PP(pp_defined)
c963b151 426{
97aff369 427 dVAR; dSP;
6136c704
AL
428 register SV* sv;
429 bool defined;
25a55bd7 430 const int op_type = PL_op->op_type;
ea5195b7 431 const bool is_dor = (op_type == OP_DOR || op_type == OP_DORASSIGN);
c963b151 432
6136c704 433 if (is_dor) {
25a55bd7
SP
434 sv = TOPs;
435 if (!sv || !SvANY(sv)) {
2bd49cfc
NC
436 if (op_type == OP_DOR)
437 --SP;
25a55bd7
SP
438 RETURNOP(cLOGOP->op_other);
439 }
440 } else if (op_type == OP_DEFINED) {
441 sv = POPs;
442 if (!sv || !SvANY(sv))
443 RETPUSHNO;
d9aa96a4 444 } else
52a5c517 445 DIE(aTHX_ "panic: Invalid op (%s) in pp_defined()", OP_NAME(PL_op));
25a55bd7 446
6136c704 447 defined = FALSE;
c963b151
BD
448 switch (SvTYPE(sv)) {
449 case SVt_PVAV:
450 if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
25a55bd7 451 defined = TRUE;
c963b151
BD
452 break;
453 case SVt_PVHV:
454 if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
25a55bd7 455 defined = TRUE;
c963b151
BD
456 break;
457 case SVt_PVCV:
458 if (CvROOT(sv) || CvXSUB(sv))
25a55bd7 459 defined = TRUE;
c963b151
BD
460 break;
461 default:
5b295bef 462 SvGETMAGIC(sv);
c963b151 463 if (SvOK(sv))
25a55bd7 464 defined = TRUE;
6136c704 465 break;
c963b151 466 }
6136c704
AL
467
468 if (is_dor) {
c960fc3b
SP
469 if(defined)
470 RETURN;
471 if(op_type == OP_DOR)
472 --SP;
25a55bd7 473 RETURNOP(cLOGOP->op_other);
25a55bd7 474 }
d9aa96a4
SP
475 /* assuming OP_DEFINED */
476 if(defined)
477 RETPUSHYES;
478 RETPUSHNO;
c963b151
BD
479}
480
a0d0e21e
LW
481PP(pp_add)
482{
97aff369 483 dVAR; dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN);
28e5dec8
JH
484 useleft = USE_LEFT(TOPm1s);
485#ifdef PERL_PRESERVE_IVUV
486 /* We must see if we can perform the addition with integers if possible,
487 as the integer code detects overflow while the NV code doesn't.
488 If either argument hasn't had a numeric conversion yet attempt to get
489 the IV. It's important to do this now, rather than just assuming that
490 it's not IOK as a PV of "9223372036854775806" may not take well to NV
491 addition, and an SV which is NOK, NV=6.0 ought to be coerced to
492 integer in case the second argument is IV=9223372036854775806
493 We can (now) rely on sv_2iv to do the right thing, only setting the
494 public IOK flag if the value in the NV (or PV) slot is truly integer.
495
496 A side effect is that this also aggressively prefers integer maths over
7dca457a
NC
497 fp maths for integer values.
498
a00b5bd3 499 How to detect overflow?
7dca457a
NC
500
501 C 99 section 6.2.6.1 says
502
503 The range of nonnegative values of a signed integer type is a subrange
504 of the corresponding unsigned integer type, and the representation of
505 the same value in each type is the same. A computation involving
506 unsigned operands can never overflow, because a result that cannot be
507 represented by the resulting unsigned integer type is reduced modulo
508 the number that is one greater than the largest value that can be
509 represented by the resulting type.
510
511 (the 9th paragraph)
512
513 which I read as "unsigned ints wrap."
514
515 signed integer overflow seems to be classed as "exception condition"
516
517 If an exceptional condition occurs during the evaluation of an
518 expression (that is, if the result is not mathematically defined or not
519 in the range of representable values for its type), the behavior is
520 undefined.
521
522 (6.5, the 5th paragraph)
523
524 I had assumed that on 2s complement machines signed arithmetic would
525 wrap, hence coded pp_add and pp_subtract on the assumption that
526 everything perl builds on would be happy. After much wailing and
527 gnashing of teeth it would seem that irix64 knows its ANSI spec well,
528 knows that it doesn't need to, and doesn't. Bah. Anyway, the all-
529 unsigned code below is actually shorter than the old code. :-)
530 */
531
28e5dec8
JH
532 SvIV_please(TOPs);
533 if (SvIOK(TOPs)) {
534 /* Unless the left argument is integer in range we are going to have to
535 use NV maths. Hence only attempt to coerce the right argument if
536 we know the left is integer. */
9c5ffd7c
JH
537 register UV auv = 0;
538 bool auvok = FALSE;
7dca457a
NC
539 bool a_valid = 0;
540
28e5dec8 541 if (!useleft) {
7dca457a
NC
542 auv = 0;
543 a_valid = auvok = 1;
544 /* left operand is undef, treat as zero. + 0 is identity,
545 Could SETi or SETu right now, but space optimise by not adding
546 lots of code to speed up what is probably a rarish case. */
547 } else {
548 /* Left operand is defined, so is it IV? */
549 SvIV_please(TOPm1s);
550 if (SvIOK(TOPm1s)) {
551 if ((auvok = SvUOK(TOPm1s)))
552 auv = SvUVX(TOPm1s);
553 else {
a3b680e6 554 register const IV aiv = SvIVX(TOPm1s);
7dca457a
NC
555 if (aiv >= 0) {
556 auv = aiv;
557 auvok = 1; /* Now acting as a sign flag. */
558 } else { /* 2s complement assumption for IV_MIN */
559 auv = (UV)-aiv;
560 }
561 }
562 a_valid = 1;
28e5dec8
JH
563 }
564 }
7dca457a
NC
565 if (a_valid) {
566 bool result_good = 0;
567 UV result;
568 register UV buv;
28e5dec8 569 bool buvok = SvUOK(TOPs);
a00b5bd3 570
7dca457a
NC
571 if (buvok)
572 buv = SvUVX(TOPs);
573 else {
a3b680e6 574 register const IV biv = SvIVX(TOPs);
7dca457a
NC
575 if (biv >= 0) {
576 buv = biv;
577 buvok = 1;
578 } else
579 buv = (UV)-biv;
580 }
581 /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
602f51c4 582 else "IV" now, independent of how it came in.
7dca457a
NC
583 if a, b represents positive, A, B negative, a maps to -A etc
584 a + b => (a + b)
585 A + b => -(a - b)
586 a + B => (a - b)
587 A + B => -(a + b)
588 all UV maths. negate result if A negative.
589 add if signs same, subtract if signs differ. */
590
591 if (auvok ^ buvok) {
592 /* Signs differ. */
593 if (auv >= buv) {
594 result = auv - buv;
595 /* Must get smaller */
596 if (result <= auv)
597 result_good = 1;
598 } else {
599 result = buv - auv;
600 if (result <= buv) {
601 /* result really should be -(auv-buv). as its negation
602 of true value, need to swap our result flag */
603 auvok = !auvok;
604 result_good = 1;
28e5dec8
JH
605 }
606 }
7dca457a
NC
607 } else {
608 /* Signs same */
609 result = auv + buv;
610 if (result >= auv)
611 result_good = 1;
612 }
613 if (result_good) {
614 SP--;
615 if (auvok)
28e5dec8 616 SETu( result );
7dca457a
NC
617 else {
618 /* Negate result */
619 if (result <= (UV)IV_MIN)
620 SETi( -(IV)result );
621 else {
622 /* result valid, but out of range for IV. */
623 SETn( -(NV)result );
28e5dec8
JH
624 }
625 }
7dca457a
NC
626 RETURN;
627 } /* Overflow, drop through to NVs. */
28e5dec8
JH
628 }
629 }
630#endif
a0d0e21e 631 {
28e5dec8
JH
632 dPOPnv;
633 if (!useleft) {
634 /* left operand is undef, treat as zero. + 0.0 is identity. */
635 SETn(value);
636 RETURN;
637 }
638 SETn( value + TOPn );
639 RETURN;
a0d0e21e
LW
640 }
641}
642
643PP(pp_aelemfast)
644{
97aff369 645 dVAR; dSP;
c445ea15 646 AV * const av = PL_op->op_flags & OPf_SPECIAL ?
6a077020 647 (AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv);
a3b680e6 648 const U32 lval = PL_op->op_flags & OPf_MOD;
0bd48802 649 SV** const svp = av_fetch(av, PL_op->op_private, lval);
3280af22 650 SV *sv = (svp ? *svp : &PL_sv_undef);
6ff81951 651 EXTEND(SP, 1);
be6c24e0
GS
652 if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */
653 sv = sv_mortalcopy(sv);
654 PUSHs(sv);
a0d0e21e
LW
655 RETURN;
656}
657
658PP(pp_join)
659{
97aff369 660 dVAR; dSP; dMARK; dTARGET;
a0d0e21e
LW
661 MARK++;
662 do_join(TARG, *MARK, MARK, SP);
663 SP = MARK;
664 SETs(TARG);
665 RETURN;
666}
667
668PP(pp_pushre)
669{
97aff369 670 dVAR; dSP;
44a8e56a
PP
671#ifdef DEBUGGING
672 /*
673 * We ass_u_me that LvTARGOFF() comes first, and that two STRLENs
674 * will be enough to hold an OP*.
675 */
c4420975 676 SV* const sv = sv_newmortal();
44a8e56a
PP
677 sv_upgrade(sv, SVt_PVLV);
678 LvTYPE(sv) = '/';
533c011a 679 Copy(&PL_op, &LvTARGOFF(sv), 1, OP*);
44a8e56a
PP
680 XPUSHs(sv);
681#else
6b88bc9c 682 XPUSHs((SV*)PL_op);
44a8e56a 683#endif
a0d0e21e
LW
684 RETURN;
685}
686
687/* Oversized hot code. */
688
689PP(pp_print)
690{
27da23d5 691 dVAR; dSP; dMARK; dORIGMARK;
a0d0e21e 692 IO *io;
760ac839 693 register PerlIO *fp;
236988e4 694 MAGIC *mg;
0bd48802 695 GV * const gv = (PL_op->op_flags & OPf_STACKED) ? (GV*)*++MARK : PL_defoutgv;
5b468f54
AMS
696
697 if (gv && (io = GvIO(gv))
698 && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
699 {
01bb7c6d 700 had_magic:
68dc0745 701 if (MARK == ORIGMARK) {
1c846c1f 702 /* If using default handle then we need to make space to
a60c0954
NIS
703 * pass object as 1st arg, so move other args up ...
704 */
4352c267 705 MEXTEND(SP, 1);
68dc0745
PP
706 ++MARK;
707 Move(MARK, MARK + 1, (SP - MARK) + 1, SV*);
708 ++SP;
709 }
710 PUSHMARK(MARK - 1);
5b468f54 711 *MARK = SvTIED_obj((SV*)io, mg);
68dc0745 712 PUTBACK;
236988e4 713 ENTER;
864dbfa3 714 call_method("PRINT", G_SCALAR);
236988e4
PP
715 LEAVE;
716 SPAGAIN;
68dc0745
PP
717 MARK = ORIGMARK + 1;
718 *MARK = *SP;
719 SP = MARK;
236988e4
PP
720 RETURN;
721 }
a0d0e21e 722 if (!(io = GvIO(gv))) {
5b468f54
AMS
723 if ((GvEGV(gv)) && (io = GvIO(GvEGV(gv)))
724 && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)))
01bb7c6d 725 goto had_magic;
2dd78f96
JH
726 if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
727 report_evil_fh(gv, io, PL_op->op_type);
93189314 728 SETERRNO(EBADF,RMS_IFI);
a0d0e21e
LW
729 goto just_say_no;
730 }
731 else if (!(fp = IoOFP(io))) {
599cee73 732 if (ckWARN2(WARN_CLOSED, WARN_IO)) {
4c80c0b2
NC
733 if (IoIFP(io))
734 report_evil_fh(gv, io, OP_phoney_INPUT_ONLY);
2dd78f96 735 else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
bc37a18f 736 report_evil_fh(gv, io, PL_op->op_type);
a0d0e21e 737 }
93189314 738 SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI);
a0d0e21e
LW
739 goto just_say_no;
740 }
741 else {
742 MARK++;
7889fe52 743 if (PL_ofs_sv && SvOK(PL_ofs_sv)) {
a0d0e21e
LW
744 while (MARK <= SP) {
745 if (!do_print(*MARK, fp))
746 break;
747 MARK++;
748 if (MARK <= SP) {
7889fe52 749 if (!do_print(PL_ofs_sv, fp)) { /* $, */
a0d0e21e
LW
750 MARK--;
751 break;
752 }
753 }
754 }
755 }
756 else {
757 while (MARK <= SP) {
758 if (!do_print(*MARK, fp))
759 break;
760 MARK++;
761 }
762 }
763 if (MARK <= SP)
764 goto just_say_no;
765 else {
cfc4a7da
GA
766 if (PL_op->op_type == OP_SAY) {
767 if (PerlIO_write(fp, "\n", 1) == 0 || PerlIO_error(fp))
768 goto just_say_no;
769 }
770 else if (PL_ors_sv && SvOK(PL_ors_sv))
7889fe52 771 if (!do_print(PL_ors_sv, fp)) /* $\ */
a0d0e21e
LW
772 goto just_say_no;
773
774 if (IoFLAGS(io) & IOf_FLUSH)
760ac839 775 if (PerlIO_flush(fp) == EOF)
a0d0e21e
LW
776 goto just_say_no;
777 }
778 }
779 SP = ORIGMARK;
e52fd6f4 780 XPUSHs(&PL_sv_yes);
a0d0e21e
LW
781 RETURN;
782
783 just_say_no:
784 SP = ORIGMARK;
e52fd6f4 785 XPUSHs(&PL_sv_undef);
a0d0e21e
LW
786 RETURN;
787}
788
789PP(pp_rv2av)
790{
97aff369 791 dVAR; dSP; dTOPss;
cde874ca 792 const I32 gimme = GIMME_V;
17ab7946
NC
793 static const char return_array_to_lvalue_scalar[] = "Can't return array to lvalue scalar context";
794 static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context";
795 static const char an_array[] = "an ARRAY";
796 static const char a_hash[] = "a HASH";
797 const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV;
d83b45b8 798 const svtype type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV;
a0d0e21e
LW
799
800 if (SvROK(sv)) {
801 wasref:
17ab7946 802 tryAMAGICunDEREF_var(is_pp_rv2av ? to_av_amg : to_hv_amg);
f5284f61 803
17ab7946
NC
804 sv = SvRV(sv);
805 if (SvTYPE(sv) != type)
806 DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash);
533c011a 807 if (PL_op->op_flags & OPf_REF) {
17ab7946 808 SETs(sv);
a0d0e21e
LW
809 RETURN;
810 }
78f9721b 811 else if (LVRET) {
cde874ca 812 if (gimme != G_ARRAY)
17ab7946
NC
813 Perl_croak(aTHX_ is_pp_rv2av ? return_array_to_lvalue_scalar
814 : return_hash_to_lvalue_scalar);
815 SETs(sv);
78f9721b
SM
816 RETURN;
817 }
82d03984
RGS
818 else if (PL_op->op_flags & OPf_MOD
819 && PL_op->op_private & OPpLVAL_INTRO)
820 Perl_croak(aTHX_ PL_no_localize_ref);
a0d0e21e
LW
821 }
822 else {
17ab7946 823 if (SvTYPE(sv) == type) {
533c011a 824 if (PL_op->op_flags & OPf_REF) {
17ab7946 825 SETs(sv);
a0d0e21e
LW
826 RETURN;
827 }
78f9721b 828 else if (LVRET) {
cde874ca 829 if (gimme != G_ARRAY)
17ab7946
NC
830 Perl_croak(aTHX_
831 is_pp_rv2av ? return_array_to_lvalue_scalar
832 : return_hash_to_lvalue_scalar);
833 SETs(sv);
78f9721b
SM
834 RETURN;
835 }
a0d0e21e
LW
836 }
837 else {
67955e0c 838 GV *gv;
1c846c1f 839
a0d0e21e
LW
840 if (SvTYPE(sv) != SVt_PVGV) {
841 if (SvGMAGICAL(sv)) {
842 mg_get(sv);
843 if (SvROK(sv))
844 goto wasref;
845 }
dc3c76f8
NC
846 gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash,
847 type, &sp);
848 if (!gv)
849 RETURN;
35cd451c
GS
850 }
851 else {
67955e0c 852 gv = (GV*)sv;
a0d0e21e 853 }
17ab7946 854 sv = is_pp_rv2av ? (SV*)GvAVn(gv) : (SV*)GvHVn(gv);
533c011a 855 if (PL_op->op_private & OPpLVAL_INTRO)
17ab7946 856 sv = is_pp_rv2av ? (SV*)save_ary(gv) : (SV*)save_hash(gv);
533c011a 857 if (PL_op->op_flags & OPf_REF) {
17ab7946 858 SETs(sv);
a0d0e21e
LW
859 RETURN;
860 }
78f9721b 861 else if (LVRET) {
cde874ca 862 if (gimme != G_ARRAY)
17ab7946
NC
863 Perl_croak(aTHX_
864 is_pp_rv2av ? return_array_to_lvalue_scalar
865 : return_hash_to_lvalue_scalar);
866 SETs(sv);
78f9721b
SM
867 RETURN;
868 }
a0d0e21e
LW
869 }
870 }
871
17ab7946
NC
872 if (is_pp_rv2av) {
873 AV *const av = (AV*)sv;
874 /* The guts of pp_rv2av, with no intenting change to preserve history
875 (until such time as we get tools that can do blame annotation across
876 whitespace changes. */
cde874ca 877 if (gimme == G_ARRAY) {
a3b680e6 878 const I32 maxarg = AvFILL(av) + 1;
c2444246 879 (void)POPs; /* XXXX May be optimized away? */
1c846c1f 880 EXTEND(SP, maxarg);
93965878 881 if (SvRMAGICAL(av)) {
1c846c1f 882 U32 i;
eb160463 883 for (i=0; i < (U32)maxarg; i++) {
0bcc34c2 884 SV ** const svp = av_fetch(av, i, FALSE);
547d1dd8
HS
885 /* See note in pp_helem, and bug id #27839 */
886 SP[i+1] = svp
887 ? SvGMAGICAL(*svp) ? sv_mortalcopy(*svp) : *svp
888 : &PL_sv_undef;
93965878 889 }
1c846c1f 890 }
93965878
NIS
891 else {
892 Copy(AvARRAY(av), SP+1, maxarg, SV*);
893 }
a0d0e21e
LW
894 SP += maxarg;
895 }
cde874ca 896 else if (gimme == G_SCALAR) {
a0d0e21e 897 dTARGET;
a3b680e6 898 const I32 maxarg = AvFILL(av) + 1;
f5284f61 899 SETi(maxarg);
a0d0e21e 900 }
17ab7946
NC
901 } else {
902 /* The guts of pp_rv2hv */
be85d344 903 if (gimme == G_ARRAY) { /* array wanted */
17ab7946 904 *PL_stack_sp = sv;
cea2e8a9 905 return do_kv();
a0d0e21e 906 }
be85d344 907 else if (gimme == G_SCALAR) {
a0d0e21e 908 dTARGET;
17ab7946 909 TARG = Perl_hv_scalar(aTHX_ (HV*)sv);
5e17dd7d 910 SPAGAIN;
a0d0e21e 911 SETTARG;
a0d0e21e 912 }
17ab7946 913 }
be85d344 914 RETURN;
a0d0e21e
LW
915}
916
10c8fecd
GS
917STATIC void
918S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
919{
97aff369 920 dVAR;
10c8fecd
GS
921 if (*relem) {
922 SV *tmpstr;
b464bac0 923 const HE *didstore;
6d822dc4
MS
924
925 if (ckWARN(WARN_MISC)) {
a3b680e6 926 const char *err;
10c8fecd
GS
927 if (relem == firstrelem &&
928 SvROK(*relem) &&
929 (SvTYPE(SvRV(*relem)) == SVt_PVAV ||
930 SvTYPE(SvRV(*relem)) == SVt_PVHV))
931 {
a3b680e6 932 err = "Reference found where even-sized list expected";
10c8fecd
GS
933 }
934 else
a3b680e6
AL
935 err = "Odd number of elements in hash assignment";
936 Perl_warner(aTHX_ packWARN(WARN_MISC), err);
10c8fecd 937 }
6d822dc4 938
561b68a9 939 tmpstr = newSV(0);
6d822dc4
MS
940 didstore = hv_store_ent(hash,*relem,tmpstr,0);
941 if (SvMAGICAL(hash)) {
942 if (SvSMAGICAL(tmpstr))
943 mg_set(tmpstr);
944 if (!didstore)
945 sv_2mortal(tmpstr);
946 }
947 TAINT_NOT;
10c8fecd
GS
948 }
949}
950
a0d0e21e
LW
951PP(pp_aassign)
952{
27da23d5 953 dVAR; dSP;
3280af22
NIS
954 SV **lastlelem = PL_stack_sp;
955 SV **lastrelem = PL_stack_base + POPMARK;
956 SV **firstrelem = PL_stack_base + POPMARK + 1;
a0d0e21e
LW
957 SV **firstlelem = lastrelem + 1;
958
959 register SV **relem;
960 register SV **lelem;
961
962 register SV *sv;
963 register AV *ary;
964
54310121 965 I32 gimme;
a0d0e21e
LW
966 HV *hash;
967 I32 i;
968 int magic;
ca65944e 969 int duplicates = 0;
cbbf8932 970 SV **firsthashrelem = NULL; /* "= 0" keeps gcc 2.95 quiet */
5637b936 971
a0d0e21e 972
3280af22 973 PL_delaymagic = DM_DELAY; /* catch simultaneous items */
ca65944e 974 gimme = GIMME_V;
a0d0e21e
LW
975
976 /* If there's a common identifier on both sides we have to take
977 * special care that assigning the identifier on the left doesn't
978 * clobber a value on the right that's used later in the list.
979 */
10c8fecd 980 if (PL_op->op_private & (OPpASSIGN_COMMON)) {
cc5e57d2 981 EXTEND_MORTAL(lastrelem - firstrelem + 1);
10c8fecd 982 for (relem = firstrelem; relem <= lastrelem; relem++) {
155aba94 983 if ((sv = *relem)) {
a1f49e72 984 TAINT_NOT; /* Each item is independent */
10c8fecd 985 *relem = sv_mortalcopy(sv);
a1f49e72 986 }
10c8fecd 987 }
a0d0e21e 988 }
461824dc
RGS
989 if (PL_op->op_private & OPpASSIGN_STATE) {
990 if (SvPADSTALE(*firstlelem))
991 SvPADSTALE_off(*firstlelem);
992 else
993 RETURN; /* ignore assignment */
994 }
a0d0e21e
LW
995
996 relem = firstrelem;
997 lelem = firstlelem;
4608196e
RGS
998 ary = NULL;
999 hash = NULL;
10c8fecd 1000
a0d0e21e 1001 while (lelem <= lastlelem) {
bbce6d69 1002 TAINT_NOT; /* Each item stands on its own, taintwise. */
a0d0e21e
LW
1003 sv = *lelem++;
1004 switch (SvTYPE(sv)) {
1005 case SVt_PVAV:
1006 ary = (AV*)sv;
748a9306 1007 magic = SvMAGICAL(ary) != 0;
a0d0e21e 1008 av_clear(ary);
7e42bd57 1009 av_extend(ary, lastrelem - relem);
a0d0e21e
LW
1010 i = 0;
1011 while (relem <= lastrelem) { /* gobble up all the rest */
5117ca91 1012 SV **didstore;
a0d0e21e 1013 assert(*relem);
f2b990bf 1014 sv = newSVsv(*relem);
a0d0e21e 1015 *(relem++) = sv;
5117ca91
GS
1016 didstore = av_store(ary,i++,sv);
1017 if (magic) {
fb73857a
PP
1018 if (SvSMAGICAL(sv))
1019 mg_set(sv);
5117ca91 1020 if (!didstore)
8127e0e3 1021 sv_2mortal(sv);
5117ca91 1022 }
bbce6d69 1023 TAINT_NOT;
a0d0e21e
LW
1024 }
1025 break;
10c8fecd 1026 case SVt_PVHV: { /* normal hash */
a0d0e21e
LW
1027 SV *tmpstr;
1028
1029 hash = (HV*)sv;
748a9306 1030 magic = SvMAGICAL(hash) != 0;
a0d0e21e 1031 hv_clear(hash);
ca65944e 1032 firsthashrelem = relem;
a0d0e21e
LW
1033
1034 while (relem < lastrelem) { /* gobble up all the rest */
5117ca91 1035 HE *didstore;
6136c704
AL
1036 sv = *relem ? *relem : &PL_sv_no;
1037 relem++;
561b68a9 1038 tmpstr = newSV(0);
a0d0e21e
LW
1039 if (*relem)
1040 sv_setsv(tmpstr,*relem); /* value */
1041 *(relem++) = tmpstr;
ca65944e
RGS
1042 if (gimme != G_VOID && hv_exists_ent(hash, sv, 0))
1043 /* key overwrites an existing entry */
1044 duplicates += 2;
5117ca91
GS
1045 didstore = hv_store_ent(hash,sv,tmpstr,0);
1046 if (magic) {
fb73857a
PP
1047 if (SvSMAGICAL(tmpstr))
1048 mg_set(tmpstr);
5117ca91 1049 if (!didstore)
8127e0e3 1050 sv_2mortal(tmpstr);
5117ca91 1051 }
bbce6d69 1052 TAINT_NOT;
8e07c86e 1053 }
6a0deba8 1054 if (relem == lastrelem) {
10c8fecd 1055 do_oddball(hash, relem, firstrelem);
6a0deba8 1056 relem++;
1930e939 1057 }
a0d0e21e
LW
1058 }
1059 break;
1060 default:
6fc92669
GS
1061 if (SvIMMORTAL(sv)) {
1062 if (relem <= lastrelem)
1063 relem++;
1064 break;
a0d0e21e
LW
1065 }
1066 if (relem <= lastrelem) {
1067 sv_setsv(sv, *relem);
1068 *(relem++) = sv;
1069 }
1070 else
3280af22 1071 sv_setsv(sv, &PL_sv_undef);
a0d0e21e
LW
1072 SvSETMAGIC(sv);
1073 break;
1074 }
1075 }
3280af22
NIS
1076 if (PL_delaymagic & ~DM_DELAY) {
1077 if (PL_delaymagic & DM_UID) {
a0d0e21e 1078#ifdef HAS_SETRESUID
fb934a90
RD
1079 (void)setresuid((PL_delaymagic & DM_RUID) ? PL_uid : (Uid_t)-1,
1080 (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1,
1081 (Uid_t)-1);
56febc5e
AD
1082#else
1083# ifdef HAS_SETREUID
fb934a90
RD
1084 (void)setreuid((PL_delaymagic & DM_RUID) ? PL_uid : (Uid_t)-1,
1085 (PL_delaymagic & DM_EUID) ? PL_euid : (Uid_t)-1);
56febc5e
AD
1086# else
1087# ifdef HAS_SETRUID
b28d0864
NIS
1088 if ((PL_delaymagic & DM_UID) == DM_RUID) {
1089 (void)setruid(PL_uid);
1090 PL_delaymagic &= ~DM_RUID;
a0d0e21e 1091 }
56febc5e
AD
1092# endif /* HAS_SETRUID */
1093# ifdef HAS_SETEUID
b28d0864 1094 if ((PL_delaymagic & DM_UID) == DM_EUID) {
fb934a90 1095 (void)seteuid(PL_euid);
b28d0864 1096 PL_delaymagic &= ~DM_EUID;
a0d0e21e 1097 }
56febc5e 1098# endif /* HAS_SETEUID */
b28d0864
NIS
1099 if (PL_delaymagic & DM_UID) {
1100 if (PL_uid != PL_euid)
cea2e8a9 1101 DIE(aTHX_ "No setreuid available");
b28d0864 1102 (void)PerlProc_setuid(PL_uid);
a0d0e21e 1103 }
56febc5e
AD
1104# endif /* HAS_SETREUID */
1105#endif /* HAS_SETRESUID */
d8eceb89
JH
1106 PL_uid = PerlProc_getuid();
1107 PL_euid = PerlProc_geteuid();
a0d0e21e 1108 }
3280af22 1109 if (PL_delaymagic & DM_GID) {
a0d0e21e 1110#ifdef HAS_SETRESGID
fb934a90
RD
1111 (void)setresgid((PL_delaymagic & DM_RGID) ? PL_gid : (Gid_t)-1,
1112 (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1,
1113 (Gid_t)-1);
56febc5e
AD
1114#else
1115# ifdef HAS_SETREGID
fb934a90
RD
1116 (void)setregid((PL_delaymagic & DM_RGID) ? PL_gid : (Gid_t)-1,
1117 (PL_delaymagic & DM_EGID) ? PL_egid : (Gid_t)-1);
56febc5e
AD
1118# else
1119# ifdef HAS_SETRGID
b28d0864
NIS
1120 if ((PL_delaymagic & DM_GID) == DM_RGID) {
1121 (void)setrgid(PL_gid);
1122 PL_delaymagic &= ~DM_RGID;
a0d0e21e 1123 }
56febc5e
AD
1124# endif /* HAS_SETRGID */
1125# ifdef HAS_SETEGID
b28d0864 1126 if ((PL_delaymagic & DM_GID) == DM_EGID) {
fb934a90 1127 (void)setegid(PL_egid);
b28d0864 1128 PL_delaymagic &= ~DM_EGID;
a0d0e21e 1129 }
56febc5e 1130# endif /* HAS_SETEGID */
b28d0864
NIS
1131 if (PL_delaymagic & DM_GID) {
1132 if (PL_gid != PL_egid)
cea2e8a9 1133 DIE(aTHX_ "No setregid available");
b28d0864 1134 (void)PerlProc_setgid(PL_gid);
a0d0e21e 1135 }
56febc5e
AD
1136# endif /* HAS_SETREGID */
1137#endif /* HAS_SETRESGID */
d8eceb89
JH
1138 PL_gid = PerlProc_getgid();
1139 PL_egid = PerlProc_getegid();
a0d0e21e 1140 }
3280af22 1141 PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid));
a0d0e21e 1142 }
3280af22 1143 PL_delaymagic = 0;
54310121 1144
54310121
PP
1145 if (gimme == G_VOID)
1146 SP = firstrelem - 1;
1147 else if (gimme == G_SCALAR) {
1148 dTARGET;
1149 SP = firstrelem;
ca65944e 1150 SETi(lastrelem - firstrelem + 1 - duplicates);
54310121
PP
1151 }
1152 else {
ca65944e 1153 if (ary)
a0d0e21e 1154 SP = lastrelem;
ca65944e
RGS
1155 else if (hash) {
1156 if (duplicates) {
1157 /* Removes from the stack the entries which ended up as
1158 * duplicated keys in the hash (fix for [perl #24380]) */
1159 Move(firsthashrelem + duplicates,
1160 firsthashrelem, duplicates, SV**);
1161 lastrelem -= duplicates;
1162 }
1163 SP = lastrelem;
1164 }
a0d0e21e
LW
1165 else
1166 SP = firstrelem + (lastlelem - firstlelem);
0c8c7a05 1167 lelem = firstlelem + (relem - firstrelem);
5f05dabc 1168 while (relem <= SP)
3280af22 1169 *relem++ = (lelem <= lastlelem) ? *lelem++ : &PL_sv_undef;
a0d0e21e 1170 }
54310121 1171 RETURN;
a0d0e21e
LW
1172}
1173
8782bef2
GB
1174PP(pp_qr)
1175{
97aff369 1176 dVAR; dSP;
c4420975
AL
1177 register PMOP * const pm = cPMOP;
1178 SV * const rv = sv_newmortal();
1179 SV * const sv = newSVrv(rv, "Regexp");
e08e52cf
AMS
1180 if (pm->op_pmdynflags & PMdf_TAINTED)
1181 SvTAINTED_on(rv);
aaa362c4 1182 sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
c8c13c22 1183 XPUSHs(rv);
1184 RETURN;
8782bef2
GB
1185}
1186
a0d0e21e
LW
1187PP(pp_match)
1188{
97aff369 1189 dVAR; dSP; dTARG;
a0d0e21e 1190 register PMOP *pm = cPMOP;
d65afb4b 1191 PMOP *dynpm = pm;
0d46e09a
SP
1192 register const char *t;
1193 register const char *s;
5c144d81 1194 const char *strend;
a0d0e21e 1195 I32 global;
f722798b 1196 I32 r_flags = REXEC_CHECKED;
5c144d81 1197 const char *truebase; /* Start of string */
aaa362c4 1198 register REGEXP *rx = PM_GETRE(pm);
b3eb6a9b 1199 bool rxtainted;
a3b680e6 1200 const I32 gimme = GIMME;
a0d0e21e 1201 STRLEN len;
748a9306 1202 I32 minmatch = 0;
a3b680e6 1203 const I32 oldsave = PL_savestack_ix;
f86702cc 1204 I32 update_minmatch = 1;
e60df1fa 1205 I32 had_zerolen = 0;
58e23c8d 1206 U32 gpos = 0;
a0d0e21e 1207
533c011a 1208 if (PL_op->op_flags & OPf_STACKED)
a0d0e21e 1209 TARG = POPs;
59f00321
RGS
1210 else if (PL_op->op_private & OPpTARGET_MY)
1211 GETTARGET;
a0d0e21e 1212 else {
54b9620d 1213 TARG = DEFSV;
a0d0e21e
LW
1214 EXTEND(SP,1);
1215 }
d9f424b2 1216
c277df42 1217 PUTBACK; /* EVAL blocks need stack_sp. */
5c144d81 1218 s = SvPV_const(TARG, len);
a0d0e21e 1219 if (!s)
2269b42e 1220 DIE(aTHX_ "panic: pp_match");
890ce7af 1221 strend = s + len;
b3eb6a9b 1222 rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
3280af22 1223 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
9212bbba 1224 TAINT_NOT;
a0d0e21e 1225
a30b2f1f 1226 RX_MATCH_UTF8_set(rx, DO_UTF8(TARG));
d9f424b2 1227
d65afb4b 1228 /* PMdf_USED is set after a ?? matches once */
48c036b1 1229 if (pm->op_pmdynflags & PMdf_USED) {
c277df42 1230 failure:
a0d0e21e
LW
1231 if (gimme == G_ARRAY)
1232 RETURN;
1233 RETPUSHNO;
1234 }
1235
d65afb4b 1236 /* empty pattern special-cased to use last successful pattern if possible */
3280af22
NIS
1237 if (!rx->prelen && PL_curpm) {
1238 pm = PL_curpm;
aaa362c4 1239 rx = PM_GETRE(pm);
a0d0e21e 1240 }
d65afb4b 1241
eb160463 1242 if (rx->minlen > (I32)len)
d65afb4b 1243 goto failure;
c277df42 1244
a0d0e21e 1245 truebase = t = s;
ad94a511
IZ
1246
1247 /* XXXX What part of this is needed with true \G-support? */
d65afb4b 1248 if ((global = dynpm->op_pmflags & PMf_GLOBAL)) {
f0ab9afb 1249 rx->offs[0].start = -1;
a0d0e21e 1250 if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
c445ea15 1251 MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global);
565764a8 1252 if (mg && mg->mg_len >= 0) {
bbe252da 1253 if (!(rx->extflags & RXf_GPOS_SEEN))
f0ab9afb 1254 rx->offs[0].end = rx->offs[0].start = mg->mg_len;
bbe252da 1255 else if (rx->extflags & RXf_ANCH_GPOS) {
0ef3e39e 1256 r_flags |= REXEC_IGNOREPOS;
f0ab9afb 1257 rx->offs[0].end = rx->offs[0].start = mg->mg_len;
bbe252da 1258 } else if (rx->extflags & RXf_GPOS_FLOAT)
58e23c8d
YO
1259 gpos = mg->mg_len;
1260 else
f0ab9afb 1261 rx->offs[0].end = rx->offs[0].start = mg->mg_len;
58e23c8d 1262 minmatch = (mg->mg_flags & MGf_MINMATCH) ? rx->gofs + 1 : 0;
f86702cc 1263 update_minmatch = 0;
748a9306 1264 }
a0d0e21e
LW
1265 }
1266 }
58e23c8d
YO
1267 /* remove comment to get faster /g but possibly unsafe $1 vars after a
1268 match. Test for the unsafe vars will fail as well*/
1269 if (( /* !global && */ rx->nparens)
cde0cee5
YO
1270 || SvTEMP(TARG) || PL_sawampersand ||
1271 (pm->op_pmflags & (PMf_EVAL|PMf_KEEPCOPY)))
14977893 1272 r_flags |= REXEC_COPY_STR;
1c846c1f 1273 if (SvSCREAM(TARG))
22e551b9
IZ
1274 r_flags |= REXEC_SCREAM;
1275
a0d0e21e 1276play_it_again:
f0ab9afb
NC
1277 if (global && rx->offs[0].start != -1) {
1278 t = s = rx->offs[0].end + truebase - rx->gofs;
58e23c8d 1279 if ((s + rx->minlen) > strend || s < truebase)
a0d0e21e 1280 goto nope;
f86702cc 1281 if (update_minmatch++)
e60df1fa 1282 minmatch = had_zerolen;
a0d0e21e 1283 }
bbe252da
YO
1284 if (rx->extflags & RXf_USE_INTUIT &&
1285 DO_UTF8(TARG) == ((rx->extflags & RXf_UTF8) != 0)) {
5c144d81
NC
1286 /* FIXME - can PL_bostr be made const char *? */
1287 PL_bostr = (char *)truebase;
f9f4320a 1288 s = CALLREG_INTUIT_START(rx, TARG, (char *)s, (char *)strend, r_flags, NULL);
f722798b
IZ
1289
1290 if (!s)
1291 goto nope;
bbe252da 1292 if ( (rx->extflags & RXf_CHECK_ALL)
14977893 1293 && !PL_sawampersand
cde0cee5 1294 && !(pm->op_pmflags & PMf_KEEPCOPY)
bbe252da
YO
1295 && ((rx->extflags & RXf_NOSCAN)
1296 || !((rx->extflags & RXf_INTUIT_TAIL)
05b4157f
GS
1297 && (r_flags & REXEC_SCREAM)))
1298 && !SvROK(TARG)) /* Cannot trust since INTUIT cannot guess ^ */
f722798b 1299 goto yup;
a0d0e21e 1300 }
70685ca0 1301 if (CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase, minmatch, TARG, INT2PTR(void*, gpos), r_flags))
bbce6d69 1302 {
3280af22 1303 PL_curpm = pm;
d65afb4b
HS
1304 if (dynpm->op_pmflags & PMf_ONCE)
1305 dynpm->op_pmdynflags |= PMdf_USED;
a0d0e21e
LW
1306 goto gotcha;
1307 }
1308 else
1309 goto ret_no;
1310 /*NOTREACHED*/
1311
1312 gotcha:
72311751
GS
1313 if (rxtainted)
1314 RX_MATCH_TAINTED_on(rx);
1315 TAINT_IF(RX_MATCH_TAINTED(rx));
a0d0e21e 1316 if (gimme == G_ARRAY) {
a3b680e6
AL
1317 const I32 nparens = rx->nparens;
1318 I32 i = (global && !nparens) ? 1 : 0;
a0d0e21e 1319
c277df42 1320 SPAGAIN; /* EVAL blocks could move the stack. */
ffc61ed2
JH
1321 EXTEND(SP, nparens + i);
1322 EXTEND_MORTAL(nparens + i);
1323 for (i = !i; i <= nparens; i++) {
a0d0e21e 1324 PUSHs(sv_newmortal());
f0ab9afb
NC
1325 if ((rx->offs[i].start != -1) && rx->offs[i].end != -1 ) {
1326 const I32 len = rx->offs[i].end - rx->offs[i].start;
1327 s = rx->offs[i].start + truebase;
1328 if (rx->offs[i].end < 0 || rx->offs[i].start < 0 ||
290deeac
A
1329 len < 0 || len > strend - s)
1330 DIE(aTHX_ "panic: pp_match start/end pointers");
a0d0e21e 1331 sv_setpvn(*SP, s, len);
cce850e4 1332 if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len))
a197cbdd 1333 SvUTF8_on(*SP);
a0d0e21e
LW
1334 }
1335 }
1336 if (global) {
d65afb4b 1337 if (dynpm->op_pmflags & PMf_CONTINUE) {
6136c704 1338 MAGIC* mg = NULL;
0af80b60
HS
1339 if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
1340 mg = mg_find(TARG, PERL_MAGIC_regex_global);
1341 if (!mg) {
d83f0a82
NC
1342#ifdef PERL_OLD_COPY_ON_WRITE
1343 if (SvIsCOW(TARG))
1344 sv_force_normal_flags(TARG, 0);
1345#endif
1346 mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
1347 &PL_vtbl_mglob, NULL, 0);
0af80b60 1348 }
f0ab9afb
NC
1349 if (rx->offs[0].start != -1) {
1350 mg->mg_len = rx->offs[0].end;
1351 if (rx->offs[0].start + rx->gofs == (UV)rx->offs[0].end)
0af80b60
HS
1352 mg->mg_flags |= MGf_MINMATCH;
1353 else
1354 mg->mg_flags &= ~MGf_MINMATCH;
1355 }
1356 }
f0ab9afb
NC
1357 had_zerolen = (rx->offs[0].start != -1
1358 && (rx->offs[0].start + rx->gofs
1359 == (UV)rx->offs[0].end));
c277df42 1360 PUTBACK; /* EVAL blocks may use stack */
cf93c79d 1361 r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
a0d0e21e
LW
1362 goto play_it_again;
1363 }
ffc61ed2 1364 else if (!nparens)
bde848c5 1365 XPUSHs(&PL_sv_yes);
4633a7c4 1366 LEAVE_SCOPE(oldsave);
a0d0e21e
LW
1367 RETURN;
1368 }
1369 else {
1370 if (global) {
cbbf8932 1371 MAGIC* mg;
a0d0e21e 1372 if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
14befaf4 1373 mg = mg_find(TARG, PERL_MAGIC_regex_global);
cbbf8932
AL
1374 else
1375 mg = NULL;
a0d0e21e 1376 if (!mg) {
d83f0a82
NC
1377#ifdef PERL_OLD_COPY_ON_WRITE
1378 if (SvIsCOW(TARG))
1379 sv_force_normal_flags(TARG, 0);
1380#endif
1381 mg = sv_magicext(TARG, NULL, PERL_MAGIC_regex_global,
1382 &PL_vtbl_mglob, NULL, 0);
a0d0e21e 1383 }
f0ab9afb
NC
1384 if (rx->offs[0].start != -1) {
1385 mg->mg_len = rx->offs[0].end;
1386 if (rx->offs[0].start + rx->gofs == (UV)rx->offs[0].end)
748a9306
LW
1387 mg->mg_flags |= MGf_MINMATCH;
1388 else
1389 mg->mg_flags &= ~MGf_MINMATCH;
1390 }
a0d0e21e 1391 }
4633a7c4 1392 LEAVE_SCOPE(oldsave);
a0d0e21e
LW
1393 RETPUSHYES;
1394 }
1395
f722798b 1396yup: /* Confirmed by INTUIT */
72311751
GS
1397 if (rxtainted)
1398 RX_MATCH_TAINTED_on(rx);
1399 TAINT_IF(RX_MATCH_TAINTED(rx));
3280af22 1400 PL_curpm = pm;
d65afb4b
HS
1401 if (dynpm->op_pmflags & PMf_ONCE)
1402 dynpm->op_pmdynflags |= PMdf_USED;
cf93c79d
IZ
1403 if (RX_MATCH_COPIED(rx))
1404 Safefree(rx->subbeg);
1405 RX_MATCH_COPIED_off(rx);
6136c704 1406 rx->subbeg = NULL;
a0d0e21e 1407 if (global) {
5c144d81
NC
1408 /* FIXME - should rx->subbeg be const char *? */
1409 rx->subbeg = (char *) truebase;
f0ab9afb 1410 rx->offs[0].start = s - truebase;
a30b2f1f 1411 if (RX_MATCH_UTF8(rx)) {
de8c5301 1412 char * const t = (char*)utf8_hop((U8*)s, rx->minlenret);
f0ab9afb 1413 rx->offs[0].end = t - truebase;
60aeb6fd
NIS
1414 }
1415 else {
f0ab9afb 1416 rx->offs[0].end = s - truebase + rx->minlenret;
60aeb6fd 1417 }
cf93c79d 1418 rx->sublen = strend - truebase;
a0d0e21e 1419 goto gotcha;
1c846c1f 1420 }
cde0cee5 1421 if (PL_sawampersand || pm->op_pmflags & PMf_KEEPCOPY) {
14977893 1422 I32 off;
f8c7b90f 1423#ifdef PERL_OLD_COPY_ON_WRITE
ed252734
NC
1424 if (SvIsCOW(TARG) || (SvFLAGS(TARG) & CAN_COW_MASK) == CAN_COW_FLAGS) {
1425 if (DEBUG_C_TEST) {
1426 PerlIO_printf(Perl_debug_log,
1427 "Copy on write: pp_match $& capture, type %d, truebase=%p, t=%p, difference %d\n",
6c9570dc 1428 (int) SvTYPE(TARG), (void*)truebase, (void*)t,
ed252734
NC
1429 (int)(t-truebase));
1430 }
1431 rx->saved_copy = sv_setsv_cow(rx->saved_copy, TARG);
555831ce 1432 rx->subbeg = (char *) SvPVX_const(rx->saved_copy) + (t - truebase);
ed252734
NC
1433 assert (SvPOKp(rx->saved_copy));
1434 } else
1435#endif
1436 {
14977893 1437
ed252734 1438 rx->subbeg = savepvn(t, strend - t);
f8c7b90f 1439#ifdef PERL_OLD_COPY_ON_WRITE
a0714e2c 1440 rx->saved_copy = NULL;
ed252734
NC
1441#endif
1442 }
14977893
JH
1443 rx->sublen = strend - t;
1444 RX_MATCH_COPIED_on(rx);
f0ab9afb
NC
1445 off = rx->offs[0].start = s - t;
1446 rx->offs[0].end = off + rx->minlenret;
14977893
JH
1447 }
1448 else { /* startp/endp are used by @- @+. */
f0ab9afb
NC
1449 rx->offs[0].start = s - truebase;
1450 rx->offs[0].end = s - truebase + rx->minlenret;
14977893 1451 }
cde0cee5
YO
1452 /* including rx->nparens in the below code seems highly suspicious.
1453 -dmq */
2d862feb 1454 rx->nparens = rx->lastparen = rx->lastcloseparen = 0; /* used by @-, @+, and $^N */
4633a7c4 1455 LEAVE_SCOPE(oldsave);
a0d0e21e
LW
1456 RETPUSHYES;
1457
1458nope:
a0d0e21e 1459ret_no:
d65afb4b 1460 if (global && !(dynpm->op_pmflags & PMf_CONTINUE)) {
a0d0e21e 1461 if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
6136c704 1462 MAGIC* const mg = mg_find(TARG, PERL_MAGIC_regex_global);
a0d0e21e 1463 if (mg)
565764a8 1464 mg->mg_len = -1;
a0d0e21e
LW
1465 }
1466 }
4633a7c4 1467 LEAVE_SCOPE(oldsave);
a0d0e21e
LW
1468 if (gimme == G_ARRAY)
1469 RETURN;
1470 RETPUSHNO;
1471}
1472
1473OP *
864dbfa3 1474Perl_do_readline(pTHX)
a0d0e21e 1475{
27da23d5 1476 dVAR; dSP; dTARGETSTACKED;
a0d0e21e
LW
1477 register SV *sv;
1478 STRLEN tmplen = 0;
1479 STRLEN offset;
760ac839 1480 PerlIO *fp;
a3b680e6
AL
1481 register IO * const io = GvIO(PL_last_in_gv);
1482 register const I32 type = PL_op->op_type;
1483 const I32 gimme = GIMME_V;
a0d0e21e 1484
6136c704
AL
1485 if (io) {
1486 MAGIC * const mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar);
1487 if (mg) {
1488 PUSHMARK(SP);
1489 XPUSHs(SvTIED_obj((SV*)io, mg));
1490 PUTBACK;
1491 ENTER;
1492 call_method("READLINE", gimme);
1493 LEAVE;
1494 SPAGAIN;
1495 if (gimme == G_SCALAR) {
1496 SV* const result = POPs;
1497 SvSetSV_nosteal(TARG, result);
1498 PUSHTARG;
1499 }
1500 RETURN;
0b7c7b4f 1501 }
e79b0511 1502 }
4608196e 1503 fp = NULL;
a0d0e21e
LW
1504 if (io) {
1505 fp = IoIFP(io);
1506 if (!fp) {
1507 if (IoFLAGS(io) & IOf_ARGV) {
1508 if (IoFLAGS(io) & IOf_START) {
a0d0e21e 1509 IoLINES(io) = 0;
3280af22 1510 if (av_len(GvAVn(PL_last_in_gv)) < 0) {
1d7c1841 1511 IoFLAGS(io) &= ~IOf_START;
4608196e 1512 do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,NULL);
c69033f2 1513 sv_setpvn(GvSVn(PL_last_in_gv), "-", 1);
3280af22 1514 SvSETMAGIC(GvSV(PL_last_in_gv));
a2008d6d
GS
1515 fp = IoIFP(io);
1516 goto have_fp;
a0d0e21e
LW
1517 }
1518 }
3280af22 1519 fp = nextargv(PL_last_in_gv);
a0d0e21e 1520 if (!fp) { /* Note: fp != IoIFP(io) */
3280af22 1521 (void)do_close(PL_last_in_gv, FALSE); /* now it does*/
a0d0e21e
LW
1522 }
1523 }
0d44d22b
NC
1524 else if (type == OP_GLOB)
1525 fp = Perl_start_glob(aTHX_ POPs, io);
a0d0e21e
LW
1526 }
1527 else if (type == OP_GLOB)
1528 SP--;
a00b5bd3 1529 else if (ckWARN(WARN_IO) && IoTYPE(io) == IoTYPE_WRONLY) {
4c80c0b2 1530 report_evil_fh(PL_last_in_gv, io, OP_phoney_OUTPUT_ONLY);
a00b5bd3 1531 }
a0d0e21e
LW
1532 }
1533 if (!fp) {
041457d9
DM
1534 if ((!io || !(IoFLAGS(io) & IOf_START))
1535 && ckWARN2(WARN_GLOB, WARN_CLOSED))
1536 {
3f4520fe 1537 if (type == OP_GLOB)
9014280d 1538 Perl_warner(aTHX_ packWARN(WARN_GLOB),
af8c498a
GS
1539 "glob failed (can't start child: %s)",
1540 Strerror(errno));
69282e91 1541 else
bc37a18f 1542 report_evil_fh(PL_last_in_gv, io, PL_op->op_type);
3f4520fe 1543 }
54310121 1544 if (gimme == G_SCALAR) {
79628082 1545 /* undef TARG, and push that undefined value */
ba92458f
AE
1546 if (type != OP_RCATLINE) {
1547 SV_CHECK_THINKFIRST_COW_DROP(TARG);
0c34ef67 1548 SvOK_off(TARG);
ba92458f 1549 }
a0d0e21e
LW
1550 PUSHTARG;
1551 }
1552 RETURN;
1553 }
a2008d6d 1554 have_fp:
54310121 1555 if (gimme == G_SCALAR) {
a0d0e21e 1556 sv = TARG;
0f722b55
RGS
1557 if (type == OP_RCATLINE && SvGMAGICAL(sv))
1558 mg_get(sv);
48de12d9
RGS
1559 if (SvROK(sv)) {
1560 if (type == OP_RCATLINE)
1561 SvPV_force_nolen(sv);
1562 else
1563 sv_unref(sv);
1564 }
f7877b28
NC
1565 else if (isGV_with_GP(sv)) {
1566 SvPV_force_nolen(sv);
1567 }
862a34c6 1568 SvUPGRADE(sv, SVt_PV);
a0d0e21e 1569 tmplen = SvLEN(sv); /* remember if already alloced */
bc44a8a2 1570 if (!tmplen && !SvREADONLY(sv))
a0d0e21e 1571 Sv_Grow(sv, 80); /* try short-buffering it */
2b5e58c4
AMS
1572 offset = 0;
1573 if (type == OP_RCATLINE && SvOK(sv)) {
1574 if (!SvPOK(sv)) {
8b6b16e7 1575 SvPV_force_nolen(sv);
2b5e58c4 1576 }
a0d0e21e 1577 offset = SvCUR(sv);
2b5e58c4 1578 }
a0d0e21e 1579 }
54310121 1580 else {
561b68a9 1581 sv = sv_2mortal(newSV(80));
54310121
PP
1582 offset = 0;
1583 }
fbad3eb5 1584
3887d568
AP
1585 /* This should not be marked tainted if the fp is marked clean */
1586#define MAYBE_TAINT_LINE(io, sv) \
1587 if (!(IoFLAGS(io) & IOf_UNTAINT)) { \
1588 TAINT; \
1589 SvTAINTED_on(sv); \
1590 }
1591
684bef36 1592/* delay EOF state for a snarfed empty file */
fbad3eb5 1593#define SNARF_EOF(gimme,rs,io,sv) \
684bef36 1594 (gimme != G_SCALAR || SvCUR(sv) \
b9fee9ba 1595 || (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs))
fbad3eb5 1596
a0d0e21e 1597 for (;;) {
09e8efcc 1598 PUTBACK;
fbad3eb5 1599 if (!sv_gets(sv, fp, offset)
2d726892
TF
1600 && (type == OP_GLOB
1601 || SNARF_EOF(gimme, PL_rs, io, sv)
1602 || PerlIO_error(fp)))
fbad3eb5 1603 {
760ac839 1604 PerlIO_clearerr(fp);
a0d0e21e 1605 if (IoFLAGS(io) & IOf_ARGV) {
3280af22 1606 fp = nextargv(PL_last_in_gv);
a0d0e21e
LW
1607 if (fp)
1608 continue;
3280af22 1609 (void)do_close(PL_last_in_gv, FALSE);
a0d0e21e
LW
1610 }
1611 else if (type == OP_GLOB) {
e476b1b5 1612 if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_GLOB)) {
9014280d 1613 Perl_warner(aTHX_ packWARN(WARN_GLOB),
4eb79ab5 1614 "glob failed (child exited with status %d%s)",
894356b3 1615 (int)(STATUS_CURRENT >> 8),
cf494569 1616 (STATUS_CURRENT & 0x80) ? ", core dumped" : "");
4eb79ab5 1617 }
a0d0e21e 1618 }
54310121 1619 if (gimme == G_SCALAR) {
ba92458f
AE
1620 if (type != OP_RCATLINE) {
1621 SV_CHECK_THINKFIRST_COW_DROP(TARG);
0c34ef67 1622 SvOK_off(TARG);
ba92458f 1623 }
09e8efcc 1624 SPAGAIN;
a0d0e21e
LW
1625 PUSHTARG;
1626 }
3887d568 1627 MAYBE_TAINT_LINE(io, sv);
a0d0e21e
LW
1628 RETURN;
1629 }
3887d568 1630 MAYBE_TAINT_LINE(io, sv);
a0d0e21e 1631 IoLINES(io)++;
b9fee9ba 1632 IoFLAGS(io) |= IOf_NOLINE;
71be2cbc 1633 SvSETMAGIC(sv);
09e8efcc 1634 SPAGAIN;
a0d0e21e 1635 XPUSHs(sv);
a0d0e21e 1636 if (type == OP_GLOB) {
349d4f2f 1637 const char *t1;
a0d0e21e 1638
3280af22 1639 if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) {
6136c704 1640 char * const tmps = SvEND(sv) - 1;
aa07b2f6 1641 if (*tmps == *SvPVX_const(PL_rs)) {
c07a80fd 1642 *tmps = '\0';
b162af07 1643 SvCUR_set(sv, SvCUR(sv) - 1);
c07a80fd
PP
1644 }
1645 }
349d4f2f
NC
1646 for (t1 = SvPVX_const(sv); *t1; t1++)
1647 if (!isALPHA(*t1) && !isDIGIT(*t1) &&
1648 strchr("$&*(){}[]'\";\\|?<>~`", *t1))
a0d0e21e 1649 break;
349d4f2f 1650 if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &PL_statbuf) < 0) {
a0d0e21e
LW
1651 (void)POPs; /* Unmatched wildcard? Chuck it... */
1652 continue;
1653 }
2d79bf7f 1654 } else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */
d4c19fe8
AL
1655 if (ckWARN(WARN_UTF8)) {
1656 const U8 * const s = (const U8*)SvPVX_const(sv) + offset;
1657 const STRLEN len = SvCUR(sv) - offset;
1658 const U8 *f;
1659
1660 if (!is_utf8_string_loc(s, len, &f))
1661 /* Emulate :encoding(utf8) warning in the same case. */
1662 Perl_warner(aTHX_ packWARN(WARN_UTF8),
1663 "utf8 \"\\x%02X\" does not map to Unicode",
1664 f < (U8*)SvEND(sv) ? *f : 0);
1665 }
a0d0e21e 1666 }
54310121 1667 if (gimme == G_ARRAY) {
a0d0e21e 1668 if (SvLEN(sv) - SvCUR(sv) > 20) {
1da4ca5f 1669 SvPV_shrink_to_cur(sv);
a0d0e21e 1670 }
561b68a9 1671 sv = sv_2mortal(newSV(80));
a0d0e21e
LW
1672 continue;
1673 }
54310121 1674 else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
a0d0e21e 1675 /* try to reclaim a bit of scalar space (only on 1st alloc) */
d5b5861b
NC
1676 const STRLEN new_len
1677 = SvCUR(sv) < 60 ? 80 : SvCUR(sv)+40; /* allow some slop */
1da4ca5f 1678 SvPV_renew(sv, new_len);
a0d0e21e
LW
1679 }
1680 RETURN;
1681 }
1682}
1683
1684PP(pp_enter)
1685{
27da23d5 1686 dVAR; dSP;
c09156bb 1687 register PERL_CONTEXT *cx;
533c011a 1688 I32 gimme = OP_GIMME(PL_op, -1);
a0d0e21e 1689
54310121
PP
1690 if (gimme == -1) {
1691 if (cxstack_ix >= 0)
1692 gimme = cxstack[cxstack_ix].blk_gimme;
1693 else
1694 gimme = G_SCALAR;
1695 }
a0d0e21e
LW
1696
1697 ENTER;
1698
1699 SAVETMPS;
924508f0 1700 PUSHBLOCK(cx, CXt_BLOCK, SP);
a0d0e21e
LW
1701
1702 RETURN;
1703}
1704
1705PP(pp_helem)
1706{
97aff369 1707 dVAR; dSP;
760ac839 1708 HE* he;
ae77835f 1709 SV **svp;
c445ea15
AL
1710 SV * const keysv = POPs;
1711 HV * const hv = (HV*)POPs;
a3b680e6
AL
1712 const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
1713 const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
be6c24e0 1714 SV *sv;
c158a4fd 1715 const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvSHARED_HASH(keysv) : 0;
9c5ffd7c 1716 I32 preeminent = 0;
a0d0e21e 1717
d4c19fe8 1718 if (SvTYPE(hv) != SVt_PVHV)
a0d0e21e 1719 RETPUSHUNDEF;
d4c19fe8
AL
1720
1721 if (PL_op->op_private & OPpLVAL_INTRO) {
1722 MAGIC *mg;
1723 HV *stash;
1724 /* does the element we're localizing already exist? */
1725 preeminent = /* can we determine whether it exists? */
1726 ( !SvRMAGICAL(hv)
1727 || mg_find((SV*)hv, PERL_MAGIC_env)
1728 || ( (mg = mg_find((SV*)hv, PERL_MAGIC_tied))
1729 /* Try to preserve the existenceness of a tied hash
1730 * element by using EXISTS and DELETE if possible.
1731 * Fallback to FETCH and STORE otherwise */
1732 && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg))))
1733 && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
1734 && gv_fetchmethod_autoload(stash, "DELETE", TRUE)
1735 )
1736 ) ? hv_exists_ent(hv, keysv, 0) : 1;
1737 }
1738 he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
1739 svp = he ? &HeVAL(he) : NULL;
a0d0e21e 1740 if (lval) {
3280af22 1741 if (!svp || *svp == &PL_sv_undef) {
68dc0745
PP
1742 SV* lv;
1743 SV* key2;
2d8e6c8d 1744 if (!defer) {
be2597df 1745 DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
2d8e6c8d 1746 }
68dc0745
PP
1747 lv = sv_newmortal();
1748 sv_upgrade(lv, SVt_PVLV);
1749 LvTYPE(lv) = 'y';
6136c704 1750 sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, NULL, 0);
68dc0745 1751 SvREFCNT_dec(key2); /* sv_magic() increments refcount */
b37c2d43 1752 LvTARG(lv) = SvREFCNT_inc_simple(hv);
68dc0745
PP
1753 LvTARGLEN(lv) = 1;
1754 PUSHs(lv);
1755 RETURN;
1756 }
533c011a 1757 if (PL_op->op_private & OPpLVAL_INTRO) {
bfcb3514 1758 if (HvNAME_get(hv) && isGV(*svp))
533c011a 1759 save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
1f5346dc
SC
1760 else {
1761 if (!preeminent) {
1762 STRLEN keylen;
e62f0680 1763 const char * const key = SvPV_const(keysv, keylen);
7d654f43 1764 SAVEDELETE(hv, savepvn(key,keylen),
bb7a0f54 1765 SvUTF8(keysv) ? -(I32)keylen : (I32)keylen);
bfc4de9f 1766 } else
1f5346dc
SC
1767 save_helem(hv, keysv, svp);
1768 }
5f05dabc 1769 }
533c011a
NIS
1770 else if (PL_op->op_private & OPpDEREF)
1771 vivify_ref(*svp, PL_op->op_private & OPpDEREF);
a0d0e21e 1772 }
3280af22 1773 sv = (svp ? *svp : &PL_sv_undef);
be6c24e0
GS
1774 /* This makes C<local $tied{foo} = $tied{foo}> possible.
1775 * Pushing the magical RHS on to the stack is useless, since
1776 * that magic is soon destined to be misled by the local(),
1777 * and thus the later pp_sassign() will fail to mg_get() the
1778 * old value. This should also cure problems with delayed
1779 * mg_get()s. GSAR 98-07-03 */
1780 if (!lval && SvGMAGICAL(sv))
1781 sv = sv_mortalcopy(sv);
1782 PUSHs(sv);
a0d0e21e
LW
1783 RETURN;
1784}
1785
1786PP(pp_leave)
1787{
27da23d5 1788 dVAR; dSP;
c09156bb 1789 register PERL_CONTEXT *cx;
a0d0e21e
LW
1790 SV **newsp;
1791 PMOP *newpm;
1792 I32 gimme;
1793
533c011a 1794 if (PL_op->op_flags & OPf_SPECIAL) {
a0d0e21e 1795 cx = &cxstack[cxstack_ix];
3280af22 1796 cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */
a0d0e21e
LW
1797 }
1798
1799 POPBLOCK(cx,newpm);
1800
533c011a 1801 gimme = OP_GIMME(PL_op, -1);
54310121
PP
1802 if (gimme == -1) {
1803 if (cxstack_ix >= 0)
1804 gimme = cxstack[cxstack_ix].blk_gimme;
1805 else
1806 gimme = G_SCALAR;
1807 }
a0d0e21e 1808
a1f49e72 1809 TAINT_NOT;
54310121
PP
1810 if (gimme == G_VOID)
1811 SP = newsp;
1812 else if (gimme == G_SCALAR) {
a3b680e6 1813 register SV **mark;
54310121 1814 MARK = newsp + 1;
09256e2f 1815 if (MARK <= SP) {
54310121
PP
1816 if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
1817 *MARK = TOPs;
1818 else
1819 *MARK = sv_mortalcopy(TOPs);
09256e2f 1820 } else {
54310121 1821 MEXTEND(mark,0);
3280af22 1822 *MARK = &PL_sv_undef;
a0d0e21e 1823 }
54310121 1824 SP = MARK;
a0d0e21e 1825 }
54310121 1826 else if (gimme == G_ARRAY) {
a1f49e72 1827 /* in case LEAVE wipes old return values */
a3b680e6 1828 register SV **mark;
a1f49e72
CS
1829 for (mark = newsp + 1; mark <= SP; mark++) {
1830 if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
a0d0e21e 1831 *mark = sv_mortalcopy(*mark);
a1f49e72
CS
1832 TAINT_NOT; /* Each item is independent */
1833 }
1834 }
a0d0e21e 1835 }
3280af22 1836 PL_curpm = newpm; /* Don't pop $1 et al till now */
a0d0e21e
LW
1837
1838 LEAVE;
1839
1840 RETURN;
1841}
1842
1843PP(pp_iter)
1844{
97aff369 1845 dVAR; dSP;
c09156bb 1846 register PERL_CONTEXT *cx;
dc09a129 1847 SV *sv, *oldsv;
4633a7c4 1848 AV* av;
1d7c1841 1849 SV **itersvp;
a0d0e21e 1850
924508f0 1851 EXTEND(SP, 1);
a0d0e21e 1852 cx = &cxstack[cxstack_ix];
6b35e009 1853 if (CxTYPE(cx) != CXt_LOOP)
cea2e8a9 1854 DIE(aTHX_ "panic: pp_iter");
a0d0e21e 1855
1d7c1841 1856 itersvp = CxITERVAR(cx);
4633a7c4 1857 av = cx->blk_loop.iterary;
89ea2908
GA
1858 if (SvTYPE(av) != SVt_PVAV) {
1859 /* iterate ($min .. $max) */
1860 if (cx->blk_loop.iterlval) {
1861 /* string increment */
1862 register SV* cur = cx->blk_loop.iterlval;
4fe3f0fa 1863 STRLEN maxlen = 0;
10edeb5d
JH
1864 const char *max =
1865 SvOK((SV*)av) ?
1866 SvPV_const((SV*)av, maxlen) : (const char *)"";
89ea2908 1867 if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) {
1d7c1841 1868 if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
eaa5c2d6 1869 /* safe to reuse old SV */
1d7c1841 1870 sv_setsv(*itersvp, cur);
eaa5c2d6 1871 }
1c846c1f 1872 else
eaa5c2d6
GA
1873 {
1874 /* we need a fresh SV every time so that loop body sees a
1875 * completely new SV for closures/references to work as
1876 * they used to */
dc09a129 1877 oldsv = *itersvp;
1d7c1841 1878 *itersvp = newSVsv(cur);
dc09a129 1879 SvREFCNT_dec(oldsv);
eaa5c2d6 1880 }
aa07b2f6 1881 if (strEQ(SvPVX_const(cur), max))
89ea2908
GA
1882 sv_setiv(cur, 0); /* terminate next time */
1883 else
1884 sv_inc(cur);
1885 RETPUSHYES;
1886 }
1887 RETPUSHNO;
1888 }
1889 /* integer increment */
1890 if (cx->blk_loop.iterix > cx->blk_loop.itermax)
1891 RETPUSHNO;
7f61b687 1892
3db8f154 1893 /* don't risk potential race */
1d7c1841 1894 if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) {
eaa5c2d6 1895 /* safe to reuse old SV */
1d7c1841 1896 sv_setiv(*itersvp, cx->blk_loop.iterix++);
eaa5c2d6 1897 }
1c846c1f 1898 else
eaa5c2d6
GA
1899 {
1900 /* we need a fresh SV every time so that loop body sees a
1901 * completely new SV for closures/references to work as they
1902 * used to */
dc09a129 1903 oldsv = *itersvp;
1d7c1841 1904 *itersvp = newSViv(cx->blk_loop.iterix++);
dc09a129 1905 SvREFCNT_dec(oldsv);
eaa5c2d6 1906 }
89ea2908
GA
1907 RETPUSHYES;
1908 }
1909
1910 /* iterate array */
ef3e5ea9
NC
1911 if (PL_op->op_private & OPpITER_REVERSED) {
1912 /* In reverse, use itermax as the min :-) */
c491ecac 1913 if (cx->blk_loop.iterix <= cx->blk_loop.itermax)
ef3e5ea9 1914 RETPUSHNO;
a0d0e21e 1915
ef3e5ea9 1916 if (SvMAGICAL(av) || AvREIFY(av)) {
c445ea15 1917 SV * const * const svp = av_fetch(av, --cx->blk_loop.iterix, FALSE);
a0714e2c 1918 sv = svp ? *svp : NULL;
ef3e5ea9
NC
1919 }
1920 else {
6e585ca0 1921 sv = AvARRAY(av)[--cx->blk_loop.iterix];
ef3e5ea9 1922 }
d42935ef
JH
1923 }
1924 else {
ef3e5ea9
NC
1925 if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp :
1926 AvFILL(av)))
1927 RETPUSHNO;
1928
1929 if (SvMAGICAL(av) || AvREIFY(av)) {
c445ea15 1930 SV * const * const svp = av_fetch(av, ++cx->blk_loop.iterix, FALSE);
a0714e2c 1931 sv = svp ? *svp : NULL;
ef3e5ea9
NC
1932 }
1933 else {
1934 sv = AvARRAY(av)[++cx->blk_loop.iterix];
1935 }
d42935ef 1936 }
ef3e5ea9 1937
0565a181 1938 if (sv && SvIS_FREED(sv)) {
a0714e2c 1939 *itersvp = NULL;
b6c83531 1940 Perl_croak(aTHX_ "Use of freed value in iteration");
cccede53
DM
1941 }
1942
d42935ef 1943 if (sv)
a0d0e21e 1944 SvTEMP_off(sv);
a0d0e21e 1945 else
3280af22 1946 sv = &PL_sv_undef;
8b530633 1947 if (av != PL_curstack && sv == &PL_sv_undef) {
5f05dabc 1948 SV *lv = cx->blk_loop.iterlval;
71be2cbc
PP
1949 if (lv && SvREFCNT(lv) > 1) {
1950 SvREFCNT_dec(lv);
a0714e2c 1951 lv = NULL;
71be2cbc 1952 }
5f05dabc
PP
1953 if (lv)
1954 SvREFCNT_dec(LvTARG(lv));
1955 else {
b9f83d2f 1956 lv = cx->blk_loop.iterlval = newSV_type(SVt_PVLV);
5f05dabc 1957 LvTYPE(lv) = 'y';
6136c704 1958 sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
5f05dabc 1959 }
b37c2d43 1960 LvTARG(lv) = SvREFCNT_inc_simple(av);
5f05dabc 1961 LvTARGOFF(lv) = cx->blk_loop.iterix;
42718184 1962 LvTARGLEN(lv) = (STRLEN)UV_MAX;
5f05dabc
PP
1963 sv = (SV*)lv;
1964 }
a0d0e21e 1965
dc09a129 1966 oldsv = *itersvp;
b37c2d43 1967 *itersvp = SvREFCNT_inc_simple_NN(sv);
dc09a129
DM
1968 SvREFCNT_dec(oldsv);
1969
a0d0e21e
LW
1970 RETPUSHYES;
1971}
1972
1973PP(pp_subst)
1974{
97aff369 1975 dVAR; dSP; dTARG;
a0d0e21e
LW
1976 register PMOP *pm = cPMOP;
1977 PMOP *rpm = pm;
a0d0e21e
LW
1978 register char *s;
1979 char *strend;
1980 register char *m;
5c144d81 1981 const char *c;
a0d0e21e
LW
1982 register char *d;
1983 STRLEN clen;
1984 I32 iters = 0;
1985 I32 maxiters;
1986 register I32 i;
1987 bool once;
71be2cbc 1988 bool rxtainted;
a0d0e21e 1989 char *orig;
22e551b9 1990 I32 r_flags;
aaa362c4 1991 register REGEXP *rx = PM_GETRE(pm);
a0d0e21e
LW
1992 STRLEN len;
1993 int force_on_match = 0;
0bcc34c2 1994 const I32 oldsave = PL_savestack_ix;
792b2c16 1995 STRLEN slen;
f272994b 1996 bool doutf8 = FALSE;
f8c7b90f 1997#ifdef PERL_OLD_COPY_ON_WRITE
ed252734
NC
1998 bool is_cow;
1999#endif
a0714e2c 2000 SV *nsv = NULL;
a0d0e21e 2001
5cd24f17 2002 /* known replacement string? */
b37c2d43 2003 register SV *dstr = (pm->op_pmflags & PMf_CONST) ? POPs : NULL;
533c011a 2004 if (PL_op->op_flags & OPf_STACKED)
a0d0e21e 2005 TARG = POPs;
59f00321
RGS
2006 else if (PL_op->op_private & OPpTARGET_MY)
2007 GETTARGET;
a0d0e21e 2008 else {
54b9620d 2009 TARG = DEFSV;
a0d0e21e 2010 EXTEND(SP,1);
1c846c1f 2011 }
d9f424b2 2012
f8c7b90f 2013#ifdef PERL_OLD_COPY_ON_WRITE
ed252734
NC
2014 /* Awooga. Awooga. "bool" types that are actually char are dangerous,
2015 because they make integers such as 256 "false". */
2016 is_cow = SvIsCOW(TARG) ? TRUE : FALSE;
2017#else
765f542d
NC
2018 if (SvIsCOW(TARG))
2019 sv_force_normal_flags(TARG,0);
ed252734
NC
2020#endif
2021 if (
f8c7b90f 2022#ifdef PERL_OLD_COPY_ON_WRITE
ed252734
NC
2023 !is_cow &&
2024#endif
2025 (SvREADONLY(TARG)
cecf5685
NC
2026 || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG))
2027 || SvTYPE(TARG) > SVt_PVLV)
4ce457a6 2028 && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG)))))
d470f89e 2029 DIE(aTHX_ PL_no_modify);
8ec5e241
NIS
2030 PUTBACK;
2031
d5263905 2032 s = SvPV_mutable(TARG, len);
68dc0745 2033 if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV)
a0d0e21e 2034 force_on_match = 1;
b3eb6a9b 2035 rxtainted = ((pm->op_pmdynflags & PMdf_TAINTED) ||
3280af22
NIS
2036 (PL_tainted && (pm->op_pmflags & PMf_RETAINT)));
2037 if (PL_tainted)
b3eb6a9b 2038 rxtainted |= 2;
9212bbba 2039 TAINT_NOT;
a12c0f56 2040
a30b2f1f 2041 RX_MATCH_UTF8_set(rx, DO_UTF8(TARG));
d9f424b2 2042
a0d0e21e
LW
2043 force_it:
2044 if (!pm || !s)
2269b42e 2045 DIE(aTHX_ "panic: pp_subst");
a0d0e21e
LW
2046
2047 strend = s + len;
a30b2f1f 2048 slen = RX_MATCH_UTF8(rx) ? utf8_length((U8*)s, (U8*)strend) : len;
792b2c16
JH
2049 maxiters = 2 * slen + 10; /* We can match twice at each
2050 position, once with zero-length,
2051 second time with non-zero. */
a0d0e21e 2052
3280af22
NIS
2053 if (!rx->prelen && PL_curpm) {
2054 pm = PL_curpm;
aaa362c4 2055 rx = PM_GETRE(pm);
a0d0e21e 2056 }
0b78c20a 2057 r_flags = (rx->nparens || SvTEMP(TARG) || PL_sawampersand
cde0cee5 2058 || (pm->op_pmflags & (PMf_EVAL|PMf_KEEPCOPY)) )
ed252734 2059 ? REXEC_COPY_STR : 0;
f722798b 2060 if (SvSCREAM(TARG))
22e551b9 2061 r_flags |= REXEC_SCREAM;
7fba1cd6 2062
a0d0e21e 2063 orig = m = s;
bbe252da 2064 if (rx->extflags & RXf_USE_INTUIT) {
ee0b7718 2065 PL_bostr = orig;
f9f4320a 2066 s = CALLREG_INTUIT_START(rx, TARG, s, strend, r_flags, NULL);
f722798b
IZ
2067
2068 if (!s)
2069 goto nope;
2070 /* How to do it in subst? */
bbe252da 2071/* if ( (rx->extflags & RXf_CHECK_ALL)
1c846c1f 2072 && !PL_sawampersand
cde0cee5 2073 && !(pm->op_pmflags & PMf_KEEPCOPY)
bbe252da
YO
2074 && ((rx->extflags & RXf_NOSCAN)
2075 || !((rx->extflags & RXf_INTUIT_TAIL)
f722798b
IZ
2076 && (r_flags & REXEC_SCREAM))))
2077 goto yup;
2078*/
a0d0e21e 2079 }
71be2cbc
PP
2080
2081 /* only replace once? */
a0d0e21e 2082 once = !(rpm->op_pmflags & PMf_GLOBAL);
71be2cbc
PP
2083
2084 /* known replacement string? */
f272994b 2085 if (dstr) {
8514a05a
JH
2086 /* replacement needing upgrading? */
2087 if (DO_UTF8(TARG) && !doutf8) {
db79b45b 2088 nsv = sv_newmortal();
4a176938 2089 SvSetSV(nsv, dstr);
8514a05a
JH
2090 if (PL_encoding)
2091 sv_recode_to_utf8(nsv, PL_encoding);
2092 else
2093 sv_utf8_upgrade(nsv);
5c144d81 2094 c = SvPV_const(nsv, clen);
4a176938
JH
2095 doutf8 = TRUE;
2096 }
2097 else {
5c144d81 2098 c = SvPV_const(dstr, clen);
4a176938 2099 doutf8 = DO_UTF8(dstr);
8514a05a 2100 }
f272994b
A
2101 }
2102 else {
6136c704 2103 c = NULL;
f272994b
A
2104 doutf8 = FALSE;
2105 }
2106
71be2cbc 2107 /* can do inplace substitution? */
ed252734 2108 if (c
f8c7b90f 2109#ifdef PERL_OLD_COPY_ON_WRITE
ed252734
NC
2110 && !is_cow
2111#endif
de8c5301 2112 && (I32)clen <= rx->minlenret && (once || !(r_flags & REXEC_COPY_STR))
bbe252da 2113 && !(rx->extflags & RXf_LOOKBEHIND_SEEN)
db79b45b 2114 && (!doutf8 || SvUTF8(TARG))) {
f9f4320a 2115 if (!CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
f722798b
IZ
2116 r_flags | REXEC_CHECKED))
2117 {
8ec5e241 2118 SPAGAIN;
3280af22 2119 PUSHs(&PL_sv_no);
71be2cbc
PP
2120 LEAVE_SCOPE(oldsave);
2121 RETURN;
2122 }
f8c7b90f 2123#ifdef PERL_OLD_COPY_ON_WRITE
ed252734
NC
2124 if (SvIsCOW(TARG)) {
2125 assert (!force_on_match);
2126 goto have_a_cow;
2127 }
2128#endif
71be2cbc
PP
2129 if (force_on_match) {
2130 force_on_match = 0;
2131 s = SvPV_force(TARG, len);
2132 goto force_it;
2133 }
71be2cbc 2134 d = s;
3280af22 2135 PL_curpm = pm;
71be2cbc
PP
2136 SvSCREAM_off(TARG); /* disable possible screamer */
2137 if (once) {
48c036b1 2138 rxtainted |= RX_MATCH_TAINTED(rx);
f0ab9afb
NC
2139 m = orig + rx->offs[0].start;
2140 d = orig + rx->offs[0].end;
71be2cbc
PP
2141 s = orig;
2142 if (m - s > strend - d) { /* faster to shorten from end */
2143 if (clen) {
2144 Copy(c, m, clen, char);
2145 m += clen;
a0d0e21e 2146 }
71be2cbc
PP
2147 i = strend - d;
2148 if (i > 0) {
2149 Move(d, m, i, char);
2150 m += i;
a0d0e21e 2151 }
71be2cbc
PP
2152 *m = '\0';
2153 SvCUR_set(TARG, m - s);
2154 }
155aba94 2155 else if ((i = m - s)) { /* faster from front */
71be2cbc
PP
2156 d -= clen;
2157 m = d;
2158 sv_chop(TARG, d-i);
2159 s += i;
2160 while (i--)
2161 *--d = *--s;
2162 if (clen)
2163 Copy(c, m, clen, char);
2164 }
2165 else if (clen) {
2166 d -= clen;
2167 sv_chop(TARG, d);
2168 Copy(c, d, clen, char);
2169 }
2170 else {
2171 sv_chop(TARG, d);
2172 }
48c036b1 2173 TAINT_IF(rxtainted & 1);
8ec5e241 2174 SPAGAIN;
3280af22 2175 PUSHs(&PL_sv_yes);
71be2cbc
PP
2176 }
2177 else {
71be2cbc
PP
2178 do {
2179 if (iters++ > maxiters)
cea2e8a9 2180 DIE(aTHX_ "Substitution loop");
d9f97599 2181 rxtainted |= RX_MATCH_TAINTED(rx);
f0ab9afb 2182 m = rx->offs[0].start + orig;
155aba94 2183 if ((i = m - s)) {
71be2cbc
PP
2184 if (s != d)
2185 Move(s, d, i, char);
2186 d += i;
a0d0e21e 2187 }
71be2cbc
PP
2188 if (clen) {
2189 Copy(c, d, clen, char);
2190 d += clen;
2191 }
f0ab9afb 2192 s = rx->offs[0].end + orig;
f9f4320a 2193 } while (CALLREGEXEC(rx, s, strend, orig, s == m,
f722798b
IZ
2194 TARG, NULL,
2195 /* don't match same null twice */
2196 REXEC_NOT_FIRST|REXEC_IGNOREPOS));
71be2cbc
PP
2197 if (s != d) {
2198 i = strend - s;
aa07b2f6 2199 SvCUR_set(TARG, d - SvPVX_const(TARG) + i);
71be2cbc 2200 Move(s, d, i+1, char); /* include the NUL */
a0d0e21e 2201 }
48c036b1 2202 TAINT_IF(rxtainted & 1);
8ec5e241 2203 SPAGAIN;
71be2cbc 2204 PUSHs(sv_2mortal(newSViv((I32)iters)));
a0d0e21e 2205 }
80b498e0 2206 (void)SvPOK_only_UTF8(TARG);
48c036b1 2207 TAINT_IF(rxtainted);
8ec5e241
NIS
2208 if (SvSMAGICAL(TARG)) {
2209 PUTBACK;
2210 mg_set(TARG);
2211 SPAGAIN;
2212 }
9212bbba 2213 SvTAINT(TARG);
aefe6dfc
JH
2214 if (doutf8)
2215 SvUTF8_on(TARG);
71be2cbc
PP
2216 LEAVE_SCOPE(oldsave);
2217 RETURN;
a0d0e21e 2218 }
71be2cbc 2219
f9f4320a 2220 if (CALLREGEXEC(rx, s, strend, orig, 0, TARG, NULL,
f722798b
IZ
2221 r_flags | REXEC_CHECKED))
2222 {
a0d0e21e
LW
2223 if (force_on_match) {
2224 force_on_match = 0;
2225 s = SvPV_force(TARG, len);
2226 goto force_it;
2227 }
f8c7b90f 2228#ifdef PERL_OLD_COPY_ON_WRITE
ed252734
NC
2229 have_a_cow:
2230#endif
48c036b1 2231 rxtainted |= RX_MATCH_TAINTED(rx);
f2b990bf 2232 dstr = newSVpvn(m, s-m);
cff085c1 2233 SAVEFREESV(dstr);
ffc61ed2
JH
2234 if (DO_UTF8(TARG))
2235 SvUTF8_on(dstr);
3280af22 2236 PL_curpm = pm;
a0d0e21e 2237 if (!c) {
c09156bb 2238 register PERL_CONTEXT *cx;
8ec5e241 2239 SPAGAIN;
a0d0e21e
LW
2240 PUSHSUBST(cx);
2241 RETURNOP(cPMOP->op_pmreplroot);
2242 }
cf93c79d 2243 r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST;
a0d0e21e
LW
2244 do {
2245 if (iters++ > maxiters)
cea2e8a9 2246 DIE(aTHX_ "Substitution loop");
d9f97599 2247 rxtainted |= RX_MATCH_TAINTED(rx);
cf93c79d 2248 if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
a0d0e21e
LW
2249 m = s;
2250 s = orig;
cf93c79d 2251 orig = rx->subbeg;
a0d0e21e
LW
2252 s = orig + (m - s);
2253 strend = s + (strend - m);
2254 }
f0ab9afb 2255 m = rx->offs[0].start + orig;
db79b45b
JH
2256 if (doutf8 && !SvUTF8(dstr))
2257 sv_catpvn_utf8_upgrade(dstr, s, m - s, nsv);
2258 else
2259 sv_catpvn(dstr, s, m-s);
f0ab9afb 2260 s = rx->offs[0].end + orig;
a0d0e21e
LW
2261 if (clen)
2262 sv_catpvn(dstr, c, clen);
2263 if (once)
2264 break;
f9f4320a 2265 } while (CALLREGEXEC(rx, s, strend, orig, s == m,
ffc61ed2 2266 TARG, NULL, r_flags));
db79b45b
JH
2267 if (doutf8 && !DO_UTF8(TARG))
2268 sv_catpvn_utf8_upgrade(dstr, s, strend - s, nsv);
89afcb60
A
2269 else
2270 sv_catpvn(dstr, s, strend - s);
748a9306 2271
f8c7b90f 2272#ifdef PERL_OLD_COPY_ON_WRITE
ed252734
NC
2273 /* The match may make the string COW. If so, brilliant, because that's
2274 just saved us one malloc, copy and free - the regexp has donated
2275 the old buffer, and we malloc an entirely new one, rather than the
2276 regexp malloc()ing a buffer and copying our original, only for
2277 us to throw it away here during the substitution. */
2278 if (SvIsCOW(TARG)) {
2279 sv_force_normal_flags(TARG, SV_COW_DROP_PV);
2280 } else
2281#endif
2282 {
8bd4d4c5 2283 SvPV_free(TARG);
ed252734 2284 }
f880fe2f 2285 SvPV_set(TARG, SvPVX(dstr));
748a9306
LW
2286 SvCUR_set(TARG, SvCUR(dstr));
2287 SvLEN_set(TARG, SvLEN(dstr));
f272994b 2288 doutf8 |= DO_UTF8(dstr);
6136c704 2289 SvPV_set(dstr, NULL);
748a9306 2290
48c036b1 2291 TAINT_IF(rxtainted & 1);
f878fbec 2292 SPAGAIN;
48c036b1
GS
2293 PUSHs(sv_2mortal(newSViv((I32)iters)));
2294
a0d0e21e 2295 (void)SvPOK_only(TARG);
f272994b 2296 if (doutf8)
60aeb6fd 2297 SvUTF8_on(TARG);
48c036b1 2298 TAINT_IF(rxtainted);
a0d0e21e 2299 SvSETMAGIC(TARG);
9212bbba 2300 SvTAINT(TARG);
4633a7c4 2301 LEAVE_SCOPE(oldsave);
a0d0e21e
LW
2302 RETURN;
2303 }
5cd24f17 2304 goto ret_no;
a0d0e21e
LW
2305
2306nope:
1c846c1f 2307ret_no:
8ec5e241 2308 SPAGAIN;
3280af22 2309 PUSHs(&PL_sv_no);
4633a7c4 2310 LEAVE_SCOPE(oldsave);
a0d0e21e
LW
2311 RETURN;
2312}
2313
2314PP(pp_grepwhile)
2315{
27da23d5 2316 dVAR; dSP;
a0d0e21e
LW
2317
2318 if (SvTRUEx(POPs))
3280af22
NIS
2319 PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
2320 ++*PL_markstack_ptr;
a0d0e21e
LW
2321 LEAVE; /* exit inner scope */
2322
2323 /* All done yet? */
3280af22 2324 if (PL_stack_base + *PL_markstack_ptr > SP) {
a0d0e21e 2325 I32 items;
c4420975 2326 const I32 gimme = GIMME_V;
a0d0e21e
LW
2327
2328 LEAVE; /* exit outer scope */
2329 (void)POPMARK; /* pop src */
3280af22 2330 items = --*PL_markstack_ptr - PL_markstack_ptr[-1];
a0d0e21e 2331 (void)POPMARK; /* pop dst */
3280af22 2332 SP = PL_stack_base + POPMARK; /* pop original mark */
54310121 2333 if (gimme == G_SCALAR) {
7cc47870 2334 if (PL_op->op_private & OPpGREP_LEX) {
c4420975 2335 SV* const sv = sv_newmortal();
7cc47870
RGS
2336 sv_setiv(sv, items);
2337 PUSHs(sv);
2338 }
2339 else {
2340 dTARGET;
2341 XPUSHi(items);
2342 }
a0d0e21e 2343 }
54310121
PP
2344 else if (gimme == G_ARRAY)
2345 SP += items;
a0d0e21e
LW
2346 RETURN;
2347 }
2348 else {
2349 SV *src;
2350
2351 ENTER; /* enter inner scope */
1d7c1841 2352 SAVEVPTR(PL_curpm);
a0d0e21e 2353
3280af22 2354 src = PL_stack_base[*PL_markstack_ptr];
a0d0e21e 2355 SvTEMP_off(src);
59f00321
RGS
2356 if (PL_op->op_private & OPpGREP_LEX)
2357 PAD_SVl(PL_op->op_targ) = src;
2358 else
2359 DEFSV = src;
a0d0e21e
LW
2360
2361 RETURNOP(cLOGOP->op_other);
2362 }
2363}
2364
2365PP(pp_leavesub)
2366{
27da23d5 2367 dVAR; dSP;
a0d0e21e
LW
2368 SV **mark;
2369 SV **newsp;
2370 PMOP *newpm;
2371 I32 gimme;
c09156bb 2372 register PERL_CONTEXT *cx;
b0d9ce38 2373 SV *sv;
a0d0e21e 2374
9850bf21
RH
2375 if (CxMULTICALL(&cxstack[cxstack_ix]))
2376 return 0;
2377
a0d0e21e 2378 POPBLOCK(cx,newpm);
5dd42e15 2379 cxstack_ix++; /* temporarily protect top context */
1c846c1f 2380
a1f49e72 2381 TAINT_NOT;
a0d0e21e
LW
2382 if (gimme == G_SCALAR) {
2383 MARK = newsp + 1;
a29cdaf0 2384 if (MARK <= SP) {
a8bba7fa 2385 if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
a29cdaf0
IZ
2386 if (SvTEMP(TOPs)) {
2387 *MARK = SvREFCNT_inc(TOPs);
2388 FREETMPS;
2389 sv_2mortal(*MARK);
cd06dffe
GS
2390 }
2391 else {
959e3673 2392 sv = SvREFCNT_inc(TOPs); /* FREETMPS could clobber it */
a29cdaf0 2393 FREETMPS;
959e3673
GS
2394 *MARK = sv_mortalcopy(sv);
2395 SvREFCNT_dec(sv);
a29cdaf0 2396 }
cd06dffe
GS
2397 }
2398 else
a29cdaf0 2399 *MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
cd06dffe
GS
2400 }
2401 else {
f86702cc 2402 MEXTEND(MARK, 0);
3280af22 2403 *MARK = &PL_sv_undef;
a0d0e21e
LW
2404 }
2405 SP = MARK;
2406 }
54310121 2407 else if (gimme == G_ARRAY) {
f86702cc 2408 for (MARK = newsp + 1; MARK <= SP; MARK++) {
a1f49e72 2409 if (!SvTEMP(*MARK)) {
f86702cc 2410 *MARK = sv_mortalcopy(*MARK);
a1f49e72
CS
2411 TAINT_NOT; /* Each item is independent */
2412 }
f86702cc 2413 }
a0d0e21e 2414 }
f86702cc 2415 PUTBACK;
1c846c1f 2416
5dd42e15
DM
2417 LEAVE;
2418 cxstack_ix--;
b0d9ce38 2419 POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
3280af22 2420 PL_curpm = newpm; /* ... and pop $1 et al */
a0d0e21e 2421
b0d9ce38 2422 LEAVESUB(sv);
f39bc417 2423 return cx->blk_sub.retop;
a0d0e21e
LW
2424}
2425
cd06dffe
GS
2426/* This duplicates the above code because the above code must not
2427 * get any slower by more conditions */
2428PP(pp_leavesublv)
2429{
27da23d5 2430 dVAR; dSP;
cd06dffe
GS
2431 SV **mark;
2432 SV **newsp;
2433 PMOP *newpm;
2434 I32 gimme;
2435 register PERL_CONTEXT *cx;
b0d9ce38 2436 SV *sv;
cd06dffe 2437
9850bf21
RH
2438 if (CxMULTICALL(&cxstack[cxstack_ix]))
2439 return 0;
2440
cd06dffe 2441 POPBLOCK(cx,newpm);
5dd42e15 2442 cxstack_ix++; /* temporarily protect top context */
1c846c1f 2443
cd06dffe
GS
2444 TAINT_NOT;
2445
cc8d50a7 2446 if (cx->blk_sub.lval & OPpENTERSUB_INARGS) {
cd06dffe
GS
2447 /* We are an argument to a function or grep().
2448 * This kind of lvalueness was legal before lvalue
2449 * subroutines too, so be backward compatible:
2450 * cannot report errors. */
2451
2452 /* Scalar context *is* possible, on the LHS of -> only,
2453 * as in f()->meth(). But this is not an lvalue. */
2454 if (gimme == G_SCALAR)
2455 goto temporise;
2456 if (gimme == G_ARRAY) {
a8bba7fa 2457 if (!CvLVALUE(cx->blk_sub.cv))
cd06dffe
GS
2458 goto temporise_array;
2459 EXTEND_MORTAL(SP - newsp);
2460 for (mark = newsp + 1; mark <= SP; mark++) {
2461 if (SvTEMP(*mark))
6f207bd3 2462 NOOP;
cd06dffe
GS
2463 else if (SvFLAGS(*mark) & (SVs_PADTMP | SVf_READONLY))
2464 *mark = sv_mortalcopy(*mark);
2465 else {
2466 /* Can be a localized value subject to deletion. */
2467 PL_tmps_stack[++PL_tmps_ix] = *mark;
b37c2d43 2468 SvREFCNT_inc_void(*mark);
cd06dffe
GS
2469 }
2470 }
2471 }
2472 }
cc8d50a7 2473 else if (cx->blk_sub.lval) { /* Leave it as it is if we can. */
cd06dffe
GS
2474 /* Here we go for robustness, not for speed, so we change all
2475 * the refcounts so the caller gets a live guy. Cannot set
2476 * TEMP, so sv_2mortal is out of question. */
a8bba7fa 2477 if (!CvLVALUE(cx->blk_sub.cv)) {
5dd42e15
DM
2478 LEAVE;
2479 cxstack_ix--;
b0d9ce38 2480 POPSUB(cx,sv);
d470f89e 2481 PL_curpm = newpm;
b0d9ce38 2482 LEAVESUB(sv);
d470f89e
GS
2483 DIE(aTHX_ "Can't modify non-lvalue subroutine call");
2484 }
cd06dffe
GS
2485 if (gimme == G_SCALAR) {
2486 MARK = newsp + 1;
2487 EXTEND_MORTAL(1);
2488 if (MARK == SP) {
f9bc45ef
TP
2489 /* Temporaries are bad unless they happen to be elements
2490 * of a tied hash or array */
2491 if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY) &&
2492 !(SvRMAGICAL(TOPs) && mg_find(TOPs, PERL_MAGIC_tiedelem))) {
5dd42e15
DM
2493 LEAVE;
2494 cxstack_ix--;
b0d9ce38 2495 POPSUB(cx,sv);
d470f89e 2496 PL_curpm = newpm;
b0d9ce38 2497 LEAVESUB(sv);
e9f19e3c
HS
2498 DIE(aTHX_ "Can't return %s from lvalue subroutine",
2499 SvREADONLY(TOPs) ? (TOPs == &PL_sv_undef) ? "undef"
2500 : "a readonly value" : "a temporary");
d470f89e 2501 }
cd06dffe
GS
2502 else { /* Can be a localized value
2503 * subject to deletion. */
2504 PL_tmps_stack[++PL_tmps_ix] = *mark;
b37c2d43 2505 SvREFCNT_inc_void(*mark);
cd06dffe
GS
2506 }
2507 }
d470f89e 2508 else { /* Should not happen? */
5dd42e15
DM
2509 LEAVE;
2510 cxstack_ix--;
b0d9ce38 2511 POPSUB(cx,sv);
d470f89e 2512 PL_curpm = newpm;
b0d9ce38 2513 LEAVESUB(sv);
d470f89e 2514 DIE(aTHX_ "%s returned from lvalue subroutine in scalar context",
cd06dffe 2515 (MARK > SP ? "Empty array" : "Array"));
d470f89e 2516 }
cd06dffe
GS
2517 SP = MARK;
2518 }
2519 else if (gimme == G_ARRAY) {
2520 EXTEND_MORTAL(SP - newsp);
2521 for (mark = newsp + 1; mark <= SP; mark++) {
f206cdda
AMS
2522 if (*mark != &PL_sv_undef
2523 && SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
d470f89e
GS
2524 /* Might be flattened array after $#array = */
2525 PUTBACK;
5dd42e15
DM
2526 LEAVE;
2527 cxstack_ix--;
b0d9ce38 2528 POPSUB(cx,sv);
d470f89e 2529 PL_curpm = newpm;
b0d9ce38 2530 LEAVESUB(sv);
f206cdda
AMS
2531 DIE(aTHX_ "Can't return a %s from lvalue subroutine",
2532 SvREADONLY(TOPs) ? "readonly value" : "temporary");
d470f89e 2533 }
cd06dffe 2534 else {
cd06dffe
GS
2535 /* Can be a localized value subject to deletion. */
2536 PL_tmps_stack[++PL_tmps_ix] = *mark;
b37c2d43 2537 SvREFCNT_inc_void(*mark);
cd06dffe
GS
2538 }
2539 }
2540 }
2541 }
2542 else {
2543 if (gimme == G_SCALAR) {
2544 temporise:
2545 MARK = newsp + 1;
2546 if (MARK <= SP) {
a8bba7fa 2547 if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
cd06dffe
GS
2548 if (SvTEMP(TOPs)) {
2549 *MARK = SvREFCNT_inc(TOPs);
2550 FREETMPS;
2551 sv_2mortal(*MARK);
2552 }
2553 else {
959e3673 2554 sv = SvREFCNT_inc(TOPs); /* FREETMPS could clobber it */
cd06dffe 2555 FREETMPS;
959e3673
GS
2556 *MARK = sv_mortalcopy(sv);
2557 SvREFCNT_dec(sv);
cd06dffe
GS
2558 }
2559 }
2560 else
2561 *MARK = SvTEMP(TOPs) ? TOPs : sv_mortalcopy(TOPs);
2562 }
2563 else {
2564 MEXTEND(MARK, 0);
2565 *MARK = &PL_sv_undef;
2566 }
2567 SP = MARK;
2568 }
2569 else if (gimme == G_ARRAY) {
2570 temporise_array:
2571 for (MARK = newsp + 1; MARK <= SP; MARK++) {
2572 if (!SvTEMP(*MARK)) {
2573 *MARK = sv_mortalcopy(*MARK);
2574 TAINT_NOT; /* Each item is independent */
2575 }
2576 }
2577 }
2578 }
2579 PUTBACK;
1c846c1f 2580
5dd42e15
DM
2581 LEAVE;
2582 cxstack_ix--;
b0d9ce38 2583 POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */
cd06dffe
GS
2584 PL_curpm = newpm; /* ... and pop $1 et al */
2585
b0d9ce38 2586 LEAVESUB(sv);
f39bc417 2587 return cx->blk_sub.retop;
cd06dffe
GS
2588}
2589
a0d0e21e
LW
2590PP(pp_entersub)
2591{
27da23d5 2592 dVAR; dSP; dPOPss;
a0d0e21e 2593 GV *gv;
a0d0e21e 2594 register CV *cv;
c09156bb 2595 register PERL_CONTEXT *cx;
5d94fbed 2596 I32 gimme;
a9c4fd4e 2597 const bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
a0d0e21e
LW
2598
2599 if (!sv)
cea2e8a9 2600 DIE(aTHX_ "Not a CODE reference");
a0d0e21e 2601 switch (SvTYPE(sv)) {
f1025168
NC
2602 /* This is overwhelming the most common case: */
2603 case SVt_PVGV:
f730a42d
NC
2604 if (!(cv = GvCVu((GV*)sv))) {
2605 HV *stash;
f2c0649b 2606 cv = sv_2cv(sv, &stash, &gv, 0);
f730a42d 2607 }
f1025168
NC
2608 if (!cv) {
2609 ENTER;
2610 SAVETMPS;
2611 goto try_autoload;
2612 }
2613 break;
a0d0e21e
LW
2614 default:
2615 if (!SvROK(sv)) {
a9c4fd4e 2616 const char *sym;
780a5241 2617 STRLEN len;
3280af22 2618 if (sv == &PL_sv_yes) { /* unfound import, ignore */
fb73857a 2619 if (hasargs)
3280af22 2620 SP = PL_stack_base + POPMARK;
a0d0e21e 2621 RETURN;
fb73857a 2622 }
15ff848f
CS
2623 if (SvGMAGICAL(sv)) {
2624 mg_get(sv);
f5f1d18e
AMS
2625 if (SvROK(sv))
2626 goto got_rv;
780a5241
NC
2627 if (SvPOKp(sv)) {
2628 sym = SvPVX_const(sv);
2629 len = SvCUR(sv);
2630 } else {
2631 sym = NULL;
2632 len = 0;
2633 }
15ff848f 2634 }
a9c4fd4e 2635 else {
780a5241 2636 sym = SvPV_const(sv, len);
a9c4fd4e 2637 }
15ff848f 2638 if (!sym)
cea2e8a9 2639 DIE(aTHX_ PL_no_usym, "a subroutine");
533c011a 2640 if (PL_op->op_private & HINT_STRICT_REFS)
cea2e8a9 2641 DIE(aTHX_ PL_no_symref, sym, "a subroutine");
780a5241 2642 cv = get_cvn_flags(sym, len, GV_ADD|SvUTF8(sv));
a0d0e21e
LW
2643 break;
2644 }
f5f1d18e 2645 got_rv:
f5284f61 2646 {
823a54a3 2647 SV * const * sp = &sv; /* Used in tryAMAGICunDEREF macro. */
f5284f61
IZ
2648 tryAMAGICunDEREF(to_cv);
2649 }
a0d0e21e
LW
2650 cv = (CV*)SvRV(sv);
2651 if (SvTYPE(cv) == SVt_PVCV)
2652 break;
2653 /* FALL THROUGH */
2654 case SVt_PVHV:
2655 case SVt_PVAV:
cea2e8a9 2656 DIE(aTHX_ "Not a CODE reference");
f1025168 2657 /* This is the second most common case: */
a0d0e21e
LW
2658 case SVt_PVCV:
2659 cv = (CV*)sv;
2660 break;
a0d0e21e
LW
2661 }
2662
2663 ENTER;
2664 SAVETMPS;
2665
2666 retry:
a0d0e21e 2667 if (!CvROOT(cv) && !CvXSUB(cv)) {
2f349aa0
NC
2668 GV* autogv;
2669 SV* sub_name;
2670
2671 /* anonymous or undef'd function leaves us no recourse */
2672 if (CvANON(cv) || !(gv = CvGV(cv)))
2673 DIE(aTHX_ "Undefined subroutine called");
2674
2675 /* autoloaded stub? */
2676 if (cv != GvCV(gv)) {
2677 cv = GvCV(gv);
2678 }
2679 /* should call AUTOLOAD now? */
2680 else {
2681try_autoload:
2682 if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
2683 FALSE)))
2684 {
2685 cv = GvCV(autogv);
2686 }
2687 /* sorry */
2688 else {
2689 sub_name = sv_newmortal();
6136c704 2690 gv_efullname3(sub_name, gv, NULL);
be2597df 2691 DIE(aTHX_ "Undefined subroutine &%"SVf" called", SVfARG(sub_name));
2f349aa0
NC
2692 }
2693 }
2694 if (!cv)
2695 DIE(aTHX_ "Not a CODE reference");
2696 goto retry;
a0d0e21e
LW
2697 }
2698
54310121 2699 gimme = GIMME_V;
67caa1fe 2700 if ((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv)) {
06492da6
SF
2701 if (CvASSERTION(cv) && PL_DBassertion)
2702 sv_setiv(PL_DBassertion, 1);
2703
005a8a35 2704 Perl_get_db_sub(aTHX_ &sv, cv);
a9ef256d
NC
2705 if (CvISXSUB(cv))
2706 PL_curcopdb = PL_curcop;
2707 cv = GvCV(PL_DBsub);
2708
ccafdc96
RGS
2709 if (!cv || (!CvXSUB(cv) && !CvSTART(cv)))
2710 DIE(aTHX_ "No DB::sub routine defined");
67caa1fe 2711 }
a0d0e21e 2712
aed2304a 2713 if (!(CvISXSUB(cv))) {
f1025168 2714 /* This path taken at least 75% of the time */
a0d0e21e
LW
2715 dMARK;
2716 register I32 items = SP - MARK;
0bcc34c2 2717 AV* const padlist = CvPADLIST(cv);
a0d0e21e
LW
2718 PUSHBLOCK(cx, CXt_SUB, MARK);
2719 PUSHSUB(cx);
f39bc417 2720 cx->blk_sub.retop = PL_op->op_next;
a0d0e21e 2721 CvDEPTH(cv)++;
6b35e009
GS
2722 /* XXX This would be a natural place to set C<PL_compcv = cv> so
2723 * that eval'' ops within this sub know the correct lexical space.
a3985cdc
DM
2724 * Owing the speed considerations, we choose instead to search for
2725 * the cv using find_runcv() when calling doeval().
6b35e009 2726 */
3a76ca88
RGS
2727 if (CvDEPTH(cv) >= 2) {
2728 PERL_STACK_OVERFLOW_CHECK();
2729 pad_push(padlist, CvDEPTH(cv));
a0d0e21e 2730 }
3a76ca88
RGS
2731 SAVECOMPPAD();
2732 PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
2733 if (hasargs) {
0bcc34c2 2734 AV* const av = (AV*)PAD_SVl(0);
221373f0
GS
2735 if (AvREAL(av)) {
2736 /* @_ is normally not REAL--this should only ever
2737 * happen when DB::sub() calls things that modify @_ */
2738 av_clear(av);
2739 AvREAL_off(av);
2740 AvREIFY_on(av);
2741 }
3280af22 2742 cx->blk_sub.savearray = GvAV(PL_defgv);
b37c2d43 2743 GvAV(PL_defgv) = (AV*)SvREFCNT_inc_simple(av);
dd2155a4 2744 CX_CURPAD_SAVE(cx->blk_sub);
6d4ff0d2 2745 cx->blk_sub.argarray = av;
a0d0e21e
LW
2746 ++MARK;
2747
2748 if (items > AvMAX(av) + 1) {
504618e9 2749 SV **ary = AvALLOC(av);
a0d0e21e
LW
2750 if (AvARRAY(av) != ary) {
2751 AvMAX(av) += AvARRAY(av) - AvALLOC(av);
9c6bc640 2752 AvARRAY(av) = ary;
a0d0e21e
LW
2753 }
2754 if (items > AvMAX(av) + 1) {
2755 AvMAX(av) = items - 1;
2756 Renew(ary,items,SV*);
2757 AvALLOC(av) = ary;
9c6bc640 2758 AvARRAY(av) = ary;
a0d0e21e
LW
2759 }
2760 }
2761 Copy(MARK,AvARRAY(av),items,SV*);
93965878 2762 AvFILLp(av) = items - 1;
1c846c1f 2763
a0d0e21e
LW
2764 while (items--) {
2765 if (*MARK)
2766 SvTEMP_off(*MARK);
2767 MARK++;
2768 }
2769 }
4a925ff6
GS
2770 /* warning must come *after* we fully set up the context
2771 * stuff so that __WARN__ handlers can safely dounwind()
2772 * if they want to
2773 */
2774 if (CvDEPTH(cv) == 100 && ckWARN(WARN_RECURSION)
2775 && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))
2776 sub_crush_depth(cv);
77a005ab 2777#if 0
bf49b057 2778 DEBUG_S(PerlIO_printf(Perl_debug_log,
6c9570dc 2779 "%p entersub returning %p\n", (void*)thr, (void*)CvSTART(cv)));
77a005ab 2780#endif
a0d0e21e
LW
2781 RETURNOP(CvSTART(cv));
2782 }
f1025168 2783 else {
3a76ca88 2784 I32 markix = TOPMARK;
f1025168 2785
3a76ca88 2786 PUTBACK;
f1025168 2787
3a76ca88
RGS
2788 if (!hasargs) {
2789 /* Need to copy @_ to stack. Alternative may be to
2790 * switch stack to @_, and copy return values
2791 * back. This would allow popping @_ in XSUB, e.g.. XXXX */
2792 AV * const av = GvAV(PL_defgv);
2793 const I32 items = AvFILLp(av) + 1; /* @_ is not tieable */
2794
2795 if (items) {
2796 /* Mark is at the end of the stack. */
2797 EXTEND(SP, items);
2798 Copy(AvARRAY(av), SP + 1, items, SV*);
2799 SP += items;
2800 PUTBACK ;
2801 }
2802 }
2803 /* We assume first XSUB in &DB::sub is the called one. */
2804 if (PL_curcopdb) {
2805 SAVEVPTR(PL_curcop);
2806 PL_curcop = PL_curcopdb;
2807 PL_curcopdb = NULL;
2808 }
2809 /* Do we need to open block here? XXXX */
2810 if (CvXSUB(cv)) /* XXX this is supposed to be true */
2811 (void)(*CvXSUB(cv))(aTHX_ cv);
2812
2813 /* Enforce some sanity in scalar context. */
2814 if (gimme == G_SCALAR && ++markix != PL_stack_sp - PL_stack_base ) {
2815 if (markix > PL_stack_sp - PL_stack_base)
2816 *(PL_stack_base + markix) = &PL_sv_undef;
2817 else
2818 *(PL_stack_base + markix) = *PL_stack_sp;
2819 PL_stack_sp = PL_stack_base + markix;
2820 }
f1025168
NC
2821 LEAVE;
2822 return NORMAL;
2823 }
a0d0e21e
LW
2824}
2825
44a8e56a 2826void
864dbfa3 2827Perl_sub_crush_depth(pTHX_ CV *cv)
44a8e56a
PP
2828{
2829 if (CvANON(cv))
9014280d 2830 Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine");
44a8e56a 2831 else {
aec46f14 2832 SV* const tmpstr = sv_newmortal();
6136c704 2833 gv_efullname3(tmpstr, CvGV(cv), NULL);
35c1215d 2834 Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%"SVf"\"",
be2597df 2835 SVfARG(tmpstr));
44a8e56a
PP
2836 }
2837}
2838
a0d0e21e
LW
2839PP(pp_aelem)
2840{
97aff369 2841 dVAR; dSP;
a0d0e21e 2842 SV** svp;
a3b680e6 2843 SV* const elemsv = POPs;
d804643f 2844 IV elem = SvIV(elemsv);
0bcc34c2 2845 AV* const av = (AV*)POPs;
e1ec3a88
AL
2846 const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
2847 const U32 defer = (PL_op->op_private & OPpLVAL_DEFER) && (elem > av_len(av));
be6c24e0 2848 SV *sv;
a0d0e21e 2849
e35c1634 2850 if (SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))
95b63a38
JH
2851 Perl_warner(aTHX_ packWARN(WARN_MISC),
2852 "Use of reference \"%"SVf"\" as array index",
be2597df 2853 SVfARG(elemsv));
748a9306 2854 if (elem > 0)
fc15ae8f 2855 elem -= CopARYBASE_get(PL_curcop);
a0d0e21e
LW
2856 if (SvTYPE(av) != SVt_PVAV)
2857 RETPUSHUNDEF;
68dc0745 2858 svp = av_fetch(av, elem, lval && !defer);
a0d0e21e 2859 if (lval) {
2b573ace 2860#ifdef PERL_MALLOC_WRAP
2b573ace 2861 if (SvUOK(elemsv)) {
a9c4fd4e 2862 const UV uv = SvUV(elemsv);
2b573ace
JH
2863 elem = uv > IV_MAX ? IV_MAX : uv;
2864 }
2865 else if (SvNOK(elemsv))
2866 elem = (IV)SvNV(elemsv);
a3b680e6
AL
2867 if (elem > 0) {
2868 static const char oom_array_extend[] =
2869 "Out of memory during array extend"; /* Duplicated in av.c */
2b573ace 2870 MEM_WRAP_CHECK_1(elem,SV*,oom_array_extend);
a3b680e6 2871 }
2b573ace 2872#endif
3280af22 2873 if (!svp || *svp == &PL_sv_undef) {
68dc0745
PP
2874 SV* lv;
2875 if (!defer)
cea2e8a9 2876 DIE(aTHX_ PL_no_aelem, elem);
68dc0745
PP
2877 lv = sv_newmortal();
2878 sv_upgrade(lv, SVt_PVLV);
2879 LvTYPE(lv) = 'y';
a0714e2c 2880 sv_magic(lv, NULL, PERL_MAGIC_defelem, NULL, 0);
b37c2d43 2881 LvTARG(lv) = SvREFCNT_inc_simple(av);
68dc0745
PP
2882 LvTARGOFF(lv) = elem;
2883 LvTARGLEN(lv) = 1;
2884 PUSHs(lv);
2885 RETURN;
2886 }
bfc4de9f 2887 if (PL_op->op_private & OPpLVAL_INTRO)
161b7d16 2888 save_aelem(av, elem, svp);
533c011a
NIS
2889 else if (PL_op->op_private & OPpDEREF)
2890 vivify_ref(*svp, PL_op->op_private & OPpDEREF);
a0d0e21e 2891 }
3280af22 2892 sv = (svp ? *svp : &PL_sv_undef);
be6c24e0
GS
2893 if (!lval && SvGMAGICAL(sv)) /* see note in pp_helem() */
2894 sv = sv_mortalcopy(sv);
2895 PUSHs(sv);
a0d0e21e
LW
2896 RETURN;
2897}
2898
02a9e968 2899void
864dbfa3 2900Perl_vivify_ref(pTHX_ SV *sv, U32 to_what)
02a9e968 2901{
5b295bef 2902 SvGETMAGIC(sv);
02a9e968
CS
2903 if (!SvOK(sv)) {
2904 if (SvREADONLY(sv))
cea2e8a9 2905 Perl_croak(aTHX_ PL_no_modify);
5f05dabc
PP
2906 if (SvTYPE(sv) < SVt_RV)
2907 sv_upgrade(sv, SVt_RV);
2908 else if (SvTYPE(sv) >= SVt_PV) {
8bd4d4c5 2909 SvPV_free(sv);
b162af07
SP
2910 SvLEN_set(sv, 0);
2911 SvCUR_set(sv, 0);
5f05dabc 2912 }
68dc0745 2913 switch (to_what) {
5f05dabc 2914 case OPpDEREF_SV:
561b68a9 2915 SvRV_set(sv, newSV(0));
5f05dabc
PP
2916 break;
2917 case OPpDEREF_AV:
b162af07 2918 SvRV_set(sv, (SV*)newAV());
5f05dabc
PP
2919 break;
2920 case OPpDEREF_HV:
b162af07 2921 SvRV_set(sv, (SV*)newHV());
5f05dabc
PP
2922 break;
2923 }
02a9e968
CS
2924 SvROK_on(sv);
2925 SvSETMAGIC(sv);
2926 }
2927}
2928
a0d0e21e
LW
2929PP(pp_method)
2930{
97aff369 2931 dVAR; dSP;
890ce7af 2932 SV* const sv = TOPs;
f5d5a27c
CS
2933
2934 if (SvROK(sv)) {
890ce7af 2935 SV* const rsv = SvRV(sv);
f5d5a27c
CS
2936 if (SvTYPE(rsv) == SVt_PVCV) {
2937 SETs(rsv);
2938 RETURN;
2939 }
2940 }
2941
4608196e 2942 SETs(method_common(sv, NULL));
f5d5a27c
CS
2943 RETURN;
2944}
2945
2946PP(pp_method_named)
2947{
97aff369 2948 dVAR; dSP;
890ce7af 2949 SV* const sv = cSVOP_sv;
c158a4fd 2950 U32 hash = SvSHARED_HASH(sv);
f5d5a27c
CS
2951
2952 XPUSHs(method_common(sv, &hash));
2953 RETURN;
2954}
2955
2956STATIC SV *
2957S_method_common(pTHX_ SV* meth, U32* hashp)
2958{
97aff369 2959 dVAR;
a0d0e21e
LW
2960 SV* ob;
2961 GV* gv;
56304f61 2962 HV* stash;
f5d5a27c 2963 STRLEN namelen;
6136c704 2964 const char* packname = NULL;
a0714e2c 2965 SV *packsv = NULL;
ac91690f 2966 STRLEN packlen;
46c461b5
AL
2967 const char * const name = SvPV_const(meth, namelen);
2968 SV * const sv = *(PL_stack_base + TOPMARK + 1);
f5d5a27c 2969
4f1b7578
SC
2970 if (!sv)
2971 Perl_croak(aTHX_ "Can't call method \"%s\" on an undefined value", name);
2972
5b295bef 2973 SvGETMAGIC(sv);
a0d0e21e 2974 if (SvROK(sv))
16d20bd9 2975 ob = (SV*)SvRV(sv);
a0d0e21e
LW
2976 else {
2977 GV* iogv;
a0d0e21e 2978
af09ea45 2979 /* this isn't a reference */
5c144d81 2980 if(SvOK(sv) && (packname = SvPV_const(sv, packlen))) {
b464bac0 2981 const HE* const he = hv_fetch_ent(PL_stashcache, sv, 0, 0);
081fc587 2982 if (he) {
5e6396ae 2983 stash = INT2PTR(HV*,SvIV(HeVAL(he)));
081fc587
AB
2984 goto fetch;
2985 }
2986 }
2987
a0d0e21e 2988 if (!SvOK(sv) ||
05f5af9a 2989 !(packname) ||
f776e3cd 2990 !(iogv = gv_fetchsv(sv, 0, SVt_PVIO)) ||
a0d0e21e
LW
2991 !(ob=(SV*)GvIO(iogv)))
2992 {
af09ea45 2993 /* this isn't the name of a filehandle either */
1c846c1f 2994 if (!packname ||
fd400ab9 2995 ((UTF8_IS_START(*packname) && DO_UTF8(sv))
b86a2fa7 2996 ? !isIDFIRST_utf8((U8*)packname)
834a4ddd
LW
2997 : !isIDFIRST(*packname)
2998 ))
2999 {
f5d5a27c
CS
3000 Perl_croak(aTHX_ "Can't call method \"%s\" %s", name,
3001 SvOK(sv) ? "without a package or object reference"
3002 : "on an undefined value");
834a4ddd 3003 }
af09ea45 3004 /* assume it's a package name */
da51bb9b 3005 stash = gv_stashpvn(packname, packlen, 0);
0dae17bd
GS
3006 if (!stash)
3007 packsv = sv;
081fc587 3008 else {
d4c19fe8 3009 SV* const ref = newSViv(PTR2IV(stash));
7e8961ec
AB
3010 hv_store(PL_stashcache, packname, packlen, ref, 0);
3011 }
ac91690f 3012 goto fetch;
a0d0e21e 3013 }
af09ea45 3014 /* it _is_ a filehandle name -- replace with a reference */
3280af22 3015 *(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV((SV*)iogv));
a0d0e21e
LW
3016 }
3017
af09ea45 3018 /* if we got here, ob should be a reference or a glob */
f0d43078
GS
3019 if (!ob || !(SvOBJECT(ob)
3020 || (SvTYPE(ob) == SVt_PVGV && (ob = (SV*)GvIO((GV*)ob))
3021 && SvOBJECT(ob))))
3022 {
f5d5a27c
CS
3023 Perl_croak(aTHX_ "Can't call method \"%s\" on unblessed reference",
3024 name);
f0d43078 3025 }
a0d0e21e 3026
56304f61 3027 stash = SvSTASH(ob);
a0d0e21e 3028
ac91690f 3029 fetch:
af09ea45
IK
3030 /* NOTE: stash may be null, hope hv_fetch_ent and
3031 gv_fetchmethod can cope (it seems they can) */
3032
f5d5a27c
CS
3033 /* shortcut for simple names */
3034 if (hashp) {
b464bac0 3035 const HE* const he = hv_fetch_ent(stash, meth, 0, *hashp);
f5d5a27c
CS
3036 if (he) {
3037 gv = (GV*)HeVAL(he);
3038 if (isGV(gv) && GvCV(gv) &&
3039 (!GvCVGEN(gv) || GvCVGEN(gv) == PL_sub_generation))
3040 return (SV*)GvCV(gv);
3041 }
3042 }
3043
0dae17bd 3044 gv = gv_fetchmethod(stash ? stash : (HV*)packsv, name);
af09ea45 3045
56304f61 3046 if (!gv) {
af09ea45
IK
3047 /* This code tries to figure out just what went wrong with
3048 gv_fetchmethod. It therefore needs to duplicate a lot of
3049 the internals of that function. We can't move it inside
3050 Perl_gv_fetchmethod_autoload(), however, since that would
3051 cause UNIVERSAL->can("NoSuchPackage::foo") to croak, and we
3052 don't want that.
3053 */
a9c4fd4e 3054 const char* leaf = name;
6136c704 3055 const char* sep = NULL;
a9c4fd4e 3056 const char* p;
56304f61
CS
3057
3058 for (p = name; *p; p++) {
3059 if (*p == '\'')
3060 sep = p, leaf = p + 1;
3061 else if (*p == ':' && *(p + 1) == ':')
3062 sep = p, leaf = p + 2;
3063 }
3064 if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
9b9d0b15
NC
3065 /* the method name is unqualified or starts with SUPER:: */
3066 bool need_strlen = 1;
3067 if (sep) {
3068 packname = CopSTASHPV(PL_curcop);
3069 }
3070 else if (stash) {
46c461b5 3071 HEK * const packhek = HvNAME_HEK(stash);
9b9d0b15
NC
3072 if (packhek) {
3073 packname = HEK_KEY(packhek);
3074 packlen = HEK_LEN(packhek);
3075 need_strlen = 0;
3076 } else {
3077 goto croak;
3078 }
3079 }
3080
3081 if (!packname) {
3082 croak:
e27ad1f2
AV
3083 Perl_croak(aTHX_
3084 "Can't use anonymous symbol table for method lookup");
9b9d0b15
NC
3085 }
3086 else if (need_strlen)
e27ad1f2 3087 packlen = strlen(packname);
9b9d0b15 3088
56304f61
CS
3089 }
3090 else {
af09ea45 3091 /* the method name is qualified */
56304f61
CS
3092 packname = name;
3093 packlen = sep - name;
3094 }
af09ea45
IK
3095
3096 /* we're relying on gv_fetchmethod not autovivifying the stash */
da51bb9b 3097 if (gv_stashpvn(packname, packlen, 0)) {
c1899e02 3098 Perl_croak(aTHX_
af09ea45
IK
3099 "Can't locate object method \"%s\" via package \"%.*s\"",
3100 leaf, (int)packlen, packname);
c1899e02
GS
3101 }
3102 else {
3103 Perl_croak(aTHX_
af09ea45
IK
3104 "Can't locate object method \"%s\" via package \"%.*s\""
3105 " (perhaps you forgot to load \"%.*s\"?)",
3106 leaf, (int)packlen, packname, (int)packlen, packname);
c1899e02 3107 }
56304f61 3108 }
f5d5a27c 3109 return isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv;
a0d0e21e 3110}
241d1a3b
NC
3111
3112/*
3113 * Local variables:
3114 * c-indentation-style: bsd
3115 * c-basic-offset: 4
3116 * indent-tabs-mode: t
3117 * End:
3118 *
37442d52
RGS
3119 * ex: set ts=8 sts=4 sw=4 noet:
3120 */