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