This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
split() utf8 fixes. Should fix both 20001014.001 and 20000426.003.
[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 {
a0d0e21e 1071 register I32 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;
1479#ifdef LIBERAL
1480 for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
1481 *tmps = ~*tmps;
1482 tmpl = (long*)tmps;
1483 for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
1484 *tmpl = ~*tmpl;
1485 tmps = (char*)tmpl;
1486#endif
1487 for ( ; anum > 0; anum--, tmps++)
1488 *tmps = ~*tmps;
1489
1490 SETs(TARG);
1491 }
1492 RETURN;
1493 }
79072805
LW
1494}
1495
a0d0e21e
LW
1496/* integer versions of some of the above */
1497
a0d0e21e 1498PP(pp_i_multiply)
79072805 1499{
8ec5e241 1500 djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
a0d0e21e
LW
1501 {
1502 dPOPTOPiirl;
1503 SETi( left * right );
1504 RETURN;
1505 }
79072805
LW
1506}
1507
a0d0e21e 1508PP(pp_i_divide)
79072805 1509{
8ec5e241 1510 djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
a0d0e21e
LW
1511 {
1512 dPOPiv;
1513 if (value == 0)
cea2e8a9 1514 DIE(aTHX_ "Illegal division by zero");
a0d0e21e
LW
1515 value = POPi / value;
1516 PUSHi( value );
1517 RETURN;
1518 }
79072805
LW
1519}
1520
a0d0e21e 1521PP(pp_i_modulo)
79072805 1522{
76e3520e 1523 djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
79072805 1524 {
a0d0e21e 1525 dPOPTOPiirl;
aa306039 1526 if (!right)
cea2e8a9 1527 DIE(aTHX_ "Illegal modulus zero");
a0d0e21e
LW
1528 SETi( left % right );
1529 RETURN;
79072805 1530 }
79072805
LW
1531}
1532
a0d0e21e 1533PP(pp_i_add)
79072805 1534{
8ec5e241 1535 djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
a0d0e21e
LW
1536 {
1537 dPOPTOPiirl;
1538 SETi( left + right );
1539 RETURN;
79072805 1540 }
79072805
LW
1541}
1542
a0d0e21e 1543PP(pp_i_subtract)
79072805 1544{
8ec5e241 1545 djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
a0d0e21e
LW
1546 {
1547 dPOPTOPiirl;
1548 SETi( left - right );
1549 RETURN;
79072805 1550 }
79072805
LW
1551}
1552
a0d0e21e 1553PP(pp_i_lt)
79072805 1554{
8ec5e241 1555 djSP; tryAMAGICbinSET(lt,0);
a0d0e21e
LW
1556 {
1557 dPOPTOPiirl;
54310121 1558 SETs(boolSV(left < right));
a0d0e21e
LW
1559 RETURN;
1560 }
79072805
LW
1561}
1562
a0d0e21e 1563PP(pp_i_gt)
79072805 1564{
8ec5e241 1565 djSP; tryAMAGICbinSET(gt,0);
a0d0e21e
LW
1566 {
1567 dPOPTOPiirl;
54310121 1568 SETs(boolSV(left > right));
a0d0e21e
LW
1569 RETURN;
1570 }
79072805
LW
1571}
1572
a0d0e21e 1573PP(pp_i_le)
79072805 1574{
8ec5e241 1575 djSP; tryAMAGICbinSET(le,0);
a0d0e21e
LW
1576 {
1577 dPOPTOPiirl;
54310121 1578 SETs(boolSV(left <= right));
a0d0e21e 1579 RETURN;
85e6fe83 1580 }
79072805
LW
1581}
1582
a0d0e21e 1583PP(pp_i_ge)
79072805 1584{
8ec5e241 1585 djSP; tryAMAGICbinSET(ge,0);
a0d0e21e
LW
1586 {
1587 dPOPTOPiirl;
54310121 1588 SETs(boolSV(left >= right));
a0d0e21e
LW
1589 RETURN;
1590 }
79072805
LW
1591}
1592
a0d0e21e 1593PP(pp_i_eq)
79072805 1594{
8ec5e241 1595 djSP; tryAMAGICbinSET(eq,0);
a0d0e21e
LW
1596 {
1597 dPOPTOPiirl;
54310121 1598 SETs(boolSV(left == right));
a0d0e21e
LW
1599 RETURN;
1600 }
79072805
LW
1601}
1602
a0d0e21e 1603PP(pp_i_ne)
79072805 1604{
8ec5e241 1605 djSP; tryAMAGICbinSET(ne,0);
a0d0e21e
LW
1606 {
1607 dPOPTOPiirl;
54310121 1608 SETs(boolSV(left != right));
a0d0e21e
LW
1609 RETURN;
1610 }
79072805
LW
1611}
1612
a0d0e21e 1613PP(pp_i_ncmp)
79072805 1614{
8ec5e241 1615 djSP; dTARGET; tryAMAGICbin(ncmp,0);
a0d0e21e
LW
1616 {
1617 dPOPTOPiirl;
1618 I32 value;
79072805 1619
a0d0e21e 1620 if (left > right)
79072805 1621 value = 1;
a0d0e21e 1622 else if (left < right)
79072805 1623 value = -1;
a0d0e21e 1624 else
79072805 1625 value = 0;
a0d0e21e
LW
1626 SETi(value);
1627 RETURN;
79072805 1628 }
85e6fe83
LW
1629}
1630
1631PP(pp_i_negate)
1632{
4e35701f 1633 djSP; dTARGET; tryAMAGICun(neg);
85e6fe83
LW
1634 SETi(-TOPi);
1635 RETURN;
1636}
1637
79072805
LW
1638/* High falutin' math. */
1639
1640PP(pp_atan2)
1641{
8ec5e241 1642 djSP; dTARGET; tryAMAGICbin(atan2,0);
a0d0e21e
LW
1643 {
1644 dPOPTOPnnrl;
65202027 1645 SETn(Perl_atan2(left, right));
a0d0e21e
LW
1646 RETURN;
1647 }
79072805
LW
1648}
1649
1650PP(pp_sin)
1651{
4e35701f 1652 djSP; dTARGET; tryAMAGICun(sin);
a0d0e21e 1653 {
65202027 1654 NV value;
a0d0e21e 1655 value = POPn;
65202027 1656 value = Perl_sin(value);
a0d0e21e
LW
1657 XPUSHn(value);
1658 RETURN;
1659 }
79072805
LW
1660}
1661
1662PP(pp_cos)
1663{
4e35701f 1664 djSP; dTARGET; tryAMAGICun(cos);
a0d0e21e 1665 {
65202027 1666 NV value;
a0d0e21e 1667 value = POPn;
65202027 1668 value = Perl_cos(value);
a0d0e21e
LW
1669 XPUSHn(value);
1670 RETURN;
1671 }
79072805
LW
1672}
1673
56cb0a1c
AD
1674/* Support Configure command-line overrides for rand() functions.
1675 After 5.005, perhaps we should replace this by Configure support
1676 for drand48(), random(), or rand(). For 5.005, though, maintain
1677 compatibility by calling rand() but allow the user to override it.
1678 See INSTALL for details. --Andy Dougherty 15 July 1998
1679*/
85ab1d1d
JH
1680/* Now it's after 5.005, and Configure supports drand48() and random(),
1681 in addition to rand(). So the overrides should not be needed any more.
1682 --Jarkko Hietaniemi 27 September 1998
1683 */
1684
1685#ifndef HAS_DRAND48_PROTO
20ce7b12 1686extern double drand48 (void);
56cb0a1c
AD
1687#endif
1688
79072805
LW
1689PP(pp_rand)
1690{
4e35701f 1691 djSP; dTARGET;
65202027 1692 NV value;
79072805
LW
1693 if (MAXARG < 1)
1694 value = 1.0;
1695 else
1696 value = POPn;
1697 if (value == 0.0)
1698 value = 1.0;
80252599 1699 if (!PL_srand_called) {
85ab1d1d 1700 (void)seedDrand01((Rand_seed_t)seed());
80252599 1701 PL_srand_called = TRUE;
93dc8474 1702 }
85ab1d1d 1703 value *= Drand01();
79072805
LW
1704 XPUSHn(value);
1705 RETURN;
1706}
1707
1708PP(pp_srand)
1709{
4e35701f 1710 djSP;
93dc8474
CS
1711 UV anum;
1712 if (MAXARG < 1)
1713 anum = seed();
79072805 1714 else
93dc8474 1715 anum = POPu;
85ab1d1d 1716 (void)seedDrand01((Rand_seed_t)anum);
80252599 1717 PL_srand_called = TRUE;
79072805
LW
1718 EXTEND(SP, 1);
1719 RETPUSHYES;
1720}
1721
76e3520e 1722STATIC U32
cea2e8a9 1723S_seed(pTHX)
93dc8474 1724{
54310121
PP
1725 /*
1726 * This is really just a quick hack which grabs various garbage
1727 * values. It really should be a real hash algorithm which
1728 * spreads the effect of every input bit onto every output bit,
85ab1d1d 1729 * if someone who knows about such things would bother to write it.
54310121 1730 * Might be a good idea to add that function to CORE as well.
85ab1d1d 1731 * No numbers below come from careful analysis or anything here,
54310121
PP
1732 * except they are primes and SEED_C1 > 1E6 to get a full-width
1733 * value from (tv_sec * SEED_C1 + tv_usec). The multipliers should
1734 * probably be bigger too.
1735 */
1736#if RANDBITS > 16
1737# define SEED_C1 1000003
1738#define SEED_C4 73819
1739#else
1740# define SEED_C1 25747
1741#define SEED_C4 20639
1742#endif
1743#define SEED_C2 3
1744#define SEED_C3 269
1745#define SEED_C5 26107
1746
e858de61 1747 dTHR;
73c60299
RS
1748#ifndef PERL_NO_DEV_RANDOM
1749 int fd;
1750#endif
93dc8474 1751 U32 u;
f12c7020
PP
1752#ifdef VMS
1753# include <starlet.h>
43c92808
HF
1754 /* when[] = (low 32 bits, high 32 bits) of time since epoch
1755 * in 100-ns units, typically incremented ever 10 ms. */
93dc8474 1756 unsigned int when[2];
73c60299
RS
1757#else
1758# ifdef HAS_GETTIMEOFDAY
1759 struct timeval when;
1760# else
1761 Time_t when;
1762# endif
1763#endif
1764
1765/* This test is an escape hatch, this symbol isn't set by Configure. */
1766#ifndef PERL_NO_DEV_RANDOM
1767#ifndef PERL_RANDOM_DEVICE
1768 /* /dev/random isn't used by default because reads from it will block
1769 * if there isn't enough entropy available. You can compile with
1770 * PERL_RANDOM_DEVICE to it if you'd prefer Perl to block until there
1771 * is enough real entropy to fill the seed. */
1772# define PERL_RANDOM_DEVICE "/dev/urandom"
1773#endif
1774 fd = PerlLIO_open(PERL_RANDOM_DEVICE, 0);
1775 if (fd != -1) {
1776 if (PerlLIO_read(fd, &u, sizeof u) != sizeof u)
1777 u = 0;
1778 PerlLIO_close(fd);
1779 if (u)
1780 return u;
1781 }
1782#endif
1783
1784#ifdef VMS
93dc8474 1785 _ckvmssts(sys$gettim(when));
54310121 1786 u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
f12c7020 1787#else
5f05dabc 1788# ifdef HAS_GETTIMEOFDAY
93dc8474 1789 gettimeofday(&when,(struct timezone *) 0);
54310121 1790 u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
f12c7020 1791# else
93dc8474 1792 (void)time(&when);
54310121 1793 u = (U32)SEED_C1 * when;
f12c7020
PP
1794# endif
1795#endif
7766f137 1796 u += SEED_C3 * (U32)PerlProc_getpid();
56431972 1797 u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
54310121 1798#ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */
56431972 1799 u += SEED_C5 * (U32)PTR2UV(&when);
f12c7020 1800#endif
93dc8474 1801 return u;
79072805
LW
1802}
1803
1804PP(pp_exp)
1805{
4e35701f 1806 djSP; dTARGET; tryAMAGICun(exp);
a0d0e21e 1807 {
65202027 1808 NV value;
a0d0e21e 1809 value = POPn;
65202027 1810 value = Perl_exp(value);
a0d0e21e
LW
1811 XPUSHn(value);
1812 RETURN;
1813 }
79072805
LW
1814}
1815
1816PP(pp_log)
1817{
4e35701f 1818 djSP; dTARGET; tryAMAGICun(log);
a0d0e21e 1819 {
65202027 1820 NV value;
a0d0e21e 1821 value = POPn;
bbce6d69 1822 if (value <= 0.0) {
f93f4e46 1823 SET_NUMERIC_STANDARD();
cea2e8a9 1824 DIE(aTHX_ "Can't take log of %g", value);
bbce6d69 1825 }
65202027 1826 value = Perl_log(value);
a0d0e21e
LW
1827 XPUSHn(value);
1828 RETURN;
1829 }
79072805
LW
1830}
1831
1832PP(pp_sqrt)
1833{
4e35701f 1834 djSP; dTARGET; tryAMAGICun(sqrt);
a0d0e21e 1835 {
65202027 1836 NV value;
a0d0e21e 1837 value = POPn;
bbce6d69 1838 if (value < 0.0) {
f93f4e46 1839 SET_NUMERIC_STANDARD();
cea2e8a9 1840 DIE(aTHX_ "Can't take sqrt of %g", value);
bbce6d69 1841 }
65202027 1842 value = Perl_sqrt(value);
a0d0e21e
LW
1843 XPUSHn(value);
1844 RETURN;
1845 }
79072805
LW
1846}
1847
1848PP(pp_int)
1849{
4e35701f 1850 djSP; dTARGET;
774d564b 1851 {
65202027 1852 NV value = TOPn;
774d564b
PP
1853 IV iv;
1854
1855 if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) {
1856 iv = SvIVX(TOPs);
1857 SETi(iv);
1858 }
1859 else {
1860 if (value >= 0.0)
65202027 1861 (void)Perl_modf(value, &value);
774d564b 1862 else {
65202027 1863 (void)Perl_modf(-value, &value);
774d564b
PP
1864 value = -value;
1865 }
1866 iv = I_V(value);
1867 if (iv == value)
1868 SETi(iv);
1869 else
1870 SETn(value);
1871 }
79072805 1872 }
79072805
LW
1873 RETURN;
1874}
1875
463ee0b2
LW
1876PP(pp_abs)
1877{
4e35701f 1878 djSP; dTARGET; tryAMAGICun(abs);
a0d0e21e 1879 {
65202027 1880 NV value = TOPn;
774d564b 1881 IV iv;
463ee0b2 1882
774d564b
PP
1883 if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) &&
1884 (iv = SvIVX(TOPs)) != IV_MIN) {
1885 if (iv < 0)
1886 iv = -iv;
1887 SETi(iv);
1888 }
1889 else {
1890 if (value < 0.0)
1891 value = -value;
1892 SETn(value);
1893 }
a0d0e21e 1894 }
774d564b 1895 RETURN;
463ee0b2
LW
1896}
1897
79072805
LW
1898PP(pp_hex)
1899{
4e35701f 1900 djSP; dTARGET;
79072805
LW
1901 char *tmps;
1902 I32 argtype;
2d8e6c8d 1903 STRLEN n_a;
79072805 1904
2d8e6c8d 1905 tmps = POPpx;
b21ed0a9 1906 argtype = 1; /* allow underscores */
9e24b6e2 1907 XPUSHn(scan_hex(tmps, 99, &argtype));
79072805
LW
1908 RETURN;
1909}
1910
1911PP(pp_oct)
1912{
4e35701f 1913 djSP; dTARGET;
9e24b6e2 1914 NV value;
79072805
LW
1915 I32 argtype;
1916 char *tmps;
2d8e6c8d 1917 STRLEN n_a;
79072805 1918
2d8e6c8d 1919 tmps = POPpx;
464e2e8a
PP
1920 while (*tmps && isSPACE(*tmps))
1921 tmps++;
9e24b6e2
JH
1922 if (*tmps == '0')
1923 tmps++;
b21ed0a9 1924 argtype = 1; /* allow underscores */
9e24b6e2
JH
1925 if (*tmps == 'x')
1926 value = scan_hex(++tmps, 99, &argtype);
1927 else if (*tmps == 'b')
1928 value = scan_bin(++tmps, 99, &argtype);
464e2e8a 1929 else
9e24b6e2
JH
1930 value = scan_oct(tmps, 99, &argtype);
1931 XPUSHn(value);
79072805
LW
1932 RETURN;
1933}
1934
1935/* String stuff. */
1936
1937PP(pp_length)
1938{
4e35701f 1939 djSP; dTARGET;
7e2040f0 1940 SV *sv = TOPs;
a0ed51b3 1941
7e2040f0
GS
1942 if (DO_UTF8(sv))
1943 SETi(sv_len_utf8(sv));
1944 else
1945 SETi(sv_len(sv));
79072805
LW
1946 RETURN;
1947}
1948
1949PP(pp_substr)
1950{
4e35701f 1951 djSP; dTARGET;
79072805
LW
1952 SV *sv;
1953 I32 len;
463ee0b2 1954 STRLEN curlen;
a0ed51b3 1955 STRLEN utfcurlen;
79072805
LW
1956 I32 pos;
1957 I32 rem;
84902520 1958 I32 fail;
533c011a 1959 I32 lvalue = PL_op->op_flags & OPf_MOD;
79072805 1960 char *tmps;
3280af22 1961 I32 arybase = PL_curcop->cop_arybase;
7b8d334a
GS
1962 char *repl = 0;
1963 STRLEN repl_len;
79072805 1964
20408e3c 1965 SvTAINTED_off(TARG); /* decontaminate */
7e2040f0 1966 SvUTF8_off(TARG); /* decontaminate */
5d82c453
GA
1967 if (MAXARG > 2) {
1968 if (MAXARG > 3) {
1969 sv = POPs;
1970 repl = SvPV(sv, repl_len);
7b8d334a 1971 }
79072805 1972 len = POPi;
5d82c453 1973 }
84902520 1974 pos = POPi;
79072805 1975 sv = POPs;
849ca7ee 1976 PUTBACK;
a0d0e21e 1977 tmps = SvPV(sv, curlen);
7e2040f0 1978 if (DO_UTF8(sv)) {
a0ed51b3
LW
1979 utfcurlen = sv_len_utf8(sv);
1980 if (utfcurlen == curlen)
1981 utfcurlen = 0;
1982 else
1983 curlen = utfcurlen;
1984 }
d1c2b58a
LW
1985 else
1986 utfcurlen = 0;
a0ed51b3 1987
84902520
TB
1988 if (pos >= arybase) {
1989 pos -= arybase;
1990 rem = curlen-pos;
1991 fail = rem;
5d82c453
GA
1992 if (MAXARG > 2) {
1993 if (len < 0) {
1994 rem += len;
1995 if (rem < 0)
1996 rem = 0;
1997 }
1998 else if (rem > len)
1999 rem = len;
2000 }
68dc0745 2001 }
84902520 2002 else {
5d82c453
GA
2003 pos += curlen;
2004 if (MAXARG < 3)
2005 rem = curlen;
2006 else if (len >= 0) {
2007 rem = pos+len;
2008 if (rem > (I32)curlen)
2009 rem = curlen;
2010 }
2011 else {
2012 rem = curlen+len;
2013 if (rem < pos)
2014 rem = pos;
2015 }
2016 if (pos < 0)
2017 pos = 0;
2018 fail = rem;
2019 rem -= pos;
84902520
TB
2020 }
2021 if (fail < 0) {
e476b1b5
GS
2022 if (lvalue || repl)
2023 Perl_croak(aTHX_ "substr outside of string");
2024 if (ckWARN(WARN_SUBSTR))
cea2e8a9 2025 Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
2304df62
AD
2026 RETPUSHUNDEF;
2027 }
79072805 2028 else {
7f66633b 2029 if (utfcurlen)
a0ed51b3 2030 sv_pos_u2b(sv, &pos, &rem);
79072805 2031 tmps += pos;
79072805 2032 sv_setpvn(TARG, tmps, rem);
7f66633b
GS
2033 if (utfcurlen)
2034 SvUTF8_on(TARG);
c8faf1c5
GS
2035 if (repl)
2036 sv_insert(sv, pos, rem, repl, repl_len);
2037 else if (lvalue) { /* it's an lvalue! */
dedeecda
PP
2038 if (!SvGMAGICAL(sv)) {
2039 if (SvROK(sv)) {
2d8e6c8d
GS
2040 STRLEN n_a;
2041 SvPV_force(sv,n_a);
599cee73 2042 if (ckWARN(WARN_SUBSTR))
cea2e8a9 2043 Perl_warner(aTHX_ WARN_SUBSTR,
599cee73 2044 "Attempt to use reference as lvalue in substr");
dedeecda
PP
2045 }
2046 if (SvOK(sv)) /* is it defined ? */
7f66633b 2047 (void)SvPOK_only_UTF8(sv);
dedeecda
PP
2048 else
2049 sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
2050 }
5f05dabc 2051
a0d0e21e
LW
2052 if (SvTYPE(TARG) < SVt_PVLV) {
2053 sv_upgrade(TARG, SVt_PVLV);
2054 sv_magic(TARG, Nullsv, 'x', Nullch, 0);
ed6116ce 2055 }
a0d0e21e 2056
5f05dabc 2057 LvTYPE(TARG) = 'x';
6ff81951
GS
2058 if (LvTARG(TARG) != sv) {
2059 if (LvTARG(TARG))
2060 SvREFCNT_dec(LvTARG(TARG));
2061 LvTARG(TARG) = SvREFCNT_inc(sv);
2062 }
a0d0e21e 2063 LvTARGOFF(TARG) = pos;
8ec5e241 2064 LvTARGLEN(TARG) = rem;
79072805
LW
2065 }
2066 }
849ca7ee 2067 SPAGAIN;
79072805
LW
2068 PUSHs(TARG); /* avoid SvSETMAGIC here */
2069 RETURN;
2070}
2071
2072PP(pp_vec)
2073{
4e35701f 2074 djSP; dTARGET;
79072805
LW
2075 register I32 size = POPi;
2076 register I32 offset = POPi;
2077 register SV *src = POPs;
533c011a 2078 I32 lvalue = PL_op->op_flags & OPf_MOD;
a0d0e21e 2079
81e118e0
JH
2080 SvTAINTED_off(TARG); /* decontaminate */
2081 if (lvalue) { /* it's an lvalue! */
2082 if (SvTYPE(TARG) < SVt_PVLV) {
2083 sv_upgrade(TARG, SVt_PVLV);
2084 sv_magic(TARG, Nullsv, 'v', Nullch, 0);
79072805 2085 }
81e118e0
JH
2086 LvTYPE(TARG) = 'v';
2087 if (LvTARG(TARG) != src) {
2088 if (LvTARG(TARG))
2089 SvREFCNT_dec(LvTARG(TARG));
2090 LvTARG(TARG) = SvREFCNT_inc(src);
79072805 2091 }
81e118e0
JH
2092 LvTARGOFF(TARG) = offset;
2093 LvTARGLEN(TARG) = size;
79072805
LW
2094 }
2095
81e118e0 2096 sv_setuv(TARG, do_vecget(src, offset, size));
79072805
LW
2097 PUSHs(TARG);
2098 RETURN;
2099}
2100
2101PP(pp_index)
2102{
4e35701f 2103 djSP; dTARGET;
79072805
LW
2104 SV *big;
2105 SV *little;
2106 I32 offset;
2107 I32 retval;
2108 char *tmps;
2109 char *tmps2;
463ee0b2 2110 STRLEN biglen;
3280af22 2111 I32 arybase = PL_curcop->cop_arybase;
79072805
LW
2112
2113 if (MAXARG < 3)
2114 offset = 0;
2115 else
2116 offset = POPi - arybase;
2117 little = POPs;
2118 big = POPs;
463ee0b2 2119 tmps = SvPV(big, biglen);
7e2040f0 2120 if (offset > 0 && DO_UTF8(big))
a0ed51b3 2121 sv_pos_u2b(big, &offset, 0);
79072805
LW
2122 if (offset < 0)
2123 offset = 0;
93a17b20
LW
2124 else if (offset > biglen)
2125 offset = biglen;
79072805 2126 if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
411d5715 2127 (unsigned char*)tmps + biglen, little, 0)))
a0ed51b3 2128 retval = -1;
79072805 2129 else
a0ed51b3 2130 retval = tmps2 - tmps;
7e2040f0 2131 if (retval > 0 && DO_UTF8(big))
a0ed51b3
LW
2132 sv_pos_b2u(big, &retval);
2133 PUSHi(retval + arybase);
79072805
LW
2134 RETURN;
2135}
2136
2137PP(pp_rindex)
2138{
4e35701f 2139 djSP; dTARGET;
79072805
LW
2140 SV *big;
2141 SV *little;
463ee0b2
LW
2142 STRLEN blen;
2143 STRLEN llen;
79072805
LW
2144 I32 offset;
2145 I32 retval;
2146 char *tmps;
2147 char *tmps2;
3280af22 2148 I32 arybase = PL_curcop->cop_arybase;
79072805 2149
a0d0e21e 2150 if (MAXARG >= 3)
a0ed51b3 2151 offset = POPi;
79072805
LW
2152 little = POPs;
2153 big = POPs;
463ee0b2
LW
2154 tmps2 = SvPV(little, llen);
2155 tmps = SvPV(big, blen);
79072805 2156 if (MAXARG < 3)
463ee0b2 2157 offset = blen;
a0ed51b3 2158 else {
7e2040f0 2159 if (offset > 0 && DO_UTF8(big))
a0ed51b3
LW
2160 sv_pos_u2b(big, &offset, 0);
2161 offset = offset - arybase + llen;
2162 }
79072805
LW
2163 if (offset < 0)
2164 offset = 0;
463ee0b2
LW
2165 else if (offset > blen)
2166 offset = blen;
79072805 2167 if (!(tmps2 = rninstr(tmps, tmps + offset,
463ee0b2 2168 tmps2, tmps2 + llen)))
a0ed51b3 2169 retval = -1;
79072805 2170 else
a0ed51b3 2171 retval = tmps2 - tmps;
7e2040f0 2172 if (retval > 0 && DO_UTF8(big))
a0ed51b3
LW
2173 sv_pos_b2u(big, &retval);
2174 PUSHi(retval + arybase);
79072805
LW
2175 RETURN;
2176}
2177
2178PP(pp_sprintf)
2179{
4e35701f 2180 djSP; dMARK; dORIGMARK; dTARGET;
79072805 2181 do_sprintf(TARG, SP-MARK, MARK+1);
bbce6d69 2182 TAINT_IF(SvTAINTED(TARG));
79072805
LW
2183 SP = ORIGMARK;
2184 PUSHTARG;
2185 RETURN;
2186}
2187
79072805
LW
2188PP(pp_ord)
2189{
4e35701f 2190 djSP; dTARGET;
bdeef251 2191 UV value;
2d8e6c8d 2192 STRLEN n_a;
7e2040f0
GS
2193 SV *tmpsv = POPs;
2194 U8 *tmps = (U8*)SvPVx(tmpsv,n_a);
a0ed51b3 2195 I32 retlen;
79072805 2196
7e2040f0 2197 if ((*tmps & 0x80) && DO_UTF8(tmpsv))
8e84507e 2198 value = utf8_to_uv_chk(tmps, &retlen, 0);
a0ed51b3 2199 else
bdeef251
GA
2200 value = (UV)(*tmps & 255);
2201 XPUSHu(value);
79072805
LW
2202 RETURN;
2203}
2204
463ee0b2
LW
2205PP(pp_chr)
2206{
4e35701f 2207 djSP; dTARGET;
463ee0b2 2208 char *tmps;
3b9be786 2209 U32 value = POPu;
463ee0b2 2210
748a9306 2211 (void)SvUPGRADE(TARG,SVt_PV);
a0ed51b3 2212
aaa68c4a 2213 if ((value > 255 && !IN_BYTE) || (value & 0x80 && PL_hints & HINT_UTF8) ) {
aa6ffa16 2214 SvGROW(TARG, UTF8_MAXLEN+1);
a0ed51b3 2215 tmps = SvPVX(TARG);
dfe13c55 2216 tmps = (char*)uv_to_utf8((U8*)tmps, (UV)value);
a0ed51b3
LW
2217 SvCUR_set(TARG, tmps - SvPVX(TARG));
2218 *tmps = '\0';
2219 (void)SvPOK_only(TARG);
aa6ffa16 2220 SvUTF8_on(TARG);
a0ed51b3
LW
2221 XPUSHs(TARG);
2222 RETURN;
2223 }
2224
748a9306 2225 SvGROW(TARG,2);
463ee0b2
LW
2226 SvCUR_set(TARG, 1);
2227 tmps = SvPVX(TARG);
a0ed51b3 2228 *tmps++ = value;
748a9306 2229 *tmps = '\0';
a0d0e21e 2230 (void)SvPOK_only(TARG);
463ee0b2
LW
2231 XPUSHs(TARG);
2232 RETURN;
2233}
2234
79072805
LW
2235PP(pp_crypt)
2236{
4e35701f 2237 djSP; dTARGET; dPOPTOPssrl;
2d8e6c8d 2238 STRLEN n_a;
79072805 2239#ifdef HAS_CRYPT
2d8e6c8d 2240 char *tmps = SvPV(left, n_a);
79072805 2241#ifdef FCRYPT
2d8e6c8d 2242 sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
79072805 2243#else
2d8e6c8d 2244 sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
79072805
LW
2245#endif
2246#else
cea2e8a9 2247 DIE(aTHX_
79072805
LW
2248 "The crypt() function is unimplemented due to excessive paranoia.");
2249#endif
2250 SETs(TARG);
2251 RETURN;
2252}
2253
2254PP(pp_ucfirst)
2255{
4e35701f 2256 djSP;
79072805 2257 SV *sv = TOPs;
a0ed51b3
LW
2258 register U8 *s;
2259 STRLEN slen;
2260
7e2040f0 2261 if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
a0ed51b3 2262 I32 ulen;
806e7201 2263 U8 tmpbuf[UTF8_MAXLEN];
a0ed51b3 2264 U8 *tend;
8e84507e 2265 UV uv = utf8_to_uv_chk(s, &ulen, 0);
a0ed51b3
LW
2266
2267 if (PL_op->op_private & OPpLOCALE) {
2268 TAINT;
2269 SvTAINTED_on(sv);
2270 uv = toTITLE_LC_uni(uv);
2271 }
2272 else
2273 uv = toTITLE_utf8(s);
2274
2275 tend = uv_to_utf8(tmpbuf, uv);
2276
014822e4 2277 if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
a0ed51b3 2278 dTARGET;
dfe13c55
GS
2279 sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
2280 sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
7e2040f0 2281 SvUTF8_on(TARG);
a0ed51b3
LW
2282 SETs(TARG);
2283 }
2284 else {
dfe13c55 2285 s = (U8*)SvPV_force(sv, slen);
a0ed51b3
LW
2286 Copy(tmpbuf, s, ulen, U8);
2287 }
a0ed51b3 2288 }
626727d5 2289 else {
014822e4 2290 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 2291 dTARGET;
7e2040f0 2292 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
2293 sv_setsv(TARG, sv);
2294 sv = TARG;
2295 SETs(sv);
2296 }
2297 s = (U8*)SvPV_force(sv, slen);
2298 if (*s) {
2299 if (PL_op->op_private & OPpLOCALE) {
2300 TAINT;
2301 SvTAINTED_on(sv);
2302 *s = toUPPER_LC(*s);
2303 }
2304 else
2305 *s = toUPPER(*s);
bbce6d69 2306 }
bbce6d69 2307 }
31351b04
JS
2308 if (SvSMAGICAL(sv))
2309 mg_set(sv);
79072805
LW
2310 RETURN;
2311}
2312
2313PP(pp_lcfirst)
2314{
4e35701f 2315 djSP;
79072805 2316 SV *sv = TOPs;
a0ed51b3
LW
2317 register U8 *s;
2318 STRLEN slen;
2319
7e2040f0 2320 if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) {
a0ed51b3 2321 I32 ulen;
806e7201 2322 U8 tmpbuf[UTF8_MAXLEN];
a0ed51b3 2323 U8 *tend;
8e84507e 2324 UV uv = utf8_to_uv_chk(s, &ulen, 0);
a0ed51b3
LW
2325
2326 if (PL_op->op_private & OPpLOCALE) {
2327 TAINT;
2328 SvTAINTED_on(sv);
2329 uv = toLOWER_LC_uni(uv);
2330 }
2331 else
2332 uv = toLOWER_utf8(s);
2333
2334 tend = uv_to_utf8(tmpbuf, uv);
2335
014822e4 2336 if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
a0ed51b3 2337 dTARGET;
dfe13c55
GS
2338 sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
2339 sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
7e2040f0 2340 SvUTF8_on(TARG);
a0ed51b3
LW
2341 SETs(TARG);
2342 }
2343 else {
dfe13c55 2344 s = (U8*)SvPV_force(sv, slen);
a0ed51b3
LW
2345 Copy(tmpbuf, s, ulen, U8);
2346 }
a0ed51b3 2347 }
626727d5 2348 else {
014822e4 2349 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 2350 dTARGET;
7e2040f0 2351 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
2352 sv_setsv(TARG, sv);
2353 sv = TARG;
2354 SETs(sv);
2355 }
2356 s = (U8*)SvPV_force(sv, slen);
2357 if (*s) {
2358 if (PL_op->op_private & OPpLOCALE) {
2359 TAINT;
2360 SvTAINTED_on(sv);
2361 *s = toLOWER_LC(*s);
2362 }
2363 else
2364 *s = toLOWER(*s);
bbce6d69 2365 }
bbce6d69 2366 }
31351b04
JS
2367 if (SvSMAGICAL(sv))
2368 mg_set(sv);
79072805
LW
2369 RETURN;
2370}
2371
2372PP(pp_uc)
2373{
4e35701f 2374 djSP;
79072805 2375 SV *sv = TOPs;
a0ed51b3 2376 register U8 *s;
463ee0b2 2377 STRLEN len;
79072805 2378
7e2040f0 2379 if (DO_UTF8(sv)) {
a0ed51b3
LW
2380 dTARGET;
2381 I32 ulen;
2382 register U8 *d;
2383 U8 *send;
2384
dfe13c55 2385 s = (U8*)SvPV(sv,len);
a5a20234 2386 if (!len) {
7e2040f0 2387 SvUTF8_off(TARG); /* decontaminate */
a5a20234
LW
2388 sv_setpvn(TARG, "", 0);
2389 SETs(TARG);
a0ed51b3
LW
2390 }
2391 else {
31351b04
JS
2392 (void)SvUPGRADE(TARG, SVt_PV);
2393 SvGROW(TARG, (len * 2) + 1);
2394 (void)SvPOK_only(TARG);
2395 d = (U8*)SvPVX(TARG);
2396 send = s + len;
2397 if (PL_op->op_private & OPpLOCALE) {
2398 TAINT;
2399 SvTAINTED_on(TARG);
2400 while (s < send) {
8e84507e 2401 d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv_chk(s, &ulen, 0)));
31351b04
JS
2402 s += ulen;
2403 }
a0ed51b3 2404 }
31351b04
JS
2405 else {
2406 while (s < send) {
2407 d = uv_to_utf8(d, toUPPER_utf8( s ));
2408 s += UTF8SKIP(s);
2409 }
a0ed51b3 2410 }
31351b04 2411 *d = '\0';
7e2040f0 2412 SvUTF8_on(TARG);
31351b04
JS
2413 SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
2414 SETs(TARG);
a0ed51b3 2415 }
a0ed51b3 2416 }
626727d5 2417 else {
014822e4 2418 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 2419 dTARGET;
7e2040f0 2420 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
2421 sv_setsv(TARG, sv);
2422 sv = TARG;
2423 SETs(sv);
2424 }
2425 s = (U8*)SvPV_force(sv, len);
2426 if (len) {
2427 register U8 *send = s + len;
2428
2429 if (PL_op->op_private & OPpLOCALE) {
2430 TAINT;
2431 SvTAINTED_on(sv);
2432 for (; s < send; s++)
2433 *s = toUPPER_LC(*s);
2434 }
2435 else {
2436 for (; s < send; s++)
2437 *s = toUPPER(*s);
2438 }
bbce6d69 2439 }
79072805 2440 }
31351b04
JS
2441 if (SvSMAGICAL(sv))
2442 mg_set(sv);
79072805
LW
2443 RETURN;
2444}
2445
2446PP(pp_lc)
2447{
4e35701f 2448 djSP;
79072805 2449 SV *sv = TOPs;
a0ed51b3 2450 register U8 *s;
463ee0b2 2451 STRLEN len;
79072805 2452
7e2040f0 2453 if (DO_UTF8(sv)) {
a0ed51b3
LW
2454 dTARGET;
2455 I32 ulen;
2456 register U8 *d;
2457 U8 *send;
2458
dfe13c55 2459 s = (U8*)SvPV(sv,len);
a5a20234 2460 if (!len) {
7e2040f0 2461 SvUTF8_off(TARG); /* decontaminate */
a5a20234
LW
2462 sv_setpvn(TARG, "", 0);
2463 SETs(TARG);
a0ed51b3
LW
2464 }
2465 else {
31351b04
JS
2466 (void)SvUPGRADE(TARG, SVt_PV);
2467 SvGROW(TARG, (len * 2) + 1);
2468 (void)SvPOK_only(TARG);
2469 d = (U8*)SvPVX(TARG);
2470 send = s + len;
2471 if (PL_op->op_private & OPpLOCALE) {
2472 TAINT;
2473 SvTAINTED_on(TARG);
2474 while (s < send) {
8e84507e 2475 d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv_chk(s, &ulen, 0)));
31351b04
JS
2476 s += ulen;
2477 }
a0ed51b3 2478 }
31351b04
JS
2479 else {
2480 while (s < send) {
2481 d = uv_to_utf8(d, toLOWER_utf8(s));
2482 s += UTF8SKIP(s);
2483 }
a0ed51b3 2484 }
31351b04 2485 *d = '\0';
7e2040f0 2486 SvUTF8_on(TARG);
31351b04
JS
2487 SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
2488 SETs(TARG);
a0ed51b3 2489 }
79072805 2490 }
626727d5 2491 else {
014822e4 2492 if (!SvPADTMP(sv) || SvREADONLY(sv)) {
31351b04 2493 dTARGET;
7e2040f0 2494 SvUTF8_off(TARG); /* decontaminate */
31351b04
JS
2495 sv_setsv(TARG, sv);
2496 sv = TARG;
2497 SETs(sv);
a0ed51b3 2498 }
bbce6d69 2499
31351b04
JS
2500 s = (U8*)SvPV_force(sv, len);
2501 if (len) {
2502 register U8 *send = s + len;
bbce6d69 2503
31351b04
JS
2504 if (PL_op->op_private & OPpLOCALE) {
2505 TAINT;
2506 SvTAINTED_on(sv);
2507 for (; s < send; s++)
2508 *s = toLOWER_LC(*s);
2509 }
2510 else {
2511 for (; s < send; s++)
2512 *s = toLOWER(*s);
2513 }
bbce6d69 2514 }
79072805 2515 }
31351b04
JS
2516 if (SvSMAGICAL(sv))
2517 mg_set(sv);
79072805
LW
2518 RETURN;
2519}
2520
a0d0e21e 2521PP(pp_quotemeta)
79072805 2522{
4e35701f 2523 djSP; dTARGET;
a0d0e21e
LW
2524 SV *sv = TOPs;
2525 STRLEN len;
2526 register char *s = SvPV(sv,len);
2527 register char *d;
79072805 2528
7e2040f0 2529 SvUTF8_off(TARG); /* decontaminate */
a0d0e21e
LW
2530 if (len) {
2531 (void)SvUPGRADE(TARG, SVt_PV);
c07a80fd 2532 SvGROW(TARG, (len * 2) + 1);
a0d0e21e 2533 d = SvPVX(TARG);
7e2040f0 2534 if (DO_UTF8(sv)) {
0dd2cdef
LW
2535 while (len) {
2536 if (*s & 0x80) {
2537 STRLEN ulen = UTF8SKIP(s);
2538 if (ulen > len)
2539 ulen = len;
2540 len -= ulen;
2541 while (ulen--)
2542 *d++ = *s++;
2543 }
2544 else {
2545 if (!isALNUM(*s))
2546 *d++ = '\\';
2547 *d++ = *s++;
2548 len--;
2549 }
2550 }
7e2040f0 2551 SvUTF8_on(TARG);
0dd2cdef
LW
2552 }
2553 else {
2554 while (len--) {
2555 if (!isALNUM(*s))
2556 *d++ = '\\';
2557 *d++ = *s++;
2558 }
79072805 2559 }
a0d0e21e
LW
2560 *d = '\0';
2561 SvCUR_set(TARG, d - SvPVX(TARG));
3aa33fe5 2562 (void)SvPOK_only_UTF8(TARG);
79072805 2563 }
a0d0e21e
LW
2564 else
2565 sv_setpvn(TARG, s, len);
2566 SETs(TARG);
31351b04
JS
2567 if (SvSMAGICAL(TARG))
2568 mg_set(TARG);
79072805
LW
2569 RETURN;
2570}
2571
a0d0e21e 2572/* Arrays. */
79072805 2573
a0d0e21e 2574PP(pp_aslice)
79072805 2575{
4e35701f 2576 djSP; dMARK; dORIGMARK;
a0d0e21e
LW
2577 register SV** svp;
2578 register AV* av = (AV*)POPs;
533c011a 2579 register I32 lval = PL_op->op_flags & OPf_MOD;
3280af22 2580 I32 arybase = PL_curcop->cop_arybase;
748a9306 2581 I32 elem;
79072805 2582
a0d0e21e 2583 if (SvTYPE(av) == SVt_PVAV) {
533c011a 2584 if (lval && PL_op->op_private & OPpLVAL_INTRO) {
748a9306 2585 I32 max = -1;
924508f0 2586 for (svp = MARK + 1; svp <= SP; svp++) {
748a9306
LW
2587 elem = SvIVx(*svp);
2588 if (elem > max)
2589 max = elem;
2590 }
2591 if (max > AvMAX(av))
2592 av_extend(av, max);
2593 }
a0d0e21e 2594 while (++MARK <= SP) {
748a9306 2595 elem = SvIVx(*MARK);
a0d0e21e 2596
748a9306
LW
2597 if (elem > 0)
2598 elem -= arybase;
a0d0e21e
LW
2599 svp = av_fetch(av, elem, lval);
2600 if (lval) {
3280af22 2601 if (!svp || *svp == &PL_sv_undef)
cea2e8a9 2602 DIE(aTHX_ PL_no_aelem, elem);
533c011a 2603 if (PL_op->op_private & OPpLVAL_INTRO)
161b7d16 2604 save_aelem(av, elem, svp);
79072805 2605 }
3280af22 2606 *MARK = svp ? *svp : &PL_sv_undef;
79072805
LW
2607 }
2608 }
748a9306 2609 if (GIMME != G_ARRAY) {
a0d0e21e
LW
2610 MARK = ORIGMARK;
2611 *++MARK = *SP;
2612 SP = MARK;
2613 }
79072805
LW
2614 RETURN;
2615}
2616
2617/* Associative arrays. */
2618
2619PP(pp_each)
2620{
59af0135 2621 djSP;
79072805 2622 HV *hash = (HV*)POPs;
c07a80fd 2623 HE *entry;
54310121 2624 I32 gimme = GIMME_V;
c750a3ec 2625 I32 realhv = (SvTYPE(hash) == SVt_PVHV);
8ec5e241 2626
c07a80fd 2627 PUTBACK;
c750a3ec
MB
2628 /* might clobber stack_sp */
2629 entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
c07a80fd 2630 SPAGAIN;
79072805 2631
79072805
LW
2632 EXTEND(SP, 2);
2633 if (entry) {
54310121
PP
2634 PUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
2635 if (gimme == G_ARRAY) {
59af0135 2636 SV *val;
c07a80fd 2637 PUTBACK;
c750a3ec 2638 /* might clobber stack_sp */
59af0135
GS
2639 val = realhv ?
2640 hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
c07a80fd 2641 SPAGAIN;
59af0135 2642 PUSHs(val);
79072805 2643 }
79072805 2644 }
54310121 2645 else if (gimme == G_SCALAR)
79072805
LW
2646 RETPUSHUNDEF;
2647
2648 RETURN;
2649}
2650
2651PP(pp_values)
2652{
cea2e8a9 2653 return do_kv();
79072805
LW
2654}
2655
2656PP(pp_keys)
2657{
cea2e8a9 2658 return do_kv();
79072805
LW
2659}
2660
2661PP(pp_delete)
2662{
4e35701f 2663 djSP;
54310121
PP
2664 I32 gimme = GIMME_V;
2665 I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
79072805 2666 SV *sv;
5f05dabc
PP
2667 HV *hv;
2668
533c011a 2669 if (PL_op->op_private & OPpSLICE) {
5f05dabc 2670 dMARK; dORIGMARK;
97fcbf96 2671 U32 hvtype;
5f05dabc 2672 hv = (HV*)POPs;
97fcbf96 2673 hvtype = SvTYPE(hv);
01020589
GS
2674 if (hvtype == SVt_PVHV) { /* hash element */
2675 while (++MARK <= SP) {
ae77835f 2676 sv = hv_delete_ent(hv, *MARK, discard, 0);
01020589
GS
2677 *MARK = sv ? sv : &PL_sv_undef;
2678 }
5f05dabc 2679 }
01020589
GS
2680 else if (hvtype == SVt_PVAV) {
2681 if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
2682 while (++MARK <= SP) {
2683 sv = av_delete((AV*)hv, SvIV(*MARK), discard);
2684 *MARK = sv ? sv : &PL_sv_undef;
2685 }
2686 }
2687 else { /* pseudo-hash element */
2688 while (++MARK <= SP) {
2689 sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
2690 *MARK = sv ? sv : &PL_sv_undef;
2691 }
2692 }
2693 }
2694 else
2695 DIE(aTHX_ "Not a HASH reference");
54310121
PP
2696 if (discard)
2697 SP = ORIGMARK;
2698 else if (gimme == G_SCALAR) {
5f05dabc
PP
2699 MARK = ORIGMARK;
2700 *++MARK = *SP;
2701 SP = MARK;
2702 }
2703 }
2704 else {
2705 SV *keysv = POPs;
2706 hv = (HV*)POPs;
97fcbf96
MB
2707 if (SvTYPE(hv) == SVt_PVHV)
2708 sv = hv_delete_ent(hv, keysv, discard, 0);
01020589
GS
2709 else if (SvTYPE(hv) == SVt_PVAV) {
2710 if (PL_op->op_flags & OPf_SPECIAL)
2711 sv = av_delete((AV*)hv, SvIV(keysv), discard);
2712 else
2713 sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
2714 }
97fcbf96 2715 else
cea2e8a9 2716 DIE(aTHX_ "Not a HASH reference");
5f05dabc 2717 if (!sv)
3280af22 2718 sv = &PL_sv_undef;
54310121
PP
2719 if (!discard)
2720 PUSHs(sv);
79072805 2721 }
79072805
LW
2722 RETURN;
2723}
2724
a0d0e21e 2725PP(pp_exists)
79072805 2726{
4e35701f 2727 djSP;
afebc493
GS
2728 SV *tmpsv;
2729 HV *hv;
2730
2731 if (PL_op->op_private & OPpEXISTS_SUB) {
2732 GV *gv;
2733 CV *cv;
2734 SV *sv = POPs;
2735 cv = sv_2cv(sv, &hv, &gv, FALSE);
2736 if (cv)
2737 RETPUSHYES;
2738 if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
2739 RETPUSHYES;
2740 RETPUSHNO;
2741 }
2742 tmpsv = POPs;
2743 hv = (HV*)POPs;
c750a3ec 2744 if (SvTYPE(hv) == SVt_PVHV) {
ae77835f 2745 if (hv_exists_ent(hv, tmpsv, 0))
c750a3ec 2746 RETPUSHYES;
ef54e1a4
JH
2747 }
2748 else if (SvTYPE(hv) == SVt_PVAV) {
01020589
GS
2749 if (PL_op->op_flags & OPf_SPECIAL) { /* array element */
2750 if (av_exists((AV*)hv, SvIV(tmpsv)))
2751 RETPUSHYES;
2752 }
2753 else if (avhv_exists_ent((AV*)hv, tmpsv, 0)) /* pseudo-hash element */
c750a3ec 2754 RETPUSHYES;
ef54e1a4
JH
2755 }
2756 else {
cea2e8a9 2757 DIE(aTHX_ "Not a HASH reference");
a0d0e21e 2758 }
a0d0e21e
LW
2759 RETPUSHNO;
2760}
79072805 2761
a0d0e21e
LW
2762PP(pp_hslice)
2763{
4e35701f 2764 djSP; dMARK; dORIGMARK;
a0d0e21e 2765 register HV *hv = (HV*)POPs;
533c011a 2766 register I32 lval = PL_op->op_flags & OPf_MOD;
c750a3ec 2767 I32 realhv = (SvTYPE(hv) == SVt_PVHV);
79072805 2768
0ebe0038 2769 if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
cea2e8a9 2770 DIE(aTHX_ "Can't localize pseudo-hash element");
0ebe0038 2771
c750a3ec 2772 if (realhv || SvTYPE(hv) == SVt_PVAV) {
a0d0e21e 2773 while (++MARK <= SP) {
f12c7020 2774 SV *keysv = *MARK;
ae77835f
MB
2775 SV **svp;
2776 if (realhv) {
800e9ae0 2777 HE *he = hv_fetch_ent(hv, keysv, lval, 0);
ae77835f 2778 svp = he ? &HeVAL(he) : 0;
ef54e1a4
JH
2779 }
2780 else {
97fcbf96 2781 svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
ae77835f 2782 }
a0d0e21e 2783 if (lval) {
2d8e6c8d
GS
2784 if (!svp || *svp == &PL_sv_undef) {
2785 STRLEN n_a;
cea2e8a9 2786 DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
2d8e6c8d 2787 }
533c011a 2788 if (PL_op->op_private & OPpLVAL_INTRO)
800e9ae0 2789 save_helem(hv, keysv, svp);
93a17b20 2790 }
3280af22 2791 *MARK = svp ? *svp : &PL_sv_undef;
79072805
LW
2792 }
2793 }
a0d0e21e
LW
2794 if (GIMME != G_ARRAY) {
2795 MARK = ORIGMARK;
2796 *++MARK = *SP;
2797 SP = MARK;
79072805 2798 }
a0d0e21e
LW
2799 RETURN;
2800}
2801
2802/* List operators. */
2803
2804PP(pp_list)
2805{
4e35701f 2806 djSP; dMARK;
a0d0e21e
LW
2807 if (GIMME != G_ARRAY) {
2808 if (++MARK <= SP)
2809 *MARK = *SP; /* unwanted list, return last item */
8990e307 2810 else
3280af22 2811 *MARK = &PL_sv_undef;
a0d0e21e 2812 SP = MARK;
79072805 2813 }
a0d0e21e 2814 RETURN;
79072805
LW
2815}
2816
a0d0e21e 2817PP(pp_lslice)
79072805 2818{
4e35701f 2819 djSP;
3280af22
NIS
2820 SV **lastrelem = PL_stack_sp;
2821 SV **lastlelem = PL_stack_base + POPMARK;
2822 SV **firstlelem = PL_stack_base + POPMARK + 1;
a0d0e21e 2823 register SV **firstrelem = lastlelem + 1;
3280af22 2824 I32 arybase = PL_curcop->cop_arybase;
533c011a 2825 I32 lval = PL_op->op_flags & OPf_MOD;
4633a7c4 2826 I32 is_something_there = lval;
79072805 2827
a0d0e21e
LW
2828 register I32 max = lastrelem - lastlelem;
2829 register SV **lelem;
2830 register I32 ix;
2831
2832 if (GIMME != G_ARRAY) {
748a9306
LW
2833 ix = SvIVx(*lastlelem);
2834 if (ix < 0)
2835 ix += max;
2836 else
2837 ix -= arybase;
a0d0e21e 2838 if (ix < 0 || ix >= max)
3280af22 2839 *firstlelem = &PL_sv_undef;
a0d0e21e
LW
2840 else
2841 *firstlelem = firstrelem[ix];
2842 SP = firstlelem;
2843 RETURN;
2844 }
2845
2846 if (max == 0) {
2847 SP = firstlelem - 1;
2848 RETURN;
2849 }
2850
2851 for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
748a9306 2852 ix = SvIVx(*lelem);
c73bf8e3 2853 if (ix < 0)
a0d0e21e 2854 ix += max;
c73bf8e3 2855 else
748a9306 2856 ix -= arybase;
c73bf8e3
HS
2857 if (ix < 0 || ix >= max)
2858 *lelem = &PL_sv_undef;
2859 else {
2860 is_something_there = TRUE;
2861 if (!(*lelem = firstrelem[ix]))
3280af22 2862 *lelem = &PL_sv_undef;
748a9306 2863 }
79072805 2864 }
4633a7c4
LW
2865 if (is_something_there)
2866 SP = lastlelem;
2867 else
2868 SP = firstlelem - 1;
79072805
LW
2869 RETURN;
2870}
2871
a0d0e21e
LW
2872PP(pp_anonlist)
2873{
4e35701f 2874 djSP; dMARK; dORIGMARK;
a0d0e21e 2875 I32 items = SP - MARK;
44a8e56a
PP
2876 SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
2877 SP = ORIGMARK; /* av_make() might realloc stack_sp */
2878 XPUSHs(av);
a0d0e21e
LW
2879 RETURN;
2880}
2881
2882PP(pp_anonhash)
79072805 2883{
4e35701f 2884 djSP; dMARK; dORIGMARK;
a0d0e21e
LW
2885 HV* hv = (HV*)sv_2mortal((SV*)newHV());
2886
2887 while (MARK < SP) {
2888 SV* key = *++MARK;
a0d0e21e
LW
2889 SV *val = NEWSV(46, 0);
2890 if (MARK < SP)
2891 sv_setsv(val, *++MARK);
e476b1b5
GS
2892 else if (ckWARN(WARN_MISC))
2893 Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
f12c7020 2894 (void)hv_store_ent(hv,key,val,0);
79072805 2895 }
a0d0e21e
LW
2896 SP = ORIGMARK;
2897 XPUSHs((SV*)hv);
79072805
LW
2898 RETURN;
2899}
2900
a0d0e21e 2901PP(pp_splice)
79072805 2902{
4e35701f 2903 djSP; dMARK; dORIGMARK;
a0d0e21e
LW
2904 register AV *ary = (AV*)*++MARK;
2905 register SV **src;
2906 register SV **dst;
2907 register I32 i;
2908 register I32 offset;
2909 register I32 length;
2910 I32 newlen;
2911 I32 after;
2912 I32 diff;
2913 SV **tmparyval = 0;
93965878
NIS
2914 MAGIC *mg;
2915
155aba94 2916 if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
33c27489 2917 *MARK-- = SvTIED_obj((SV*)ary, mg);
93965878 2918 PUSHMARK(MARK);
8ec5e241 2919 PUTBACK;
a60c0954 2920 ENTER;
864dbfa3 2921 call_method("SPLICE",GIMME_V);
a60c0954 2922 LEAVE;
93965878
NIS
2923 SPAGAIN;
2924 RETURN;
2925 }
79072805 2926
a0d0e21e 2927 SP++;
79072805 2928
a0d0e21e 2929 if (++MARK < SP) {
84902520 2930 offset = i = SvIVx(*MARK);
a0d0e21e 2931 if (offset < 0)
93965878 2932 offset += AvFILLp(ary) + 1;
a0d0e21e 2933 else
3280af22 2934 offset -= PL_curcop->cop_arybase;
84902520 2935 if (offset < 0)
cea2e8a9 2936 DIE(aTHX_ PL_no_aelem, i);
a0d0e21e
LW
2937 if (++MARK < SP) {
2938 length = SvIVx(*MARK++);
48cdf507
GA
2939 if (length < 0) {
2940 length += AvFILLp(ary) - offset + 1;
2941 if (length < 0)
2942 length = 0;
2943 }
79072805
LW
2944 }
2945 else
a0d0e21e 2946 length = AvMAX(ary) + 1; /* close enough to infinity */
79072805 2947 }
a0d0e21e
LW
2948 else {
2949 offset = 0;
2950 length = AvMAX(ary) + 1;
2951 }
93965878
NIS
2952 if (offset > AvFILLp(ary) + 1)
2953 offset = AvFILLp(ary) + 1;
2954 after = AvFILLp(ary) + 1 - (offset + length);
a0d0e21e
LW
2955 if (after < 0) { /* not that much array */
2956 length += after; /* offset+length now in array */
2957 after = 0;
2958 if (!AvALLOC(ary))
2959 av_extend(ary, 0);
2960 }
2961
2962 /* At this point, MARK .. SP-1 is our new LIST */
2963
2964 newlen = SP - MARK;
2965 diff = newlen - length;
13d7cbc1
GS
2966 if (newlen && !AvREAL(ary) && AvREIFY(ary))
2967 av_reify(ary);
a0d0e21e
LW
2968
2969 if (diff < 0) { /* shrinking the area */
2970 if (newlen) {
2971 New(451, tmparyval, newlen, SV*); /* so remember insertion */
2972 Copy(MARK, tmparyval, newlen, SV*);
79072805 2973 }
a0d0e21e
LW
2974
2975 MARK = ORIGMARK + 1;
2976 if (GIMME == G_ARRAY) { /* copy return vals to stack */
2977 MEXTEND(MARK, length);
2978 Copy(AvARRAY(ary)+offset, MARK, length, SV*);
2979 if (AvREAL(ary)) {
bbce6d69 2980 EXTEND_MORTAL(length);
36477c24 2981 for (i = length, dst = MARK; i; i--) {
d689ffdd 2982 sv_2mortal(*dst); /* free them eventualy */
36477c24
PP
2983 dst++;
2984 }
a0d0e21e
LW
2985 }
2986 MARK += length - 1;
79072805 2987 }
a0d0e21e
LW
2988 else {
2989 *MARK = AvARRAY(ary)[offset+length-1];
2990 if (AvREAL(ary)) {
d689ffdd 2991 sv_2mortal(*MARK);
a0d0e21e
LW
2992 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
2993 SvREFCNT_dec(*dst++); /* free them now */
79072805 2994 }
a0d0e21e 2995 }
93965878 2996 AvFILLp(ary) += diff;
a0d0e21e
LW
2997
2998 /* pull up or down? */
2999
3000 if (offset < after) { /* easier to pull up */
3001 if (offset) { /* esp. if nothing to pull */
3002 src = &AvARRAY(ary)[offset-1];
3003 dst = src - diff; /* diff is negative */
3004 for (i = offset; i > 0; i--) /* can't trust Copy */
3005 *dst-- = *src--;
79072805 3006 }
a0d0e21e
LW
3007 dst = AvARRAY(ary);
3008 SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
3009 AvMAX(ary) += diff;
3010 }
3011 else {
3012 if (after) { /* anything to pull down? */
3013 src = AvARRAY(ary) + offset + length;
3014 dst = src + diff; /* diff is negative */
3015 Move(src, dst, after, SV*);
79072805 3016 }
93965878 3017 dst = &AvARRAY(ary)[AvFILLp(ary)+1];
a0d0e21e
LW
3018 /* avoid later double free */
3019 }
3020 i = -diff;
3021 while (i)
3280af22 3022 dst[--i] = &PL_sv_undef;
a0d0e21e
LW
3023
3024 if (newlen) {
3025 for (src = tmparyval, dst = AvARRAY(ary) + offset;
3026 newlen; newlen--) {
3027 *dst = NEWSV(46, 0);
3028 sv_setsv(*dst++, *src++);
79072805 3029 }
a0d0e21e
LW
3030 Safefree(tmparyval);
3031 }
3032 }
3033 else { /* no, expanding (or same) */
3034 if (length) {
3035 New(452, tmparyval, length, SV*); /* so remember deletion */
3036 Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
3037 }
3038
3039 if (diff > 0) { /* expanding */
3040
3041 /* push up or down? */
3042
3043 if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
3044 if (offset) {
3045 src = AvARRAY(ary);
3046 dst = src - diff;
3047 Move(src, dst, offset, SV*);
79072805 3048 }
a0d0e21e
LW
3049 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
3050 AvMAX(ary) += diff;
93965878 3051 AvFILLp(ary) += diff;
79072805
LW
3052 }
3053 else {
93965878
NIS
3054 if (AvFILLp(ary) + diff >= AvMAX(ary)) /* oh, well */
3055 av_extend(ary, AvFILLp(ary) + diff);
3056 AvFILLp(ary) += diff;
a0d0e21e
LW
3057
3058 if (after) {
93965878 3059 dst = AvARRAY(ary) + AvFILLp(ary);
a0d0e21e
LW
3060 src = dst - diff;
3061 for (i = after; i; i--) {
3062 *dst-- = *src--;
3063 }
79072805
LW
3064 }
3065 }
a0d0e21e
LW
3066 }
3067
3068 for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
3069 *dst = NEWSV(46, 0);
3070 sv_setsv(*dst++, *src++);
3071 }
3072 MARK = ORIGMARK + 1;
3073 if (GIMME == G_ARRAY) { /* copy return vals to stack */
3074 if (length) {
3075 Copy(tmparyval, MARK, length, SV*);
3076 if (AvREAL(ary)) {
bbce6d69 3077 EXTEND_MORTAL(length);
36477c24 3078 for (i = length, dst = MARK; i; i--) {
d689ffdd 3079 sv_2mortal(*dst); /* free them eventualy */
36477c24
PP
3080 dst++;
3081 }
79072805 3082 }
a0d0e21e 3083 Safefree(tmparyval);
79072805 3084 }
a0d0e21e
LW
3085 MARK += length - 1;
3086 }
3087 else if (length--) {
3088 *MARK = tmparyval[length];
3089 if (AvREAL(ary)) {
d689ffdd 3090 sv_2mortal(*MARK);
a0d0e21e
LW
3091 while (length-- > 0)
3092 SvREFCNT_dec(tmparyval[length]);
79072805 3093 }
a0d0e21e 3094 Safefree(tmparyval);
79072805 3095 }
a0d0e21e 3096 else
3280af22 3097 *MARK = &PL_sv_undef;
79072805 3098 }
a0d0e21e 3099 SP = MARK;
79072805
LW
3100 RETURN;
3101}
3102
a0d0e21e 3103PP(pp_push)
79072805 3104{
4e35701f 3105 djSP; dMARK; dORIGMARK; dTARGET;
a0d0e21e 3106 register AV *ary = (AV*)*++MARK;
3280af22 3107 register SV *sv = &PL_sv_undef;
93965878 3108 MAGIC *mg;
79072805 3109
155aba94 3110 if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
33c27489 3111 *MARK-- = SvTIED_obj((SV*)ary, mg);
93965878
NIS
3112 PUSHMARK(MARK);
3113 PUTBACK;
a60c0954 3114 ENTER;
864dbfa3 3115 call_method("PUSH",G_SCALAR|G_DISCARD);
a60c0954 3116 LEAVE;
93965878 3117 SPAGAIN;
93965878 3118 }
a60c0954
NIS
3119 else {
3120 /* Why no pre-extend of ary here ? */
3121 for (++MARK; MARK <= SP; MARK++) {
3122 sv = NEWSV(51, 0);
3123 if (*MARK)
3124 sv_setsv(sv, *MARK);
3125 av_push(ary, sv);
3126 }
79072805
LW
3127 }
3128 SP = ORIGMARK;
a0d0e21e 3129 PUSHi( AvFILL(ary) + 1 );
79072805
LW
3130 RETURN;
3131}
3132
a0d0e21e 3133PP(pp_pop)
79072805 3134{
4e35701f 3135 djSP;
a0d0e21e
LW
3136 AV *av = (AV*)POPs;
3137 SV *sv = av_pop(av);
d689ffdd 3138 if (AvREAL(av))
a0d0e21e
LW
3139 (void)sv_2mortal(sv);
3140 PUSHs(sv);
79072805 3141 RETURN;
79072805
LW
3142}
3143
a0d0e21e 3144PP(pp_shift)
79072805 3145{
4e35701f 3146 djSP;
a0d0e21e
LW
3147 AV *av = (AV*)POPs;
3148 SV *sv = av_shift(av);
79072805 3149 EXTEND(SP, 1);
a0d0e21e 3150 if (!sv)
79072805 3151 RETPUSHUNDEF;
d689ffdd 3152 if (AvREAL(av))
a0d0e21e
LW
3153 (void)sv_2mortal(sv);
3154 PUSHs(sv);
79072805 3155 RETURN;
79072805
LW
3156}
3157
a0d0e21e 3158PP(pp_unshift)
79072805 3159{
4e35701f 3160 djSP; dMARK; dORIGMARK; dTARGET;
a0d0e21e
LW
3161 register AV *ary = (AV*)*++MARK;
3162 register SV *sv;
3163 register I32 i = 0;
93965878
NIS
3164 MAGIC *mg;
3165
155aba94 3166 if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
33c27489 3167 *MARK-- = SvTIED_obj((SV*)ary, mg);
7fd66d9d 3168 PUSHMARK(MARK);
93965878 3169 PUTBACK;
a60c0954 3170 ENTER;
864dbfa3 3171 call_method("UNSHIFT",G_SCALAR|G_DISCARD);
a60c0954 3172 LEAVE;
93965878 3173 SPAGAIN;
93965878 3174 }
a60c0954
NIS
3175 else {
3176 av_unshift(ary, SP - MARK);
3177 while (MARK < SP) {
3178 sv = NEWSV(27, 0);
3179 sv_setsv(sv, *++MARK);
3180 (void)av_store(ary, i++, sv);
3181 }
79072805 3182 }
a0d0e21e
LW
3183 SP = ORIGMARK;
3184 PUSHi( AvFILL(ary) + 1 );
79072805 3185 RETURN;
79072805
LW
3186}
3187
a0d0e21e 3188PP(pp_reverse)
79072805 3189{
4e35701f 3190 djSP; dMARK;
a0d0e21e
LW
3191 register SV *tmp;
3192 SV **oldsp = SP;
79072805 3193
a0d0e21e
LW
3194 if (GIMME == G_ARRAY) {
3195 MARK++;
3196 while (MARK < SP) {
3197 tmp = *MARK;
3198 *MARK++ = *SP;
3199 *SP-- = tmp;
3200 }
dd58a1ab 3201 /* safe as long as stack cannot get extended in the above */
a0d0e21e 3202 SP = oldsp;
79072805
LW
3203 }
3204 else {
a0d0e21e
LW
3205 register char *up;
3206 register char *down;
3207 register I32 tmp;
3208 dTARGET;
3209 STRLEN len;
79072805 3210
7e2040f0 3211 SvUTF8_off(TARG); /* decontaminate */
a0d0e21e 3212 if (SP - MARK > 1)
3280af22 3213 do_join(TARG, &PL_sv_no, MARK, SP);
a0d0e21e 3214 else
54b9620d 3215 sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
a0d0e21e
LW
3216 up = SvPV_force(TARG, len);
3217 if (len > 1) {
7e2040f0 3218 if (DO_UTF8(TARG)) { /* first reverse each character */
dfe13c55
GS
3219 U8* s = (U8*)SvPVX(TARG);
3220 U8* send = (U8*)(s + len);
a0ed51b3
LW
3221 while (s < send) {
3222 if (*s < 0x80) {
3223 s++;
3224 continue;
3225 }
3226 else {
dfe13c55 3227 up = (char*)s;
a0ed51b3 3228 s += UTF8SKIP(s);
dfe13c55 3229 down = (char*)(s - 1);
f248d071
GS
3230 if (s > send || !((*down & 0xc0) == 0x80)) {
3231 if (ckWARN_d(WARN_UTF8))
3232 Perl_warner(aTHX_ WARN_UTF8,
3233 "Malformed UTF-8 character");
a0ed51b3
LW
3234 break;
3235 }
3236 while (down > up) {
3237 tmp = *up;
3238 *up++ = *down;
3239 *down-- = tmp;
3240 }
3241 }
3242 }
3243 up = SvPVX(TARG);
3244 }
a0d0e21e
LW
3245 down = SvPVX(TARG) + len - 1;
3246 while (down > up) {
3247 tmp = *up;
3248 *up++ = *down;
3249 *down-- = tmp;
3250 }
3aa33fe5 3251 (void)SvPOK_only_UTF8(TARG);
79072805 3252 }
a0d0e21e
LW
3253 SP = MARK + 1;
3254 SETTARG;
79072805 3255 }
a0d0e21e 3256 RETURN;
79072805
LW
3257}
3258
864dbfa3 3259STATIC SV *
cea2e8a9 3260S_mul128(pTHX_ SV *sv, U8 m)
55497cff
PP
3261{
3262 STRLEN len;
3263 char *s = SvPV(sv, len);
3264 char *t;
3265 U32 i = 0;
3266
3267 if (!strnEQ(s, "0000", 4)) { /* need to grow sv */
79cb57f6 3268 SV *tmpNew = newSVpvn("0000000000", 10);
55497cff 3269
09b7f37c 3270 sv_catsv(tmpNew, sv);
55497cff 3271 SvREFCNT_dec(sv); /* free old sv */
09b7f37c 3272 sv = tmpNew;
55497cff
PP
3273 s = SvPV(sv, len);
3274 }
3275 t = s + len - 1;
3276 while (!*t) /* trailing '\0'? */
3277 t--;
3278 while (t > s) {
3279 i = ((*t - '0') << 7) + m;
3280 *(t--) = '0' + (i % 10);
3281 m = i / 10;
3282 }
3283 return (sv);
3284}
3285
a0d0e21e
LW
3286/* Explosives and implosives. */
3287
9d116dd7
JH
3288#if 'I' == 73 && 'J' == 74
3289/* On an ASCII/ISO kind of system */
ba1ac976 3290#define ISUUCHAR(ch) ((ch) >= ' ' && (ch) < 'a')
9d116dd7
JH
3291#else
3292/*
3293 Some other sort of character set - use memchr() so we don't match
3294 the null byte.
3295 */
80252599 3296#define ISUUCHAR(ch) (memchr(PL_uuemap, (ch), sizeof(PL_uuemap)-1) || (ch) == ' ')
9d116dd7
JH
3297#endif
3298
a0d0e21e 3299PP(pp_unpack)
79072805 3300{
4e35701f 3301 djSP;
a0d0e21e 3302 dPOPPOPssrl;
dd58a1ab 3303 I32 start_sp_offset = SP - PL_stack_base;
54310121 3304 I32 gimme = GIMME_V;
ed6116ce 3305 SV *sv;
a0d0e21e
LW
3306 STRLEN llen;
3307 STRLEN rlen;
3308 register char *pat = SvPV(left, llen);
3309 register char *s = SvPV(right, rlen);
3310 char *strend = s + rlen;
3311 char *strbeg = s;
3312 register char *patend = pat + llen;
3313 I32 datumtype;
3314 register I32 len;
3315 register I32 bits;
abdc5761 3316 register char *str;
79072805 3317
a0d0e21e
LW
3318 /* These must not be in registers: */
3319 I16 ashort;
3320 int aint;
3321 I32 along;
6b8eaf93 3322#ifdef HAS_QUAD
ecfc5424 3323 Quad_t aquad;
a0d0e21e
LW
3324#endif
3325 U16 aushort;
3326 unsigned int auint;
3327 U32 aulong;
6b8eaf93 3328#ifdef HAS_QUAD
e862df63 3329 Uquad_t auquad;
a0d0e21e
LW
3330#endif
3331 char *aptr;
3332 float afloat;
3333 double adouble;
3334 I32 checksum = 0;
3335 register U32 culong;
65202027 3336 NV cdouble;
fb73857a 3337 int commas = 0;
4b5b2118 3338 int star;
726ea183 3339#ifdef PERL_NATINT_PACK
ef54e1a4
JH
3340 int natint; /* native integer */
3341 int unatint; /* unsigned native integer */
726ea183 3342#endif
79072805 3343
54310121 3344 if (gimme != G_ARRAY) { /* arrange to do first one only */
a0d0e21e
LW
3345 /*SUPPRESS 530*/
3346 for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
5a929a98 3347 if (strchr("aAZbBhHP", *patend) || *pat == '%') {
a0d0e21e
LW
3348 patend++;
3349 while (isDIGIT(*patend) || *patend == '*')
3350 patend++;
3351 }
3352 else
3353 patend++;
79072805 3354 }
a0d0e21e
LW
3355 while (pat < patend) {
3356 reparse:
bbdab043 3357 datumtype = *pat++ & 0xFF;
726ea183 3358#ifdef PERL_NATINT_PACK
ef54e1a4 3359 natint = 0;
726ea183 3360#endif
bbdab043
CS
3361 if (isSPACE(datumtype))
3362 continue;
17f4a12d
IZ
3363 if (datumtype == '#') {
3364 while (pat < patend && *pat != '\n')
3365 pat++;
3366 continue;
3367 }
f61d411c 3368 if (*pat == '!') {
ef54e1a4
JH
3369 char *natstr = "sSiIlL";
3370
3371 if (strchr(natstr, datumtype)) {
726ea183 3372#ifdef PERL_NATINT_PACK
ef54e1a4 3373 natint = 1;
726ea183 3374#endif
ef54e1a4
JH
3375 pat++;
3376 }
3377 else
d470f89e 3378 DIE(aTHX_ "'!' allowed only after types %s", natstr);
ef54e1a4 3379 }
4b5b2118 3380 star = 0;
a0d0e21e
LW
3381 if (pat >= patend)
3382 len = 1;
3383 else if (*pat == '*') {
3384 len = strend - strbeg; /* long enough */
3385 pat++;
4b5b2118 3386 star = 1;
a0d0e21e
LW
3387 }
3388 else if (isDIGIT(*pat)) {
3389 len = *pat++ - '0';
06387354 3390 while (isDIGIT(*pat)) {
a0d0e21e 3391 len = (len * 10) + (*pat++ - '0');
06387354 3392 if (len < 0)
d470f89e 3393 DIE(aTHX_ "Repeat count in unpack overflows");
06387354 3394 }
a0d0e21e
LW
3395 }
3396 else
3397 len = (datumtype != '@');
4b5b2118 3398 redo_switch:
a0d0e21e
LW
3399 switch(datumtype) {
3400 default:
d470f89e 3401 DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
fb73857a 3402 case ',': /* grandfather in commas but with a warning */
e476b1b5
GS
3403 if (commas++ == 0 && ckWARN(WARN_UNPACK))
3404 Perl_warner(aTHX_ WARN_UNPACK,
d470f89e 3405 "Invalid type in unpack: '%c'", (int)datumtype);
fb73857a 3406 break;
a0d0e21e
LW
3407 case '%':
3408 if (len == 1 && pat[-1] != '1')
3409 len = 16;
3410 checksum = len;
3411 culong = 0;
3412 cdouble = 0;
3413 if (pat < patend)
3414 goto reparse;
3415 break;
3416 case '@':
3417 if (len > strend - strbeg)
cea2e8a9 3418 DIE(aTHX_ "@ outside of string");
a0d0e21e
LW
3419 s = strbeg + len;
3420 break;
3421 case 'X':
3422 if (len > s - strbeg)
cea2e8a9 3423 DIE(aTHX_ "X outside of string");
a0d0e21e
LW
3424 s -= len;
3425 break;
3426 case 'x':
3427 if (len > strend - s)
cea2e8a9 3428 DIE(aTHX_ "x outside of string");
a0d0e21e
LW
3429 s += len;
3430 break;
17f4a12d 3431 case '/':
dd58a1ab 3432 if (start_sp_offset >= SP - PL_stack_base)
17f4a12d 3433 DIE(aTHX_ "/ must follow a numeric type");
43192e07
IP
3434 datumtype = *pat++;
3435 if (*pat == '*')
3436 pat++; /* ignore '*' for compatibility with pack */
3437 if (isDIGIT(*pat))
17f4a12d 3438 DIE(aTHX_ "/ cannot take a count" );
43192e07 3439 len = POPi;
4b5b2118
GS
3440 star = 0;
3441 goto redo_switch;
a0d0e21e 3442 case 'A':
5a929a98 3443 case 'Z':
a0d0e21e
LW
3444 case 'a':
3445 if (len > strend - s)
3446 len = strend - s;
3447 if (checksum)
3448 goto uchar_checksum;
3449 sv = NEWSV(35, len);
3450 sv_setpvn(sv, s, len);
3451 s += len;
5a929a98 3452 if (datumtype == 'A' || datumtype == 'Z') {
a0d0e21e 3453 aptr = s; /* borrow register */
5a929a98
VU
3454 if (datumtype == 'Z') { /* 'Z' strips stuff after first null */
3455 s = SvPVX(sv);
3456 while (*s)
3457 s++;
3458 }
3459 else { /* 'A' strips both nulls and spaces */
3460 s = SvPVX(sv) + len - 1;
3461 while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
3462 s--;
3463 *++s = '\0';
3464 }
a0d0e21e
LW
3465 SvCUR_set(sv, s - SvPVX(sv));
3466 s = aptr; /* unborrow register */
3467 }
3468 XPUSHs(sv_2mortal(sv));
3469 break;
3470 case 'B':
3471 case 'b':
4b5b2118 3472 if (star || len > (strend - s) * 8)
a0d0e21e
LW
3473 len = (strend - s) * 8;
3474 if (checksum) {
80252599
GS
3475 if (!PL_bitcount) {
3476 Newz(601, PL_bitcount, 256, char);
a0d0e21e 3477 for (bits = 1; bits < 256; bits++) {
80252599
GS
3478 if (bits & 1) PL_bitcount[bits]++;
3479 if (bits & 2) PL_bitcount[bits]++;
3480 if (bits & 4) PL_bitcount[bits]++;
3481 if (bits & 8) PL_bitcount[bits]++;
3482 if (bits & 16) PL_bitcount[bits]++;
3483 if (bits & 32) PL_bitcount[bits]++;
3484 if (bits & 64) PL_bitcount[bits]++;
3485 if (bits & 128) PL_bitcount[bits]++;
a0d0e21e
LW
3486 }
3487 }
3488 while (len >= 8) {
80252599 3489 culong += PL_bitcount[*(unsigned char*)s++];
a0d0e21e
LW
3490 len -= 8;
3491 }
3492 if (len) {
3493 bits = *s;
3494 if (datumtype == 'b') {
3495 while (len-- > 0) {
3496 if (bits & 1) culong++;
3497 bits >>= 1;
3498 }
3499 }
3500 else {
3501 while (len-- > 0) {
3502 if (bits & 128) culong++;
3503 bits <<= 1;
3504 }
3505 }
3506 }
79072805
LW
3507 break;
3508 }
a0d0e21e
LW
3509 sv = NEWSV(35, len + 1);
3510 SvCUR_set(sv, len);
3511 SvPOK_on(sv);
abdc5761 3512 str = SvPVX(sv);
a0d0e21e
LW
3513 if (datumtype == 'b') {
3514 aint = len;
3515 for (len = 0; len < aint; len++) {
3516 if (len & 7) /*SUPPRESS 595*/
3517 bits >>= 1;
3518 else
3519 bits = *s++;
abdc5761 3520 *str++ = '0' + (bits & 1);
a0d0e21e
LW
3521 }
3522 }
3523 else {
3524 aint = len;
3525 for (len = 0; len < aint; len++) {
3526 if (len & 7)
3527 bits <<= 1;
3528 else
3529 bits = *s++;
abdc5761 3530 *str++ = '0' + ((bits & 128) != 0);
a0d0e21e
LW
3531 }
3532 }
abdc5761 3533 *str = '\0';
a0d0e21e
LW
3534 XPUSHs(sv_2mortal(sv));
3535 break;
3536 case 'H':
3537 case 'h':
4b5b2118 3538 if (star || len > (strend - s) * 2)
a0d0e21e
LW
3539 len = (strend - s) * 2;
3540 sv = NEWSV(35, len + 1);
3541 SvCUR_set(sv, len);
3542 SvPOK_on(sv);
abdc5761 3543 str = SvPVX(sv);
a0d0e21e
LW
3544 if (datumtype == 'h') {
3545 aint = len;
3546 for (len = 0; len < aint; len++) {
3547 if (len & 1)
3548 bits >>= 4;
3549 else
3550 bits = *s++;
abdc5761 3551 *str++ = PL_hexdigit[bits & 15];
a0d0e21e
LW
3552 }
3553 }
3554 else {
3555 aint = len;
3556 for (len = 0; len < aint; len++) {
3557 if (len & 1)
3558 bits <<= 4;
3559 else
3560 bits = *s++;
abdc5761 3561 *str++ = PL_hexdigit[(bits >> 4) & 15];
a0d0e21e
LW
3562 }
3563 }
abdc5761 3564 *str = '\0';
a0d0e21e
LW
3565 XPUSHs(sv_2mortal(sv));
3566 break;
3567 case 'c':
3568 if (len > strend - s)
3569 len = strend - s;
3570 if (checksum) {
3571 while (len-- > 0) {
3572 aint = *s++;
3573 if (aint >= 128) /* fake up signed chars */
3574 aint -= 256;
3575 culong += aint;
3576 }
3577 }
3578 else {
3579 EXTEND(SP, len);
bbce6d69 3580 EXTEND_MORTAL(len);
a0d0e21e
LW
3581 while (len-- > 0) {
3582 aint = *s++;
3583 if (aint >= 128) /* fake up signed chars */
3584 aint -= 256;
3585 sv = NEWSV(36, 0);
1e422769 3586 sv_setiv(sv, (IV)aint);
a0d0e21e
LW
3587 PUSHs(sv_2mortal(sv));
3588 }
3589 }
3590 break;
3591 case 'C':
3592 if (len > strend - s)
3593 len = strend - s;
3594 if (checksum) {
3595 uchar_checksum:
3596 while (len-- > 0) {
3597 auint = *s++ & 255;
3598 culong += auint;
3599 }
3600 }
3601 else {
3602 EXTEND(SP, len);
bbce6d69 3603 EXTEND_MORTAL(len);
a0d0e21e
LW
3604 while (len-- > 0) {
3605 auint = *s++ & 255;
3606 sv = NEWSV(37, 0);
1e422769 3607 sv_setiv(sv, (IV)auint);
a0d0e21e
LW
3608 PUSHs(sv_2mortal(sv));
3609 }
3610 }
3611 break;
a0ed51b3
LW
3612 case 'U':
3613 if (len > strend - s)
3614 len = strend - s;
3615 if (checksum) {
3616 while (len-- > 0 && s < strend) {
8e84507e 3617 auint = utf8_to_uv_chk((U8*)s, &along, 0);
a0ed51b3 3618 s += along;
32d8b6e5 3619 if (checksum > 32)
65202027 3620 cdouble += (NV)auint;
32d8b6e5
GA
3621 else
3622 culong += auint;
a0ed51b3
LW
3623 }
3624 }
3625 else {
3626 EXTEND(SP, len);
3627 EXTEND_MORTAL(len);
3628 while (len-- > 0 && s < strend) {
8e84507e 3629 auint = utf8_to_uv_chk((U8*)s, &along, 0);
a0ed51b3
LW
3630 s += along;