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