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