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