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