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