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