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