This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Configure blooper
[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
PP
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
PP
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
PP
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
PP
291 if (SvTYPE(TARG) < SVt_PVLV) {
292 sv_upgrade(TARG, SVt_PVLV);
14befaf4 293 sv_magic(TARG, Nullsv, PERL_MAGIC_pos, Nullch, 0);
5f05dabc
PP
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
PP
347PP(pp_prototype)
348{
39644a26 349 dSP;
c07a80fd
PP
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
PP
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
PP
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
PP
453{
454 SV* rv;
455
456 if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
457 if (LvTARGLEN(sv))
68dc0745
PP
458 vivify_defelem(sv);
459 if (!(sv = LvTARG(sv)))
3280af22 460 sv = &PL_sv_undef;
0dd88869 461 else
a6c40364 462 (void)SvREFCNT_inc(sv);
71be2cbc 463 }
d8b46c1b
GS
464 else if (SvTYPE(sv) == SVt_PVAV) {
465 if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv))
466 av_reify((AV*)sv);
467 SvTEMP_off(sv);
468 (void)SvREFCNT_inc(sv);
469 }
f2933f5f
DM
470 else if (SvPADTMP(sv) && !IS_PADGV(sv))
471 sv = newSVsv(sv);
71be2cbc
PP
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
PP
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
PP
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
PP
541 sv = Nullsv;
542 switch (elem ? *elem : '\0')
543 {
544 case 'A':
545 if (strEQ(elem, "ARRAY"))
76e3520e 546 tmpRef = (SV*)GvAV(gv);
fb73857a
PP
547 break;
548 case 'C':
549 if (strEQ(elem, "CODE"))
76e3520e 550 tmpRef = (SV*)GvCVu(gv);
fb73857a
PP
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
PP
558 break;
559 case 'G':
560 if (strEQ(elem, "GLOB"))
76e3520e 561 tmpRef = (SV*)gv;
fb73857a
PP
562 break;
563 case 'H':
564 if (strEQ(elem, "HASH"))
76e3520e 565 tmpRef = (SV*)GvHV(gv);
fb73857a
PP
566 break;
567 case 'I':
568 if (strEQ(elem, "IO"))
76e3520e 569 tmpRef = (SV*)GvIOp(gv);
fb73857a
PP
570 break;
571 case 'N':
572 if (strEQ(elem, "NAME"))
79cb57f6 573 sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv));
fb73857a
PP
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
PP
582 break;
583 }
76e3520e
GS
584 if (tmpRef)
585 sv = newRV(tmpRef);
fb73857a
PP
586 if (sv)
587 sv_2mortal(sv);
588 else
3280af22 589 sv = &PL_sv_undef;
fb73857a
PP
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
PP
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
PP
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
PP
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
PP
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
PP
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
PP
857 SvIVX(TOPs) != IV_MIN)
858 {
748a9306 859 --SvIVX(TOPs);
55497cff 860 SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
748a9306
LW
861 }
862 else
863 sv_dec(TOPs);
a0d0e21e
LW
864 SvSETMAGIC(TOPs);
865 SETs(TARG);
866 return NORMAL;
867}
79072805 868
a0d0e21e
LW
869/* Ordinary operators. */
870
871PP(pp_pow)
872{
39644a26 873 dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
a0d0e21e
LW
874 {
875 dPOPTOPnnrl;
73b309ea 876 SETn( Perl_pow( left, right) );
a0d0e21e 877 RETURN;
93a17b20 878 }
a0d0e21e
LW
879}
880
881PP(pp_multiply)
882{
39644a26 883 dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
28e5dec8
JH
884#ifdef PERL_PRESERVE_IVUV
885 SvIV_please(TOPs);
886 if (SvIOK(TOPs)) {
887 /* Unless the left argument is integer in range we are going to have to
888 use NV maths. Hence only attempt to coerce the right argument if
889 we know the left is integer. */
890 /* Left operand is defined, so is it IV? */
891 SvIV_please(TOPm1s);
892 if (SvIOK(TOPm1s)) {
893 bool auvok = SvUOK(TOPm1s);
894 bool buvok = SvUOK(TOPs);
895 const UV topmask = (~ (UV)0) << (4 * sizeof (UV));
896 const UV botmask = ~((~ (UV)0) << (4 * sizeof (UV)));
897 UV alow;
898 UV ahigh;
899 UV blow;
900 UV bhigh;
901
902 if (auvok) {
903 alow = SvUVX(TOPm1s);
904 } else {
905 IV aiv = SvIVX(TOPm1s);
906 if (aiv >= 0) {
907 alow = aiv;
908 auvok = TRUE; /* effectively it's a UV now */
909 } else {
910 alow = -aiv; /* abs, auvok == false records sign */
911 }
912 }
913 if (buvok) {
914 blow = SvUVX(TOPs);
915 } else {
916 IV biv = SvIVX(TOPs);
917 if (biv >= 0) {
918 blow = biv;
919 buvok = TRUE; /* effectively it's a UV now */
920 } else {
921 blow = -biv; /* abs, buvok == false records sign */
922 }
923 }
924
925 /* If this does sign extension on unsigned it's time for plan B */
926 ahigh = alow >> (4 * sizeof (UV));
927 alow &= botmask;
928 bhigh = blow >> (4 * sizeof (UV));
929 blow &= botmask;
930 if (ahigh && bhigh) {
931 /* eg 32 bit is at least 0x10000 * 0x10000 == 0x100000000
932 which is overflow. Drop to NVs below. */
933 } else if (!ahigh && !bhigh) {
934 /* eg 32 bit is at most 0xFFFF * 0xFFFF == 0xFFFE0001
935 so the unsigned multiply cannot overflow. */
936 UV product = alow * blow;
937 if (auvok == buvok) {
938 /* -ve * -ve or +ve * +ve gives a +ve result. */
939 SP--;
940 SETu( product );
941 RETURN;
942 } else if (product <= (UV)IV_MIN) {
943 /* 2s complement assumption that (UV)-IV_MIN is correct. */
944 /* -ve result, which could overflow an IV */
945 SP--;
25716404 946 SETi( -(IV)product );
28e5dec8
JH
947 RETURN;
948 } /* else drop to NVs below. */
949 } else {
950 /* One operand is large, 1 small */
951 UV product_middle;
952 if (bhigh) {
953 /* swap the operands */
954 ahigh = bhigh;
955 bhigh = blow; /* bhigh now the temp var for the swap */
956 blow = alow;
957 alow = bhigh;
958 }
959 /* now, ((ahigh * blow) << half_UV_len) + (alow * blow)
960 multiplies can't overflow. shift can, add can, -ve can. */
961 product_middle = ahigh * blow;
962 if (!(product_middle & topmask)) {
963 /* OK, (ahigh * blow) won't lose bits when we shift it. */
964 UV product_low;
965 product_middle <<= (4 * sizeof (UV));
966 product_low = alow * blow;
967
968 /* as for pp_add, UV + something mustn't get smaller.
969 IIRC ANSI mandates this wrapping *behaviour* for
970 unsigned whatever the actual representation*/
971 product_low += product_middle;
972 if (product_low >= product_middle) {
973 /* didn't overflow */
974 if (auvok == buvok) {
975 /* -ve * -ve or +ve * +ve gives a +ve result. */
976 SP--;
977 SETu( product_low );
978 RETURN;
979 } else if (product_low <= (UV)IV_MIN) {
980 /* 2s complement assumption again */
981 /* -ve result, which could overflow an IV */
982 SP--;
25716404 983 SETi( -(IV)product_low );
28e5dec8
JH
984 RETURN;
985 } /* else drop to NVs below. */
986 }
987 } /* product_middle too large */
988 } /* ahigh && bhigh */
989 } /* SvIOK(TOPm1s) */
990 } /* SvIOK(TOPs) */
991#endif
a0d0e21e
LW
992 {
993 dPOPTOPnnrl;
994 SETn( left * right );
995 RETURN;
79072805 996 }
a0d0e21e
LW
997}
998
999PP(pp_divide)
1000{
39644a26 1001 dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
a0d0e21e 1002 {
77676ba1 1003 dPOPPOPnnrl;
65202027 1004 NV value;
7a4c00b4 1005 if (right == 0.0)
cea2e8a9 1006 DIE(aTHX_ "Illegal division by zero");
a0d0e21e
LW
1007#ifdef SLOPPYDIVIDE
1008 /* insure that 20./5. == 4. */
1009 {
7a4c00b4 1010 IV k;
65202027
DS
1011 if ((NV)I_V(left) == left &&
1012 (NV)I_V(right) == right &&
7a4c00b4 1013 (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
a0d0e21e 1014 value = k;
ef54e1a4
JH
1015 }
1016 else {
7a4c00b4 1017 value = left / right;
79072805 1018 }
a0d0e21e
LW
1019 }
1020#else
7a4c00b4 1021 value = left / right;
a0d0e21e
LW
1022#endif
1023 PUSHn( value );
1024 RETURN;
79072805 1025 }
a0d0e21e
LW
1026}
1027
1028PP(pp_modulo)
1029{
39644a26 1030 dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
a0d0e21e 1031 {
9c5ffd7c
JH
1032 UV left = 0;
1033 UV right = 0;
787eafbd
IZ
1034 bool left_neg;
1035 bool right_neg;
1036 bool use_double = 0;
9c5ffd7c
JH
1037 NV dright = 0.0;
1038 NV dleft = 0.0;
787eafbd 1039
d658dc55 1040 if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
787eafbd
IZ
1041 IV i = SvIVX(POPs);
1042 right = (right_neg = (i < 0)) ? -i : i;
1043 }
1044 else {
1045 dright = POPn;
1046 use_double = 1;
1047 right_neg = dright < 0;
1048 if (right_neg)
1049 dright = -dright;
1050 }
a0d0e21e 1051
d658dc55 1052 if (!use_double && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
787eafbd
IZ
1053 IV i = SvIVX(POPs);
1054 left = (left_neg = (i < 0)) ? -i : i;
1055 }
1056 else {
1057 dleft = POPn;
1058 if (!use_double) {
a1bd196e
GS
1059 use_double = 1;
1060 dright = right;
787eafbd
IZ
1061 }
1062 left_neg = dleft < 0;
1063 if (left_neg)
1064 dleft = -dleft;
1065 }
68dc0745 1066
787eafbd 1067 if (use_double) {
65202027 1068 NV dans;
787eafbd
IZ
1069
1070#if 1
787eafbd
IZ
1071/* Somehow U_V is pessimized even if CASTFLAGS is 0 */
1072# if CASTFLAGS & 2
1073# define CAST_D2UV(d) U_V(d)
1074# else
1075# define CAST_D2UV(d) ((UV)(d))
1076# endif
a1bd196e
GS
1077 /* Tried to do this only in the case DOUBLESIZE <= UV_SIZE,
1078 * or, in other words, precision of UV more than of NV.
1079 * But in fact the approach below turned out to be an
1080 * optimization - floor() may be slow */
787eafbd
IZ
1081 if (dright <= UV_MAX && dleft <= UV_MAX) {
1082 right = CAST_D2UV(dright);
1083 left = CAST_D2UV(dleft);
1084 goto do_uv;
1085 }
1086#endif
1087
1088 /* Backward-compatibility clause: */
73b309ea
JH
1089 dright = Perl_floor(dright + 0.5);
1090 dleft = Perl_floor(dleft + 0.5);
787eafbd
IZ
1091
1092 if (!dright)
cea2e8a9 1093 DIE(aTHX_ "Illegal modulus zero");
787eafbd 1094
65202027 1095 dans = Perl_fmod(dleft, dright);
787eafbd
IZ
1096 if ((left_neg != right_neg) && dans)
1097 dans = dright - dans;
1098 if (right_neg)
1099 dans = -dans;
1100 sv_setnv(TARG, dans);
1101 }
1102 else {
1103 UV ans;
1104
1105 do_uv:
1106 if (!right)
cea2e8a9 1107 DIE(aTHX_ "Illegal modulus zero");
787eafbd
IZ
1108
1109 ans = left % right;
1110 if ((left_neg != right_neg) && ans)
1111 ans = right - ans;
1112 if (right_neg) {
1113 /* XXX may warn: unary minus operator applied to unsigned type */
1114 /* could change -foo to be (~foo)+1 instead */
1115 if (ans <= ~((UV)IV_MAX)+1)
1116 sv_setiv(TARG, ~ans+1);
1117 else
65202027 1118 sv_setnv(TARG, -(NV)ans);
787eafbd
IZ
1119 }
1120 else
1121 sv_setuv(TARG, ans);
1122 }
1123 PUSHTARG;
1124 RETURN;
79072805 1125 }
a0d0e21e 1126}
79072805 1127
a0d0e21e
LW
1128PP(pp_repeat)
1129{
39644a26 1130 dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
748a9306 1131 {
467f0320 1132 register IV count = POPi;
533c011a 1133 if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
a0d0e21e
LW
1134 dMARK;
1135 I32 items = SP - MARK;
1136 I32 max;
79072805 1137
a0d0e21e
LW
1138 max = items * count;
1139 MEXTEND(MARK, max);
1140 if (count > 1) {
1141 while (SP > MARK) {
e30acc16
RH
1142 if (*SP) {
1143 *SP = sv_2mortal(newSVsv(*SP));
1144 SvREADONLY_on(*SP);
1145 }
a0d0e21e 1146 SP--;
79072805 1147 }
a0d0e21e
LW
1148 MARK++;
1149 repeatcpy((char*)(MARK + items), (char*)MARK,
1150 items * sizeof(SV*), count - 1);
1151 SP += max;
79072805 1152 }
a0d0e21e
LW
1153 else if (count <= 0)
1154 SP -= items;
79072805 1155 }
a0d0e21e 1156 else { /* Note: mark already snarfed by pp_list */
dfcb284a 1157 SV *tmpstr = POPs;
a0d0e21e 1158 STRLEN len;
9b877dbb 1159 bool isutf;
a0d0e21e 1160
a0d0e21e
LW
1161 SvSetSV(TARG, tmpstr);
1162 SvPV_force(TARG, len);
9b877dbb 1163 isutf = DO_UTF8(TARG);
8ebc5c01
PP
1164 if (count != 1) {
1165 if (count < 1)
1166 SvCUR_set(TARG, 0);
1167 else {
1168 SvGROW(TARG, (count * len) + 1);
a0d0e21e 1169 repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
8ebc5c01 1170 SvCUR(TARG) *= count;
7a4c00b4 1171 }
a0d0e21e 1172 *SvEND(TARG) = '\0';
a0d0e21e 1173 }
dfcb284a
GS
1174 if (isutf)
1175 (void)SvPOK_only_UTF8(TARG);
1176 else
1177 (void)SvPOK_only(TARG);
b80b6069
RH
1178
1179 if (PL_op->op_private & OPpREPEAT_DOLIST) {
1180 /* The parser saw this as a list repeat, and there
1181 are probably several items on the stack. But we're
1182 in scalar context, and there's no pp_list to save us
1183 now. So drop the rest of the items -- robin@kitsite.com
1184 */
1185 dMARK;
1186 SP = MARK;
1187 }
a0d0e21e 1188 PUSHTARG;
79072805 1189 }
a0d0e21e 1190 RETURN;
748a9306 1191 }
a0d0e21e 1192}
79072805 1193
a0d0e21e
LW
1194PP(pp_subtract)
1195{
39644a26 1196 dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
28e5dec8
JH
1197 useleft = USE_LEFT(TOPm1s);
1198#ifdef PERL_PRESERVE_IVUV
7dca457a
NC
1199 /* See comments in pp_add (in pp_hot.c) about Overflow, and how
1200 "bad things" happen if you rely on signed integers wrapping. */
28e5dec8
JH
1201 SvIV_please(TOPs);
1202 if (SvIOK(TOPs)) {
1203 /* Unless the left argument is integer in range we are going to have to
1204 use NV maths. Hence only attempt to coerce the right argument if
1205 we know the left is integer. */
9c5ffd7c
JH
1206 register UV auv = 0;
1207 bool auvok = FALSE;
7dca457a
NC
1208 bool a_valid = 0;
1209
28e5dec8 1210 if (!useleft) {
7dca457a
NC
1211 auv = 0;
1212 a_valid = auvok = 1;
1213 /* left operand is undef, treat as zero. */
28e5dec8
JH
1214 } else {
1215 /* Left operand is defined, so is it IV? */
1216 SvIV_please(TOPm1s);
1217 if (SvIOK(TOPm1s)) {
7dca457a
NC
1218 if ((auvok = SvUOK(TOPm1s)))
1219 auv = SvUVX(TOPm1s);
1220 else {
1221 register IV aiv = SvIVX(TOPm1s);
1222 if (aiv >= 0) {
1223 auv = aiv;
1224 auvok = 1; /* Now acting as a sign flag. */
1225 } else { /* 2s complement assumption for IV_MIN */
1226 auv = (UV)-aiv;
28e5dec8 1227 }
7dca457a
NC
1228 }
1229 a_valid = 1;
1230 }
1231 }
1232 if (a_valid) {
1233 bool result_good = 0;
1234 UV result;
1235 register UV buv;
1236 bool buvok = SvUOK(TOPs);
9041c2e3 1237
7dca457a
NC
1238 if (buvok)
1239 buv = SvUVX(TOPs);
1240 else {
1241 register IV biv = SvIVX(TOPs);
1242 if (biv >= 0) {
1243 buv = biv;
1244 buvok = 1;
1245 } else
1246 buv = (UV)-biv;
1247 }
1248 /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
1249 else "IV" now, independant of how it came in.
1250 if a, b represents positive, A, B negative, a maps to -A etc
1251 a - b => (a - b)
1252 A - b => -(a + b)
1253 a - B => (a + b)
1254 A - B => -(a - b)
1255 all UV maths. negate result if A negative.
1256 subtract if signs same, add if signs differ. */
1257
1258 if (auvok ^ buvok) {
1259 /* Signs differ. */
1260 result = auv + buv;
1261 if (result >= auv)
1262 result_good = 1;
1263 } else {
1264 /* Signs same */
1265 if (auv >= buv) {
1266 result = auv - buv;
1267 /* Must get smaller */
1268 if (result <= auv)
1269 result_good = 1;
1270 } else {
1271 result = buv - auv;
1272 if (result <= buv) {
1273 /* result really should be -(auv-buv). as its negation
1274 of true value, need to swap our result flag */
1275 auvok = !auvok;
1276 result_good = 1;
28e5dec8 1277 }
28e5dec8
JH
1278 }
1279 }
7dca457a
NC
1280 if (result_good) {
1281 SP--;
1282 if (auvok)
1283 SETu( result );
1284 else {
1285 /* Negate result */
1286 if (result <= (UV)IV_MIN)
1287 SETi( -(IV)result );
1288 else {
1289 /* result valid, but out of range for IV. */
1290 SETn( -(NV)result );
1291 }
1292 }
1293 RETURN;
1294 } /* Overflow, drop through to NVs. */
28e5dec8
JH
1295 }
1296 }
1297#endif
7dca457a 1298 useleft = USE_LEFT(TOPm1s);
a0d0e21e 1299 {
28e5dec8
JH
1300 dPOPnv;
1301 if (!useleft) {
1302 /* left operand is undef, treat as zero - value */
1303 SETn(-value);
1304 RETURN;
1305 }
1306 SETn( TOPn - value );
1307 RETURN;
79072805 1308 }
a0d0e21e 1309}
79072805 1310
a0d0e21e
LW
1311PP(pp_left_shift)
1312{
39644a26 1313 dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
a0d0e21e 1314 {
972b05a9 1315 IV shift = POPi;
d0ba1bd2 1316 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
1317 IV i = TOPi;
1318 SETi(i << shift);
d0ba1bd2
JH
1319 }
1320 else {
972b05a9
JH
1321 UV u = TOPu;
1322 SETu(u << shift);
d0ba1bd2 1323 }
55497cff 1324 RETURN;
79072805 1325 }
a0d0e21e 1326}
79072805 1327
a0d0e21e
LW
1328PP(pp_right_shift)
1329{
39644a26 1330 dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
a0d0e21e 1331 {
972b05a9 1332 IV shift = POPi;
d0ba1bd2 1333 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
1334 IV i = TOPi;
1335 SETi(i >> shift);
d0ba1bd2
JH
1336 }
1337 else {
972b05a9
JH
1338 UV u = TOPu;
1339 SETu(u >> shift);
d0ba1bd2 1340 }
a0d0e21e 1341 RETURN;
93a17b20 1342 }
79072805
LW
1343}
1344
a0d0e21e 1345PP(pp_lt)
79072805 1346{
39644a26 1347 dSP; tryAMAGICbinSET(lt,0);
28e5dec8
JH
1348#ifdef PERL_PRESERVE_IVUV
1349 SvIV_please(TOPs);
1350 if (SvIOK(TOPs)) {
1351 SvIV_please(TOPm1s);
1352 if (SvIOK(TOPm1s)) {
1353 bool auvok = SvUOK(TOPm1s);
1354 bool buvok = SvUOK(TOPs);
a227d84d 1355
28e5dec8
JH
1356 if (!auvok && !buvok) { /* ## IV < IV ## */
1357 IV aiv = SvIVX(TOPm1s);
1358 IV biv = SvIVX(TOPs);
1359
1360 SP--;
1361 SETs(boolSV(aiv < biv));
1362 RETURN;
1363 }
1364 if (auvok && buvok) { /* ## UV < UV ## */
1365 UV auv = SvUVX(TOPm1s);
1366 UV buv = SvUVX(TOPs);
1367
1368 SP--;
1369 SETs(boolSV(auv < buv));
1370 RETURN;
1371 }
1372 if (auvok) { /* ## UV < IV ## */
1373 UV auv;
1374 IV biv;
1375
1376 biv = SvIVX(TOPs);
1377 SP--;
1378 if (biv < 0) {
1379 /* As (a) is a UV, it's >=0, so it cannot be < */
1380 SETs(&PL_sv_no);
1381 RETURN;
1382 }
1383 auv = SvUVX(TOPs);
1384 if (auv >= (UV) IV_MAX) {
1385 /* As (b) is an IV, it cannot be > IV_MAX */
1386 SETs(&PL_sv_no);
1387 RETURN;
1388 }
1389 SETs(boolSV(auv < (UV)biv));
1390 RETURN;
1391 }
1392 { /* ## IV < UV ## */
1393 IV aiv;
1394 UV buv;
1395
1396 aiv = SvIVX(TOPm1s);
1397 if (aiv < 0) {
1398 /* As (b) is a UV, it's >=0, so it must be < */
1399 SP--;
1400 SETs(&PL_sv_yes);
1401 RETURN;
1402 }
1403 buv = SvUVX(TOPs);
1404 SP--;
1405 if (buv > (UV) IV_MAX) {
1406 /* As (a) is an IV, it cannot be > IV_MAX */
1407 SETs(&PL_sv_yes);
1408 RETURN;
1409 }
1410 SETs(boolSV((UV)aiv < buv));
1411 RETURN;
1412 }
1413 }
1414 }
1415#endif
a0d0e21e
LW
1416 {
1417 dPOPnv;
54310121 1418 SETs(boolSV(TOPn < value));
a0d0e21e 1419 RETURN;
79072805 1420 }
a0d0e21e 1421}
79072805 1422
a0d0e21e
LW
1423PP(pp_gt)
1424{
39644a26 1425 dSP; tryAMAGICbinSET(gt,0);
28e5dec8
JH
1426#ifdef PERL_PRESERVE_IVUV
1427 SvIV_please(TOPs);
1428 if (SvIOK(TOPs)) {
1429 SvIV_please(TOPm1s);
1430 if (SvIOK(TOPm1s)) {
1431 bool auvok = SvUOK(TOPm1s);
1432 bool buvok = SvUOK(TOPs);
a227d84d 1433
28e5dec8
JH
1434 if (!auvok && !buvok) { /* ## IV > IV ## */
1435 IV aiv = SvIVX(TOPm1s);
1436 IV biv = SvIVX(TOPs);
1437
1438 SP--;
1439 SETs(boolSV(aiv > biv));
1440 RETURN;
1441 }
1442 if (auvok && buvok) { /* ## UV > UV ## */
1443 UV auv = SvUVX(TOPm1s);
1444 UV buv = SvUVX(TOPs);
1445
1446 SP--;
1447 SETs(boolSV(auv > buv));
1448 RETURN;
1449 }
1450 if (auvok) { /* ## UV > IV ## */
1451 UV auv;
1452 IV biv;
1453
1454 biv = SvIVX(TOPs);
1455 SP--;
1456 if (biv < 0) {
1457 /* As (a) is a UV, it's >=0, so it must be > */
1458 SETs(&PL_sv_yes);
1459 RETURN;
1460 }
1461 auv = SvUVX(TOPs);
1462 if (auv > (UV) IV_MAX) {
1463 /* As (b) is an IV, it cannot be > IV_MAX */
1464 SETs(&PL_sv_yes);
1465 RETURN;
1466 }
1467 SETs(boolSV(auv > (UV)biv));
1468 RETURN;
1469 }
1470 { /* ## IV > UV ## */
1471 IV aiv;
1472 UV buv;
1473
1474 aiv = SvIVX(TOPm1s);
1475 if (aiv < 0) {
1476 /* As (b) is a UV, it's >=0, so it cannot be > */
1477 SP--;
1478 SETs(&PL_sv_no);
1479 RETURN;
1480 }
1481 buv = SvUVX(TOPs);
1482 SP--;
1483 if (buv >= (UV) IV_MAX) {
1484 /* As (a) is an IV, it cannot be > IV_MAX */
1485 SETs(&PL_sv_no);
1486 RETURN;
1487 }
1488 SETs(boolSV((UV)aiv > buv));
1489 RETURN;
1490 }
1491 }
1492 }
1493#endif
a0d0e21e
LW
1494 {
1495 dPOPnv;
54310121 1496 SETs(boolSV(TOPn > value));
a0d0e21e 1497 RETURN;
79072805 1498 }
a0d0e21e
LW
1499}
1500
1501PP(pp_le)
1502{
39644a26 1503 dSP; tryAMAGICbinSET(le,0);
28e5dec8
JH
1504#ifdef PERL_PRESERVE_IVUV
1505 SvIV_please(TOPs);
1506 if (SvIOK(TOPs)) {
1507 SvIV_please(TOPm1s);
1508 if (SvIOK(TOPm1s)) {
1509 bool auvok = SvUOK(TOPm1s);
1510 bool buvok = SvUOK(TOPs);
a227d84d 1511
28e5dec8
JH
1512 if (!auvok && !buvok) { /* ## IV <= IV ## */
1513 IV aiv = SvIVX(TOPm1s);
1514 IV biv = SvIVX(TOPs);
1515
1516 SP--;
1517 SETs(boolSV(aiv <= biv));
1518 RETURN;
1519 }
1520 if (auvok && buvok) { /* ## UV <= UV ## */
1521 UV auv = SvUVX(TOPm1s);
1522 UV buv = SvUVX(TOPs);
1523
1524 SP--;
1525 SETs(boolSV(auv <= buv));
1526 RETURN;
1527 }
1528 if (auvok) { /* ## UV <= IV ## */
1529 UV auv;
1530 IV biv;
1531
1532 biv = SvIVX(TOPs);
1533 SP--;
1534 if (biv < 0) {
1535 /* As (a) is a UV, it's >=0, so a cannot be <= */
1536 SETs(&PL_sv_no);
1537 RETURN;
1538 }
1539 auv = SvUVX(TOPs);
1540 if (auv > (UV) IV_MAX) {
1541 /* As (b) is an IV, it cannot be > IV_MAX */
1542 SETs(&PL_sv_no);
1543 RETURN;
1544 }
1545 SETs(boolSV(auv <= (UV)biv));
1546 RETURN;
1547 }
1548 { /* ## IV <= UV ## */
1549 IV aiv;
1550 UV buv;
1551
1552 aiv = SvIVX(TOPm1s);
1553 if (aiv < 0) {
1554 /* As (b) is a UV, it's >=0, so a must be <= */
1555 SP--;
1556 SETs(&PL_sv_yes);
1557 RETURN;
1558 }
1559 buv = SvUVX(TOPs);
1560 SP--;
1561 if (buv >= (UV) IV_MAX) {
1562 /* As (a) is an IV, it cannot be > IV_MAX */
1563 SETs(&PL_sv_yes);
1564 RETURN;
1565 }
1566 SETs(boolSV((UV)aiv <= buv));
1567 RETURN;
1568 }
1569 }
1570 }
1571#endif
a0d0e21e
LW
1572 {
1573 dPOPnv;
54310121 1574 SETs(boolSV(TOPn <= value));
a0d0e21e 1575 RETURN;
79072805 1576 }
a0d0e21e
LW
1577}
1578
1579PP(pp_ge)
1580{
39644a26 1581 dSP; tryAMAGICbinSET(ge,0);
28e5dec8
JH
1582#ifdef PERL_PRESERVE_IVUV
1583 SvIV_please(TOPs);
1584 if (SvIOK(TOPs)) {
1585 SvIV_please(TOPm1s);
1586 if (SvIOK(TOPm1s)) {
1587 bool auvok = SvUOK(TOPm1s);
1588 bool buvok = SvUOK(TOPs);
a227d84d 1589
28e5dec8
JH
1590 if (!auvok && !buvok) { /* ## IV >= IV ## */
1591 IV aiv = SvIVX(TOPm1s);
1592 IV biv = SvIVX(TOPs);
1593
1594 SP--;
1595 SETs(boolSV(aiv >= biv));
1596 RETURN;
1597 }
1598 if (auvok && buvok) { /* ## UV >= UV ## */
1599 UV auv = SvUVX(TOPm1s);
1600 UV buv = SvUVX(TOPs);
1601
1602 SP--;
1603 SETs(boolSV(auv >= buv));
1604 RETURN;
1605 }
1606 if (auvok) { /* ## UV >= IV ## */
1607 UV auv;
1608 IV biv;
1609
1610 biv = SvIVX(TOPs);
1611 SP--;
1612 if (biv < 0) {
1613 /* As (a) is a UV, it's >=0, so it must be >= */
1614 SETs(&PL_sv_yes);
1615 RETURN;
1616 }
1617 auv = SvUVX(TOPs);
1618 if (auv >= (UV) IV_MAX) {
1619 /* As (b) is an IV, it cannot be > IV_MAX */
1620 SETs(&PL_sv_yes);
1621 RETURN;
1622 }
1623 SETs(boolSV(auv >= (UV)biv));
1624 RETURN;
1625 }
1626 { /* ## IV >= UV ## */
1627 IV aiv;
1628 UV buv;
1629
1630 aiv = SvIVX(TOPm1s);
1631 if (aiv < 0) {
1632 /* As (b) is a UV, it's >=0, so a cannot be >= */
1633 SP--;
1634 SETs(&PL_sv_no);
1635 RETURN;
1636 }
1637 buv = SvUVX(TOPs);
1638 SP--;
1639 if (buv > (UV) IV_MAX) {
1640 /* As (a) is an IV, it cannot be > IV_MAX */
1641 SETs(&PL_sv_no);
1642 RETURN;
1643 }
1644 SETs(boolSV((UV)aiv >= buv));
1645 RETURN;
1646 }
1647 }
1648 }
1649#endif
a0d0e21e
LW
1650 {
1651 dPOPnv;
54310121 1652 SETs(boolSV(TOPn >= value));
a0d0e21e 1653 RETURN;
79072805 1654 }
a0d0e21e 1655}
79072805 1656
a0d0e21e
LW
1657PP(pp_ne)
1658{
16303949 1659 dSP; tryAMAGICbinSET(ne,0);
3bb2c415
JH
1660#ifndef NV_PRESERVES_UV
1661 if (SvROK(TOPs) && SvROK(TOPm1s)) {
c3e03cdf 1662 SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s)));
3bb2c415
JH
1663 RETURN;
1664 }
1665#endif
28e5dec8
JH
1666#ifdef PERL_PRESERVE_IVUV
1667 SvIV_please(TOPs);
1668 if (SvIOK(TOPs)) {
1669 SvIV_please(TOPm1s);
1670 if (SvIOK(TOPm1s)) {
1671 bool auvok = SvUOK(TOPm1s);
1672 bool buvok = SvUOK(TOPs);
a227d84d 1673
28e5dec8
JH
1674 if (!auvok && !buvok) { /* ## IV <=> IV ## */
1675 IV aiv = SvIVX(TOPm1s);
1676 IV biv = SvIVX(TOPs);
1677
1678 SP--;
1679 SETs(boolSV(aiv != biv));
1680 RETURN;
1681 }
1682 if (auvok && buvok) { /* ## UV != UV ## */
1683 UV auv = SvUVX(TOPm1s);
1684 UV buv = SvUVX(TOPs);
1685
1686 SP--;
1687 SETs(boolSV(auv != buv));
1688 RETURN;
1689 }
1690 { /* ## Mixed IV,UV ## */
1691 IV iv;
1692 UV uv;
1693
1694 /* != is commutative so swap if needed (save code) */
1695 if (auvok) {
1696 /* swap. top of stack (b) is the iv */
1697 iv = SvIVX(TOPs);
1698 SP--;
1699 if (iv < 0) {
1700 /* As (a) is a UV, it's >0, so it cannot be == */
1701 SETs(&PL_sv_yes);
1702 RETURN;
1703 }
1704 uv = SvUVX(TOPs);
1705 } else {
1706 iv = SvIVX(TOPm1s);
1707 SP--;
1708 if (iv < 0) {
1709 /* As (b) is a UV, it's >0, so it cannot be == */
1710 SETs(&PL_sv_yes);
1711 RETURN;
1712 }
1713 uv = SvUVX(*(SP+1)); /* Do I want TOPp1s() ? */
1714 }
1715 /* we know iv is >= 0 */
1716 if (uv > (UV) IV_MAX) {
1717 SETs(&PL_sv_yes);
1718 RETURN;
1719 }
1720 SETs(boolSV((UV)iv != uv));
1721 RETURN;
1722 }
1723 }
1724 }
1725#endif
a0d0e21e
LW
1726 {
1727 dPOPnv;
54310121 1728 SETs(boolSV(TOPn != value));
a0d0e21e
LW
1729 RETURN;
1730 }
79072805
LW
1731}
1732
a0d0e21e 1733PP(pp_ncmp)
79072805 1734{
39644a26 1735 dSP; dTARGET; tryAMAGICbin(ncmp,0);
d8c7644e
JH
1736#ifndef NV_PRESERVES_UV
1737 if (SvROK(TOPs) && SvROK(TOPm1s)) {
34d3ce40 1738 SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
d8c7644e
JH
1739 RETURN;
1740 }
1741#endif
28e5dec8
JH
1742#ifdef PERL_PRESERVE_IVUV
1743 /* Fortunately it seems NaN isn't IOK */
1744 SvIV_please(TOPs);
1745 if (SvIOK(TOPs)) {
1746 SvIV_please(TOPm1s);
1747 if (SvIOK(TOPm1s)) {
1748 bool leftuvok = SvUOK(TOPm1s);
1749 bool rightuvok = SvUOK(TOPs);
1750 I32 value;
1751 if (!leftuvok && !rightuvok) { /* ## IV <=> IV ## */
1752 IV leftiv = SvIVX(TOPm1s);
1753 IV rightiv = SvIVX(TOPs);
1754
1755 if (leftiv > rightiv)
1756 value = 1;
1757 else if (leftiv < rightiv)
1758 value = -1;
1759 else
1760 value = 0;
1761 } else if (leftuvok && rightuvok) { /* ## UV <=> UV ## */
1762 UV leftuv = SvUVX(TOPm1s);
1763 UV rightuv = SvUVX(TOPs);
1764
1765 if (leftuv > rightuv)
1766 value = 1;
1767 else if (leftuv < rightuv)
1768 value = -1;
1769 else
1770 value = 0;
1771 } else if (leftuvok) { /* ## UV <=> IV ## */
1772 UV leftuv;
1773 IV rightiv;
1774
1775 rightiv = SvIVX(TOPs);
1776 if (rightiv < 0) {
1777 /* As (a) is a UV, it's >=0, so it cannot be < */
1778 value = 1;
1779 } else {
1780 leftuv = SvUVX(TOPm1s);
1781 if (leftuv > (UV) IV_MAX) {
1782 /* As (b) is an IV, it cannot be > IV_MAX */
1783 value = 1;
1784 } else if (leftuv > (UV)rightiv) {
1785 value = 1;
1786 } else if (leftuv < (UV)rightiv) {
1787 value = -1;
1788 } else {
1789 value = 0;
1790 }
1791 }
1792 } else { /* ## IV <=> UV ## */
1793 IV leftiv;
1794 UV rightuv;
1795
1796 leftiv = SvIVX(TOPm1s);
1797 if (leftiv < 0) {
1798 /* As (b) is a UV, it's >=0, so it must be < */
1799 value = -1;
1800 } else {
1801 rightuv = SvUVX(TOPs);
1802 if (rightuv > (UV) IV_MAX) {
1803 /* As (a) is an IV, it cannot be > IV_MAX */
1804 value = -1;
1805 } else if (leftiv > (UV)rightuv) {
1806 value = 1;
1807 } else if (leftiv < (UV)rightuv) {
1808 value = -1;
1809 } else {
1810 value = 0;
1811 }
1812 }
1813 }
1814 SP--;
1815 SETi(value);
1816 RETURN;
1817 }
1818 }
1819#endif
a0d0e21e
LW
1820 {
1821 dPOPTOPnnrl;
1822 I32 value;
79072805 1823
a3540c92 1824#ifdef Perl_isnan
1ad04cfd
JH
1825 if (Perl_isnan(left) || Perl_isnan(right)) {
1826 SETs(&PL_sv_undef);
1827 RETURN;
1828 }
1829 value = (left > right) - (left < right);
1830#else
ff0cee69 1831 if (left == right)
a0d0e21e 1832 value = 0;
a0d0e21e
LW
1833 else if (left < right)
1834 value = -1;
44a8e56a
PP
1835 else if (left > right)
1836 value = 1;
1837 else {
3280af22 1838 SETs(&PL_sv_undef);
44a8e56a
PP
1839 RETURN;
1840 }
1ad04cfd 1841#endif
a0d0e21e
LW
1842 SETi(value);
1843 RETURN;
79072805 1844 }
a0d0e21e 1845}
79072805 1846
a0d0e21e
LW
1847PP(pp_slt)
1848{
39644a26 1849 dSP; tryAMAGICbinSET(slt,0);
a0d0e21e
LW
1850 {
1851 dPOPTOPssrl;
2de3dbcc 1852 int cmp = (IN_LOCALE_RUNTIME
bbce6d69
PP
1853 ? sv_cmp_locale(left, right)
1854 : sv_cmp(left, right));
54310121 1855 SETs(boolSV(cmp < 0));
a0d0e21e
LW
1856 RETURN;
1857 }
79072805
LW
1858}
1859
a0d0e21e 1860PP(pp_sgt)
79072805 1861{
39644a26 1862 dSP; tryAMAGICbinSET(sgt,0);
a0d0e21e
LW
1863 {
1864 dPOPTOPssrl;
2de3dbcc 1865 int cmp = (IN_LOCALE_RUNTIME
bbce6d69
PP
1866 ? sv_cmp_locale(left, right)
1867 : sv_cmp(left, right));
54310121 1868 SETs(boolSV(cmp > 0));
a0d0e21e
LW
1869 RETURN;
1870 }
1871}
79072805 1872
a0d0e21e
LW
1873PP(pp_sle)
1874{
39644a26 1875 dSP; tryAMAGICbinSET(sle,0);
a0d0e21e
LW
1876 {
1877 dPOPTOPssrl;
2de3dbcc 1878 int cmp = (IN_LOCALE_RUNTIME
bbce6d69
PP
1879 ? sv_cmp_locale(left, right)
1880 : sv_cmp(left, right));
54310121 1881 SETs(boolSV(cmp <= 0));
a0d0e21e 1882 RETURN;
79072805 1883 }
79072805
LW
1884}
1885
a0d0e21e
LW
1886PP(pp_sge)
1887{
39644a26 1888 dSP; tryAMAGICbinSET(sge,0);
a0d0e21e
LW
1889 {
1890 dPOPTOPssrl;
2de3dbcc 1891 int cmp = (IN_LOCALE_RUNTIME
bbce6d69
PP
1892 ? sv_cmp_locale(left, right)
1893 : sv_cmp(left, right));
54310121 1894 SETs(boolSV(cmp >= 0));
a0d0e21e
LW
1895 RETURN;
1896 }
1897}
79072805 1898
36477c24
PP
1899PP(pp_seq)
1900{
39644a26 1901 dSP; tryAMAGICbinSET(seq,0);
36477c24
PP
1902 {
1903 dPOPTOPssrl;
54310121 1904 SETs(boolSV(sv_eq(left, right)));
a0d0e21e
LW
1905 RETURN;
1906 }
1907}
79072805 1908
a0d0e21e 1909PP(pp_sne)
79072805 1910{
39644a26 1911 dSP; tryAMAGICbinSET(sne,0);
a0d0e21e
LW
1912 {
1913 dPOPTOPssrl;
54310121 1914 SETs(boolSV(!sv_eq(left, right)));
a0d0e21e 1915 RETURN;
463ee0b2 1916 }
79072805
LW
1917}
1918
a0d0e21e 1919PP(pp_scmp)
79072805 1920{
39644a26 1921 dSP; dTARGET; tryAMAGICbin(scmp,0);
a0d0e21e
LW
1922 {
1923 dPOPTOPssrl;
2de3dbcc 1924 int cmp = (IN_LOCALE_RUNTIME
bbce6d69
PP
1925 ? sv_cmp_locale(left, right)
1926 : sv_cmp(left, right));
1927 SETi( cmp );
a0d0e21e
LW
1928 RETURN;
1929 }
1930}
79072805 1931
55497cff
PP
1932PP(pp_bit_and)
1933{
39644a26 1934 dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
a0d0e21e
LW
1935 {
1936 dPOPTOPssrl;
4633a7c4 1937 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1938 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
1939 IV i = SvIV(left) & SvIV(right);
1940 SETi(i);
d0ba1bd2
JH
1941 }
1942 else {
972b05a9
JH
1943 UV u = SvUV(left) & SvUV(right);
1944 SETu(u);
d0ba1bd2 1945 }
a0d0e21e
LW
1946 }
1947 else {
533c011a 1948 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW
1949 SETTARG;
1950 }
1951 RETURN;
1952 }
1953}
79072805 1954
a0d0e21e
LW
1955PP(pp_bit_xor)
1956{
39644a26 1957 dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
a0d0e21e
LW
1958 {
1959 dPOPTOPssrl;
4633a7c4 1960 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1961 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
1962 IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
1963 SETi(i);
d0ba1bd2
JH
1964 }
1965 else {
972b05a9
JH
1966 UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
1967 SETu(u);
d0ba1bd2 1968 }
a0d0e21e
LW
1969 }
1970 else {
533c011a 1971 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW
1972 SETTARG;
1973 }
1974 RETURN;
1975 }
1976}
79072805 1977
a0d0e21e
LW
1978PP(pp_bit_or)
1979{
39644a26 1980 dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
a0d0e21e
LW
1981 {
1982 dPOPTOPssrl;
4633a7c4 1983 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1984 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
1985 IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
1986 SETi(i);
d0ba1bd2
JH
1987 }
1988 else {
972b05a9
JH
1989 UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
1990 SETu(u);
d0ba1bd2 1991 }
a0d0e21e
LW
1992 }
1993 else {
533c011a 1994 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW
1995 SETTARG;
1996 }
1997 RETURN;
79072805 1998 }
a0d0e21e 1999}
79072805 2000
a0d0e21e
LW
2001PP(pp_negate)
2002{
39644a26 2003 dSP; dTARGET; tryAMAGICun(neg);
a0d0e21e
LW
2004 {
2005 dTOPss;
28e5dec8 2006 int flags = SvFLAGS(sv);
4633a7c4
LW
2007 if (SvGMAGICAL(sv))
2008 mg_get(sv);
28e5dec8
JH
2009 if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
2010 /* It's publicly an integer, or privately an integer-not-float */
2011 oops_its_an_int:
9b0e499b
GS
2012 if (SvIsUV(sv)) {
2013 if (SvIVX(sv) == IV_MIN) {
28e5dec8 2014 /* 2s complement assumption. */
9b0e499b
GS
2015 SETi(SvIVX(sv)); /* special case: -((UV)IV_MAX+1) == IV_MIN */
2016 RETURN;
2017 }
2018 else if (SvUVX(sv) <= IV_MAX) {
beccb14c 2019 SETi(-SvIVX(sv));
9b0e499b
GS
2020 RETURN;
2021 }
2022 }
2023 else if (SvIVX(sv) != IV_MIN) {
2024 SETi(-SvIVX(sv));
2025 RETURN;
2026 }
28e5dec8
JH
2027#ifdef PERL_PRESERVE_IVUV
2028 else {
2029 SETu((UV)IV_MIN);
2030 RETURN;
2031 }
2032#endif
9b0e499b
GS
2033 }
2034 if (SvNIOKp(sv))
a0d0e21e 2035 SETn(-SvNV(sv));
4633a7c4 2036 else if (SvPOKp(sv)) {
a0d0e21e
LW
2037 STRLEN len;
2038 char *s = SvPV(sv, len);
bbce6d69 2039 if (isIDFIRST(*s)) {
a0d0e21e
LW
2040 sv_setpvn(TARG, "-", 1);
2041 sv_catsv(TARG, sv);
79072805 2042 }
a0d0e21e
LW
2043 else if (*s == '+' || *s == '-') {
2044 sv_setsv(TARG, sv);
2045 *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
79072805 2046 }
fd400ab9 2047 else if (DO_UTF8(sv) && UTF8_IS_START(*s) && isIDFIRST_utf8((U8*)s)) {
834a4ddd
LW
2048 sv_setpvn(TARG, "-", 1);
2049 sv_catsv(TARG, sv);
2050 }
28e5dec8
JH
2051 else {
2052 SvIV_please(sv);
2053 if (SvIOK(sv))
2054 goto oops_its_an_int;
2055 sv_setnv(TARG, -SvNV(sv));
2056 }
a0d0e21e 2057 SETTARG;
79072805 2058 }
4633a7c4
LW
2059 else
2060 SETn(-SvNV(sv));
79072805 2061 }
a0d0e21e 2062 RETURN;
79072805
LW
2063}
2064
a0d0e21e 2065PP(pp_not)
79072805 2066{
39644a26 2067 dSP; tryAMAGICunSET(not);
3280af22 2068 *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
a0d0e21e 2069 return NORMAL;
79072805
LW
2070}
2071
a0d0e21e 2072PP(pp_complement)
79072805 2073{
39644a26 2074 dSP; dTARGET; tryAMAGICun(compl);
a0d0e21e
LW
2075 {
2076 dTOPss;
4633a7c4 2077 if (SvNIOKp(sv)) {
d0ba1bd2 2078 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
2079 IV i = ~SvIV(sv);
2080 SETi(i);
d0ba1bd2
JH
2081 }
2082 else {
972b05a9
JH
2083 UV u = ~SvUV(sv);
2084 SETu(u);
d0ba1bd2 2085 }
a0d0e21e
LW
2086 }
2087 else {
51723571 2088 register U8 *tmps;
55497cff 2089 register I32 anum;
a0d0e21e
LW
2090 STRLEN len;
2091
2092 SvSetSV(TARG, sv);
51723571 2093 tmps = (U8*)SvPV_force(TARG, len);
a0d0e21e 2094 anum = len;
1d68d6cd 2095 if (SvUTF8(TARG)) {
a1ca4561 2096 /* Calculate exact length, let's not estimate. */
1d68d6cd
SC
2097 STRLEN targlen = 0;
2098 U8 *result;
51723571 2099 U8 *send;
ba210ebe 2100 STRLEN l;
a1ca4561
YST
2101 UV nchar = 0;
2102 UV nwide = 0;
1d68d6cd
SC
2103
2104 send = tmps + len;
2105 while (tmps < send) {
9041c2e3 2106 UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
1d68d6cd 2107 tmps += UTF8SKIP(tmps);
5bbb0b5a 2108 targlen += UNISKIP(~c);
a1ca4561
YST
2109 nchar++;
2110 if (c > 0xff)
2111 nwide++;
1d68d6cd
SC
2112 }
2113
2114 /* Now rewind strings and write them. */
2115 tmps -= len;
a1ca4561
YST
2116
2117 if (nwide) {
2118 Newz(0, result, targlen + 1, U8);
2119 while (tmps < send) {
9041c2e3 2120 UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
a1ca4561 2121 tmps += UTF8SKIP(tmps);
9041c2e3 2122 result = uvchr_to_utf8(result, ~c);
a1ca4561
YST
2123 }
2124 *result = '\0';
2125 result -= targlen;
2126 sv_setpvn(TARG, (char*)result, targlen);
2127 SvUTF8_on(TARG);
2128 }
2129 else {
2130 Newz(0, result, nchar + 1, U8);
2131 while (tmps < send) {
9041c2e3 2132 U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY);
a1ca4561
YST
2133 tmps += UTF8SKIP(tmps);
2134 *result++ = ~c;
2135 }
2136 *result = '\0';
2137 result -= nchar;
2138 sv_setpvn(TARG, (char*)result, nchar);
1d68d6cd 2139 }
1d68d6cd
SC
2140 Safefree(result);
2141 SETs(TARG);
2142 RETURN;
2143 }
a0d0e21e 2144#ifdef LIBERAL
51723571
JH
2145 {
2146 register long *tmpl;
2147 for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
2148 *tmps = ~*tmps;
2149 tmpl = (long*)tmps;
2150 for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
2151 *tmpl = ~*tmpl;
2152 tmps = (U8*)tmpl;
2153 }
a0d0e21e
LW
2154#endif
2155 for ( ; anum > 0; anum--, tmps++)
2156 *tmps = ~*tmps;
2157
2158 SETs(TARG);
2159 }
2160 RETURN;
2161 }
79072805
LW
2162}
2163
a0d0e21e
LW
2164/* integer versions of some of the above */
2165
a0d0e21e 2166PP(pp_i_multiply)
79072805 2167{
39644a26 2168 dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
a0d0e21e
LW
2169 {
2170 dPOPTOPiirl;
2171 SETi( left * right );
2172 RETURN;
2173 }
79072805
LW
2174}
2175
a0d0e21e 2176PP(pp_i_divide)
79072805 2177{
39644a26 2178 dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
a0d0e21e
LW
2179 {
2180 dPOPiv;
2181 if (value == 0)
cea2e8a9 2182 DIE(aTHX_ "Illegal division by zero");
a0d0e21e
LW
2183 value = POPi / value;
2184 PUSHi( value );
2185 RETURN;
2186 }
79072805
LW
2187}
2188
a0d0e21e 2189PP(pp_i_modulo)
79072805 2190{
39644a26 2191 dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
79072805 2192 {
a0d0e21e 2193 dPOPTOPiirl;
aa306039 2194 if (!right)
cea2e8a9 2195 DIE(aTHX_ "Illegal modulus zero");
a0d0e21e
LW
2196 SETi( left % right );
2197 RETURN;
79072805 2198 }
79072805
LW
2199}
2200
a0d0e21e 2201PP(pp_i_add)
79072805 2202{
39644a26 2203 dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
a0d0e21e 2204 {
5e66d4f1 2205 dPOPTOPiirl_ul;
a0d0e21e
LW
2206 SETi( left + right );
2207 RETURN;
79072805 2208 }
79072805
LW
2209}
2210
a0d0e21e 2211PP(pp_i_subtract)
79072805 2212{
39644a26 2213 dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
a0d0e21e 2214 {
5e66d4f1 2215 dPOPTOPiirl_ul;
a0d0e21e
LW
2216 SETi( left - right );
2217 RETURN;
79072805 2218 }
79072805
LW
2219}
2220
a0d0e21e 2221PP(pp_i_lt)
79072805 2222{
39644a26 2223 dSP; tryAMAGICbinSET(lt,0);
a0d0e21e
LW
2224 {
2225 dPOPTOPiirl;
54310121 2226 SETs(boolSV(left < right));
a0d0e21e
LW
2227 RETURN;
2228 }
79072805
LW
2229}
2230
a0d0e21e 2231PP(pp_i_gt)
79072805 2232{
39644a26 2233 dSP; tryAMAGICbinSET(gt,0);
a0d0e21e
LW
2234 {
2235 dPOPTOPiirl;
54310121 2236 SETs(boolSV(left > right));
a0d0e21e
LW
2237 RETURN;
2238 }
79072805
LW
2239}
2240
a0d0e21e 2241PP(pp_i_le)
79072805 2242{
39644a26 2243 dSP; tryAMAGICbinSET(le,0);
a0d0e21e
LW
2244 {
2245 dPOPTOPiirl;
54310121 2246 SETs(boolSV(left <= right));
a0d0e21e 2247 RETURN;
85e6fe83 2248 }
79072805
LW
2249}
2250
a0d0e21e 2251PP(pp_i_ge)
79072805 2252{
39644a26 2253 dSP; tryAMAGICbinSET(ge,0);
a0d0e21e
LW
2254 {
2255 dPOPTOPiirl;
54310121 2256 SETs(boolSV(left >= right));
a0d0e21e
LW
2257 RETURN;
2258 }
79072805
LW
2259}
2260
a0d0e21e 2261PP(pp_i_eq)
79072805 2262{
39644a26 2263 dSP; tryAMAGICbinSET(eq,0);
a0d0e21e
LW
2264 {
2265 dPOPTOPiirl;
54310121 2266 SETs(boolSV(left == right));
a0d0e21e
LW
2267 RETURN;
2268 }
79072805
LW
2269}
2270
a0d0e21e 2271PP(pp_i_ne)
79072805 2272{
39644a26 2273 dSP; tryAMAGICbinSET(ne,0);
a0d0e21e
LW
2274 {
2275 dPOPTOPiirl;
54310121 2276 SETs(boolSV(left != right));
a0d0e21e
LW
2277 RETURN;
2278 }
79072805
LW
2279}
2280
a0d0e21e 2281PP(pp_i_ncmp)
79072805 2282{
39644a26 2283 dSP; dTARGET; tryAMAGICbin(ncmp,0);
a0d0e21e
LW
2284 {
2285 dPOPTOPiirl;
2286 I32 value;
79072805 2287
a0d0e21e 2288 if (left > right)
79072805 2289 value = 1;
a0d0e21e 2290 else if (left < right)
79072805 2291 value = -1;
a0d0e21e 2292 else
79072805 2293 value = 0;
a0d0e21e
LW
2294 SETi(value);
2295 RETURN;
79072805 2296 }
85e6fe83
LW
2297}
2298
2299PP(pp_i_negate)
2300{
39644a26 2301 dSP; dTARGET; tryAMAGICun(neg);
85e6fe83
LW
2302 SETi(-TOPi);
2303 RETURN;
2304}
2305
79072805
LW
2306/* High falutin' math. */
2307
2308PP(pp_atan2)
2309{
39644a26 2310 dSP; dTARGET; tryAMAGICbin(atan2,0);
a0d0e21e
LW
2311 {
2312 dPOPTOPnnrl;
65202027 2313 SETn(Perl_atan2(left, right));
a0d0e21e
LW
2314 RETURN;
2315 }
79072805
LW
2316}
2317
2318PP(pp_sin)
2319{
39644a26 2320 dSP; dTARGET; tryAMAGICun(sin);
a0d0e21e 2321 {
65202027 2322 NV value;
a0d0e21e 2323 value = POPn;
65202027 2324 value = Perl_sin(value);
a0d0e21e
LW
2325 XPUSHn(value);
2326 RETURN;
2327 }
79072805
LW
2328}
2329
2330PP(pp_cos)
2331{
39644a26 2332 dSP; dTARGET; tryAMAGICun(cos);
a0d0e21e 2333 {
65202027 2334 NV value;
a0d0e21e 2335 value = POPn;
65202027 2336 value = Perl_cos(value);
a0d0e21e
LW
2337 XPUSHn(value);
2338 RETURN;
2339 }
79072805
LW
2340}
2341
56cb0a1c
AD
2342/* Support Configure command-line overrides for rand() functions.
2343 After 5.005, perhaps we should replace this by Configure support
2344 for drand48(), random(), or rand(). For 5.005, though, maintain
2345 compatibility by calling rand() but allow the user to override it.
2346 See INSTALL for details. --Andy Dougherty 15 July 1998
2347*/
85ab1d1d
JH
2348/* Now it's after 5.005, and Configure supports drand48() and random(),
2349 in addition to rand(). So the overrides should not be needed any more.
2350 --Jarkko Hietaniemi 27 September 1998
2351 */
2352
2353#ifndef HAS_DRAND48_PROTO
20ce7b12 2354extern double drand48 (void);
56cb0a1c
AD
2355#endif
2356
79072805
LW
2357PP(pp_rand)
2358{
39644a26 2359 dSP; dTARGET;
65202027 2360 NV value;
79072805
LW
2361 if (MAXARG < 1)
2362 value = 1.0;
2363 else
2364 value = POPn;
2365 if (value == 0.0)
2366 value = 1.0;
80252599 2367 if (!PL_srand_called) {
85ab1d1d 2368 (void)seedDrand01((Rand_seed_t)seed());
80252599 2369 PL_srand_called = TRUE;
93dc8474 2370 }
85ab1d1d 2371 value *= Drand01();
79072805
LW
2372 XPUSHn(value);
2373 RETURN;
2374}
2375
2376PP(pp_srand)
2377{
39644a26 2378 dSP;
93dc8474
CS
2379 UV anum;
2380 if (MAXARG < 1)
2381 anum = seed();
79072805 2382 else
93dc8474 2383 anum = POPu;
85ab1d1d 2384 (void)seedDrand01((Rand_seed_t)anum);
80252599 2385 PL_srand_called = TRUE;
79072805
LW
2386 EXTEND(SP, 1);
2387 RETPUSHYES;
2388}
2389
76e3520e 2390STATIC U32
cea2e8a9 2391S_seed(pTHX)
93dc8474 2392{
54310121
PP
2393 /*
2394 * This is really just a quick hack which grabs various garbage
2395 * values. It really should be a real hash algorithm which
2396 * spreads the effect of every input bit onto every output bit,
85ab1d1d 2397 * if someone who knows about such things would bother to write it.
54310121 2398 * Might be a good idea to add that function to CORE as well.
85ab1d1d 2399 * No numbers below come from careful analysis or anything here,
54310121
PP
2400 * except they are primes and SEED_C1 > 1E6 to get a full-width
2401 * value from (tv_sec * SEED_C1 + tv_usec). The multipliers should
2402 * probably be bigger too.
2403 */
2404#if RANDBITS > 16
2405# define SEED_C1 1000003
2406#define SEED_C4 73819
2407#else
2408# define SEED_C1 25747
2409#define SEED_C4 20639
2410#endif
2411#define SEED_C2 3
2412#define SEED_C3 269
2413#define SEED_C5 26107
2414
73c60299
RS
2415#ifndef PERL_NO_DEV_RANDOM
2416 int fd;
2417#endif
93dc8474 2418 U32 u;
f12c7020
PP
2419#ifdef VMS
2420# include <starlet.h>
43c92808
HF
2421 /* when[] = (low 32 bits, high 32 bits) of time since epoch
2422 * in 100-ns units, typically incremented ever 10 ms. */
93dc8474 2423 unsigned int when[2];
73c60299
RS
2424#else
2425# ifdef HAS_GETTIMEOFDAY
2426 struct timeval when;
2427# else
2428 Time_t when;
2429# endif
2430#endif
2431
2432/* This test is an escape hatch, this symbol isn't set by Configure. */
2433#ifndef PERL_NO_DEV_RANDOM
2434#ifndef PERL_RANDOM_DEVICE
2435 /* /dev/random isn't used by default because reads from it will block
2436 * if there isn't enough entropy available. You can compile with
2437 * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
2438 * is enough real entropy to fill the seed. */
2439# define PERL_RANDOM_DEVICE "/dev/urandom"
2440#endif
2441 fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
2442 if (fd != -1) {
2443 if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
2444 u = 0;
2445 PerlLIO_close(fd);
2446 if (u)
2447 return u;
2448 }
2449#endif
2450
2451#ifdef VMS
93dc8474 2452 _ckvmssts(sys$gettim(when));
54310121 2453 u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
f12c7020 2454#else
5f05dabc 2455# ifdef HAS_GETTIMEOFDAY
93dc8474 2456 gettimeofday(&when,(struct timezone *) 0);
54310121 2457 u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
f12c7020 2458# else
93dc8474 2459 (void)time(&when);
54310121 2460 u = (U32)SEED_C1 * when;
f12c7020
PP
2461# endif
2462#endif
7766f137 2463 u += SEED_C3 * (U32)PerlProc_getpid();
56431972 2464 u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
54310121 2465#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */
56431972 2466 u += SEED_C5 * (U32)PTR2UV(&when);
f12c7020 2467#endif
93dc8474 2468 return u;
79072805
LW
2469}
2470
2471PP(pp_exp)
2472{
39644a26 2473 dSP; dTARGET; tryAMAGICun(exp);
a0d0e21e 2474 {
65202027 2475 NV value;
a0d0e21e 2476 value = POPn;
65202027 2477 value = Perl_exp(value);
a0d0e21e
LW
2478 XPUSHn(value);
2479 RETURN;
2480 }
79072805
LW
2481}
2482
2483PP(pp_log)
2484{
39644a26 2485 dSP; dTARGET; tryAMAGICun(log);
a0d0e21e 2486 {
65202027 2487 NV value;
a0d0e21e 2488 value = POPn;
bbce6d69 2489 if (value <= 0.0) {
f93f4e46 2490 SET_NUMERIC_STANDARD();
cea2e8a9 2491 DIE(aTHX_ "Can't take log of %g", value);
bbce6d69 2492 }
65202027 2493 value = Perl_log(value);
a0d0e21e
LW
2494 XPUSHn(value);
2495 RETURN;
2496 }
79072805
LW
2497}
2498
2499PP(pp_sqrt)
2500{
39644a26 2501 dSP; dTARGET; tryAMAGICun(sqrt);
a0d0e21e 2502 {
65202027 2503 NV value;
a0d0e21e 2504 value = POPn;
bbce6d69 2505 if (value < 0.0) {
f93f4e46 2506 SET_NUMERIC_STANDARD();
cea2e8a9 2507 DIE(aTHX_ "Can't take sqrt of %g", value);
bbce6d69 2508 }
65202027 2509 value = Perl_sqrt(value);
a0d0e21e
LW
2510 XPUSHn(value);
2511 RETURN;
2512 }
79072805
LW
2513}
2514
2515PP(pp_int)
2516{
39644a26 2517 dSP; dTARGET; tryAMAGICun(int);
774d564b 2518 {
28e5dec8
JH
2519 NV value;
2520 IV iv = TOPi; /* attempt to convert to IV if possible. */
2521 /* XXX it's arguable that compiler casting to IV might be subtly
2522 different from modf (for numbers inside (IV_MIN,UV_MAX)) in which
2523 else preferring IV has introduced a subtle behaviour change bug. OTOH
2524 relying on floating point to be accurate is a bug. */
2525
2526 if (SvIOK(TOPs)) {
2527 if (SvIsUV(TOPs)) {
2528 UV uv = TOPu;
2529 SETu(uv);
2530 } else
2531 SETi(iv);
2532 } else {
2533 value = TOPn;
1048ea30 2534 if (value >= 0.0) {
28e5dec8
JH
2535 if (value < (NV)UV_MAX + 0.5) {
2536 SETu(U_V(value));
2537 } else {
1048ea30 2538#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
e67aeab1
JH
2539# ifdef HAS_MODFL_POW32_BUG
2540/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
2541 {
2542 NV offset = Perl_modf(value, &value);
2543 (void)Perl_modf(offset, &offset);
2544 value += offset;
2545 }
2546# else
28e5dec8 2547 (void)Perl_modf(value, &value);
e67aeab1 2548# endif
1048ea30 2549#else
28e5dec8
JH
2550 double tmp = (double)value;
2551 (void)Perl_modf(tmp, &tmp);
2552 value = (NV)tmp;
1048ea30 2553#endif
2d9af89d 2554 SETn(value);
28e5dec8 2555 }
1048ea30 2556 }
28e5dec8
JH
2557 else {
2558 if (value > (NV)IV_MIN - 0.5) {
2559 SETi(I_V(value));
2560 } else {
1048ea30 2561#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
e67aeab1
JH
2562# ifdef HAS_MODFL_POW32_BUG
2563/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
2564 {
2565 NV offset = Perl_modf(-value, &value);
2566 (void)Perl_modf(offset, &offset);
2567 value += offset;
2568 }
2569# else
28e5dec8 2570 (void)Perl_modf(-value, &value);
e67aeab1 2571# endif
28e5dec8 2572 value = -value;
1048ea30 2573#else
28e5dec8
JH
2574 double tmp = (double)value;
2575 (void)Perl_modf(-tmp, &tmp);
2576 value = -(NV)tmp;
1048ea30 2577#endif
28e5dec8
JH
2578 SETn(value);
2579 }
2580 }
774d564b 2581 }
79072805 2582 }
79072805
LW
2583 RETURN;
2584}
2585
463ee0b2
LW
2586PP(pp_abs)
2587{
39644a26 2588 dSP; dTARGET; tryAMAGICun(abs);
a0d0e21e 2589 {
28e5dec8
JH
2590 /* This will cache the NV value if string isn't actually integer */
2591 IV iv = TOPi;
a227d84d 2592
28e5dec8
JH
2593 if (SvIOK(TOPs)) {
2594 /* IVX is precise */
2595 if (SvIsUV(TOPs)) {
2596 SETu(TOPu); /* force it to be numeric only */
2597 } else {
2598 if (iv >= 0) {
2599 SETi(iv);
2600 } else {
2601 if (iv != IV_MIN) {
2602 SETi(-iv);
2603 } else {
2604 /* 2s complement assumption. Also, not really needed as
2605 IV_MIN and -IV_MIN should both be %100...00 and NV-able */
2606 SETu(IV_MIN);
2607 }
a227d84d 2608 }
28e5dec8
JH
2609 }
2610 } else{
2611 NV value = TOPn;
774d564b 2612 if (value < 0.0)
28e5dec8 2613 value = -value;
774d564b
PP
2614 SETn(value);
2615 }
a0d0e21e 2616 }
774d564b 2617 RETURN;
463ee0b2
LW
2618}
2619
79072805
LW
2620PP(pp_hex)
2621{
39644a26 2622 dSP; dTARGET;
79072805 2623 char *tmps;
ba210ebe 2624 STRLEN argtype;
6f894ead 2625 STRLEN len;
79072805 2626
6f894ead 2627 tmps = (SvPVx(POPs, len));
b21ed0a9 2628 argtype = 1; /* allow underscores */
6f894ead 2629 XPUSHn(scan_hex(tmps, len, &argtype));
79072805
LW
2630 RETURN;
2631}
2632
2633PP(pp_oct)
2634{
39644a26 2635 dSP; dTARGET;
9e24b6e2 2636 NV value;
ba210ebe 2637 STRLEN argtype;
79072805 2638 char *tmps;
6f894ead 2639 STRLEN len;
79072805 2640
6f894ead
DD
2641 tmps = (SvPVx(POPs, len));
2642 while (*tmps && len && isSPACE(*tmps))
2643 tmps++, len--;
9e24b6e2 2644 if (*tmps == '0')
6f894ead 2645 tmps++, len--;
b21ed0a9 2646 argtype = 1; /* allow underscores */
9e24b6e2 2647 if (*tmps == 'x')
6f894ead 2648 value = scan_hex(++tmps, --len, &argtype);
9e24b6e2 2649 else if (*tmps == 'b')
6f894ead 2650 value = scan_bin(++tmps, --len, &argtype);
464e2e8a 2651 else
6f894ead 2652 value = scan_oct(tmps, len, &argtype);
9e24b6e2 2653 XPUSHn(value);
79072805
LW
2654 RETURN;
2655}
2656
2657/* String stuff. */
2658
2659PP(pp_length)
2660{
39644a26 2661 dSP; dTARGET;
7e2040f0 2662 SV *sv = TOPs;
a0ed51b3 2663
7e2040f0
GS
2664 if (DO_UTF8(sv))
2665 SETi(sv_len_utf8(sv));
2666 else
2667 SETi(sv_len(sv));
79072805
LW
2668 RETURN;
2669}
2670
2671PP(pp_substr)
2672{
39644a26 2673 dSP; dTARGET;
79072805 2674 SV *sv;
9c5ffd7c 2675 I32 len = 0;
463ee0b2 2676 STRLEN curlen;
9402d6ed 2677 STRLEN utf8_curlen;
79072805
LW
2678 I32 pos;
2679 I32 rem;
84902520 2680 I32 fail;
78f9721b 2681 I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
79072805 2682 char *tmps;
3280af22 2683 I32 arybase = PL_curcop->cop_arybase;
9402d6ed 2684 SV *repl_sv = NULL;
7b8d334a
GS
2685 char *repl = 0;
2686 STRLEN repl_len;
78f9721b 2687 int num_args = PL_op->op_private & 7;
13e30c65 2688 bool repl_need_utf8_upgrade = FALSE;
9402d6ed 2689 bool repl_is_utf8 = FALSE;
79072805 2690
20408e3c 2691 SvTAINTED_off(TARG); /* decontaminate */
7e2040f0 2692 SvUTF8_off(TARG); /* decontaminate */
78f9721b
SM
2693 if (num_args > 2) {
2694 if (num_args > 3) {
9402d6ed
JH
2695 repl_sv = POPs;
2696 repl = SvPV(repl_sv, repl_len);
2697 repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
7b8d334a 2698 }
79072805 2699 len = POPi;
5d82c453 2700 }
84902520 2701 pos = POPi;
79072805 2702 sv = POPs;
849ca7ee 2703 PUTBACK;
9402d6ed
JH
2704 if (repl_sv) {
2705 if (repl_is_utf8) {
2706 if (!DO_UTF8(sv))
2707 sv_utf8_upgrade(sv);
2708 }
13e30c65
JH
2709 else if (DO_UTF8(sv))
2710 repl_need_utf8_upgrade = TRUE;
9402d6ed 2711 }
a0d0e21e 2712 tmps = SvPV(sv, curlen);
7e2040f0 2713 if (DO_UTF8(sv)) {
9402d6ed
JH
2714 utf8_curlen = sv_len_utf8(sv);
2715 if (utf8_curlen == curlen)
2716 utf8_curlen = 0;
a0ed51b3 2717 else
9402d6ed 2718 curlen = utf8_curlen;
a0ed51b3 2719 }
d1c2b58a 2720 else
9402d6ed 2721 utf8_curlen = 0;
a0ed51b3 2722
84902520
TB
2723 if (pos >= arybase) {
2724 pos -= arybase;
2725 rem = curlen-pos;
2726 fail = rem;
78f9721b 2727 if (num_args > 2) {
5d82c453
GA
2728 if (len < 0) {
2729 rem += len;
2730 if (rem < 0)
2731 rem = 0;
2732 }
2733 else if (rem > len)
2734 rem = len;
2735 }
68dc0745 2736 }
84902520 2737 else {
5d82c453 2738 pos += curlen;
78f9721b 2739 if (num_args < 3)
5d82c453
GA
2740 rem = curlen;
2741 else if (len >= 0) {
2742 rem = pos+len;
2743 if (rem > (I32)curlen)
2744 rem = curlen;
2745 }
2746 else {
2747 rem = curlen+len;
2748 if (rem < pos)
2749 rem = pos;
2750 }
2751 if (pos < 0)
2752 pos = 0;
2753 fail = rem;
2754 rem -= pos;
84902520
TB
2755 }
2756 if (fail < 0) {
e476b1b5
GS
2757 if (lvalue || repl)
2758 Perl_croak(aTHX_ "substr outside of string");
2759 if (ckWARN(WARN_SUBSTR))
cea2e8a9 2760 Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
2304df62
AD
2761 RETPUSHUNDEF;
2762 }
79072805 2763 else {
9aa983d2
JH
2764 I32 upos = pos;
2765 I32 urem = rem;
9402d6ed 2766 if (utf8_curlen)
a0ed51b3 2767 sv_pos_u2b(sv, &pos, &rem);
79072805 2768 tmps += pos;
79072805 2769 sv_setpvn(TARG, tmps, rem);
12aa1545 2770#ifdef USE_LOCALE_COLLATE
14befaf4 2771 sv_unmagic(TARG, PERL_MAGIC_collxfrm);
12aa1545 2772#endif
9402d6ed 2773 if (utf8_curlen)
7f66633b 2774 SvUTF8_on(TARG);
f7928d6c 2775 if (repl) {
13e30c65
JH
2776 SV* repl_sv_copy = NULL;
2777
2778 if (repl_need_utf8_upgrade) {
2779 repl_sv_copy = newSVsv(repl_sv);
2780 sv_utf8_upgrade(repl_sv_copy);
2781 repl = SvPV(repl_sv_copy, repl_len);
2782 repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
2783 }
c8faf1c5 2784 sv_insert(sv, pos, rem, repl, repl_len);
9402d6ed 2785 if (repl_is_utf8)
f7928d6c 2786 SvUTF8_on(sv);
9402d6ed
JH
2787 if (repl_sv_copy)
2788 SvREFCNT_dec(repl_sv_copy);
f7928d6c 2789 }
c8faf1c5 2790 else if (lvalue) { /* it's an lvalue! */
dedeecda
PP
2791 if (!SvGMAGICAL(sv)) {
2792 if (SvROK(sv)) {
2d8e6c8d
GS
2793 STRLEN n_a;
2794 SvPV_force(sv,n_a);
599cee73 2795 if (ckWARN(WARN_SUBSTR))
cea2e8a9 2796 Perl_warner(aTHX_ WARN_SUBSTR,
599cee73 2797 "Attempt to use reference as lvalue in substr");
dedeecda
PP
2798 }
2799 if (SvOK(sv)) /* is it defined ? */
7f66633b 2800 (void)SvPOK_only_UTF8(sv);
dedeecda
PP
2801 else
2802 sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
2803 }
5f05dabc 2804
a0d0e21e
LW
2805 if (SvTYPE(TARG) < SVt_PVLV) {
2806 sv_upgrade(TARG, SVt_PVLV);
14befaf4 2807 sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
ed6116ce 2808 }
a0d0e21e 2809
5f05dabc 2810 LvTYPE(TARG) = 'x';
6ff81951
GS
2811 if (LvTARG(TARG) != sv) {
2812 if (LvTARG(TARG))
2813 SvREFCNT_dec(LvTARG(TARG));
2814 LvTARG(TARG) = SvREFCNT_inc(sv);
2815 }
9aa983d2
JH
2816 LvTARGOFF(TARG) = upos;
2817 LvTARGLEN(TARG) = urem;
79072805
LW
2818 }
2819 }
849ca7ee 2820 SPAGAIN;
79072805
LW
2821 PUSHs(TARG); /* avoid SvSETMAGIC here */
2822 RETURN;
2823}
2824
2825PP(pp_vec)
2826{
39644a26 2827 dSP; dTARGET;
467f0320
JH
2828 register IV size = POPi;
2829 register IV offset = POPi;
79072805 2830 register SV *src = POPs;
78f9721b 2831 I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
a0d0e21e 2832
81e118e0
JH
2833 SvTAINTED_off(TARG); /* decontaminate */
2834 if (lvalue) { /* it's an lvalue! */
2835 if (SvTYPE(TARG) < SVt_PVLV) {
2836 sv_upgrade(TARG, SVt_PVLV);
14befaf4 2837 sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0);
79072805 2838 }
81e118e0
JH
2839 LvTYPE(TARG) = 'v';
2840 if (LvTARG(TARG) != src) {
2841 if (LvTARG(TARG))
2842 SvREFCNT_dec(LvTARG(TARG));
2843 LvTARG(TARG) = SvREFCNT_inc(src);
79072805 2844 }
81e118e0
JH
2845 LvTARGOFF(TARG) = offset;
2846 LvTARGLEN(TARG) = size;
79072805
LW
2847 }
2848
81e118e0 2849 sv_setuv(TARG, do_vecget(src, offset, size));
79072805
LW
2850 PUSHs(TARG);
2851 RETURN;
2852}
2853
2854PP(pp_index)
2855{
39644a26 2856 dSP; dTARGET;
79072805
LW
2857 SV *big;
2858 SV *little;
2859 I32 offset;
2860 I32 retval;
2861 char *tmps;
2862 char *tmps2;
463ee0b2 2863 STRLEN biglen;
3280af22 2864 I32 arybase = PL_curcop->cop_arybase;
79072805
LW
2865
2866 if (MAXARG < 3)
2867 offset = 0;
2868 else
2869 offset = POPi - arybase;
2870 little = POPs;
2871 big = POPs;
463ee0b2 2872 tmps = SvPV(big, biglen);
7e2040f0 2873 if (offset > 0 && DO_UTF8(big))
a0ed51b3 2874 sv_pos_u2b(big, &offset, 0);
79072805
LW
2875 if (offset < 0)
2876 offset = 0;
93a17b20
LW
2877 else if (offset > biglen)
2878 offset = biglen;
79072805 2879 if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
411d5715 2880 (unsigned char*)tmps + biglen, little, 0)))
a0ed51b3 2881 retval = -1;
79072805 2882 else
a0ed51b3 2883 retval = tmps2 - tmps;
7e2040f0 2884 if (retval > 0 && DO_UTF8(big))
a0ed51b3
LW
2885 sv_pos_b2u(big, &retval);
2886 PUSHi(retval + arybase);
79072805
LW
2887 RETURN;
2888}
2889
2890PP(pp_rindex)
2891{
39644a26 2892 dSP; dTARGET;
79072805
LW
2893 SV *big;
2894 SV *little;
463ee0b2
LW
2895 STRLEN blen;
2896 STRLEN llen;
79072805
LW
2897 I32 offset;
2898 I32 retval;
2899 char *tmps;
2900 char *tmps2;
3280af22 2901 I32 arybase = PL_curcop->cop_arybase;
79072805 2902
a0d0e21e 2903 if (MAXARG >= 3)
a0ed51b3 2904 offset = POPi;
79072805
LW
2905 little = POPs;
2906 big = POPs;
463ee0b2
LW
2907 tmps2 = SvPV(little, llen);
2908 tmps = SvPV(big, blen);
79072805 2909 if (MAXARG < 3)
463ee0b2 2910 offset = blen;
a0ed51b3 2911 else {
7e2040f0 2912 if (offset > 0 && DO_UTF8(big))
a0ed51b3
LW
2913 sv_pos_u2b(big, &offset, 0);
2914 offset = offset - arybase + llen;
2915 }
79072805
LW
2916 if (offset < 0)
2917 offset = 0;
463ee0b2
LW
2918 else if (offset > blen)
2919 offset = blen;
79072805 2920 if (!(tmps2 = rninstr(tmps, tmps + offset,
463ee0b2 2921 tmps2, tmps2 + llen)))
a0ed51b3 2922 retval = -1;
79072805 2923 else
a0ed51b3 2924 retval = tmps2 - tmps;
7e2040f0 2925 if (retval > 0 && DO_UTF8(big))
a0ed51b3
LW
2926 sv_pos_b2u(big, &retval);
2927 PUSHi(retval + arybase);
79072805
LW
2928 RETURN;
2929}
2930
2931PP(pp_sprintf)
2932{
39644a26 2933 dSP; dMARK; dORIGMARK; dTARGET;
79072805 2934 do_sprintf(TARG, SP-MARK, MARK+1);
bbce6d69 2935 TAINT_IF(SvTAINTED(TARG));
6ee35fb7
JH
2936 if (DO_UTF8(*(MARK+1)))
2937 SvUTF8_on(TARG);
79072805
LW
2938 SP = ORIGMARK;
2939 PUSHTARG;
2940 RETURN;
2941}
2942
79072805
LW
2943PP(pp_ord)
2944{
39644a26 2945 dSP; dTARGET;
7df053ec 2946 SV *argsv = POPs;
ba210ebe 2947 STRLEN len;
7df053ec 2948 U8 *s = (U8*)SvPVx(argsv, len);
79072805 2949
9041c2e3 2950 XPUSHu(DO_UTF8(argsv) ? utf8_to_uvchr(s, 0) : (*s & 0xff));
79072805
LW
2951 RETURN;
2952}
2953
463ee0b2
LW
2954PP(pp_chr)
2955{
39644a26 2956 dSP; dTARGET;
463ee0b2 2957 char *tmps;
467f0320 2958 UV value = POPu;
463ee0b2 2959
748a9306 2960 (void)SvUPGRADE(TARG,SVt_PV);
a0ed51b3 2961
0064a8a9 2962 if (value > 255 && !IN_BYTES) {
9aa983d2 2963 SvGROW(TARG, UNISKIP(value)+1);
9041c2e3 2964 tmps = (char*)uvchr_to_utf8((U8*)SvPVX(TARG), value);
a0ed51b3
LW
2965 SvCUR_set(TARG, tmps - SvPVX(TARG));
2966 *tmps = '\0';
2967 (void)SvPOK_only(TARG);
aa6ffa16 2968 SvUTF8_on(TARG);
a0ed51b3
LW
2969 XPUSHs(TARG);
2970 RETURN;
2971 }
2972
748a9306 2973 SvGROW(TARG,2);
463ee0b2
LW
2974 SvCUR_set(TARG, 1);
2975 tmps = SvPVX(TARG);
a0ed51b3 2976 *tmps++ = value;
748a9306 2977 *tmps = '\0';
a0d0e21e 2978 (void)SvPOK_only(TARG);
463ee0b2
LW
2979 XPUSHs(TARG);
2980 RETURN;
2981}
2982
79072805
LW
2983PP(pp_crypt)
2984{
39644a26 2985 dSP; dTARGET; dPOPTOPssrl;
2d8e6c8d 2986 STRLEN n_a;
79072805 2987#ifdef HAS_CRYPT
2d8e6c8d 2988 char *tmps = SvPV(left, n_a);
79072805 2989#ifdef FCRYPT
2d8e6c8d 2990 sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
79072805 2991#else
2d8e6c8d 2992 sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
79072805
LW
2993#endif
2994#else
b13b2135 2995 DIE(aTHX_
79072805
LW
2996 "The crypt() function is unimplemented due to excessive paranoia.");
2997#endif
2998 SETs(TARG);
2999 RETURN;
3000}
3001
3002PP(pp_ucfirst)
3003{
39644a26 3004 dSP;
79072805 3005 SV *sv = TOPs;
a0ed51b3
LW
3006 register U8 *s;
3007 STRLEN slen;
3008
fd400ab9 3009 if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
ba210ebe 3010 STRLEN ulen;
ad391ad9 3011 U8 tmpbuf[UTF8_MAXLEN+1];
a0ed51b3 3012 U8 *tend;
9041c2e3 3013 UV uv;
a0ed51b3 3014
2de3dbcc 3015 if (IN_LOCALE_RUNTIME) {
a0ed51b3
LW
3016 TAINT;
3017 SvTAINTED_on(sv);
9041c2e3 3018 uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
a0ed51b3 3019 }
b0f2b690
JH
3020 else {
3021 uv = toTITLE_utf8(s);
3022 ulen = UNISKIP(uv);
3023 }
a0ed51b3 3024
9041c2e3 3025 tend = uvchr_to_utf8(tmpbuf, uv);
a0ed51b3 3026
014822e4 3027 if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
a0ed51b3 3028 dTARGET;
dfe13c55
GS
3029 sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
3030 sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
7e2040f0 3031 SvUTF8_on(TARG);
a0ed51b3
LW
3032 SETs(TARG);
3033 }
3034 else {
dfe13c55 3035 s = (U8*)SvPV_force(sv, slen);
a0ed51b3
LW
3036 Copy(tmpbuf, s, ulen, U8);
3037 }
a0ed51b3 3038 }
626727d5 3039 else {
014822e4 3040 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3041 dTARGET;
7e2040f0 3042 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
3043 sv_setsv(TARG, sv);
3044 sv = TARG;
3045 SETs(sv);
3046 }
3047 s = (U8*)SvPV_force(sv, slen);
3048 if (*s) {
2de3dbcc 3049 if (IN_LOCALE_RUNTIME) {
31351b04
JS
3050 TAINT;
3051 SvTAINTED_on(sv);
3052 *s = toUPPER_LC(*s);
3053 }
3054 else
3055 *s = toUPPER(*s);
bbce6d69 3056 }
bbce6d69 3057 }
31351b04
JS
3058 if (SvSMAGICAL(sv))
3059 mg_set(sv);
79072805
LW
3060 RETURN;
3061}
3062
3063PP(pp_lcfirst)
3064{
39644a26 3065 dSP;
79072805 3066 SV *sv = TOPs;
a0ed51b3
LW
3067 register U8 *s;
3068 STRLEN slen;
3069
fd400ab9 3070 if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
ba210ebe 3071 STRLEN ulen;
ad391ad9 3072 U8 tmpbuf[UTF8_MAXLEN+1];
a0ed51b3 3073 U8 *tend;
9041c2e3 3074 UV uv;
a0ed51b3 3075
2de3dbcc 3076 if (IN_LOCALE_RUNTIME) {
a0ed51b3
LW
3077 TAINT;
3078 SvTAINTED_on(sv);
9041c2e3 3079 uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
a0ed51b3 3080 }
b0f2b690
JH
3081 else {
3082 uv = toLOWER_utf8(s);
3083 ulen = UNISKIP(uv);
3084 }
a0ed51b3 3085
9041c2e3 3086 tend = uvchr_to_utf8(tmpbuf, uv);
a0ed51b3 3087
014822e4 3088 if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
a0ed51b3 3089 dTARGET;
dfe13c55
GS
3090 sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
3091 sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
7e2040f0 3092 SvUTF8_on(TARG);
a0ed51b3
LW
3093 SETs(TARG);
3094 }
3095 else {
dfe13c55 3096 s = (U8*)SvPV_force(sv, slen);
a0ed51b3
LW
3097 Copy(tmpbuf, s, ulen, U8);
3098 }
a0ed51b3 3099 }
626727d5 3100 else {
014822e4 3101 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3102 dTARGET;
7e2040f0 3103 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
3104 sv_setsv(TARG, sv);
3105 sv = TARG;
3106 SETs(sv);
3107 }
3108 s = (U8*)SvPV_force(sv, slen);
3109 if (*s) {
2de3dbcc 3110 if (IN_LOCALE_RUNTIME) {
31351b04
JS
3111 TAINT;
3112 SvTAINTED_on(sv);
3113 *s = toLOWER_LC(*s);
3114 }
3115 else
3116 *s = toLOWER(*s);
bbce6d69 3117 }
bbce6d69 3118 }
31351b04
JS
3119 if (SvSMAGICAL(sv))
3120 mg_set(sv);
79072805
LW
3121 RETURN;
3122}
3123
3124PP(pp_uc)
3125{
39644a26 3126 dSP;
79072805 3127 SV *sv = TOPs;
a0ed51b3 3128 register U8 *s;
463ee0b2 3129 STRLEN len;
79072805 3130
7e2040f0 3131 if (DO_UTF8(sv)) {
a0ed51b3 3132 dTARGET;
ba210ebe 3133 STRLEN ulen;
a0ed51b3
LW
3134 register U8 *d;
3135 U8 *send;
3136
dfe13c55 3137 s = (U8*)SvPV(sv,len);
a5a20234 3138 if (!len) {
7e2040f0 3139 SvUTF8_off(TARG); /* decontaminate */
a5a20234
LW
3140 sv_setpvn(TARG, "", 0);
3141 SETs(TARG);
a0ed51b3
LW
3142 }
3143 else {
31351b04
JS
3144 (void)SvUPGRADE(TARG, SVt_PV);
3145 SvGROW(TARG, (len * 2) + 1);
3146 (void)SvPOK_only(TARG);
3147 d = (U8*)SvPVX(TARG);
3148 send = s + len;
2de3dbcc 3149 if (IN_LOCALE_RUNTIME) {
31351b04
JS
3150 TAINT;
3151 SvTAINTED_on(TARG);
3152 while (s < send) {
9041c2e3 3153 d = uvchr_to_utf8(d, toUPPER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
31351b04
JS
3154 s += ulen;
3155 }
a0ed51b3 3156 }
31351b04
JS
3157 else {
3158 while (s < send) {
9041c2e3 3159 d = uvchr_to_utf8(d, toUPPER_utf8( s ));
31351b04
JS
3160 s += UTF8SKIP(s);
3161 }
a0ed51b3 3162 }
31351b04 3163 *d = '\0';
7e2040f0 3164 SvUTF8_on(TARG);
31351b04
JS
3165 SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
3166 SETs(TARG);
a0ed51b3 3167 }
a0ed51b3 3168 }
626727d5 3169 else {
014822e4 3170 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3171 dTARGET;
7e2040f0 3172 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
3173 sv_setsv(TARG, sv);
3174 sv = TARG;
3175 SETs(sv);
3176 }
3177 s = (U8*)SvPV_force(sv, len);
3178 if (len) {
3179 register U8 *send = s + len;
3180
2de3dbcc 3181 if (IN_LOCALE_RUNTIME) {
31351b04
JS
3182 TAINT;
3183 SvTAINTED_on(sv);
3184 for (; s < send; s++)
3185 *s = toUPPER_LC(*s);
3186 }
3187 else {
3188 for (; s < send; s++)
3189 *s = toUPPER(*s);
3190 }
bbce6d69 3191 }
79072805 3192 }
31351b04
JS
3193 if (SvSMAGICAL(sv))
3194 mg_set(sv);
79072805
LW
3195 RETURN;
3196}
3197
3198PP(pp_lc)
3199{
39644a26 3200 dSP;
79072805 3201 SV *sv = TOPs;
a0ed51b3 3202 register U8 *s;
463ee0b2 3203 STRLEN len;
79072805 3204
7e2040f0 3205 if (DO_UTF8(sv)) {
a0ed51b3 3206 dTARGET;
ba210ebe 3207 STRLEN ulen;
a0ed51b3
LW
3208 register U8 *d;
3209 U8 *send;
3210
dfe13c55 3211 s = (U8*)SvPV(sv,len);
a5a20234 3212 if (!len) {
7e2040f0 3213 SvUTF8_off(TARG); /* decontaminate */
a5a20234
LW
3214 sv_setpvn(TARG, "", 0);
3215 SETs(TARG);
a0ed51b3
LW
3216 }
3217 else {
31351b04
JS
3218 (void)SvUPGRADE(TARG, SVt_PV);
3219 SvGROW(TARG, (len * 2) + 1);
3220 (void)SvPOK_only(TARG);
3221 d = (U8*)SvPVX(TARG);
3222 send = s + len;
2de3dbcc 3223 if (IN_LOCALE_RUNTIME) {
31351b04
JS
3224 TAINT;
3225 SvTAINTED_on(TARG);
3226 while (s < send) {
9041c2e3 3227 d = uvchr_to_utf8(d, toLOWER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
31351b04
JS
3228 s += ulen;
3229 }
a0ed51b3 3230 }
31351b04
JS
3231 else {
3232 while (s < send) {
9041c2e3 3233 d = uvchr_to_utf8(d, toLOWER_utf8(s));
31351b04
JS
3234 s += UTF8SKIP(s);
3235 }
a0ed51b3 3236 }
31351b04 3237 *d = '\0';
7e2040f0 3238 SvUTF8_on(TARG);
31351b04
JS
3239 SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
3240 SETs(TARG);
a0ed51b3 3241 }
79072805 3242 }
626727d5 3243 else {
014822e4 3244 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 3245 dTARGET;
7e2040f0 3246 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
3247 sv_setsv(TARG, sv);
3248 sv = TARG;
3249 SETs(sv);
a0ed51b3 3250 }
bbce6d69 3251
31351b04
JS
3252 s = (U8*)SvPV_force(sv, len);
3253 if (len) {
3254 register U8 *send = s + len;
bbce6d69 3255
2de3dbcc 3256 if (IN_LOCALE_RUNTIME) {
31351b04
JS
3257 TAINT;
3258 SvTAINTED_on(sv);
3259 for (; s < send; s++)
3260 *s = toLOWER_LC(*s);
3261 }
3262 else {
3263 for (; s < send; s++)
3264 *s = toLOWER(*s);
3265 }
bbce6d69 3266 }
79072805 3267 }
31351b04
JS
3268 if (SvSMAGICAL(sv))
3269 mg_set(sv);
79072805
LW
3270 RETURN;
3271}
3272
a0d0e21e 3273PP(pp_quotemeta)
79072805 3274{
39644a26 3275 dSP; dTARGET;
a0d0e21e
LW
3276 SV *sv = TOPs;
3277 STRLEN len;
3278 register char *s = SvPV(sv,len);
3279 register char *d;
79072805 3280
7e2040f0 3281 SvUTF8_off(TARG); /* decontaminate */
a0d0e21e
LW
3282 if (len) {
3283 (void)SvUPGRADE(TARG, SVt_PV);
c07a80fd 3284 SvGROW(TARG, (len * 2) + 1);
a0d0e21e 3285 d = SvPVX(TARG);
7e2040f0 3286 if (DO_UTF8(sv)) {
0dd2cdef 3287 while (len) {
fd400ab9 3288 if (UTF8_IS_CONTINUED(*s)) {
0dd2cdef
LW
3289 STRLEN ulen = UTF8SKIP(s);
3290 if (ulen > len)
3291 ulen = len;
3292 len -= ulen;
3293 while (ulen--)
3294 *d++ = *s++;
3295 }
3296 else {
3297 if (!isALNUM(*s))
3298 *d++ = '\\';
3299 *d++ = *s++;
3300 len--;
3301 }
3302 }
7e2040f0 3303 SvUTF8_on(TARG);
0dd2cdef
LW
3304 }
3305 else {
3306 while (len--) {
3307 if (!isALNUM(*s))
3308 *d++ = '\\';
3309 *d++ = *s++;
3310 }
79072805 3311 }
a0d0e21e
LW
3312 *d = '\0';
3313 SvCUR_set(TARG, d - SvPVX(TARG));
3aa33fe5 3314 (void)SvPOK_only_UTF8(TARG);
79072805 3315 }
a0d0e21e
LW
3316 else
3317 sv_setpvn(TARG, s, len);
3318 SETs(TARG);
31351b04
JS
3319 if (SvSMAGICAL(TARG))
3320 mg_set(TARG);
79072805
LW
3321 RETURN;
3322}
3323
a0d0e21e 3324/* Arrays. */
79072805 3325
a0d0e21e 3326PP(pp_aslice)
79072805 3327{
39644a26 3328 dSP; dMARK; dORIGMARK;
a0d0e21e
LW
3329 register SV** svp;
3330 register AV* av = (AV*)POPs;
78f9721b 3331 register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
3280af22 3332 I32 arybase = PL_curcop->cop_arybase;
748a9306 3333 I32 elem;
79072805 3334
a0d0e21e 3335 if (SvTYPE(av) == SVt_PVAV) {
533c011a 3336 if (lval && PL_op->op_private & OPpLVAL_INTRO) {
748a9306 3337 I32 max = -1;
924508f0 3338 for (svp = MARK + 1; svp <= SP; svp++) {
748a9306
LW
3339 elem = SvIVx(*svp);
3340 if (elem > max)
3341 max = elem;
3342 }
3343 if (max > AvMAX(av))
3344 av_extend(av, max);
3345 }
a0d0e21e 3346 while (++MARK <= SP) {
748a9306 3347 elem = SvIVx(*MARK);
a0d0e21e 3348
748a9306
LW
3349 if (elem > 0)
3350 elem -= arybase;
a0d0e21e
LW
3351 svp = av_fetch(av, elem, lval);
3352 if (lval) {
3280af22 3353 if (!svp || *svp == &PL_sv_undef)
cea2e8a9 3354 DIE(aTHX_ PL_no_aelem, elem);
533c011a 3355 if (PL_op->op_private & OPpLVAL_INTRO)
161b7d16 3356 save_aelem(av, elem, svp);
79072805 3357 }
3280af22 3358 *MARK = svp ? *svp : &PL_sv_undef;
79072805
LW
3359 }
3360 }
748a9306 3361 if (GIMME != G_ARRAY) {
a0d0e21e
LW
3362 MARK = ORIGMARK;
3363 *++MARK = *SP;
3364 SP = MARK;
3365 }
79072805
LW
3366 RETURN;
3367}
3368
3369/* Associative arrays. */
3370
3371PP(pp_each)
3372{
39644a26 3373 dSP;
79072805 3374 HV *hash = (HV*)POPs;
c07a80fd 3375 HE *entry;
54310121 3376 I32 gimme = GIMME_V;
c750a3ec 3377 I32 realhv = (SvTYPE(hash) == SVt_PVHV);
8ec5e241 3378
c07a80fd 3379 PUTBACK;
c750a3ec
MB
3380 /* might clobber stack_sp */
3381 entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
c07a80fd 3382 SPAGAIN;
79072805 3383
79072805
LW
3384 EXTEND(SP, 2);
3385 if (entry) {
54310121
PP
3386 PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
3387 if (gimme == G_ARRAY) {
59af0135 3388 SV *val;
c07a80fd 3389 PUTBACK;
c750a3ec 3390 /* might clobber stack_sp */
59af0135
GS
3391 val = realhv ?
3392 hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
c07a80fd 3393 SPAGAIN;
59af0135 3394 PUSHs(val);
79072805 3395 }
79072805 3396 }
54310121 3397 else if (gimme == G_SCALAR)
79072805
LW
3398 RETPUSHUNDEF;
3399
3400 RETURN;
3401}
3402
3403PP(pp_values)
3404{
cea2e8a9 3405 return do_kv();
79072805
LW
3406}
3407
3408PP(pp_keys)
3409{
cea2e8a9 3410 return do_kv();
79072805
LW
3411}
3412
3413PP(pp_delete)
3414{
39644a26 3415 dSP;
54310121
PP
3416 I32 gimme = GIMME_V;
3417 I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
79072805 3418 SV *sv;
5f05dabc
PP
3419 HV *hv;
3420
533c011a 3421 if (PL_op->op_private & OPpSLICE) {
5f05dabc 3422 dMARK; dORIGMARK;
97fcbf96 3423 U32 hvtype;
5f05dabc 3424 hv = (HV*)POPs;
97fcbf96 3425 hvtype = SvTYPE(hv);
01020589
GS
3426 if (hvtype == SVt_PVHV) { /* hash element */
3427 while (++MARK <= SP) {
ae77835f 3428 sv = hv_delete_ent(hv, *MARK, discard, 0);
01020589
GS
3429 *MARK = sv ? sv : &PL_sv_undef;
3430 }
5f05dabc 3431 }
01020589
GS
3432 else if (hvtype == SVt_PVAV) {
3433 if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
3434 while (++MARK <= SP) {
3435 sv = av_delete((AV*)hv, SvIV(*MARK), discard);
3436 *MARK = sv ? sv : &PL_sv_undef;
3437 }
3438 }
3439 else { /* pseudo-hash element */
3440 while (++MARK <= SP) {
3441 sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
3442 *MARK = sv ? sv : &PL_sv_undef;
3443 }
3444 }
3445 }
3446 else
3447 DIE(aTHX_ "Not a HASH reference");
54310121
PP
3448 if (discard)
3449 SP = ORIGMARK;
3450 else if (gimme == G_SCALAR) {
5f05dabc
PP
3451 MARK = ORIGMARK;
3452 *++MARK = *SP;
3453 SP = MARK;
3454 }
3455 }
3456 else {
3457 SV *keysv = POPs;
3458 hv = (HV*)POPs;
97fcbf96
MB
3459 if (SvTYPE(hv) == SVt_PVHV)
3460 sv = hv_delete_ent(hv, keysv, discard, 0);
01020589
GS
3461 else if (SvTYPE(hv) == SVt_PVAV) {
3462 if (PL_op->op_flags & OPf_SPECIAL)
3463 sv = av_delete((AV*)hv, SvIV(keysv), discard);
3464 else
3465 sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
3466 }
97fcbf96 3467 else
cea2e8a9 3468 DIE(aTHX_ "Not a HASH reference");
5f05dabc 3469 if (!sv)
3280af22 3470 sv = &PL_sv_undef;
54310121
PP
3471 if (!discard)
3472 PUSHs(sv);
79072805 3473 }
79072805
LW
3474 RETURN;
3475}
3476
a0d0e21e 3477PP(pp_exists)
79072805 3478{
39644a26 3479 dSP;
afebc493
GS
3480 SV *tmpsv;
3481 HV *hv;
3482
3483 if (PL_op->op_private & OPpEXISTS_SUB) {
3484 GV *gv;
3485 CV *cv;
3486 SV *sv = POPs;
3487 cv = sv_2cv(sv, &hv, &gv, FALSE);
3488 if (cv)
3489 RETPUSHYES;
3490 if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
3491 RETPUSHYES;
3492 RETPUSHNO;
3493 }
3494 tmpsv = POPs;
3495 hv = (HV*)POPs;
c750a3ec 3496 if (SvTYPE(hv) == SVt_PVHV) {
ae77835f 3497 if (hv_exists_ent(hv, tmpsv, 0))
c750a3ec 3498 RETPUSHYES;
ef54e1a4
JH
3499 }
3500 else if (SvTYPE(hv) == SVt_PVAV) {
01020589
GS
3501 if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
3502 if (av_exists((AV*)hv, SvIV(tmpsv)))
3503 RETPUSHYES;
3504 }
3505 else if (avhv_exists_ent((AV*)hv, tmpsv, 0)) /* pseudo-hash element */
c750a3ec 3506 RETPUSHYES;
ef54e1a4
JH
3507 }
3508 else {
cea2e8a9 3509 DIE(aTHX_ "Not a HASH reference");
a0d0e21e 3510 }
a0d0e21e
LW
3511 RETPUSHNO;
3512}
79072805 3513
a0d0e21e
LW
3514PP(pp_hslice)
3515{
39644a26 3516 dSP; dMARK; dORIGMARK;
a0d0e21e 3517 register HV *hv = (HV*)POPs;
78f9721b 3518 register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
c750a3ec 3519 I32 realhv = (SvTYPE(hv) == SVt_PVHV);
79072805 3520
0ebe0038 3521 if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
cea2e8a9 3522 DIE(aTHX_ "Can't localize pseudo-hash element");
0ebe0038 3523
c750a3ec 3524 if (realhv || SvTYPE(hv) == SVt_PVAV) {
a0d0e21e 3525 while (++MARK <= SP) {
f12c7020 3526 SV *keysv = *MARK;
ae77835f 3527 SV **svp;
d4fa047a
RH
3528 I32 preeminent = SvRMAGICAL(hv) ? 1 :
3529 realhv ? hv_exists_ent(hv, keysv, 0)
3530 : avhv_exists_ent((AV*)hv, keysv, 0);
ae77835f 3531 if (realhv) {
800e9ae0 3532 HE *he = hv_fetch_ent(hv, keysv, lval, 0);
ae77835f 3533 svp = he ? &HeVAL(he) : 0;
ef54e1a4
JH
3534 }
3535 else {
97fcbf96 3536 svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
ae77835f 3537 }
a0d0e21e 3538 if (lval) {
2d8e6c8d
GS
3539 if (!svp || *svp == &PL_sv_undef) {
3540 STRLEN n_a;
cea2e8a9 3541 DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
2d8e6c8d 3542 }
1f5346dc 3543 if (PL_op->op_private & OPpLVAL_INTRO) {
a227d84d 3544 if (preeminent)
1f5346dc
SC
3545 save_helem(hv, keysv, svp);
3546 else {
3547 STRLEN keylen;
3548 char *key = SvPV(keysv, keylen);
57813020 3549 SAVEDELETE(hv, savepvn(key,keylen), keylen);
1f5346dc
SC
3550 }
3551 }
93a17b20 3552 }
3280af22 3553 *MARK = svp ? *svp : &PL_sv_undef;
79072805
LW
3554 }
3555 }
a0d0e21e
LW
3556 if (GIMME != G_ARRAY) {
3557 MARK = ORIGMARK;
3558 *++MARK = *SP;
3559 SP = MARK;
79072805 3560 }
a0d0e21e
LW
3561 RETURN;
3562}
3563
3564/* List operators. */
3565
3566PP(pp_list)
3567{
39644a26 3568 dSP; dMARK;
a0d0e21e
LW
3569 if (GIMME != G_ARRAY) {
3570 if (++MARK <= SP)
3571 *MARK = *SP; /* unwanted list, return last item */
8990e307 3572 else
3280af22 3573 *MARK = &PL_sv_undef;
a0d0e21e 3574 SP = MARK;
79072805 3575 }
a0d0e21e 3576 RETURN;
79072805
LW
3577}
3578
a0d0e21e 3579PP(pp_lslice)
79072805 3580{
39644a26 3581 dSP;
3280af22
NIS
3582 SV **lastrelem = PL_stack_sp;
3583 SV **lastlelem = PL_stack_base + POPMARK;
3584 SV **firstlelem = PL_stack_base + POPMARK + 1;
a0d0e21e 3585 register SV **firstrelem = lastlelem + 1;
3280af22 3586 I32 arybase = PL_curcop->cop_arybase;
533c011a 3587 I32 lval = PL_op->op_flags & OPf_MOD;
4633a7c4 3588 I32 is_something_there = lval;
79072805 3589
a0d0e21e
LW
3590 register I32 max = lastrelem - lastlelem;
3591 register SV **lelem;
3592 register I32 ix;
3593
3594 if (GIMME != G_ARRAY) {
748a9306
LW
3595 ix = SvIVx(*lastlelem);
3596 if (ix < 0)
3597 ix += max;
3598 else
3599 ix -= arybase;
a0d0e21e 3600 if (ix < 0 || ix >= max)
3280af22 3601 *firstlelem = &PL_sv_undef;
a0d0e21e
LW
3602 else
3603 *firstlelem = firstrelem[ix];
3604 SP = firstlelem;
3605 RETURN;
3606 }
3607
3608 if (max == 0) {
3609 SP = firstlelem - 1;
3610 RETURN;
3611 }
3612
3613 for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
748a9306 3614 ix = SvIVx(*lelem);
c73bf8e3 3615 if (ix < 0)
a0d0e21e 3616 ix += max;
b13b2135 3617 else
748a9306 3618 ix -= arybase;
c73bf8e3
HS
3619 if (ix < 0 || ix >= max)
3620 *lelem = &PL_sv_undef;
3621 else {
3622 is_something_there = TRUE;
3623 if (!(*lelem = firstrelem[ix]))
3280af22 3624 *lelem = &PL_sv_undef;
748a9306 3625 }
79072805 3626 }
4633a7c4
LW
3627 if (is_something_there)
3628 SP = lastlelem;
3629 else
3630 SP = firstlelem - 1;
79072805
LW
3631 RETURN;
3632}
3633
a0d0e21e
LW
3634PP(pp_anonlist)
3635{
39644a26 3636 dSP; dMARK; dORIGMARK;
a0d0e21e 3637 I32 items = SP - MARK;
44a8e56a
PP
3638 SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
3639 SP = ORIGMARK; /* av_make() might realloc stack_sp */
3640 XPUSHs(av);
a0d0e21e
LW
3641 RETURN;
3642}
3643
3644PP(pp_anonhash)
79072805 3645{
39644a26 3646 dSP; dMARK; dORIGMARK;
a0d0e21e
LW
3647 HV* hv = (HV*)sv_2mortal((SV*)newHV());
3648
3649 while (MARK < SP) {
3650 SV* key = *++MARK;
a0d0e21e
LW
3651 SV *val = NEWSV(46, 0);
3652 if (MARK < SP)
3653 sv_setsv(val, *++MARK);
e476b1b5
GS
3654 else if (ckWARN(WARN_MISC))
3655 Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
f12c7020 3656 (void)hv_store_ent(hv,key,val,0);
79072805 3657 }
a0d0e21e
LW
3658 SP = ORIGMARK;
3659 XPUSHs((SV*)hv);
79072805
LW
3660 RETURN;
3661}
3662
a0d0e21e 3663PP(pp_splice)
79072805 3664{
39644a26 3665 dSP; dMARK; dORIGMARK;
a0d0e21e
LW
3666 register AV *ary = (AV*)*++MARK;
3667 register SV **src;
3668 register SV **dst;
3669 register I32 i;
3670 register I32 offset;
3671 register I32 length;
3672 I32 newlen;
3673 I32 after;
3674 I32 diff;
3675 SV **tmparyval = 0;
93965878
NIS
3676 MAGIC *mg;
3677
14befaf4 3678 if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
33c27489 3679 *MARK-- = SvTIED_obj((SV*)ary, mg);
93965878 3680 PUSHMARK(MARK);
8ec5e241 3681 PUTBACK;
a60c0954 3682 ENTER;
864dbfa3 3683 call_method("SPLICE",GIMME_V);
a60c0954 3684 LEAVE;
93965878
NIS
3685 SPAGAIN;
3686 RETURN;
3687 }
79072805 3688
a0d0e21e 3689 SP++;
79072805 3690
a0d0e21e 3691 if (++MARK < SP) {
84902520 3692 offset = i = SvIVx(*MARK);
a0d0e21e 3693 if (offset < 0)
93965878 3694 offset += AvFILLp(ary) + 1;
a0d0e21e 3695 else
3280af22 3696 offset -= PL_curcop->cop_arybase;
84902520 3697 if (offset < 0)
cea2e8a9 3698 DIE(aTHX_ PL_no_aelem, i);
a0d0e21e
LW
3699 if (++MARK < SP) {
3700 length = SvIVx(*MARK++);
48cdf507
GA
3701 if (length < 0) {
3702 length += AvFILLp(ary) - offset + 1;
3703 if (length < 0)
3704 length = 0;
3705 }
79072805
LW
3706 }
3707 else
a0d0e21e 3708 length = AvMAX(ary) + 1; /* close enough to infinity */
79072805 3709 }
a0d0e21e
LW
3710 else {
3711