This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make hints available via globals in the respective pragmas to
[perl5.git] / pp.c
CommitLineData
a0d0e21e 1/* pp.c
79072805 2 *
3818b22b 3 * Copyright (c) 1991-2000, 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
36477c24 19/*
ef2d312d
TH
20 * The compiler on Concurrent CX/UX systems has a subtle bug which only
21 * seems to show up when compiling pp.c - it generates the wrong double
22 * precision constant value for (double)UV_MAX when used inline in the body
23 * of the code below, so this makes a static variable up front (which the
24 * compiler seems to get correct) and uses it in place of UV_MAX below.
25 */
26#ifdef CXUX_BROKEN_CONSTANT_CONVERT
27static double UV_MAX_cxux = ((double)UV_MAX);
8ec5e241 28#endif
ef2d312d
TH
29
30/*
96e4d5b1
PP
31 * Offset for integer pack/unpack.
32 *
33 * On architectures where I16 and I32 aren't really 16 and 32 bits,
34 * which for now are all Crays, pack and unpack have to play games.
35 */
36
37/*
38 * These values are required for portability of pack() output.
39 * If they're not right on your machine, then pack() and unpack()
40 * wouldn't work right anyway; you'll need to apply the Cray hack.
41 * (I'd like to check them with #if, but you can't use sizeof() in
dc45a647
MB
42 * the preprocessor.) --???
43 */
44/*
45 The appropriate SHORTSIZE, INTSIZE, LONGSIZE, and LONGLONGSIZE
46 defines are now in config.h. --Andy Dougherty April 1998
96e4d5b1
PP
47 */
48#define SIZE16 2
49#define SIZE32 4
50
9851f69c
JH
51/* CROSSCOMPILE and MULTIARCH are going to affect pp_pack() and pp_unpack().
52 --jhi Feb 1999 */
53
726ea183
JH
54#if SHORTSIZE != SIZE16 || LONGSIZE != SIZE32
55# define PERL_NATINT_PACK
56#endif
57
0f9dfb06 58#if LONGSIZE > 4 && defined(_CRAY)
96e4d5b1
PP
59# if BYTEORDER == 0x12345678
60# define OFF16(p) (char*)(p)
61# define OFF32(p) (char*)(p)
62# else
63# if BYTEORDER == 0x87654321
64# define OFF16(p) ((char*)(p) + (sizeof(U16) - SIZE16))
65# define OFF32(p) ((char*)(p) + (sizeof(U32) - SIZE32))
66# else
67 }}}} bad cray byte order
68# endif
69# endif
70# define COPY16(s,p) (*(p) = 0, Copy(s, OFF16(p), SIZE16, char))
71# define COPY32(s,p) (*(p) = 0, Copy(s, OFF32(p), SIZE32, char))
ef54e1a4 72# define COPYNN(s,p,n) (*(p) = 0, Copy(s, (char *)(p), n, char))
96e4d5b1
PP
73# define CAT16(sv,p) sv_catpvn(sv, OFF16(p), SIZE16)
74# define CAT32(sv,p) sv_catpvn(sv, OFF32(p), SIZE32)
75#else
76# define COPY16(s,p) Copy(s, p, SIZE16, char)
77# define COPY32(s,p) Copy(s, p, SIZE32, char)
ef54e1a4 78# define COPYNN(s,p,n) Copy(s, (char *)(p), n, char)
96e4d5b1
PP
79# define CAT16(sv,p) sv_catpvn(sv, (char*)(p), SIZE16)
80# define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32)
81#endif
82
a0d0e21e 83/* variations on pp_null */
79072805 84
8ac85365
NIS
85#ifdef I_UNISTD
86#include <unistd.h>
87#endif
dfe9444c
AD
88
89/* XXX I can't imagine anyone who doesn't have this actually _needs_
90 it, since pid_t is an integral type.
91 --AD 2/20/1998
92*/
93#ifdef NEED_GETPID_PROTO
94extern Pid_t getpid (void);
8ac85365
NIS
95#endif
96
93a17b20
LW
97PP(pp_stub)
98{
4e35701f 99 djSP;
54310121 100 if (GIMME_V == G_SCALAR)
3280af22 101 XPUSHs(&PL_sv_undef);
93a17b20
LW
102 RETURN;
103}
104
79072805
LW
105PP(pp_scalar)
106{
107 return NORMAL;
108}
109
110/* Pushy stuff. */
111
93a17b20
LW
112PP(pp_padav)
113{
4e35701f 114 djSP; dTARGET;
533c011a
NIS
115 if (PL_op->op_private & OPpLVAL_INTRO)
116 SAVECLEARSV(PL_curpad[PL_op->op_targ]);
85e6fe83 117 EXTEND(SP, 1);
533c011a 118 if (PL_op->op_flags & OPf_REF) {
85e6fe83 119 PUSHs(TARG);
93a17b20 120 RETURN;
85e6fe83
LW
121 }
122 if (GIMME == G_ARRAY) {
123 I32 maxarg = AvFILL((AV*)TARG) + 1;
124 EXTEND(SP, maxarg);
93965878
NIS
125 if (SvMAGICAL(TARG)) {
126 U32 i;
127 for (i=0; i < maxarg; i++) {
128 SV **svp = av_fetch((AV*)TARG, i, FALSE);
3280af22 129 SP[i+1] = (svp) ? *svp : &PL_sv_undef;
93965878
NIS
130 }
131 }
132 else {
133 Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
134 }
85e6fe83
LW
135 SP += maxarg;
136 }
137 else {
138 SV* sv = sv_newmortal();
139 I32 maxarg = AvFILL((AV*)TARG) + 1;
140 sv_setiv(sv, maxarg);
141 PUSHs(sv);
142 }
143 RETURN;
93a17b20
LW
144}
145
146PP(pp_padhv)
147{
4e35701f 148 djSP; dTARGET;
54310121
PP
149 I32 gimme;
150
93a17b20 151 XPUSHs(TARG);
533c011a
NIS
152 if (PL_op->op_private & OPpLVAL_INTRO)
153 SAVECLEARSV(PL_curpad[PL_op->op_targ]);
154 if (PL_op->op_flags & OPf_REF)
93a17b20 155 RETURN;
54310121
PP
156 gimme = GIMME_V;
157 if (gimme == G_ARRAY) {
cea2e8a9 158 RETURNOP(do_kv());
85e6fe83 159 }
54310121 160 else if (gimme == G_SCALAR) {
85e6fe83 161 SV* sv = sv_newmortal();
46fc3d4c 162 if (HvFILL((HV*)TARG))
cea2e8a9 163 Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
46fc3d4c 164 (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1);
85e6fe83
LW
165 else
166 sv_setiv(sv, 0);
167 SETs(sv);
85e6fe83 168 }
54310121 169 RETURN;
93a17b20
LW
170}
171
ed6116ce
LW
172PP(pp_padany)
173{
cea2e8a9 174 DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
ed6116ce
LW
175}
176
79072805
LW
177/* Translations. */
178
179PP(pp_rv2gv)
180{
853846ea 181 djSP; dTOPss;
8ec5e241 182
ed6116ce 183 if (SvROK(sv)) {
a0d0e21e 184 wasref:
f5284f61
IZ
185 tryAMAGICunDEREF(to_gv);
186
ed6116ce 187 sv = SvRV(sv);
b1dadf13
PP
188 if (SvTYPE(sv) == SVt_PVIO) {
189 GV *gv = (GV*) sv_newmortal();
190 gv_init(gv, 0, "", 0, 0);
191 GvIOp(gv) = (IO *)sv;
3e3baf6d 192 (void)SvREFCNT_inc(sv);
b1dadf13 193 sv = (SV*) gv;
ef54e1a4
JH
194 }
195 else if (SvTYPE(sv) != SVt_PVGV)
cea2e8a9 196 DIE(aTHX_ "Not a GLOB reference");
79072805
LW
197 }
198 else {
93a17b20 199 if (SvTYPE(sv) != SVt_PVGV) {
748a9306 200 char *sym;
2d8e6c8d 201 STRLEN n_a;
748a9306 202
a0d0e21e
LW
203 if (SvGMAGICAL(sv)) {
204 mg_get(sv);
205 if (SvROK(sv))
206 goto wasref;
207 }
208 if (!SvOK(sv)) {
853846ea
NIS
209 /* If this is a 'my' scalar and flag is set then vivify
210 * NI-S 1999/05/07
211 */
1d8d4d2a 212 if (PL_op->op_private & OPpDEREF) {
2c8ac474
GS
213 char *name;
214 GV *gv;
215 if (cUNOP->op_targ) {
216 STRLEN len;
217 SV *namesv = PL_curpad[cUNOP->op_targ];
218 name = SvPV(namesv, len);
2d6d9f7a 219 gv = (GV*)NEWSV(0,0);
2c8ac474
GS
220 gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
221 }
222 else {
223 name = CopSTASHPV(PL_curcop);
224 gv = newGVgen(name);
1d8d4d2a 225 }
853846ea 226 sv_upgrade(sv, SVt_RV);
2c8ac474 227 SvRV(sv) = (SV*)gv;
853846ea 228 SvROK_on(sv);
1d8d4d2a 229 SvSETMAGIC(sv);
853846ea 230 goto wasref;
2c8ac474 231 }
533c011a
NIS
232 if (PL_op->op_flags & OPf_REF ||
233 PL_op->op_private & HINT_STRICT_REFS)
cea2e8a9 234 DIE(aTHX_ PL_no_usym, "a symbol");
599cee73 235 if (ckWARN(WARN_UNINITIALIZED))
b89fed5f 236 report_uninit();
a0d0e21e
LW
237 RETSETUNDEF;
238 }
2d8e6c8d 239 sym = SvPV(sv, n_a);
35cd451c
GS
240 if ((PL_op->op_flags & OPf_SPECIAL) &&
241 !(PL_op->op_flags & OPf_MOD))
242 {
243 sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV);
244 if (!sv)
245 RETSETUNDEF;
246 }
247 else {
248 if (PL_op->op_private & HINT_STRICT_REFS)
cea2e8a9 249 DIE(aTHX_ PL_no_symref, sym, "a symbol");
35cd451c
GS
250 sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
251 }
93a17b20 252 }
79072805 253 }
533c011a
NIS
254 if (PL_op->op_private & OPpLVAL_INTRO)
255 save_gp((GV*)sv, !(PL_op->op_flags & OPf_SPECIAL));
79072805
LW
256 SETs(sv);
257 RETURN;
258}
259
79072805
LW
260PP(pp_rv2sv)
261{
4e35701f 262 djSP; dTOPss;
79072805 263
ed6116ce 264 if (SvROK(sv)) {
a0d0e21e 265 wasref:
f5284f61
IZ
266 tryAMAGICunDEREF(to_sv);
267
ed6116ce 268 sv = SvRV(sv);
79072805
LW
269 switch (SvTYPE(sv)) {
270 case SVt_PVAV:
271 case SVt_PVHV:
272 case SVt_PVCV:
cea2e8a9 273 DIE(aTHX_ "Not a SCALAR reference");
79072805
LW
274 }
275 }
276 else {
f12c7020 277 GV *gv = (GV*)sv;
748a9306 278 char *sym;
2d8e6c8d 279 STRLEN n_a;
748a9306 280
463ee0b2 281 if (SvTYPE(gv) != SVt_PVGV) {
a0d0e21e
LW
282 if (SvGMAGICAL(sv)) {
283 mg_get(sv);
284 if (SvROK(sv))
285 goto wasref;
286 }
287 if (!SvOK(sv)) {
533c011a
NIS
288 if (PL_op->op_flags & OPf_REF ||
289 PL_op->op_private & HINT_STRICT_REFS)
cea2e8a9 290 DIE(aTHX_ PL_no_usym, "a SCALAR");
599cee73 291 if (ckWARN(WARN_UNINITIALIZED))
b89fed5f 292 report_uninit();
a0d0e21e
LW
293 RETSETUNDEF;
294 }
2d8e6c8d 295 sym = SvPV(sv, n_a);
35cd451c
GS
296 if ((PL_op->op_flags & OPf_SPECIAL) &&
297 !(PL_op->op_flags & OPf_MOD))
298 {
299 gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV);
300 if (!gv)
301 RETSETUNDEF;
302 }
303 else {
304 if (PL_op->op_private & HINT_STRICT_REFS)
cea2e8a9 305 DIE(aTHX_ PL_no_symref, sym, "a SCALAR");
35cd451c
GS
306 gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
307 }
463ee0b2
LW
308 }
309 sv = GvSV(gv);
a0d0e21e 310 }
533c011a
NIS
311 if (PL_op->op_flags & OPf_MOD) {
312 if (PL_op->op_private & OPpLVAL_INTRO)
a0d0e21e 313 sv = save_scalar((GV*)TOPs);
533c011a
NIS
314 else if (PL_op->op_private & OPpDEREF)
315 vivify_ref(sv, PL_op->op_private & OPpDEREF);
79072805 316 }
a0d0e21e 317 SETs(sv);
79072805
LW
318 RETURN;
319}
320
321PP(pp_av2arylen)
322{
4e35701f 323 djSP;
79072805
LW
324 AV *av = (AV*)TOPs;
325 SV *sv = AvARYLEN(av);
326 if (!sv) {
327 AvARYLEN(av) = sv = NEWSV(0,0);
328 sv_upgrade(sv, SVt_IV);
329 sv_magic(sv, (SV*)av, '#', Nullch, 0);
330 }
331 SETs(sv);
332 RETURN;
333}
334
a0d0e21e
LW
335PP(pp_pos)
336{
4e35701f 337 djSP; dTARGET; dPOPss;
8ec5e241 338
533c011a 339 if (PL_op->op_flags & OPf_MOD) {
5f05dabc
PP
340 if (SvTYPE(TARG) < SVt_PVLV) {
341 sv_upgrade(TARG, SVt_PVLV);
342 sv_magic(TARG, Nullsv, '.', Nullch, 0);
343 }
344
345 LvTYPE(TARG) = '.';
6ff81951
GS
346 if (LvTARG(TARG) != sv) {
347 if (LvTARG(TARG))
348 SvREFCNT_dec(LvTARG(TARG));
349 LvTARG(TARG) = SvREFCNT_inc(sv);
350 }
a0d0e21e
LW
351 PUSHs(TARG); /* no SvSETMAGIC */
352 RETURN;
353 }
354 else {
8ec5e241 355 MAGIC* mg;
a0d0e21e
LW
356
357 if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
358 mg = mg_find(sv, 'g');
565764a8 359 if (mg && mg->mg_len >= 0) {
a0ed51b3 360 I32 i = mg->mg_len;
7e2040f0 361 if (DO_UTF8(sv))
a0ed51b3
LW
362 sv_pos_b2u(sv, &i);
363 PUSHi(i + PL_curcop->cop_arybase);
a0d0e21e
LW
364 RETURN;
365 }
366 }
367 RETPUSHUNDEF;
368 }
369}
370
79072805
LW
371PP(pp_rv2cv)
372{
4e35701f 373 djSP;
79072805
LW
374 GV *gv;
375 HV *stash;
8990e307 376
4633a7c4
LW
377 /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
378 /* (But not in defined().) */
533c011a 379 CV *cv = sv_2cv(TOPs, &stash, &gv, !(PL_op->op_flags & OPf_SPECIAL));
07055b4c
CS
380 if (cv) {
381 if (CvCLONE(cv))
382 cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
cd06dffe 383 if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv))
d470f89e 384 DIE(aTHX_ "Can't modify non-lvalue subroutine call");
07055b4c
CS
385 }
386 else
3280af22 387 cv = (CV*)&PL_sv_undef;
79072805
LW
388 SETs((SV*)cv);
389 RETURN;
390}
391
c07a80fd
PP
392PP(pp_prototype)
393{
4e35701f 394 djSP;
c07a80fd
PP
395 CV *cv;
396 HV *stash;
397 GV *gv;
398 SV *ret;
399
3280af22 400 ret = &PL_sv_undef;
b6c543e3
IZ
401 if (SvPOK(TOPs) && SvCUR(TOPs) >= 7) {
402 char *s = SvPVX(TOPs);
403 if (strnEQ(s, "CORE::", 6)) {
404 int code;
405
406 code = keyword(s + 6, SvCUR(TOPs) - 6);
407 if (code < 0) { /* Overridable. */
408#define MAX_ARGS_OP ((sizeof(I32) - 1) * 2)
409 int i = 0, n = 0, seen_question = 0;
410 I32 oa;
411 char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */
412
413 while (i < MAXO) { /* The slow way. */
22c35a8c
GS
414 if (strEQ(s + 6, PL_op_name[i])
415 || strEQ(s + 6, PL_op_desc[i]))
416 {
b6c543e3 417 goto found;
22c35a8c 418 }
b6c543e3
IZ
419 i++;
420 }
421 goto nonesuch; /* Should not happen... */
422 found:
22c35a8c 423 oa = PL_opargs[i] >> OASHIFT;
b6c543e3
IZ
424 while (oa) {
425 if (oa & OA_OPTIONAL) {
426 seen_question = 1;
427 str[n++] = ';';
ef54e1a4
JH
428 }
429 else if (seen_question)
b6c543e3
IZ
430 goto set; /* XXXX system, exec */
431 if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
432 && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
433 str[n++] = '\\';
434 }
435 /* What to do with R ((un)tie, tied, (sys)read, recv)? */
436 str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
437 oa = oa >> 4;
438 }
439 str[n++] = '\0';
79cb57f6 440 ret = sv_2mortal(newSVpvn(str, n - 1));
ef54e1a4
JH
441 }
442 else if (code) /* Non-Overridable */
b6c543e3
IZ
443 goto set;
444 else { /* None such */
445 nonesuch:
d470f89e 446 DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
b6c543e3
IZ
447 }
448 }
449 }
c07a80fd 450 cv = sv_2cv(TOPs, &stash, &gv, FALSE);
5f05dabc 451 if (cv && SvPOK(cv))
79cb57f6 452 ret = sv_2mortal(newSVpvn(SvPVX(cv), SvCUR(cv)));
b6c543e3 453 set:
c07a80fd
PP
454 SETs(ret);
455 RETURN;
456}
457
a0d0e21e
LW
458PP(pp_anoncode)
459{
4e35701f 460 djSP;
533c011a 461 CV* cv = (CV*)PL_curpad[PL_op->op_targ];
a5f75d66 462 if (CvCLONE(cv))
b355b4e0 463 cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
5f05dabc 464 EXTEND(SP,1);
748a9306 465 PUSHs((SV*)cv);
a0d0e21e
LW
466 RETURN;
467}
468
469PP(pp_srefgen)
79072805 470{
4e35701f 471 djSP;
71be2cbc 472 *SP = refto(*SP);
79072805 473 RETURN;
8ec5e241 474}
a0d0e21e
LW
475
476PP(pp_refgen)
477{
4e35701f 478 djSP; dMARK;
a0d0e21e 479 if (GIMME != G_ARRAY) {
5f0b1d4e
GS
480 if (++MARK <= SP)
481 *MARK = *SP;
482 else
3280af22 483 *MARK = &PL_sv_undef;
5f0b1d4e
GS
484 *MARK = refto(*MARK);
485 SP = MARK;
486 RETURN;
a0d0e21e 487 }
bbce6d69 488 EXTEND_MORTAL(SP - MARK);
71be2cbc
PP
489 while (++MARK <= SP)
490 *MARK = refto(*MARK);
a0d0e21e 491 RETURN;
79072805
LW
492}
493
76e3520e 494STATIC SV*
cea2e8a9 495S_refto(pTHX_ SV *sv)
71be2cbc
PP
496{
497 SV* rv;
498
499 if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
500 if (LvTARGLEN(sv))
68dc0745
PP
501 vivify_defelem(sv);
502 if (!(sv = LvTARG(sv)))
3280af22 503 sv = &PL_sv_undef;
0dd88869 504 else
a6c40364 505 (void)SvREFCNT_inc(sv);
71be2cbc 506 }
d8b46c1b
GS
507 else if (SvTYPE(sv) == SVt_PVAV) {
508 if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv))
509 av_reify((AV*)sv);
510 SvTEMP_off(sv);
511 (void)SvREFCNT_inc(sv);
512 }
71be2cbc
PP
513 else if (SvPADTMP(sv))
514 sv = newSVsv(sv);
515 else {
516 SvTEMP_off(sv);
517 (void)SvREFCNT_inc(sv);
518 }
519 rv = sv_newmortal();
520 sv_upgrade(rv, SVt_RV);
521 SvRV(rv) = sv;
522 SvROK_on(rv);
523 return rv;
524}
525
79072805
LW
526PP(pp_ref)
527{
4e35701f 528 djSP; dTARGET;
463ee0b2 529 SV *sv;
79072805
LW
530 char *pv;
531
a0d0e21e 532 sv = POPs;
f12c7020
PP
533
534 if (sv && SvGMAGICAL(sv))
8ec5e241 535 mg_get(sv);
f12c7020 536
a0d0e21e 537 if (!sv || !SvROK(sv))
4633a7c4 538 RETPUSHNO;
79072805 539
ed6116ce 540 sv = SvRV(sv);
a0d0e21e 541 pv = sv_reftype(sv,TRUE);
463ee0b2 542 PUSHp(pv, strlen(pv));
79072805
LW
543 RETURN;
544}
545
546PP(pp_bless)
547{
4e35701f 548 djSP;
463ee0b2 549 HV *stash;
79072805 550
463ee0b2 551 if (MAXARG == 1)
11faa288 552 stash = CopSTASH(PL_curcop);
7b8d334a
GS
553 else {
554 SV *ssv = POPs;
555 STRLEN len;
556 char *ptr = SvPV(ssv,len);
e476b1b5
GS
557 if (ckWARN(WARN_MISC) && len == 0)
558 Perl_warner(aTHX_ WARN_MISC,
599cee73 559 "Explicit blessing to '' (assuming package main)");
7b8d334a
GS
560 stash = gv_stashpvn(ptr, len, TRUE);
561 }
a0d0e21e 562
5d3fdfeb 563 (void)sv_bless(TOPs, stash);
79072805
LW
564 RETURN;
565}
566
fb73857a
PP
567PP(pp_gelem)
568{
569 GV *gv;
570 SV *sv;
76e3520e 571 SV *tmpRef;
fb73857a 572 char *elem;
4e35701f 573 djSP;
2d8e6c8d
GS
574 STRLEN n_a;
575
fb73857a 576 sv = POPs;
2d8e6c8d 577 elem = SvPV(sv, n_a);
fb73857a 578 gv = (GV*)POPs;
76e3520e 579 tmpRef = Nullsv;
fb73857a
PP
580 sv = Nullsv;
581 switch (elem ? *elem : '\0')
582 {
583 case 'A':
584 if (strEQ(elem, "ARRAY"))
76e3520e 585 tmpRef = (SV*)GvAV(gv);
fb73857a
PP
586 break;
587 case 'C':
588 if (strEQ(elem, "CODE"))
76e3520e 589 tmpRef = (SV*)GvCVu(gv);
fb73857a
PP
590 break;
591 case 'F':
592 if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
76e3520e 593 tmpRef = (SV*)GvIOp(gv);
fb73857a
PP
594 break;
595 case 'G':
596 if (strEQ(elem, "GLOB"))
76e3520e 597 tmpRef = (SV*)gv;
fb73857a
PP
598 break;
599 case 'H':
600 if (strEQ(elem, "HASH"))
76e3520e 601 tmpRef = (SV*)GvHV(gv);
fb73857a
PP
602 break;
603 case 'I':
604 if (strEQ(elem, "IO"))
76e3520e 605 tmpRef = (SV*)GvIOp(gv);
fb73857a
PP
606 break;
607 case 'N':
608 if (strEQ(elem, "NAME"))
79cb57f6 609 sv = newSVpvn(GvNAME(gv), GvNAMELEN(gv));
fb73857a
PP
610 break;
611 case 'P':
612 if (strEQ(elem, "PACKAGE"))
613 sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
614 break;
615 case 'S':
616 if (strEQ(elem, "SCALAR"))
76e3520e 617 tmpRef = GvSV(gv);
fb73857a
PP
618 break;
619 }
76e3520e
GS
620 if (tmpRef)
621 sv = newRV(tmpRef);
fb73857a
PP
622 if (sv)
623 sv_2mortal(sv);
624 else
3280af22 625 sv = &PL_sv_undef;
fb73857a
PP
626 XPUSHs(sv);
627 RETURN;
628}
629
a0d0e21e 630/* Pattern matching */
79072805 631
a0d0e21e 632PP(pp_study)
79072805 633{
4e35701f 634 djSP; dPOPss;
a0d0e21e
LW
635 register unsigned char *s;
636 register I32 pos;
637 register I32 ch;
638 register I32 *sfirst;
639 register I32 *snext;
a0d0e21e
LW
640 STRLEN len;
641
3280af22 642 if (sv == PL_lastscream) {
1e422769
PP
643 if (SvSCREAM(sv))
644 RETPUSHYES;
645 }
c07a80fd 646 else {
3280af22
NIS
647 if (PL_lastscream) {
648 SvSCREAM_off(PL_lastscream);
649 SvREFCNT_dec(PL_lastscream);
c07a80fd 650 }
3280af22 651 PL_lastscream = SvREFCNT_inc(sv);
c07a80fd 652 }
1e422769
PP
653
654 s = (unsigned char*)(SvPV(sv, len));
655 pos = len;
656 if (pos <= 0)
657 RETPUSHNO;
3280af22
NIS
658 if (pos > PL_maxscream) {
659 if (PL_maxscream < 0) {
660 PL_maxscream = pos + 80;
661 New(301, PL_screamfirst, 256, I32);
662 New(302, PL_screamnext, PL_maxscream, I32);
79072805
LW
663 }
664 else {
3280af22
NIS
665 PL_maxscream = pos + pos / 4;
666 Renew(PL_screamnext, PL_maxscream, I32);
79072805 667 }
79072805 668 }
a0d0e21e 669
3280af22
NIS
670 sfirst = PL_screamfirst;
671 snext = PL_screamnext;
a0d0e21e
LW
672
673 if (!sfirst || !snext)
cea2e8a9 674 DIE(aTHX_ "do_study: out of memory");
a0d0e21e
LW
675
676 for (ch = 256; ch; --ch)
677 *sfirst++ = -1;
678 sfirst -= 256;
679
680 while (--pos >= 0) {
681 ch = s[pos];
682 if (sfirst[ch] >= 0)
683 snext[pos] = sfirst[ch] - pos;
684 else
685 snext[pos] = -pos;
686 sfirst[ch] = pos;
79072805
LW
687 }
688
c07a80fd 689 SvSCREAM_on(sv);
464e2e8a 690 sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */
1e422769 691 RETPUSHYES;
79072805
LW
692}
693
a0d0e21e 694PP(pp_trans)
79072805 695{
4e35701f 696 djSP; dTARG;
a0d0e21e
LW
697 SV *sv;
698
533c011a 699 if (PL_op->op_flags & OPf_STACKED)
a0d0e21e 700 sv = POPs;
79072805 701 else {
54b9620d 702 sv = DEFSV;
a0d0e21e 703 EXTEND(SP,1);
79072805 704 }
adbc6bb1 705 TARG = sv_newmortal();
4757a243 706 PUSHi(do_trans(sv));
a0d0e21e 707 RETURN;
79072805
LW
708}
709
a0d0e21e 710/* Lvalue operators. */
79072805 711
a0d0e21e
LW
712PP(pp_schop)
713{
4e35701f 714 djSP; dTARGET;
a0d0e21e
LW
715 do_chop(TARG, TOPs);
716 SETTARG;
717 RETURN;
79072805
LW
718}
719
a0d0e21e 720PP(pp_chop)
79072805 721{
4e35701f 722 djSP; dMARK; dTARGET;
a0d0e21e
LW
723 while (SP > MARK)
724 do_chop(TARG, POPs);
725 PUSHTARG;
726 RETURN;
79072805
LW
727}
728
a0d0e21e 729PP(pp_schomp)
79072805 730{
4e35701f 731 djSP; dTARGET;
a0d0e21e
LW
732 SETi(do_chomp(TOPs));
733 RETURN;
79072805
LW
734}
735
a0d0e21e 736PP(pp_chomp)
79072805 737{
4e35701f 738 djSP; dMARK; dTARGET;
a0d0e21e 739 register I32 count = 0;
8ec5e241 740
a0d0e21e
LW
741 while (SP > MARK)
742 count += do_chomp(POPs);
743 PUSHi(count);
744 RETURN;
79072805
LW
745}
746
a0d0e21e 747PP(pp_defined)
463ee0b2 748{
4e35701f 749 djSP;
a0d0e21e
LW
750 register SV* sv;
751
752 sv = POPs;
753 if (!sv || !SvANY(sv))
754 RETPUSHNO;
755 switch (SvTYPE(sv)) {
756 case SVt_PVAV:
6051dbdb 757 if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
a0d0e21e
LW
758 RETPUSHYES;
759 break;
760 case SVt_PVHV:
6051dbdb 761 if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
a0d0e21e
LW
762 RETPUSHYES;
763 break;
764 case SVt_PVCV:
765 if (CvROOT(sv) || CvXSUB(sv))
766 RETPUSHYES;
767 break;
768 default:
769 if (SvGMAGICAL(sv))
770 mg_get(sv);
771 if (SvOK(sv))
772 RETPUSHYES;
773 }
774 RETPUSHNO;
463ee0b2
LW
775}
776
a0d0e21e
LW
777PP(pp_undef)
778{
4e35701f 779 djSP;
a0d0e21e
LW
780 SV *sv;
781
533c011a 782 if (!PL_op->op_private) {
774d564b 783 EXTEND(SP, 1);
a0d0e21e 784 RETPUSHUNDEF;
774d564b 785 }
79072805 786
a0d0e21e
LW
787 sv = POPs;
788 if (!sv)
789 RETPUSHUNDEF;
85e6fe83 790
6fc92669
GS
791 if (SvTHINKFIRST(sv))
792 sv_force_normal(sv);
85e6fe83 793
a0d0e21e
LW
794 switch (SvTYPE(sv)) {
795 case SVt_NULL:
796 break;
797 case SVt_PVAV:
798 av_undef((AV*)sv);
799 break;
800 case SVt_PVHV:
801 hv_undef((HV*)sv);
802 break;
803 case SVt_PVCV:
e476b1b5
GS
804 if (ckWARN(WARN_MISC) && cv_const_sv((CV*)sv))
805 Perl_warner(aTHX_ WARN_MISC, "Constant subroutine %s undefined",
54310121 806 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
9607fc9c
PP
807 /* FALL THROUGH */
808 case SVt_PVFM:
6fc92669
GS
809 {
810 /* let user-undef'd sub keep its identity */
811 GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv));
812 cv_undef((CV*)sv);
813 CvGV((CV*)sv) = gv;
814 }
a0d0e21e 815 break;
8e07c86e 816 case SVt_PVGV:
44a8e56a 817 if (SvFAKE(sv))
3280af22 818 SvSetMagicSV(sv, &PL_sv_undef);
20408e3c
GS
819 else {
820 GP *gp;
821 gp_free((GV*)sv);
822 Newz(602, gp, 1, GP);
823 GvGP(sv) = gp_ref(gp);
824 GvSV(sv) = NEWSV(72,0);
57843af0 825 GvLINE(sv) = CopLINE(PL_curcop);
20408e3c
GS
826 GvEGV(sv) = (GV*)sv;
827 GvMULTI_on(sv);
828 }
44a8e56a 829 break;
a0d0e21e 830 default:
1e422769 831 if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
4633a7c4
LW
832 (void)SvOOK_off(sv);
833 Safefree(SvPVX(sv));
834 SvPV_set(sv, Nullch);
835 SvLEN_set(sv, 0);
a0d0e21e 836 }
4633a7c4
LW
837 (void)SvOK_off(sv);
838 SvSETMAGIC(sv);
79072805 839 }
a0d0e21e
LW
840
841 RETPUSHUNDEF;
79072805
LW
842}
843
a0d0e21e 844PP(pp_predec)
79072805 845{
4e35701f 846 djSP;
68dc0745 847 if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
d470f89e 848 DIE(aTHX_ PL_no_modify);
25da4f38 849 if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
55497cff
PP
850 SvIVX(TOPs) != IV_MIN)
851 {
748a9306 852 --SvIVX(TOPs);
55497cff 853 SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
748a9306
LW
854 }
855 else
856 sv_dec(TOPs);
a0d0e21e
LW
857 SvSETMAGIC(TOPs);
858 return NORMAL;
859}
79072805 860
a0d0e21e
LW
861PP(pp_postinc)
862{
4e35701f 863 djSP; dTARGET;
68dc0745 864 if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
d470f89e 865 DIE(aTHX_ PL_no_modify);
a0d0e21e 866 sv_setsv(TARG, TOPs);
25da4f38 867 if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
55497cff
PP
868 SvIVX(TOPs) != IV_MAX)
869 {
748a9306 870 ++SvIVX(TOPs);
55497cff 871 SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
748a9306
LW
872 }
873 else
874 sv_inc(TOPs);
a0d0e21e
LW
875 SvSETMAGIC(TOPs);
876 if (!SvOK(TARG))
877 sv_setiv(TARG, 0);
878 SETs(TARG);
879 return NORMAL;
880}
79072805 881
a0d0e21e
LW
882PP(pp_postdec)
883{
4e35701f 884 djSP; dTARGET;
43192e07 885 if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
d470f89e 886 DIE(aTHX_ PL_no_modify);
a0d0e21e 887 sv_setsv(TARG, TOPs);
25da4f38 888 if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
55497cff
PP
889 SvIVX(TOPs) != IV_MIN)
890 {
748a9306 891 --SvIVX(TOPs);
55497cff 892 SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
748a9306
LW
893 }
894 else
895 sv_dec(TOPs);
a0d0e21e
LW
896 SvSETMAGIC(TOPs);
897 SETs(TARG);
898 return NORMAL;
899}
79072805 900
a0d0e21e
LW
901/* Ordinary operators. */
902
903PP(pp_pow)
904{
8ec5e241 905 djSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
a0d0e21e
LW
906 {
907 dPOPTOPnnrl;
73b309ea 908 SETn( Perl_pow( left, right) );
a0d0e21e 909 RETURN;
93a17b20 910 }
a0d0e21e
LW
911}
912
913PP(pp_multiply)
914{
8ec5e241 915 djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
a0d0e21e
LW
916 {
917 dPOPTOPnnrl;
918 SETn( left * right );
919 RETURN;
79072805 920 }
a0d0e21e
LW
921}
922
923PP(pp_divide)
924{
8ec5e241 925 djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
a0d0e21e 926 {
77676ba1 927 dPOPPOPnnrl;
65202027 928 NV value;
7a4c00b4 929 if (right == 0.0)
cea2e8a9 930 DIE(aTHX_ "Illegal division by zero");
a0d0e21e
LW
931#ifdef SLOPPYDIVIDE
932 /* insure that 20./5. == 4. */
933 {
7a4c00b4 934 IV k;
65202027
DS
935 if ((NV)I_V(left) == left &&
936 (NV)I_V(right) == right &&
7a4c00b4 937 (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
a0d0e21e 938 value = k;
ef54e1a4
JH
939 }
940 else {
7a4c00b4 941 value = left / right;
79072805 942 }
a0d0e21e
LW
943 }
944#else
7a4c00b4 945 value = left / right;
a0d0e21e
LW
946#endif
947 PUSHn( value );
948 RETURN;
79072805 949 }
a0d0e21e
LW
950}
951
952PP(pp_modulo)
953{
76e3520e 954 djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
a0d0e21e 955 {
787eafbd
IZ
956 UV left;
957 UV right;
958 bool left_neg;
959 bool right_neg;
960 bool use_double = 0;
65202027
DS
961 NV dright;
962 NV dleft;
787eafbd
IZ
963
964 if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
965 IV i = SvIVX(POPs);
966 right = (right_neg = (i < 0)) ? -i : i;
967 }
968 else {
969 dright = POPn;
970 use_double = 1;
971 right_neg = dright < 0;
972 if (right_neg)
973 dright = -dright;
974 }
a0d0e21e 975
787eafbd
IZ
976 if (!use_double && SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
977 IV i = SvIVX(POPs);
978 left = (left_neg = (i < 0)) ? -i : i;
979 }
980 else {
981 dleft = POPn;
982 if (!use_double) {
a1bd196e
GS
983 use_double = 1;
984 dright = right;
787eafbd
IZ
985 }
986 left_neg = dleft < 0;
987 if (left_neg)
988 dleft = -dleft;
989 }
68dc0745 990
787eafbd 991 if (use_double) {
65202027 992 NV dans;
787eafbd
IZ
993
994#if 1
787eafbd
IZ
995/* Somehow U_V is pessimized even if CASTFLAGS is 0 */
996# if CASTFLAGS & 2
997# define CAST_D2UV(d) U_V(d)
998# else
999# define CAST_D2UV(d) ((UV)(d))
1000# endif
a1bd196e
GS
1001 /* Tried to do this only in the case DOUBLESIZE <= UV_SIZE,
1002 * or, in other words, precision of UV more than of NV.
1003 * But in fact the approach below turned out to be an
1004 * optimization - floor() may be slow */
787eafbd
IZ
1005 if (dright <= UV_MAX && dleft <= UV_MAX) {
1006 right = CAST_D2UV(dright);
1007 left = CAST_D2UV(dleft);
1008 goto do_uv;
1009 }
1010#endif
1011
1012 /* Backward-compatibility clause: */
73b309ea
JH
1013 dright = Perl_floor(dright + 0.5);
1014 dleft = Perl_floor(dleft + 0.5);
787eafbd
IZ
1015
1016 if (!dright)
cea2e8a9 1017 DIE(aTHX_ "Illegal modulus zero");
787eafbd 1018
65202027 1019 dans = Perl_fmod(dleft, dright);
787eafbd
IZ
1020 if ((left_neg != right_neg) && dans)
1021 dans = dright - dans;
1022 if (right_neg)
1023 dans = -dans;
1024 sv_setnv(TARG, dans);
1025 }
1026 else {
1027 UV ans;
1028
1029 do_uv:
1030 if (!right)
cea2e8a9 1031 DIE(aTHX_ "Illegal modulus zero");
787eafbd
IZ
1032
1033 ans = left % right;
1034 if ((left_neg != right_neg) && ans)
1035 ans = right - ans;
1036 if (right_neg) {
1037 /* XXX may warn: unary minus operator applied to unsigned type */
1038 /* could change -foo to be (~foo)+1 instead */
1039 if (ans <= ~((UV)IV_MAX)+1)
1040 sv_setiv(TARG, ~ans+1);
1041 else
65202027 1042 sv_setnv(TARG, -(NV)ans);
787eafbd
IZ
1043 }
1044 else
1045 sv_setuv(TARG, ans);
1046 }
1047 PUSHTARG;
1048 RETURN;
79072805 1049 }
a0d0e21e 1050}
79072805 1051
a0d0e21e
LW
1052PP(pp_repeat)
1053{
4e35701f 1054 djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
748a9306 1055 {
a0d0e21e 1056 register I32 count = POPi;
533c011a 1057 if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
a0d0e21e
LW
1058 dMARK;
1059 I32 items = SP - MARK;
1060 I32 max;
79072805 1061
a0d0e21e
LW
1062 max = items * count;
1063 MEXTEND(MARK, max);
1064 if (count > 1) {
1065 while (SP > MARK) {
1066 if (*SP)
1067 SvTEMP_off((*SP));
1068 SP--;
79072805 1069 }
a0d0e21e
LW
1070 MARK++;
1071 repeatcpy((char*)(MARK + items), (char*)MARK,
1072 items * sizeof(SV*), count - 1);
1073 SP += max;
79072805 1074 }
a0d0e21e
LW
1075 else if (count <= 0)
1076 SP -= items;
79072805 1077 }
a0d0e21e
LW
1078 else { /* Note: mark already snarfed by pp_list */
1079 SV *tmpstr;
1080 STRLEN len;
1081
1082 tmpstr = POPs;
a0d0e21e
LW
1083 SvSetSV(TARG, tmpstr);
1084 SvPV_force(TARG, len);
8ebc5c01
PP
1085 if (count != 1) {
1086 if (count < 1)
1087 SvCUR_set(TARG, 0);
1088 else {
1089 SvGROW(TARG, (count * len) + 1);
a0d0e21e 1090 repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
8ebc5c01 1091 SvCUR(TARG) *= count;
7a4c00b4 1092 }
a0d0e21e 1093 *SvEND(TARG) = '\0';
a0d0e21e 1094 }
8ebc5c01 1095 (void)SvPOK_only(TARG);
a0d0e21e 1096 PUSHTARG;
79072805 1097 }
a0d0e21e 1098 RETURN;
748a9306 1099 }
a0d0e21e 1100}
79072805 1101
a0d0e21e
LW
1102PP(pp_subtract)
1103{
8ec5e241 1104 djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
a0d0e21e 1105 {
7a4c00b4 1106 dPOPTOPnnrl_ul;
a0d0e21e
LW
1107 SETn( left - right );
1108 RETURN;
79072805 1109 }
a0d0e21e 1110}
79072805 1111
a0d0e21e
LW
1112PP(pp_left_shift)
1113{
8ec5e241 1114 djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
a0d0e21e 1115 {
972b05a9 1116 IV shift = POPi;
d0ba1bd2 1117 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
1118 IV i = TOPi;
1119 SETi(i << shift);
d0ba1bd2
JH
1120 }
1121 else {
972b05a9
JH
1122 UV u = TOPu;
1123 SETu(u << shift);
d0ba1bd2 1124 }
55497cff 1125 RETURN;
79072805 1126 }
a0d0e21e 1127}
79072805 1128
a0d0e21e
LW
1129PP(pp_right_shift)
1130{
8ec5e241 1131 djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
a0d0e21e 1132 {
972b05a9 1133 IV shift = POPi;
d0ba1bd2 1134 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
1135 IV i = TOPi;
1136 SETi(i >> shift);
d0ba1bd2
JH
1137 }
1138 else {
972b05a9
JH
1139 UV u = TOPu;
1140 SETu(u >> shift);
d0ba1bd2 1141 }
a0d0e21e 1142 RETURN;
93a17b20 1143 }
79072805
LW
1144}
1145
a0d0e21e 1146PP(pp_lt)
79072805 1147{
8ec5e241 1148 djSP; tryAMAGICbinSET(lt,0);
a0d0e21e
LW
1149 {
1150 dPOPnv;
54310121 1151 SETs(boolSV(TOPn < value));
a0d0e21e 1152 RETURN;
79072805 1153 }
a0d0e21e 1154}
79072805 1155
a0d0e21e
LW
1156PP(pp_gt)
1157{
8ec5e241 1158 djSP; tryAMAGICbinSET(gt,0);
a0d0e21e
LW
1159 {
1160 dPOPnv;
54310121 1161 SETs(boolSV(TOPn > value));
a0d0e21e 1162 RETURN;
79072805 1163 }
a0d0e21e
LW
1164}
1165
1166PP(pp_le)
1167{
8ec5e241 1168 djSP; tryAMAGICbinSET(le,0);
a0d0e21e
LW
1169 {
1170 dPOPnv;
54310121 1171 SETs(boolSV(TOPn <= value));
a0d0e21e 1172 RETURN;
79072805 1173 }
a0d0e21e
LW
1174}
1175
1176PP(pp_ge)
1177{
8ec5e241 1178 djSP; tryAMAGICbinSET(ge,0);
a0d0e21e
LW
1179 {
1180 dPOPnv;
54310121 1181 SETs(boolSV(TOPn >= value));
a0d0e21e 1182 RETURN;
79072805 1183 }
a0d0e21e 1184}
79072805 1185
a0d0e21e
LW
1186PP(pp_ne)
1187{
8ec5e241 1188 djSP; tryAMAGICbinSET(ne,0);
a0d0e21e
LW
1189 {
1190 dPOPnv;
54310121 1191 SETs(boolSV(TOPn != value));
a0d0e21e
LW
1192 RETURN;
1193 }
79072805
LW
1194}
1195
a0d0e21e 1196PP(pp_ncmp)
79072805 1197{
8ec5e241 1198 djSP; dTARGET; tryAMAGICbin(ncmp,0);
a0d0e21e
LW
1199 {
1200 dPOPTOPnnrl;
1201 I32 value;
1ad04cfd
JH
1202#ifdef __osf__ /* XXX fix in 5.6.1 --jhi */
1203#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
1204#define Perl_isnan isnanl
1205#else
1206#define Perl_isnan isnan
1207#endif
1208#endif
79072805 1209
1ad04cfd
JH
1210#ifdef __osf__ /* XXX fix in 5.6.1 --jhi */
1211 if (Perl_isnan(left) || Perl_isnan(right)) {
1212 SETs(&PL_sv_undef);
1213 RETURN;
1214 }
1215 value = (left > right) - (left < right);
1216#else
ff0cee69 1217 if (left == right)
a0d0e21e 1218 value = 0;
a0d0e21e
LW
1219 else if (left < right)
1220 value = -1;
44a8e56a
PP
1221 else if (left > right)
1222 value = 1;
1223 else {
3280af22 1224 SETs(&PL_sv_undef);
44a8e56a
PP
1225 RETURN;
1226 }
1ad04cfd 1227#endif
a0d0e21e
LW
1228 SETi(value);
1229 RETURN;
79072805 1230 }
a0d0e21e 1231}
79072805 1232
a0d0e21e
LW
1233PP(pp_slt)
1234{
8ec5e241 1235 djSP; tryAMAGICbinSET(slt,0);
a0d0e21e
LW
1236 {
1237 dPOPTOPssrl;
533c011a 1238 int cmp = ((PL_op->op_private & OPpLOCALE)
bbce6d69
PP
1239 ? sv_cmp_locale(left, right)
1240 : sv_cmp(left, right));
54310121 1241 SETs(boolSV(cmp < 0));
a0d0e21e
LW
1242 RETURN;
1243 }
79072805
LW
1244}
1245
a0d0e21e 1246PP(pp_sgt)
79072805 1247{
8ec5e241 1248 djSP; tryAMAGICbinSET(sgt,0);
a0d0e21e
LW
1249 {
1250 dPOPTOPssrl;
533c011a 1251 int cmp = ((PL_op->op_private & OPpLOCALE)
bbce6d69
PP
1252 ? sv_cmp_locale(left, right)
1253 : sv_cmp(left, right));
54310121 1254 SETs(boolSV(cmp > 0));
a0d0e21e
LW
1255 RETURN;
1256 }
1257}
79072805 1258
a0d0e21e
LW
1259PP(pp_sle)
1260{
8ec5e241 1261 djSP; tryAMAGICbinSET(sle,0);
a0d0e21e
LW
1262 {
1263 dPOPTOPssrl;
533c011a 1264 int cmp = ((PL_op->op_private & OPpLOCALE)
bbce6d69
PP
1265 ? sv_cmp_locale(left, right)
1266 : sv_cmp(left, right));
54310121 1267 SETs(boolSV(cmp <= 0));
a0d0e21e 1268 RETURN;
79072805 1269 }
79072805
LW
1270}
1271
a0d0e21e
LW
1272PP(pp_sge)
1273{
8ec5e241 1274 djSP; tryAMAGICbinSET(sge,0);
a0d0e21e
LW
1275 {
1276 dPOPTOPssrl;
533c011a 1277 int cmp = ((PL_op->op_private & OPpLOCALE)
bbce6d69
PP
1278 ? sv_cmp_locale(left, right)
1279 : sv_cmp(left, right));
54310121 1280 SETs(boolSV(cmp >= 0));
a0d0e21e
LW
1281 RETURN;
1282 }
1283}
79072805 1284
36477c24
PP
1285PP(pp_seq)
1286{
8ec5e241 1287 djSP; tryAMAGICbinSET(seq,0);
36477c24
PP
1288 {
1289 dPOPTOPssrl;
54310121 1290 SETs(boolSV(sv_eq(left, right)));
a0d0e21e
LW
1291 RETURN;
1292 }
1293}
79072805 1294
a0d0e21e 1295PP(pp_sne)
79072805 1296{
8ec5e241 1297 djSP; tryAMAGICbinSET(sne,0);
a0d0e21e
LW
1298 {
1299 dPOPTOPssrl;
54310121 1300 SETs(boolSV(!sv_eq(left, right)));
a0d0e21e 1301 RETURN;
463ee0b2 1302 }
79072805
LW
1303}
1304
a0d0e21e 1305PP(pp_scmp)
79072805 1306{
4e35701f 1307 djSP; dTARGET; tryAMAGICbin(scmp,0);
a0d0e21e
LW
1308 {
1309 dPOPTOPssrl;
533c011a 1310 int cmp = ((PL_op->op_private & OPpLOCALE)
bbce6d69
PP
1311 ? sv_cmp_locale(left, right)
1312 : sv_cmp(left, right));
1313 SETi( cmp );
a0d0e21e
LW
1314 RETURN;
1315 }
1316}
79072805 1317
55497cff
PP
1318PP(pp_bit_and)
1319{
8ec5e241 1320 djSP; dATARGET; tryAMAGICbin(band,opASSIGN);
a0d0e21e
LW
1321 {
1322 dPOPTOPssrl;
4633a7c4 1323 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1324 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
1325 IV i = SvIV(left) & SvIV(right);
1326 SETi(i);
d0ba1bd2
JH
1327 }
1328 else {
972b05a9
JH
1329 UV u = SvUV(left) & SvUV(right);
1330 SETu(u);
d0ba1bd2 1331 }
a0d0e21e
LW
1332 }
1333 else {
533c011a 1334 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW
1335 SETTARG;
1336 }
1337 RETURN;
1338 }
1339}
79072805 1340
a0d0e21e
LW
1341PP(pp_bit_xor)
1342{
8ec5e241 1343 djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
a0d0e21e
LW
1344 {
1345 dPOPTOPssrl;
4633a7c4 1346 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1347 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
1348 IV i = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
1349 SETi(i);
d0ba1bd2
JH
1350 }
1351 else {
972b05a9
JH
1352 UV u = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
1353 SETu(u);
d0ba1bd2 1354 }
a0d0e21e
LW
1355 }
1356 else {
533c011a 1357 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW
1358 SETTARG;
1359 }
1360 RETURN;
1361 }
1362}
79072805 1363
a0d0e21e
LW
1364PP(pp_bit_or)
1365{
8ec5e241 1366 djSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
a0d0e21e
LW
1367 {
1368 dPOPTOPssrl;
4633a7c4 1369 if (SvNIOKp(left) || SvNIOKp(right)) {
d0ba1bd2 1370 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
1371 IV i = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
1372 SETi(i);
d0ba1bd2
JH
1373 }
1374 else {
972b05a9
JH
1375 UV u = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
1376 SETu(u);
d0ba1bd2 1377 }
a0d0e21e
LW
1378 }
1379 else {
533c011a 1380 do_vop(PL_op->op_type, TARG, left, right);
a0d0e21e
LW
1381 SETTARG;
1382 }
1383 RETURN;
79072805 1384 }
a0d0e21e 1385}
79072805 1386
a0d0e21e
LW
1387PP(pp_negate)
1388{
4e35701f 1389 djSP; dTARGET; tryAMAGICun(neg);
a0d0e21e
LW
1390 {
1391 dTOPss;
4633a7c4
LW
1392 if (SvGMAGICAL(sv))
1393 mg_get(sv);
55497cff
PP
1394 if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN)
1395 SETi(-SvIVX(sv));
1396 else if (SvNIOKp(sv))
a0d0e21e 1397 SETn(-SvNV(sv));
4633a7c4 1398 else if (SvPOKp(sv)) {
a0d0e21e
LW
1399 STRLEN len;
1400 char *s = SvPV(sv, len);
bbce6d69 1401 if (isIDFIRST(*s)) {
a0d0e21e
LW
1402 sv_setpvn(TARG, "-", 1);
1403 sv_catsv(TARG, sv);
79072805 1404 }
a0d0e21e
LW
1405 else if (*s == '+' || *s == '-') {
1406 sv_setsv(TARG, sv);
1407 *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
79072805 1408 }
7e2040f0 1409 else if (DO_UTF8(sv) && *(U8*)s >= 0xc0 && isIDFIRST_utf8((U8*)s)) {
834a4ddd
LW
1410 sv_setpvn(TARG, "-", 1);
1411 sv_catsv(TARG, sv);
1412 }
79072805 1413 else
a0d0e21e
LW
1414 sv_setnv(TARG, -SvNV(sv));
1415 SETTARG;
79072805 1416 }
4633a7c4
LW
1417 else
1418 SETn(-SvNV(sv));
79072805 1419 }
a0d0e21e 1420 RETURN;
79072805
LW
1421}
1422
a0d0e21e 1423PP(pp_not)
79072805 1424{
4e35701f 1425 djSP; tryAMAGICunSET(not);
3280af22 1426 *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
a0d0e21e 1427 return NORMAL;
79072805
LW
1428}
1429
a0d0e21e 1430PP(pp_complement)
79072805 1431{
8ec5e241 1432 djSP; dTARGET; tryAMAGICun(compl);
a0d0e21e
LW
1433 {
1434 dTOPss;
4633a7c4 1435 if (SvNIOKp(sv)) {
d0ba1bd2 1436 if (PL_op->op_private & HINT_INTEGER) {
972b05a9
JH
1437 IV i = ~SvIV(sv);
1438 SETi(i);
d0ba1bd2
JH
1439 }
1440 else {
972b05a9
JH
1441 UV u = ~SvUV(sv);
1442 SETu(u);
d0ba1bd2 1443 }
a0d0e21e
LW
1444 }
1445 else {
1446 register char *tmps;
1447 register long *tmpl;
55497cff 1448 register I32 anum;
a0d0e21e
LW
1449 STRLEN len;
1450
1451 SvSetSV(TARG, sv);
1452 tmps = SvPV_force(TARG, len);
1453 anum = len;
1454#ifdef LIBERAL
1455 for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
1456 *tmps = ~*tmps;
1457 tmpl = (long*)tmps;
1458 for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
1459 *tmpl = ~*tmpl;
1460 tmps = (char*)tmpl;
1461#endif
1462 for ( ; anum > 0; anum--, tmps++)
1463 *tmps = ~*tmps;
1464
1465 SETs(TARG);
1466 }
1467 RETURN;
1468 }
79072805
LW
1469}
1470
a0d0e21e
LW
1471/* integer versions of some of the above */
1472
a0d0e21e 1473PP(pp_i_multiply)
79072805 1474{
8ec5e241 1475 djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
a0d0e21e
LW
1476 {
1477 dPOPTOPiirl;
1478 SETi( left * right );
1479 RETURN;
1480 }
79072805
LW
1481}
1482
a0d0e21e 1483PP(pp_i_divide)
79072805 1484{
8ec5e241 1485 djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
a0d0e21e
LW
1486 {
1487 dPOPiv;
1488 if (value == 0)
cea2e8a9 1489 DIE(aTHX_ "Illegal division by zero");
a0d0e21e
LW
1490 value = POPi / value;
1491 PUSHi( value );
1492 RETURN;
1493 }
79072805
LW
1494}
1495
a0d0e21e 1496PP(pp_i_modulo)
79072805 1497{
76e3520e 1498 djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
79072805 1499 {
a0d0e21e 1500 dPOPTOPiirl;
aa306039 1501 if (!right)
cea2e8a9 1502 DIE(aTHX_ "Illegal modulus zero");
a0d0e21e
LW
1503 SETi( left % right );
1504 RETURN;
79072805 1505 }
79072805
LW
1506}
1507
a0d0e21e 1508PP(pp_i_add)
79072805 1509{
8ec5e241 1510 djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
a0d0e21e
LW
1511 {
1512 dPOPTOPiirl;
1513 SETi( left + right );
1514 RETURN;
79072805 1515 }
79072805
LW
1516}
1517
a0d0e21e 1518PP(pp_i_subtract)
79072805 1519{
8ec5e241 1520 djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
a0d0e21e
LW
1521 {
1522 dPOPTOPiirl;
1523 SETi( left - right );
1524 RETURN;
79072805 1525 }
79072805
LW
1526}
1527
a0d0e21e 1528PP(pp_i_lt)
79072805 1529{
8ec5e241 1530 djSP; tryAMAGICbinSET(lt,0);
a0d0e21e
LW
1531 {
1532 dPOPTOPiirl;
54310121 1533 SETs(boolSV(left < right));
a0d0e21e
LW
1534 RETURN;
1535 }
79072805
LW
1536}
1537
a0d0e21e 1538PP(pp_i_gt)
79072805 1539{
8ec5e241 1540 djSP; tryAMAGICbinSET(gt,0);
a0d0e21e
LW
1541 {
1542 dPOPTOPiirl;
54310121 1543 SETs(boolSV(left > right));
a0d0e21e
LW
1544 RETURN;
1545 }
79072805
LW
1546}
1547
a0d0e21e 1548PP(pp_i_le)
79072805 1549{
8ec5e241 1550 djSP; tryAMAGICbinSET(le,0);
a0d0e21e
LW
1551 {
1552 dPOPTOPiirl;
54310121 1553 SETs(boolSV(left <= right));
a0d0e21e 1554 RETURN;
85e6fe83 1555 }
79072805
LW
1556}
1557
a0d0e21e 1558PP(pp_i_ge)
79072805 1559{
8ec5e241 1560 djSP; tryAMAGICbinSET(ge,0);
a0d0e21e
LW
1561 {
1562 dPOPTOPiirl;
54310121 1563 SETs(boolSV(left >= right));
a0d0e21e
LW
1564 RETURN;
1565 }
79072805
LW
1566}
1567
a0d0e21e 1568PP(pp_i_eq)
79072805 1569{
8ec5e241 1570 djSP; tryAMAGICbinSET(eq,0);
a0d0e21e
LW
1571 {
1572 dPOPTOPiirl;
54310121 1573 SETs(boolSV(left == right));
a0d0e21e
LW
1574 RETURN;
1575 }
79072805
LW
1576}
1577
a0d0e21e 1578PP(pp_i_ne)
79072805 1579{
8ec5e241 1580 djSP; tryAMAGICbinSET(ne,0);
a0d0e21e
LW
1581 {
1582 dPOPTOPiirl;
54310121 1583 SETs(boolSV(left != right));
a0d0e21e
LW
1584 RETURN;
1585 }
79072805
LW
1586}
1587
a0d0e21e 1588PP(pp_i_ncmp)
79072805 1589{
8ec5e241 1590 djSP; dTARGET; tryAMAGICbin(ncmp,0);
a0d0e21e
LW
1591 {
1592 dPOPTOPiirl;
1593 I32 value;
79072805 1594
a0d0e21e 1595 if (left > right)
79072805 1596 value = 1;
a0d0e21e 1597 else if (left < right)
79072805 1598 value = -1;
a0d0e21e 1599 else
79072805 1600 value = 0;
a0d0e21e
LW
1601 SETi(value);
1602 RETURN;
79072805 1603 }
85e6fe83
LW
1604}
1605
1606PP(pp_i_negate)
1607{
4e35701f 1608 djSP; dTARGET; tryAMAGICun(neg);
85e6fe83
LW
1609 SETi(-TOPi);
1610 RETURN;
1611}
1612
79072805
LW
1613/* High falutin' math. */
1614
1615PP(pp_atan2)
1616{
8ec5e241 1617 djSP; dTARGET; tryAMAGICbin(atan2,0);
a0d0e21e
LW
1618 {
1619 dPOPTOPnnrl;
65202027 1620 SETn(Perl_atan2(left, right));
a0d0e21e
LW
1621 RETURN;
1622 }
79072805
LW
1623}
1624
1625PP(pp_sin)
1626{
4e35701f 1627 djSP; dTARGET; tryAMAGICun(sin);
a0d0e21e 1628 {
65202027 1629 NV value;
a0d0e21e 1630 value = POPn;
65202027 1631 value = Perl_sin(value);
a0d0e21e
LW
1632 XPUSHn(value);
1633 RETURN;
1634 }
79072805
LW
1635}
1636
1637PP(pp_cos)
1638{
4e35701f 1639 djSP; dTARGET; tryAMAGICun(cos);
a0d0e21e 1640 {
65202027 1641 NV value;
a0d0e21e 1642 value = POPn;
65202027 1643 value = Perl_cos(value);
a0d0e21e
LW
1644 XPUSHn(value);
1645 RETURN;
1646 }
79072805
LW
1647}
1648
56cb0a1c
AD
1649/* Support Configure command-line overrides for rand() functions.
1650 After 5.005, perhaps we should replace this by Configure support
1651 for drand48(), random(), or rand(). For 5.005, though, maintain
1652 compatibility by calling rand() but allow the user to override it.
1653 See INSTALL for details. --Andy Dougherty 15 July 1998
1654*/
85ab1d1d
JH
1655/* Now it's after 5.005, and Configure supports drand48() and random(),
1656 in addition to rand(). So the overrides should not be needed any more.
1657 --Jarkko Hietaniemi 27 September 1998
1658 */
1659
1660#ifndef HAS_DRAND48_PROTO
20ce7b12 1661extern double drand48 (void);
56cb0a1c
AD
1662#endif
1663
79072805
LW
1664PP(pp_rand)
1665{
4e35701f 1666 djSP; dTARGET;
65202027 1667 NV value;
79072805
LW
1668 if (MAXARG < 1)
1669 value = 1.0;
1670 else
1671 value = POPn;
1672 if (value == 0.0)
1673 value = 1.0;
80252599 1674 if (!PL_srand_called) {
85ab1d1d 1675 (void)seedDrand01((Rand_seed_t)seed());
80252599 1676 PL_srand_called = TRUE;
93dc8474 1677 }
85ab1d1d 1678 value *= Drand01();
79072805
LW
1679 XPUSHn(value);
1680 RETURN;
1681}
1682
1683PP(pp_srand)
1684{
4e35701f 1685 djSP;
93dc8474
CS
1686 UV anum;
1687 if (MAXARG < 1)
1688 anum = seed();
79072805 1689 else
93dc8474 1690 anum = POPu;
85ab1d1d 1691 (void)seedDrand01((Rand_seed_t)anum);
80252599 1692 PL_srand_called = TRUE;
79072805
LW
1693 EXTEND(SP, 1);
1694 RETPUSHYES;
1695}
1696
76e3520e 1697STATIC U32
cea2e8a9 1698S_seed(pTHX)
93dc8474 1699{
54310121
PP
1700 /*
1701 * This is really just a quick hack which grabs various garbage
1702 * values. It really should be a real hash algorithm which
1703 * spreads the effect of every input bit onto every output bit,
85ab1d1d 1704 * if someone who knows about such things would bother to write it.
54310121 1705 * Might be a good idea to add that function to CORE as well.
85ab1d1d 1706 * No numbers below come from careful analysis or anything here,
54310121
PP
1707 * except they are primes and SEED_C1 > 1E6 to get a full-width
1708 * value from (tv_sec * SEED_C1 + tv_usec). The multipliers should
1709 * probably be bigger too.
1710 */
1711#if RANDBITS > 16
1712# define SEED_C1 1000003
1713#define SEED_C4 73819
1714#else
1715# define SEED_C1 25747
1716#define SEED_C4 20639
1717#endif
1718#define SEED_C2 3
1719#define SEED_C3 269
1720#define SEED_C5 26107
1721
e858de61 1722 dTHR;
73c60299
RS
1723#ifndef PERL_NO_DEV_RANDOM
1724 int fd;
1725#endif
93dc8474 1726 U32 u;
f12c7020
PP
1727#ifdef VMS
1728# include <starlet.h>
43c92808
HF
1729 /* when[] = (low 32 bits, high 32 bits) of time since epoch
1730 * in 100-ns units, typically incremented ever 10 ms. */
93dc8474 1731 unsigned int when[2];
73c60299
RS
1732#else
1733# ifdef HAS_GETTIMEOFDAY
1734 struct timeval when;
1735# else
1736 Time_t when;
1737# endif
1738#endif
1739
1740/* This test is an escape hatch, this symbol isn't set by Configure. */
1741#ifndef PERL_NO_DEV_RANDOM
1742#ifndef PERL_RANDOM_DEVICE
1743 /* /dev/random isn't used by default because reads from it will block
1744 * if there isn't enough entropy available. You can compile with
1745 * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
1746 * is enough real entropy to fill the seed. */
1747# define PERL_RANDOM_DEVICE "/dev/urandom"
1748#endif
1749 fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
1750 if (fd != -1) {
1751 if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
1752 u = 0;
1753 PerlLIO_close(fd);
1754 if (u)
1755 return u;
1756 }
1757#endif
1758
1759#ifdef VMS
93dc8474 1760 _ckvmssts(sys$gettim(when));
54310121 1761 u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
f12c7020 1762#else
5f05dabc 1763# ifdef HAS_GETTIMEOFDAY
93dc8474 1764 gettimeofday(&when,(struct timezone *) 0);
54310121 1765 u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
f12c7020 1766# else
93dc8474 1767 (void)time(&when);
54310121 1768 u = (U32)SEED_C1 * when;
f12c7020
PP
1769# endif
1770#endif
7766f137 1771 u += SEED_C3 * (U32)PerlProc_getpid();
56431972 1772 u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
54310121 1773#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */
56431972 1774 u += SEED_C5 * (U32)PTR2UV(&when);
f12c7020 1775#endif
93dc8474 1776 return u;
79072805
LW
1777}
1778
1779PP(pp_exp)
1780{
4e35701f 1781 djSP; dTARGET; tryAMAGICun(exp);
a0d0e21e 1782 {
65202027 1783 NV value;
a0d0e21e 1784 value = POPn;
65202027 1785 value = Perl_exp(value);
a0d0e21e
LW
1786 XPUSHn(value);
1787 RETURN;
1788 }
79072805
LW
1789}
1790
1791PP(pp_log)
1792{
4e35701f 1793 djSP; dTARGET; tryAMAGICun(log);
a0d0e21e 1794 {
65202027 1795 NV value;
a0d0e21e 1796 value = POPn;
bbce6d69 1797 if (value <= 0.0) {
097ee67d 1798 RESTORE_NUMERIC_STANDARD();
cea2e8a9 1799 DIE(aTHX_ "Can't take log of %g", value);
bbce6d69 1800 }
65202027 1801 value = Perl_log(value);
a0d0e21e
LW
1802 XPUSHn(value);
1803 RETURN;
1804 }
79072805
LW
1805}
1806
1807PP(pp_sqrt)
1808{
4e35701f 1809 djSP; dTARGET; tryAMAGICun(sqrt);
a0d0e21e 1810 {
65202027 1811 NV value;
a0d0e21e 1812 value = POPn;
bbce6d69 1813 if (value < 0.0) {
097ee67d 1814 RESTORE_NUMERIC_STANDARD();
cea2e8a9 1815 DIE(aTHX_ "Can't take sqrt of %g", value);
bbce6d69 1816 }
65202027 1817 value = Perl_sqrt(value);
a0d0e21e
LW
1818 XPUSHn(value);
1819 RETURN;
1820 }
79072805
LW
1821}
1822
1823PP(pp_int)
1824{
4e35701f 1825 djSP; dTARGET;
774d564b 1826 {
65202027 1827 NV value = TOPn;
774d564b
PP
1828 IV iv;
1829
1830 if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) {
1831 iv = SvIVX(TOPs);
1832 SETi(iv);
1833 }
1834 else {
1835 if (value >= 0.0)
65202027 1836 (void)Perl_modf(value, &value);
774d564b 1837 else {
65202027 1838 (void)Perl_modf(-value, &value);
774d564b
PP
1839 value = -value;
1840 }
1841 iv = I_V(value);
1842 if (iv == value)
1843 SETi(iv);
1844 else
1845 SETn(value);
1846 }
79072805 1847 }
79072805
LW
1848 RETURN;
1849}
1850
463ee0b2
LW
1851PP(pp_abs)
1852{
4e35701f 1853 djSP; dTARGET; tryAMAGICun(abs);
a0d0e21e 1854 {
65202027 1855 NV value = TOPn;
774d564b 1856 IV iv;
463ee0b2 1857
774d564b
PP
1858 if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) &&
1859 (iv = SvIVX(TOPs)) != IV_MIN) {
1860 if (iv < 0)
1861 iv = -iv;
1862 SETi(iv);
1863 }
1864 else {
1865 if (value < 0.0)
1866 value = -value;
1867 SETn(value);
1868 }
a0d0e21e 1869 }
774d564b 1870 RETURN;
463ee0b2
LW
1871}
1872
79072805
LW
1873PP(pp_hex)
1874{
4e35701f 1875 djSP; dTARGET;
79072805
LW
1876 char *tmps;
1877 I32 argtype;
2d8e6c8d 1878 STRLEN n_a;
79072805 1879
2d8e6c8d 1880 tmps = POPpx;
9e24b6e2 1881 XPUSHn(scan_hex(tmps, 99, &argtype));
79072805
LW
1882 RETURN;
1883}
1884
1885PP(pp_oct)
1886{
4e35701f 1887 djSP; dTARGET;
9e24b6e2 1888 NV value;
79072805
LW
1889 I32 argtype;
1890 char *tmps;
2d8e6c8d 1891 STRLEN n_a;
79072805 1892
2d8e6c8d 1893 tmps = POPpx;
464e2e8a
PP
1894 while (*tmps && isSPACE(*tmps))
1895 tmps++;
9e24b6e2
JH
1896 if (*tmps == '0')
1897 tmps++;
1898 if (*tmps == 'x')
1899 value = scan_hex(++tmps, 99, &argtype);
1900 else if (*tmps == 'b')
1901 value = scan_bin(++tmps, 99, &argtype);
464e2e8a 1902 else
9e24b6e2
JH
1903 value = scan_oct(tmps, 99, &argtype);
1904 XPUSHn(value);
79072805
LW
1905 RETURN;
1906}
1907
1908/* String stuff. */
1909
1910PP(pp_length)
1911{
4e35701f 1912 djSP; dTARGET;
7e2040f0 1913 SV *sv = TOPs;
a0ed51b3 1914
7e2040f0
GS
1915 if (DO_UTF8(sv))
1916 SETi(sv_len_utf8(sv));
1917 else
1918 SETi(sv_len(sv));
79072805
LW
1919 RETURN;
1920}
1921
1922PP(pp_substr)
1923{
4e35701f 1924 djSP; dTARGET;
79072805
LW
1925 SV *sv;
1926 I32 len;
463ee0b2 1927 STRLEN curlen;
a0ed51b3 1928 STRLEN utfcurlen;
79072805
LW
1929 I32 pos;
1930 I32 rem;
84902520 1931 I32 fail;
533c011a 1932 I32 lvalue = PL_op->op_flags & OPf_MOD;
79072805 1933 char *tmps;
3280af22 1934 I32 arybase = PL_curcop->cop_arybase;
7b8d334a
GS
1935 char *repl = 0;
1936 STRLEN repl_len;
79072805 1937
20408e3c 1938 SvTAINTED_off(TARG); /* decontaminate */
7e2040f0 1939 SvUTF8_off(TARG); /* decontaminate */
5d82c453
GA
1940 if (MAXARG > 2) {
1941 if (MAXARG > 3) {
1942 sv = POPs;
1943 repl = SvPV(sv, repl_len);
7b8d334a 1944 }
79072805 1945 len = POPi;
5d82c453 1946 }
84902520 1947 pos = POPi;
79072805 1948 sv = POPs;
849ca7ee 1949 PUTBACK;
a0d0e21e 1950 tmps = SvPV(sv, curlen);
7e2040f0 1951 if (DO_UTF8(sv)) {
a0ed51b3
LW
1952 utfcurlen = sv_len_utf8(sv);
1953 if (utfcurlen == curlen)
1954 utfcurlen = 0;
1955 else
1956 curlen = utfcurlen;
1957 }
d1c2b58a
LW
1958 else
1959 utfcurlen = 0;
a0ed51b3 1960
84902520
TB
1961 if (pos >= arybase) {
1962 pos -= arybase;
1963 rem = curlen-pos;
1964 fail = rem;
5d82c453
GA
1965 if (MAXARG > 2) {
1966 if (len < 0) {
1967 rem += len;
1968 if (rem < 0)
1969 rem = 0;
1970 }
1971 else if (rem > len)
1972 rem = len;
1973 }
68dc0745 1974 }
84902520 1975 else {
5d82c453
GA
1976 pos += curlen;
1977 if (MAXARG < 3)
1978 rem = curlen;
1979 else if (len >= 0) {
1980 rem = pos+len;
1981 if (rem > (I32)curlen)
1982 rem = curlen;
1983 }
1984 else {
1985 rem = curlen+len;
1986 if (rem < pos)
1987 rem = pos;
1988 }
1989 if (pos < 0)
1990 pos = 0;
1991 fail = rem;
1992 rem -= pos;
84902520
TB
1993 }
1994 if (fail < 0) {
e476b1b5
GS
1995 if (lvalue || repl)
1996 Perl_croak(aTHX_ "substr outside of string");
1997 if (ckWARN(WARN_SUBSTR))
cea2e8a9 1998 Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
2304df62
AD
1999 RETPUSHUNDEF;
2000 }
79072805 2001 else {
7e2040f0 2002 if (utfcurlen) {
a0ed51b3 2003 sv_pos_u2b(sv, &pos, &rem);
7e2040f0
GS
2004 SvUTF8_on(TARG);
2005 }
79072805 2006 tmps += pos;
79072805 2007 sv_setpvn(TARG, tmps, rem);
c8faf1c5
GS
2008 if (repl)
2009 sv_insert(sv, pos, rem, repl, repl_len);
2010 else if (lvalue) { /* it's an lvalue! */
dedeecda
PP
2011 if (!SvGMAGICAL(sv)) {
2012 if (SvROK(sv)) {
2d8e6c8d
GS
2013 STRLEN n_a;
2014 SvPV_force(sv,n_a);
599cee73 2015 if (ckWARN(WARN_SUBSTR))
cea2e8a9 2016 Perl_warner(aTHX_ WARN_SUBSTR,
599cee73 2017 "Attempt to use reference as lvalue in substr");
dedeecda
PP
2018 }
2019 if (SvOK(sv)) /* is it defined ? */
2020 (void)SvPOK_only(sv);
2021 else
2022 sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
2023 }
5f05dabc 2024
a0d0e21e
LW
2025 if (SvTYPE(TARG) < SVt_PVLV) {
2026 sv_upgrade(TARG, SVt_PVLV);
2027 sv_magic(TARG, Nullsv, 'x', Nullch, 0);
ed6116ce 2028 }
a0d0e21e 2029
5f05dabc 2030 LvTYPE(TARG) = 'x';
6ff81951
GS
2031 if (LvTARG(TARG) != sv) {
2032 if (LvTARG(TARG))
2033 SvREFCNT_dec(LvTARG(TARG));
2034 LvTARG(TARG) = SvREFCNT_inc(sv);
2035 }
a0d0e21e 2036 LvTARGOFF(TARG) = pos;
8ec5e241 2037 LvTARGLEN(TARG) = rem;
79072805
LW
2038 }
2039 }
849ca7ee 2040 SPAGAIN;
79072805
LW
2041 PUSHs(TARG); /* avoid SvSETMAGIC here */
2042 RETURN;
2043}
2044
2045PP(pp_vec)
2046{
4e35701f 2047 djSP; dTARGET;
79072805
LW
2048 register I32 size = POPi;
2049 register I32 offset = POPi;
2050 register SV *src = POPs;
533c011a 2051 I32 lvalue = PL_op->op_flags & OPf_MOD;
a0d0e21e 2052
81e118e0
JH
2053 SvTAINTED_off(TARG); /* decontaminate */
2054 if (lvalue) { /* it's an lvalue! */
2055 if (SvTYPE(TARG) < SVt_PVLV) {
2056 sv_upgrade(TARG, SVt_PVLV);
2057 sv_magic(TARG, Nullsv, 'v', Nullch, 0);
79072805 2058 }
81e118e0
JH
2059 LvTYPE(TARG) = 'v';
2060 if (LvTARG(TARG) != src) {
2061 if (LvTARG(TARG))
2062 SvREFCNT_dec(LvTARG(TARG));
2063 LvTARG(TARG) = SvREFCNT_inc(src);
79072805 2064 }
81e118e0
JH
2065 LvTARGOFF(TARG) = offset;
2066 LvTARGLEN(TARG) = size;
79072805
LW
2067 }
2068
81e118e0 2069 sv_setuv(TARG, do_vecget(src, offset, size));
79072805
LW
2070 PUSHs(TARG);
2071 RETURN;
2072}
2073
2074PP(pp_index)
2075{
4e35701f 2076 djSP; dTARGET;
79072805
LW
2077 SV *big;
2078 SV *little;
2079 I32 offset;
2080 I32 retval;
2081 char *tmps;
2082 char *tmps2;
463ee0b2 2083 STRLEN biglen;
3280af22 2084 I32 arybase = PL_curcop->cop_arybase;
79072805
LW
2085
2086 if (MAXARG < 3)
2087 offset = 0;
2088 else
2089 offset = POPi - arybase;
2090 little = POPs;
2091 big = POPs;
463ee0b2 2092 tmps = SvPV(big, biglen);
7e2040f0 2093 if (offset > 0 && DO_UTF8(big))
a0ed51b3 2094 sv_pos_u2b(big, &offset, 0);
79072805
LW
2095 if (offset < 0)
2096 offset = 0;
93a17b20
LW
2097 else if (offset > biglen)
2098 offset = biglen;
79072805 2099 if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
411d5715 2100 (unsigned char*)tmps + biglen, little, 0)))
a0ed51b3 2101 retval = -1;
79072805 2102 else
a0ed51b3 2103 retval = tmps2 - tmps;
7e2040f0 2104 if (retval > 0 && DO_UTF8(big))
a0ed51b3
LW
2105 sv_pos_b2u(big, &retval);
2106 PUSHi(retval + arybase);
79072805
LW
2107 RETURN;
2108}
2109
2110PP(pp_rindex)
2111{
4e35701f 2112 djSP; dTARGET;
79072805
LW
2113 SV *big;
2114 SV *little;
463ee0b2
LW
2115 STRLEN blen;
2116 STRLEN llen;
79072805
LW
2117 I32 offset;
2118 I32 retval;
2119 char *tmps;
2120 char *tmps2;
3280af22 2121 I32 arybase = PL_curcop->cop_arybase;
79072805 2122
a0d0e21e 2123 if (MAXARG >= 3)
a0ed51b3 2124 offset = POPi;
79072805
LW
2125 little = POPs;
2126 big = POPs;
463ee0b2
LW
2127 tmps2 = SvPV(little, llen);
2128 tmps = SvPV(big, blen);
79072805 2129 if (MAXARG < 3)
463ee0b2 2130 offset = blen;
a0ed51b3 2131 else {
7e2040f0 2132 if (offset > 0 && DO_UTF8(big))
a0ed51b3
LW
2133 sv_pos_u2b(big, &offset, 0);
2134 offset = offset - arybase + llen;
2135 }
79072805
LW
2136 if (offset < 0)
2137 offset = 0;
463ee0b2
LW
2138 else if (offset > blen)
2139 offset = blen;
79072805 2140 if (!(tmps2 = rninstr(tmps, tmps + offset,
463ee0b2 2141 tmps2, tmps2 + llen)))
a0ed51b3 2142 retval = -1;
79072805 2143 else
a0ed51b3 2144 retval = tmps2 - tmps;
7e2040f0 2145 if (retval > 0 && DO_UTF8(big))
a0ed51b3
LW
2146 sv_pos_b2u(big, &retval);
2147 PUSHi(retval + arybase);
79072805
LW
2148 RETURN;
2149}
2150
2151PP(pp_sprintf)
2152{
4e35701f 2153 djSP; dMARK; dORIGMARK; dTARGET;
79072805 2154 do_sprintf(TARG, SP-MARK, MARK+1);
bbce6d69 2155 TAINT_IF(SvTAINTED(TARG));
79072805
LW
2156 SP = ORIGMARK;
2157 PUSHTARG;
2158 RETURN;
2159}
2160
79072805
LW
2161PP(pp_ord)
2162{
4e35701f 2163 djSP; dTARGET;
bdeef251 2164 UV value;
2d8e6c8d 2165 STRLEN n_a;
7e2040f0
GS
2166 SV *tmpsv = POPs;
2167 U8 *tmps = (U8*)SvPVx(tmpsv,n_a);
a0ed51b3 2168 I32 retlen;
79072805 2169
7e2040f0 2170 if ((*tmps & 0x80) && DO_UTF8(tmpsv))
bdeef251 2171 value = utf8_to_uv(tmps, &retlen);
a0ed51b3 2172 else
bdeef251
GA
2173 value = (UV)(*tmps & 255);
2174 XPUSHu(value);
79072805
LW
2175 RETURN;
2176}
2177
463ee0b2
LW
2178PP(pp_chr)
2179{
4e35701f 2180 djSP; dTARGET;
463ee0b2 2181 char *tmps;
3b9be786 2182 U32 value = POPu;
463ee0b2 2183
748a9306 2184 (void)SvUPGRADE(TARG,SVt_PV);
a0ed51b3 2185
3969a896 2186 if (value > 255 && !IN_BYTE) {
aa6ffa16 2187 SvGROW(TARG, UTF8_MAXLEN+1);
a0ed51b3 2188 tmps = SvPVX(TARG);
dfe13c55 2189 tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value);
a0ed51b3
LW
2190 SvCUR_set(TARG, tmps - SvPVX(TARG));
2191 *tmps = '\0';
2192 (void)SvPOK_only(TARG);
aa6ffa16 2193 SvUTF8_on(TARG);
a0ed51b3
LW
2194 XPUSHs(TARG);
2195 RETURN;
2196 }
2197
748a9306 2198 SvGROW(TARG,2);
463ee0b2
LW
2199 SvCUR_set(TARG, 1);
2200 tmps = SvPVX(TARG);
a0ed51b3 2201 *tmps++ = value;
748a9306 2202 *tmps = '\0';
3969a896 2203 SvUTF8_off(TARG); /* decontaminate */
a0d0e21e 2204 (void)SvPOK_only(TARG);
463ee0b2
LW
2205 XPUSHs(TARG);
2206 RETURN;
2207}
2208
79072805
LW
2209PP(pp_crypt)
2210{
4e35701f 2211 djSP; dTARGET; dPOPTOPssrl;
2d8e6c8d 2212 STRLEN n_a;
79072805 2213#ifdef HAS_CRYPT
2d8e6c8d 2214 char *tmps = SvPV(left, n_a);
79072805 2215#ifdef FCRYPT
2d8e6c8d 2216 sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
79072805 2217#else
2d8e6c8d 2218 sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
79072805
LW
2219#endif
2220#else
cea2e8a9 2221 DIE(aTHX_
79072805
LW
2222 "The crypt() function is unimplemented due to excessive paranoia.");
2223#endif
2224 SETs(TARG);
2225 RETURN;
2226}
2227
2228PP(pp_ucfirst)
2229{
4e35701f 2230 djSP;
79072805 2231 SV *sv = TOPs;
a0ed51b3
LW
2232 register U8 *s;
2233 STRLEN slen;
2234
7e2040f0 2235 if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
a0ed51b3 2236 I32 ulen;
806e7201 2237 U8 tmpbuf[UTF8_MAXLEN];
a0ed51b3
LW
2238 U8 *tend;
2239 UV uv = utf8_to_uv(s, &ulen);
2240
2241 if (PL_op->op_private & OPpLOCALE) {
2242 TAINT;
2243 SvTAINTED_on(sv);
2244 uv = toTITLE_LC_uni(uv);
2245 }
2246 else
2247 uv = toTITLE_utf8(s);
2248
2249 tend = uv_to_utf8(tmpbuf, uv);
2250
014822e4 2251 if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
a0ed51b3 2252 dTARGET;
dfe13c55
GS
2253 sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
2254 sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
7e2040f0 2255 SvUTF8_on(TARG);
a0ed51b3
LW
2256 SETs(TARG);
2257 }
2258 else {
dfe13c55 2259 s = (U8*)SvPV_force(sv, slen);
a0ed51b3
LW
2260 Copy(tmpbuf, s, ulen, U8);
2261 }
a0ed51b3 2262 }
626727d5 2263 else {
014822e4 2264 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 2265 dTARGET;
7e2040f0 2266 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
2267 sv_setsv(TARG, sv);
2268 sv = TARG;
2269 SETs(sv);
2270 }
2271 s = (U8*)SvPV_force(sv, slen);
2272 if (*s) {
2273 if (PL_op->op_private & OPpLOCALE) {
2274 TAINT;
2275 SvTAINTED_on(sv);
2276 *s = toUPPER_LC(*s);
2277 }
2278 else
2279 *s = toUPPER(*s);
bbce6d69 2280 }
bbce6d69 2281 }
31351b04
JS
2282 if (SvSMAGICAL(sv))
2283 mg_set(sv);
79072805
LW
2284 RETURN;
2285}
2286
2287PP(pp_lcfirst)
2288{
4e35701f 2289 djSP;
79072805 2290 SV *sv = TOPs;
a0ed51b3
LW
2291 register U8 *s;
2292 STRLEN slen;
2293
7e2040f0 2294 if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
a0ed51b3 2295 I32 ulen;
806e7201 2296 U8 tmpbuf[UTF8_MAXLEN];
a0ed51b3
LW
2297 U8 *tend;
2298 UV uv = utf8_to_uv(s, &ulen);
2299
2300 if (PL_op->op_private & OPpLOCALE) {
2301 TAINT;
2302 SvTAINTED_on(sv);
2303 uv = toLOWER_LC_uni(uv);
2304 }
2305 else
2306 uv = toLOWER_utf8(s);
2307
2308 tend = uv_to_utf8(tmpbuf, uv);
2309
014822e4 2310 if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
a0ed51b3 2311 dTARGET;
dfe13c55
GS
2312 sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
2313 sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
7e2040f0 2314 SvUTF8_on(TARG);
a0ed51b3
LW
2315 SETs(TARG);
2316 }
2317 else {
dfe13c55 2318 s = (U8*)SvPV_force(sv, slen);
a0ed51b3
LW
2319 Copy(tmpbuf, s, ulen, U8);
2320 }
a0ed51b3 2321 }
626727d5 2322 else {
014822e4 2323 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 2324 dTARGET;
7e2040f0 2325 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
2326 sv_setsv(TARG, sv);
2327 sv = TARG;
2328 SETs(sv);
2329 }
2330 s = (U8*)SvPV_force(sv, slen);
2331 if (*s) {
2332 if (PL_op->op_private & OPpLOCALE) {
2333 TAINT;
2334 SvTAINTED_on(sv);
2335 *s = toLOWER_LC(*s);
2336 }
2337 else
2338 *s = toLOWER(*s);
bbce6d69 2339 }
bbce6d69 2340 }
31351b04
JS
2341 if (SvSMAGICAL(sv))
2342 mg_set(sv);
79072805
LW
2343 RETURN;
2344}
2345
2346PP(pp_uc)
2347{
4e35701f 2348 djSP;
79072805 2349 SV *sv = TOPs;
a0ed51b3 2350 register U8 *s;
463ee0b2 2351 STRLEN len;
79072805 2352
7e2040f0 2353 if (DO_UTF8(sv)) {
a0ed51b3
LW
2354 dTARGET;
2355 I32 ulen;
2356 register U8 *d;
2357 U8 *send;
2358
dfe13c55 2359 s = (U8*)SvPV(sv,len);
a5a20234 2360 if (!len) {
7e2040f0 2361 SvUTF8_off(TARG); /* decontaminate */
a5a20234
LW
2362 sv_setpvn(TARG, "", 0);
2363 SETs(TARG);
a0ed51b3
LW
2364 }
2365 else {
31351b04
JS
2366 (void)SvUPGRADE(TARG, SVt_PV);
2367 SvGROW(TARG, (len * 2) + 1);
2368 (void)SvPOK_only(TARG);
2369 d = (U8*)SvPVX(TARG);
2370 send = s + len;
2371 if (PL_op->op_private & OPpLOCALE) {
2372 TAINT;
2373 SvTAINTED_on(TARG);
2374 while (s < send) {
2375 d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
2376 s += ulen;
2377 }
a0ed51b3 2378 }
31351b04
JS
2379 else {
2380 while (s < send) {
2381 d = uv_to_utf8(d, toUPPER_utf8( s ));
2382 s += UTF8SKIP(s);
2383 }
a0ed51b3 2384 }
31351b04 2385 *d = '\0';
7e2040f0 2386 SvUTF8_on(TARG);
31351b04
JS
2387 SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
2388 SETs(TARG);
a0ed51b3 2389 }
a0ed51b3 2390 }
626727d5 2391 else {
014822e4 2392 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 2393 dTARGET;
7e2040f0 2394 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
2395 sv_setsv(TARG, sv);
2396 sv = TARG;
2397 SETs(sv);
2398 }
2399 s = (U8*)SvPV_force(sv, len);
2400 if (len) {
2401 register U8 *send = s + len;
2402
2403 if (PL_op->op_private & OPpLOCALE) {
2404 TAINT;
2405 SvTAINTED_on(sv);
2406 for (; s < send; s++)
2407 *s = toUPPER_LC(*s);
2408 }
2409 else {
2410 for (; s < send; s++)
2411 *s = toUPPER(*s);
2412 }
bbce6d69 2413 }
79072805 2414 }
31351b04
JS
2415 if (SvSMAGICAL(sv))
2416 mg_set(sv);
79072805
LW
2417 RETURN;
2418}
2419
2420PP(pp_lc)
2421{
4e35701f 2422 djSP;
79072805 2423 SV *sv = TOPs;
a0ed51b3 2424 register U8 *s;
463ee0b2 2425 STRLEN len;
79072805 2426
7e2040f0 2427 if (DO_UTF8(sv)) {
a0ed51b3
LW
2428 dTARGET;
2429 I32 ulen;
2430 register U8 *d;
2431 U8 *send;
2432
dfe13c55 2433 s = (U8*)SvPV(sv,len);
a5a20234 2434 if (!len) {
7e2040f0 2435 SvUTF8_off(TARG); /* decontaminate */
a5a20234
LW
2436 sv_setpvn(TARG, "", 0);
2437 SETs(TARG);
a0ed51b3
LW
2438 }
2439 else {
31351b04
JS
2440 (void)SvUPGRADE(TARG, SVt_PV);
2441 SvGROW(TARG, (len * 2) + 1);
2442 (void)SvPOK_only(TARG);
2443 d = (U8*)SvPVX(TARG);
2444 send = s + len;
2445 if (PL_op->op_private & OPpLOCALE) {
2446 TAINT;
2447 SvTAINTED_on(TARG);
2448 while (s < send) {
2449 d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
2450 s += ulen;
2451 }
a0ed51b3 2452 }
31351b04
JS
2453 else {
2454 while (s < send) {
2455 d = uv_to_utf8(d, toLOWER_utf8(s));
2456 s += UTF8SKIP(s);
2457 }
a0ed51b3 2458 }
31351b04 2459 *d = '\0';
7e2040f0 2460 SvUTF8_on(TARG);
31351b04
JS
2461 SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
2462 SETs(TARG);
a0ed51b3 2463 }
79072805 2464 }
626727d5 2465 else {
014822e4 2466 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 2467 dTARGET;
7e2040f0 2468 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
2469 sv_setsv(TARG, sv);
2470 sv = TARG;
2471 SETs(sv);
a0ed51b3 2472 }
bbce6d69 2473
31351b04
JS
2474 s = (U8*)SvPV_force(sv, len);
2475 if (len) {
2476 register U8 *send = s + len;
bbce6d69 2477
31351b04
JS
2478 if (PL_op->op_private & OPpLOCALE) {
2479 TAINT;
2480 SvTAINTED_on(sv);
2481 for (; s < send; s++)
2482 *s = toLOWER_LC(*s);
2483 }
2484 else {
2485 for (; s < send; s++)
2486 *s = toLOWER(*s);
2487 }
bbce6d69 2488 }
79072805 2489 }
31351b04
JS
2490 if (SvSMAGICAL(sv))
2491 mg_set(sv);
79072805
LW
2492 RETURN;
2493}
2494
a0d0e21e 2495PP(pp_quotemeta)
79072805 2496{
4e35701f 2497 djSP; dTARGET;
a0d0e21e
LW
2498 SV *sv = TOPs;
2499 STRLEN len;
2500 register char *s = SvPV(sv,len);
2501 register char *d;
79072805 2502
7e2040f0 2503 SvUTF8_off(TARG); /* decontaminate */
a0d0e21e
LW
2504 if (len) {
2505 (void)SvUPGRADE(TARG, SVt_PV);
c07a80fd 2506 SvGROW(TARG, (len * 2) + 1);
a0d0e21e 2507 d = SvPVX(TARG);
7e2040f0 2508 if (DO_UTF8(sv)) {
0dd2cdef
LW
2509 while (len) {
2510 if (*s & 0x80) {
2511 STRLEN ulen = UTF8SKIP(s);
2512 if (ulen > len)
2513 ulen = len;
2514 len -= ulen;
2515 while (ulen--)
2516 *d++ = *s++;
2517 }
2518 else {
2519 if (!isALNUM(*s))
2520 *d++ = '\\';
2521 *d++ = *s++;
2522 len--;
2523 }
2524 }
7e2040f0 2525 SvUTF8_on(TARG);
0dd2cdef
LW
2526 }
2527 else {
2528 while (len--) {
2529 if (!isALNUM(*s))
2530 *d++ = '\\';
2531 *d++ = *s++;
2532 }
79072805 2533 }
a0d0e21e
LW
2534 *d = '\0';
2535 SvCUR_set(TARG, d - SvPVX(TARG));
2536 (void)SvPOK_only(TARG);
79072805 2537 }
a0d0e21e
LW
2538 else
2539 sv_setpvn(TARG, s, len);
2540 SETs(TARG);
31351b04
JS
2541 if (SvSMAGICAL(TARG))
2542 mg_set(TARG);
79072805
LW
2543 RETURN;
2544}
2545
a0d0e21e 2546/* Arrays. */
79072805 2547
a0d0e21e 2548PP(pp_aslice)
79072805 2549{
4e35701f 2550 djSP; dMARK; dORIGMARK;
a0d0e21e
LW
2551 register SV** svp;
2552 register AV* av = (AV*)POPs;
533c011a 2553 register I32 lval = PL_op->op_flags & OPf_MOD;
3280af22 2554 I32 arybase = PL_curcop->cop_arybase;
748a9306 2555 I32 elem;
79072805 2556
a0d0e21e 2557 if (SvTYPE(av) == SVt_PVAV) {
533c011a 2558 if (lval && PL_op->op_private & OPpLVAL_INTRO) {
748a9306 2559 I32 max = -1;
924508f0 2560 for (svp = MARK + 1; svp <= SP; svp++) {
748a9306
LW
2561 elem = SvIVx(*svp);
2562 if (elem > max)
2563 max = elem;
2564 }
2565 if (max > AvMAX(av))
2566 av_extend(av, max);
2567 }
a0d0e21e 2568 while (++MARK <= SP) {
748a9306 2569 elem = SvIVx(*MARK);
a0d0e21e 2570
748a9306
LW
2571 if (elem > 0)
2572 elem -= arybase;
a0d0e21e
LW
2573 svp = av_fetch(av, elem, lval);
2574 if (lval) {
3280af22 2575 if (!svp || *svp == &PL_sv_undef)
cea2e8a9 2576 DIE(aTHX_ PL_no_aelem, elem);
533c011a 2577 if (PL_op->op_private & OPpLVAL_INTRO)
161b7d16 2578 save_aelem(av, elem, svp);
79072805 2579 }
3280af22 2580 *MARK = svp ? *svp : &PL_sv_undef;
79072805
LW
2581 }
2582 }
748a9306 2583 if (GIMME != G_ARRAY) {
a0d0e21e
LW
2584 MARK = ORIGMARK;
2585 *++MARK = *SP;
2586 SP = MARK;
2587 }
79072805
LW
2588 RETURN;
2589}
2590
2591/* Associative arrays. */
2592
2593PP(pp_each)
2594{
59af0135 2595 djSP;
79072805 2596 HV *hash = (HV*)POPs;
c07a80fd 2597 HE *entry;
54310121 2598 I32 gimme = GIMME_V;
c750a3ec 2599 I32 realhv = (SvTYPE(hash) == SVt_PVHV);
8ec5e241 2600
c07a80fd 2601 PUTBACK;
c750a3ec
MB
2602 /* might clobber stack_sp */
2603 entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
c07a80fd 2604 SPAGAIN;
79072805 2605
79072805
LW
2606 EXTEND(SP, 2);
2607 if (entry) {
54310121
PP
2608 PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
2609 if (gimme == G_ARRAY) {
59af0135 2610 SV *val;
c07a80fd 2611 PUTBACK;
c750a3ec 2612 /* might clobber stack_sp */
59af0135
GS
2613 val = realhv ?
2614 hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
c07a80fd 2615 SPAGAIN;
59af0135 2616 PUSHs(val);
79072805 2617 }
79072805 2618 }
54310121 2619 else if (gimme == G_SCALAR)
79072805
LW
2620 RETPUSHUNDEF;
2621
2622 RETURN;
2623}
2624
2625PP(pp_values)
2626{
cea2e8a9 2627 return do_kv();
79072805
LW
2628}
2629
2630PP(pp_keys)
2631{
cea2e8a9 2632 return do_kv();
79072805
LW
2633}
2634
2635PP(pp_delete)
2636{
4e35701f 2637 djSP;
54310121
PP
2638 I32 gimme = GIMME_V;
2639 I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
79072805 2640 SV *sv;
5f05dabc
PP
2641 HV *hv;
2642
533c011a 2643 if (PL_op->op_private & OPpSLICE) {
5f05dabc 2644 dMARK; dORIGMARK;
97fcbf96 2645 U32 hvtype;
5f05dabc 2646 hv = (HV*)POPs;
97fcbf96 2647 hvtype = SvTYPE(hv);
01020589
GS
2648 if (hvtype == SVt_PVHV) { /* hash element */
2649 while (++MARK <= SP) {
ae77835f 2650 sv = hv_delete_ent(hv, *MARK, discard, 0);
01020589
GS
2651 *MARK = sv ? sv : &PL_sv_undef;
2652 }
5f05dabc 2653 }
01020589
GS
2654 else if (hvtype == SVt_PVAV) {
2655 if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
2656 while (++MARK <= SP) {
2657 sv = av_delete((AV*)hv, SvIV(*MARK), discard);
2658 *MARK = sv ? sv : &PL_sv_undef;
2659 }
2660 }
2661 else { /* pseudo-hash element */
2662 while (++MARK <= SP) {
2663 sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
2664 *MARK = sv ? sv : &PL_sv_undef;
2665 }
2666 }
2667 }
2668 else
2669 DIE(aTHX_ "Not a HASH reference");
54310121
PP
2670 if (discard)
2671 SP = ORIGMARK;
2672 else if (gimme == G_SCALAR) {
5f05dabc
PP
2673 MARK = ORIGMARK;
2674 *++MARK = *SP;
2675 SP = MARK;
2676 }
2677 }
2678 else {
2679 SV *keysv = POPs;
2680 hv = (HV*)POPs;
97fcbf96
MB
2681 if (SvTYPE(hv) == SVt_PVHV)
2682 sv = hv_delete_ent(hv, keysv, discard, 0);
01020589
GS
2683 else if (SvTYPE(hv) == SVt_PVAV) {
2684 if (PL_op->op_flags & OPf_SPECIAL)
2685 sv = av_delete((AV*)hv, SvIV(keysv), discard);
2686 else
2687 sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
2688 }
97fcbf96 2689 else
cea2e8a9 2690 DIE(aTHX_ "Not a HASH reference");
5f05dabc 2691 if (!sv)
3280af22 2692 sv = &PL_sv_undef;
54310121
PP
2693 if (!discard)
2694 PUSHs(sv);
79072805 2695 }
79072805
LW
2696 RETURN;
2697}
2698
a0d0e21e 2699PP(pp_exists)
79072805 2700{
4e35701f 2701 djSP;
afebc493
GS
2702 SV *tmpsv;
2703 HV *hv;
2704
2705 if (PL_op->op_private & OPpEXISTS_SUB) {
2706 GV *gv;
2707 CV *cv;
2708 SV *sv = POPs;
2709 cv = sv_2cv(sv, &hv, &gv, FALSE);
2710 if (cv)
2711 RETPUSHYES;
2712 if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
2713 RETPUSHYES;
2714 RETPUSHNO;
2715 }
2716 tmpsv = POPs;
2717 hv = (HV*)POPs;
c750a3ec 2718 if (SvTYPE(hv) == SVt_PVHV) {
ae77835f 2719 if (hv_exists_ent(hv, tmpsv, 0))
c750a3ec 2720 RETPUSHYES;
ef54e1a4
JH
2721 }
2722 else if (SvTYPE(hv) == SVt_PVAV) {
01020589
GS
2723 if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
2724 if (av_exists((AV*)hv, SvIV(tmpsv)))
2725 RETPUSHYES;
2726 }
2727 else if (avhv_exists_ent((AV*)hv, tmpsv, 0)) /* pseudo-hash element */
c750a3ec 2728 RETPUSHYES;
ef54e1a4
JH
2729 }
2730 else {
cea2e8a9 2731 DIE(aTHX_ "Not a HASH reference");
a0d0e21e 2732 }
a0d0e21e
LW
2733 RETPUSHNO;
2734}
79072805 2735
a0d0e21e
LW
2736PP(pp_hslice)
2737{
4e35701f 2738 djSP; dMARK; dORIGMARK;
a0d0e21e 2739 register HV *hv = (HV*)POPs;
533c011a 2740 register I32 lval = PL_op->op_flags & OPf_MOD;
c750a3ec 2741 I32 realhv = (SvTYPE(hv) == SVt_PVHV);
79072805 2742
0ebe0038 2743 if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
cea2e8a9 2744 DIE(aTHX_ "Can't localize pseudo-hash element");
0ebe0038 2745
c750a3ec 2746 if (realhv || SvTYPE(hv) == SVt_PVAV) {
a0d0e21e 2747 while (++MARK <= SP) {
f12c7020 2748 SV *keysv = *MARK;
ae77835f
MB
2749 SV **svp;
2750 if (realhv) {
800e9ae0 2751 HE *he = hv_fetch_ent(hv, keysv, lval, 0);
ae77835f 2752 svp = he ? &HeVAL(he) : 0;
ef54e1a4
JH
2753 }
2754 else {
97fcbf96 2755 svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
ae77835f 2756 }
a0d0e21e 2757 if (lval) {
2d8e6c8d
GS
2758 if (!svp || *svp == &PL_sv_undef) {
2759 STRLEN n_a;
cea2e8a9 2760 DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
2d8e6c8d 2761 }
533c011a 2762 if (PL_op->op_private & OPpLVAL_INTRO)
800e9ae0 2763 save_helem(hv, keysv, svp);
93a17b20 2764 }
3280af22 2765 *MARK = svp ? *svp : &PL_sv_undef;
79072805
LW
2766 }
2767 }
a0d0e21e
LW
2768 if (GIMME != G_ARRAY) {
2769 MARK = ORIGMARK;
2770 *++MARK = *SP;
2771 SP = MARK;
79072805 2772 }
a0d0e21e
LW
2773 RETURN;
2774}
2775
2776/* List operators. */
2777
2778PP(pp_list)
2779{
4e35701f 2780 djSP; dMARK;
a0d0e21e
LW
2781 if (GIMME != G_ARRAY) {
2782 if (++MARK <= SP)
2783 *MARK = *SP; /* unwanted list, return last item */
8990e307 2784 else
3280af22 2785 *MARK = &PL_sv_undef;
a0d0e21e 2786 SP = MARK;
79072805 2787 }
a0d0e21e 2788 RETURN;
79072805
LW
2789}
2790
a0d0e21e 2791PP(pp_lslice)
79072805 2792{
4e35701f 2793 djSP;
3280af22
NIS
2794 SV **lastrelem = PL_stack_sp;
2795 SV **lastlelem = PL_stack_base + POPMARK;
2796 SV **firstlelem = PL_stack_base + POPMARK + 1;
a0d0e21e 2797 register SV **firstrelem = lastlelem + 1;
3280af22 2798 I32 arybase = PL_curcop->cop_arybase;
533c011a 2799 I32 lval = PL_op->op_flags & OPf_MOD;
4633a7c4 2800 I32 is_something_there = lval;
79072805 2801
a0d0e21e
LW
2802 register I32 max = lastrelem - lastlelem;
2803 register SV **lelem;
2804 register I32 ix;
2805
2806 if (GIMME != G_ARRAY) {
748a9306
LW
2807 ix = SvIVx(*lastlelem);
2808 if (ix < 0)
2809 ix += max;
2810 else
2811 ix -= arybase;
a0d0e21e 2812 if (ix < 0 || ix >= max)
3280af22 2813 *firstlelem = &PL_sv_undef;
a0d0e21e
LW
2814 else
2815 *firstlelem = firstrelem[ix];
2816 SP = firstlelem;
2817 RETURN;
2818 }
2819
2820 if (max == 0) {
2821 SP = firstlelem - 1;
2822 RETURN;
2823 }
2824
2825 for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
748a9306 2826 ix = SvIVx(*lelem);
c73bf8e3 2827 if (ix < 0)
a0d0e21e 2828 ix += max;
c73bf8e3 2829 else
748a9306 2830 ix -= arybase;
c73bf8e3
HS
2831 if (ix < 0 || ix >= max)
2832 *lelem = &PL_sv_undef;
2833 else {
2834 is_something_there = TRUE;
2835 if (!(*lelem = firstrelem[ix]))
3280af22 2836 *lelem = &PL_sv_undef;
748a9306 2837 }
79072805 2838 }
4633a7c4
LW
2839 if (is_something_there)
2840 SP = lastlelem;
2841 else
2842 SP = firstlelem - 1;
79072805
LW
2843 RETURN;
2844}
2845
a0d0e21e
LW
2846PP(pp_anonlist)
2847{
4e35701f 2848 djSP; dMARK; dORIGMARK;
a0d0e21e 2849 I32 items = SP - MARK;
44a8e56a
PP
2850 SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
2851 SP = ORIGMARK; /* av_make() might realloc stack_sp */
2852 XPUSHs(av);
a0d0e21e
LW
2853 RETURN;
2854}
2855
2856PP(pp_anonhash)
79072805 2857{
4e35701f 2858 djSP; dMARK; dORIGMARK;
a0d0e21e
LW
2859 HV* hv = (HV*)sv_2mortal((SV*)newHV());
2860
2861 while (MARK < SP) {
2862 SV* key = *++MARK;
a0d0e21e
LW
2863 SV *val = NEWSV(46, 0);
2864 if (MARK < SP)
2865 sv_setsv(val, *++MARK);
e476b1b5
GS
2866 else if (ckWARN(WARN_MISC))
2867 Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
f12c7020 2868 (void)hv_store_ent(hv,key,val,0);
79072805 2869 }
a0d0e21e
LW
2870 SP = ORIGMARK;
2871 XPUSHs((SV*)hv);
79072805
LW
2872 RETURN;
2873}
2874
a0d0e21e 2875PP(pp_splice)
79072805 2876{
4e35701f 2877 djSP; dMARK; dORIGMARK;
a0d0e21e
LW
2878 register AV *ary = (AV*)*++MARK;
2879 register SV **src;
2880 register SV **dst;
2881 register I32 i;
2882 register I32 offset;
2883 register I32 length;
2884 I32 newlen;
2885 I32 after;
2886 I32 diff;
2887 SV **tmparyval = 0;
93965878
NIS
2888 MAGIC *mg;
2889
33c27489
GS
2890 if (mg = SvTIED_mg((SV*)ary, 'P')) {
2891 *MARK-- = SvTIED_obj((SV*)ary, mg);
93965878 2892 PUSHMARK(MARK);
8ec5e241 2893 PUTBACK;
a60c0954 2894 ENTER;
864dbfa3 2895 call_method("SPLICE",GIMME_V);
a60c0954 2896 LEAVE;
93965878
NIS
2897 SPAGAIN;
2898 RETURN;
2899 }
79072805 2900
a0d0e21e 2901 SP++;
79072805 2902
a0d0e21e 2903 if (++MARK < SP) {
84902520 2904 offset = i = SvIVx(*MARK);
a0d0e21e 2905 if (offset < 0)
93965878 2906 offset += AvFILLp(ary) + 1;
a0d0e21e 2907 else
3280af22 2908 offset -= PL_curcop->cop_arybase;
84902520 2909 if (offset < 0)
cea2e8a9 2910 DIE(aTHX_ PL_no_aelem, i);
a0d0e21e
LW
2911 if (++MARK < SP) {
2912 length = SvIVx(*MARK++);
48cdf507
GA
2913 if (length < 0) {
2914 length += AvFILLp(ary) - offset + 1;
2915 if (length < 0)
2916 length = 0;
2917 }
79072805
LW
2918 }
2919 else
a0d0e21e 2920 length = AvMAX(ary) + 1; /* close enough to infinity */
79072805 2921 }
a0d0e21e
LW
2922 else {
2923 offset = 0;
2924 length = AvMAX(ary) + 1;
2925 }
93965878
NIS
2926 if (offset > AvFILLp(ary) + 1)
2927 offset = AvFILLp(ary) + 1;
2928 after = AvFILLp(ary) + 1 - (offset + length);
a0d0e21e
LW
2929 if (after < 0) { /* not that much array */
2930 length += after; /* offset+length now in array */
2931 after = 0;
2932 if (!AvALLOC(ary))
2933 av_extend(ary, 0);
2934 }
2935
2936 /* At this point, MARK .. SP-1 is our new LIST */
2937
2938 newlen = SP - MARK;
2939 diff = newlen - length;
13d7cbc1
GS
2940 if (newlen && !AvREAL(ary) && AvREIFY(ary))
2941 av_reify(ary);
a0d0e21e
LW
2942
2943 if (diff < 0) { /* shrinking the area */
2944 if (newlen) {
2945 New(451, tmparyval, newlen, SV*); /* so remember insertion */
2946 Copy(MARK, tmparyval, newlen, SV*);
79072805 2947 }
a0d0e21e
LW
2948
2949 MARK = ORIGMARK + 1;
2950 if (GIMME == G_ARRAY) { /* copy return vals to stack */
2951 MEXTEND(MARK, length);
2952 Copy(AvARRAY(ary)+offset, MARK, length, SV*);
2953 if (AvREAL(ary)) {
bbce6d69 2954 EXTEND_MORTAL(length);
36477c24 2955 for (i = length, dst = MARK; i; i--) {
d689ffdd 2956 sv_2mortal(*dst); /* free them eventualy */
36477c24
PP
2957 dst++;
2958 }
a0d0e21e
LW
2959 }
2960 MARK += length - 1;
79072805 2961 }
a0d0e21e
LW
2962 else {
2963 *MARK = AvARRAY(ary)[offset+length-1];
2964 if (AvREAL(ary)) {
d689ffdd 2965 sv_2mortal(*MARK);
a0d0e21e
LW
2966 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
2967 SvREFCNT_dec(*dst++); /* free them now */
79072805 2968 }
a0d0e21e 2969 }
93965878 2970 AvFILLp(ary) += diff;
a0d0e21e
LW
2971
2972 /* pull up or down? */
2973
2974 if (offset < after) { /* easier to pull up */
2975 if (offset) { /* esp. if nothing to pull */
2976 src = &AvARRAY(ary)[offset-1];
2977 dst = src - diff; /* diff is negative */
2978 for (i = offset; i > 0; i--) /* can't trust Copy */
2979 *dst-- = *src--;
79072805 2980 }
a0d0e21e
LW
2981 dst = AvARRAY(ary);
2982 SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
2983 AvMAX(ary) += diff;
2984 }
2985 else {
2986 if (after) { /* anything to pull down? */
2987 src = AvARRAY(ary) + offset + length;
2988 dst = src + diff; /* diff is negative */
2989 Move(src, dst, after, SV*);
79072805 2990 }
93965878 2991 dst = &AvARRAY(ary)[AvFILLp(ary)+1];
a0d0e21e
LW
2992 /* avoid later double free */
2993 }
2994 i = -diff;
2995 while (i)
3280af22 2996 dst[--i] = &PL_sv_undef;
a0d0e21e
LW
2997
2998 if (newlen) {
2999 for (src = tmparyval, dst = AvARRAY(ary) + offset;
3000 newlen; newlen--) {
3001 *dst = NEWSV(46, 0);
3002 sv_setsv(*dst++, *src++);
79072805 3003 }
a0d0e21e
LW
3004 Safefree(tmparyval);
3005 }
3006 }
3007 else { /* no, expanding (or same) */
3008 if (length) {
3009 New(452, tmparyval, length, SV*); /* so remember deletion */
3010 Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
3011 }
3012
3013 if (diff > 0) { /* expanding */
3014
3015 /* push up or down? */
3016
3017 if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
3018 if (offset) {
3019 src = AvARRAY(ary);
3020 dst = src - diff;
3021 Move(src, dst, offset, SV*);
79072805 3022 }
a0d0e21e
LW
3023 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
3024 AvMAX(ary) += diff;
93965878 3025 AvFILLp(ary) += diff;
79072805
LW
3026 }
3027 else {
93965878
NIS
3028 if (AvFILLp(ary) + diff >= AvMAX(ary)) /* oh, well */
3029 av_extend(ary, AvFILLp(ary) + diff);
3030 AvFILLp(ary) += diff;
a0d0e21e
LW
3031
3032 if (after) {
93965878 3033 dst = AvARRAY(ary) + AvFILLp(ary);
a0d0e21e
LW
3034 src = dst - diff;
3035 for (i = after; i; i--) {
3036 *dst-- = *src--;
3037 }
79072805
LW
3038 }
3039 }
a0d0e21e
LW
3040 }
3041
3042 for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
3043 *dst = NEWSV(46, 0);
3044 sv_setsv(*dst++, *src++);
3045 }
3046 MARK = ORIGMARK + 1;
3047 if (GIMME == G_ARRAY) { /* copy return vals to stack */
3048 if (length) {
3049 Copy(tmparyval, MARK, length, SV*);
3050 if (AvREAL(ary)) {
bbce6d69 3051 EXTEND_MORTAL(length);
36477c24 3052 for (i = length, dst = MARK; i; i--) {
d689ffdd 3053 sv_2mortal(*dst); /* free them eventualy */
36477c24
PP
3054 dst++;
3055 }
79072805 3056 }
a0d0e21e 3057 Safefree(tmparyval);
79072805 3058 }
a0d0e21e
LW
3059 MARK += length - 1;
3060 }
3061 else if (length--) {
3062 *MARK = tmparyval[length];
3063 if (AvREAL(ary)) {
d689ffdd 3064 sv_2mortal(*MARK);
a0d0e21e
LW
3065 while (length-- > 0)
3066 SvREFCNT_dec(tmparyval[length]);
79072805 3067 }
a0d0e21e 3068 Safefree(tmparyval);
79072805 3069 }
a0d0e21e 3070 else
3280af22 3071 *MARK = &PL_sv_undef;
79072805 3072 }
a0d0e21e 3073 SP = MARK;
79072805
LW
3074 RETURN;
3075}
3076
a0d0e21e 3077PP(pp_push)
79072805 3078{
4e35701f 3079 djSP; dMARK; dORIGMARK; dTARGET;
a0d0e21e 3080 register AV *ary = (AV*)*++MARK;
3280af22 3081 register SV *sv = &PL_sv_undef;
93965878 3082 MAGIC *mg;
79072805 3083
33c27489
GS
3084 if (mg = SvTIED_mg((SV*)ary, 'P')) {
3085 *MARK-- = SvTIED_obj((SV*)ary, mg);
93965878
NIS
3086 PUSHMARK(MARK);
3087 PUTBACK;
a60c0954 3088 ENTER;
864dbfa3 3089 call_method("PUSH",G_SCALAR|G_DISCARD);
a60c0954 3090 LEAVE;
93965878 3091 SPAGAIN;
93965878 3092 }
a60c0954
NIS
3093 else {
3094 /* Why no pre-extend of ary here ? */
3095 for (++MARK; MARK <= SP; MARK++) {
3096 sv = NEWSV(51, 0);
3097 if (*MARK)
3098 sv_setsv(sv, *MARK);
3099 av_push(ary, sv);
3100 }
79072805
LW
3101 }
3102 SP = ORIGMARK;
a0d0e21e 3103 PUSHi( AvFILL(ary) + 1 );
79072805
LW
3104 RETURN;
3105}
3106
a0d0e21e 3107PP(pp_pop)
79072805 3108{
4e35701f 3109 djSP;
a0d0e21e
LW
3110 AV *av = (AV*)POPs;
3111 SV *sv = av_pop(av);
d689ffdd 3112 if (AvREAL(av))
a0d0e21e
LW
3113 (void)sv_2mortal(sv);
3114 PUSHs(sv);
79072805 3115 RETURN;
79072805
LW
3116}
3117
a0d0e21e 3118PP(pp_shift)
79072805 3119{
4e35701f 3120 djSP;
a0d0e21e
LW
3121 AV *av = (AV*)POPs;
3122 SV *sv = av_shift(av);
79072805 3123 EXTEND(SP, 1);
a0d0e21e 3124 if (!sv)
79072805 3125 RETPUSHUNDEF;
d689ffdd 3126 if (AvREAL(av))
a0d0e21e
LW
3127 (void)sv_2mortal(sv);
3128 PUSHs(sv);
79072805 3129 RETURN;
79072805
LW
3130}
3131
a0d0e21e 3132PP(pp_unshift)
79072805 3133{
4e35701f 3134 djSP; dMARK; dORIGMARK; dTARGET;
a0d0e21e
LW
3135 register AV *ary = (AV*)*++MARK;
3136 register SV *sv;
3137 register I32 i = 0;
93965878
NIS
3138 MAGIC *mg;
3139
33c27489
GS
3140 if (mg = SvTIED_mg((SV*)ary, 'P')) {
3141 *MARK-- = SvTIED_obj((SV*)ary, mg);
7fd66d9d 3142 PUSHMARK(MARK);
93965878 3143 PUTBACK;
a60c0954 3144 ENTER;
864dbfa3 3145 call_method("UNSHIFT",G_SCALAR|G_DISCARD);
a60c0954 3146 LEAVE;
93965878 3147 SPAGAIN;
93965878 3148 }
a60c0954
NIS
3149 else {
3150 av_unshift(ary, SP - MARK);
3151 while (MARK < SP) {
3152 sv = NEWSV(27, 0);
3153 sv_setsv(sv, *++MARK);
3154 (void)av_store(ary, i++, sv);
3155 }
79072805 3156 }
a0d0e21e
LW
3157 SP = ORIGMARK;
3158 PUSHi( AvFILL(ary) + 1 );
79072805 3159 RETURN;
79072805
LW
3160}
3161
a0d0e21e 3162PP(pp_reverse)
79072805 3163{
4e35701f 3164 djSP; dMARK;
a0d0e21e
LW
3165 register SV *tmp;
3166 SV **oldsp = SP;
79072805 3167
a0d0e21e
LW
3168 if (GIMME == G_ARRAY) {
3169 MARK++;
3170 while (MARK < SP) {
3171 tmp = *MARK;
3172 *MARK++ = *SP;
3173 *SP-- = tmp;
3174 }
dd58a1ab 3175 /* safe as long as stack cannot get extended in the above */
a0d0e21e 3176 SP = oldsp;
79072805
LW
3177 }
3178 else {
a0d0e21e
LW
3179 register char *up;
3180 register char *down;
3181 register I32 tmp;
3182 dTARGET;
3183 STRLEN len;
79072805 3184
7e2040f0 3185 SvUTF8_off(TARG); /* decontaminate */
a0d0e21e 3186 if (SP - MARK > 1)
3280af22 3187 do_join(TARG, &PL_sv_no, MARK, SP);
a0d0e21e 3188 else
54b9620d 3189 sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
a0d0e21e
LW
3190 up = SvPV_force(TARG, len);
3191 if (len > 1) {
7e2040f0 3192 if (DO_UTF8(TARG)) { /* first reverse each character */
dfe13c55
GS
3193 U8* s = (U8*)SvPVX(TARG);
3194 U8* send = (U8*)(s + len);
a0ed51b3
LW
3195 while (s < send) {
3196 if (*s < 0x80) {
3197 s++;
3198 continue;
3199 }
3200 else {
dfe13c55 3201 up = (char*)s;
a0ed51b3 3202 s += UTF8SKIP(s);
dfe13c55 3203 down = (char*)(s - 1);
f248d071
GS
3204 if (s > send || !((*down & 0xc0) == 0x80)) {
3205 if (ckWARN_d(WARN_UTF8))
3206 Perl_warner(aTHX_ WARN_UTF8,
3207 "Malformed UTF-8 character");
a0ed51b3
LW
3208 break;
3209 }
3210 while (down > up) {
3211 tmp = *up;
3212 *up++ = *down;
3213 *down-- = tmp;
3214 }
3215 }
3216 }
3217 up = SvPVX(TARG);
3218 }
a0d0e21e
LW
3219 down = SvPVX(TARG) + len - 1;
3220 while (down > up) {
3221 tmp = *up;
3222 *up++ = *down;
3223 *down-- = tmp;
3224 }
3225 (void)SvPOK_only(TARG);
79072805 3226 }
a0d0e21e
LW
3227 SP = MARK + 1;
3228 SETTARG;
79072805 3229 }
a0d0e21e 3230 RETURN;
79072805
LW
3231}
3232
864dbfa3 3233STATIC SV *
cea2e8a9 3234S_mul128(pTHX_ SV *sv, U8 m)
55497cff
PP
3235{
3236 STRLEN len;
3237 char *s = SvPV(sv, len);
3238 char *t;
3239 U32 i = 0;
3240
3241 if (!strnEQ(s, "0000", 4)) { /* need to grow sv */
79cb57f6 3242 SV *tmpNew = newSVpvn("0000000000", 10);
55497cff 3243
09b7f37c 3244 sv_catsv(tmpNew, sv);
55497cff 3245 SvREFCNT_dec(sv); /* free old sv */
09b7f37c 3246 sv = tmpNew;
55497cff
PP
3247 s = SvPV(sv, len);
3248 }
3249 t = s + len - 1;
3250 while (!*t) /* trailing '\0'? */
3251 t--;
3252 while (t > s) {
3253 i = ((*t - '0') << 7) + m;
3254 *(t--) = '0' + (i % 10);
3255 m = i / 10;
3256 }
3257 return (sv);
3258}
3259
a0d0e21e
LW
3260/* Explosives and implosives. */
3261
9d116dd7
JH
3262#if 'I' == 73 && 'J' == 74
3263/* On an ASCII/ISO kind of system */
ba1ac976 3264#define ISUUCHAR(ch) ((ch) >= ' ' && (ch) < 'a')
9d116dd7
JH
3265#else
3266/*
3267 Some other sort of character set - use memchr() so we don't match
3268 the null byte.
3269 */
80252599 3270#define ISUUCHAR(ch) (memchr(PL_uuemap, (ch), sizeof(PL_uuemap)-1) || (ch) == ' ')
9d116dd7
JH
3271#endif
3272
a0d0e21e 3273PP(pp_unpack)
79072805 3274{
4e35701f 3275 djSP;
a0d0e21e 3276 dPOPPOPssrl;
dd58a1ab 3277 I32 start_sp_offset = SP - PL_stack_base;
54310121 3278 I32 gimme = GIMME_V;
ed6116ce 3279 SV *sv;
a0d0e21e
LW
3280 STRLEN llen;
3281 STRLEN rlen;
3282 register char *pat = SvPV(left, llen);
3283 register char *s = SvPV(right, rlen);
3284 char *strend = s + rlen;
3285 char *strbeg = s;
3286 register char *patend = pat + llen;
3287 I32 datumtype;
3288 register I32 len;
3289 register I32 bits;
abdc5761 3290 register char *str;
79072805 3291
a0d0e21e
LW
3292 /* These must not be in registers: */
3293 I16 ashort;
3294 int aint;
3295 I32 along;
6b8eaf93 3296#ifdef HAS_QUAD
ecfc5424 3297 Quad_t aquad;
a0d0e21e
LW
3298#endif
3299 U16 aushort;
3300 unsigned int auint;
3301 U32 aulong;
6b8eaf93 3302#ifdef HAS_QUAD
e862df63 3303 Uquad_t auquad;
a0d0e21e
LW
3304#endif
3305 char *aptr;
3306 float afloat;
3307 double adouble;
3308 I32 checksum = 0;
3309 register U32 culong;
65202027 3310 NV cdouble;
fb73857a 3311 int commas = 0;
4b5b2118 3312 int star;
726ea183 3313#ifdef PERL_NATINT_PACK
ef54e1a4
JH
3314 int natint; /* native integer */
3315 int unatint; /* unsigned native integer */
726ea183 3316#endif
79072805 3317
54310121 3318 if (gimme != G_ARRAY) { /* arrange to do first one only */
a0d0e21e
LW
3319 /*SUPPRESS 530*/
3320 for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
5a929a98 3321 if (strchr("aAZbBhHP", *patend) || *pat == '%') {
a0d0e21e
LW
3322 patend++;
3323 while (isDIGIT(*patend) || *patend == '*')
3324 patend++;
3325 }
3326 else
3327 patend++;
79072805 3328 }
a0d0e21e
LW
3329 while (pat < patend) {
3330 reparse:
bbdab043 3331 datumtype = *pat++ & 0xFF;
726ea183 3332#ifdef PERL_NATINT_PACK
ef54e1a4 3333 natint = 0;
726ea183 3334#endif
bbdab043
CS
3335 if (isSPACE(datumtype))
3336 continue;
17f4a12d
IZ
3337 if (datumtype == '#') {
3338 while (pat < patend && *pat != '\n')
3339 pat++;
3340 continue;
3341 }
f61d411c 3342 if (*pat == '!') {
ef54e1a4
JH
3343 char *natstr = "sSiIlL";
3344
3345 if (strchr(natstr, datumtype)) {
726ea183 3346#ifdef PERL_NATINT_PACK
ef54e1a4 3347 natint = 1;
726ea183 3348#endif
ef54e1a4
JH
3349 pat++;
3350 }
3351 else
d470f89e 3352 DIE(aTHX_ "'!' allowed only after types %s", natstr);
ef54e1a4 3353 }
4b5b2118 3354 star = 0;
a0d0e21e
LW
3355 if (pat >= patend)
3356 len = 1;
3357 else if (*pat == '*') {
3358 len = strend - strbeg; /* long enough */
3359 pat++;
4b5b2118 3360 star = 1;
a0d0e21e
LW
3361 }
3362 else if (isDIGIT(*pat)) {
3363 len = *pat++ - '0';
06387354 3364 while (isDIGIT(*pat)) {
a0d0e21e 3365 len = (len * 10) + (*pat++ - '0');
06387354 3366 if (len < 0)
d470f89e 3367 DIE(aTHX_ "Repeat count in unpack overflows");
06387354 3368 }
a0d0e21e
LW
3369 }
3370 else
3371 len = (datumtype != '@');
4b5b2118 3372 redo_switch:
a0d0e21e
LW
3373 switch(datumtype) {
3374 default:
d470f89e 3375 DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
fb73857a 3376 case ',': /* grandfather in commas but with a warning */
e476b1b5
GS
3377 if (commas++ == 0 && ckWARN(WARN_UNPACK))
3378 Perl_warner(aTHX_ WARN_UNPACK,
d470f89e 3379 "Invalid type in unpack: '%c'", (int)datumtype);
fb73857a 3380 break;
a0d0e21e
LW
3381 case '%':
3382 if (len == 1 && pat[-1] != '1')
3383 len = 16;
3384 checksum = len;
3385 culong = 0;
3386 cdouble = 0;
3387 if (pat < patend)
3388 goto reparse;
3389 break;
3390 case '@':
3391 if (len > strend - strbeg)
cea2e8a9 3392 DIE(aTHX_ "@ outside of string");
a0d0e21e
LW
3393 s = strbeg + len;
3394 break;
3395 case 'X':
3396 if (len > s - strbeg)
cea2e8a9 3397 DIE(aTHX_ "X outside of string");
a0d0e21e
LW
3398 s -= len;
3399 break;
3400 case 'x':
3401 if (len > strend - s)
cea2e8a9 3402 DIE(aTHX_ "x outside of string");
a0d0e21e
LW
3403 s += len;
3404 break;
17f4a12d 3405 case '/':
dd58a1ab 3406 if (start_sp_offset >= SP - PL_stack_base)
17f4a12d 3407 DIE(aTHX_ "/ must follow a numeric type");
43192e07
IP
3408 datumtype = *pat++;
3409 if (*pat == '*')
3410 pat++; /* ignore '*' for compatibility with pack */
3411 if (isDIGIT(*pat))
17f4a12d 3412 DIE(aTHX_ "/ cannot take a count" );
43192e07 3413 len = POPi;
4b5b2118
GS
3414 star = 0;
3415 goto redo_switch;
a0d0e21e 3416 case 'A':
5a929a98 3417 case 'Z':
a0d0e21e
LW
3418 case 'a':
3419 if (len > strend - s)
3420 len = strend - s;
3421 if (checksum)
3422 goto uchar_checksum;
3423 sv = NEWSV(35, len);
3424 sv_setpvn(sv, s, len);
3425 s += len;
5a929a98 3426 if (datumtype == 'A' || datumtype == 'Z') {
a0d0e21e 3427 aptr = s; /* borrow register */
5a929a98
VU
3428 if (datumtype == 'Z') { /* 'Z' strips stuff after first null */
3429 s = SvPVX(sv);
3430 while (*s)
3431 s++;
3432 }
3433 else { /* 'A' strips both nulls and spaces */
3434 s = SvPVX(sv) + len - 1;
3435 while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
3436 s--;
3437 *++s = '\0';
3438 }
a0d0e21e
LW
3439 SvCUR_set(sv, s - SvPVX(sv));
3440 s = aptr; /* unborrow register */
3441 }
3442 XPUSHs(sv_2mortal(sv));
3443 break;
3444 case 'B':
3445 case 'b':
4b5b2118 3446 if (star || len > (strend - s) * 8)
a0d0e21e
LW
3447 len = (strend - s) * 8;
3448 if (checksum) {
80252599
GS
3449 if (!PL_bitcount) {
3450 Newz(601, PL_bitcount, 256, char);
a0d0e21e 3451 for (bits = 1; bits < 256; bits++) {
80252599
GS
3452 if (bits & 1) PL_bitcount[bits]++;
3453 if (bits & 2) PL_bitcount[bits]++;
3454 if (bits & 4) PL_bitcount[bits]++;
3455 if (bits & 8) PL_bitcount[bits]++;
3456 if (bits & 16) PL_bitcount[bits]++;
3457 if (bits & 32) PL_bitcount[bits]++;
3458 if (bits & 64) PL_bitcount[bits]++;
3459 if (bits & 128) PL_bitcount[bits]++;
a0d0e21e
LW
3460 }
3461 }
3462 while (len >= 8) {
80252599 3463 culong += PL_bitcount[*(unsigned char*)s++];
a0d0e21e
LW
3464 len -= 8;
3465 }
3466 if (len) {
3467 bits = *s;
3468 if (datumtype == 'b') {
3469 while (len-- > 0) {
3470 if (bits & 1) culong++;
3471 bits >>= 1;
3472 }
3473 }
3474 else {
3475 while (len-- > 0) {
3476 if (bits & 128) culong++;
3477 bits <<= 1;
3478 }
3479 }
3480 }
79072805
LW
3481 break;
3482 }
a0d0e21e
LW
3483 sv = NEWSV(35, len + 1);
3484 SvCUR_set(sv, len);
3485 SvPOK_on(sv);
abdc5761 3486 str = SvPVX(sv);
a0d0e21e
LW
3487 if (datumtype == 'b') {
3488 aint = len;
3489 for (len = 0; len < aint; len++) {
3490 if (len & 7) /*SUPPRESS 595*/
3491 bits >>= 1;
3492 else
3493 bits = *s++;
abdc5761 3494 *str++ = '0' + (bits & 1);
a0d0e21e
LW
3495 }
3496 }
3497 else {
3498 aint = len;
3499 for (len = 0; len < aint; len++) {
3500 if (len & 7)
3501 bits <<= 1;
3502 else
3503 bits = *s++;
abdc5761 3504 *str++ = '0' + ((bits & 128) != 0);
a0d0e21e
LW
3505 }
3506 }
abdc5761 3507 *str = '\0';
a0d0e21e
LW
3508 XPUSHs(sv_2mortal(sv));
3509 break;
3510 case 'H':
3511 case 'h':
4b5b2118 3512 if (star || len > (strend - s) * 2)
a0d0e21e
LW
3513 len = (strend - s) * 2;
3514 sv = NEWSV(35, len + 1);
3515 SvCUR_set(sv, len);
3516 SvPOK_on(sv);
abdc5761 3517 str = SvPVX(sv);
a0d0e21e
LW
3518 if (datumtype == 'h') {
3519 aint = len;
3520 for (len = 0; len < aint; len++) {
3521 if (len & 1)
3522 bits >>= 4;
3523 else
3524 bits = *s++;
abdc5761 3525 *str++ = PL_hexdigit[bits & 15];
a0d0e21e
LW
3526 }
3527 }
3528 else {
3529 aint = len;
3530 for (len = 0; len < aint; len++) {
3531 if (len & 1)
3532 bits <<= 4;
3533 else
3534 bits = *s++;
abdc5761 3535 *str++ = PL_hexdigit[(bits >> 4) & 15];
a0d0e21e
LW
3536 }
3537 }
abdc5761 3538 *str = '\0';
a0d0e21e
LW
3539 XPUSHs(sv_2mortal(sv));
3540 break;
3541 case 'c':
3542 if (len > strend - s)
3543 len = strend - s;
3544 if (checksum) {
3545 while (len-- > 0) {
3546 aint = *s++;
3547 if (aint >= 128) /* fake up signed chars */
3548 aint -= 256;
3549 culong += aint;
3550 }
3551 }
3552 else {
3553 EXTEND(SP, len);
bbce6d69 3554 EXTEND_MORTAL(len);
a0d0e21e
LW
3555 while (len-- > 0) {
3556 aint = *s++;
3557 if (aint >= 128) /* fake up signed chars */
3558 aint -= 256;
3559 sv = NEWSV(36, 0);
1e422769 3560 sv_setiv(sv, (IV)aint);
a0d0e21e
LW
3561 PUSHs(sv_2mortal(sv));
3562 }
3563 }
3564 break;
3565 case 'C':
3566 if (len > strend - s)
3567 len = strend - s;
3568 if (checksum) {
3569 uchar_checksum:
3570 while (len-- > 0) {
3571 auint = *s++ & 255;
3572 culong += auint;
3573 }
3574 }
3575 else {
3576 EXTEND(SP, len);
bbce6d69 3577 EXTEND_MORTAL(len);
a0d0e21e
LW
3578 while (len-- > 0) {
3579 auint = *s++ & 255;
3580 sv = NEWSV(37, 0);
1e422769 3581 sv_setiv(sv, (IV)auint);
a0d0e21e
LW
3582 PUSHs(sv_2mortal(sv));
3583 }
3584 }
3585 break;
a0ed51b3
LW
3586 case 'U':
3587 if (len > strend - s)
3588 len = strend - s;
3589 if (checksum) {
3590 while (len-- > 0 && s < strend) {
dfe13c55 3591 auint = utf8_to_uv((U8*)s, &along);
a0ed51b3 3592 s += along;
32d8b6e5 3593 if (checksum > 32)
65202027 3594 cdouble += (NV)auint;
32d8b6e5
GA
3595 else
3596 culong += auint;
a0ed51b3
LW
3597 }
3598 }
3599 else {
3600 EXTEND(SP, len);
3601 EXTEND_MORTAL(len);
3602 while (len-- > 0 && s < strend) {
dfe13c55 3603 auint = utf8_to_uv((U8*)s, &along);
a0ed51b3
LW
3604 s += along;
3605 sv = NEWSV(37, 0);
bdeef251 3606 sv_setuv(sv, (UV)auint);
a0ed51b3
LW
3607 PUSHs(sv_2mortal(sv));
3608 }
3609 }
3610 break;
a0d0e21e 3611 case 's':
726ea183
JH
3612#if SHORTSIZE == SIZE16
3613 along = (strend - s) / SIZE16;
3614#else
ef54e1a4 3615 along = (strend - s) / (natint ? sizeof(short) : SIZE16);
726ea183 3616#endif
a0d0e21e
LW
3617 if (len > along)
3618 len = along;
3619 if (checksum) {
726ea183 3620#if SHORTSIZE != SIZE16
ef54e1a4 3621 if (natint) {
bf9315bb 3622 short ashort;
ef54e1a4
JH
3623 while (len-- > 0) {
3624 COPYNN(s, &ashort, sizeof(short));
3625 s += sizeof(short);
3626 culong += ashort;
3627
3628 }
3629 }
726ea183
JH
3630 else
3631#endif
3632 {
ef54e1a4
JH
3633 while (len-- > 0) {
3634 COPY16(s, &ashort);
c67712b2
JH
3635#if SHORTSIZE > SIZE16
3636 if (ashort > 32767)
3637 ashort -= 65536;
3638#endif
ef54e1a4
JH
3639 s += SIZE16;
3640 culong += ashort;
3641 }
a0d0e21e
LW
3642 }
3643 }
3644 else {
3645 EXTEND(SP, len);
bbce6d69 3646 EXTEND_MORTAL(len);
726ea183 3647#if SHORTSIZE != SIZE16
ef54e1a4 3648 if (natint) {