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