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