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