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