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