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