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