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
Test obsoleted by change #10777.
[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 }
71be2cbc 470 else if (SvPADTMP(sv))
471 sv = newSVsv(sv);
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--;
946 SETi( -product );
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--;
983 SETi( -product_low );
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) {
1142 if (*SP)
1143 SvTEMP_off((*SP));
1144 SP--;
79072805 1145 }
a0d0e21e
LW		 1146 MARK++;
1147 repeatcpy((char*)(MARK + items), (char*)MARK,
1148 items * sizeof(SV*), count - 1);
1149 SP += max;
79072805 1150 }
a0d0e21e
LW		 1151 else if (count <= 0)
1152 SP -= items;
79072805 1153 }
a0d0e21e 1154 else { /* Note: mark already snarfed by pp_list */
dfcb284a 1155 SV *tmpstr = POPs;
a0d0e21e 1156 STRLEN len;
9b877dbb 1157 bool isutf;
a0d0e21e 1158
a0d0e21e
LW		 1159 SvSetSV(TARG, tmpstr);
1160 SvPV_force(TARG, len);
9b877dbb 1161 isutf = DO_UTF8(TARG);
8ebc5c01 1162 if (count != 1) {
1163 if (count < 1)
1164 SvCUR_set(TARG, 0);
1165 else {
1166 SvGROW(TARG, (count * len) + 1);
a0d0e21e 1167 repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
8ebc5c01 1168 SvCUR(TARG) *= count;
7a4c00b4 1169 }
a0d0e21e 1170 *SvEND(TARG) = '\0';
a0d0e21e 1171 }
dfcb284a
GS		 1172 if (isutf)
1173 (void)SvPOK_only_UTF8(TARG);
1174 else
1175 (void)SvPOK_only(TARG);
b80b6069
RH		 1176
1177 if (PL_op->op_private & OPpREPEAT_DOLIST) {
1178 /* The parser saw this as a list repeat, and there
1179 are probably several items on the stack. But we're
1180 in scalar context, and there's no pp_list to save us
1181 now. So drop the rest of the items -- robin@kitsite.com
1182 */
1183 dMARK;
1184 SP = MARK;
1185 }
a0d0e21e 1186 PUSHTARG;
79072805 1187 }
a0d0e21e 1188 RETURN;
748a9306 1189 }
a0d0e21e 1190}
79072805 1191
a0d0e21e
LW		 1192PP(pp_subtract)
1193{
39644a26 1194 dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
28e5dec8
JH		 1195 useleft = USE_LEFT(TOPm1s);
1196#ifdef PERL_PRESERVE_IVUV
7dca457a
NC		 1197 /* See comments in pp_add (in pp_hot.c) about Overflow, and how
1198 "bad things" happen if you rely on signed integers wrapping. */
28e5dec8
JH		 1199 SvIV_please(TOPs);
1200 if (SvIOK(TOPs)) {
1201 /* Unless the left argument is integer in range we are going to have to
1202 use NV maths. Hence only attempt to coerce the right argument if
1203 we know the left is integer. */
9c5ffd7c
JH		 1204 register UV auv = 0;
1205 bool auvok = FALSE;
7dca457a
NC		 1206 bool a_valid = 0;
1207
28e5dec8 1208 if (!useleft) {
7dca457a
NC		 1209 auv = 0;
1210 a_valid = auvok = 1;
1211 /* left operand is undef, treat as zero. */
28e5dec8
JH		 1212 } else {
1213 /* Left operand is defined, so is it IV? */
1214 SvIV_please(TOPm1s);
1215 if (SvIOK(TOPm1s)) {
7dca457a
NC		 1216 if ((auvok = SvUOK(TOPm1s)))
1217 auv = SvUVX(TOPm1s);
1218 else {
1219 register IV aiv = SvIVX(TOPm1s);
1220 if (aiv >= 0) {
1221 auv = aiv;
1222 auvok = 1; /* Now acting as a sign flag. */
1223 } else { /* 2s complement assumption for IV_MIN */
1224 auv = (UV)-aiv;
28e5dec8 1225 }
7dca457a
NC		 1226 }
1227 a_valid = 1;
1228 }
1229 }
1230 if (a_valid) {
1231 bool result_good = 0;
1232 UV result;
1233 register UV buv;
1234 bool buvok = SvUOK(TOPs);
9041c2e3 1235
7dca457a
NC		 1236 if (buvok)
1237 buv = SvUVX(TOPs);
1238 else {
1239 register IV biv = SvIVX(TOPs);
1240 if (biv >= 0) {
1241 buv = biv;
1242 buvok = 1;
1243 } else
1244 buv = (UV)-biv;
1245 }
1246 /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
1247 else "IV" now, independant of how it came in.
1248 if a, b represents positive, A, B negative, a maps to -A etc
1249 a - b => (a - b)
1250 A - b => -(a + b)
1251 a - B => (a + b)
1252 A - B => -(a - b)
1253 all UV maths. negate result if A negative.
1254 subtract if signs same, add if signs differ. */
1255
1256 if (auvok ^ buvok) {
1257 /* Signs differ. */
1258 result = auv + buv;
1259 if (result >= auv)
1260 result_good = 1;
1261 } else {
1262 /* Signs same */
1263 if (auv >= buv) {
1264 result = auv - buv;
1265 /* Must get smaller */
1266 if (result <= auv)
1267 result_good = 1;
1268 } else {
1269 result = buv - auv;
1270 if (result <= buv) {
1271 /* result really should be -(auv-buv). as its negation
1272 of true value, need to swap our result flag */
1273 auvok = !auvok;
1274 result_good = 1;
28e5dec8 1275 }
28e5dec8
JH		 1276 }
1277 }
7dca457a
NC		 1278 if (result_good) {
1279 SP--;
1280 if (auvok)
1281 SETu( result );
1282 else {
1283 /* Negate result */
1284 if (result <= (UV)IV_MIN)
1285 SETi( -(IV)result );
1286 else {
1287 /* result valid, but out of range for IV. */
1288 SETn( -(NV)result );
1289 }
1290 }
1291 RETURN;
1292 } /* Overflow, drop through to NVs. */
28e5dec8
JH		 1293 }
1294 }
1295#endif
7dca457a 1296 useleft = USE_LEFT(TOPm1s);
a0d0e21e 1297 {
28e5dec8
JH		 1298 dPOPnv;
1299 if (!useleft) {
1300 /* left operand is undef, treat as zero - value */
1301 SETn(-value);
1302 RETURN;
1303 }
1304 SETn( TOPn - value );
1305 RETURN;
79072805 1306 }
a0d0e21e 1307}
79072805 1308
a0d0e21e
LW		 1309PP(pp_left_shift)
1310{
39644a26 1311 dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
a0d0e21e 1312 {
972b05a9 1313 IV shift = POPi;
d0ba1bd2 1314 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 1315 IV i = TOPi;
1316 SETi(i << shift);
d0ba1bd2
JH		 1317 }
1318 else {
972b05a9
JH		 1319 UV u = TOPu;
1320 SETu(u << shift);
d0ba1bd2 1321 }
55497cff 1322 RETURN;
79072805 1323 }
a0d0e21e 1324}
79072805 1325
a0d0e21e
LW		 1326PP(pp_right_shift)
1327{
39644a26 1328 dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
a0d0e21e 1329 {
972b05a9 1330 IV shift = POPi;
d0ba1bd2 1331 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 1332 IV i = TOPi;
1333 SETi(i >> shift);
d0ba1bd2
JH		 1334 }
1335 else {
972b05a9
JH		 1336 UV u = TOPu;
1337 SETu(u >> shift);
d0ba1bd2 1338 }
a0d0e21e 1339 RETURN;
93a17b20 1340 }
79072805
LW		 1341}
1342
a0d0e21e 1343PP(pp_lt)
79072805 1344{
39644a26 1345 dSP; tryAMAGICbinSET(lt,0);
28e5dec8
JH		 1346#ifdef PERL_PRESERVE_IVUV
1347 SvIV_please(TOPs);
1348 if (SvIOK(TOPs)) {
1349 SvIV_please(TOPm1s);
1350 if (SvIOK(TOPm1s)) {
1351 bool auvok = SvUOK(TOPm1s);
1352 bool buvok = SvUOK(TOPs);
a227d84d 1353
28e5dec8
JH		 1354 if (!auvok && !buvok) { /* ## IV < IV ## */
1355 IV aiv = SvIVX(TOPm1s);
1356 IV biv = SvIVX(TOPs);
1357
1358 SP--;
1359 SETs(boolSV(aiv < biv));
1360 RETURN;
1361 }
1362 if (auvok && buvok) { /* ## UV < UV ## */
1363 UV auv = SvUVX(TOPm1s);
1364 UV buv = SvUVX(TOPs);
1365
1366 SP--;
1367 SETs(boolSV(auv < buv));
1368 RETURN;
1369 }
1370 if (auvok) { /* ## UV < IV ## */
1371 UV auv;
1372 IV biv;
1373
1374 biv = SvIVX(TOPs);
1375 SP--;
1376 if (biv < 0) {
1377 /* As (a) is a UV, it's >=0, so it cannot be < */
1378 SETs(&PL_sv_no);
1379 RETURN;
1380 }
1381 auv = SvUVX(TOPs);
1382 if (auv >= (UV) IV_MAX) {
1383 /* As (b) is an IV, it cannot be > IV_MAX */
1384 SETs(&PL_sv_no);
1385 RETURN;
1386 }
1387 SETs(boolSV(auv < (UV)biv));
1388 RETURN;
1389 }
1390 { /* ## IV < UV ## */
1391 IV aiv;
1392 UV buv;
1393
1394 aiv = SvIVX(TOPm1s);
1395 if (aiv < 0) {
1396 /* As (b) is a UV, it's >=0, so it must be < */
1397 SP--;
1398 SETs(&PL_sv_yes);
1399 RETURN;
1400 }
1401 buv = SvUVX(TOPs);
1402 SP--;
1403 if (buv > (UV) IV_MAX) {
1404 /* As (a) is an IV, it cannot be > IV_MAX */
1405 SETs(&PL_sv_yes);
1406 RETURN;
1407 }
1408 SETs(boolSV((UV)aiv < buv));
1409 RETURN;
1410 }
1411 }
1412 }
1413#endif
a0d0e21e
LW		 1414 {
1415 dPOPnv;
54310121 1416 SETs(boolSV(TOPn < value));
a0d0e21e 1417 RETURN;
79072805 1418 }
a0d0e21e 1419}
79072805 1420
a0d0e21e
LW		 1421PP(pp_gt)
1422{
39644a26 1423 dSP; tryAMAGICbinSET(gt,0);
28e5dec8
JH		 1424#ifdef PERL_PRESERVE_IVUV
1425 SvIV_please(TOPs);
1426 if (SvIOK(TOPs)) {
1427 SvIV_please(TOPm1s);
1428 if (SvIOK(TOPm1s)) {
1429 bool auvok = SvUOK(TOPm1s);
1430 bool buvok = SvUOK(TOPs);
a227d84d 1431
28e5dec8
JH		 1432 if (!auvok && !buvok) { /* ## IV > IV ## */
1433 IV aiv = SvIVX(TOPm1s);
1434 IV biv = SvIVX(TOPs);
1435
1436 SP--;
1437 SETs(boolSV(aiv > biv));
1438 RETURN;
1439 }
1440 if (auvok && buvok) { /* ## UV > UV ## */
1441 UV auv = SvUVX(TOPm1s);
1442 UV buv = SvUVX(TOPs);
1443
1444 SP--;
1445 SETs(boolSV(auv > buv));
1446 RETURN;
1447 }
1448 if (auvok) { /* ## UV > IV ## */
1449 UV auv;
1450 IV biv;
1451
1452 biv = SvIVX(TOPs);
1453 SP--;
1454 if (biv < 0) {
1455 /* As (a) is a UV, it's >=0, so it must be > */
1456 SETs(&PL_sv_yes);
1457 RETURN;
1458 }
1459 auv = SvUVX(TOPs);
1460 if (auv > (UV) IV_MAX) {
1461 /* As (b) is an IV, it cannot be > IV_MAX */
1462 SETs(&PL_sv_yes);
1463 RETURN;
1464 }
1465 SETs(boolSV(auv > (UV)biv));
1466 RETURN;
1467 }
1468 { /* ## IV > UV ## */
1469 IV aiv;
1470 UV buv;
1471
1472 aiv = SvIVX(TOPm1s);
1473 if (aiv < 0) {
1474 /* As (b) is a UV, it's >=0, so it cannot be > */
1475 SP--;
1476 SETs(&PL_sv_no);
1477 RETURN;
1478 }
1479 buv = SvUVX(TOPs);
1480 SP--;
1481 if (buv >= (UV) IV_MAX) {
1482 /* As (a) is an IV, it cannot be > IV_MAX */
1483 SETs(&PL_sv_no);
1484 RETURN;
1485 }
1486 SETs(boolSV((UV)aiv > buv));
1487 RETURN;
1488 }
1489 }
1490 }
1491#endif
a0d0e21e
LW		 1492 {
1493 dPOPnv;
54310121 1494 SETs(boolSV(TOPn > value));
a0d0e21e 1495 RETURN;
79072805 1496 }
a0d0e21e
LW		 1497}
1498
1499PP(pp_le)
1500{
39644a26 1501 dSP; tryAMAGICbinSET(le,0);
28e5dec8
JH		 1502#ifdef PERL_PRESERVE_IVUV
1503 SvIV_please(TOPs);
1504 if (SvIOK(TOPs)) {
1505 SvIV_please(TOPm1s);
1506 if (SvIOK(TOPm1s)) {
1507 bool auvok = SvUOK(TOPm1s);
1508 bool buvok = SvUOK(TOPs);
a227d84d 1509
28e5dec8
JH		 1510 if (!auvok && !buvok) { /* ## IV <= IV ## */
1511 IV aiv = SvIVX(TOPm1s);
1512 IV biv = SvIVX(TOPs);
1513
1514 SP--;
1515 SETs(boolSV(aiv <= biv));
1516 RETURN;
1517 }
1518 if (auvok && buvok) { /* ## UV <= UV ## */
1519 UV auv = SvUVX(TOPm1s);
1520 UV buv = SvUVX(TOPs);
1521
1522 SP--;
1523 SETs(boolSV(auv <= buv));
1524 RETURN;
1525 }
1526 if (auvok) { /* ## UV <= IV ## */
1527 UV auv;
1528 IV biv;
1529
1530 biv = SvIVX(TOPs);
1531 SP--;
1532 if (biv < 0) {
1533 /* As (a) is a UV, it's >=0, so a cannot be <= */
1534 SETs(&PL_sv_no);
1535 RETURN;
1536 }
1537 auv = SvUVX(TOPs);
1538 if (auv > (UV) IV_MAX) {
1539 /* As (b) is an IV, it cannot be > IV_MAX */
1540 SETs(&PL_sv_no);
1541 RETURN;
1542 }
1543 SETs(boolSV(auv <= (UV)biv));
1544 RETURN;
1545 }
1546 { /* ## IV <= UV ## */
1547 IV aiv;
1548 UV buv;
1549
1550 aiv = SvIVX(TOPm1s);
1551 if (aiv < 0) {
1552 /* As (b) is a UV, it's >=0, so a must be <= */
1553 SP--;
1554 SETs(&PL_sv_yes);
1555 RETURN;
1556 }
1557 buv = SvUVX(TOPs);
1558 SP--;
1559 if (buv >= (UV) IV_MAX) {
1560 /* As (a) is an IV, it cannot be > IV_MAX */
1561 SETs(&PL_sv_yes);
1562 RETURN;
1563 }
1564 SETs(boolSV((UV)aiv <= buv));
1565 RETURN;
1566 }
1567 }
1568 }
1569#endif
a0d0e21e
LW		 1570 {
1571 dPOPnv;
54310121 1572 SETs(boolSV(TOPn <= value));
a0d0e21e 1573 RETURN;
79072805 1574 }
a0d0e21e
LW		 1575}
1576
1577PP(pp_ge)
1578{
39644a26 1579 dSP; tryAMAGICbinSET(ge,0);
28e5dec8
JH		 1580#ifdef PERL_PRESERVE_IVUV
1581 SvIV_please(TOPs);
1582 if (SvIOK(TOPs)) {
1583 SvIV_please(TOPm1s);
1584 if (SvIOK(TOPm1s)) {
1585 bool auvok = SvUOK(TOPm1s);
1586 bool buvok = SvUOK(TOPs);
a227d84d 1587
28e5dec8
JH		 1588 if (!auvok && !buvok) { /* ## IV >= IV ## */
1589 IV aiv = SvIVX(TOPm1s);
1590 IV biv = SvIVX(TOPs);
1591
1592 SP--;
1593 SETs(boolSV(aiv >= biv));
1594 RETURN;
1595 }
1596 if (auvok && buvok) { /* ## UV >= UV ## */
1597 UV auv = SvUVX(TOPm1s);
1598 UV buv = SvUVX(TOPs);
1599
1600 SP--;
1601 SETs(boolSV(auv >= buv));
1602 RETURN;
1603 }
1604 if (auvok) { /* ## UV >= IV ## */
1605 UV auv;
1606 IV biv;
1607
1608 biv = SvIVX(TOPs);
1609 SP--;
1610 if (biv < 0) {
1611 /* As (a) is a UV, it's >=0, so it must be >= */
1612 SETs(&PL_sv_yes);
1613 RETURN;
1614 }
1615 auv = SvUVX(TOPs);
1616 if (auv >= (UV) IV_MAX) {
1617 /* As (b) is an IV, it cannot be > IV_MAX */
1618 SETs(&PL_sv_yes);
1619 RETURN;
1620 }
1621 SETs(boolSV(auv >= (UV)biv));
1622 RETURN;
1623 }
1624 { /* ## IV >= UV ## */
1625 IV aiv;
1626 UV buv;
1627
1628 aiv = SvIVX(TOPm1s);
1629 if (aiv < 0) {
1630 /* As (b) is a UV, it's >=0, so a cannot be >= */
1631 SP--;
1632 SETs(&PL_sv_no);
1633 RETURN;
1634 }
1635 buv = SvUVX(TOPs);
1636 SP--;
1637 if (buv > (UV) IV_MAX) {
1638 /* As (a) is an IV, it cannot be > IV_MAX */
1639 SETs(&PL_sv_no);
1640 RETURN;
1641 }
1642 SETs(boolSV((UV)aiv >= buv));
1643 RETURN;
1644 }
1645 }
1646 }
1647#endif
a0d0e21e
LW		 1648 {
1649 dPOPnv;
54310121 1650 SETs(boolSV(TOPn >= value));
a0d0e21e 1651 RETURN;
79072805 1652 }
a0d0e21e 1653}
79072805 1654
a0d0e21e
LW		 1655PP(pp_ne)
1656{
16303949 1657 dSP; tryAMAGICbinSET(ne,0);
3bb2c415
JH		 1658#ifndef NV_PRESERVES_UV
1659 if (SvROK(TOPs) && SvROK(TOPm1s)) {
c3e03cdf 1660 SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s)));
3bb2c415
JH		 1661 RETURN;
1662 }
1663#endif
28e5dec8
JH		 1664#ifdef PERL_PRESERVE_IVUV
1665 SvIV_please(TOPs);
1666 if (SvIOK(TOPs)) {
1667 SvIV_please(TOPm1s);
1668 if (SvIOK(TOPm1s)) {
1669 bool auvok = SvUOK(TOPm1s);
1670 bool buvok = SvUOK(TOPs);
a227d84d 1671
28e5dec8
JH		 1672 if (!auvok && !buvok) { /* ## IV <=> IV ## */
1673 IV aiv = SvIVX(TOPm1s);
1674 IV biv = SvIVX(TOPs);
1675
1676 SP--;
1677 SETs(boolSV(aiv != biv));
1678 RETURN;
1679 }
1680 if (auvok && buvok) { /* ## UV != UV ## */
1681 UV auv = SvUVX(TOPm1s);
1682 UV buv = SvUVX(TOPs);
1683
1684 SP--;
1685 SETs(boolSV(auv != buv));
1686 RETURN;
1687 }
1688 { /* ## Mixed IV,UV ## */
1689 IV iv;
1690 UV uv;
1691
1692 /* != is commutative so swap if needed (save code) */
1693 if (auvok) {
1694 /* swap. top of stack (b) is the iv */
1695 iv = SvIVX(TOPs);
1696 SP--;
1697 if (iv < 0) {
1698 /* As (a) is a UV, it's >0, so it cannot be == */
1699 SETs(&PL_sv_yes);
1700 RETURN;
1701 }
1702 uv = SvUVX(TOPs);
1703 } else {
1704 iv = SvIVX(TOPm1s);
1705 SP--;
1706 if (iv < 0) {
1707 /* As (b) is a UV, it's >0, so it cannot be == */
1708 SETs(&PL_sv_yes);
1709 RETURN;
1710 }
1711 uv = SvUVX(*(SP+1)); /* Do I want TOPp1s() ? */
1712 }
1713 /* we know iv is >= 0 */
1714 if (uv > (UV) IV_MAX) {
1715 SETs(&PL_sv_yes);
1716 RETURN;
1717 }
1718 SETs(boolSV((UV)iv != uv));
1719 RETURN;
1720 }
1721 }
1722 }
1723#endif
a0d0e21e
LW		 1724 {
1725 dPOPnv;
54310121 1726 SETs(boolSV(TOPn != value));
a0d0e21e
LW		 1727 RETURN;
1728 }
79072805
LW		 1729}
1730
a0d0e21e 1731PP(pp_ncmp)
79072805 1732{
39644a26 1733 dSP; dTARGET; tryAMAGICbin(ncmp,0);
d8c7644e
JH		 1734#ifndef NV_PRESERVES_UV
1735 if (SvROK(TOPs) && SvROK(TOPm1s)) {
34d3ce40 1736 SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
d8c7644e
JH		 1737 RETURN;
1738 }
1739#endif
28e5dec8
JH		 1740#ifdef PERL_PRESERVE_IVUV
1741 /* Fortunately it seems NaN isn't IOK */
1742 SvIV_please(TOPs);
1743 if (SvIOK(TOPs)) {
1744 SvIV_please(TOPm1s);
1745 if (SvIOK(TOPm1s)) {
1746 bool leftuvok = SvUOK(TOPm1s);
1747 bool rightuvok = SvUOK(TOPs);
1748 I32 value;
1749 if (!leftuvok && !rightuvok) { /* ## IV <=> IV ## */
1750 IV leftiv = SvIVX(TOPm1s);
1751 IV rightiv = SvIVX(TOPs);
1752
1753 if (leftiv > rightiv)
1754 value = 1;
1755 else if (leftiv < rightiv)
1756 value = -1;
1757 else
1758 value = 0;
1759 } else if (leftuvok && rightuvok) { /* ## UV <=> UV ## */
1760 UV leftuv = SvUVX(TOPm1s);
1761 UV rightuv = SvUVX(TOPs);
1762
1763 if (leftuv > rightuv)
1764 value = 1;
1765 else if (leftuv < rightuv)
1766 value = -1;
1767 else
1768 value = 0;
1769 } else if (leftuvok) { /* ## UV <=> IV ## */
1770 UV leftuv;
1771 IV rightiv;
1772
1773 rightiv = SvIVX(TOPs);
1774 if (rightiv < 0) {
1775 /* As (a) is a UV, it's >=0, so it cannot be < */
1776 value = 1;
1777 } else {
1778 leftuv = SvUVX(TOPm1s);
1779 if (leftuv > (UV) IV_MAX) {
1780 /* As (b) is an IV, it cannot be > IV_MAX */
1781 value = 1;
1782 } else if (leftuv > (UV)rightiv) {
1783 value = 1;
1784 } else if (leftuv < (UV)rightiv) {
1785 value = -1;
1786 } else {
1787 value = 0;
1788 }
1789 }
1790 } else { /* ## IV <=> UV ## */
1791 IV leftiv;
1792 UV rightuv;
1793
1794 leftiv = SvIVX(TOPm1s);
1795 if (leftiv < 0) {
1796 /* As (b) is a UV, it's >=0, so it must be < */
1797 value = -1;
1798 } else {
1799 rightuv = SvUVX(TOPs);
1800 if (rightuv > (UV) IV_MAX) {
1801 /* As (a) is an IV, it cannot be > IV_MAX */
1802 value = -1;
1803 } else if (leftiv > (UV)rightuv) {
1804 value = 1;
1805 } else if (leftiv < (UV)rightuv) {
1806 value = -1;
1807 } else {
1808 value = 0;
1809 }
1810 }
1811 }
1812 SP--;
1813 SETi(value);
1814 RETURN;
1815 }
1816 }
1817#endif
a0d0e21e
LW		 1818 {
1819 dPOPTOPnnrl;
1820 I32 value;
79072805 1821
a3540c92 1822#ifdef Perl_isnan
1ad04cfd
JH		 1823 if (Perl_isnan(left) || Perl_isnan(right)) {
1824 SETs(&PL_sv_undef);
1825 RETURN;
1826 }
1827 value = (left > right) - (left < right);
1828#else
ff0cee69 1829 if (left == right)
a0d0e21e 1830 value = 0;
a0d0e21e
LW		 1831 else if (left < right)
1832 value = -1;
44a8e56a 1833 else if (left > right)
1834 value = 1;
1835 else {
3280af22 1836 SETs(&PL_sv_undef);
44a8e56a 1837 RETURN;
1838 }
1ad04cfd 1839#endif
a0d0e21e
LW		 1840 SETi(value);
1841 RETURN;
79072805 1842 }
a0d0e21e 1843}
79072805 1844
a0d0e21e
LW		 1845PP(pp_slt)
1846{
39644a26 1847 dSP; tryAMAGICbinSET(slt,0);
a0d0e21e
LW		 1848 {
1849 dPOPTOPssrl;
2de3dbcc 1850 int cmp = (IN_LOCALE_RUNTIME
bbce6d69 1851 ? sv_cmp_locale(left, right)
1852 : sv_cmp(left, right));
54310121 1853 SETs(boolSV(cmp < 0));
a0d0e21e
LW		 1854 RETURN;
1855 }
79072805
LW		 1856}
1857
a0d0e21e 1858PP(pp_sgt)
79072805 1859{
39644a26 1860 dSP; tryAMAGICbinSET(sgt,0);
a0d0e21e
LW		 1861 {
1862 dPOPTOPssrl;
2de3dbcc 1863 int cmp = (IN_LOCALE_RUNTIME
bbce6d69 1864 ? sv_cmp_locale(left, right)
1865 : sv_cmp(left, right));
54310121 1866 SETs(boolSV(cmp > 0));
a0d0e21e
LW		 1867 RETURN;
1868 }
1869}
79072805 1870
a0d0e21e
LW		 1871PP(pp_sle)
1872{
39644a26 1873 dSP; tryAMAGICbinSET(sle,0);
a0d0e21e
LW		 1874 {
1875 dPOPTOPssrl;
2de3dbcc 1876 int cmp = (IN_LOCALE_RUNTIME
bbce6d69 1877 ? sv_cmp_locale(left, right)
1878 : sv_cmp(left, right));
54310121 1879 SETs(boolSV(cmp <= 0));
a0d0e21e 1880 RETURN;
79072805 1881 }
79072805
LW		 1882}
1883
a0d0e21e
LW		 1884PP(pp_sge)
1885{
39644a26 1886 dSP; tryAMAGICbinSET(sge,0);
a0d0e21e
LW		 1887 {
1888 dPOPTOPssrl;
2de3dbcc 1889 int cmp = (IN_LOCALE_RUNTIME
bbce6d69 1890 ? sv_cmp_locale(left, right)
1891 : sv_cmp(left, right));
54310121 1892 SETs(boolSV(cmp >= 0));
a0d0e21e
LW		 1893 RETURN;
1894 }
1895}
79072805 1896
36477c24 1897PP(pp_seq)
1898{
39644a26 1899 dSP; tryAMAGICbinSET(seq,0);
36477c24 1900 {
1901 dPOPTOPssrl;
54310121 1902 SETs(boolSV(sv_eq(left, right)));
a0d0e21e
LW		 1903 RETURN;
1904 }
1905}
79072805 1906
a0d0e21e 1907PP(pp_sne)
79072805 1908{
39644a26 1909 dSP; tryAMAGICbinSET(sne,0);
a0d0e21e
LW		 1910 {
1911 dPOPTOPssrl;
54310121 1912 SETs(boolSV(!sv_eq(left, right)));
a0d0e21e 1913 RETURN;
463ee0b2 1914 }
79072805
LW		 1915}
1916
a0d0e21e 1917PP(pp_scmp)
79072805 1918{
39644a26 1919 dSP; dTARGET; tryAMAGICbin(scmp,0);
a0d0e21e
LW		 1920 {
1921 dPOPTOPssrl;
2de3dbcc 1922 int cmp = (IN_LOCALE_RUNTIME
bbce6d69 1923 ? sv_cmp_locale(left, right)
1924 : sv_cmp(left, right));
1925 SETi( cmp );
a0d0e21e
LW		 1926 RETURN;
1927 }
1928}
79072805 1929
55497cff 1930PP(pp_bit_and)
1931{
39644a26 1932 dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
a0d0e21e
LW		 1933 {
1934 dPOPTOPssrl;
4633a7c4 1935 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1936 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 1937 IV i = SvIV(left) & SvIV(right);
1938 SETi(i);
d0ba1bd2
JH		 1939 }
1940 else {
972b05a9
JH		 1941 UV u = SvUV(left) & SvUV(right);
1942 SETu(u);
d0ba1bd2 1943 }
a0d0e21e
LW		 1944 }
1945 else {
533c011a 1946 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW		 1947 SETTARG;
1948 }
1949 RETURN;
1950 }
1951}
79072805 1952
a0d0e21e
LW		 1953PP(pp_bit_xor)
1954{
39644a26 1955 dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
a0d0e21e
LW		 1956 {
1957 dPOPTOPssrl;
4633a7c4 1958 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1959 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 1960 IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
1961 SETi(i);
d0ba1bd2
JH		 1962 }
1963 else {
972b05a9
JH		 1964 UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
1965 SETu(u);
d0ba1bd2 1966 }
a0d0e21e
LW		 1967 }
1968 else {
533c011a 1969 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW		 1970 SETTARG;
1971 }
1972 RETURN;
1973 }
1974}
79072805 1975
a0d0e21e
LW		 1976PP(pp_bit_or)
1977{
39644a26 1978 dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
a0d0e21e
LW		 1979 {
1980 dPOPTOPssrl;
4633a7c4 1981 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1982 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 1983 IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
1984 SETi(i);
d0ba1bd2
JH		 1985 }
1986 else {
972b05a9
JH		 1987 UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
1988 SETu(u);
d0ba1bd2 1989 }
a0d0e21e
LW		 1990 }
1991 else {
533c011a 1992 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW		 1993 SETTARG;
1994 }
1995 RETURN;
79072805 1996 }
a0d0e21e 1997}
79072805 1998
a0d0e21e
LW		 1999PP(pp_negate)
2000{
39644a26 2001 dSP; dTARGET; tryAMAGICun(neg);
a0d0e21e
LW		 2002 {
2003 dTOPss;
28e5dec8 2004 int flags = SvFLAGS(sv);
4633a7c4
LW		 2005 if (SvGMAGICAL(sv))
2006 mg_get(sv);
28e5dec8
JH		 2007 if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
2008 /* It's publicly an integer, or privately an integer-not-float */
2009 oops_its_an_int:
9b0e499b
GS		 2010 if (SvIsUV(sv)) {
2011 if (SvIVX(sv) == IV_MIN) {
28e5dec8 2012 /* 2s complement assumption. */
9b0e499b
GS		 2013 SETi(SvIVX(sv)); /* special case: -((UV)IV_MAX+1) == IV_MIN */
2014 RETURN;
2015 }
2016 else if (SvUVX(sv) <= IV_MAX) {
beccb14c 2017 SETi(-SvIVX(sv));
9b0e499b
GS		 2018 RETURN;
2019 }
2020 }
2021 else if (SvIVX(sv) != IV_MIN) {
2022 SETi(-SvIVX(sv));
2023 RETURN;
2024 }
28e5dec8
JH		 2025#ifdef PERL_PRESERVE_IVUV
2026 else {
2027 SETu((UV)IV_MIN);
2028 RETURN;
2029 }
2030#endif
9b0e499b
GS		 2031 }
2032 if (SvNIOKp(sv))
a0d0e21e 2033 SETn(-SvNV(sv));
4633a7c4 2034 else if (SvPOKp(sv)) {
a0d0e21e
LW		 2035 STRLEN len;
2036 char *s = SvPV(sv, len);
bbce6d69 2037 if (isIDFIRST(*s)) {
a0d0e21e
LW		 2038 sv_setpvn(TARG, "-", 1);
2039 sv_catsv(TARG, sv);
79072805 2040 }
a0d0e21e
LW		 2041 else if (*s == '+' || *s == '-') {
2042 sv_setsv(TARG, sv);
2043 *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
79072805 2044 }
fd400ab9 2045 else if (DO_UTF8(sv) && UTF8_IS_START(*s) && isIDFIRST_utf8((U8*)s)) {
834a4ddd
LW		 2046 sv_setpvn(TARG, "-", 1);
2047 sv_catsv(TARG, sv);
2048 }
28e5dec8
JH		 2049 else {
2050 SvIV_please(sv);
2051 if (SvIOK(sv))
2052 goto oops_its_an_int;
2053 sv_setnv(TARG, -SvNV(sv));
2054 }
a0d0e21e 2055 SETTARG;
79072805 2056 }
4633a7c4
LW		 2057 else
2058 SETn(-SvNV(sv));
79072805 2059 }
a0d0e21e 2060 RETURN;
79072805
LW		 2061}
2062
a0d0e21e 2063PP(pp_not)
79072805 2064{
39644a26 2065 dSP; tryAMAGICunSET(not);
3280af22 2066 *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
a0d0e21e 2067 return NORMAL;
79072805
LW		 2068}
2069
a0d0e21e 2070PP(pp_complement)
79072805 2071{
39644a26 2072 dSP; dTARGET; tryAMAGICun(compl);
a0d0e21e
LW		 2073 {
2074 dTOPss;
4633a7c4 2075 if (SvNIOKp(sv)) {
d0ba1bd2 2076 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH		 2077 IV i = ~SvIV(sv);
2078 SETi(i);
d0ba1bd2
JH		 2079 }
2080 else {
972b05a9
JH		 2081 UV u = ~SvUV(sv);
2082 SETu(u);
d0ba1bd2 2083 }
a0d0e21e
LW		 2084 }
2085 else {
51723571 2086 register U8 *tmps;
55497cff 2087 register I32 anum;
a0d0e21e
LW		 2088 STRLEN len;
2089
2090 SvSetSV(TARG, sv);
51723571 2091 tmps = (U8*)SvPV_force(TARG, len);
a0d0e21e 2092 anum = len;
1d68d6cd 2093 if (SvUTF8(TARG)) {
a1ca4561 2094 /* Calculate exact length, let's not estimate. */
1d68d6cd
SC		 2095 STRLEN targlen = 0;
2096 U8 *result;
51723571 2097 U8 *send;
ba210ebe 2098 STRLEN l;
a1ca4561
YST		 2099 UV nchar = 0;
2100 UV nwide = 0;
1d68d6cd
SC		 2101
2102 send = tmps + len;
2103 while (tmps < send) {
9041c2e3 2104 UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
1d68d6cd 2105 tmps += UTF8SKIP(tmps);
5bbb0b5a 2106 targlen += UNISKIP(~c);
a1ca4561
YST		 2107 nchar++;
2108 if (c > 0xff)
2109 nwide++;
1d68d6cd
SC		 2110 }
2111
2112 /* Now rewind strings and write them. */
2113 tmps -= len;
a1ca4561
YST		 2114
2115 if (nwide) {
2116 Newz(0, result, targlen + 1, U8);
2117 while (tmps < send) {
9041c2e3 2118 UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
a1ca4561 2119 tmps += UTF8SKIP(tmps);
9041c2e3 2120 result = uvchr_to_utf8(result, ~c);
a1ca4561
YST		 2121 }
2122 *result = '\0';
2123 result -= targlen;
2124 sv_setpvn(TARG, (char*)result, targlen);
2125 SvUTF8_on(TARG);
2126 }
2127 else {
2128 Newz(0, result, nchar + 1, U8);
2129 while (tmps < send) {
9041c2e3 2130 U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY);
a1ca4561
YST		 2131 tmps += UTF8SKIP(tmps);
2132 *result++ = ~c;
2133 }
2134 *result = '\0';
2135 result -= nchar;
2136 sv_setpvn(TARG, (char*)result, nchar);
1d68d6cd 2137 }
1d68d6cd
SC		 2138 Safefree(result);
2139 SETs(TARG);
2140 RETURN;
2141 }
a0d0e21e 2142#ifdef LIBERAL
51723571
JH		 2143 {
2144 register long *tmpl;
2145 for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
2146 *tmps = ~*tmps;
2147 tmpl = (long*)tmps;
2148 for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
2149 *tmpl = ~*tmpl;
2150 tmps = (U8*)tmpl;
2151 }
a0d0e21e
LW		 2152#endif
2153 for ( ; anum > 0; anum--, tmps++)
2154 *tmps = ~*tmps;
2155
2156 SETs(TARG);
2157 }
2158 RETURN;
2159 }
79072805
LW		 2160}
2161
a0d0e21e
LW		 2162/* integer versions of some of the above */
2163
a0d0e21e 2164PP(pp_i_multiply)
79072805 2165{
39644a26 2166 dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
a0d0e21e
LW		 2167 {
2168 dPOPTOPiirl;
2169 SETi( left * right );
2170 RETURN;
2171 }
79072805
LW		 2172}
2173
a0d0e21e 2174PP(pp_i_divide)
79072805 2175{
39644a26 2176 dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
a0d0e21e
LW		 2177 {
2178 dPOPiv;
2179 if (value == 0)
cea2e8a9 2180 DIE(aTHX_ "Illegal division by zero");
a0d0e21e
LW		 2181 value = POPi / value;
2182 PUSHi( value );
2183 RETURN;
2184 }
79072805
LW		 2185}
2186
a0d0e21e 2187PP(pp_i_modulo)
79072805 2188{
39644a26 2189 dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
79072805 2190 {
a0d0e21e 2191 dPOPTOPiirl;
aa306039 2192 if (!right)
cea2e8a9 2193 DIE(aTHX_ "Illegal modulus zero");
a0d0e21e
LW		 2194 SETi( left % right );
2195 RETURN;
79072805 2196 }
79072805
LW		 2197}
2198
a0d0e21e 2199PP(pp_i_add)
79072805 2200{
39644a26 2201 dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
a0d0e21e 2202 {
5e66d4f1 2203 dPOPTOPiirl_ul;
a0d0e21e
LW		 2204 SETi( left + right );
2205 RETURN;
79072805 2206 }
79072805
LW		 2207}
2208
a0d0e21e 2209PP(pp_i_subtract)
79072805 2210{
39644a26 2211 dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
a0d0e21e 2212 {
5e66d4f1 2213 dPOPTOPiirl_ul;
a0d0e21e
LW		 2214 SETi( left - right );
2215 RETURN;
79072805 2216 }
79072805
LW		 2217}
2218
a0d0e21e 2219PP(pp_i_lt)
79072805 2220{
39644a26 2221 dSP; tryAMAGICbinSET(lt,0);
a0d0e21e
LW		 2222 {
2223 dPOPTOPiirl;
54310121 2224 SETs(boolSV(left < right));
a0d0e21e
LW		 2225 RETURN;
2226 }
79072805
LW		 2227}
2228
a0d0e21e 2229PP(pp_i_gt)
79072805 2230{
39644a26 2231 dSP; tryAMAGICbinSET(gt,0);
a0d0e21e
LW		 2232 {
2233 dPOPTOPiirl;
54310121 2234 SETs(boolSV(left > right));
a0d0e21e
LW		 2235 RETURN;
2236 }
79072805
LW		 2237}
2238
a0d0e21e 2239PP(pp_i_le)
79072805 2240{
39644a26 2241 dSP; tryAMAGICbinSET(le,0);
a0d0e21e
LW		 2242 {
2243 dPOPTOPiirl;
54310121 2244 SETs(boolSV(left <= right));
a0d0e21e 2245 RETURN;
85e6fe83 2246 }
79072805
LW		 2247}
2248
a0d0e21e 2249PP(pp_i_ge)
79072805 2250{
39644a26 2251 dSP; tryAMAGICbinSET(ge,0);
a0d0e21e
LW		 2252 {
2253 dPOPTOPiirl;
54310121 2254 SETs(boolSV(left >= right));
a0d0e21e
LW		 2255 RETURN;
2256 }
79072805
LW		 2257}
2258
a0d0e21e 2259PP(pp_i_eq)
79072805 2260{
39644a26 2261 dSP; tryAMAGICbinSET(eq,0);
a0d0e21e
LW		 2262 {
2263 dPOPTOPiirl;
54310121 2264 SETs(boolSV(left == right));
a0d0e21e
LW		 2265 RETURN;
2266 }
79072805
LW		 2267}
2268
a0d0e21e 2269PP(pp_i_ne)
79072805 2270{
39644a26 2271 dSP; tryAMAGICbinSET(ne,0);
a0d0e21e
LW		 2272 {
2273 dPOPTOPiirl;
54310121 2274 SETs(boolSV(left != right));
a0d0e21e
LW		 2275 RETURN;
2276 }
79072805
LW		 2277}
2278
a0d0e21e 2279PP(pp_i_ncmp)
79072805 2280{
39644a26 2281 dSP; dTARGET; tryAMAGICbin(ncmp,0);
a0d0e21e
LW		 2282 {
2283 dPOPTOPiirl;
2284 I32 value;
79072805 2285
a0d0e21e 2286 if (left > right)
79072805 2287 value = 1;
a0d0e21e 2288 else if (left < right)
79072805 2289 value = -1;
a0d0e21e 2290 else
79072805 2291 value = 0;
a0d0e21e
LW		 2292 SETi(value);
2293 RETURN;
79072805 2294 }
85e6fe83
LW		 2295}
2296
2297PP(pp_i_negate)
2298{
39644a26 2299 dSP; dTARGET; tryAMAGICun(neg);
85e6fe83
LW		 2300 SETi(-TOPi);
2301 RETURN;
2302}
2303
79072805
LW		 2304/* High falutin' math. */
2305
2306PP(pp_atan2)
2307{
39644a26 2308 dSP; dTARGET; tryAMAGICbin(atan2,0);
a0d0e21e
LW		 2309 {
2310 dPOPTOPnnrl;
65202027 2311 SETn(Perl_atan2(left, right));
a0d0e21e
LW		 2312 RETURN;
2313 }
79072805
LW		 2314}
2315
2316PP(pp_sin)
2317{
39644a26 2318 dSP; dTARGET; tryAMAGICun(sin);
a0d0e21e 2319 {
65202027 2320 NV value;
a0d0e21e 2321 value = POPn;
65202027 2322 value = Perl_sin(value);
a0d0e21e
LW		 2323 XPUSHn(value);
2324 RETURN;
2325 }
79072805
LW		 2326}
2327
2328PP(pp_cos)
2329{
39644a26 2330 dSP; dTARGET; tryAMAGICun(cos);
a0d0e21e 2331 {
65202027 2332 NV value;
a0d0e21e 2333 value = POPn;
65202027 2334 value = Perl_cos(value);
a0d0e21e
LW		 2335 XPUSHn(value);
2336 RETURN;
2337 }
79072805
LW		 2338}
2339
56cb0a1c
AD		 2340/* Support Configure command-line overrides for rand() functions.
2341 After 5.005, perhaps we should replace this by Configure support
2342 for drand48(), random(), or rand(). For 5.005, though, maintain
2343 compatibility by calling rand() but allow the user to override it.
2344 See INSTALL for details. --Andy Dougherty 15 July 1998
2345*/
85ab1d1d
JH		 2346/* Now it's after 5.005, and Configure supports drand48() and random(),
2347 in addition to rand(). So the overrides should not be needed any more.
2348 --Jarkko Hietaniemi 27 September 1998
2349 */
2350
2351#ifndef HAS_DRAND48_PROTO
20ce7b12 2352extern double drand48 (void);
56cb0a1c
AD		 2353#endif
2354
79072805
LW		 2355PP(pp_rand)
2356{
39644a26 2357 dSP; dTARGET;
65202027 2358 NV value;
79072805
LW		 2359 if (MAXARG < 1)
2360 value = 1.0;
2361 else
2362 value = POPn;
2363 if (value == 0.0)
2364 value = 1.0;
80252599 2365 if (!PL_srand_called) {
85ab1d1d 2366 (void)seedDrand01((Rand_seed_t)seed());
80252599 2367 PL_srand_called = TRUE;
93dc8474 2368 }
85ab1d1d 2369 value *= Drand01();
79072805
LW		 2370 XPUSHn(value);
2371 RETURN;
2372}
2373
2374PP(pp_srand)
2375{
39644a26 2376 dSP;
93dc8474
CS		 2377 UV anum;
2378 if (MAXARG < 1)
2379 anum = seed();
79072805 2380 else
93dc8474 2381 anum = POPu;
85ab1d1d 2382 (void)seedDrand01((Rand_seed_t)anum);
80252599 2383 PL_srand_called = TRUE;
79072805
LW		 2384 EXTEND(SP, 1);
2385 RETPUSHYES;
2386}
2387
76e3520e 2388STATIC U32
cea2e8a9 2389S_seed(pTHX)
93dc8474 2390{
54310121 2391 /*
2392 * This is really just a quick hack which grabs various garbage
2393 * values. It really should be a real hash algorithm which
2394 * spreads the effect of every input bit onto every output bit,
85ab1d1d 2395 * if someone who knows about such things would bother to write it.
54310121 2396 * Might be a good idea to add that function to CORE as well.
85ab1d1d 2397 * No numbers below come from careful analysis or anything here,
54310121 2398 * except they are primes and SEED_C1 > 1E6 to get a full-width
2399 * value from (tv_sec * SEED_C1 + tv_usec). The multipliers should
2400 * probably be bigger too.
2401 */
2402#if RANDBITS > 16
2403# define SEED_C1 1000003
2404#define SEED_C4 73819
2405#else
2406# define SEED_C1 25747
2407#define SEED_C4 20639
2408#endif
2409#define SEED_C2 3
2410#define SEED_C3 269
2411#define SEED_C5 26107
2412
73c60299
RS		 2413#ifndef PERL_NO_DEV_RANDOM
2414 int fd;
2415#endif
93dc8474 2416 U32 u;
f12c7020 2417#ifdef VMS
2418# include <starlet.h>
43c92808
HF		 2419 /* when[] = (low 32 bits, high 32 bits) of time since epoch
2420 * in 100-ns units, typically incremented ever 10 ms. */
93dc8474 2421 unsigned int when[2];
73c60299
RS		 2422#else
2423# ifdef HAS_GETTIMEOFDAY
2424 struct timeval when;
2425# else
2426 Time_t when;
2427# endif
2428#endif
2429
2430/* This test is an escape hatch, this symbol isn't set by Configure. */
2431#ifndef PERL_NO_DEV_RANDOM
2432#ifndef PERL_RANDOM_DEVICE
2433 /* /dev/random isn't used by default because reads from it will block
2434 * if there isn't enough entropy available. You can compile with
2435 * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
2436 * is enough real entropy to fill the seed. */
2437# define PERL_RANDOM_DEVICE "/dev/urandom"
2438#endif
2439 fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
2440 if (fd != -1) {
2441 if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
2442 u = 0;
2443 PerlLIO_close(fd);
2444 if (u)
2445 return u;
2446 }
2447#endif
2448
2449#ifdef VMS
93dc8474 2450 _ckvmssts(sys$gettim(when));
54310121 2451 u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
f12c7020 2452#else
5f05dabc 2453# ifdef HAS_GETTIMEOFDAY
93dc8474 2454 gettimeofday(&when,(struct timezone *) 0);
54310121 2455 u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
f12c7020 2456# else
93dc8474 2457 (void)time(&when);
54310121 2458 u = (U32)SEED_C1 * when;
f12c7020 2459# endif
2460#endif
7766f137 2461 u += SEED_C3 * (U32)PerlProc_getpid();
56431972 2462 u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
54310121 2463#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */
56431972 2464 u += SEED_C5 * (U32)PTR2UV(&when);
f12c7020 2465#endif
93dc8474 2466 return u;
79072805
LW		 2467}
2468
2469PP(pp_exp)
2470{
39644a26 2471 dSP; dTARGET; tryAMAGICun(exp);
a0d0e21e 2472 {
65202027 2473 NV value;
a0d0e21e 2474 value = POPn;
65202027 2475 value = Perl_exp(value);
a0d0e21e
LW		 2476 XPUSHn(value);
2477 RETURN;
2478 }
79072805
LW		 2479}
2480
2481PP(pp_log)
2482{
39644a26 2483 dSP; dTARGET; tryAMAGICun(log);
a0d0e21e 2484 {
65202027 2485 NV value;
a0d0e21e 2486 value = POPn;
bbce6d69 2487 if (value <= 0.0) {
f93f4e46 2488 SET_NUMERIC_STANDARD();
cea2e8a9 2489 DIE(aTHX_ "Can't take log of %g", value);
bbce6d69 2490 }
65202027 2491 value = Perl_log(value);
a0d0e21e
LW		 2492 XPUSHn(value);
2493 RETURN;
2494 }
79072805
LW		 2495}
2496
2497PP(pp_sqrt)
2498{
39644a26 2499 dSP; dTARGET; tryAMAGICun(sqrt);
a0d0e21e 2500 {
65202027 2501 NV value;
a0d0e21e 2502 value = POPn;
bbce6d69 2503 if (value < 0.0) {
f93f4e46 2504 SET_NUMERIC_STANDARD();
cea2e8a9 2505 DIE(aTHX_ "Can't take sqrt of %g", value);
bbce6d69 2506 }
65202027 2507 value = Perl_sqrt(value);
a0d0e21e
LW		 2508 XPUSHn(value);
2509 RETURN;
2510 }
79072805
LW		 2511}
2512
2513PP(pp_int)
2514{
39644a26 2515 dSP; dTARGET; tryAMAGICun(int);
774d564b 2516 {
28e5dec8
JH		 2517 NV value;
2518 IV iv = TOPi; /* attempt to convert to IV if possible. */
2519 /* XXX it's arguable that compiler casting to IV might be subtly
2520 different from modf (for numbers inside (IV_MIN,UV_MAX)) in which
2521 else preferring IV has introduced a subtle behaviour change bug. OTOH
2522 relying on floating point to be accurate is a bug. */
2523
2524 if (SvIOK(TOPs)) {
2525 if (SvIsUV(TOPs)) {
2526 UV uv = TOPu;
2527 SETu(uv);
2528 } else
2529 SETi(iv);
2530 } else {
2531 value = TOPn;
1048ea30 2532 if (value >= 0.0) {
28e5dec8
JH		 2533 if (value < (NV)UV_MAX + 0.5) {
2534 SETu(U_V(value));
2535 } else {
1048ea30 2536#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
e67aeab1
JH		 2537# ifdef HAS_MODFL_POW32_BUG
2538/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
2539 {
2540 NV offset = Perl_modf(value, &value);
2541 (void)Perl_modf(offset, &offset);
2542 value += offset;
2543 }
2544# else
28e5dec8 2545 (void)Perl_modf(value, &value);
e67aeab1 2546# endif
1048ea30 2547#else
28e5dec8
JH		 2548 double tmp = (double)value;
2549 (void)Perl_modf(tmp, &tmp);
2550 value = (NV)tmp;
1048ea30 2551#endif
2d9af89d 2552 SETn(value);
28e5dec8 2553 }
1048ea30 2554 }
28e5dec8
JH		 2555 else {
2556 if (value > (NV)IV_MIN - 0.5) {
2557 SETi(I_V(value));
2558 } else {
1048ea30 2559#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
e67aeab1
JH		 2560# ifdef HAS_MODFL_POW32_BUG
2561/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
2562 {
2563 NV offset = Perl_modf(-value, &value);
2564 (void)Perl_modf(offset, &offset);
2565 value += offset;
2566 }
2567# else
28e5dec8 2568 (void)Perl_modf(-value, &value);
e67aeab1 2569# endif
28e5dec8 2570 value = -value;
1048ea30 2571#else
28e5dec8
JH		 2572 double tmp = (double)value;
2573 (void)Perl_modf(-tmp, &tmp);
2574 value = -(NV)tmp;
1048ea30 2575#endif
28e5dec8
JH		 2576 SETn(value);
2577 }
2578 }
774d564b 2579 }
79072805 2580 }
79072805
LW		 2581 RETURN;
2582}
2583
463ee0b2
LW		 2584PP(pp_abs)
2585{
39644a26 2586 dSP; dTARGET; tryAMAGICun(abs);
a0d0e21e 2587 {
28e5dec8
JH		 2588 /* This will cache the NV value if string isn't actually integer */
2589 IV iv = TOPi;
a227d84d 2590
28e5dec8
JH		 2591 if (SvIOK(TOPs)) {
2592 /* IVX is precise */
2593 if (SvIsUV(TOPs)) {
2594 SETu(TOPu); /* force it to be numeric only */
2595 } else {
2596 if (iv >= 0) {
2597 SETi(iv);
2598 } else {
2599 if (iv != IV_MIN) {
2600 SETi(-iv);
2601 } else {
2602 /* 2s complement assumption. Also, not really needed as
2603 IV_MIN and -IV_MIN should both be %100...00 and NV-able */
2604 SETu(IV_MIN);
2605 }
a227d84d 2606 }
28e5dec8
JH		 2607 }
2608 } else{
2609 NV value = TOPn;
774d564b 2610 if (value < 0.0)
28e5dec8 2611 value = -value;
774d564b 2612 SETn(value);
2613 }
a0d0e21e 2614 }
774d564b 2615 RETURN;
463ee0b2
LW		 2616}
2617
79072805
LW		 2618PP(pp_hex)
2619{
39644a26 2620 dSP; dTARGET;
79072805 2621 char *tmps;
ba210ebe 2622 STRLEN argtype;
6f894ead 2623 STRLEN len;
79072805 2624
6f894ead 2625 tmps = (SvPVx(POPs, len));
b21ed0a9 2626 argtype = 1; /* allow underscores */
6f894ead 2627 XPUSHn(scan_hex(tmps, len, &argtype));
79072805
LW		 2628 RETURN;
2629}
2630
2631PP(pp_oct)
2632{
39644a26 2633 dSP; dTARGET;
9e24b6e2 2634 NV value;
ba210ebe 2635 STRLEN argtype;
79072805 2636 char *tmps;
6f894ead 2637 STRLEN len;
79072805 2638
6f894ead
DD		 2639 tmps = (SvPVx(POPs, len));
2640 while (*tmps && len && isSPACE(*tmps))
2641 tmps++, len--;
9e24b6e2 2642 if (*tmps == '0')
6f894ead 2643 tmps++, len--;
b21ed0a9 2644 argtype = 1; /* allow underscores */
9e24b6e2 2645 if (*tmps == 'x')
6f894ead 2646 value = scan_hex(++tmps, --len, &argtype);
9e24b6e2 2647 else if (*tmps == 'b')
6f894ead 2648 value = scan_bin(++tmps, --len, &argtype);
464e2e8a 2649 else
6f894ead 2650 value = scan_oct(tmps, len, &argtype);
9e24b6e2 2651 XPUSHn(value);
79072805
LW		 2652 RETURN;
2653}
2654
2655/* String stuff. */
2656
2657PP(pp_length)
2658{
39644a26 2659 dSP; dTARGET;
7e2040f0 2660 SV *sv = TOPs;
a0ed51b3 2661
7e2040f0
GS		 2662 if (DO_UTF8(sv))
2663 SETi(sv_len_utf8(sv));
2664 else
2665 SETi(sv_len(sv));
79072805
LW		 2666 RETURN;
2667}
2668
2669PP(pp_substr)
2670{
39644a26 2671 dSP; dTARGET;
79072805 2672 SV *sv;
9c5ffd7c 2673 I32 len = 0;
463ee0b2 2674 STRLEN curlen;
9402d6ed 2675 STRLEN utf8_curlen;
79072805
LW		 2676 I32 pos;
2677 I32 rem;
84902520 2678 I32 fail;
78f9721b 2679 I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
79072805 2680 char *tmps;
3280af22 2681 I32 arybase = PL_curcop->cop_arybase;
9402d6ed 2682 SV *repl_sv = NULL;
7b8d334a
GS		 2683 char *repl = 0;
2684 STRLEN repl_len;
78f9721b 2685 int num_args = PL_op->op_private & 7;
13e30c65 2686 bool repl_need_utf8_upgrade = FALSE;
9402d6ed 2687 bool repl_is_utf8 = FALSE;
79072805 2688
20408e3c 2689 SvTAINTED_off(TARG); /* decontaminate */
7e2040f0 2690 SvUTF8_off(TARG); /* decontaminate */
78f9721b
SM		 2691 if (num_args > 2) {
2692 if (num_args > 3) {
9402d6ed
JH		 2693 repl_sv = POPs;
2694 repl = SvPV(repl_sv, repl_len);
2695 repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
7b8d334a 2696 }
79072805 2697 len = POPi;
5d82c453 2698 }
84902520 2699 pos = POPi;
79072805 2700 sv = POPs;
849ca7ee 2701 PUTBACK;
9402d6ed
JH		 2702 if (repl_sv) {
2703 if (repl_is_utf8) {
2704 if (!DO_UTF8(sv))
2705 sv_utf8_upgrade(sv);
2706 }
13e30c65
JH		 2707 else if (DO_UTF8(sv))
2708 repl_need_utf8_upgrade = TRUE;
9402d6ed 2709 }
a0d0e21e 2710 tmps = SvPV(sv, curlen);
7e2040f0 2711 if (DO_UTF8(sv)) {
9402d6ed
JH		 2712 utf8_curlen = sv_len_utf8(sv);
2713 if (utf8_curlen == curlen)
2714 utf8_curlen = 0;
a0ed51b3 2715 else
9402d6ed 2716 curlen = utf8_curlen;
a0ed51b3 2717 }
d1c2b58a 2718 else
9402d6ed 2719 utf8_curlen = 0;
a0ed51b3 2720
84902520
TB		 2721 if (pos >= arybase) {
2722 pos -= arybase;
2723 rem = curlen-pos;
2724 fail = rem;
78f9721b 2725 if (num_args > 2) {
5d82c453
GA		 2726 if (len < 0) {
2727 rem += len;
2728 if (rem < 0)
2729 rem = 0;
2730 }
2731 else if (rem > len)
2732 rem = len;
2733 }
68dc0745 2734 }
84902520 2735 else {
5d82c453 2736 pos += curlen;
78f9721b 2737 if (num_args < 3)
5d82c453
GA		 2738 rem = curlen;
2739 else if (len >= 0) {
2740 rem = pos+len;
2741 if (rem > (I32)curlen)
2742 rem = curlen;
2743 }
2744 else {
2745 rem = curlen+len;
2746 if (rem < pos)
2747 rem = pos;
2748 }
2749 if (pos < 0)
2750 pos = 0;
2751 fail = rem;
2752 rem -= pos;
84902520
TB		 2753 }
2754 if (fail < 0) {
e476b1b5
GS		 2755 if (lvalue || repl)
2756 Perl_croak(aTHX_ "substr outside of string");
2757 if (ckWARN(WARN_SUBSTR))
cea2e8a9 2758 Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
2304df62
AD		 2759 RETPUSHUNDEF;
2760 }
79072805 2761 else {
9aa983d2
JH		 2762 I32 upos = pos;
2763 I32 urem = rem;
9402d6ed 2764 if (utf8_curlen)
a0ed51b3 2765 sv_pos_u2b(sv, &pos, &rem);
79072805 2766 tmps += pos;
79072805 2767 sv_setpvn(TARG, tmps, rem);
12aa1545 2768#ifdef USE_LOCALE_COLLATE
14befaf4 2769 sv_unmagic(TARG, PERL_MAGIC_collxfrm);
12aa1545 2770#endif
9402d6ed 2771 if (utf8_curlen)
7f66633b 2772 SvUTF8_on(TARG);
f7928d6c 2773 if (repl) {
13e30c65
JH		 2774 SV* repl_sv_copy = NULL;
2775
2776 if (repl_need_utf8_upgrade) {
2777 repl_sv_copy = newSVsv(repl_sv);
2778 sv_utf8_upgrade(repl_sv_copy);
2779 repl = SvPV(repl_sv_copy, repl_len);
2780 repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
2781 }
c8faf1c5 2782 sv_insert(sv, pos, rem, repl, repl_len);
9402d6ed 2783 if (repl_is_utf8)
f7928d6c 2784 SvUTF8_on(sv);
9402d6ed
JH		 2785 if (repl_sv_copy)
2786 SvREFCNT_dec(repl_sv_copy);
f7928d6c 2787 }
c8faf1c5 2788 else if (lvalue) { /* it's an lvalue! */
dedeecda 2789 if (!SvGMAGICAL(sv)) {
2790 if (SvROK(sv)) {
2d8e6c8d
GS		 2791 STRLEN n_a;
2792 SvPV_force(sv,n_a);
599cee73 2793 if (ckWARN(WARN_SUBSTR))
cea2e8a9 2794 Perl_warner(aTHX_ WARN_SUBSTR,
599cee73 2795 "Attempt to use reference as lvalue in substr");
dedeecda 2796 }
2797 if (SvOK(sv)) /* is it defined ? */
7f66633b 2798 (void)SvPOK_only_UTF8(sv);
dedeecda 2799 else
2800 sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
2801 }
5f05dabc 2802
a0d0e21e
LW		 2803 if (SvTYPE(TARG) < SVt_PVLV) {
2804 sv_upgrade(TARG, SVt_PVLV);
14befaf4 2805 sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
ed6116ce 2806 }
a0d0e21e 2807
5f05dabc 2808 LvTYPE(TARG) = 'x';
6ff81951
GS		 2809 if (LvTARG(TARG) != sv) {
2810 if (LvTARG(TARG))
2811 SvREFCNT_dec(LvTARG(TARG));
2812 LvTARG(TARG) = SvREFCNT_inc(sv);
2813 }
9aa983d2
JH		 2814 LvTARGOFF(TARG) = upos;
2815 LvTARGLEN(TARG) = urem;
79072805
LW		 2816 }
2817 }
849ca7ee 2818 SPAGAIN;
79072805
LW		 2819 PUSHs(TARG); /* avoid SvSETMAGIC here */
2820 RETURN;
2821}
2822
2823PP(pp_vec)
2824{
39644a26 2825 dSP; dTARGET;
467f0320
JH		 2826 register IV size = POPi;
2827 register IV offset = POPi;
79072805 2828 register SV *src = POPs;
78f9721b 2829 I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
a0d0e21e 2830
81e118e0
JH		 2831 SvTAINTED_off(TARG); /* decontaminate */
2832 if (lvalue) { /* it's an lvalue! */
2833 if (SvTYPE(TARG) < SVt_PVLV) {
2834 sv_upgrade(TARG, SVt_PVLV);
14befaf4 2835 sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0);
79072805 2836 }
81e118e0
JH		 2837 LvTYPE(TARG) = 'v';
2838 if (LvTARG(TARG) != src) {
2839 if (LvTARG(TARG))
2840 SvREFCNT_dec(LvTARG(TARG));
2841 LvTARG(TARG) = SvREFCNT_inc(src);
79072805 2842 }
81e118e0
JH		 2843 LvTARGOFF(TARG) = offset;
2844 LvTARGLEN(TARG) = size;
79072805
LW		 2845 }
2846
81e118e0 2847 sv_setuv(TARG, do_vecget(src, offset, size));
79072805
LW		 2848 PUSHs(TARG);
2849 RETURN;
2850}
2851
2852PP(pp_index)
2853{
39644a26 2854 dSP; dTARGET;
79072805
LW		 2855 SV *big;
2856 SV *little;
2857 I32 offset;
2858 I32 retval;
2859 char *tmps;
2860 char *tmps2;
463ee0b2 2861 STRLEN biglen;
3280af22 2862 I32 arybase = PL_curcop->cop_arybase;
79072805
LW		 2863
2864 if (MAXARG < 3)
2865 offset = 0;
2866 else
2867 offset = POPi - arybase;
2868 little = POPs;
2869 big = POPs;
463ee0b2 2870 tmps = SvPV(big, biglen);
7e2040f0 2871 if (offset > 0 && DO_UTF8(big))
a0ed51b3 2872 sv_pos_u2b(big, &offset, 0);
79072805
LW		 2873 if (offset < 0)
2874 offset = 0;
93a17b20
LW		 2875 else if (offset > biglen)
2876 offset = biglen;
79072805 2877 if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
411d5715 2878 (unsigned char*)tmps + biglen, little, 0)))
a0ed51b3 2879 retval = -1;
79072805 2880 else
a0ed51b3 2881 retval = tmps2 - tmps;
7e2040f0 2882 if (retval > 0 && DO_UTF8(big))
a0ed51b3
LW		 2883 sv_pos_b2u(big, &retval);
2884 PUSHi(retval + arybase);
79072805
LW		 2885 RETURN;
2886}
2887
2888PP(pp_rindex)
2889{
39644a26 2890 dSP; dTARGET;
79072805
LW		 2891 SV *big;
2892 SV *little;
463ee0b2
LW		 2893 STRLEN blen;
2894 STRLEN llen;
79072805
LW		 2895 I32 offset;
2896 I32 retval;
2897 char *tmps;
2898 char *tmps2;
3280af22 2899 I32 arybase = PL_curcop->cop_arybase;
79072805 2900
a0d0e21e 2901 if (MAXARG >= 3)
a0ed51b3 2902 offset = POPi;
79072805
LW		 2903 little = POPs;
2904 big = POPs;
463ee0b2
LW		 2905 tmps2 = SvPV(little, llen);
2906 tmps = SvPV(big, blen);
79072805 2907 if (MAXARG < 3)
463ee0b2 2908 offset = blen;
a0ed51b3 2909 else {
7e2040f0 2910 if (offset > 0 && DO_UTF8(big))
a0ed51b3
LW		 2911 sv_pos_u2b(big, &offset, 0);
2912 offset = offset - arybase + llen;
2913 }
79072805
LW		 2914 if (offset < 0)
2915 offset = 0;
463ee0b2
LW		 2916 else if (offset > blen)
2917 offset = blen;
79072805 2918 if (!(tmps2 = rninstr(tmps, tmps + offset,
463ee0b2 2919 tmps2, tmps2 + llen)))
a0ed51b3 2920 retval = -1;
79072805 2921 else
a0ed51b3 2922 retval = tmps2 - tmps;
7e2040f0 2923 if (retval > 0 && DO_UTF8(big))
a0ed51b3
LW		 2924 sv_pos_b2u(big, &retval);
2925 PUSHi(retval + arybase);
79072805
LW		 2926 RETURN;
2927}
2928
2929PP(pp_sprintf)
2930{
39644a26 2931 dSP; dMARK; dORIGMARK; dTARGET;
79072805 2932 do_sprintf(TARG, SP-MARK, MARK+1);
bbce6d69 2933 TAINT_IF(SvTAINTED(TARG));
79072805
LW		 2934 SP = ORIGMARK;
2935 PUSHTARG;
2936 RETURN;
2937}
2938
79072805
LW		 2939PP(pp_ord)
2940{
39644a26 2941 dSP; dTARGET;
7df053ec 2942 SV *argsv = POPs;
ba210ebe 2943 STRLEN len;
7df053ec 2944 U8 *s = (U8*)SvPVx(argsv, len);
79072805 2945
9041c2e3 2946 XPUSHu(DO_UTF8(argsv) ? utf8_to_uvchr(s, 0) : (*s & 0xff));
79072805
LW		 2947 RETURN;
2948}
2949
463ee0b2
LW		 2950PP(pp_chr)
2951{
39644a26 2952 dSP; dTARGET;
463ee0b2 2953 char *tmps;
467f0320 2954 UV value = POPu;
463ee0b2 2955
748a9306 2956 (void)SvUPGRADE(TARG,SVt_PV);
a0ed51b3 2957
0064a8a9 2958 if (value > 255 && !IN_BYTES) {
9aa983d2 2959 SvGROW(TARG, UNISKIP(value)+1);
9041c2e3 2960 tmps = (char*)uvchr_to_utf8((U8*)SvPVX(TARG), value);
a0ed51b3
LW		 2961 SvCUR_set(TARG, tmps - SvPVX(TARG));
2962 *tmps = '\0';
2963 (void)SvPOK_only(TARG);
aa6ffa16 2964 SvUTF8_on(TARG);
a0ed51b3
LW		 2965 XPUSHs(TARG);
2966 RETURN;
2967 }
2968
748a9306 2969 SvGROW(TARG,2);
463ee0b2
LW		 2970 SvCUR_set(TARG, 1);
2971 tmps = SvPVX(TARG);
a0ed51b3 2972 *tmps++ = value;
748a9306 2973 *tmps = '\0';
a0d0e21e 2974 (void)SvPOK_only(TARG);
463ee0b2
LW		 2975 XPUSHs(TARG);
2976 RETURN;
2977}
2978
79072805
LW		 2979PP(pp_crypt)
2980{
39644a26 2981 dSP; dTARGET; dPOPTOPssrl;
2d8e6c8d 2982 STRLEN n_a;
79072805 2983#ifdef HAS_CRYPT
2d8e6c8d 2984 char *tmps = SvPV(left, n_a);
79072805 2985#ifdef FCRYPT
2d8e6c8d 2986 sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
79072805 2987#else
2d8e6c8d 2988 sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
79072805
LW		 2989#endif
2990#else
b13b2135 2991 DIE(aTHX_
79072805
LW		 2992 "The crypt() function is unimplemented due to excessive paranoia.");
2993#endif
2994 SETs(TARG);
2995 RETURN;
2996}
2997
2998PP(pp_ucfirst)
2999{
39644a26 3000 dSP;
79072805 3001 SV *sv = TOPs;
a0ed51b3
LW		 3002 register U8 *s;
3003 STRLEN slen;
3004
fd400ab9 3005 if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
ba210ebe 3006 STRLEN ulen;
ad391ad9 3007 U8 tmpbuf[UTF8_MAXLEN+1];
a0ed51b3 3008 U8 *tend;
9041c2e3 3009 UV uv;
a0ed51b3 3010
2de3dbcc 3011 if (IN_LOCALE_RUNTIME) {
a0ed51b3
LW		 3012 TAINT;
3013 SvTAINTED_on(sv);
9041c2e3 3014 uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
a0ed51b3
LW		 3015 }
3016 else
3017 uv = toTITLE_utf8(s);
3018
9041c2e3 3019 tend = uvchr_to_utf8(tmpbuf, uv);
a0ed51b3 3020
014822e4 3021 if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
a0ed51b3 3022 dTARGET;
dfe13c55
GS		 3023 sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
3024 sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
7e2040f0 3025 SvUTF8_on(TARG);
a0ed51b3
LW		 3026 SETs(TARG);
3027 }
3028 else {
dfe13c55 3029 s = (U8*)SvPV_force(sv, slen);
a0ed51b3
LW		 3030 Copy(tmpbuf, s, ulen, U8);
3031 }
a0ed51b3 3032 }
626727d5 3033 else {
014822e4 3034 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3035 dTARGET;
7e2040f0 3036 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS		 3037 sv_setsv(TARG, sv);
3038 sv = TARG;
3039 SETs(sv);
3040 }
3041 s = (U8*)SvPV_force(sv, slen);
3042 if (*s) {
2de3dbcc 3043 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3044 TAINT;
3045 SvTAINTED_on(sv);
3046 *s = toUPPER_LC(*s);
3047 }
3048 else
3049 *s = toUPPER(*s);
bbce6d69 3050 }
bbce6d69 3051 }
31351b04
JS		 3052 if (SvSMAGICAL(sv))
3053 mg_set(sv);
79072805
LW		 3054 RETURN;
3055}
3056
3057PP(pp_lcfirst)
3058{
39644a26 3059 dSP;
79072805 3060 SV *sv = TOPs;
a0ed51b3
LW		 3061 register U8 *s;
3062 STRLEN slen;
3063
fd400ab9 3064 if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
ba210ebe 3065 STRLEN ulen;
ad391ad9 3066 U8 tmpbuf[UTF8_MAXLEN+1];
a0ed51b3 3067 U8 *tend;
9041c2e3 3068 UV uv;
a0ed51b3 3069
2de3dbcc 3070 if (IN_LOCALE_RUNTIME) {
a0ed51b3
LW		 3071 TAINT;
3072 SvTAINTED_on(sv);
9041c2e3 3073 uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
a0ed51b3
LW		 3074 }
3075 else
3076 uv = toLOWER_utf8(s);
3077
9041c2e3 3078 tend = uvchr_to_utf8(tmpbuf, uv);
a0ed51b3 3079
014822e4 3080 if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
a0ed51b3 3081 dTARGET;
dfe13c55
GS		 3082 sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
3083 sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
7e2040f0 3084 SvUTF8_on(TARG);
a0ed51b3
LW		 3085 SETs(TARG);
3086 }
3087 else {
dfe13c55 3088 s = (U8*)SvPV_force(sv, slen);
a0ed51b3
LW		 3089 Copy(tmpbuf, s, ulen, U8);
3090 }
a0ed51b3 3091 }
626727d5 3092 else {
014822e4 3093 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3094 dTARGET;
7e2040f0 3095 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS		 3096 sv_setsv(TARG, sv);
3097 sv = TARG;
3098 SETs(sv);
3099 }
3100 s = (U8*)SvPV_force(sv, slen);
3101 if (*s) {
2de3dbcc 3102 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3103 TAINT;
3104 SvTAINTED_on(sv);
3105 *s = toLOWER_LC(*s);
3106 }
3107 else
3108 *s = toLOWER(*s);
bbce6d69 3109 }
bbce6d69 3110 }
31351b04
JS		 3111 if (SvSMAGICAL(sv))
3112 mg_set(sv);
79072805
LW		 3113 RETURN;
3114}
3115
3116PP(pp_uc)
3117{
39644a26 3118 dSP;
79072805 3119 SV *sv = TOPs;
a0ed51b3 3120 register U8 *s;
463ee0b2 3121 STRLEN len;
79072805 3122
7e2040f0 3123 if (DO_UTF8(sv)) {
a0ed51b3 3124 dTARGET;
ba210ebe 3125 STRLEN ulen;
a0ed51b3
LW		 3126 register U8 *d;
3127 U8 *send;
3128
dfe13c55 3129 s = (U8*)SvPV(sv,len);
a5a20234 3130 if (!len) {
7e2040f0 3131 SvUTF8_off(TARG); /* decontaminate */
a5a20234
LW		 3132 sv_setpvn(TARG, "", 0);
3133 SETs(TARG);
a0ed51b3
LW		 3134 }
3135 else {
31351b04
JS		 3136 (void)SvUPGRADE(TARG, SVt_PV);
3137 SvGROW(TARG, (len * 2) + 1);
3138 (void)SvPOK_only(TARG);
3139 d = (U8*)SvPVX(TARG);
3140 send = s + len;
2de3dbcc 3141 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3142 TAINT;
3143 SvTAINTED_on(TARG);
3144 while (s < send) {
9041c2e3 3145 d = uvchr_to_utf8(d, toUPPER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
31351b04
JS		 3146 s += ulen;
3147 }
a0ed51b3 3148 }
31351b04
JS		 3149 else {
3150 while (s < send) {
9041c2e3 3151 d = uvchr_to_utf8(d, toUPPER_utf8( s ));
31351b04
JS		 3152 s += UTF8SKIP(s);
3153 }
a0ed51b3 3154 }
31351b04 3155 *d = '\0';
7e2040f0 3156 SvUTF8_on(TARG);
31351b04
JS		 3157 SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
3158 SETs(TARG);
a0ed51b3 3159 }
a0ed51b3 3160 }
626727d5 3161 else {
014822e4 3162 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3163 dTARGET;
7e2040f0 3164 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS		 3165 sv_setsv(TARG, sv);
3166 sv = TARG;
3167 SETs(sv);
3168 }
3169 s = (U8*)SvPV_force(sv, len);
3170 if (len) {
3171 register U8 *send = s + len;
3172
2de3dbcc 3173 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3174 TAINT;
3175 SvTAINTED_on(sv);
3176 for (; s < send; s++)
3177 *s = toUPPER_LC(*s);
3178 }
3179 else {
3180 for (; s < send; s++)
3181 *s = toUPPER(*s);
3182 }
bbce6d69 3183 }
79072805 3184 }
31351b04
JS		 3185 if (SvSMAGICAL(sv))
3186 mg_set(sv);
79072805
LW		 3187 RETURN;
3188}
3189
3190PP(pp_lc)
3191{
39644a26 3192 dSP;
79072805 3193 SV *sv = TOPs;
a0ed51b3 3194 register U8 *s;
463ee0b2 3195 STRLEN len;
79072805 3196
7e2040f0 3197 if (DO_UTF8(sv)) {
a0ed51b3 3198 dTARGET;
ba210ebe 3199 STRLEN ulen;
a0ed51b3
LW		 3200 register U8 *d;
3201 U8 *send;
3202
dfe13c55 3203 s = (U8*)SvPV(sv,len);
a5a20234 3204 if (!len) {
7e2040f0 3205 SvUTF8_off(TARG); /* decontaminate */
a5a20234
LW		 3206 sv_setpvn(TARG, "", 0);
3207 SETs(TARG);
a0ed51b3
LW		 3208 }
3209 else {
31351b04
JS		 3210 (void)SvUPGRADE(TARG, SVt_PV);
3211 SvGROW(TARG, (len * 2) + 1);
3212 (void)SvPOK_only(TARG);
3213 d = (U8*)SvPVX(TARG);
3214 send = s + len;
2de3dbcc 3215 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3216 TAINT;
3217 SvTAINTED_on(TARG);
3218 while (s < send) {
9041c2e3 3219 d = uvchr_to_utf8(d, toLOWER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
31351b04
JS		 3220 s += ulen;
3221 }
a0ed51b3 3222 }
31351b04
JS		 3223 else {
3224 while (s < send) {
9041c2e3 3225 d = uvchr_to_utf8(d, toLOWER_utf8(s));
31351b04
JS		 3226 s += UTF8SKIP(s);
3227 }
a0ed51b3 3228 }
31351b04 3229 *d = '\0';
7e2040f0 3230 SvUTF8_on(TARG);
31351b04
JS		 3231 SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
3232 SETs(TARG);
a0ed51b3 3233 }
79072805 3234 }
626727d5 3235 else {
014822e4 3236 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3237 dTARGET;
7e2040f0 3238 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS		 3239 sv_setsv(TARG, sv);
3240 sv = TARG;
3241 SETs(sv);
a0ed51b3 3242 }
bbce6d69 3243
31351b04
JS		 3244 s = (U8*)SvPV_force(sv, len);
3245 if (len) {
3246 register U8 *send = s + len;
bbce6d69 3247
2de3dbcc 3248 if (IN_LOCALE_RUNTIME) {
31351b04
JS		 3249 TAINT;
3250 SvTAINTED_on(sv);
3251 for (; s < send; s++)
3252 *s = toLOWER_LC(*s);
3253 }
3254 else {
3255 for (; s < send; s++)
3256 *s = toLOWER(*s);
3257 }
bbce6d69 3258 }
79072805 3259 }
31351b04
JS		 3260 if (SvSMAGICAL(sv))
3261 mg_set(sv);
79072805
LW		 3262 RETURN;
3263}
3264
a0d0e21e 3265PP(pp_quotemeta)
79072805 3266{
39644a26 3267 dSP; dTARGET;
a0d0e21e
LW		 3268 SV *sv = TOPs;
3269 STRLEN len;
3270 register char *s = SvPV(sv,len);
3271 register char *d;
79072805 3272
7e2040f0 3273 SvUTF8_off(TARG); /* decontaminate */
a0d0e21e
LW		 3274 if (len) {
3275 (void)SvUPGRADE(TARG, SVt_PV);
c07a80fd 3276 SvGROW(TARG, (len * 2) + 1);
a0d0e21e 3277 d = SvPVX(TARG);
7e2040f0 3278 if (DO_UTF8(sv)) {
0dd2cdef 3279 while (len) {
fd400ab9 3280 if (UTF8_IS_CONTINUED(*s)) {
0dd2cdef
LW		 3281 STRLEN ulen = UTF8SKIP(s);
3282 if (ulen > len)
3283 ulen = len;
3284 len -= ulen;
3285 while (ulen--)
3286 *d++ = *s++;
3287 }
3288 else {
3289 if (!isALNUM(*s))
3290 *d++ = '\\';
3291 *d++ = *s++;
3292 len--;
3293 }
3294 }
7e2040f0 3295 SvUTF8_on(TARG);
0dd2cdef
LW		 3296 }
3297 else {
3298 while (len--) {
3299 if (!isALNUM(*s))
3300 *d++ = '\\';
3301 *d++ = *s++;
3302 }
79072805 3303 }
a0d0e21e
LW		 3304 *d = '\0';
3305 SvCUR_set(TARG, d - SvPVX(TARG));
3aa33fe5 3306 (void)SvPOK_only_UTF8(TARG);
79072805 3307 }
a0d0e21e
LW		 3308 else
3309 sv_setpvn(TARG, s, len);
3310 SETs(TARG);
31351b04
JS		 3311 if (SvSMAGICAL(TARG))
3312 mg_set(TARG);
79072805
LW		 3313 RETURN;
3314}
3315
a0d0e21e 3316/* Arrays. */
79072805 3317
a0d0e21e 3318PP(pp_aslice)
79072805 3319{
39644a26 3320 dSP; dMARK; dORIGMARK;
a0d0e21e
LW		 3321 register SV** svp;
3322 register AV* av = (AV*)POPs;
78f9721b 3323 register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
3280af22 3324 I32 arybase = PL_curcop->cop_arybase;
748a9306 3325 I32 elem;
79072805 3326
a0d0e21e 3327 if (SvTYPE(av) == SVt_PVAV) {
533c011a 3328 if (lval && PL_op->op_private & OPpLVAL_INTRO) {
748a9306 3329 I32 max = -1;
924508f0 3330 for (svp = MARK + 1; svp <= SP; svp++) {
748a9306
LW		 3331 elem = SvIVx(*svp);
3332 if (elem > max)
3333 max = elem;
3334 }
3335 if (max > AvMAX(av))
3336 av_extend(av, max);
3337 }
a0d0e21e 3338 while (++MARK <= SP) {
748a9306 3339 elem = SvIVx(*MARK);
a0d0e21e 3340
748a9306
LW		 3341 if (elem > 0)
3342 elem -= arybase;
a0d0e21e
LW		 3343 svp = av_fetch(av, elem, lval);
3344 if (lval) {
3280af22 3345 if (!svp || *svp == &PL_sv_undef)
cea2e8a9 3346 DIE(aTHX_ PL_no_aelem, elem);
533c011a 3347 if (PL_op->op_private & OPpLVAL_INTRO)
161b7d16 3348 save_aelem(av, elem, svp);
79072805 3349 }
3280af22 3350 *MARK = svp ? *svp : &PL_sv_undef;
79072805
LW		 3351 }
3352 }
748a9306 3353 if (GIMME != G_ARRAY) {
a0d0e21e
LW		 3354 MARK = ORIGMARK;
3355 *++MARK = *SP;
3356 SP = MARK;
3357 }
79072805
LW		 3358 RETURN;
3359}
3360
3361/* Associative arrays. */
3362
3363PP(pp_each)
3364{
39644a26 3365 dSP;
79072805 3366 HV *hash = (HV*)POPs;
c07a80fd 3367 HE *entry;
54310121 3368 I32 gimme = GIMME_V;
c750a3ec 3369 I32 realhv = (SvTYPE(hash) == SVt_PVHV);
8ec5e241 3370
c07a80fd 3371 PUTBACK;
c750a3ec
MB		 3372 /* might clobber stack_sp */
3373 entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
c07a80fd 3374 SPAGAIN;
79072805 3375
79072805
LW		 3376 EXTEND(SP, 2);
3377 if (entry) {
54310121 3378 PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
3379 if (gimme == G_ARRAY) {
59af0135 3380 SV *val;
c07a80fd 3381 PUTBACK;
c750a3ec 3382 /* might clobber stack_sp */
59af0135
GS		 3383 val = realhv ?
3384 hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
c07a80fd 3385 SPAGAIN;
59af0135 3386 PUSHs(val);
79072805 3387 }
79072805 3388 }
54310121 3389 else if (gimme == G_SCALAR)
79072805
LW		 3390 RETPUSHUNDEF;
3391
3392 RETURN;
3393}
3394
3395PP(pp_values)
3396{
cea2e8a9 3397 return do_kv();
79072805
LW		 3398}
3399
3400PP(pp_keys)
3401{
cea2e8a9 3402 return do_kv();
79072805
LW		 3403}
3404
3405PP(pp_delete)
3406{
39644a26 3407 dSP;
54310121 3408 I32 gimme = GIMME_V;
3409 I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
79072805 3410 SV *sv;
5f05dabc 3411 HV *hv;
3412
533c011a 3413 if (PL_op->op_private & OPpSLICE) {
5f05dabc 3414 dMARK; dORIGMARK;
97fcbf96 3415 U32 hvtype;
5f05dabc 3416 hv = (HV*)POPs;
97fcbf96 3417 hvtype = SvTYPE(hv);
01020589
GS		 3418 if (hvtype == SVt_PVHV) { /* hash element */
3419 while (++MARK <= SP) {
ae77835f 3420 sv = hv_delete_ent(hv, *MARK, discard, 0);
01020589
GS		 3421 *MARK = sv ? sv : &PL_sv_undef;
3422 }
5f05dabc 3423 }
01020589
GS		 3424 else if (hvtype == SVt_PVAV) {
3425 if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
3426 while (++MARK <= SP) {
3427 sv = av_delete((AV*)hv, SvIV(*MARK), discard);
3428 *MARK = sv ? sv : &PL_sv_undef;
3429 }
3430 }
3431 else { /* pseudo-hash element */
3432 while (++MARK <= SP) {
3433 sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
3434 *MARK = sv ? sv : &PL_sv_undef;
3435 }
3436 }
3437 }
3438 else
3439 DIE(aTHX_ "Not a HASH reference");
54310121 3440 if (discard)
3441 SP = ORIGMARK;
3442 else if (gimme == G_SCALAR) {
5f05dabc 3443 MARK = ORIGMARK;
3444 *++MARK = *SP;
3445 SP = MARK;
3446 }
3447 }
3448 else {
3449 SV *keysv = POPs;
3450 hv = (HV*)POPs;
97fcbf96
MB		 3451 if (SvTYPE(hv) == SVt_PVHV)
3452 sv = hv_delete_ent(hv, keysv, discard, 0);
01020589
GS		 3453 else if (SvTYPE(hv) == SVt_PVAV) {
3454 if (PL_op->op_flags & OPf_SPECIAL)
3455 sv = av_delete((AV*)hv, SvIV(keysv), discard);
3456 else
3457 sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
3458 }
97fcbf96 3459 else
cea2e8a9 3460 DIE(aTHX_ "Not a HASH reference");
5f05dabc 3461 if (!sv)
3280af22 3462 sv = &PL_sv_undef;
54310121 3463 if (!discard)
3464 PUSHs(sv);
79072805 3465 }
79072805
LW		 3466 RETURN;
3467}
3468
a0d0e21e 3469PP(pp_exists)
79072805 3470{
39644a26 3471 dSP;
afebc493
GS		 3472 SV *tmpsv;
3473 HV *hv;
3474
3475 if (PL_op->op_private & OPpEXISTS_SUB) {
3476 GV *gv;
3477 CV *cv;
3478 SV *sv = POPs;
3479 cv = sv_2cv(sv, &hv, &gv, FALSE);
3480 if (cv)
3481 RETPUSHYES;
3482 if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
3483 RETPUSHYES;
3484 RETPUSHNO;
3485 }
3486 tmpsv = POPs;
3487 hv = (HV*)POPs;
c750a3ec 3488 if (SvTYPE(hv) == SVt_PVHV) {
ae77835f 3489 if (hv_exists_ent(hv, tmpsv, 0))
c750a3ec 3490 RETPUSHYES;
ef54e1a4
JH		 3491 }
3492 else if (SvTYPE(hv) == SVt_PVAV) {
01020589
GS		 3493 if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
3494 if (av_exists((AV*)hv, SvIV(tmpsv)))
3495 RETPUSHYES;
3496 }
3497 else if (avhv_exists_ent((AV*)hv, tmpsv, 0)) /* pseudo-hash element */
c750a3ec 3498 RETPUSHYES;
ef54e1a4
JH		 3499 }
3500 else {
cea2e8a9 3501 DIE(aTHX_ "Not a HASH reference");
a0d0e21e 3502 }
a0d0e21e
LW		 3503 RETPUSHNO;
3504}
79072805 3505
a0d0e21e
LW		 3506PP(pp_hslice)
3507{
39644a26 3508 dSP; dMARK; dORIGMARK;
a0d0e21e 3509 register HV *hv = (HV*)POPs;
78f9721b 3510 register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
c750a3ec 3511 I32 realhv = (SvTYPE(hv) == SVt_PVHV);
79072805 3512
0ebe0038 3513 if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
cea2e8a9 3514 DIE(aTHX_ "Can't localize pseudo-hash element");
0ebe0038 3515
c750a3ec 3516 if (realhv || SvTYPE(hv) == SVt_PVAV) {
a0d0e21e 3517 while (++MARK <= SP) {
f12c7020 3518 SV *keysv = *MARK;
ae77835f 3519 SV **svp;
d4fa047a
RH		 3520 I32 preeminent = SvRMAGICAL(hv) ? 1 :
3521 realhv ? hv_exists_ent(hv, keysv, 0)
3522 : avhv_exists_ent((AV*)hv, keysv, 0);
ae77835f 3523 if (realhv) {
800e9ae0 3524 HE *he = hv_fetch_ent(hv, keysv, lval, 0);
ae77835f 3525 svp = he ? &HeVAL(he) : 0;
ef54e1a4
JH		 3526 }
3527 else {
97fcbf96 3528 svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
ae77835f 3529 }
a0d0e21e 3530 if (lval) {
2d8e6c8d
GS		 3531 if (!svp || *svp == &PL_sv_undef) {
3532 STRLEN n_a;
cea2e8a9 3533 DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
2d8e6c8d 3534 }
1f5346dc 3535 if (PL_op->op_private & OPpLVAL_INTRO) {
a227d84d 3536 if (preeminent)
1f5346dc
SC		 3537 save_helem(hv, keysv, svp);
3538 else {
3539 STRLEN keylen;
3540 char *key = SvPV(keysv, keylen);
57813020 3541 SAVEDELETE(hv, savepvn(key,keylen), keylen);
1f5346dc
SC		 3542 }
3543 }
93a17b20 3544 }
3280af22 3545 *MARK = svp ? *svp : &PL_sv_undef;
79072805
LW		 3546 }
3547 }
a0d0e21e
LW		 3548 if (GIMME != G_ARRAY) {
3549 MARK = ORIGMARK;
3550 *++MARK = *SP;
3551 SP = MARK;
79072805 3552 }
a0d0e21e
LW		 3553 RETURN;
3554}
3555
3556/* List operators. */
3557
3558PP(pp_list)
3559{
39644a26 3560 dSP; dMARK;
a0d0e21e
LW		 3561 if (GIMME != G_ARRAY) {
3562 if (++MARK <= SP)
3563 *MARK = *SP; /* unwanted list, return last item */
8990e307 3564 else
3280af22 3565 *MARK = &PL_sv_undef;
a0d0e21e 3566 SP = MARK;
79072805 3567 }
a0d0e21e 3568 RETURN;
79072805
LW		 3569}
3570
a0d0e21e 3571PP(pp_lslice)
79072805 3572{
39644a26 3573 dSP;
3280af22
NIS		 3574 SV **lastrelem = PL_stack_sp;
3575 SV **lastlelem = PL_stack_base + POPMARK;
3576 SV **firstlelem = PL_stack_base + POPMARK + 1;
a0d0e21e 3577 register SV **firstrelem = lastlelem + 1;
3280af22 3578 I32 arybase = PL_curcop->cop_arybase;
533c011a 3579 I32 lval = PL_op->op_flags & OPf_MOD;
4633a7c4 3580 I32 is_something_there = lval;
79072805 3581
a0d0e21e
LW		 3582 register I32 max = lastrelem - lastlelem;
3583 register SV **lelem;
3584 register I32 ix;
3585
3586 if (GIMME != G_ARRAY) {
748a9306
LW		 3587 ix = SvIVx(*lastlelem);
3588 if (ix < 0)
3589 ix += max;
3590 else
3591 ix -= arybase;
a0d0e21e 3592 if (ix < 0 || ix >= max)
3280af22 3593 *firstlelem = &PL_sv_undef;
a0d0e21e
LW		 3594 else
3595 *firstlelem = firstrelem[ix];
3596 SP = firstlelem;
3597 RETURN;
3598 }
3599
3600 if (max == 0) {
3601 SP = firstlelem - 1;
3602 RETURN;
3603 }
3604
3605 for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
748a9306 3606 ix = SvIVx(*lelem);
c73bf8e3 3607 if (ix < 0)
a0d0e21e 3608 ix += max;
b13b2135 3609 else
748a9306 3610 ix -= arybase;
c73bf8e3
HS		 3611 if (ix < 0 || ix >= max)
3612 *lelem = &PL_sv_undef;
3613 else {
3614 is_something_there = TRUE;
3615 if (!(*lelem = firstrelem[ix]))
3280af22 3616 *lelem = &PL_sv_undef;
748a9306 3617 }
79072805 3618 }
4633a7c4
LW		 3619 if (is_something_there)
3620 SP = lastlelem;
3621 else
3622 SP = firstlelem - 1;
79072805
LW		 3623 RETURN;
3624}
3625
a0d0e21e
LW		 3626PP(pp_anonlist)
3627{
39644a26 3628 dSP; dMARK; dORIGMARK;
a0d0e21e 3629 I32 items = SP - MARK;
44a8e56a 3630 SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
3631 SP = ORIGMARK; /* av_make() might realloc stack_sp */
3632 XPUSHs(av);
a0d0e21e
LW		 3633 RETURN;
3634}
3635
3636PP(pp_anonhash)
79072805 3637{
39644a26 3638 dSP; dMARK; dORIGMARK;
a0d0e21e
LW		 3639 HV* hv = (HV*)sv_2mortal((SV*)newHV());
3640
3641 while (MARK < SP) {
3642 SV* key = *++MARK;
a0d0e21e
LW		 3643 SV *val = NEWSV(46, 0);
3644 if (MARK < SP)
3645 sv_setsv(val, *++MARK);
e476b1b5
GS		 3646 else if (ckWARN(WARN_MISC))
3647 Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
f12c7020 3648 (void)hv_store_ent(hv,key,val,0);
79072805 3649 }
a0d0e21e
LW		 3650 SP = ORIGMARK;
3651 XPUSHs((SV*)hv);
79072805
LW		 3652 RETURN;
3653}
3654
a0d0e21e 3655PP(pp_splice)
79072805 3656{
39644a26 3657 dSP; dMARK; dORIGMARK;
a0d0e21e
LW		 3658 register AV *ary = (AV*)*++MARK;
3659 register SV **src;
3660 register SV **dst;
3661 register I32 i;
3662 register I32 offset;
3663 register I32 length;
3664 I32 newlen;
3665 I32 after;
3666 I32 diff;
3667 SV **tmparyval = 0;
93965878
NIS		 3668 MAGIC *mg;
3669
14befaf4 3670 if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
33c27489 3671 *MARK-- = SvTIED_obj((SV*)ary, mg);
93965878 3672 PUSHMARK(MARK);
8ec5e241 3673 PUTBACK;
a60c0954 3674 ENTER;
864dbfa3 3675 call_method("SPLICE",GIMME_V);
a60c0954 3676 LEAVE;
93965878
NIS		 3677 SPAGAIN;
3678 RETURN;
3679 }
79072805 3680
a0d0e21e 3681 SP++;
79072805 3682
a0d0e21e 3683 if (++MARK < SP) {
84902520 3684 offset = i = SvIVx(*MARK);
a0d0e21e 3685 if (offset < 0)
93965878 3686 offset += AvFILLp(ary) + 1;
a0d0e21e 3687 else
3280af22 3688 offset -= PL_curcop->cop_arybase;
84902520 3689 if (offset < 0)
cea2e8a9 3690 DIE(aTHX_ PL_no_aelem, i);
a0d0e21e
LW		 3691 if (++MARK < SP) {
3692 length = SvIVx(*MARK++);
48cdf507
GA		 3693 if (length < 0) {
3694 length += AvFILLp(ary) - offset + 1;
3695 if (length < 0)
3696 length = 0;
3697 }
79072805
LW		 3698 }
3699 else
a0d0e21e 3700 length = AvMAX(ary) + 1; /* close enough to infinity */
79072805 3701 }
a0d0e21e
LW		 3702 else {
3703 offset = 0;
3704 length = AvMAX(ary) + 1;
3705 }
93965878
NIS		 3706 if (offset > AvFILLp(ary) + 1)
3707 offset = AvFILLp(ary) + 1;
3708 after = AvFILLp(ary) + 1 - (offset + length);
a0d0e21e
LW		 3709 if (after < 0) { /* not that much array */
3710 length += after; /* offset+length now in array */
3711 after = 0;
3712 if (!AvALLOC(ary))
3713 av_extend(ary, 0);
3714 }
3715
3716 /* At this point, MARK .. SP-1 is our new LIST */
3717
3718 newlen = SP - MARK;
3719 diff = newlen - length;
13d7cbc1
GS		 3720 if (newlen && !AvREAL(ary) && AvREIFY(ary))
3721 av_reify(ary);
a0d0e21e
LW		 3722
3723 if (diff < 0) { /* shrinking the area */
3724 if (newlen) {
3725 New(451, tmparyval, newlen, SV*); /* so remember insertion */
3726 Copy(MARK, tmparyval, newlen, SV*);
79072805 3727 }
a0d0e21e
LW		 3728
3729 MARK = ORIGMARK + 1;
3730 if (GIMME == G_ARRAY) { /* copy return vals to stack */
3731 MEXTEND(MARK, length);
3732 Copy(AvARRAY(ary)+offset, MARK, length, SV*);
3733 if (AvREAL(ary)) {
bbce6d69 3734 EXTEND_MORTAL(length);
36477c24 3735 for (i = length, dst = MARK; i; i--) {
d689ffdd 3736 sv_2mortal(*dst); /* free them eventualy */
36477c24 3737 dst++;
3738 }
a0d0e21e
LW		 3739 }
3740 MARK += length - 1;
79072805 3741 }
a0d0e21e
LW		 3742 else {
3743 *MARK = AvARRAY(ary)[offset+length-1];
3744 if (AvREAL(ary)) {
d689ffdd 3745 sv_2mortal(*MARK);
a0d0e21e
LW		 3746 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
3747 SvREFCNT_dec(*dst++); /* free them now */
79072805 3748 }
a0d0e21e 3749 }
93965878 3750 AvFILLp(ary) += diff;
a0d0e21e
LW		 3751
3752 /* pull up or down? */
3753
3754 if (offset < after) { /* easier to pull up */
3755 if (offset) { /* esp. if nothing to pull */
3756 src = &AvARRAY(ary)[offset-1];
3757 dst = src - diff; /* diff is negative */
3758 for (i = offset; i > 0; i--) /* can't trust Copy */
3759 *dst-- = *src--;
79072805 3760 }
a0d0e21e
LW		 3761 dst = AvARRAY(ary);
3762 SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
3763 AvMAX(ary) += diff;
3764 }
3765 else {
3766 if (after) { /* anything to pull down? */
3767 src = AvARRAY(ary) + offset + length;
3768 dst = src + diff; /* diff is negative */
3769 Move(src, dst, after, SV*);
79072805 3770 }
93965878 3771 dst = &AvARRAY(ary)[AvFILLp(ary)+1];
a0d0e21e
LW		 3772 /* avoid later double free */
3773 }
3774 i = -diff;
3775 while (i)
3280af22 3776 dst[--i] = &PL_sv_undef;
a0d0e21e
LW		 3777
3778 if (newlen) {
3779 for (src = tmparyval, dst = AvARRAY(ary) + offset;
3780 newlen; newlen--) {
3781 *dst = NEWSV(46, 0);
3782 sv_setsv(*dst++, *src++);
79072805 3783 }
a0d0e21e
LW		 3784 Safefree(tmparyval);
3785 }
3786 }
3787 else { /* no, expanding (or same) */
3788 if (length) {
3789 New(452, tmparyval, length, SV*); /* so remember deletion */
3790 Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
3791 }
3792
3793 if (diff > 0) { /* expanding */
3794
3795 /* push up or down? */
3796
3797 if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
3798 if (offset) {
3799 src = AvARRAY(ary);
3800 dst = src - diff;
3801 Move(src, dst, offset, SV*);
79072805 3802 }
a0d0e21e
LW		 3803 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
3804 AvMAX(ary) += diff;
93965878 3805 AvFILLp(ary) += diff;
79072805
LW		 3806 }
3807 else {
93965878
NIS		 3808 if (AvFILLp(ary) + diff >= AvMAX(ary)) /* oh, well */
3809 av_extend(ary, AvFILLp(ary) + diff);
3810 AvFILLp(ary) += diff;
a0d0e21e
LW		 3811
3812 if (after) {
93965878 3813 dst = AvARRAY(ary) + AvFILLp(ary);
a0d0e21e
LW		 3814 src = dst - diff;
3815 for (i = after; i; i--) {
3816 *dst-- = *src--;
3817 }
79072805
LW		 3818 }
3819 }
a0d0e21e
LW		 3820 }
3821
3822 for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
3823 *dst = NEWSV(46, 0);
3824 sv_setsv(*dst++, *src++);
3825 }
3826 MARK = ORIGMARK + 1;
3827 if (GIMME == G_ARRAY) { /* copy return vals to stack */
3828 if (length) {
3829 Copy(tmparyval, MARK, length, SV*);
3830 if (AvREAL(ary)) {
bbce6d69 3831 EXTEND_MORTAL(length);
36477c24 3832 for (i = length, dst = MARK; i; i--) {
d689ffdd 3833 sv_2mortal(*dst); /* free them eventualy */
36477c24 3834 dst++;
3835 }
79072805 3836 }
a0d0e21e 3837 Safefree(tmparyval);
79072805 3838 }
a0d0e21e
LW		 3839 MARK += length - 1;
3840 }
3841 else if (length--) {
3842 *MARK = tmparyval[length];
3843 if (AvREAL(ary)) {
d689ffdd 3844 sv_2mortal(*MARK);
a0d0e21e
LW		 3845 while (length-- > 0)
3846 SvREFCNT_dec(tmparyval[length]);
79072805 3847 }
a0d0e21e 3848 Safefree(tmparyval);
79072805 3849 }
a0d0e21e 3850 else
3280af22 3851 *MARK = &PL_sv_undef;
79072805 3852 }
a0d0e21e 3853 SP = MARK;
79072805
LW		 3854 RETURN;
3855}
3856
a0d0e21e 3857PP(pp_push)
79072805 3858{
39644a26 3859 dSP; dMARK; dORIGMARK; dTARGET;
a0d0e21e 3860 register AV *ary = (AV*)*++MARK;
3280af22 3861 register SV *sv = &PL_sv_undef;
93965878 3862 MAGIC *mg;
79072805 3863
14befaf4 3864 if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
33c27489 3865 *MARK-- = SvTIED_obj((SV*)ary, mg);
93965878
NIS		 3866 PUSHMARK(MARK);
3867 PUTBACK;
a60c0954 3868 ENTER;
864dbfa3 3869 call_method("PUSH",G_SCALAR|G_DISCARD);
a60c0954 3870 LEAVE;
93965878 3871 SPAGAIN;
93965878 3872 }
a60c0954
NIS		 3873 else {
3874 /* Why no pre-extend of ary here ? */
3875 for (++MARK; MARK <= SP; MARK++) {
3876 sv = NEWSV(51, 0);
3877 if (*MARK)
3878 sv_setsv(sv, *MARK);
3879 av_push(ary, sv);
3880 }
79072805
LW		 3881 }
3882 SP = ORIGMARK;
a0d0e21e 3883 PUSHi( AvFILL(ary) + 1 );
79072805
LW		 3884 RETURN;
3885}
3886
a0d0e21e 3887PP(pp_pop)
79072805 3888{
39644a26 3889 dSP;
a0d0e21e
LW		 3890 AV *av = (AV*)POPs;
3891 SV *sv = av_pop(av);
d689ffdd 3892 if (AvREAL(av))
a0d0e21e
LW		 3893 (void)sv_2mortal(sv);
3894 PUSHs(sv);
79072805 3895 RETURN;
79072805
LW		 3896}
3897
a0d0e21e 3898PP(pp_shift)
79072805 3899{
39644a26 3900 dSP;
a0d0e21e
LW		 3901 AV *av = (AV*)POPs;
3902 SV *sv = av_shift(av);
79072805 3903 EXTEND(SP, 1);
a0d0e21e 3904 if (!sv)
79072805 3905 RETPUSHUNDEF;
d689ffdd 3906 if (AvREAL(av))
a0d0e21e
LW		 3907 (void)sv_2mortal(sv);
3908 PUSHs(sv);
79072805 3909 RETURN;
79072805
LW		 3910}
3911
a0d0e21e 3912PP(pp_unshift)
79072805 3913{
39644a26 3914 dSP; dMARK; dORIGMARK; dTARGET;
a0d0e21e
LW		 3915 register AV *ary = (AV*)*++MARK;
3916 register SV *sv;
3917 register I32 i = 0;
93965878
NIS		 3918 MAGIC *mg;
3919
14befaf4 3920 if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
33c27489 3921 *MARK-- = SvTIED_obj((SV*)ary, mg);
7fd66d9d 3922 PUSHMARK(MARK);
93965878 3923 PUTBACK;
a60c0954 3924 ENTER;
864dbfa3 3925 call_method("UNSHIFT",G_SCALAR|G_DISCARD);
a60c0954 3926 LEAVE;
93965878 3927 SPAGAIN;
93965878 3928 }
a60c0954
NIS		 3929 else {
3930 av_unshift(ary, SP - MARK);
3931 while (MARK < SP) {
3932 sv = NEWSV(27, 0);
3933 sv_setsv(sv, *++MARK);
3934 (void)av_store(ary, i++, sv);
3935 }
79072805 3936 }
a0d0e21e
LW		 3937 SP = ORIGMARK;
3938 PUSHi( AvFILL(ary) + 1 );
79072805 3939 RETURN;
79072805
LW		 3940}
3941
a0d0e21e 3942PP(pp_reverse)
79072805 3943{
39644a26 3944 dSP; dMARK;
a0d0e21e
LW		 3945 register SV *tmp;
3946 SV **oldsp = SP;
79072805 3947
a0d0e21e
LW		 3948 if (GIMME == G_ARRAY) {
3949 MARK++;
3950 while (MARK < SP) {
3951 tmp = *MARK;
3952 *MARK++ = *SP;
3953 *SP-- = tmp;
3954 }
dd58a1ab 3955 /* safe as long as stack cannot get extended in the above */
a0d0e21e 3956 SP = oldsp;
79072805
LW		 3957 }
3958 else {
a0d0e21e
LW		 3959 register char *up;
3960 register char *down;
3961 register I32 tmp;
3962 dTARGET;
3963 STRLEN len;
79072805 3964
7e2040f0 3965 SvUTF8_off(TARG); /* decontaminate */
a0d0e21e 3966 if (SP - MARK > 1)
3280af22 3967 do_join(TARG, &PL_sv_no, MARK, SP);
a0d0e21e 3968 else
54b9620d 3969 sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
a0d0e21e
LW		 3970 up = SvPV_force(TARG, len);
3971 if (len > 1) {
7e2040f0 3972 if (DO_UTF8(TARG)) { /* first reverse each character */
dfe13c55
GS		 3973 U8* s = (U8*)SvPVX(TARG);
3974 U8* send = (U8*)(s + len);
a0ed51b3 3975 while (s < send) {
d742c382 3976 if (UTF8_IS_INVARIANT(*s)) {
a0ed51b3
LW		 3977 s++;
3978 continue;
3979 }
3980 else {
9041c2e3 3981 if (!utf8_to_uvchr(s, 0))
a0dbb045 3982 break;
dfe13c55 3983 up = (char*)s;
a0ed51b3 3984 s += UTF8SKIP(s);
dfe13c55 3985 down = (char*)(s - 1);
a0dbb045 3986 /* reverse this character */
a0ed51b3
LW		 3987 while (down > up) {
3988 tmp = *up;
3989 *up++ = *down;
3990 *down-- = tmp;
3991 }
3992 }
3993 }
3994 up = SvPVX(TARG);
3995 }
a0d0e21e
LW		 3996 down = SvPVX(TARG) + len - 1;
3997 while (down > up) {
3998 tmp = *up;
3999 *up++ = *down;
4000 *down-- = tmp;
4001 }
3aa33fe5 4002 (void)SvPOK_only_UTF8(TARG);
79072805 4003 }
a0d0e21e
LW		 4004 SP = MARK + 1;
4005 SETTARG;
79072805 4006 }
a0d0e21e 4007 RETURN;
79072805
LW		 4008}
4009
a0d0e21e 4010PP(pp_split)
79072805 4011{
39644a26 4012 dSP; dTARG;
a0d0e21e 4013 AV *ary;
467f0320 4014 register IV limit = POPi; /* note, negative is forever */
a0d0e21e
LW		 4015 SV *sv = POPs;
4016 STRLEN len;
4017 register char *s = SvPV(sv, len);
1aa99e6b 4018 bool do_utf8 = DO_UTF8(sv);
a0d0e21e 4019 char *strend = s + len;
44a8e56a 4020 register PMOP *pm;
d9f97599 4021 register REGEXP *rx;
a0d0e21e
LW		 4022 register SV *dstr;
4023 register char *m;
4024 I32 iters = 0;
792b2c16
JH		 4025 STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s);
4026 I32 maxiters = slen + 10;
a0d0e21e
LW		 4027 I32 i;
4028 char *orig;
4029 I32 origlimit = limit;
4030 I32 realarray = 0;
4031 I32 base;
3280af22 4032 AV *oldstack = PL_curstack;
54310121 4033 I32 gimme = GIMME_V;
3280af22 4034 I32 oldsave = PL_savestack_ix;
8ec5e241
NIS		 4035 I32 make_mortal = 1;
4036 MAGIC *mg = (MAGIC *) NULL;
79072805 4037
44a8e56a 4038#ifdef DEBUGGING
4039 Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
4040#else
4041 pm = (PMOP*)POPs;
4042#endif
a0d0e21e 4043 if (!pm || !s)
2269b42e 4044 DIE(aTHX_ "panic: pp_split");
d9f97599 4045 rx = pm->op_pmregexp;
bbce6d69 4046
4047 TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
4048 (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
4049
971a9dd3
GS		 4050 if (pm->op_pmreplroot) {
4051#ifdef USE_ITHREADS
4052 ary = GvAVn((GV*)PL_curpad[(PADOFFSET)pm->op_pmreplroot]);
4053#else
a0d0e21e 4054 ary = GvAVn((GV*)pm->op_pmreplroot);
971a9dd3
GS		 4055#endif
4056 }
a0d0e21e 4057 else if (gimme != G_ARRAY)
6d4ff0d2 4058#ifdef USE_THREADS
533c011a 4059 ary = (AV*)PL_curpad[0];
6d4ff0d2 4060#else
3280af22 4061 ary = GvAVn(PL_defgv);
6d4ff0d2 4062#endif /* USE_THREADS */
79072805 4063 else
a0d0e21e
LW		 4064 ary = Nullav;
4065 if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
4066 realarray = 1;
8ec5e241 4067 PUTBACK;
a0d0e21e
LW		 4068 av_extend(ary,0);
4069 av_clear(ary);
8ec5e241 4070 SPAGAIN;
14befaf4 4071 if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
8ec5e241 4072 PUSHMARK(SP);
33c27489 4073 XPUSHs(SvTIED_obj((SV*)ary, mg));
8ec5e241
NIS		 4074 }
4075 else {
1c0b011c
NIS		 4076 if (!AvREAL(ary)) {
4077 AvREAL_on(ary);
abff13bb 4078 AvREIFY_off(ary);
1c0b011c 4079 for (i = AvFILLp(ary); i >= 0; i--)
3280af22 4080 AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */
1c0b011c
NIS		 4081 }
4082 /* temporarily switch stacks */
3280af22 4083 SWITCHSTACK(PL_curstack, ary);
8ec5e241 4084 make_mortal = 0;
1c0b011c 4085 }
79072805 4086 }
3280af22 4087 base = SP - PL_stack_base;
a0d0e21e
LW		 4088 orig = s;
4089 if (pm->op_pmflags & PMf_SKIPWHITE) {
bbce6d69 4090 if (pm->op_pmflags & PMf_LOCALE) {
4091 while (isSPACE_LC(*s))
4092 s++;
4093 }
4094 else {
4095 while (isSPACE(*s))
4096 s++;
4097 }
a0d0e21e 4098 }
c07a80fd 4099 if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
3280af22
NIS		 4100 SAVEINT(PL_multiline);
4101 PL_multiline = pm->op_pmflags & PMf_MULTILINE;
c07a80fd 4102 }
4103
a0d0e21e
LW		 4104 if (!limit)
4105 limit = maxiters + 2;
4106 if (pm->op_pmflags & PMf_WHITE) {
4107 while (--limit) {
bbce6d69 4108 m = s;
4109 while (m < strend &&
4110 !((pm->op_pmflags & PMf_LOCALE)
4111 ? isSPACE_LC(*m) : isSPACE(*m)))
4112 ++m;
a0d0e21e
LW		 4113 if (m >= strend)
4114 break;
bbce6d69 4115
a0d0e21e
LW		 4116 dstr = NEWSV(30, m-s);
4117 sv_setpvn(dstr, s, m-s);
8ec5e241 4118 if (make_mortal)
a0d0e21e 4119 sv_2mortal(dstr);
792b2c16 4120 if (do_utf8)
28cb3359 4121 (void)SvUTF8_on(dstr);
a0d0e21e 4122 XPUSHs(dstr);
bbce6d69 4123
4124 s = m + 1;
4125 while (s < strend &&
4126 ((pm->op_pmflags & PMf_LOCALE)
4127 ? isSPACE_LC(*s) : isSPACE(*s)))
4128 ++s;
79072805
LW		 4129 }
4130 }
f4091fba 4131 else if (strEQ("^", rx->precomp)) {
a0d0e21e
LW		 4132 while (--limit) {
4133 /*SUPPRESS 530*/
4134 for (m = s; m < strend && *m != '\n'; m++) ;
4135 m++;
4136 if (m >= strend)
4137 break;
4138 dstr = NEWSV(30, m-s);
4139 sv_setpvn(dstr, s, m-s);
8ec5e241 4140 if (make_mortal)
a0d0e21e 4141 sv_2mortal(dstr);
792b2c16 4142 if (do_utf8)
28cb3359 4143 (void)SvUTF8_on(dstr);
a0d0e21e
LW		 4144 XPUSHs(dstr);
4145 s = m;
4146 }
4147 }
699c3c34
JH		 4148 else if (do_utf8 == ((rx->reganch & ROPT_UTF8) != 0) &&
4149 (rx->reganch & RE_USE_INTUIT) && !rx->nparens
d9f97599
GS		 4150 && (rx->reganch & ROPT_CHECK_ALL)
4151 && !(rx->reganch & ROPT_ANCH)) {
f722798b
IZ		 4152 int tail = (rx->reganch & RE_INTUIT_TAIL);
4153 SV *csv = CALLREG_INTUIT_STRING(aTHX_ rx);
cf93c79d 4154
ca5b42cb 4155 len = rx->minlen;
1aa99e6b 4156 if (len == 1 && !(rx->reganch & ROPT_UTF8) && !tail) {
93f04dac
JH		 4157 STRLEN n_a;
4158 char c = *SvPV(csv, n_a);
a0d0e21e 4159 while (--limit) {
bbce6d69 4160 /*SUPPRESS 530*/
f722798b 4161 for (m = s; m < strend && *m != c; m++) ;
a0d0e21e
LW		 4162 if (m >= strend)
4163 break;
4164 dstr = NEWSV(30, m-s);
4165 sv_setpvn(dstr, s, m-s);
8ec5e241 4166 if (make_mortal)
a0d0e21e 4167 sv_2mortal(dstr);
792b2c16 4168 if (do_utf8)
28cb3359 4169 (void)SvUTF8_on(dstr);
a0d0e21e 4170 XPUSHs(dstr);
93f04dac
JH		 4171 /* The rx->minlen is in characters but we want to step
4172 * s ahead by bytes. */
1aa99e6b
IH		 4173 if (do_utf8)
4174 s = (char*)utf8_hop((U8*)m, len);
4175 else
4176 s = m + len; /* Fake \n at the end */
a0d0e21e
LW		 4177 }
4178 }
4179 else {
4180#ifndef lint
4181 while (s < strend && --limit &&
f722798b
IZ		 4182 (m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
4183 csv, PL_multiline ? FBMrf_MULTILINE : 0)) )
79072805 4184#endif
a0d0e21e
LW		 4185 {
4186 dstr = NEWSV(31, m-s);
4187 sv_setpvn(dstr, s, m-s);
8ec5e241 4188 if (make_mortal)
a0d0e21e 4189 sv_2mortal(dstr);
792b2c16 4190 if (do_utf8)
28cb3359 4191 (void)SvUTF8_on(dstr);
a0d0e21e 4192 XPUSHs(dstr);
93f04dac
JH		 4193 /* The rx->minlen is in characters but we want to step
4194 * s ahead by bytes. */
1aa99e6b
IH		 4195 if (do_utf8)
4196 s = (char*)utf8_hop((U8*)m, len);
4197 else
4198 s = m + len; /* Fake \n at the end */
a0d0e21e 4199 }
463ee0b2 4200 }
463ee0b2 4201 }
a0d0e21e 4202 else {
792b2c16 4203 maxiters += slen * rx->nparens;
f722798b 4204 while (s < strend && --limit
b13b2135 4205/* && (!rx->check_substr
f722798b
IZ		 4206 || ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend,
4207 0, NULL))))
4208*/ && CALLREGEXEC(aTHX_ rx, s, strend, orig,
4209 1 /* minend */, sv, NULL, 0))
bbce6d69 4210 {
d9f97599 4211 TAINT_IF(RX_MATCH_TAINTED(rx));
cf93c79d 4212 if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
a0d0e21e
LW		 4213 m = s;
4214 s = orig;
cf93c79d 4215 orig = rx->subbeg;
a0d0e21e
LW		 4216 s = orig + (m - s);
4217 strend = s + (strend - m);
4218 }
cf93c79d 4219 m = rx->startp[0] + orig;
a0d0e21e
LW		 4220 dstr = NEWSV(32, m-s);
4221 sv_setpvn(dstr, s, m-s);
8ec5e241 4222 if (make_mortal)
a0d0e21e 4223 sv_2mortal(dstr);
792b2c16 4224 if (do_utf8)
28cb3359 4225 (void)SvUTF8_on(dstr);
a0d0e21e 4226 XPUSHs(dstr);
d9f97599
GS		 4227 if (rx->nparens) {
4228 for (i = 1; i <= rx->nparens; i++) {
cf93c79d
IZ		 4229 s = rx->startp[i] + orig;
4230 m = rx->endp[i] + orig;
748a9306
LW		 4231 if (m && s) {
4232 dstr = NEWSV(33, m-s);
4233 sv_setpvn(dstr, s, m-s);
4234 }
4235 else
4236 dstr = NEWSV(33, 0);
8ec5e241 4237 if (make_mortal)
a0d0e21e 4238 sv_2mortal(dstr);
792b2c16 4239 if (do_utf8)
28cb3359 4240 (void)SvUTF8_on(dstr);
a0d0e21e
LW		 4241 XPUSHs(dstr);
4242 }
4243 }
cf93c79d 4244 s = rx->endp[0] + orig;
a0d0e21e 4245 }
79072805 4246 }
8ec5e241 4247
c07a80fd 4248 LEAVE_SCOPE(oldsave);
3280af22 4249 iters = (SP - PL_stack_base) - base;
a0d0e21e 4250 if (iters > maxiters)
cea2e8a9 4251 DIE(aTHX_ "Split loop");
8ec5e241 4252
a0d0e21e
LW		 4253 /* keep field after final delim? */
4254 if (s < strend || (iters && origlimit)) {
93f04dac
JH		 4255 STRLEN l = strend - s;
4256 dstr = NEWSV(34, l);
4257 sv_setpvn(dstr, s, l);
8ec5e241 4258 if (make_mortal)
a0d0e21e 4259 sv_2mortal(dstr);
792b2c16 4260 if (do_utf8)
28cb3359 4261 (void)SvUTF8_on(dstr);
a0d0e21e
LW		 4262 XPUSHs(dstr);
4263 iters++;
79072805 4264 }
a0d0e21e 4265 else if (!origlimit) {
b1dadf13 4266 while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
a0d0e21e
LW		 4267 iters--, SP--;
4268 }
8ec5e241 4269
a0d0e21e 4270 if (realarray) {
8ec5e241 4271 if (!mg) {
1c0b011c
NIS		 4272 SWITCHSTACK(ary, oldstack);
4273 if (SvSMAGICAL(ary)) {
4274 PUTBACK;
4275 mg_set((SV*)ary);
4276 SPAGAIN;
4277 }
4278 if (gimme == G_ARRAY) {
4279 EXTEND(SP, iters);
4280 Copy(AvARRAY(ary), SP + 1, iters, SV*);
4281 SP += iters;
4282 RETURN;
4283 }
8ec5e241 4284 }
1c0b011c 4285 else {
fb73857a 4286 PUTBACK;
8ec5e241 4287 ENTER;
864dbfa3 4288 call_method("PUSH",G_SCALAR|G_DISCARD);
8ec5e241 4289 LEAVE;
fb73857a 4290 SPAGAIN;
8ec5e241
NIS		 4291 if (gimme == G_ARRAY) {
4292 /* EXTEND should not be needed - we just popped them */
4293 EXTEND(SP, iters);
4294 for (i=0; i < iters; i++) {
4295 SV **svp = av_fetch(ary, i, FALSE);
3280af22 4296 PUSHs((svp) ? *svp : &PL_sv_undef);
8ec5e241 4297 }
1c0b011c
NIS		 4298 RETURN;
4299 }
a0d0e21e
LW		 4300 }
4301 }
4302 else {
4303 if (gimme == G_ARRAY)
4304 RETURN;
4305 }
4306 if (iters || !pm->op_pmreplroot) {
4307 GETTARGET;
4308 PUSHi(iters);
4309 RETURN;
4310 }
4311 RETPUSHUNDEF;
79072805 4312}
85e6fe83 4313
c0329465 4314#ifdef USE_THREADS
77a005ab 4315void
864dbfa3 4316Perl_unlock_condpair(pTHX_ void *svv)
c0329465 4317{
14befaf4 4318 MAGIC *mg = mg_find((SV*)svv, PERL_MAGIC_mutex);
8ec5e241 4319
c0329465 4320 if (!mg)
cea2e8a9 4321 Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex");
c0329465
MB		 4322 MUTEX_LOCK(MgMUTEXP(mg));
4323 if (MgOWNER(mg) != thr)
cea2e8a9 4324 Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own");
c0329465
MB		 4325 MgOWNER(mg) = 0;
4326 COND_SIGNAL(MgOWNERCONDP(mg));
b900a521
JH		 4327 DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n",
4328 PTR2UV(thr), PTR2UV(svv));)
c0329465
MB		 4329 MUTEX_UNLOCK(MgMUTEXP(mg));
4330}
4331#endif /* USE_THREADS */
4332
4333PP(pp_lock)
4334{
39644a26 4335 dSP;
c0329465 4336 dTOPss;
e55aaa0e
MB		 4337 SV *retsv = sv;
4338#ifdef USE_THREADS
4755096e 4339 sv_lock(sv);
c0329465 4340#endif /* USE_THREADS */
e55aaa0e
MB		 4341 if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
4342 || SvTYPE(retsv) == SVt_PVCV) {
4343 retsv = refto(retsv);
4344 }
4345 SETs(retsv);
c0329465
MB		 4346 RETURN;
4347}
a863c7d1 4348
2faa37cc 4349PP(pp_threadsv)
a863c7d1 4350{
57d3b86d 4351#ifdef USE_THREADS
39644a26 4352 dSP;
924508f0 4353 EXTEND(SP, 1);
533c011a
NIS		 4354 if (PL_op->op_private & OPpLVAL_INTRO)
4355 PUSHs(*save_threadsv(PL_op->op_targ));
554b3eca 4356 else
533c011a 4357 PUSHs(THREADSV(PL_op->op_targ));
fdb47d66 4358 RETURN;
a863c7d1 4359#else
cea2e8a9 4360 DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
a863c7d1 4361#endif /* USE_THREADS */
a863c7d1 4362}
Unnamed repository; edit this file 'description' to name the repository.