This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Re: [ID 20010809.023] perlre misleads when stating that (?i) should be at front of...
[perl5.git] / pp.c
CommitLineData
a0d0e21e 1/* pp.c
79072805 2 *
bc89e66f 3 * Copyright (c) 1991-2001, Larry Wall
79072805 4 *
a0d0e21e
LW		 5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
79072805 7 *
a0d0e21e
LW		 8 */
9
10/*
11 * "It's a big house this, and very peculiar. Always a bit more to discover,
12 * and no knowing what you'll find around a corner. And Elves, sir!" --Samwise
13 */
79072805
LW		 14
15#include "EXTERN.h"
864dbfa3 16#define PERL_IN_PP_C
79072805
LW		 17#include "perl.h"
18
a0d0e21e 19/* variations on pp_null */
79072805 20
dfe9444c
AD		 21/* XXX I can't imagine anyone who doesn't have this actually _needs_
22 it, since pid_t is an integral type.
23 --AD 2/20/1998
24*/
25#ifdef NEED_GETPID_PROTO
26extern Pid_t getpid (void);
8ac85365
NIS		 27#endif
28
93a17b20
LW		 29PP(pp_stub)
30{
39644a26 31 dSP;
54310121 32 if (GIMME_V == G_SCALAR)
3280af22 33 XPUSHs(&PL_sv_undef);
93a17b20
LW		 34 RETURN;
35}
36
79072805
LW		 37PP(pp_scalar)
38{
39 return NORMAL;
40}
41
42/* Pushy stuff. */
43
93a17b20
LW		 44PP(pp_padav)
45{
39644a26 46 dSP; dTARGET;
533c011a
NIS		 47 if (PL_op->op_private & OPpLVAL_INTRO)
48 SAVECLEARSV(PL_curpad[PL_op->op_targ]);
85e6fe83 49 EXTEND(SP, 1);
533c011a 50 if (PL_op->op_flags & OPf_REF) {
85e6fe83 51 PUSHs(TARG);
93a17b20 52 RETURN;
78f9721b
SM		 53 } else if (LVRET) {
54 if (GIMME == G_SCALAR)
55 Perl_croak(aTHX_ "Can't return array to lvalue scalar context");
56 PUSHs(TARG);
57 RETURN;
85e6fe83
LW		 58 }
59 if (GIMME == G_ARRAY) {
60 I32 maxarg = AvFILL((AV*)TARG) + 1;
61 EXTEND(SP, maxarg);
93965878
NIS		 62 if (SvMAGICAL(TARG)) {
63 U32 i;
64 for (i=0; i < maxarg; i++) {
65 SV **svp = av_fetch((AV*)TARG, i, FALSE);
3280af22 66 SP[i+1] = (svp) ? *svp : &PL_sv_undef;
93965878
NIS		 67 }
68 }
69 else {
70 Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
71 }
85e6fe83
LW		 72 SP += maxarg;
73 }
74 else {
75 SV* sv = sv_newmortal();
76 I32 maxarg = AvFILL((AV*)TARG) + 1;
77 sv_setiv(sv, maxarg);
78 PUSHs(sv);
79 }
80 RETURN;
93a17b20
LW		 81}
82
83PP(pp_padhv)
84{
39644a26 85 dSP; dTARGET;
54310121 86 I32 gimme;
87
93a17b20 88 XPUSHs(TARG);
533c011a
NIS		 89 if (PL_op->op_private & OPpLVAL_INTRO)
90 SAVECLEARSV(PL_curpad[PL_op->op_targ]);
91 if (PL_op->op_flags & OPf_REF)
93a17b20 92 RETURN;
78f9721b
SM		 93 else if (LVRET) {
94 if (GIMME == G_SCALAR)
95 Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
96 RETURN;
97 }
54310121 98 gimme = GIMME_V;
99 if (gimme == G_ARRAY) {
cea2e8a9 100 RETURNOP(do_kv());
85e6fe83 101 }
54310121 102 else if (gimme == G_SCALAR) {
85e6fe83 103 SV* sv = sv_newmortal();
46fc3d4c 104 if (HvFILL((HV*)TARG))
cea2e8a9 105 Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
46fc3d4c 106 (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1);
85e6fe83
LW		 107 else
108 sv_setiv(sv, 0);
109 SETs(sv);
85e6fe83 110 }
54310121 111 RETURN;
93a17b20
LW		 112}
113
ed6116ce
LW		 114PP(pp_padany)
115{
cea2e8a9 116 DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
ed6116ce
LW		 117}
118
79072805
LW		 119/* Translations. */
120
121PP(pp_rv2gv)
122{
39644a26 123 dSP; dTOPss;
8ec5e241 124
ed6116ce 125 if (SvROK(sv)) {
a0d0e21e 126 wasref:
f5284f61
IZ		 127 tryAMAGICunDEREF(to_gv);
128
ed6116ce 129 sv = SvRV(sv);
b1dadf13 130 if (SvTYPE(sv) == SVt_PVIO) {
131 GV *gv = (GV*) sv_newmortal();
132 gv_init(gv, 0, "", 0, 0);
133 GvIOp(gv) = (IO *)sv;
3e3baf6d 134 (void)SvREFCNT_inc(sv);
b1dadf13 135 sv = (SV*) gv;
ef54e1a4
JH		 136 }
137 else if (SvTYPE(sv) != SVt_PVGV)
cea2e8a9 138 DIE(aTHX_ "Not a GLOB reference");
79072805
LW		 139 }
140 else {
93a17b20 141 if (SvTYPE(sv) != SVt_PVGV) {
748a9306 142 char *sym;
c9d5ac95 143 STRLEN len;
748a9306 144
a0d0e21e
LW		 145 if (SvGMAGICAL(sv)) {
146 mg_get(sv);
147 if (SvROK(sv))
148 goto wasref;
149 }
afd1915d 150 if (!SvOK(sv) && sv != &PL_sv_undef) {
b13b2135 151 /* If this is a 'my' scalar and flag is set then vivify
853846ea 152 * NI-S 1999/05/07
b13b2135 153 */
1d8d4d2a 154 if (PL_op->op_private & OPpDEREF) {
2c8ac474
GS		 155 char *name;
156 GV *gv;
157 if (cUNOP->op_targ) {
158 STRLEN len;
159 SV *namesv = PL_curpad[cUNOP->op_targ];
160 name = SvPV(namesv, len);
2d6d9f7a 161 gv = (GV*)NEWSV(0,0);
2c8ac474
GS		 162 gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
163 }
164 else {
165 name = CopSTASHPV(PL_curcop);
166 gv = newGVgen(name);
1d8d4d2a 167 }
b13b2135
NIS		 168 if (SvTYPE(sv) < SVt_RV)
169 sv_upgrade(sv, SVt_RV);
2c8ac474 170 SvRV(sv) = (SV*)gv;
853846ea 171 SvROK_on(sv);
1d8d4d2a 172 SvSETMAGIC(sv);
853846ea 173 goto wasref;
2c8ac474 174 }
533c011a
NIS		 175 if (PL_op->op_flags & OPf_REF ||
176 PL_op->op_private & HINT_STRICT_REFS)
cea2e8a9 177 DIE(aTHX_ PL_no_usym, "a symbol");
599cee73 178 if (ckWARN(WARN_UNINITIALIZED))
b89fed5f 179 report_uninit();
a0d0e21e
LW		 180 RETSETUNDEF;
181 }
c9d5ac95 182 sym = SvPV(sv,len);
35cd451c
GS		 183 if ((PL_op->op_flags & OPf_SPECIAL) &&
184 !(PL_op->op_flags & OPf_MOD))
185 {
186 sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV);
c9d5ac95
GS		 187 if (!sv
188 && (!is_gv_magical(sym,len,0)
189 || !(sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV))))
190 {
35cd451c 191 RETSETUNDEF;
c9d5ac95 192 }
35cd451c
GS		 193 }
194 else {
195 if (PL_op->op_private & HINT_STRICT_REFS)
cea2e8a9 196 DIE(aTHX_ PL_no_symref, sym, "a symbol");
35cd451c
GS		 197 sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
198 }
93a17b20 199 }
79072805 200 }
533c011a
NIS		 201 if (PL_op->op_private & OPpLVAL_INTRO)
202 save_gp((GV*)sv, !(PL_op->op_flags & OPf_SPECIAL));
79072805
LW		 203 SETs(sv);
204 RETURN;
205}
206
79072805
LW		 207PP(pp_rv2sv)
208{
39644a26 209 dSP; dTOPss;
79072805 210
ed6116ce 211 if (SvROK(sv)) {
a0d0e21e 212 wasref:
f5284f61
IZ		 213 tryAMAGICunDEREF(to_sv);
214
ed6116ce 215 sv = SvRV(sv);
79072805
LW		 216 switch (SvTYPE(sv)) {
217 case SVt_PVAV:
218 case SVt_PVHV:
219 case SVt_PVCV:
cea2e8a9 220 DIE(aTHX_ "Not a SCALAR reference");
79072805
LW		 221 }
222 }
223 else {
f12c7020 224 GV *gv = (GV*)sv;
748a9306 225 char *sym;
c9d5ac95 226 STRLEN len;
748a9306 227
463ee0b2 228 if (SvTYPE(gv) != SVt_PVGV) {
a0d0e21e
LW		 229 if (SvGMAGICAL(sv)) {
230 mg_get(sv);
231 if (SvROK(sv))
232 goto wasref;
233 }
234 if (!SvOK(sv)) {
533c011a
NIS		 235 if (PL_op->op_flags & OPf_REF ||
236 PL_op->op_private & HINT_STRICT_REFS)
cea2e8a9 237 DIE(aTHX_ PL_no_usym, "a SCALAR");
599cee73 238 if (ckWARN(WARN_UNINITIALIZED))
b89fed5f 239 report_uninit();
a0d0e21e
LW		 240 RETSETUNDEF;
241 }
c9d5ac95 242 sym = SvPV(sv, len);
35cd451c
GS		 243 if ((PL_op->op_flags & OPf_SPECIAL) &&
244 !(PL_op->op_flags & OPf_MOD))
245 {
246 gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV);
c9d5ac95
GS		 247 if (!gv
248 && (!is_gv_magical(sym,len,0)
249 || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV))))
250 {
35cd451c 251 RETSETUNDEF;
c9d5ac95 252 }
35cd451c
GS		 253 }
254 else {
255 if (PL_op->op_private & HINT_STRICT_REFS)
cea2e8a9 256 DIE(aTHX_ PL_no_symref, sym, "a SCALAR");
35cd451c
GS		 257 gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
258 }
463ee0b2
LW		 259 }
260 sv = GvSV(gv);
a0d0e21e 261 }
533c011a
NIS		 262 if (PL_op->op_flags & OPf_MOD) {
263 if (PL_op->op_private & OPpLVAL_INTRO)
a0d0e21e 264 sv = save_scalar((GV*)TOPs);
533c011a
NIS		 265 else if (PL_op->op_private & OPpDEREF)
266 vivify_ref(sv, PL_op->op_private & OPpDEREF);
79072805 267 }
a0d0e21e 268 SETs(sv);
79072805
LW		 269 RETURN;
270}
271
272PP(pp_av2arylen)
273{
39644a26 274 dSP;
79072805
LW		 275 AV *av = (AV*)TOPs;
276 SV *sv = AvARYLEN(av);
277 if (!sv) {
278 AvARYLEN(av) = sv = NEWSV(0,0);
279 sv_upgrade(sv, SVt_IV);
14befaf4 280 sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0);
79072805
LW		 281 }
282 SETs(sv);
283 RETURN;
284}
285
a0d0e21e
LW		 286PP(pp_pos)
287{
39644a26 288 dSP; dTARGET; dPOPss;
8ec5e241 289
78f9721b 290 if (PL_op->op_flags & OPf_MOD || LVRET) {
5f05dabc 291 if (SvTYPE(TARG) < SVt_PVLV) {
292 sv_upgrade(TARG, SVt_PVLV);
14befaf4 293 sv_magic(TARG, Nullsv, PERL_MAGIC_pos, Nullch, 0);
5f05dabc 294 }
295
296 LvTYPE(TARG) = '.';
6ff81951
GS		 297 if (LvTARG(TARG) != sv) {
298 if (LvTARG(TARG))
299 SvREFCNT_dec(LvTARG(TARG));
300 LvTARG(TARG) = SvREFCNT_inc(sv);
301 }
a0d0e21e
LW		 302 PUSHs(TARG); /* no SvSETMAGIC */
303 RETURN;
304 }
305 else {
8ec5e241 306 MAGIC* mg;
a0d0e21e
LW		 307
308 if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
14befaf4 309 mg = mg_find(sv, PERL_MAGIC_regex_global);
565764a8 310 if (mg && mg->mg_len >= 0) {
a0ed51b3 311 I32 i = mg->mg_len;
7e2040f0 312 if (DO_UTF8(sv))
a0ed51b3
LW		 313 sv_pos_b2u(sv, &i);
314 PUSHi(i + PL_curcop->cop_arybase);
a0d0e21e
LW		 315 RETURN;
316 }
317 }
318 RETPUSHUNDEF;
319 }
320}
321
79072805
LW		 322PP(pp_rv2cv)
323{
39644a26 324 dSP;
79072805
LW		 325 GV *gv;
326 HV *stash;
8990e307 327
4633a7c4
LW		 328 /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
329 /* (But not in defined().) */
533c011a 330 CV *cv = sv_2cv(TOPs, &stash, &gv, !(PL_op->op_flags & OPf_SPECIAL));
07055b4c
CS		 331 if (cv) {
332 if (CvCLONE(cv))
333 cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
d32f2495
SC		 334 if ((PL_op->op_private & OPpLVAL_INTRO)) {
335 if (gv && GvCV(gv) == cv && (gv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), FALSE)))
336 cv = GvCV(gv);
337 if (!CvLVALUE(cv))
338 DIE(aTHX_ "Can't modify non-lvalue subroutine call");
339 }
07055b4c
CS		 340 }
341 else
3280af22 342 cv = (CV*)&PL_sv_undef;
79072805
LW		 343 SETs((SV*)cv);
344 RETURN;
345}
346
c07a80fd 347PP(pp_prototype)
348{
39644a26 349 dSP;
c07a80fd 350 CV *cv;
351 HV *stash;
352 GV *gv;
353 SV *ret;
354
3280af22 355 ret = &PL_sv_undef;
b6c543e3
IZ		 356 if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
357 char *s = SvPVX(TOPs);
358 if (strnEQ(s, "CORE::", 6)) {
359 int code;
b13b2135 360
b6c543e3
IZ		 361 code = keyword(s + 6, SvCUR(TOPs) - 6);
362 if (code < 0) { /* Overridable. */
363#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
364 int i = 0, n = 0, seen_question = 0;
365 I32 oa;
366 char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
367
368 while (i < MAXO) { /* The slow way. */
22c35a8c
GS		 369 if (strEQ(s + 6, PL_op_name[i])
370 || strEQ(s + 6, PL_op_desc[i]))
371 {
b6c543e3 372 goto found;
22c35a8c 373 }
b6c543e3
IZ		 374 i++;
375 }
376 goto nonesuch; /* Should not happen... */
377 found:
22c35a8c 378 oa = PL_opargs[i] >> OASHIFT;
b6c543e3 379 while (oa) {
3012a639 380 if (oa & OA_OPTIONAL && !seen_question) {
b6c543e3
IZ		 381 seen_question = 1;
382 str[n++] = ';';
ef54e1a4 383 }
b13b2135 384 else if (n && str[0] == ';' && seen_question)
b6c543e3 385 goto set; /* XXXX system, exec */
b13b2135 386 if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
6e97e420
SC		 387 && (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF
388 /* But globs are already references (kinda) */
389 && (oa & (OA_OPTIONAL - 1)) != OA_FILEREF
390 ) {
b6c543e3
IZ		 391 str[n++] = '\\';
392 }
b6c543e3
IZ		 393 str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
394 oa = oa >> 4;
395 }
396 str[n++] = '\0';
79cb57f6 397 ret = sv_2mortal(newSVpvn(str, n - 1));
ef54e1a4
JH		 398 }
399 else if (code) /* Non-Overridable */
b6c543e3
IZ		 400 goto set;
401 else { /* None such */
402 nonesuch:
d470f89e 403 DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
b6c543e3
IZ		 404 }
405 }
406 }
c07a80fd 407 cv = sv_2cv(TOPs, &stash, &gv, FALSE);
5f05dabc 408 if (cv && SvPOK(cv))
79cb57f6 409 ret = sv_2mortal(newSVpvn(SvPVX(cv), SvCUR(cv)));
b6c543e3 410 set:
c07a80fd 411 SETs(ret);
412 RETURN;
413}
414
a0d0e21e
LW		 415PP(pp_anoncode)
416{
39644a26 417 dSP;
533c011a 418 CV* cv = (CV*)PL_curpad[PL_op->op_targ];
a5f75d66 419 if (CvCLONE(cv))
b355b4e0 420 cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
5f05dabc 421 EXTEND(SP,1);
748a9306 422 PUSHs((SV*)cv);
a0d0e21e
LW		 423 RETURN;
424}
425
426PP(pp_srefgen)
79072805 427{
39644a26 428 dSP;
71be2cbc 429 *SP = refto(*SP);
79072805 430 RETURN;
8ec5e241 431}
a0d0e21e
LW		 432
433PP(pp_refgen)
434{
39644a26 435 dSP; dMARK;
a0d0e21e 436 if (GIMME != G_ARRAY) {
5f0b1d4e
GS		 437 if (++MARK <= SP)
438 *MARK = *SP;
439 else
3280af22 440 *MARK = &PL_sv_undef;
5f0b1d4e
GS		 441 *MARK = refto(*MARK);
442 SP = MARK;
443 RETURN;
a0d0e21e 444 }
bbce6d69 445 EXTEND_MORTAL(SP - MARK);
71be2cbc 446 while (++MARK <= SP)
447 *MARK = refto(*MARK);
a0d0e21e 448 RETURN;
79072805
LW		 449}
450
76e3520e 451STATIC SV*
cea2e8a9 452S_refto(pTHX_ SV *sv)
71be2cbc 453{
454 SV* rv;
455
456 if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
457 if (LvTARGLEN(sv))
68dc0745 458 vivify_defelem(sv);
459 if (!(sv = LvTARG(sv)))
3280af22 460 sv = &PL_sv_undef;
0dd88869 461 else
a6c40364 462 (void)SvREFCNT_inc(sv);
71be2cbc 463 }
d8b46c1b
GS		 464 else if (SvTYPE(sv) == SVt_PVAV) {
465 if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv))
466 av_reify((AV*)sv);
467 SvTEMP_off(sv);
468 (void)SvREFCNT_inc(sv);
469 }
f2933f5f
DM		 470 else if (SvPADTMP(sv) && !IS_PADGV(sv))
471 sv = newSVsv(sv);
71be2cbc 472 else {
473 SvTEMP_off(sv);
474 (void)SvREFCNT_inc(sv);
475 }
476 rv = sv_newmortal();
477 sv_upgrade(rv, SVt_RV);
478 SvRV(rv) = sv;
479 SvROK_on(rv);
480 return rv;
481}
482
79072805
LW		 483PP(pp_ref)
484{
39644a26 485 dSP; dTARGET;
463ee0b2 486 SV *sv;
79072805
LW		 487 char *pv;
488
a0d0e21e 489 sv = POPs;
f12c7020 490
491 if (sv && SvGMAGICAL(sv))
8ec5e241 492 mg_get(sv);
f12c7020 493
a0d0e21e 494 if (!sv || !SvROK(sv))
4633a7c4 495 RETPUSHNO;
79072805 496
ed6116ce 497 sv = SvRV(sv);
a0d0e21e 498 pv = sv_reftype(sv,TRUE);
463ee0b2 499 PUSHp(pv, strlen(pv));
79072805
LW		 500 RETURN;
501}
502
503PP(pp_bless)
504{
39644a26 505 dSP;
463ee0b2 506 HV *stash;
79072805 507
463ee0b2 508 if (MAXARG == 1)
11faa288 509 stash = CopSTASH(PL_curcop);
7b8d334a
GS		 510 else {
511 SV *ssv = POPs;
512 STRLEN len;
81689caa
HS		 513 char *ptr;
514
016a42f3 515 if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
81689caa
HS		 516 Perl_croak(aTHX_ "Attempt to bless into a reference");
517 ptr = SvPV(ssv,len);
e476b1b5 518 if (ckWARN(WARN_MISC) && len == 0)
b13b2135 519 Perl_warner(aTHX_ WARN_MISC,
599cee73 520 "Explicit blessing to '' (assuming package main)");
7b8d334a
GS		 521 stash = gv_stashpvn(ptr, len, TRUE);
522 }
a0d0e21e 523
5d3fdfeb 524 (void)sv_bless(TOPs, stash);
79072805
LW		 525 RETURN;
526}
527
fb73857a 528PP(pp_gelem)
529{
530 GV *gv;
531 SV *sv;
76e3520e 532 SV *tmpRef;
fb73857a 533 char *elem;
39644a26 534 dSP;
2d8e6c8d 535 STRLEN n_a;
b13b2135 536
fb73857a 537 sv = POPs;
2d8e6c8d 538 elem = SvPV(sv, n_a);
fb73857a 539 gv = (GV*)POPs;
76e3520e 540 tmpRef = Nullsv;
fb73857a 541 sv = Nullsv;
542 switch (elem ? *elem : '\0')
543 {
544 case 'A':
545 if (strEQ(elem, "ARRAY"))
76e3520e 546 tmpRef = (SV*)GvAV(gv);
fb73857a 547 break;
548 case 'C':
549 if (strEQ(elem, "CODE"))
76e3520e 550 tmpRef = (SV*)GvCVu(gv);
fb73857a 551 break;
552 case 'F':
553 if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
76e3520e 554 tmpRef = (SV*)GvIOp(gv);
f4d13ee9
JH		 555 else
556 if (strEQ(elem, "FORMAT"))
557 tmpRef = (SV*)GvFORM(gv);
fb73857a 558 break;
559 case 'G':
560 if (strEQ(elem, "GLOB"))
76e3520e 561 tmpRef = (SV*)gv;
fb73857a 562 break;
563 case 'H':
564 if (strEQ(elem, "HASH"))
76e3520e 565 tmpRef = (SV*)GvHV(gv);
fb73857a 566 break;
567 case 'I':
568 if (strEQ(elem, "IO"))
76e3520e 569 tmpRef = (SV*)GvIOp(gv);
fb73857a 570 break;
571 case 'N':
572 if (strEQ(elem, "NAME"))
79cb57f6 573 sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv));
fb73857a 574 break;
575 case 'P':
576 if (strEQ(elem, "PACKAGE"))
577 sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
578 break;
579 case 'S':
580 if (strEQ(elem, "SCALAR"))
76e3520e 581 tmpRef = GvSV(gv);
fb73857a 582 break;
583 }
76e3520e
GS		 584 if (tmpRef)
585 sv = newRV(tmpRef);
fb73857a 586 if (sv)
587 sv_2mortal(sv);
588 else
3280af22 589 sv = &PL_sv_undef;
fb73857a 590 XPUSHs(sv);
591 RETURN;
592}
593
a0d0e21e 594/* Pattern matching */
79072805 595
a0d0e21e 596PP(pp_study)
79072805 597{
39644a26 598 dSP; dPOPss;
a0d0e21e
LW		 599 register unsigned char *s;
600 register I32 pos;
601 register I32 ch;
602 register I32 *sfirst;
603 register I32 *snext;
a0d0e21e
LW		 604 STRLEN len;
605
3280af22 606 if (sv == PL_lastscream) {
1e422769 607 if (SvSCREAM(sv))
608 RETPUSHYES;
609 }
c07a80fd 610 else {
3280af22
NIS		 611 if (PL_lastscream) {
612 SvSCREAM_off(PL_lastscream);
613 SvREFCNT_dec(PL_lastscream);
c07a80fd 614 }
3280af22 615 PL_lastscream = SvREFCNT_inc(sv);
c07a80fd 616 }
1e422769 617
618 s = (unsigned char*)(SvPV(sv, len));
619 pos = len;
620 if (pos <= 0)
621 RETPUSHNO;
3280af22
NIS		 622 if (pos > PL_maxscream) {
623 if (PL_maxscream < 0) {
624 PL_maxscream = pos + 80;
625 New(301, PL_screamfirst, 256, I32);
626 New(302, PL_screamnext, PL_maxscream, I32);
79072805
LW		 627 }
628 else {
3280af22
NIS		 629 PL_maxscream = pos + pos / 4;
630 Renew(PL_screamnext, PL_maxscream, I32);
79072805 631 }
79072805 632 }
a0d0e21e 633
3280af22
NIS		 634 sfirst = PL_screamfirst;
635 snext = PL_screamnext;
a0d0e21e
LW		 636
637 if (!sfirst || !snext)
cea2e8a9 638 DIE(aTHX_ "do_study: out of memory");
a0d0e21e
LW		 639
640 for (ch = 256; ch; --ch)
641 *sfirst++ = -1;
642 sfirst -= 256;
643
644 while (--pos >= 0) {
645 ch = s[pos];
646 if (sfirst[ch] >= 0)
647 snext[pos] = sfirst[ch] - pos;
648 else
649 snext[pos] = -pos;
650 sfirst[ch] = pos;
79072805
LW		 651 }
652
c07a80fd 653 SvSCREAM_on(sv);
14befaf4
DM		 654 /* piggyback on m//g magic */
655 sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0);
1e422769 656 RETPUSHYES;
79072805
LW		 657}
658
a0d0e21e 659PP(pp_trans)
79072805 660{
39644a26 661 dSP; dTARG;
a0d0e21e
LW		 662 SV *sv;
663
533c011a 664 if (PL_op->op_flags & OPf_STACKED)
a0d0e21e 665 sv = POPs;
79072805 666 else {
54b9620d 667 sv = DEFSV;
a0d0e21e 668 EXTEND(SP,1);
79072805 669 }
adbc6bb1 670 TARG = sv_newmortal();
4757a243 671 PUSHi(do_trans(sv));
a0d0e21e 672 RETURN;
79072805
LW		 673}
674
a0d0e21e 675/* Lvalue operators. */
79072805 676
a0d0e21e
LW		 677PP(pp_schop)
678{
39644a26 679 dSP; dTARGET;
a0d0e21e
LW		 680 do_chop(TARG, TOPs);
681 SETTARG;
682 RETURN;
79072805
LW		 683}
684
a0d0e21e 685PP(pp_chop)
79072805 686{
2ec6af5f
RG		 687 dSP; dMARK; dTARGET; dORIGMARK;
688 while (MARK < SP)
689 do_chop(TARG, *++MARK);
690 SP = ORIGMARK;
a0d0e21e
LW		 691 PUSHTARG;
692 RETURN;
79072805
LW		 693}
694
a0d0e21e 695PP(pp_schomp)
79072805 696{
39644a26 697 dSP; dTARGET;
a0d0e21e
LW		 698 SETi(do_chomp(TOPs));
699 RETURN;
79072805
LW		 700}
701
a0d0e21e 702PP(pp_chomp)
79072805 703{
39644a26 704 dSP; dMARK; dTARGET;
a0d0e21e 705 register I32 count = 0;
8ec5e241 706
a0d0e21e
LW		 707 while (SP > MARK)
708 count += do_chomp(POPs);
709 PUSHi(count);
710 RETURN;
79072805
LW		 711}
712
a0d0e21e 713PP(pp_defined)
463ee0b2 714{
39644a26 715 dSP;
a0d0e21e
LW		 716 register SV* sv;
717
718 sv = POPs;
719 if (!sv || !SvANY(sv))
720 RETPUSHNO;
721 switch (SvTYPE(sv)) {
722 case SVt_PVAV:
14befaf4
DM		 723 if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
724 || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
a0d0e21e
LW		 725 RETPUSHYES;
726 break;
727 case SVt_PVHV:
14befaf4
DM		 728 if (HvARRAY(sv) || SvGMAGICAL(sv)
729 || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
a0d0e21e
LW		 730 RETPUSHYES;
731 break;
732 case SVt_PVCV:
733 if (CvROOT(sv) || CvXSUB(sv))
734 RETPUSHYES;
735 break;
736 default:
737 if (SvGMAGICAL(sv))
738 mg_get(sv);
739 if (SvOK(sv))
740 RETPUSHYES;
741 }
742 RETPUSHNO;
463ee0b2
LW		 743}
744
a0d0e21e
LW		 745PP(pp_undef)
746{
39644a26 747 dSP;
a0d0e21e
LW		 748 SV *sv;
749
533c011a 750 if (!PL_op->op_private) {
774d564b 751 EXTEND(SP, 1);
a0d0e21e 752 RETPUSHUNDEF;
774d564b 753 }
79072805 754
a0d0e21e
LW		 755 sv = POPs;
756 if (!sv)
757 RETPUSHUNDEF;
85e6fe83 758
6fc92669
GS		 759 if (SvTHINKFIRST(sv))
760 sv_force_normal(sv);
85e6fe83 761
a0d0e21e
LW		 762 switch (SvTYPE(sv)) {
763 case SVt_NULL:
764 break;
765 case SVt_PVAV:
766 av_undef((AV*)sv);
767 break;
768 case SVt_PVHV:
769 hv_undef((HV*)sv);
770 break;
771 case SVt_PVCV:
e476b1b5
GS		 772 if (ckWARN(WARN_MISC) && cv_const_sv((CV*)sv))
773 Perl_warner(aTHX_ WARN_MISC, "Constant subroutine %s undefined",
54310121 774 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
9607fc9c 775 /* FALL THROUGH */
776 case SVt_PVFM:
6fc92669
GS		 777 {
778 /* let user-undef'd sub keep its identity */
65c50114 779 GV* gv = CvGV((CV*)sv);
6fc92669
GS		 780 cv_undef((CV*)sv);
781 CvGV((CV*)sv) = gv;
782 }
a0d0e21e 783 break;
8e07c86e 784 case SVt_PVGV:
44a8e56a 785 if (SvFAKE(sv))
3280af22 786 SvSetMagicSV(sv, &PL_sv_undef);
20408e3c
GS		 787 else {
788 GP *gp;
789 gp_free((GV*)sv);
790 Newz(602, gp, 1, GP);
791 GvGP(sv) = gp_ref(gp);
792 GvSV(sv) = NEWSV(72,0);
57843af0 793 GvLINE(sv) = CopLINE(PL_curcop);
20408e3c
GS		 794 GvEGV(sv) = (GV*)sv;
795 GvMULTI_on(sv);
796 }
44a8e56a 797 break;
a0d0e21e 798 default:
1e422769 799 if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
4633a7c4
LW		 800 (void)SvOOK_off(sv);
801 Safefree(SvPVX(sv));
802 SvPV_set(sv, Nullch);
803 SvLEN_set(sv, 0);
a0d0e21e 804 }
4633a7c4
LW		 805 (void)SvOK_off(sv);
806 SvSETMAGIC(sv);
79072805 807 }
a0d0e21e
LW		 808
809 RETPUSHUNDEF;
79072805
LW		 810}
811
a0d0e21e 812PP(pp_predec)
79072805 813{
39644a26 814 dSP;
68dc0745 815 if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
d470f89e 816 DIE(aTHX_ PL_no_modify);
25da4f38 817 if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
55497cff 818 SvIVX(TOPs) != IV_MIN)
819 {
748a9306 820 --SvIVX(TOPs);
55497cff 821 SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
748a9306
LW		 822 }
823 else
824 sv_dec(TOPs);
a0d0e21e
LW		 825 SvSETMAGIC(TOPs);
826 return NORMAL;
827}
79072805 828
a0d0e21e
LW		 829PP(pp_postinc)
830{
39644a26 831 dSP; dTARGET;
68dc0745 832 if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
d470f89e 833 DIE(aTHX_ PL_no_modify);
a0d0e21e 834 sv_setsv(TARG, TOPs);
25da4f38 835 if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
55497cff 836 SvIVX(TOPs) != IV_MAX)
837 {
748a9306 838 ++SvIVX(TOPs);
55497cff 839 SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
748a9306
LW		 840 }
841 else
842 sv_inc(TOPs);
a0d0e21e
LW		 843 SvSETMAGIC(TOPs);
844 if (!SvOK(TARG))
845 sv_setiv(TARG, 0);
846 SETs(TARG);
847 return NORMAL;
848}
79072805 849
a0d0e21e
LW		 850PP(pp_postdec)
851{
39644a26 852 dSP; dTARGET;
43192e07 853 if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
d470f89e 854 DIE(aTHX_ PL_no_modify);
a0d0e21e 855 sv_setsv(TARG, TOPs);
25da4f38 856 if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
55497cff 857 SvIVX(TOPs) != IV_MIN)
858 {
748a9306 859 --SvIVX(TOPs);
55497cff 860 SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
748a9306
LW		 861 }
862 else
863 sv_dec(TOPs);
a0d0e21e
LW		 864 SvSETMAGIC(TOPs);
865 SETs(TARG);
866 return NORMAL;
867}
79072805 868
a0d0e21e
LW		 869/* Ordinary operators. */
870
871PP(pp_pow)
872{
39644a26 873 dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
a0d0e21e
LW		 874 {
875 dPOPTOPnnrl;
73b309ea 876 SETn( Perl_pow( left, right) );
a0d0e21e 877 RETURN;
93a17b20 878 }
a0d0e21e
LW		 879}
880
881PP(pp_multiply)
882{
39644a26 883 dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
28e5dec8
JH		 884#ifdef PERL_PRESERVE_IVUV
885 SvIV_please(TOPs);
886 if (SvIOK(TOPs)) {
887 /* Unless the left argument is integer in range we are going to have to
888 use NV maths. Hence only attempt to coerce the right argument if
889 we know the left is integer. */
890 /* Left operand is defined, so is it IV? */
891 SvIV_please(TOPm1s);
892 if (SvIOK(TOPm1s)) {
893 bool auvok = SvUOK(TOPm1s);
894 bool buvok = SvUOK(TOPs);
895 const UV topmask = (~ (UV)0) << (4 * sizeof (UV));
896 const UV botmask = ~((~ (UV)0) << (4 * sizeof (UV)));
897 UV alow;
898 UV ahigh;
899 UV blow;
900 UV bhigh;
901
902 if (auvok) {
903 alow = SvUVX(TOPm1s);
904 } else {
905 IV aiv = SvIVX(TOPm1s);
906 if (aiv >= 0) {
907 alow = aiv;
908 auvok = TRUE; /* effectively it's a UV now */
909 } else {
910 alow = -aiv; /* abs, auvok == false records sign */
911 }
912 }
913 if (buvok) {
914 blow = SvUVX(TOPs);
915 } else {
916 IV biv = SvIVX(TOPs);
917 if (biv >= 0) {
918 blow = biv;
919 buvok = TRUE; /* effectively it's a UV now */
920 } else {
921 blow = -biv; /* abs, buvok == false records sign */
922 }
923 }
924
925 /* If this does sign extension on unsigned it's time for plan B */
926 ahigh = alow >> (4 * sizeof (UV));
927 alow &= botmask;
928 bhigh = blow >> (4 * sizeof (UV));
929 blow &= botmask;
930 if (ahigh && bhigh) {
931 /* eg 32 bit is at least 0x10000 * 0x10000 == 0x100000000
932 which is overflow. Drop to NVs below. */
933 } else if (!ahigh && !bhigh) {
934 /* eg 32 bit is at most 0xFFFF * 0xFFFF == 0xFFFE0001
935 so the unsigned multiply cannot overflow. */
936 UV product = alow * blow;
937 if (auvok == buvok) {
938 /* -ve * -ve or +ve * +ve gives a +ve result. */
939 SP--;
940 SETu( product );
941 RETURN;
942 } else if (product <= (UV)IV_MIN) {
943 /* 2s complement assumption that (UV)-IV_MIN is correct. */
944 /* -ve result, which could overflow an IV */
945 SP--;
25716404 946 SETi( -(IV)product );
28e5dec8
JH		 947 RETURN;
948 } /* else drop to NVs below. */
949 } else {
950 /* One operand is large, 1 small */
951 UV product_middle;
952 if (bhigh) {
953 /* swap the operands */
954 ahigh = bhigh;
955 bhigh = blow; /* bhigh now the temp var for the swap */
956 blow = alow;
957 alow = bhigh;
958 }
959 /* now, ((ahigh * blow) << half_UV_len) + (alow * blow)
960 multiplies can't overflow. shift can, add can, -ve can. */
961 product_middle = ahigh * blow;
962 if (!(product_middle & topmask)) {
963 /* OK, (ahigh * blow) won't lose bits when we shift it. */
964 UV product_low;
965 product_middle <<= (4 * sizeof (UV));
966 product_low = alow * blow;
967
968 /* as for pp_add, UV + something mustn't get smaller.
969 IIRC ANSI mandates this wrapping *behaviour* for
970 unsigned whatever the actual representation*/
971 product_low += product_middle;
972 if (product_low >= product_middle) {
973 /* didn't overflow */
974 if (auvok == buvok) {
975 /* -ve * -ve or +ve * +ve gives a +ve result. */
976 SP--;
977 SETu( product_low );
978 RETURN;
979 } else if (product_low <= (UV)IV_MIN) {
980 /* 2s complement assumption again */
981 /* -ve result, which could overflow an IV */
982 SP--;
25716404 983 SETi( -(IV)product_low );
28e5dec8
JH		 984 RETURN;
985 } /* else drop to NVs below. */
986 }
987 } /* product_middle too large */
988 } /* ahigh && bhigh */
989 } /* SvIOK(TOPm1s) */
990 } /* SvIOK(TOPs) */
991#endif
a0d0e21e
LW		 992 {
993 dPOPTOPnnrl;
994 SETn( left * right );
995 RETURN;
79072805 996 }
a0d0e21e
LW		 997}
998
999PP(pp_divide)
1000{
39644a26 1001 dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
a0d0e21e 1002 {
77676ba1 1003 dPOPPOPnnrl;
65202027 1004 NV value;
7a4c00b4 1005 if (right == 0.0)
cea2e8a9 1006 DIE(aTHX_ "Illegal division by zero");
a0d0e21e
LW		 1007#ifdef SLOPPYDIVIDE
1008 /* insure that 20./5. == 4. */
1009 {
7a4c00b4 1010 IV k;
65202027
DS		 1011 if ((NV)I_V(left) == left &&
1012 (NV)I_V(right) == right &&
7a4c00b4 1013 (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
a0d0e21e 1014 value = k;
ef54e1a4
JH		 1015 }
1016 else {
7a4c00b4 1017 value = left / right;
79072805 1018 }
a0d0e21e
LW		 1019 }
1020#else
7a4c00b4 1021 value = left / right;
a0d0e21e
LW		 1022#endif
1023 PUSHn( value );
1024 RETURN;
79072805 1025 }
a0d0e21e
LW		 1026}
1027
1028PP(pp_modulo)
1029{
39644a26 1030 dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
a0d0e21e 1031 {
9c5ffd7c
JH		 1032 UV left = 0;
1033 UV right = 0;
787eafbd
IZ		 1034 bool left_neg;
1035 bool right_neg;
1036 bool use_double = 0;
9c5ffd7c
JH		 1037 NV dright = 0.0;
1038 NV dleft = 0.0;
787eafbd 1039
d658dc55 1040 if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
787eafbd
IZ		 1041 IV i = SvIVX(POPs);
1042 right = (right_neg = (i < 0)) ? -i : i;
1043 }
1044 else {
1045 dright = POPn;
1046 use_double = 1;
1047 right_neg = dright < 0;
1048 if (right_neg)
1049 dright = -dright;
1050 }
a0d0e21e 1051
d658dc55 1052 if (!use_double && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
787eafbd
IZ		 1053 IV i = SvIVX(POPs);
1054 left = (left_neg = (i < 0)) ? -i : i;
1055 }
1056 else {
1057 dleft = POPn;
1058 if (!use_double) {
a1bd196e
GS		 1059 use_double = 1;
1060 dright = right;
787eafbd
IZ		 1061 }
1062 left_neg = dleft < 0;
1063 if (left_neg)
1064 dleft = -dleft;
1065 }
68dc0745 1066
787eafbd 1067 if (use_double) {
65202027 1068 NV dans;
787eafbd
IZ		 1069
1070#if 1
787eafbd
IZ		 1071/* Somehow U_V is pessimized even if CASTFLAGS is 0 */
1072# if CASTFLAGS & 2
1073# define CAST_D2UV(d) U_V(d)
1074# else
1075# define CAST_D2UV(d) ((UV)(d))
1076# endif
a1bd196e
GS		 1077 /* Tried to do this only in the case DOUBLESIZE <= UV_SIZE,
1078 * or, in other words, precision of UV more than of NV.
1079 * But in fact the approach below turned out to be an
1080 * optimization - floor() may be slow */
787eafbd
IZ		 1081 if (dright <= UV_MAX && dleft <= UV_MAX) {
1082 right = CAST_D2UV(dright);
1083 left = CAST_D2UV(dleft);
1084 goto do_uv;
1085 }
1086#endif
1087
1088 /* Backward-compatibility clause: */
73b309ea
JH		 1089 dright = Perl_floor(dright + 0.5);
1090 dleft = Perl_floor(dleft + 0.5);
787eafbd
IZ		 1091
1092 if (!dright)
cea2e8a9 1093 DIE(aTHX_ "Illegal modulus zero");
787eafbd 1094
65202027 1095 dans = Perl_fmod(dleft, dright);
787eafbd
IZ		 1096 if ((left_neg != right_neg) && dans)
1097 dans = dright - dans;
1098 if (right_neg)
1099 dans = -dans;
1100 sv_setnv(TARG, dans);
1101 }
1102 else {
1103 UV ans;
1104
1105 do_uv:
1106 if (!right)
cea2e8a9 1107 DIE(aTHX_ "Illegal modulus zero");
787eafbd
IZ		 1108
1109 ans = left % right;
1110 if ((left_neg != right_neg) && ans)
1111 ans = right - ans;
1112 if (right_neg) {
1113 /* XXX may warn: unary minus operator applied to unsigned type */
1114 /* could change -foo to be (~foo)+1 instead */
1115 if (ans <= ~((UV)IV_MAX)+1)
1116 sv_setiv(TARG, ~ans+1);
1117 else
65202027 1118 sv_setnv(TARG, -(NV)ans);
787eafbd
IZ		 1119 }
1120 else
1121 sv_setuv(TARG, ans);
1122 }
1123 PUSHTARG;
1124 RETURN;
79072805 1125 }
a0d0e21e 1126}
79072805 1127
a0d0e21e
LW		 1128PP(pp_repeat)
1129{
39644a26 1130 dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
748a9306 1131 {
467f0320 1132 register IV count = POPi;
533c011a 1133 if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
a0d0e21e
LW		 1134 dMARK;
1135 I32 items = SP - MARK;
1136 I32 max;
79072805 1137
a0d0e21e
LW		 1138 max = items * count;
1139 MEXTEND(MARK, max);
1140 if (count > 1) {
1141 while (SP > MARK) {
e30acc16
RH		 1142 if (*SP) {
1143 *SP = sv_2mortal(newSVsv(*SP));
1144 SvREADONLY_on(*SP);
1145 }
a0d0e21e 1146 SP--;
79072805 1147 }
a0d0e21e
LW		 1148 MARK++;
1149 repeatcpy((char*)(MARK + items), (char*)MARK,
1150 items * sizeof(SV*), count - 1);
1151 SP += max;
79072805 1152 }
a0d0e21e
LW		 1153 else if (count <= 0)
1154 SP -= items;
79072805 1155 }
a0d0e21e 1156 else { /* Note: mark already snarfed by pp_list */
dfcb284a 1157 SV *tmpstr = POPs;
a0d0e21e 1158 STRLEN len;
9b877dbb 1159 bool isutf;
a0d0e21e 1160
a0d0e21e
LW		 1161 SvSetSV(TARG, tmpstr);
1162 SvPV_force(TARG, len);
9b877dbb 1163 isutf = DO_UTF8(TARG);
8ebc5c01 1164 if (count != 1) {
1165 if (count < 1)
1166 SvCUR_set(TARG, 0);
1167 else {
1168 SvGROW(TARG, (count * len) + 1);
a0d0e21e 1169 repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
8ebc5c01 1170 SvCUR(TARG) *= count;
7a4c00b4 1171 }
a0d0e21e 1172 *SvEND(TARG) = '\0';
a0d0e21e 1173 }
dfcb284a
GS		 1174 if (isutf)
1175 (void)SvPOK_only_UTF8(TARG);
1176 else
1177 (void)SvPOK_only(TARG);
b80b6069
RH		 1178
1179 if (PL_op->op_private & OPpREPEAT_DOLIST) {
1180 /* The parser saw this as a list repeat, and there
1181 are probably several items on the stack. But we're
1182 in scalar context, and there's no pp_list to save us
1183 now. So drop the rest of the items -- robin@kitsite.com
1184 */
1185 dMARK;
1186 SP = MARK;
1187 }
a0d0e21e 1188 PUSHTARG;
79072805 1189 }
a0d0e21e 1190 RETURN;
748a9306 1191 }
a0d0e21e 1192}
79072805 1193
a0d0e21e
LW		 1194PP(pp_subtract)
1195{
39644a26 1196 dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
28e5dec8
JH		 1197 useleft = USE_LEFT(TOPm1s);
1198#ifdef PERL_PRESERVE_IVUV
7dca457a
NC		 1199 /* See comments in pp_add (in pp_hot.c) about Overflow, and how
1200 "bad things" happen if you rely on signed integers wrapping. */
28e5dec8
JH		 1201 SvIV_please(TOPs);
1202 if (SvIOK(TOPs)) {
1203 /* Unless the left argument is integer in range we are going to have to
1204 use NV maths. Hence only attempt to coerce the right argument if
1205 we know the left is integer. */
9c5ffd7c
JH		 1206 register UV auv = 0;
1207 bool auvok = FALSE;
7dca457a
NC		 1208 bool a_valid = 0;
1209
28e5dec8 1210 if (!useleft) {
7dca457a
NC		 1211 auv = 0;
1212 a_valid = auvok = 1;
1213 /* left operand is undef, treat as zero. */
28e5dec8
JH		 1214 } else {
1215 /* Left operand is defined, so is it IV? */
1216 SvIV_please(TOPm1s);
1217 if (SvIOK(TOPm1s)) {
7dca457a
NC		 1218 if ((auvok = SvUOK(TOPm1s)))
1219 auv = SvUVX(TOPm1s);
1220 else {
1221 register IV aiv = SvIVX(TOPm1s);
1222 if (aiv >= 0) {
1223 auv = aiv;
1224 auvok = 1; /* Now acting as a sign flag. */
1225 } else { /* 2s complement assumption for IV_MIN */
1226 auv = (UV)-aiv;
28e5dec8 1227 }
7dca457a
NC		 1228 }
1229 a_valid = 1;
1230 }
1231 }
1232 if (a_valid) {
1233 bool result_good = 0;
1234 UV result;
1235 register UV buv;
1236 bool buvok = SvUOK(TOPs);
9041c2e3 1237
7dca457a
NC		 1238 if (buvok)
1239 buv = SvUVX(TOPs);
1240 else {
1241 register IV biv = SvIVX(TOPs);
1242 if (biv >= 0) {
1243 buv = biv;
1244 buvok = 1;
1245 } else
1246 buv = (UV)-biv;
1247 }
1248 /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
1249 else "IV" now, independant of how it came in.
1250 if a, b represents positive, A, B negative, a maps to -A etc
1251 a - b => (a - b)
1252 A - b => -(a + b)
1253 a - B => (a + b)
1254 A - B => -(a - b)
1255 all UV maths. negate result if A negative.
1256 subtract if signs same, add if signs differ. */
1257
1258 if (auvok ^ buvok) {
1259 /* Signs differ. */
1260 result = auv + buv;
1261 if (result >= auv)
1262 result_good = 1;
1263 } else {
1264 /* Signs same */
1265 if (auv >= buv) {
1266 result = auv - buv;
1267 /* Must get smaller */
1268 if (result <= auv)
1269 result_good = 1;
1270 } else {
1271 result = buv - auv;
1272 if (result <= buv) {
1273 /* result really should be -(auv-buv). as its negation
1274 of true value, need to swap our result flag */
1275 auvok = !auvok;
1276 result_good = 1;
28e5dec8 1277 }
28e5dec8
JH		 1278 }
1279 }
7dca457a
NC		 1280 if (result_good) {
1281 SP--;
1282 if (auvok)
1283 SETu( result );
1284 else {
1285 /* Negate result */
1286 if (result <= (UV)IV_MIN)
1287 SETi( -(IV)result );
1288 else {
1289 /* result valid, but out of range for IV. */
1290 SETn( -(NV)result );
1291 }
1292 }
1293 RETURN;
1294 } /* Overflow, drop through to NVs. */
28e5dec8
JH		 1295 }
1296 }
1297#endif
7dca457a 1298 useleft = USE_LEFT(TOPm1s);
a0d0e21e 1299 {
28e5dec8
JH		 1300 dPOPnv;
1301 if (!useleft) {
1302 /* left operand is undef, treat as zero - value */
1303 SETn(-value);
1304 RETURN;
1305 }
1306 SETn( TOPn - value );
1307 RETURN;
79072805 1308 }
a0d0e21e 1309}
79072805 1310
a0d0e21e
LW		 1311PP(pp_left_shift)
1312{
39644a26 1313 dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
a0d0e21e 1314 {
972b05a9 1315 IV shift = POPi;
d0ba1bd2 1316 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 1317 IV i = TOPi;
1318 SETi(i << shift);
d0ba1bd2
JH		 1319 }
1320 else {
972b05a9
JH		 1321 UV u = TOPu;
1322 SETu(u << shift);
d0ba1bd2 1323 }
55497cff 1324 RETURN;
79072805 1325 }
a0d0e21e 1326}
79072805 1327
a0d0e21e
LW		 1328PP(pp_right_shift)
1329{
39644a26 1330 dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
a0d0e21e 1331 {
972b05a9 1332 IV shift = POPi;
d0ba1bd2 1333 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 1334 IV i = TOPi;
1335 SETi(i >> shift);
d0ba1bd2
JH		 1336 }
1337 else {
972b05a9
JH		 1338 UV u = TOPu;
1339 SETu(u >> shift);
d0ba1bd2 1340 }
a0d0e21e 1341 RETURN;
93a17b20 1342 }
79072805
LW		 1343}
1344
a0d0e21e 1345PP(pp_lt)
79072805 1346{
39644a26 1347 dSP; tryAMAGICbinSET(lt,0);
28e5dec8
JH		 1348#ifdef PERL_PRESERVE_IVUV
1349 SvIV_please(TOPs);
1350 if (SvIOK(TOPs)) {
1351 SvIV_please(TOPm1s);
1352 if (SvIOK(TOPm1s)) {
1353 bool auvok = SvUOK(TOPm1s);
1354 bool buvok = SvUOK(TOPs);
a227d84d 1355
28e5dec8
JH		 1356 if (!auvok && !buvok) { /* ## IV < IV ## */
1357 IV aiv = SvIVX(TOPm1s);
1358 IV biv = SvIVX(TOPs);
1359
1360 SP--;
1361 SETs(boolSV(aiv < biv));
1362 RETURN;
1363 }
1364 if (auvok && buvok) { /* ## UV < UV ## */
1365 UV auv = SvUVX(TOPm1s);
1366 UV buv = SvUVX(TOPs);
1367
1368 SP--;
1369 SETs(boolSV(auv < buv));
1370 RETURN;
1371 }
1372 if (auvok) { /* ## UV < IV ## */
1373 UV auv;
1374 IV biv;
1375
1376 biv = SvIVX(TOPs);
1377 SP--;
1378 if (biv < 0) {
1379 /* As (a) is a UV, it's >=0, so it cannot be < */
1380 SETs(&PL_sv_no);
1381 RETURN;
1382 }
1383 auv = SvUVX(TOPs);
1384 if (auv >= (UV) IV_MAX) {
1385 /* As (b) is an IV, it cannot be > IV_MAX */
1386 SETs(&PL_sv_no);
1387 RETURN;
1388 }
1389 SETs(boolSV(auv < (UV)biv));
1390 RETURN;
1391 }
1392 { /* ## IV < UV ## */
1393 IV aiv;
1394 UV buv;
1395
1396 aiv = SvIVX(TOPm1s);
1397 if (aiv < 0) {
1398 /* As (b) is a UV, it's >=0, so it must be < */
1399 SP--;
1400 SETs(&PL_sv_yes);
1401 RETURN;
1402 }
1403 buv = SvUVX(TOPs);
1404 SP--;
1405 if (buv > (UV) IV_MAX) {
1406 /* As (a) is an IV, it cannot be > IV_MAX */
1407 SETs(&PL_sv_yes);
1408 RETURN;
1409 }
1410 SETs(boolSV((UV)aiv < buv));
1411 RETURN;
1412 }
1413 }
1414 }
1415#endif
a0d0e21e
LW		 1416 {
1417 dPOPnv;
54310121 1418 SETs(boolSV(TOPn < value));
a0d0e21e 1419 RETURN;
79072805 1420 }
a0d0e21e 1421}
79072805 1422
a0d0e21e
LW		 1423PP(pp_gt)
1424{
39644a26 1425 dSP; tryAMAGICbinSET(gt,0);
28e5dec8
JH		 1426#ifdef PERL_PRESERVE_IVUV
1427 SvIV_please(TOPs);
1428 if (SvIOK(TOPs)) {
1429 SvIV_please(TOPm1s);
1430 if (SvIOK(TOPm1s)) {
1431 bool auvok = SvUOK(TOPm1s);
1432 bool buvok = SvUOK(TOPs);
a227d84d 1433
28e5dec8
JH		 1434 if (!auvok && !buvok) { /* ## IV > IV ## */
1435 IV aiv = SvIVX(TOPm1s);
1436 IV biv = SvIVX(TOPs);
1437
1438 SP--;
1439 SETs(boolSV(aiv > biv));
1440 RETURN;
1441 }
1442 if (auvok && buvok) { /* ## UV > UV ## */
1443 UV auv = SvUVX(TOPm1s);
1444 UV buv = SvUVX(TOPs);
1445
1446 SP--;
1447 SETs(boolSV(auv > buv));
1448 RETURN;
1449 }
1450 if (auvok) { /* ## UV > IV ## */
1451 UV auv;
1452 IV biv;
1453
1454 biv = SvIVX(TOPs);
1455 SP--;
1456 if (biv < 0) {
1457 /* As (a) is a UV, it's >=0, so it must be > */
1458 SETs(&PL_sv_yes);
1459 RETURN;
1460 }
1461 auv = SvUVX(TOPs);
1462 if (auv > (UV) IV_MAX) {
1463 /* As (b) is an IV, it cannot be > IV_MAX */
1464 SETs(&PL_sv_yes);
1465 RETURN;
1466 }
1467 SETs(boolSV(auv > (UV)biv));
1468 RETURN;
1469 }
1470 { /* ## IV > UV ## */
1471 IV aiv;
1472 UV buv;
1473
1474 aiv = SvIVX(TOPm1s);
1475 if (aiv < 0) {
1476 /* As (b) is a UV, it's >=0, so it cannot be > */
1477 SP--;
1478 SETs(&PL_sv_no);
1479 RETURN;
1480 }
1481 buv = SvUVX(TOPs);
1482 SP--;
1483 if (buv >= (UV) IV_MAX) {
1484 /* As (a) is an IV, it cannot be > IV_MAX */
1485 SETs(&PL_sv_no);
1486 RETURN;
1487 }
1488 SETs(boolSV((UV)aiv > buv));
1489 RETURN;
1490 }
1491 }
1492 }
1493#endif
a0d0e21e
LW		 1494 {
1495 dPOPnv;
54310121 1496 SETs(boolSV(TOPn > value));
a0d0e21e 1497 RETURN;
79072805 1498 }
a0d0e21e
LW		 1499}
1500
1501PP(pp_le)
1502{
39644a26 1503 dSP; tryAMAGICbinSET(le,0);
28e5dec8
JH		 1504#ifdef PERL_PRESERVE_IVUV
1505 SvIV_please(TOPs);
1506 if (SvIOK(TOPs)) {
1507 SvIV_please(TOPm1s);
1508 if (SvIOK(TOPm1s)) {
1509 bool auvok = SvUOK(TOPm1s);
1510 bool buvok = SvUOK(TOPs);
a227d84d 1511
28e5dec8
JH		 1512 if (!auvok && !buvok) { /* ## IV <= IV ## */
1513 IV aiv = SvIVX(TOPm1s);
1514 IV biv = SvIVX(TOPs);
1515
1516 SP--;
1517 SETs(boolSV(aiv <= biv));
1518 RETURN;
1519 }
1520 if (auvok && buvok) { /* ## UV <= UV ## */
1521 UV auv = SvUVX(TOPm1s);
1522 UV buv = SvUVX(TOPs);
1523
1524 SP--;
1525 SETs(boolSV(auv <= buv));
1526 RETURN;
1527 }
1528 if (auvok) { /* ## UV <= IV ## */
1529 UV auv;
1530 IV biv;
1531
1532 biv = SvIVX(TOPs);
1533 SP--;
1534 if (biv < 0) {
1535 /* As (a) is a UV, it's >=0, so a cannot be <= */
1536 SETs(&PL_sv_no);
1537 RETURN;
1538 }
1539 auv = SvUVX(TOPs);
1540 if (auv > (UV) IV_MAX) {
1541 /* As (b) is an IV, it cannot be > IV_MAX */
1542 SETs(&PL_sv_no);
1543 RETURN;
1544 }
1545 SETs(boolSV(auv <= (UV)biv));
1546 RETURN;
1547 }
1548 { /* ## IV <= UV ## */
1549 IV aiv;
1550 UV buv;
1551
1552 aiv = SvIVX(TOPm1s);
1553 if (aiv < 0) {
1554 /* As (b) is a UV, it's >=0, so a must be <= */
1555 SP--;
1556 SETs(&PL_sv_yes);
1557 RETURN;
1558 }
1559 buv = SvUVX(TOPs);
1560 SP--;
1561 if (buv >= (UV) IV_MAX) {
1562 /* As (a) is an IV, it cannot be > IV_MAX */
1563 SETs(&PL_sv_yes);
1564 RETURN;
1565 }
1566 SETs(boolSV((UV)aiv <= buv));
1567 RETURN;
1568 }
1569 }
1570 }
1571#endif
a0d0e21e
LW		 1572 {
1573 dPOPnv;
54310121 1574 SETs(boolSV(TOPn <= value));
a0d0e21e 1575 RETURN;
79072805 1576 }
a0d0e21e
LW		 1577}
1578
1579PP(pp_ge)
1580{
39644a26 1581 dSP; tryAMAGICbinSET(ge,0);
28e5dec8
JH		 1582#ifdef PERL_PRESERVE_IVUV
1583 SvIV_please(TOPs);
1584 if (SvIOK(TOPs)) {
1585 SvIV_please(TOPm1s);
1586 if (SvIOK(TOPm1s)) {
1587 bool auvok = SvUOK(TOPm1s);
1588 bool buvok = SvUOK(TOPs);
a227d84d 1589
28e5dec8
JH		 1590 if (!auvok && !buvok) { /* ## IV >= IV ## */
1591 IV aiv = SvIVX(TOPm1s);
1592 IV biv = SvIVX(TOPs);
1593
1594 SP--;
1595 SETs(boolSV(aiv >= biv));
1596 RETURN;
1597 }
1598 if (auvok && buvok) { /* ## UV >= UV ## */
1599 UV auv = SvUVX(TOPm1s);
1600 UV buv = SvUVX(TOPs);
1601
1602 SP--;
1603 SETs(boolSV(auv >= buv));
1604 RETURN;
1605 }
1606 if (auvok) { /* ## UV >= IV ## */
1607 UV auv;
1608 IV biv;
1609
1610 biv = SvIVX(TOPs);
1611 SP--;
1612 if (biv < 0) {
1613 /* As (a) is a UV, it's >=0, so it must be >= */
1614 SETs(&PL_sv_yes);
1615 RETURN;
1616 }
1617 auv = SvUVX(TOPs);
1618 if (auv >= (UV) IV_MAX) {
1619 /* As (b) is an IV, it cannot be > IV_MAX */
1620 SETs(&PL_sv_yes);
1621 RETURN;
1622 }
1623 SETs(boolSV(auv >= (UV)biv));
1624 RETURN;
1625 }
1626 { /* ## IV >= UV ## */
1627 IV aiv;
1628 UV buv;
1629
1630 aiv = SvIVX(TOPm1s);
1631 if (aiv < 0) {
1632 /* As (b) is a UV, it's >=0, so a cannot be >= */
1633 SP--;
1634 SETs(&PL_sv_no);
1635 RETURN;
1636 }
1637 buv = SvUVX(TOPs);
1638 SP--;
1639 if (buv > (UV) IV_MAX) {
1640 /* As (a) is an IV, it cannot be > IV_MAX */
1641 SETs(&PL_sv_no);
1642 RETURN;
1643 }
1644 SETs(boolSV((UV)aiv >= buv));
1645 RETURN;
1646 }
1647 }
1648 }
1649#endif
a0d0e21e
LW		 1650 {
1651 dPOPnv;
54310121 1652 SETs(boolSV(TOPn >= value));
a0d0e21e 1653 RETURN;
79072805 1654 }
a0d0e21e 1655}
79072805 1656
a0d0e21e
LW		 1657PP(pp_ne)
1658{
16303949 1659 dSP; tryAMAGICbinSET(ne,0);
3bb2c415
JH		 1660#ifndef NV_PRESERVES_UV
1661 if (SvROK(TOPs) && SvROK(TOPm1s)) {
c3e03cdf 1662 SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s)));
3bb2c415
JH		 1663 RETURN;
1664 }
1665#endif
28e5dec8
JH		 1666#ifdef PERL_PRESERVE_IVUV
1667 SvIV_please(TOPs);
1668 if (SvIOK(TOPs)) {
1669 SvIV_please(TOPm1s);
1670 if (SvIOK(TOPm1s)) {
1671 bool auvok = SvUOK(TOPm1s);
1672 bool buvok = SvUOK(TOPs);
a227d84d 1673
28e5dec8
JH		 1674 if (!auvok && !buvok) { /* ## IV <=> IV ## */
1675 IV aiv = SvIVX(TOPm1s);
1676 IV biv = SvIVX(TOPs);
1677
1678 SP--;
1679 SETs(boolSV(aiv != biv));
1680 RETURN;
1681 }
1682 if (auvok && buvok) { /* ## UV != UV ## */
1683 UV auv = SvUVX(TOPm1s);
1684 UV buv = SvUVX(TOPs);
1685
1686 SP--;
1687 SETs(boolSV(auv != buv));
1688 RETURN;
1689 }
1690 { /* ## Mixed IV,UV ## */
1691 IV iv;
1692 UV uv;
1693
1694 /* != is commutative so swap if needed (save code) */
1695 if (auvok) {
1696 /* swap. top of stack (b) is the iv */
1697 iv = SvIVX(TOPs);
1698 SP--;
1699 if (iv < 0) {
1700 /* As (a) is a UV, it's >0, so it cannot be == */
1701 SETs(&PL_sv_yes);
1702 RETURN;
1703 }
1704 uv = SvUVX(TOPs);
1705 } else {
1706 iv = SvIVX(TOPm1s);
1707 SP--;
1708 if (iv < 0) {
1709 /* As (b) is a UV, it's >0, so it cannot be == */
1710 SETs(&PL_sv_yes);
1711 RETURN;
1712 }
1713 uv = SvUVX(*(SP+1)); /* Do I want TOPp1s() ? */
1714 }
1715 /* we know iv is >= 0 */
1716 if (uv > (UV) IV_MAX) {
1717 SETs(&PL_sv_yes);
1718 RETURN;
1719 }
1720 SETs(boolSV((UV)iv != uv));
1721 RETURN;
1722 }
1723 }
1724 }
1725#endif
a0d0e21e
LW		 1726 {
1727 dPOPnv;
54310121 1728 SETs(boolSV(TOPn != value));
a0d0e21e
LW		 1729 RETURN;
1730 }
79072805
LW		 1731}
1732
a0d0e21e 1733PP(pp_ncmp)
79072805 1734{
39644a26 1735 dSP; dTARGET; tryAMAGICbin(ncmp,0);
d8c7644e
JH		 1736#ifndef NV_PRESERVES_UV
1737 if (SvROK(TOPs) && SvROK(TOPm1s)) {
34d3ce40 1738 SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
d8c7644e
JH		 1739 RETURN;
1740 }
1741#endif
28e5dec8
JH		 1742#ifdef PERL_PRESERVE_IVUV
1743 /* Fortunately it seems NaN isn't IOK */
1744 SvIV_please(TOPs);
1745 if (SvIOK(TOPs)) {
1746 SvIV_please(TOPm1s);
1747 if (SvIOK(TOPm1s)) {
1748 bool leftuvok = SvUOK(TOPm1s);
1749 bool rightuvok = SvUOK(TOPs);
1750 I32 value;
1751 if (!leftuvok && !rightuvok) { /* ## IV <=> IV ## */
1752 IV leftiv = SvIVX(TOPm1s);
1753 IV rightiv = SvIVX(TOPs);
1754
1755 if (leftiv > rightiv)
1756 value = 1;
1757 else if (leftiv < rightiv)
1758 value = -1;
1759 else
1760 value = 0;
1761 } else if (leftuvok && rightuvok) { /* ## UV <=> UV ## */
1762 UV leftuv = SvUVX(TOPm1s);
1763 UV rightuv = SvUVX(TOPs);
1764
1765 if (leftuv > rightuv)
1766 value = 1;
1767 else if (leftuv < rightuv)
1768 value = -1;
1769 else
1770 value = 0;
1771 } else if (leftuvok) { /* ## UV <=> IV ## */
1772 UV leftuv;
1773 IV rightiv;
1774
1775 rightiv = SvIVX(TOPs);
1776 if (rightiv < 0) {
1777 /* As (a) is a UV, it's >=0, so it cannot be < */
1778 value = 1;
1779 } else {
1780 leftuv = SvUVX(TOPm1s);
1781 if (leftuv > (UV) IV_MAX) {
1782 /* As (b) is an IV, it cannot be > IV_MAX */
1783 value = 1;
1784 } else if (leftuv > (UV)rightiv) {
1785 value = 1;
1786 } else if (leftuv < (UV)rightiv) {
1787 value = -1;
1788 } else {
1789 value = 0;
1790 }
1791 }
1792 } else { /* ## IV <=> UV ## */
1793 IV leftiv;
1794 UV rightuv;
1795
1796 leftiv = SvIVX(TOPm1s);
1797 if (leftiv < 0) {
1798 /* As (b) is a UV, it's >=0, so it must be < */
1799 value = -1;
1800 } else {
1801 rightuv = SvUVX(TOPs);
1802 if (rightuv > (UV) IV_MAX) {
1803 /* As (a) is an IV, it cannot be > IV_MAX */
1804 value = -1;
1805 } else if (leftiv > (UV)rightuv) {
1806 value = 1;
1807 } else if (leftiv < (UV)rightuv) {
1808 value = -1;
1809 } else {
1810 value = 0;
1811 }
1812 }
1813 }
1814 SP--;
1815 SETi(value);
1816 RETURN;
1817 }
1818 }
1819#endif
a0d0e21e
LW		 1820 {
1821 dPOPTOPnnrl;
1822 I32 value;
79072805 1823
a3540c92 1824#ifdef Perl_isnan
1ad04cfd
JH		 1825 if (Perl_isnan(left) || Perl_isnan(right)) {
1826 SETs(&PL_sv_undef);
1827 RETURN;
1828 }
1829 value = (left > right) - (left < right);
1830#else
ff0cee69 1831 if (left == right)
a0d0e21e 1832 value = 0;
a0d0e21e
LW		 1833 else if (left < right)
1834 value = -1;
44a8e56a 1835 else if (left > right)
1836 value = 1;
1837 else {
3280af22 1838 SETs(&PL_sv_undef);
44a8e56a 1839 RETURN;
1840 }
1ad04cfd 1841#endif
a0d0e21e
LW		 1842 SETi(value);
1843 RETURN;
79072805 1844 }
a0d0e21e 1845}
79072805 1846
a0d0e21e
LW		 1847PP(pp_slt)
1848{
39644a26 1849 dSP; tryAMAGICbinSET(slt,0);
a0d0e21e
LW		 1850 {
1851 dPOPTOPssrl;
2de3dbcc 1852 int cmp = (IN_LOCALE_RUNTIME
bbce6d69 1853 ? sv_cmp_locale(left, right)
1854 : sv_cmp(left, right));
54310121 1855 SETs(boolSV(cmp < 0));
a0d0e21e
LW		 1856 RETURN;
1857 }
79072805
LW		 1858}
1859
a0d0e21e 1860PP(pp_sgt)
79072805 1861{
39644a26 1862 dSP; tryAMAGICbinSET(sgt,0);
a0d0e21e
LW		 1863 {
1864 dPOPTOPssrl;
2de3dbcc 1865 int cmp = (IN_LOCALE_RUNTIME
bbce6d69 1866 ? sv_cmp_locale(left, right)
1867 : sv_cmp(left, right));
54310121 1868 SETs(boolSV(cmp > 0));
a0d0e21e
LW		 1869 RETURN;
1870 }
1871}
79072805 1872
a0d0e21e
LW		 1873PP(pp_sle)
1874{
39644a26 1875 dSP; tryAMAGICbinSET(sle,0);
a0d0e21e
LW		 1876 {
1877 dPOPTOPssrl;
2de3dbcc 1878 int cmp = (IN_LOCALE_RUNTIME
bbce6d69 1879 ? sv_cmp_locale(left, right)
1880 : sv_cmp(left, right));
54310121 1881 SETs(boolSV(cmp <= 0));
a0d0e21e 1882 RETURN;
79072805 1883 }
79072805
LW		 1884}
1885
a0d0e21e
LW		 1886PP(pp_sge)
1887{
39644a26 1888 dSP; tryAMAGICbinSET(sge,0);
a0d0e21e
LW		 1889 {
1890 dPOPTOPssrl;
2de3dbcc 1891 int cmp = (IN_LOCALE_RUNTIME
bbce6d69 1892 ? sv_cmp_locale(left, right)
1893 : sv_cmp(left, right));
54310121 1894 SETs(boolSV(cmp >= 0));
a0d0e21e
LW		 1895 RETURN;
1896 }
1897}
79072805 1898
36477c24 1899PP(pp_seq)
1900{
39644a26 1901 dSP; tryAMAGICbinSET(seq,0);
36477c24 1902 {
1903 dPOPTOPssrl;
54310121 1904 SETs(boolSV(sv_eq(left, right)));
a0d0e21e
LW		 1905 RETURN;
1906 }
1907}
79072805 1908
a0d0e21e 1909PP(pp_sne)
79072805 1910{
39644a26 1911 dSP; tryAMAGICbinSET(sne,0);
a0d0e21e
LW		 1912 {
1913 dPOPTOPssrl;
54310121 1914 SETs(boolSV(!sv_eq(left, right)));
a0d0e21e 1915 RETURN;
463ee0b2 1916 }
79072805
LW		 1917}
1918
a0d0e21e 1919PP(pp_scmp)
79072805 1920{
39644a26 1921 dSP; dTARGET; tryAMAGICbin(scmp,0);
a0d0e21e
LW		 1922 {
1923 dPOPTOPssrl;
2de3dbcc 1924 int cmp = (IN_LOCALE_RUNTIME
bbce6d69 1925 ? sv_cmp_locale(left, right)
1926 : sv_cmp(left, right));
1927 SETi( cmp );
a0d0e21e
LW		 1928 RETURN;
1929 }
1930}
79072805 1931
55497cff 1932PP(pp_bit_and)
1933{
39644a26 1934 dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
a0d0e21e
LW		 1935 {
1936 dPOPTOPssrl;
4633a7c4 1937 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1938 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 1939 IV i = SvIV(left) & SvIV(right);
1940 SETi(i);
d0ba1bd2
JH		 1941 }
1942 else {
972b05a9
JH		 1943 UV u = SvUV(left) & SvUV(right);
1944 SETu(u);
d0ba1bd2 1945 }
a0d0e21e
LW		 1946 }
1947 else {
533c011a 1948 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW		 1949 SETTARG;
1950 }
1951 RETURN;
1952 }
1953}
79072805 1954
a0d0e21e
LW		 1955PP(pp_bit_xor)
1956{
39644a26 1957 dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
a0d0e21e
LW		 1958 {
1959 dPOPTOPssrl;
4633a7c4 1960 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1961 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 1962 IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
1963 SETi(i);
d0ba1bd2
JH		 1964 }
1965 else {
972b05a9
JH		 1966 UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
1967 SETu(u);
d0ba1bd2 1968 }
a0d0e21e
LW		 1969 }
1970 else {
533c011a 1971 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW		 1972 SETTARG;
1973 }
1974 RETURN;
1975 }
1976}
79072805 1977
a0d0e21e
LW		 1978PP(pp_bit_or)
1979{
39644a26 1980 dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
a0d0e21e
LW		 1981 {
1982 dPOPTOPssrl;
4633a7c4 1983 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1984 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 1985 IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
1986 SETi(i);
d0ba1bd2
JH		 1987 }
1988 else {
972b05a9
JH		 1989 UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
1990 SETu(u);
d0ba1bd2 1991 }
a0d0e21e
LW		 1992 }
1993 else {
533c011a 1994 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW		 1995 SETTARG;
1996 }
1997 RETURN;
79072805 1998 }
a0d0e21e 1999}
79072805 2000
a0d0e21e
LW		 2001PP(pp_negate)
2002{
39644a26 2003 dSP; dTARGET; tryAMAGICun(neg);
a0d0e21e
LW		 2004 {
2005 dTOPss;
28e5dec8 2006 int flags = SvFLAGS(sv);
4633a7c4
LW		 2007 if (SvGMAGICAL(sv))
2008 mg_get(sv);
28e5dec8
JH		 2009 if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
2010 /* It's publicly an integer, or privately an integer-not-float */
2011 oops_its_an_int:
9b0e499b
GS		 2012 if (SvIsUV(sv)) {
2013 if (SvIVX(sv) == IV_MIN) {
28e5dec8 2014 /* 2s complement assumption. */
9b0e499b
GS		 2015 SETi(SvIVX(sv)); /* special case: -((UV)IV_MAX+1) == IV_MIN */
2016 RETURN;
2017 }
2018 else if (SvUVX(sv) <= IV_MAX) {
beccb14c 2019 SETi(-SvIVX(sv));
9b0e499b
GS		 2020 RETURN;
2021 }
2022 }
2023 else if (SvIVX(sv) != IV_MIN) {
2024 SETi(-SvIVX(sv));
2025 RETURN;
2026 }
28e5dec8
JH		 2027#ifdef PERL_PRESERVE_IVUV
2028 else {
2029 SETu((UV)IV_MIN);
2030 RETURN;
2031 }
2032#endif
9b0e499b
GS		 2033 }
2034 if (SvNIOKp(sv))
a0d0e21e 2035 SETn(-SvNV(sv));
4633a7c4 2036 else if (SvPOKp(sv)) {
a0d0e21e
LW		 2037 STRLEN len;
2038 char *s = SvPV(sv, len);
bbce6d69 2039 if (isIDFIRST(*s)) {
a0d0e21e
LW		 2040 sv_setpvn(TARG, "-", 1);
2041 sv_catsv(TARG, sv);
79072805 2042 }
a0d0e21e
LW		 2043 else if (*s == '+' || *s == '-') {
2044 sv_setsv(TARG, sv);
2045 *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
79072805 2046 }
fd400ab9 2047 else if (DO_UTF8(sv) && UTF8_IS_START(*s) && isIDFIRST_utf8((U8*)s)) {
834a4ddd
LW		 2048 sv_setpvn(TARG, "-", 1);
2049 sv_catsv(TARG, sv);
2050 }
28e5dec8
JH		 2051 else {
2052 SvIV_please(sv);
2053 if (SvIOK(sv))
2054 goto oops_its_an_int;
2055 sv_setnv(TARG, -SvNV(sv));
2056 }
a0d0e21e 2057 SETTARG;
79072805 2058 }
4633a7c4
LW		 2059 else
2060 SETn(-SvNV(sv));
79072805 2061 }
a0d0e21e 2062 RETURN;
79072805
LW		 2063}
2064
a0d0e21e 2065PP(pp_not)
79072805 2066{
39644a26 2067 dSP; tryAMAGICunSET(not);
3280af22 2068 *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
a0d0e21e 2069 return NORMAL;
79072805
LW		 2070}
2071
a0d0e21e 2072PP(pp_complement)
79072805 2073{
39644a26 2074 dSP; dTARGET; tryAMAGICun(compl);
a0d0e21e
LW		 2075 {
2076 dTOPss;
4633a7c4 2077 if (SvNIOKp(sv)) {
d0ba1bd2 2078 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 2079 IV i = ~SvIV(sv);
2080 SETi(i);
d0ba1bd2
JH		 2081 }
2082 else {
972b05a9
JH		 2083 UV u = ~SvUV(sv);
2084 SETu(u);
d0ba1bd2 2085 }
a0d0e21e
LW		 2086 }
2087 else {
51723571 2088 register U8 *tmps;
55497cff 2089 register I32 anum;
a0d0e21e
LW		 2090 STRLEN len;
2091
2092 SvSetSV(TARG, sv);
51723571 2093 tmps = (U8*)SvPV_force(TARG, len);
a0d0e21e 2094 anum = len;
1d68d6cd 2095 if (SvUTF8(TARG)) {
a1ca4561 2096 /* Calculate exact length, let's not estimate. */
1d68d6cd
SC		 2097 STRLEN targlen = 0;
2098 U8 *result;
51723571 2099 U8 *send;
ba210ebe 2100 STRLEN l;
a1ca4561
YST		 2101 UV nchar = 0;
2102 UV nwide = 0;
1d68d6cd
SC		 2103
2104 send = tmps + len;
2105 while (tmps < send) {
9041c2e3 2106 UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
1d68d6cd 2107 tmps += UTF8SKIP(tmps);
5bbb0b5a 2108 targlen += UNISKIP(~c);
a1ca4561
YST		 2109 nchar++;
2110 if (c > 0xff)
2111 nwide++;
1d68d6cd
SC		 2112 }
2113
2114 /* Now rewind strings and write them. */
2115 tmps -= len;
a1ca4561
YST		 2116
2117 if (nwide) {
2118 Newz(0, result, targlen + 1, U8);
2119 while (tmps < send) {
9041c2e3 2120 UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
a1ca4561 2121 tmps += UTF8SKIP(tmps);
9041c2e3 2122 result = uvchr_to_utf8(result, ~c);
a1ca4561
YST		 2123 }
2124 *result = '\0';
2125 result -= targlen;
2126 sv_setpvn(TARG, (char*)result, targlen);
2127 SvUTF8_on(TARG);
2128 }
2129 else {
2130 Newz(0, result, nchar + 1, U8);
2131 while (tmps < send) {
9041c2e3 2132 U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY);
a1ca4561
YST		 2133 tmps += UTF8SKIP(tmps);
2134 *result++ = ~c;
2135 }
2136 *result = '\0';
2137 result -= nchar;
2138 sv_setpvn(TARG, (char*)result, nchar);
1d68d6cd 2139 }
1d68d6cd
SC		 2140 Safefree(result);
2141 SETs(TARG);
2142 RETURN;
2143 }
a0d0e21e 2144#ifdef LIBERAL
51723571
JH		 2145 {
2146 register long *tmpl;
2147 for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
2148 *tmps = ~*tmps;
2149 tmpl = (long*)tmps;
2150 for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
2151 *tmpl = ~*tmpl;
2152 tmps = (U8*)tmpl;
2153 }
a0d0e21e
LW		 2154#endif
2155 for ( ; anum > 0; anum--, tmps++)
2156 *tmps = ~*tmps;
2157
2158 SETs(TARG);
2159 }
2160 RETURN;
2161 }
79072805
LW		 2162}
2163
a0d0e21e
LW		 2164/* integer versions of some of the above */
2165
a0d0e21e 2166PP(pp_i_multiply)
79072805 2167{
39644a26 2168 dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
a0d0e21e
LW		 2169 {
2170 dPOPTOPiirl;
2171 SETi( left * right );
2172 RETURN;
2173 }
79072805
LW		 2174}
2175
a0d0e21e 2176PP(pp_i_divide)
79072805 2177{
39644a26 2178 dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
a0d0e21e
LW		 2179 {
2180 dPOPiv;
2181 if (value == 0)
cea2e8a9 2182 DIE(aTHX_ "Illegal division by zero");
a0d0e21e
LW		 2183 value = POPi / value;
2184 PUSHi( value );
2185 RETURN;
2186 }
79072805
LW		 2187}
2188
a0d0e21e 2189PP(pp_i_modulo)
79072805 2190{
39644a26 2191 dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
79072805 2192 {
a0d0e21e 2193 dPOPTOPiirl;
aa306039 2194 if (!right)
cea2e8a9 2195 DIE(aTHX_ "Illegal modulus zero");
a0d0e21e
LW		 2196 SETi( left % right );
2197 RETURN;
79072805 2198 }
79072805
LW		 2199}
2200
a0d0e21e 2201PP(pp_i_add)
79072805 2202{
39644a26 2203 dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
a0d0e21e 2204 {
5e66d4f1 2205 dPOPTOPiirl_ul;
a0d0e21e
LW		 2206 SETi( left + right );
2207 RETURN;
79072805 2208 }
79072805
LW		 2209}
2210
a0d0e21e 2211PP(pp_i_subtract)
79072805 2212{
39644a26 2213 dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
a0d0e21e 2214 {
5e66d4f1 2215 dPOPTOPiirl_ul;
a0d0e21e
LW		 2216 SETi( left - right );
2217 RETURN;
79072805 2218 }
79072805
LW		 2219}
2220
a0d0e21e 2221PP(pp_i_lt)
79072805 2222{
39644a26 2223 dSP; tryAMAGICbinSET(lt,0);
a0d0e21e
LW		 2224 {
2225 dPOPTOPiirl;
54310121 2226 SETs(boolSV(left < right));
a0d0e21e
LW		 2227 RETURN;
2228 }
79072805
LW		 2229}
2230
a0d0e21e 2231PP(pp_i_gt)
79072805 2232{
39644a26 2233 dSP; tryAMAGICbinSET(gt,0);
a0d0e21e
LW		 2234 {
2235 dPOPTOPiirl;
54310121 2236 SETs(boolSV(left > right));
a0d0e21e
LW		 2237 RETURN;
2238 }
79072805
LW		 2239}
2240
a0d0e21e 2241PP(pp_i_le)
79072805 2242{
39644a26 2243 dSP; tryAMAGICbinSET(le,0);
a0d0e21e
LW		 2244 {
2245 dPOPTOPiirl;
54310121 2246 SETs(boolSV(left <= right));
a0d0e21e 2247 RETURN;
85e6fe83 2248 }
79072805
LW		 2249}
2250
a0d0e21e 2251PP(pp_i_ge)
79072805 2252{
39644a26 2253 dSP; tryAMAGICbinSET(ge,0);
a0d0e21e
LW		 2254 {
2255 dPOPTOPiirl;
54310121 2256 SETs(boolSV(left >= right));
a0d0e21e
LW		 2257 RETURN;
2258 }
79072805
LW		 2259}
2260
a0d0e21e 2261PP(pp_i_eq)
79072805 2262{
39644a26 2263 dSP; tryAMAGICbinSET(eq,0);
a0d0e21e
LW		 2264 {
2265 dPOPTOPiirl;
54310121 2266 SETs(boolSV(left == right));
a0d0e21e
LW		 2267 RETURN;
2268 }
79072805
LW		 2269}
2270
a0d0e21e 2271PP(pp_i_ne)
79072805 2272{
39644a26 2273 dSP; tryAMAGICbinSET(ne,0);
a0d0e21e
LW		 2274 {
2275 dPOPTOPiirl;
54310121 2276 SETs(boolSV(left != right));
a0d0e21e
LW		 2277 RETURN;
2278 }
79072805
LW		 2279}
2280
a0d0e21e 2281PP(pp_i_ncmp)
79072805 2282{
39644a26 2283 dSP; dTARGET; tryAMAGICbin(ncmp,0);
a0d0e21e
LW		 2284 {
2285 dPOPTOPiirl;
2286 I32 value;
79072805 2287
a0d0e21e 2288 if (left > right)
79072805 2289 value = 1;
a0d0e21e 2290 else if (left < right)
79072805 2291 value = -1;
a0d0e21e 2292 else
79072805 2293 value = 0;
a0d0e21e
LW		 2294 SETi(value);
2295 RETURN;
79072805 2296 }
85e6fe83
LW		 2297}
2298
2299PP(pp_i_negate)
2300{
39644a26 2301 dSP; dTARGET; tryAMAGICun(neg);
85e6fe83
LW		 2302 SETi(-TOPi);
2303 RETURN;
2304}
2305
79072805
LW		 2306/* High falutin' math. */
2307
2308PP(pp_atan2)
2309{
39644a26 2310 dSP; dTARGET; tryAMAGICbin(atan2,0);
a0d0e21e
LW		 2311 {
2312 dPOPTOPnnrl;
65202027 2313 SETn(Perl_atan2(left, right));
a0d0e21e
LW		 2314 RETURN;
2315 }
79072805
LW		 2316}
2317
2318PP(pp_sin)
2319{
39644a26 2320 dSP; dTARGET; tryAMAGICun(sin);
a0d0e21e 2321 {
65202027 2322 NV value;
a0d0e21e 2323 value = POPn;
65202027 2324 value = Perl_sin(value);
a0d0e21e
LW		 2325 XPUSHn(value);
2326 RETURN;
2327 }
79072805
LW		 2328}
2329
2330PP(pp_cos)
2331{
39644a26 2332 dSP; dTARGET; tryAMAGICun(cos);
a0d0e21e 2333 {
65202027 2334 NV value;
a0d0e21e 2335 value = POPn;
65202027 2336 value = Perl_cos(value);
a0d0e21e
LW		 2337 XPUSHn(value);
2338 RETURN;
2339 }
79072805
LW		 2340}
2341
56cb0a1c
AD		 2342/* Support Configure command-line overrides for rand() functions.
2343 After 5.005, perhaps we should replace this by Configure support
2344 for drand48(), random(), or rand(). For 5.005, though, maintain
2345 compatibility by calling rand() but allow the user to override it.
2346 See INSTALL for details. --Andy Dougherty 15 July 1998
2347*/
85ab1d1d
JH		 2348/* Now it's after 5.005, and Configure supports drand48() and random(),
2349 in addition to rand(). So the overrides should not be needed any more.
2350 --Jarkko Hietaniemi 27 September 1998
2351 */
2352
2353#ifndef HAS_DRAND48_PROTO
20ce7b12 2354extern double drand48 (void);
56cb0a1c
AD		 2355#endif
2356
79072805
LW		 2357PP(pp_rand)
2358{
39644a26 2359 dSP; dTARGET;
65202027 2360 NV value;
79072805
LW		 2361 if (MAXARG < 1)
2362 value = 1.0;
2363 else
2364 value = POPn;
2365 if (value == 0.0)
2366 value = 1.0;
80252599 2367 if (!PL_srand_called) {
85ab1d1d 2368 (void)seedDrand01((Rand_seed_t)seed());
80252599 2369 PL_srand_called = TRUE;
93dc8474 2370 }
85ab1d1d 2371 value *= Drand01();
79072805
LW		 2372 XPUSHn(value);
2373 RETURN;
2374}
2375
2376PP(pp_srand)
2377{
39644a26 2378 dSP;
93dc8474
CS		 2379 UV anum;
2380 if (MAXARG < 1)
2381 anum = seed();
79072805 2382 else
93dc8474 2383 anum = POPu;
85ab1d1d 2384 (void)seedDrand01((Rand_seed_t)anum);
80252599 2385 PL_srand_called = TRUE;
79072805
LW		 2386 EXTEND(SP, 1);
2387 RETPUSHYES;
2388}
2389
76e3520e 2390STATIC U32
cea2e8a9 2391S_seed(pTHX)
93dc8474 2392{
54310121 2393 /*
2394 * This is really just a quick hack which grabs various garbage
2395 * values. It really should be a real hash algorithm which
2396 * spreads the effect of every input bit onto every output bit,
85ab1d1d 2397 * if someone who knows about such things would bother to write it.
54310121 2398 * Might be a good idea to add that function to CORE as well.
85ab1d1d 2399 * No numbers below come from careful analysis or anything here,
54310121 2400 * except they are primes and SEED_C1 > 1E6 to get a full-width
2401 * value from (tv_sec * SEED_C1 + tv_usec). The multipliers should
2402 * probably be bigger too.
2403 */
2404#if RANDBITS > 16
2405# define SEED_C1 1000003
2406#define SEED_C4 73819
2407#else
2408# define SEED_C1 25747
2409#define SEED_C4 20639
2410#endif
2411#define SEED_C2 3
2412#define SEED_C3 269
2413#define SEED_C5 26107
2414
73c60299
RS		 2415#ifndef PERL_NO_DEV_RANDOM
2416 int fd;
2417#endif
93dc8474 2418 U32 u;
f12c7020 2419#ifdef VMS
2420# include <starlet.h>
43c92808
HF		 2421 /* when[] = (low 32 bits, high 32 bits) of time since epoch
2422 * in 100-ns units, typically incremented ever 10 ms. */
93dc8474 2423 unsigned int when[2];
73c60299
RS		 2424#else
2425# ifdef HAS_GETTIMEOFDAY
2426 struct timeval when;
2427# else
2428 Time_t when;
2429# endif
2430#endif
2431
2432/* This test is an escape hatch, this symbol isn't set by Configure. */
2433#ifndef PERL_NO_DEV_RANDOM
2434#ifndef PERL_RANDOM_DEVICE
2435 /* /dev/random isn't used by default because reads from it will block
2436 * if there isn't enough entropy available. You can compile with
2437 * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
2438 * is enough real entropy to fill the seed. */
2439# define PERL_RANDOM_DEVICE "/dev/urandom"
2440#endif
2441 fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
2442 if (fd != -1) {
2443 if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
2444 u = 0;
2445 PerlLIO_close(fd);
2446 if (u)
2447 return u;
2448 }
2449#endif
2450
2451#ifdef VMS
93dc8474 2452 _ckvmssts(sys$gettim(when));
54310121 2453 u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
f12c7020 2454#else
5f05dabc 2455# ifdef HAS_GETTIMEOFDAY
93dc8474 2456 gettimeofday(&when,(struct timezone *) 0);
54310121 2457 u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
f12c7020 2458# else
93dc8474 2459 (void)time(&when);
54310121 2460 u = (U32)SEED_C1 * when;
f12c7020 2461# endif
2462#endif
7766f137 2463 u += SEED_C3 * (U32)PerlProc_getpid();
56431972 2464 u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
54310121 2465#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */
56431972 2466 u += SEED_C5 * (U32)PTR2UV(&when);
f12c7020 2467#endif
93dc8474 2468 return u;
79072805
LW		 2469}
2470
2471PP(pp_exp)
2472{
39644a26 2473 dSP; dTARGET; tryAMAGICun(exp);
a0d0e21e 2474 {
65202027 2475 NV value;
a0d0e21e 2476 value = POPn;
65202027 2477 value = Perl_exp(value);
a0d0e21e
LW		 2478 XPUSHn(value);
2479 RETURN;
2480 }
79072805
LW		 2481}
2482
2483PP(pp_log)
2484{
39644a26 2485 dSP; dTARGET; tryAMAGICun(log);
a0d0e21e 2486 {
65202027 2487 NV value;
a0d0e21e 2488 value = POPn;
bbce6d69 2489 if (value <= 0.0) {
f93f4e46 2490 SET_NUMERIC_STANDARD();
cea2e8a9 2491 DIE(aTHX_ "Can't take log of %g", value);
bbce6d69 2492 }
65202027 2493 value = Perl_log(value);
a0d0e21e
LW		 2494 XPUSHn(value);
2495 RETURN;
2496 }
79072805
LW		 2497}
2498
2499PP(pp_sqrt)
2500{
39644a26 2501 dSP; dTARGET; tryAMAGICun(sqrt);
a0d0e21e 2502 {
65202027 2503 NV value;
a0d0e21e 2504 value = POPn;
bbce6d69 2505 if (value < 0.0) {
f93f4e46 2506 SET_NUMERIC_STANDARD();
cea2e8a9 2507 DIE(aTHX_ "Can't take sqrt of %g", value);
bbce6d69 2508 }
65202027 2509 value = Perl_sqrt(value);
a0d0e21e
LW		 2510 XPUSHn(value);
2511 RETURN;
2512 }
79072805
LW		 2513}
2514
2515PP(pp_int)
2516{
39644a26 2517 dSP; dTARGET; tryAMAGICun(int);
774d564b 2518 {
28e5dec8
JH		 2519 NV value;
2520 IV iv = TOPi; /* attempt to convert to IV if possible. */
2521 /* XXX it's arguable that compiler casting to IV might be subtly
2522 different from modf (for numbers inside (IV_MIN,UV_MAX)) in which
2523 else preferring IV has introduced a subtle behaviour change bug. OTOH
2524 relying on floating point to be accurate is a bug. */
2525
2526 if (SvIOK(TOPs)) {
2527 if (SvIsUV(TOPs)) {
2528 UV uv = TOPu;
2529 SETu(uv);
2530 } else
2531 SETi(iv);
2532 } else {
2533 value = TOPn;
1048ea30 2534 if (value >= 0.0) {
28e5dec8
JH		 2535 if (value < (NV)UV_MAX + 0.5) {
2536 SETu(U_V(value));
2537 } else {
1048ea30 2538#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
e67aeab1
JH		 2539# ifdef HAS_MODFL_POW32_BUG
2540/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
2541 {
2542 NV offset = Perl_modf(value, &value);
2543 (void)Perl_modf(offset, &offset);
2544 value += offset;
2545 }
2546# else
28e5dec8 2547 (void)Perl_modf(value, &value);
e67aeab1 2548# endif
1048ea30 2549#else
28e5dec8
JH		 2550 double tmp = (double)value;
2551 (void)Perl_modf(tmp, &tmp);
2552 value = (NV)tmp;
1048ea30 2553#endif
2d9af89d 2554 SETn(value);
28e5dec8 2555 }
1048ea30 2556 }
28e5dec8
JH		 2557 else {
2558 if (value > (NV)IV_MIN - 0.5) {
2559 SETi(I_V(value));
2560 } else {
1048ea30 2561#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
e67aeab1
JH		 2562# ifdef HAS_MODFL_POW32_BUG
2563/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
2564 {
2565 NV offset = Perl_modf(-value, &value);
2566 (void)Perl_modf(offset, &offset);
2567 value += offset;
2568 }
2569# else
28e5dec8 2570 (void)Perl_modf(-value, &value);
e67aeab1 2571# endif
28e5dec8 2572 value = -value;
1048ea30 2573#else
28e5dec8
JH		 2574 double tmp = (double)value;
2575 (void)Perl_modf(-tmp, &tmp);
2576 value = -(NV)tmp;
1048ea30 2577#endif
28e5dec8
JH		 2578 SETn(value);
2579 }
2580 }
774d564b 2581 }
79072805 2582 }
79072805
LW		 2583 RETURN;
2584}
2585
463ee0b2
LW		 2586PP(pp_abs)
2587{
39644a26 2588 dSP; dTARGET; tryAMAGICun(abs);
a0d0e21e 2589 {
28e5dec8
JH		 2590 /* This will cache the NV value if string isn't actually integer */
2591 IV iv = TOPi;
a227d84d 2592
28e5dec8
JH		 2593 if (SvIOK(TOPs)) {
2594 /* IVX is precise */
2595 if (SvIsUV(TOPs)) {
2596 SETu(TOPu); /* force it to be numeric only */
2597 } else {
2598 if (iv >= 0) {
2599 SETi(iv);
2600 } else {
2601 if (iv != IV_MIN) {
2602 SETi(-iv);
2603 } else {
2604 /* 2s complement assumption. Also, not really needed as
2605 IV_MIN and -IV_MIN should both be %100...00 and NV-able */
2606 SETu(IV_MIN);
2607 }
a227d84d 2608 }
28e5dec8
JH		 2609 }
2610 } else{
2611 NV value = TOPn;
774d564b 2612 if (value < 0.0)
28e5dec8 2613 value = -value;
774d564b 2614 SETn(value);
2615 }
a0d0e21e 2616 }
774d564b 2617 RETURN;
463ee0b2
LW		 2618}
2619
79072805
LW		 2620PP(pp_hex)
2621{
39644a26 2622 dSP; dTARGET;
79072805 2623 char *tmps;
ba210ebe 2624 STRLEN argtype;
6f894ead 2625 STRLEN len;
79072805 2626
6f894ead 2627 tmps = (SvPVx(POPs, len));
b21ed0a9 2628 argtype = 1; /* allow underscores */
6f894ead 2629 XPUSHn(scan_hex(tmps, len, &argtype));
79072805
LW		 2630 RETURN;
2631}
2632
2633PP(pp_oct)
2634{
39644a26 2635 dSP; dTARGET;
9e24b6e2 2636 NV value;
ba210ebe 2637 STRLEN argtype;
79072805 2638 char *tmps;
6f894ead 2639 STRLEN len;
79072805 2640
6f894ead
DD		 2641 tmps = (SvPVx(POPs, len));
2642 while (*tmps && len && isSPACE(*tmps))
2643 tmps++, len--;
9e24b6e2 2644 if (*tmps == '0')
6f894ead 2645 tmps++, len--;
b21ed0a9 2646 argtype = 1; /* allow underscores */
9e24b6e2 2647 if (*tmps == 'x')
6f894ead 2648 value = scan_hex(++tmps, --len, &argtype);
9e24b6e2 2649 else if (*tmps == 'b')
6f894ead 2650 value = scan_bin(++tmps, --len, &argtype);
464e2e8a 2651 else
6f894ead 2652 value = scan_oct(tmps, len, &argtype);
9e24b6e2 2653 XPUSHn(value);
79072805
LW		 2654 RETURN;
2655}
2656
2657/* String stuff. */
2658
2659PP(pp_length)
2660{
39644a26 2661 dSP; dTARGET;
7e2040f0 2662 SV *sv = TOPs;
a0ed51b3 2663
7e2040f0
GS		 2664 if (DO_UTF8(sv))
2665 SETi(sv_len_utf8(sv));
2666 else
2667 SETi(sv_len(sv));
79072805
LW		 2668 RETURN;
2669}
2670
2671PP(pp_substr)
2672{
39644a26 2673 dSP; dTARGET;
79072805 2674 SV *sv;
9c5ffd7c 2675 I32 len = 0;
463ee0b2 2676 STRLEN curlen;
9402d6ed 2677 STRLEN utf8_curlen;
79072805
LW		 2678 I32 pos;
2679 I32 rem;
84902520 2680 I32 fail;
78f9721b 2681 I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
79072805 2682 char *tmps;
3280af22 2683 I32 arybase = PL_curcop->cop_arybase;
9402d6ed 2684 SV *repl_sv = NULL;
7b8d334a
GS		 2685 char *repl = 0;
2686 STRLEN repl_len;
78f9721b 2687 int num_args = PL_op->op_private & 7;
13e30c65 2688 bool repl_need_utf8_upgrade = FALSE;
9402d6ed 2689 bool repl_is_utf8 = FALSE;
79072805 2690
20408e3c 2691 SvTAINTED_off(TARG); /* decontaminate */
7e2040f0 2692 SvUTF8_off(TARG); /* decontaminate */
78f9721b
SM		 2693 if (num_args > 2) {
2694 if (num_args > 3) {
9402d6ed
JH		 2695 repl_sv = POPs;
2696 repl = SvPV(repl_sv, repl_len);
2697 repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
7b8d334a 2698 }
79072805 2699 len = POPi;
5d82c453 2700 }
84902520 2701 pos = POPi;
79072805 2702 sv = POPs;
849ca7ee 2703 PUTBACK;
9402d6ed
JH		 2704 if (repl_sv) {
2705 if (repl_is_utf8) {
2706 if (!DO_UTF8(sv))
2707 sv_utf8_upgrade(sv);
2708 }
13e30c65
JH		 2709 else if (DO_UTF8(sv))
2710 repl_need_utf8_upgrade = TRUE;
9402d6ed 2711 }
a0d0e21e 2712 tmps = SvPV(sv, curlen);
7e2040f0 2713 if (DO_UTF8(sv)) {
9402d6ed
JH		 2714 utf8_curlen = sv_len_utf8(sv);
2715 if (utf8_curlen == curlen)
2716 utf8_curlen = 0;
a0ed51b3 2717 else
9402d6ed 2718 curlen = utf8_curlen;
a0ed51b3 2719 }
d1c2b58a 2720 else
9402d6ed 2721 utf8_curlen = 0;
a0ed51b3 2722
84902520
TB		 2723 if (pos >= arybase) {
2724 pos -= arybase;
2725 rem = curlen-pos;
2726 fail = rem;
78f9721b 2727 if (num_args > 2) {
5d82c453
GA		 2728 if (len < 0) {
2729 rem += len;
2730 if (rem < 0)
2731 rem = 0;
2732 }
2733 else if (rem > len)
2734 rem = len;
2735 }
68dc0745 2736 }
84902520 2737 else {
5d82c453 2738 pos += curlen;
78f9721b 2739 if (num_args < 3)
5d82c453
GA		 2740 rem = curlen;
2741 else if (len >= 0) {
2742 rem = pos+len;
2743 if (rem > (I32)curlen)
2744 rem = curlen;
2745 }
2746 else {
2747 rem = curlen+len;
2748 if (rem < pos)
2749 rem = pos;
2750 }
2751 if (pos < 0)
2752 pos = 0;
2753 fail = rem;
2754 rem -= pos;
84902520
TB		 2755 }
2756 if (fail < 0) {
e476b1b5
GS		 2757 if (lvalue || repl)
2758 Perl_croak(aTHX_ "substr outside of string");
2759 if (ckWARN(WARN_SUBSTR))
cea2e8a9 2760 Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
2304df62
AD		 2761 RETPUSHUNDEF;
2762 }
79072805 2763 else {
9aa983d2
JH		 2764 I32 upos = pos;
2765 I32 urem = rem;
9402d6ed 2766 if (utf8_curlen)
a0ed51b3 2767 sv_pos_u2b(sv, &pos, &rem);
79072805 2768 tmps += pos;
79072805 2769 sv_setpvn(TARG, tmps, rem);
12aa1545 2770#ifdef USE_LOCALE_COLLATE
14befaf4 2771 sv_unmagic(TARG, PERL_MAGIC_collxfrm);
12aa1545 2772#endif
9402d6ed 2773 if (utf8_curlen)
7f66633b 2774 SvUTF8_on(TARG);
f7928d6c 2775 if (repl) {
13e30c65
JH		 2776 SV* repl_sv_copy = NULL;
2777
2778 if (repl_need_utf8_upgrade) {
2779 repl_sv_copy = newSVsv(repl_sv);
2780 sv_utf8_upgrade(repl_sv_copy);
2781 repl = SvPV(repl_sv_copy, repl_len);
2782 repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
2783 }
c8faf1c5 2784 sv_insert(sv, pos, rem, repl, repl_len);
9402d6ed 2785 if (repl_is_utf8)
f7928d6c 2786 SvUTF8_on(sv);
9402d6ed
JH		 2787 if (repl_sv_copy)
2788 SvREFCNT_dec(repl_sv_copy);
f7928d6c 2789 }
c8faf1c5 2790 else if (lvalue) { /* it's an lvalue! */
dedeecda 2791 if (!SvGMAGICAL(sv)) {
2792 if (SvROK(sv)) {
2d8e6c8d
GS		 2793 STRLEN n_a;
2794 SvPV_force(sv,n_a);
599cee73 2795 if (ckWARN(WARN_SUBSTR))
cea2e8a9 2796 Perl_warner(aTHX_ WARN_SUBSTR,
599cee73 2797 "Attempt to use reference as lvalue in substr");
dedeecda 2798 }
2799 if (SvOK(sv)) /* is it defined ? */
7f66633b 2800 (void)SvPOK_only_UTF8(sv);
dedeecda 2801 else
2802 sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
2803 }
5f05dabc 2804
a0d0e21e
LW		 2805 if (SvTYPE(TARG) < SVt_PVLV) {
2806 sv_upgrade(TARG, SVt_PVLV);
14befaf4 2807 sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
ed6116ce 2808 }
a0d0e21e 2809
5f05dabc 2810 LvTYPE(TARG) = 'x';
6ff81951
GS		 2811 if (LvTARG(TARG) != sv) {
2812 if (LvTARG(TARG))
2813 SvREFCNT_dec(LvTARG(TARG));
2814 LvTARG(TARG) = SvREFCNT_inc(sv);
2815 }
9aa983d2
JH		 2816 LvTARGOFF(TARG) = upos;
2817 LvTARGLEN(TARG) = urem;
79072805
LW		 2818 }
2819 }
849ca7ee 2820 SPAGAIN;
79072805
LW		 2821 PUSHs(TARG); /* avoid SvSETMAGIC here */
2822 RETURN;
2823}
2824
2825PP(pp_vec)
2826{
39644a26 2827 dSP; dTARGET;
467f0320
JH		 2828 register IV size = POPi;
2829 register IV offset = POPi;
79072805 2830 register SV *src = POPs;
78f9721b 2831 I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
a0d0e21e 2832
81e118e0
JH		 2833 SvTAINTED_off(TARG); /* decontaminate */
2834 if (lvalue) { /* it's an lvalue! */
2835 if (SvTYPE(TARG) < SVt_PVLV) {
2836 sv_upgrade(TARG, SVt_PVLV);
14befaf4 2837 sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0);
79072805 2838 }
81e118e0
JH		 2839 LvTYPE(TARG) = 'v';
2840 if (LvTARG(TARG) != src) {
2841 if (LvTARG(TARG))
2842 SvREFCNT_dec(LvTARG(TARG));
2843 LvTARG(TARG) = SvREFCNT_inc(src);
79072805 2844 }
81e118e0
JH		 2845 LvTARGOFF(TARG) = offset;
2846 LvTARGLEN(TARG) = size;
79072805
LW		 2847 }
2848
81e118e0 2849 sv_setuv(TARG, do_vecget(src, offset, size));
79072805
LW		 2850 PUSHs(TARG);
2851 RETURN;
2852}
2853
2854PP(pp_index)
2855{
39644a26 2856 dSP; dTARGET;
79072805
LW		 2857 SV *big;
2858 SV *little;
2859 I32 offset;
2860 I32 retval;
2861 char *tmps;
2862 char *tmps2;
463ee0b2 2863 STRLEN biglen;
3280af22 2864 I32 arybase = PL_curcop->cop_arybase;
79072805
LW		 2865
2866 if (MAXARG < 3)
2867 offset = 0;
2868 else
2869 offset = POPi - arybase;
2870 little = POPs;
2871 big = POPs;
463ee0b2 2872 tmps = SvPV(big, biglen);
7e2040f0 2873 if (offset > 0 && DO_UTF8(big))
a0ed51b3 2874 sv_pos_u2b(big, &offset, 0);
79072805
LW		 2875 if (offset < 0)
2876 offset = 0;
93a17b20
LW		 2877 else if (offset > biglen)
2878 offset = biglen;
79072805 2879 if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
411d5715 2880 (unsigned char*)tmps + biglen, little, 0)))
a0ed51b3 2881 retval = -1;
79072805 2882 else
a0ed51b3 2883 retval = tmps2 - tmps;
7e2040f0 2884 if (retval > 0 && DO_UTF8(big))
a0ed51b3
LW		 2885 sv_pos_b2u(big, &retval);
2886 PUSHi(retval + arybase);
79072805
LW		 2887 RETURN;
2888}
2889
2890PP(pp_rindex)
2891{
39644a26 2892 dSP; dTARGET;
79072805
LW		 2893 SV *big;
2894 SV *little;
463ee0b2
LW		 2895 STRLEN blen;
2896 STRLEN llen;
79072805
LW		 2897 I32 offset;
2898 I32 retval;
2899 char *tmps;
2900 char *tmps2;
3280af22 2901 I32 arybase = PL_curcop->cop_arybase;
79072805 2902
a0d0e21e 2903 if (MAXARG >= 3)
a0ed51b3 2904 offset = POPi;
79072805
LW		 2905 little = POPs;
2906 big = POPs;
463ee0b2
LW		 2907 tmps2 = SvPV(little, llen);
2908 tmps = SvPV(big, blen);
79072805 2909 if (MAXARG < 3)
463ee0b2 2910 offset = blen;
a0ed51b3 2911 else {
7e2040f0 2912 if (offset > 0 && DO_UTF8(big))
a0ed51b3
LW		 2913 sv_pos_u2b(big, &offset, 0);
2914 offset = offset - arybase + llen;
2915 }
79072805
LW		 2916 if (offset < 0)
2917 offset = 0;
463ee0b2
LW		 2918 else if (offset > blen)
2919 offset = blen;
79072805 2920 if (!(tmps2 = rninstr(tmps, tmps + offset,
463ee0b2 2921 tmps2, tmps2 + llen)))
a0ed51b3 2922 retval = -1;
79072805 2923 else
a0ed51b3 2924 retval = tmps2 - tmps;
7e2040f0 2925 if (retval > 0 && DO_UTF8(big))
a0ed51b3
LW		 2926 sv_pos_b2u(big, &retval);
2927 PUSHi(retval + arybase);
79072805
LW		 2928 RETURN;
2929}
2930
2931PP(pp_sprintf)
2932{
39644a26 2933 dSP; dMARK; dORIGMARK; dTARGET;
79072805 2934 do_sprintf(TARG, SP-MARK, MARK+1);
bbce6d69 2935 TAINT_IF(SvTAINTED(TARG));
79072805
LW		 2936 SP = ORIGMARK;
2937 PUSHTARG;
2938 RETURN;
2939}
2940
79072805
LW		 2941PP(pp_ord)
2942{
39644a26 2943 dSP; dTARGET;
7df053ec 2944 SV *argsv = POPs;
ba210ebe 2945 STRLEN len;
7df053ec 2946 U8 *s = (U8*)SvPVx(argsv, len);
79072805 2947
9041c2e3 2948 XPUSHu(DO_UTF8(argsv) ? utf8_to_uvchr(s, 0) : (*s & 0xff));
79072805
LW		 2949 RETURN;
2950}
2951
463ee0b2
LW		 2952PP(pp_chr)
2953{
39644a26 2954 dSP; dTARGET;
463ee0b2 2955 char *tmps;
467f0320 2956 UV value = POPu;
463ee0b2 2957
748a9306 2958 (void)SvUPGRADE(TARG,SVt_PV);
a0ed51b3 2959
0064a8a9 2960 if (value > 255 && !IN_BYTES) {
9aa983d2 2961 SvGROW(TARG, UNISKIP(value)+1);
9041c2e3 2962 tmps = (char*)uvchr_to_utf8((U8*)SvPVX(TARG), value);
a0ed51b3
LW		 2963 SvCUR_set(TARG, tmps - SvPVX(TARG));
2964 *tmps = '\0';
2965 (void)SvPOK_only(TARG);
aa6ffa16 2966 SvUTF8_on(TARG);
a0ed51b3
LW		 2967 XPUSHs(TARG);
2968 RETURN;
2969 }
2970
748a9306 2971 SvGROW(TARG,2);
463ee0b2
LW		 2972 SvCUR_set(TARG, 1);
2973 tmps = SvPVX(TARG);
a0ed51b3 2974 *tmps++ = value;
748a9306 2975 *tmps = '\0';
a0d0e21e 2976 (void)SvPOK_only(TARG);
463ee0b2
LW		 2977 XPUSHs(TARG);
2978 RETURN;
2979}
2980
79072805
LW		 2981PP(pp_crypt)
2982{
39644a26 2983 dSP; dTARGET; dPOPTOPssrl;
2d8e6c8d 2984 STRLEN n_a;
79072805 2985#ifdef HAS_CRYPT
2d8e6c8d 2986 char *tmps = SvPV(left, n_a);
79072805 2987#ifdef FCRYPT
2d8e6c8d 2988 sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
79072805 2989#else
2d8e6c8d 2990 sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
79072805
LW		 2991#endif
2992#else
b13b2135 2993 DIE(aTHX_
79072805
LW		 2994 "The crypt() function is unimplemented due to excessive paranoia.");
2995#endif
2996 SETs(TARG);
2997 RETURN;
2998}
2999
3000PP(pp_ucfirst)
3001{
39644a26 3002 dSP;
79072805 3003 SV *sv = TOPs;
a0ed51b3
LW		 3004 register U8 *s;
3005 STRLEN slen;
3006
fd400ab9 3007 if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
ba210ebe 3008 STRLEN ulen;
ad391ad9 3009 U8 tmpbuf[UTF8_MAXLEN+1];
a0ed51b3 3010 U8 *tend;
9041c2e3 3011 UV uv;
a0ed51b3 3012
2de3dbcc 3013 if (IN_LOCALE_RUNTIME) {
a0ed51b3
LW		 3014 TAINT;
3015 SvTAINTED_on(sv);
9041c2e3 3016 uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
a0ed51b3 3017 }
b0f2b690
JH		 3018 else {
3019 uv = toTITLE_utf8(s);
3020 ulen = UNISKIP(uv);
3021 }
a0ed51b3 3022
9041c2e3 3023 tend = uvchr_to_utf8(tmpbuf, uv);
a0ed51b3 3024
014822e4 3025 if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
a0ed51b3 3026 dTARGET;
dfe13c55
GS		 3027 sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
3028 sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
7e2040f0 3029 SvUTF8_on(TARG);
a0ed51b3
LW		 3030 SETs(TARG);
3031 }
3032 else {
dfe13c55 3033 s = (U8*)SvPV_force(sv, slen);
a0ed51b3
LW		 3034 Copy(tmpbuf, s, ulen, U8);
3035 }
a0ed51b3 3036 }
626727d5 3037 else {
014822e4 3038 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3039 dTARGET;
7e2040f0 3040 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS		 3041 sv_setsv(TARG, sv);
3042 sv = TARG;
3043 SETs(sv);
3044 }
3045 s = (U8*)SvPV_force(sv, slen);
3046 if (*s) {
2de3dbcc 3047 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3048 TAINT;
3049 SvTAINTED_on(sv);
3050 *s = toUPPER_LC(*s);
3051 }
3052 else
3053 *s = toUPPER(*s);
bbce6d69 3054 }
bbce6d69 3055 }
31351b04
JS		 3056 if (SvSMAGICAL(sv))
3057 mg_set(sv);
79072805
LW		 3058 RETURN;
3059}
3060
3061PP(pp_lcfirst)
3062{
39644a26 3063 dSP;
79072805 3064 SV *sv = TOPs;
a0ed51b3
LW		 3065 register U8 *s;
3066 STRLEN slen;
3067
fd400ab9 3068 if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
ba210ebe 3069 STRLEN ulen;
ad391ad9 3070 U8 tmpbuf[UTF8_MAXLEN+1];
a0ed51b3 3071 U8 *tend;
9041c2e3 3072 UV uv;
a0ed51b3 3073
2de3dbcc 3074 if (IN_LOCALE_RUNTIME) {
a0ed51b3
LW		 3075 TAINT;
3076 SvTAINTED_on(sv);
9041c2e3 3077 uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
a0ed51b3 3078 }
b0f2b690
JH		 3079 else {
3080 uv = toLOWER_utf8(s);
3081 ulen = UNISKIP(uv);
3082 }
a0ed51b3 3083
9041c2e3 3084 tend = uvchr_to_utf8(tmpbuf, uv);
a0ed51b3 3085
014822e4 3086 if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
a0ed51b3 3087 dTARGET;
dfe13c55
GS		 3088 sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
3089 sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
7e2040f0 3090 SvUTF8_on(TARG);
a0ed51b3
LW		 3091 SETs(TARG);
3092 }
3093 else {
dfe13c55 3094 s = (U8*)SvPV_force(sv, slen);
a0ed51b3
LW		 3095 Copy(tmpbuf, s, ulen, U8);
3096 }
a0ed51b3 3097 }
626727d5 3098 else {
014822e4 3099 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3100 dTARGET;
7e2040f0 3101 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS		 3102 sv_setsv(TARG, sv);
3103 sv = TARG;
3104 SETs(sv);
3105 }
3106 s = (U8*)SvPV_force(sv, slen);
3107 if (*s) {
2de3dbcc 3108 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3109 TAINT;
3110 SvTAINTED_on(sv);
3111 *s = toLOWER_LC(*s);
3112 }
3113 else
3114 *s = toLOWER(*s);
bbce6d69 3115 }
bbce6d69 3116 }
31351b04
JS		 3117 if (SvSMAGICAL(sv))
3118 mg_set(sv);
79072805
LW		 3119 RETURN;
3120}
3121
3122PP(pp_uc)
3123{
39644a26 3124 dSP;
79072805 3125 SV *sv = TOPs;
a0ed51b3 3126 register U8 *s;
463ee0b2 3127 STRLEN len;
79072805 3128
7e2040f0 3129 if (DO_UTF8(sv)) {
a0ed51b3 3130 dTARGET;
ba210ebe 3131 STRLEN ulen;
a0ed51b3
LW		 3132 register U8 *d;
3133 U8 *send;
3134
dfe13c55 3135 s = (U8*)SvPV(sv,len);
a5a20234 3136 if (!len) {
7e2040f0 3137 SvUTF8_off(TARG); /* decontaminate */
a5a20234
LW		 3138 sv_setpvn(TARG, "", 0);
3139 SETs(TARG);
a0ed51b3
LW		 3140 }
3141 else {
31351b04
JS		 3142 (void)SvUPGRADE(TARG, SVt_PV);
3143 SvGROW(TARG, (len * 2) + 1);
3144 (void)SvPOK_only(TARG);
3145 d = (U8*)SvPVX(TARG);
3146 send = s + len;
2de3dbcc 3147 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3148 TAINT;
3149 SvTAINTED_on(TARG);
3150 while (s < send) {
9041c2e3 3151 d = uvchr_to_utf8(d, toUPPER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
31351b04
JS		 3152 s += ulen;
3153 }
a0ed51b3 3154 }
31351b04
JS		 3155 else {
3156 while (s < send) {
9041c2e3 3157 d = uvchr_to_utf8(d, toUPPER_utf8( s ));
31351b04
JS		 3158 s += UTF8SKIP(s);
3159 }
a0ed51b3 3160 }
31351b04 3161 *d = '\0';
7e2040f0 3162 SvUTF8_on(TARG);
31351b04
JS		 3163 SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
3164 SETs(TARG);
a0ed51b3 3165 }
a0ed51b3 3166 }
626727d5 3167 else {
014822e4 3168 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3169 dTARGET;
7e2040f0 3170 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS		 3171 sv_setsv(TARG, sv);
3172 sv = TARG;
3173 SETs(sv);
3174 }
3175 s = (U8*)SvPV_force(sv, len);
3176 if (len) {
3177 register U8 *send = s + len;
3178
2de3dbcc 3179 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3180 TAINT;
3181 SvTAINTED_on(sv);
3182 for (; s < send; s++)
3183 *s = toUPPER_LC(*s);
3184 }
3185 else {
3186 for (; s < send; s++)
3187 *s = toUPPER(*s);
3188 }
bbce6d69 3189 }
79072805 3190 }
31351b04
JS		 3191 if (SvSMAGICAL(sv))
3192 mg_set(sv);
79072805
LW		 3193 RETURN;
3194}
3195
3196PP(pp_lc)
3197{
39644a26 3198 dSP;
79072805 3199 SV *sv = TOPs;
a0ed51b3 3200 register U8 *s;
463ee0b2 3201 STRLEN len;
79072805 3202
7e2040f0 3203 if (DO_UTF8(sv)) {
a0ed51b3 3204 dTARGET;
ba210ebe 3205 STRLEN ulen;
a0ed51b3
LW		 3206 register U8 *d;
3207 U8 *send;
3208
dfe13c55 3209 s = (U8*)SvPV(sv,len);
a5a20234 3210 if (!len) {
7e2040f0 3211 SvUTF8_off(TARG); /* decontaminate */
a5a20234
LW		 3212 sv_setpvn(TARG, "", 0);
3213 SETs(TARG);
a0ed51b3
LW		 3214 }
3215 else {
31351b04
JS		 3216 (void)SvUPGRADE(TARG, SVt_PV);
3217 SvGROW(TARG, (len * 2) + 1);
3218 (void)SvPOK_only(TARG);
3219 d = (U8*)SvPVX(TARG);
3220 send = s + len;
2de3dbcc 3221 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3222 TAINT;
3223 SvTAINTED_on(TARG);
3224 while (s < send) {
9041c2e3 3225 d = uvchr_to_utf8(d, toLOWER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
31351b04
JS		 3226 s += ulen;
3227 }
a0ed51b3 3228 }
31351b04
JS		 3229 else {
3230 while (s < send) {
9041c2e3 3231 d = uvchr_to_utf8(d, toLOWER_utf8(s));
31351b04
JS		 3232 s += UTF8SKIP(s);
3233 }
a0ed51b3 3234 }
31351b04 3235 *d = '\0';
7e2040f0 3236 SvUTF8_on(TARG);
31351b04
JS		 3237 SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
3238 SETs(TARG);
a0ed51b3 3239 }
79072805 3240 }
626727d5 3241 else {
014822e4 3242 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3243 dTARGET;
7e2040f0 3244 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS		 3245 sv_setsv(TARG, sv);
3246 sv = TARG;
3247 SETs(sv);
a0ed51b3 3248 }
bbce6d69 3249
31351b04
JS		 3250 s = (U8*)SvPV_force(sv, len);
3251 if (len) {
3252 register U8 *send = s + len;
bbce6d69 3253
2de3dbcc 3254 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3255 TAINT;
3256 SvTAINTED_on(sv);
3257 for (; s < send; s++)
3258 *s = toLOWER_LC(*s);
3259 }
3260 else {
3261 for (; s < send; s++)
3262 *s = toLOWER(*s);
3263 }
bbce6d69 3264 }
79072805 3265 }
31351b04
JS		 3266 if (SvSMAGICAL(sv))
3267 mg_set(sv);
79072805
LW		 3268 RETURN;
3269}
3270
a0d0e21e 3271PP(pp_quotemeta)
79072805 3272{
39644a26 3273 dSP; dTARGET;
a0d0e21e
LW		 3274 SV *sv = TOPs;
3275 STRLEN len;
3276 register char *s = SvPV(sv,len);
3277 register char *d;
79072805 3278
7e2040f0 3279 SvUTF8_off(TARG); /* decontaminate */
a0d0e21e
LW		 3280 if (len) {
3281 (void)SvUPGRADE(TARG, SVt_PV);
c07a80fd 3282 SvGROW(TARG, (len * 2) + 1);
a0d0e21e 3283 d = SvPVX(TARG);
7e2040f0 3284 if (DO_UTF8(sv)) {
0dd2cdef 3285 while (len) {
fd400ab9 3286 if (UTF8_IS_CONTINUED(*s)) {
0dd2cdef
LW		 3287 STRLEN ulen = UTF8SKIP(s);
3288 if (ulen > len)
3289 ulen = len;
3290 len -= ulen;
3291 while (ulen--)
3292 *d++ = *s++;
3293 }
3294 else {
3295 if (!isALNUM(*s))
3296 *d++ = '\\';
3297 *d++ = *s++;
3298 len--;
3299 }
3300 }
7e2040f0 3301 SvUTF8_on(TARG);
0dd2cdef
LW		 3302 }
3303 else {
3304 while (len--) {
3305 if (!isALNUM(*s))
3306 *d++ = '\\';
3307 *d++ = *s++;
3308 }
79072805 3309 }
a0d0e21e
LW		 3310 *d = '\0';
3311 SvCUR_set(TARG, d - SvPVX(TARG));
3aa33fe5 3312 (void)SvPOK_only_UTF8(TARG);
79072805 3313 }
a0d0e21e
LW		 3314 else
3315 sv_setpvn(TARG, s, len);
3316 SETs(TARG);
31351b04
JS		 3317 if (SvSMAGICAL(TARG))
3318 mg_set(TARG);
79072805
LW		 3319 RETURN;
3320}
3321
a0d0e21e 3322/* Arrays. */
79072805 3323
a0d0e21e 3324PP(pp_aslice)
79072805 3325{
39644a26 3326 dSP; dMARK; dORIGMARK;
a0d0e21e
LW		 3327 register SV** svp;
3328 register AV* av = (AV*)POPs;
78f9721b 3329 register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
3280af22 3330 I32 arybase = PL_curcop->cop_arybase;
748a9306 3331 I32 elem;
79072805 3332
a0d0e21e 3333 if (SvTYPE(av) == SVt_PVAV) {
533c011a 3334 if (lval && PL_op->op_private & OPpLVAL_INTRO) {
748a9306 3335 I32 max = -1;
924508f0 3336 for (svp = MARK + 1; svp <= SP; svp++) {
748a9306
LW		 3337 elem = SvIVx(*svp);
3338 if (elem > max)
3339 max = elem;
3340 }
3341 if (max > AvMAX(av))
3342 av_extend(av, max);
3343 }
a0d0e21e 3344 while (++MARK <= SP) {
748a9306 3345 elem = SvIVx(*MARK);
a0d0e21e 3346
748a9306
LW		 3347 if (elem > 0)
3348 elem -= arybase;
a0d0e21e
LW		 3349 svp = av_fetch(av, elem, lval);
3350 if (lval) {
3280af22 3351 if (!svp || *svp == &PL_sv_undef)
cea2e8a9 3352 DIE(aTHX_ PL_no_aelem, elem);
533c011a 3353 if (PL_op->op_private & OPpLVAL_INTRO)
161b7d16 3354 save_aelem(av, elem, svp);
79072805 3355 }
3280af22 3356 *MARK = svp ? *svp : &PL_sv_undef;
79072805
LW		 3357 }
3358 }
748a9306 3359 if (GIMME != G_ARRAY) {
a0d0e21e
LW		 3360 MARK = ORIGMARK;
3361 *++MARK = *SP;
3362 SP = MARK;
3363 }
79072805
LW		 3364 RETURN;
3365}
3366
3367/* Associative arrays. */
3368
3369PP(pp_each)
3370{
39644a26 3371 dSP;
79072805 3372 HV *hash = (HV*)POPs;
c07a80fd 3373 HE *entry;
54310121 3374 I32 gimme = GIMME_V;
c750a3ec 3375 I32 realhv = (SvTYPE(hash) == SVt_PVHV);
8ec5e241 3376
c07a80fd 3377 PUTBACK;
c750a3ec
MB		 3378 /* might clobber stack_sp */
3379 entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
c07a80fd 3380 SPAGAIN;
79072805 3381
79072805
LW		 3382 EXTEND(SP, 2);
3383 if (entry) {
54310121 3384 PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
3385 if (gimme == G_ARRAY) {
59af0135 3386 SV *val;
c07a80fd 3387 PUTBACK;
c750a3ec 3388 /* might clobber stack_sp */
59af0135
GS		 3389 val = realhv ?
3390 hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
c07a80fd 3391 SPAGAIN;
59af0135 3392 PUSHs(val);
79072805 3393 }
79072805 3394 }
54310121 3395 else if (gimme == G_SCALAR)
79072805
LW		 3396 RETPUSHUNDEF;
3397
3398 RETURN;
3399}
3400
3401PP(pp_values)
3402{
cea2e8a9 3403 return do_kv();
79072805
LW		 3404}
3405
3406PP(pp_keys)
3407{
cea2e8a9 3408 return do_kv();
79072805
LW		 3409}
3410
3411PP(pp_delete)
3412{
39644a26 3413 dSP;
54310121 3414 I32 gimme = GIMME_V;
3415 I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
79072805 3416 SV *sv;
5f05dabc 3417 HV *hv;
3418
533c011a 3419 if (PL_op->op_private & OPpSLICE) {
5f05dabc 3420 dMARK; dORIGMARK;
97fcbf96 3421 U32 hvtype;
5f05dabc 3422 hv = (HV*)POPs;
97fcbf96 3423 hvtype = SvTYPE(hv);
01020589
GS		 3424 if (hvtype == SVt_PVHV) { /* hash element */
3425 while (++MARK <= SP) {
ae77835f 3426 sv = hv_delete_ent(hv, *MARK, discard, 0);
01020589
GS		 3427 *MARK = sv ? sv : &PL_sv_undef;
3428 }
5f05dabc 3429 }
01020589
GS		 3430 else if (hvtype == SVt_PVAV) {
3431 if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
3432 while (++MARK <= SP) {
3433 sv = av_delete((AV*)hv, SvIV(*MARK), discard);
3434 *MARK = sv ? sv : &PL_sv_undef;
3435 }
3436 }
3437 else { /* pseudo-hash element */
3438 while (++MARK <= SP) {
3439 sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
3440 *MARK = sv ? sv : &PL_sv_undef;
3441 }
3442 }
3443 }
3444 else
3445 DIE(aTHX_ "Not a HASH reference");
54310121 3446 if (discard)
3447 SP = ORIGMARK;
3448 else if (gimme == G_SCALAR) {
5f05dabc 3449 MARK = ORIGMARK;
3450 *++MARK = *SP;
3451 SP = MARK;
3452 }
3453 }
3454 else {
3455 SV *keysv = POPs;
3456 hv = (HV*)POPs;
97fcbf96
MB		 3457 if (SvTYPE(hv) == SVt_PVHV)
3458 sv = hv_delete_ent(hv, keysv, discard, 0);
01020589
GS		 3459 else if (SvTYPE(hv) == SVt_PVAV) {
3460 if (PL_op->op_flags & OPf_SPECIAL)
3461 sv = av_delete((AV*)hv, SvIV(keysv), discard);
3462 else
3463 sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
3464 }
97fcbf96 3465 else
cea2e8a9 3466 DIE(aTHX_ "Not a HASH reference");
5f05dabc 3467 if (!sv)
3280af22 3468 sv = &PL_sv_undef;
54310121 3469 if (!discard)
3470 PUSHs(sv);
79072805 3471 }
79072805
LW		 3472 RETURN;
3473}
3474
a0d0e21e 3475PP(pp_exists)
79072805 3476{
39644a26 3477 dSP;
afebc493
GS		 3478 SV *tmpsv;
3479 HV *hv;
3480
3481 if (PL_op->op_private & OPpEXISTS_SUB) {
3482 GV *gv;
3483 CV *cv;
3484 SV *sv = POPs;
3485 cv = sv_2cv(sv, &hv, &gv, FALSE);
3486 if (cv)
3487 RETPUSHYES;
3488 if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
3489 RETPUSHYES;
3490 RETPUSHNO;
3491 }
3492 tmpsv = POPs;
3493 hv = (HV*)POPs;
c750a3ec 3494 if (SvTYPE(hv) == SVt_PVHV) {
ae77835f 3495 if (hv_exists_ent(hv, tmpsv, 0))
c750a3ec 3496 RETPUSHYES;
ef54e1a4
JH		 3497 }
3498 else if (SvTYPE(hv) == SVt_PVAV) {
01020589
GS		 3499 if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
3500 if (av_exists((AV*)hv, SvIV(tmpsv)))
3501 RETPUSHYES;
3502 }
3503 else if (avhv_exists_ent((AV*)hv, tmpsv, 0)) /* pseudo-hash element */
c750a3ec 3504 RETPUSHYES;
ef54e1a4
JH		 3505 }
3506 else {
cea2e8a9 3507 DIE(aTHX_ "Not a HASH reference");
a0d0e21e 3508 }
a0d0e21e
LW		 3509 RETPUSHNO;
3510}
79072805 3511
a0d0e21e
LW		 3512PP(pp_hslice)
3513{
39644a26 3514 dSP; dMARK; dORIGMARK;
a0d0e21e 3515 register HV *hv = (HV*)POPs;
78f9721b 3516 register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
c750a3ec 3517 I32 realhv = (SvTYPE(hv) == SVt_PVHV);
79072805 3518
0ebe0038 3519 if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
cea2e8a9 3520 DIE(aTHX_ "Can't localize pseudo-hash element");
0ebe0038 3521
c750a3ec 3522 if (realhv || SvTYPE(hv) == SVt_PVAV) {
a0d0e21e 3523 while (++MARK <= SP) {
f12c7020 3524 SV *keysv = *MARK;
ae77835f 3525 SV **svp;
d4fa047a
RH		 3526 I32 preeminent = SvRMAGICAL(hv) ? 1 :
3527 realhv ? hv_exists_ent(hv, keysv, 0)
3528 : avhv_exists_ent((AV*)hv, keysv, 0);
ae77835f 3529 if (realhv) {
800e9ae0 3530 HE *he = hv_fetch_ent(hv, keysv, lval, 0);
ae77835f 3531 svp = he ? &HeVAL(he) : 0;
ef54e1a4
JH		 3532 }
3533 else {
97fcbf96 3534 svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
ae77835f 3535 }
a0d0e21e 3536 if (lval) {
2d8e6c8d
GS		 3537 if (!svp || *svp == &PL_sv_undef) {
3538 STRLEN n_a;
cea2e8a9 3539 DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
2d8e6c8d 3540 }
1f5346dc 3541 if (PL_op->op_private & OPpLVAL_INTRO) {
a227d84d 3542 if (preeminent)
1f5346dc
SC		 3543 save_helem(hv, keysv, svp);
3544 else {
3545 STRLEN keylen;
3546 char *key = SvPV(keysv, keylen);
57813020 3547 SAVEDELETE(hv, savepvn(key,keylen), keylen);
1f5346dc
SC		 3548 }
3549 }
93a17b20 3550 }
3280af22 3551 *MARK = svp ? *svp : &PL_sv_undef;
79072805
LW		 3552 }
3553 }
a0d0e21e
LW		 3554 if (GIMME != G_ARRAY) {
3555 MARK = ORIGMARK;
3556 *++MARK = *SP;
3557 SP = MARK;
79072805 3558 }
a0d0e21e
LW		 3559 RETURN;
3560}
3561
3562/* List operators. */
3563
3564PP(pp_list)
3565{
39644a26 3566 dSP; dMARK;
a0d0e21e
LW		 3567 if (GIMME != G_ARRAY) {
3568 if (++MARK <= SP)
3569 *MARK = *SP; /* unwanted list, return last item */
8990e307 3570 else
3280af22 3571 *MARK = &PL_sv_undef;
a0d0e21e 3572 SP = MARK;
79072805 3573 }
a0d0e21e 3574 RETURN;
79072805
LW		 3575}
3576
a0d0e21e 3577PP(pp_lslice)
79072805 3578{
39644a26 3579 dSP;
3280af22
NIS		 3580 SV **lastrelem = PL_stack_sp;
3581 SV **lastlelem = PL_stack_base + POPMARK;
3582 SV **firstlelem = PL_stack_base + POPMARK + 1;
a0d0e21e 3583 register SV **firstrelem = lastlelem + 1;
3280af22 3584 I32 arybase = PL_curcop->cop_arybase;
533c011a 3585 I32 lval = PL_op->op_flags & OPf_MOD;
4633a7c4 3586 I32 is_something_there = lval;
79072805 3587
a0d0e21e
LW		 3588 register I32 max = lastrelem - lastlelem;
3589 register SV **lelem;
3590 register I32 ix;
3591
3592 if (GIMME != G_ARRAY) {
748a9306
LW		 3593 ix = SvIVx(*lastlelem);
3594 if (ix < 0)
3595 ix += max;
3596 else
3597 ix -= arybase;
a0d0e21e 3598 if (ix < 0 || ix >= max)
3280af22 3599 *firstlelem = &PL_sv_undef;
a0d0e21e
LW		 3600 else
3601 *firstlelem = firstrelem[ix];
3602 SP = firstlelem;
3603 RETURN;
3604 }
3605
3606 if (max == 0) {
3607 SP = firstlelem - 1;
3608 RETURN;
3609 }
3610
3611 for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
748a9306 3612 ix = SvIVx(*lelem);
c73bf8e3 3613 if (ix < 0)
a0d0e21e 3614 ix += max;
b13b2135 3615 else
748a9306 3616 ix -= arybase;
c73bf8e3
HS		 3617 if (ix < 0 || ix >= max)
3618 *lelem = &PL_sv_undef;
3619 else {
3620 is_something_there = TRUE;
3621 if (!(*lelem = firstrelem[ix]))
3280af22 3622 *lelem = &PL_sv_undef;
748a9306 3623 }
79072805 3624 }
4633a7c4
LW		 3625 if (is_something_there)
3626 SP = lastlelem;
3627 else
3628 SP = firstlelem - 1;
79072805
LW		 3629 RETURN;
3630}
3631
a0d0e21e
LW		 3632PP(pp_anonlist)
3633{
39644a26 3634 dSP; dMARK; dORIGMARK;
a0d0e21e 3635 I32 items = SP - MARK;
44a8e56a 3636 SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
3637 SP = ORIGMARK; /* av_make() might realloc stack_sp */
3638 XPUSHs(av);
a0d0e21e
LW		 3639 RETURN;
3640}
3641
3642PP(pp_anonhash)
79072805 3643{
39644a26 3644 dSP; dMARK; dORIGMARK;
a0d0e21e
LW		 3645 HV* hv = (HV*)sv_2mortal((SV*)newHV());
3646
3647 while (MARK < SP) {
3648 SV* key = *++MARK;
a0d0e21e
LW		 3649 SV *val = NEWSV(46, 0);
3650 if (MARK < SP)
3651 sv_setsv(val, *++MARK);
e476b1b5
GS		 3652 else if (ckWARN(WARN_MISC))
3653 Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
f12c7020 3654 (void)hv_store_ent(hv,key,val,0);
79072805 3655 }
a0d0e21e
LW		 3656 SP = ORIGMARK;
3657 XPUSHs((SV*)hv);
79072805
LW		 3658 RETURN;
3659}
3660
a0d0e21e 3661PP(pp_splice)
79072805 3662{
39644a26 3663 dSP; dMARK; dORIGMARK;
a0d0e21e
LW		 3664 register AV *ary = (AV*)*++MARK;
3665 register SV **src;
3666 register SV **dst;
3667 register I32 i;
3668 register I32 offset;
3669 register I32 length;
3670 I32 newlen;
3671 I32 after;
3672 I32 diff;
3673 SV **tmparyval = 0;
93965878
NIS		 3674 MAGIC *mg;
3675
14befaf4 3676 if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
33c27489 3677 *MARK-- = SvTIED_obj((SV*)ary, mg);
93965878 3678 PUSHMARK(MARK);
8ec5e241 3679 PUTBACK;
a60c0954 3680 ENTER;
864dbfa3 3681 call_method("SPLICE",GIMME_V);
a60c0954 3682 LEAVE;
93965878
NIS		 3683 SPAGAIN;
3684 RETURN;
3685 }
79072805 3686
a0d0e21e 3687 SP++;
79072805 3688
a0d0e21e 3689 if (++MARK < SP) {
84902520 3690 offset = i = SvIVx(*MARK);
a0d0e21e 3691 if (offset < 0)
93965878 3692 offset += AvFILLp(ary) + 1;
a0d0e21e 3693 else
3280af22 3694 offset -= PL_curcop->cop_arybase;
84902520 3695 if (offset < 0)
cea2e8a9 3696 DIE(aTHX_ PL_no_aelem, i);
a0d0e21e
LW		 3697 if (++MARK < SP) {
3698 length = SvIVx(*MARK++);
48cdf507
GA		 3699 if (length < 0) {
3700 length += AvFILLp(ary) - offset + 1;
3701 if (length < 0)
3702 length = 0;
3703 }
79072805
LW		 3704 }
3705 else
a0d0e21e 3706 length = AvMAX(ary) + 1; /* close enough to infinity */
79072805 3707 }
a0d0e21e
LW		 3708 else {
3709 offset = 0;
3710 length = AvMAX(ary) + 1;
3711 }
93965878
NIS		 3712 if (offset > AvFILLp(ary) + 1)
3713 offset = AvFILLp(ary) + 1;
3714 after = AvFILLp(ary) + 1 - (offset + length);
a0d0e21e
LW		 3715 if (after < 0) { /* not that much array */
3716 length += after; /* offset+length now in array */
3717 after = 0;
3718 if (!AvALLOC(ary))
3719 av_extend(ary, 0);
3720 }
3721
3722 /* At this point, MARK .. SP-1 is our new LIST */
3723
3724 newlen = SP - MARK;
3725 diff = newlen - length;
13d7cbc1
GS		 3726 if (newlen && !AvREAL(ary) && AvREIFY(ary))
3727 av_reify(ary);
a0d0e21e
LW		 3728
3729 if (diff < 0) { /* shrinking the area */
3730 if (newlen) {
3731 New(451, tmparyval, newlen, SV*); /* so remember insertion */
3732 Copy(MARK, tmparyval, newlen, SV*);
79072805 3733 }
a0d0e21e
LW		 3734
3735 MARK = ORIGMARK + 1;
3736 if (GIMME == G_ARRAY) { /* copy return vals to stack */
3737 MEXTEND(MARK, length);
3738 Copy(AvARRAY(ary)+offset, MARK, length, SV*);
3739 if (AvREAL(ary)) {
bbce6d69 3740 EXTEND_MORTAL(length);
36477c24 3741 for (i = length, dst = MARK; i; i--) {
d689ffdd 3742 sv_2mortal(*dst); /* free them eventualy */
36477c24 3743 dst++;
3744 }
a0d0e21e
LW		 3745 }
3746 MARK += length - 1;
79072805 3747 }
a0d0e21e
LW		 3748 else {
3749 *MARK = AvARRAY(ary)[offset+length-1];
3750 if (AvREAL(ary)) {
d689ffdd 3751 sv_2mortal(*MARK);
a0d0e21e
LW		 3752 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
3753 SvREFCNT_dec(*dst++); /* free them now */
79072805 3754 }
a0d0e21e 3755 }
93965878 3756 AvFILLp(ary) += diff;
a0d0e21e
LW		 3757
3758 /* pull up or down? */
3759
3760 if (offset < after) { /* easier to pull up */
3761 if (offset) { /* esp. if nothing to pull */
3762 src = &AvARRAY(ary)[offset-1];
3763 dst = src - diff; /* diff is negative */
3764 for (i = offset; i > 0; i--) /* can't trust Copy */
3765 *dst-- = *src--;
79072805 3766 }
a0d0e21e
LW		 3767 dst = AvARRAY(ary);
3768 SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
3769 AvMAX(ary) += diff;
3770 }
3771 else {
3772 if (after) { /* anything to pull down? */
3773 src = AvARRAY(ary) + offset + length;
3774 dst = src + diff; /* diff is negative */
3775 Move(src, dst, after, SV*);
79072805 3776 }
93965878 3777 dst = &AvARRAY(ary)[AvFILLp(ary)+1];
a0d0e21e
LW		 3778 /* avoid later double free */
3779 }
3780 i = -diff;
3781 while (i)
3280af22 3782 dst[--i] = &PL_sv_undef;
a0d0e21e
LW		 3783
3784 if (newlen) {
3785 for (src = tmparyval, dst = AvARRAY(ary) + offset;
3786 newlen; newlen--) {
3787 *dst = NEWSV(46, 0);
3788 sv_setsv(*dst++, *src++);
79072805 3789 }
a0d0e21e
LW		 3790 Safefree(tmparyval);
3791 }
3792 }
3793 else { /* no, expanding (or same) */
3794 if (length) {
3795 New(452, tmparyval, length, SV*); /* so remember deletion */
3796 Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
3797 }
3798
3799 if (diff > 0) { /* expanding */
3800
3801 /* push up or down? */
3802
3803 if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
3804 if (offset) {
3805 src = AvARRAY(ary);
3806 dst = src - diff;
3807 Move(src, dst, offset, SV*);
79072805 3808 }
a0d0e21e
LW		 3809 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
3810 AvMAX(ary) += diff;
93965878 3811 AvFILLp(ary) += diff;
79072805
LW		 3812 }
3813 else {
93965878
NIS		 3814 if (AvFILLp(ary) + diff >= AvMAX(ary)) /* oh, well */
3815 av_extend(ary, AvFILLp(ary) + diff);
3816 AvFILLp(ary) += diff;
a0d0e21e
LW		 3817
3818 if (after) {
93965878 3819 dst = AvARRAY(ary) + AvFILLp(ary);
a0d0e21e
LW		 3820 src = dst - diff;
3821 for (i = after; i; i--) {
3822 *dst-- = *src--;
3823 }
79072805
LW		 3824 }
3825 }
a0d0e21e
LW		 3826 }
3827
3828 for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
3829 *dst = NEWSV(46, 0);
3830 sv_setsv(*dst++, *src++);
3831 }
3832 MARK = ORIGMARK + 1;
3833 if (GIMME == G_ARRAY) { /* copy return vals to stack */
3834 if (length) {
3835 Copy(tmparyval, MARK, length, SV*);
3836 if (AvREAL(ary)) {
bbce6d69 3837 EXTEND_MORTAL(length);
36477c24 3838 for (i = length, dst = MARK; i; i--) {
d689ffdd 3839 sv_2mortal(*dst); /* free them eventualy */
36477c24 3840 dst++;
3841 }
79072805 3842 }
a0d0e21e 3843 Safefree(tmparyval);
79072805 3844 }
a0d0e21e
LW		 3845 MARK += length - 1;
3846 }
3847 else if (length--) {
3848 *MARK = tmparyval[length];
3849 if (AvREAL(ary)) {
d689ffdd 3850 sv_2mortal(*MARK);
a0d0e21e
LW		 3851 while (length-- > 0)
3852 SvREFCNT_dec(tmparyval[length]);
79072805 3853 }
a0d0e21e 3854 Safefree(tmparyval);
79072805 3855 }
a0d0e21e 3856 else
3280af22 3857 *MARK = &PL_sv_undef;
79072805 3858 }
a0d0e21e 3859 SP = MARK;
79072805
LW		 3860 RETURN;
3861}
3862
a0d0e21e 3863PP(pp_push)
79072805 3864{
39644a26 3865 dSP; dMARK; dORIGMARK; dTARGET;
a0d0e21e 3866 register AV *ary = (AV*)*++MARK;
3280af22 3867 register SV *sv = &PL_sv_undef;
93965878 3868 MAGIC *mg;
79072805 3869
14befaf4 3870 if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
33c27489 3871 *MARK-- = SvTIED_obj((SV*)ary, mg);
93965878
NIS		 3872 PUSHMARK(MARK);
3873 PUTBACK;
a60c0954 3874 ENTER;
864dbfa3 3875 call_method("PUSH",G_SCALAR|G_DISCARD);
a60c0954 3876 LEAVE;
93965878 3877 SPAGAIN;
93965878 3878 }
a60c0954
NIS		 3879 else {
3880 /* Why no pre-extend of ary here ? */
3881 for (++MARK; MARK <= SP; MARK++) {
3882 sv = NEWSV(51, 0);
3883 if (*MARK)
3884 sv_setsv(sv, *MARK);
3885 av_push(ary, sv);
3886 }
79072805
LW		 3887 }
3888 SP = ORIGMARK;
a0d0e21e 3889 PUSHi( AvFILL(ary) + 1 );
79072805
LW		 3890 RETURN;
3891}
3892
a0d0e21e 3893PP(pp_pop)
79072805 3894{
39644a26 3895 dSP;
a0d0e21e
LW		 3896 AV *av = (AV*)POPs;
3897 SV *sv = av_pop(av);
d689ffdd 3898 if (AvREAL(av))
a0d0e21e
LW		 3899 (void)sv_2mortal(sv);
3900 PUSHs(sv);
79072805 3901 RETURN;
79072805
LW		 3902}
3903
a0d0e21e 3904PP(pp_shift)
79072805 3905{
39644a26 3906 dSP;
a0d0e21e
LW		 3907 AV *av = (AV*)POPs;
3908 SV *sv = av_shift(av);
79072805 3909 EXTEND(SP, 1);
a0d0e21e 3910 if (!sv)
79072805 3911 RETPUSHUNDEF;
d689ffdd 3912 if (AvREAL(av))
a0d0e21e
LW		 3913 (void)sv_2mortal(sv);
3914 PUSHs(sv);
79072805 3915 RETURN;
79072805
LW		 3916}
3917
a0d0e21e 3918PP(pp_unshift)
79072805 3919{
39644a26 3920 dSP; dMARK; dORIGMARK; dTARGET;
a0d0e21e
LW		 3921 register AV *ary = (AV*)*++MARK;
3922 register SV *sv;
3923 register I32 i = 0;
93965878
NIS		 3924 MAGIC *mg;
3925
14befaf4 3926 if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
33c27489 3927 *MARK-- = SvTIED_obj((SV*)ary, mg);
7fd66d9d 3928 PUSHMARK(MARK);
93965878 3929 PUTBACK;
a60c0954 3930 ENTER;
864dbfa3 3931 call_method("UNSHIFT",G_SCALAR|G_DISCARD);
a60c0954 3932 LEAVE;
93965878 3933 SPAGAIN;
93965878 3934 }
a60c0954
NIS		 3935 else {
3936 av_unshift(ary, SP - MARK);
3937 while (MARK < SP) {
3938 sv = NEWSV(27, 0);
3939 sv_setsv(sv, *++MARK);
3940 (void)av_store(ary, i++, sv);
3941 }
79072805 3942 }
a0d0e21e
LW		 3943 SP = ORIGMARK;
3944 PUSHi( AvFILL(ary) + 1 );
79072805 3945 RETURN;
79072805
LW		 3946}
3947
a0d0e21e 3948PP(pp_reverse)
79072805 3949{
39644a26 3950 dSP; dMARK;
a0d0e21e
LW		 3951 register SV *tmp;
3952 SV **oldsp = SP;
79072805 3953
a0d0e21e
LW		 3954 if (GIMME == G_ARRAY) {
3955 MARK++;
3956 while (MARK < SP) {
3957 tmp = *MARK;
3958 *MARK++ = *SP;
3959 *SP-- = tmp;
3960 }
dd58a1ab 3961 /* safe as long as stack cannot get extended in the above */
a0d0e21e 3962 SP = oldsp;
79072805
LW		 3963 }
3964 else {
a0d0e21e
LW		 3965 register char *up;
3966 register char *down;
3967 register I32 tmp;
3968 dTARGET;
3969 STRLEN len;
79072805 3970
7e2040f0 3971 SvUTF8_off(TARG); /* decontaminate */
a0d0e21e 3972 if (SP - MARK > 1)
3280af22 3973 do_join(TARG, &PL_sv_no, MARK, SP);
a0d0e21e 3974 else
54b9620d 3975 sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
a0d0e21e
LW		 3976 up = SvPV_force(TARG, len);
3977 if (len > 1) {
7e2040f0 3978 if (DO_UTF8(TARG)) { /* first reverse each character */
dfe13c55
GS		 3979 U8* s = (U8*)SvPVX(TARG);
3980 U8* send = (U8*)(s + len);
a0ed51b3 3981 while (s < send) {
d742c382 3982 if (UTF8_IS_INVARIANT(*s)) {
a0ed51b3
LW		 3983 s++;
3984 continue;
3985 }
3986 else {
9041c2e3 3987 if (!utf8_to_uvchr(s, 0))
a0dbb045 3988 break;
dfe13c55 3989 up = (char*)s;
a0ed51b3 3990 s += UTF8SKIP(s);
dfe13c55 3991 down = (char*)(s - 1);
a0dbb045 3992 /* reverse this character */
a0ed51b3
LW		 3993 while (down > up) {
3994 tmp = *up;
3995 *up++ = *down;
3996 *down-- = tmp;
3997 }
3998 }
3999 }
4000 up = SvPVX(TARG);
4001 }
a0d0e21e
LW		 4002 down = SvPVX(TARG) + len - 1;
4003 while (down > up) {
4004 tmp = *up;
4005 *up++ = *down;
4006 *down-- = tmp;
4007 }
3aa33fe5 4008 (void)SvPOK_only_UTF8(TARG);
79072805 4009 }
a0d0e21e
LW		 4010 SP = MARK + 1;
4011 SETTARG;
79072805 4012 }
a0d0e21e 4013 RETURN;
79072805
LW		 4014}
4015
a0d0e21e 4016PP(pp_split)
79072805 4017{
39644a26 4018 dSP; dTARG;
a0d0e21e 4019 AV *ary;
467f0320 4020 register IV limit = POPi; /* note, negative is forever */
a0d0e21e
LW		 4021 SV *sv = POPs;
4022 STRLEN len;
4023 register char *s = SvPV(sv, len);
1aa99e6b 4024 bool do_utf8 = DO_UTF8(sv);
a0d0e21e 4025 char *strend = s + len;
44a8e56a 4026 register PMOP *pm;
d9f97599 4027 register REGEXP *rx;
a0d0e21e
LW		 4028 register SV *dstr;
4029 register char *m;
4030 I32 iters = 0;
792b2c16
JH		 4031 STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s);
4032 I32 maxiters = slen + 10;
a0d0e21e
LW		 4033 I32 i;
4034 char *orig;
4035 I32 origlimit = limit;
4036 I32 realarray = 0;
4037 I32 base;
3280af22 4038 AV *oldstack = PL_curstack;
54310121 4039 I32 gimme = GIMME_V;
3280af22 4040 I32 oldsave = PL_savestack_ix;
8ec5e241
NIS		 4041 I32 make_mortal = 1;
4042 MAGIC *mg = (MAGIC *) NULL;
79072805 4043
44a8e56a 4044#ifdef DEBUGGING
4045 Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
4046#else
4047 pm = (PMOP*)POPs;
4048#endif
a0d0e21e 4049 if (!pm || !s)
2269b42e 4050 DIE(aTHX_ "panic: pp_split");
aaa362c4 4051 rx = PM_GETRE(pm);
bbce6d69 4052
4053 TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
4054 (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
4055
971a9dd3
GS		 4056 if (pm->op_pmreplroot) {
4057#ifdef USE_ITHREADS
4058 ary = GvAVn((GV*)PL_curpad[(PADOFFSET)pm->op_pmreplroot]);
4059#else
a0d0e21e 4060 ary = GvAVn((GV*)pm->op_pmreplroot);
971a9dd3
GS		 4061#endif
4062 }
a0d0e21e 4063 else if (gimme != G_ARRAY)
6d4ff0d2 4064#ifdef USE_THREADS
533c011a 4065 ary = (AV*)PL_curpad[0];
6d4ff0d2 4066#else
3280af22 4067 ary = GvAVn(PL_defgv);
6d4ff0d2 4068#endif /* USE_THREADS */
79072805 4069 else
a0d0e21e
LW		 4070 ary = Nullav;
4071 if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
4072 realarray = 1;
8ec5e241 4073 PUTBACK;
a0d0e21e
LW		 4074 av_extend(ary,0);
4075 av_clear(ary);
8ec5e241 4076 SPAGAIN;
14befaf4 4077 if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
8ec5e241 4078 PUSHMARK(SP);
33c27489 4079 XPUSHs(SvTIED_obj((SV*)ary, mg));
8ec5e241
NIS		 4080 }
4081 else {
1c0b011c
NIS		 4082 if (!AvREAL(ary)) {
4083 AvREAL_on(ary);
abff13bb 4084 AvREIFY_off(ary);
1c0b011c 4085 for (i = AvFILLp(ary); i >= 0; i--)
3280af22 4086 AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */
1c0b011c
NIS		 4087 }
4088 /* temporarily switch stacks */
3280af22 4089 SWITCHSTACK(PL_curstack, ary);
8ec5e241 4090 make_mortal = 0;
1c0b011c 4091 }
79072805 4092 }
3280af22 4093 base = SP - PL_stack_base;
a0d0e21e
LW		 4094 orig = s;
4095 if (pm->op_pmflags & PMf_SKIPWHITE) {
bbce6d69 4096 if (pm->op_pmflags & PMf_LOCALE) {
4097 while (isSPACE_LC(*s))
4098 s++;
4099 }
4100 else {
4101 while (isSPACE(*s))
4102 s++;
4103 }
a0d0e21e 4104 }
c07a80fd 4105 if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
3280af22
NIS		 4106 SAVEINT(PL_multiline);
4107 PL_multiline = pm->op_pmflags & PMf_MULTILINE;
c07a80fd 4108 }
4109
a0d0e21e
LW		 4110 if (!limit)
4111 limit = maxiters + 2;
4112 if (pm->op_pmflags & PMf_WHITE) {
4113 while (--limit) {
bbce6d69 4114 m = s;
4115 while (m < strend &&
4116 !((pm->op_pmflags & PMf_LOCALE)
4117 ? isSPACE_LC(*m) : isSPACE(*m)))
4118 ++m;
a0d0e21e
LW		 4119 if (m >= strend)
4120 break;
bbce6d69 4121
a0d0e21e
LW		 4122 dstr = NEWSV(30, m-s);
4123 sv_setpvn(dstr, s, m-s);
8ec5e241 4124 if (make_mortal)
a0d0e21e 4125 sv_2mortal(dstr);
792b2c16 4126 if (do_utf8)
28cb3359 4127 (void)SvUTF8_on(dstr);
a0d0e21e 4128 XPUSHs(dstr);
bbce6d69 4129
4130 s = m + 1;
4131 while (s < strend &&
4132 ((pm->op_pmflags & PMf_LOCALE)
4133 ? isSPACE_LC(*s) : isSPACE(*s)))
4134 ++s;
79072805
LW		 4135 }
4136 }
f4091fba 4137 else if (strEQ("^", rx->precomp)) {
a0d0e21e
LW		 4138 while (--limit) {
4139 /*SUPPRESS 530*/
4140 for (m = s; m < strend && *m != '\n'; m++) ;
4141 m++;
4142 if (m >= strend)
4143 break;
4144 dstr = NEWSV(30, m-s);
4145 sv_setpvn(dstr, s, m-s);
8ec5e241 4146 if (make_mortal)
a0d0e21e 4147 sv_2mortal(dstr);
792b2c16 4148 if (do_utf8)
28cb3359 4149 (void)SvUTF8_on(dstr);
a0d0e21e
LW		 4150 XPUSHs(dstr);
4151 s = m;
4152 }
4153 }
699c3c34
JH		 4154 else if (do_utf8 == ((rx->reganch & ROPT_UTF8) != 0) &&
4155 (rx->reganch & RE_USE_INTUIT) && !rx->nparens
d9f97599
GS		 4156 && (rx->reganch & ROPT_CHECK_ALL)
4157 && !(rx->reganch & ROPT_ANCH)) {
f722798b
IZ		 4158 int tail = (rx->reganch & RE_INTUIT_TAIL);
4159 SV *csv = CALLREG_INTUIT_STRING(aTHX_ rx);
cf93c79d 4160
ca5b42cb 4161 len = rx->minlen;
1aa99e6b 4162 if (len == 1 && !(rx->reganch & ROPT_UTF8) && !tail) {
93f04dac
JH		 4163 STRLEN n_a;
4164 char c = *SvPV(csv, n_a);
a0d0e21e 4165 while (--limit) {
bbce6d69 4166 /*SUPPRESS 530*/
f722798b 4167 for (m = s; m < strend && *m != c; m++) ;
a0d0e21e
LW		 4168 if (m >= strend)
4169 break;
4170 dstr = NEWSV(30, m-s);
4171 sv_setpvn(dstr, s, m-s);
8ec5e241 4172 if (make_mortal)
a0d0e21e 4173 sv_2mortal(dstr);
792b2c16 4174 if (do_utf8)
28cb3359 4175 (void)SvUTF8_on(dstr);
a0d0e21e 4176 XPUSHs(dstr);
93f04dac
JH		 4177 /* The rx->minlen is in characters but we want to step
4178 * s ahead by bytes. */
1aa99e6b
IH		 4179 if (do_utf8)
4180 s = (char*)utf8_hop((U8*)m, len);
4181 else
4182 s = m + len; /* Fake \n at the end */
a0d0e21e
LW		 4183 }
4184 }
4185 else {
4186#ifndef lint
4187 while (s < strend && --limit &&
f722798b
IZ		 4188 (m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
4189 csv, PL_multiline ? FBMrf_MULTILINE : 0)) )
79072805 4190#endif
a0d0e21e
LW		 4191 {
4192 dstr = NEWSV(31, m-s);
4193 sv_setpvn(dstr, s, m-s);
8ec5e241 4194 if (make_mortal)
a0d0e21e 4195 sv_2mortal(dstr);
792b2c16 4196 if (do_utf8)
28cb3359 4197 (void)SvUTF8_on(dstr);
a0d0e21e 4198 XPUSHs(dstr);
93f04dac
JH		 4199 /* The rx->minlen is in characters but we want to step
4200 * s ahead by bytes. */
1aa99e6b
IH		 4201 if (do_utf8)
4202 s = (char*)utf8_hop((U8*)m, len);
4203 else
4204 s = m + len; /* Fake \n at the end */
a0d0e21e 4205 }
463ee0b2 4206 }
463ee0b2 4207 }
a0d0e21e 4208 else {
792b2c16 4209 maxiters += slen * rx->nparens;
f722798b 4210 while (s < strend && --limit
b13b2135 4211/* && (!rx->check_substr
f722798b
IZ		 4212 || ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend,
4213 0, NULL))))
4214*/ && CALLREGEXEC(aTHX_ rx, s, strend, orig,
4215 1 /* minend */, sv, NULL, 0))
bbce6d69 4216 {
d9f97599 4217 TAINT_IF(RX_MATCH_TAINTED(rx));
cf93c79d 4218 if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
a0d0e21e
LW		 4219 m = s;
4220 s = orig;
cf93c79d 4221 orig = rx->subbeg;
a0d0e21e
LW		 4222 s = orig + (m - s);
4223 strend = s + (strend - m);
4224 }
cf93c79d 4225 m = rx->startp[0] + orig;
a0d0e21e
LW		 4226 dstr = NEWSV(32, m-s);
4227 sv_setpvn(dstr, s, m-s);
8ec5e241 4228 if (make_mortal)
a0d0e21e 4229 sv_2mortal(dstr);
792b2c16 4230 if (do_utf8)
28cb3359 4231 (void)SvUTF8_on(dstr);
a0d0e21e 4232 XPUSHs(dstr);
d9f97599
GS		 4233 if (rx->nparens) {
4234 for (i = 1; i <= rx->nparens; i++) {
cf93c79d
IZ		 4235 s = rx->startp[i] + orig;
4236 m = rx->endp[i] + orig;
6de67870
JP		 4237
4238 /* japhy (07/27/01) -- the (m && s) test doesn't catch
4239 parens that didn't match -- they should be set to
4240 undef, not the empty string */
4241 if (m >= orig && s >= orig) {
748a9306
LW		 4242 dstr = NEWSV(33, m-s);
4243 sv_setpvn(dstr, s, m-s);
4244 }
4245 else
6de67870 4246 dstr = &PL_sv_undef; /* undef, not "" */
8ec5e241 4247 if (make_mortal)
a0d0e21e 4248 sv_2mortal(dstr);
792b2c16 4249 if (do_utf8)
28cb3359 4250 (void)SvUTF8_on(dstr);
a0d0e21e
LW		 4251 XPUSHs(dstr);
4252 }
4253 }
cf93c79d 4254 s = rx->endp[0] + orig;
a0d0e21e 4255 }
79072805 4256 }
8ec5e241 4257
c07a80fd 4258 LEAVE_SCOPE(oldsave);
3280af22 4259 iters = (SP - PL_stack_base) - base;
a0d0e21e 4260 if (iters > maxiters)
cea2e8a9 4261 DIE(aTHX_ "Split loop");
8ec5e241 4262
a0d0e21e
LW		 4263 /* keep field after final delim? */
4264 if (s < strend || (iters && origlimit)) {
93f04dac
JH		 4265 STRLEN l = strend - s;
4266 dstr = NEWSV(34, l);
4267 sv_setpvn(dstr, s, l);
8ec5e241 4268 if (make_mortal)
a0d0e21e 4269 sv_2mortal(dstr);
792b2c16 4270 if (do_utf8)
28cb3359 4271 (void)SvUTF8_on(dstr);
a0d0e21e
LW		 4272 XPUSHs(dstr);
4273 iters++;
79072805 4274 }
a0d0e21e 4275 else if (!origlimit) {
b1dadf13 4276 while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
a0d0e21e
LW		 4277 iters--, SP--;
4278 }
8ec5e241 4279
a0d0e21e 4280 if (realarray) {
8ec5e241 4281 if (!mg) {
1c0b011c
NIS		 4282 SWITCHSTACK(ary, oldstack);
4283 if (SvSMAGICAL(ary)) {
4284 PUTBACK;
4285 mg_set((SV*)ary);
4286 SPAGAIN;
4287 }
4288 if (gimme == G_ARRAY) {
4289 EXTEND(SP, iters);
4290 Copy(AvARRAY(ary), SP + 1, iters, SV*);
4291 SP += iters;
4292 RETURN;
4293 }
8ec5e241 4294 }
1c0b011c 4295 else {
fb73857a 4296 PUTBACK;
8ec5e241 4297 ENTER;
864dbfa3 4298 call_method("PUSH",G_SCALAR|G_DISCARD);
8ec5e241 4299 LEAVE;
fb73857a 4300 SPAGAIN;
8ec5e241
NIS		 4301 if (gimme == G_ARRAY) {
4302 /* EXTEND should not be needed - we just popped them */
4303 EXTEND(SP, iters);
4304 for (i=0; i < iters; i++) {
4305 SV **svp = av_fetch(ary, i, FALSE);
3280af22 4306 PUSHs((svp) ? *svp : &PL_sv_undef);
8ec5e241 4307 }
1c0b011c
NIS		 4308 RETURN;
4309 }
a0d0e21e
LW		 4310 }
4311 }
4312 else {
4313 if (gimme == G_ARRAY)
4314 RETURN;
4315 }
4316 if (iters || !pm->op_pmreplroot) {
4317 GETTARGET;
4318 PUSHi(iters);
4319 RETURN;
4320 }
4321 RETPUSHUNDEF;
79072805 4322}
85e6fe83 4323
c0329465 4324#ifdef USE_THREADS
77a005ab 4325void
864dbfa3 4326Perl_unlock_condpair(pTHX_ void *svv)
c0329465 4327{
14befaf4 4328 MAGIC *mg = mg_find((SV*)svv, PERL_MAGIC_mutex);
8ec5e241 4329
c0329465 4330 if (!mg)
cea2e8a9 4331 Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex");
c0329465
MB		 4332 MUTEX_LOCK(MgMUTEXP(mg));
4333 if (MgOWNER(mg) != thr)
cea2e8a9 4334 Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own");
c0329465
MB		 4335 MgOWNER(mg) = 0;
4336 COND_SIGNAL(MgOWNERCONDP(mg));
b900a521 4337 DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n",
a674cc95 4338 PTR2UV(thr), PTR2UV(svv)));
c0329465
MB		 4339 MUTEX_UNLOCK(MgMUTEXP(mg));
4340}
4341#endif /* USE_THREADS */
4342
4343PP(pp_lock)
4344{
39644a26 4345 dSP;
c0329465 4346 dTOPss;
e55aaa0e
MB		 4347 SV *retsv = sv;
4348#ifdef USE_THREADS
4755096e 4349 sv_lock(sv);
c0329465 4350#endif /* USE_THREADS */
e55aaa0e
MB		 4351 if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
4352 || SvTYPE(retsv) == SVt_PVCV) {
4353 retsv = refto(retsv);
4354 }
4355 SETs(retsv);
c0329465
MB		 4356 RETURN;
4357}
a863c7d1 4358
2faa37cc 4359PP(pp_threadsv)
a863c7d1 4360{
57d3b86d 4361#ifdef USE_THREADS
39644a26 4362 dSP;
924508f0 4363 EXTEND(SP, 1);
533c011a
NIS		 4364 if (PL_op->op_private & OPpLVAL_INTRO)
4365 PUSHs(*save_threadsv(PL_op->op_targ));
554b3eca 4366 else
533c011a 4367 PUSHs(THREADSV(PL_op->op_targ));
fdb47d66 4368 RETURN;
a863c7d1 4369#else
cea2e8a9 4370 DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
a863c7d1 4371#endif /* USE_THREADS */
a863c7d1 4372}
Unnamed repository; edit this file 'description' to name the repository.