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