This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl 5.003 check-in
[perl5.git] / pp.c
CommitLineData
a0d0e21e 1/* pp.c
79072805 2 *
a0d0e21e 3 * Copyright (c) 1991-1994, 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
a0d0e21e 18static void doencodes _((SV *sv, char *s, I32 len));
79072805 19
a0d0e21e 20/* variations on pp_null */
79072805 21
93a17b20
LW
22PP(pp_stub)
23{
24 dSP;
25 if (GIMME != G_ARRAY) {
26 XPUSHs(&sv_undef);
27 }
28 RETURN;
29}
30
79072805
LW
31PP(pp_scalar)
32{
33 return NORMAL;
34}
35
36/* Pushy stuff. */
37
93a17b20
LW
38PP(pp_padav)
39{
40 dSP; dTARGET;
a0d0e21e 41 if (op->op_private & OPpLVAL_INTRO)
8990e307 42 SAVECLEARSV(curpad[op->op_targ]);
85e6fe83 43 EXTEND(SP, 1);
a0d0e21e 44 if (op->op_flags & OPf_REF) {
85e6fe83 45 PUSHs(TARG);
93a17b20 46 RETURN;
85e6fe83
LW
47 }
48 if (GIMME == G_ARRAY) {
49 I32 maxarg = AvFILL((AV*)TARG) + 1;
50 EXTEND(SP, maxarg);
51 Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
52 SP += maxarg;
53 }
54 else {
55 SV* sv = sv_newmortal();
56 I32 maxarg = AvFILL((AV*)TARG) + 1;
57 sv_setiv(sv, maxarg);
58 PUSHs(sv);
59 }
60 RETURN;
93a17b20
LW
61}
62
63PP(pp_padhv)
64{
65 dSP; dTARGET;
66 XPUSHs(TARG);
a0d0e21e 67 if (op->op_private & OPpLVAL_INTRO)
8990e307 68 SAVECLEARSV(curpad[op->op_targ]);
a0d0e21e 69 if (op->op_flags & OPf_REF)
93a17b20 70 RETURN;
85e6fe83 71 if (GIMME == G_ARRAY) { /* array wanted */
a0d0e21e 72 RETURNOP(do_kv(ARGS));
85e6fe83
LW
73 }
74 else {
75 SV* sv = sv_newmortal();
76 if (HvFILL((HV*)TARG)) {
77 sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
78 sv_setpv(sv, buf);
79 }
80 else
81 sv_setiv(sv, 0);
82 SETs(sv);
83 RETURN;
84 }
93a17b20
LW
85}
86
ed6116ce
LW
87PP(pp_padany)
88{
89 DIE("NOT IMPL LINE %d",__LINE__);
90}
91
79072805
LW
92/* Translations. */
93
94PP(pp_rv2gv)
95{
96 dSP; dTOPss;
a0d0e21e 97
ed6116ce 98 if (SvROK(sv)) {
a0d0e21e 99 wasref:
ed6116ce 100 sv = SvRV(sv);
79072805 101 if (SvTYPE(sv) != SVt_PVGV)
a0d0e21e 102 DIE("Not a GLOB reference");
79072805
LW
103 }
104 else {
93a17b20 105 if (SvTYPE(sv) != SVt_PVGV) {
748a9306
LW
106 char *sym;
107
a0d0e21e
LW
108 if (SvGMAGICAL(sv)) {
109 mg_get(sv);
110 if (SvROK(sv))
111 goto wasref;
112 }
113 if (!SvOK(sv)) {
114 if (op->op_flags & OPf_REF ||
115 op->op_private & HINT_STRICT_REFS)
116 DIE(no_usym, "a symbol");
117 RETSETUNDEF;
118 }
748a9306 119 sym = SvPV(sv, na);
85e6fe83 120 if (op->op_private & HINT_STRICT_REFS)
748a9306
LW
121 DIE(no_symref, sym, "a symbol");
122 sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
93a17b20 123 }
79072805 124 }
a0d0e21e 125 if (op->op_private & OPpLVAL_INTRO) {
79072805
LW
126 GP *ogp = GvGP(sv);
127
128 SSCHECK(3);
4633a7c4 129 SSPUSHPTR(SvREFCNT_inc(sv));
79072805
LW
130 SSPUSHPTR(ogp);
131 SSPUSHINT(SAVEt_GP);
132
a0d0e21e 133 if (op->op_flags & OPf_SPECIAL) {
79072805 134 GvGP(sv)->gp_refcnt++; /* will soon be assigned */
a5f75d66 135 GvINTRO_on(sv);
a0d0e21e 136 }
79072805
LW
137 else {
138 GP *gp;
139 Newz(602,gp, 1, GP);
140 GvGP(sv) = gp;
141 GvREFCNT(sv) = 1;
142 GvSV(sv) = NEWSV(72,0);
143 GvLINE(sv) = curcop->cop_line;
144 GvEGV(sv) = sv;
145 }
146 }
147 SETs(sv);
148 RETURN;
149}
150
79072805
LW
151PP(pp_rv2sv)
152{
153 dSP; dTOPss;
154
ed6116ce 155 if (SvROK(sv)) {
a0d0e21e 156 wasref:
ed6116ce 157 sv = SvRV(sv);
79072805
LW
158 switch (SvTYPE(sv)) {
159 case SVt_PVAV:
160 case SVt_PVHV:
161 case SVt_PVCV:
a0d0e21e 162 DIE("Not a SCALAR reference");
79072805
LW
163 }
164 }
165 else {
463ee0b2 166 GV *gv = sv;
748a9306
LW
167 char *sym;
168
463ee0b2 169 if (SvTYPE(gv) != SVt_PVGV) {
a0d0e21e
LW
170 if (SvGMAGICAL(sv)) {
171 mg_get(sv);
172 if (SvROK(sv))
173 goto wasref;
174 }
175 if (!SvOK(sv)) {
176 if (op->op_flags & OPf_REF ||
177 op->op_private & HINT_STRICT_REFS)
178 DIE(no_usym, "a SCALAR");
179 RETSETUNDEF;
180 }
748a9306 181 sym = SvPV(sv, na);
85e6fe83 182 if (op->op_private & HINT_STRICT_REFS)
748a9306
LW
183 DIE(no_symref, sym, "a SCALAR");
184 gv = (SV*)gv_fetchpv(sym, TRUE, SVt_PV);
463ee0b2
LW
185 }
186 sv = GvSV(gv);
a0d0e21e
LW
187 }
188 if (op->op_flags & OPf_MOD) {
189 if (op->op_private & OPpLVAL_INTRO)
190 sv = save_scalar((GV*)TOPs);
464e2e8a
PP
191 else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV))
192 provide_ref(op, sv);
79072805 193 }
a0d0e21e 194 SETs(sv);
79072805
LW
195 RETURN;
196}
197
198PP(pp_av2arylen)
199{
200 dSP;
201 AV *av = (AV*)TOPs;
202 SV *sv = AvARYLEN(av);
203 if (!sv) {
204 AvARYLEN(av) = sv = NEWSV(0,0);
205 sv_upgrade(sv, SVt_IV);
206 sv_magic(sv, (SV*)av, '#', Nullch, 0);
207 }
208 SETs(sv);
209 RETURN;
210}
211
a0d0e21e
LW
212PP(pp_pos)
213{
214 dSP; dTARGET; dPOPss;
215
216 if (op->op_flags & OPf_MOD) {
217 LvTYPE(TARG) = '<';
218 LvTARG(TARG) = sv;
219 PUSHs(TARG); /* no SvSETMAGIC */
220 RETURN;
221 }
222 else {
223 MAGIC* mg;
224
225 if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
226 mg = mg_find(sv, 'g');
227 if (mg && mg->mg_len >= 0) {
228 PUSHi(mg->mg_len + curcop->cop_arybase);
229 RETURN;
230 }
231 }
232 RETPUSHUNDEF;
233 }
234}
235
79072805
LW
236PP(pp_rv2cv)
237{
238 dSP;
79072805
LW
239 GV *gv;
240 HV *stash;
8990e307 241
4633a7c4
LW
242 /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
243 /* (But not in defined().) */
244 CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
79072805 245
4633a7c4
LW
246 if (!cv)
247 cv = (CV*)&sv_undef;
79072805
LW
248 SETs((SV*)cv);
249 RETURN;
250}
251
c07a80fd
PP
252PP(pp_prototype)
253{
254 dSP;
255 CV *cv;
256 HV *stash;
257 GV *gv;
258 SV *ret;
259
260 ret = &sv_undef;
261 cv = sv_2cv(TOPs, &stash, &gv, FALSE);
262 if (cv && SvPOK(cv)) {
263 char *p = SvPVX(cv);
264 ret = sv_2mortal(newSVpv(p ? p : "", SvLEN(cv)));
265 }
266 SETs(ret);
267 RETURN;
268}
269
a0d0e21e
LW
270PP(pp_anoncode)
271{
272 dSP;
748a9306
LW
273 CV* cv = (CV*)cSVOP->op_sv;
274 EXTEND(SP,1);
275
a5f75d66 276 if (CvCLONE(cv))
b355b4e0 277 cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
748a9306
LW
278
279 PUSHs((SV*)cv);
a0d0e21e
LW
280 RETURN;
281}
282
283PP(pp_srefgen)
79072805
LW
284{
285 dSP; dTOPss;
286 SV* rv;
8990e307 287 rv = sv_newmortal();
ed6116ce 288 sv_upgrade(rv, SVt_RV);
a0d0e21e
LW
289 if (SvPADTMP(sv))
290 sv = newSVsv(sv);
291 else {
292 SvTEMP_off(sv);
293 (void)SvREFCNT_inc(sv);
294 }
295 SvRV(rv) = sv;
ed6116ce 296 SvROK_on(rv);
79072805
LW
297 SETs(rv);
298 RETURN;
a0d0e21e
LW
299}
300
301PP(pp_refgen)
302{
303 dSP; dMARK;
304 SV* sv;
305 SV* rv;
306 if (GIMME != G_ARRAY) {
307 MARK[1] = *SP;
308 SP = MARK + 1;
309 }
310 while (MARK < SP) {
311 sv = *++MARK;
312 rv = sv_newmortal();
313 sv_upgrade(rv, SVt_RV);
314 if (SvPADTMP(sv))
315 sv = newSVsv(sv);
316 else {
317 SvTEMP_off(sv);
318 (void)SvREFCNT_inc(sv);
319 }
320 SvRV(rv) = sv;
321 SvROK_on(rv);
322 *MARK = rv;
323 }
324 RETURN;
79072805
LW
325}
326
327PP(pp_ref)
328{
463ee0b2
LW
329 dSP; dTARGET;
330 SV *sv;
79072805
LW
331 char *pv;
332
a0d0e21e
LW
333 sv = POPs;
334 if (!sv || !SvROK(sv))
4633a7c4 335 RETPUSHNO;
79072805 336
ed6116ce 337 sv = SvRV(sv);
a0d0e21e 338 pv = sv_reftype(sv,TRUE);
463ee0b2 339 PUSHp(pv, strlen(pv));
79072805
LW
340 RETURN;
341}
342
343PP(pp_bless)
344{
463ee0b2 345 dSP;
463ee0b2 346 HV *stash;
79072805 347
463ee0b2
LW
348 if (MAXARG == 1)
349 stash = curcop->cop_stash;
350 else
a0d0e21e
LW
351 stash = gv_stashsv(POPs, TRUE);
352
353 (void)sv_bless(TOPs, stash);
79072805
LW
354 RETURN;
355}
356
a0d0e21e 357/* Pattern matching */
79072805 358
a0d0e21e 359PP(pp_study)
79072805 360{
c07a80fd 361 dSP; dPOPss;
a0d0e21e
LW
362 register unsigned char *s;
363 register I32 pos;
364 register I32 ch;
365 register I32 *sfirst;
366 register I32 *snext;
367 I32 retval;
368 STRLEN len;
369
c07a80fd 370 s = (unsigned char*)(SvPV(sv, len));
a0d0e21e 371 pos = len;
c07a80fd
PP
372 if (sv == lastscream)
373 SvSCREAM_off(sv);
374 else {
375 if (lastscream) {
376 SvSCREAM_off(lastscream);
377 SvREFCNT_dec(lastscream);
378 }
379 lastscream = SvREFCNT_inc(sv);
380 }
a0d0e21e
LW
381 if (pos <= 0) {
382 retval = 0;
383 goto ret;
384 }
385 if (pos > maxscream) {
386 if (maxscream < 0) {
387 maxscream = pos + 80;
388 New(301, screamfirst, 256, I32);
389 New(302, screamnext, maxscream, I32);
79072805
LW
390 }
391 else {
a0d0e21e
LW
392 maxscream = pos + pos / 4;
393 Renew(screamnext, maxscream, I32);
79072805 394 }
79072805 395 }
a0d0e21e
LW
396
397 sfirst = screamfirst;
398 snext = screamnext;
399
400 if (!sfirst || !snext)
401 DIE("do_study: out of memory");
402
403 for (ch = 256; ch; --ch)
404 *sfirst++ = -1;
405 sfirst -= 256;
406
407 while (--pos >= 0) {
408 ch = s[pos];
409 if (sfirst[ch] >= 0)
410 snext[pos] = sfirst[ch] - pos;
411 else
412 snext[pos] = -pos;
413 sfirst[ch] = pos;
414
415 /* If there were any case insensitive searches, we must assume they
416 * all are. This speeds up insensitive searches much more than
417 * it slows down sensitive ones.
418 */
419 if (sawi)
420 sfirst[fold[ch]] = pos;
79072805
LW
421 }
422
c07a80fd 423 SvSCREAM_on(sv);
464e2e8a 424 sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */
a0d0e21e
LW
425 retval = 1;
426 ret:
427 XPUSHs(sv_2mortal(newSViv((I32)retval)));
79072805
LW
428 RETURN;
429}
430
a0d0e21e 431PP(pp_trans)
79072805 432{
a0d0e21e
LW
433 dSP; dTARG;
434 SV *sv;
435
436 if (op->op_flags & OPf_STACKED)
437 sv = POPs;
79072805 438 else {
a0d0e21e
LW
439 sv = GvSV(defgv);
440 EXTEND(SP,1);
79072805 441 }
adbc6bb1 442 TARG = sv_newmortal();
a0d0e21e
LW
443 PUSHi(do_trans(sv, op));
444 RETURN;
79072805
LW
445}
446
a0d0e21e 447/* Lvalue operators. */
79072805 448
a0d0e21e
LW
449PP(pp_schop)
450{
451 dSP; dTARGET;
452 do_chop(TARG, TOPs);
453 SETTARG;
454 RETURN;
79072805
LW
455}
456
a0d0e21e 457PP(pp_chop)
79072805 458{
a0d0e21e
LW
459 dSP; dMARK; dTARGET;
460 while (SP > MARK)
461 do_chop(TARG, POPs);
462 PUSHTARG;
463 RETURN;
79072805
LW
464}
465
a0d0e21e 466PP(pp_schomp)
79072805 467{
a0d0e21e
LW
468 dSP; dTARGET;
469 SETi(do_chomp(TOPs));
470 RETURN;
79072805
LW
471}
472
a0d0e21e 473PP(pp_chomp)
79072805 474{
a0d0e21e
LW
475 dSP; dMARK; dTARGET;
476 register I32 count = 0;
477
478 while (SP > MARK)
479 count += do_chomp(POPs);
480 PUSHi(count);
481 RETURN;
79072805
LW
482}
483
a0d0e21e 484PP(pp_defined)
463ee0b2 485{
a0d0e21e
LW
486 dSP;
487 register SV* sv;
488
489 sv = POPs;
490 if (!sv || !SvANY(sv))
491 RETPUSHNO;
492 switch (SvTYPE(sv)) {
493 case SVt_PVAV:
8e07c86e 494 if (AvMAX(sv) >= 0 || SvRMAGICAL(sv))
a0d0e21e
LW
495 RETPUSHYES;
496 break;
497 case SVt_PVHV:
8e07c86e 498 if (HvARRAY(sv) || SvRMAGICAL(sv))
a0d0e21e
LW
499 RETPUSHYES;
500 break;
501 case SVt_PVCV:
502 if (CvROOT(sv) || CvXSUB(sv))
503 RETPUSHYES;
504 break;
505 default:
506 if (SvGMAGICAL(sv))
507 mg_get(sv);
508 if (SvOK(sv))
509 RETPUSHYES;
510 }
511 RETPUSHNO;
463ee0b2
LW
512}
513
a0d0e21e
LW
514PP(pp_undef)
515{
79072805 516 dSP;
a0d0e21e
LW
517 SV *sv;
518
519 if (!op->op_private)
520 RETPUSHUNDEF;
79072805 521
a0d0e21e
LW
522 sv = POPs;
523 if (!sv)
524 RETPUSHUNDEF;
85e6fe83 525
a0d0e21e
LW
526 if (SvTHINKFIRST(sv)) {
527 if (SvREADONLY(sv))
528 RETPUSHUNDEF;
529 if (SvROK(sv))
530 sv_unref(sv);
85e6fe83
LW
531 }
532
a0d0e21e
LW
533 switch (SvTYPE(sv)) {
534 case SVt_NULL:
535 break;
536 case SVt_PVAV:
537 av_undef((AV*)sv);
538 break;
539 case SVt_PVHV:
540 hv_undef((HV*)sv);
541 break;
542 case SVt_PVCV:
543 cv_undef((CV*)sv);
544 sub_generation++;
545 break;
8e07c86e
AD
546 case SVt_PVGV:
547 if (SvFAKE(sv)) {
548 sv_setsv(sv, &sv_undef);
549 break;
550 }
a0d0e21e 551 default:
4633a7c4
LW
552 if (SvPOK(sv) && SvLEN(sv)) {
553 (void)SvOOK_off(sv);
554 Safefree(SvPVX(sv));
555 SvPV_set(sv, Nullch);
556 SvLEN_set(sv, 0);
a0d0e21e 557 }
4633a7c4
LW
558 (void)SvOK_off(sv);
559 SvSETMAGIC(sv);
79072805 560 }
a0d0e21e
LW
561
562 RETPUSHUNDEF;
79072805
LW
563}
564
a0d0e21e 565PP(pp_predec)
79072805 566{
a0d0e21e 567 dSP;
748a9306
LW
568 if (SvIOK(TOPs)) {
569 --SvIVX(TOPs);
570 SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
571 }
572 else
573 sv_dec(TOPs);
a0d0e21e
LW
574 SvSETMAGIC(TOPs);
575 return NORMAL;
576}
79072805 577
a0d0e21e
LW
578PP(pp_postinc)
579{
580 dSP; dTARGET;
581 sv_setsv(TARG, TOPs);
748a9306
LW
582 if (SvIOK(TOPs)) {
583 ++SvIVX(TOPs);
584 SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
585 }
586 else
587 sv_inc(TOPs);
a0d0e21e
LW
588 SvSETMAGIC(TOPs);
589 if (!SvOK(TARG))
590 sv_setiv(TARG, 0);
591 SETs(TARG);
592 return NORMAL;
593}
79072805 594
a0d0e21e
LW
595PP(pp_postdec)
596{
597 dSP; dTARGET;
598 sv_setsv(TARG, TOPs);
748a9306
LW
599 if (SvIOK(TOPs)) {
600 --SvIVX(TOPs);
601 SvFLAGS(TOPs) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK);
602 }
603 else
604 sv_dec(TOPs);
a0d0e21e
LW
605 SvSETMAGIC(TOPs);
606 SETs(TARG);
607 return NORMAL;
608}
79072805 609
a0d0e21e
LW
610/* Ordinary operators. */
611
612PP(pp_pow)
613{
614 dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
615 {
616 dPOPTOPnnrl;
617 SETn( pow( left, right) );
618 RETURN;
93a17b20 619 }
a0d0e21e
LW
620}
621
622PP(pp_multiply)
623{
624 dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
625 {
626 dPOPTOPnnrl;
627 SETn( left * right );
628 RETURN;
79072805 629 }
a0d0e21e
LW
630}
631
632PP(pp_divide)
633{
634 dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
635 {
636 dPOPnv;
637 if (value == 0.0)
638 DIE("Illegal division by zero");
639#ifdef SLOPPYDIVIDE
640 /* insure that 20./5. == 4. */
641 {
642 double x;
643 I32 k;
644 x = POPn;
645 if ((double)I_32(x) == x &&
646 (double)I_32(value) == value &&
647 (k = I_32(x)/I_32(value))*I_32(value) == I_32(x)) {
648 value = k;
649 } else {
650 value = x/value;
79072805 651 }
a0d0e21e
LW
652 }
653#else
654 value = POPn / value;
655#endif
656 PUSHn( value );
657 RETURN;
79072805 658 }
a0d0e21e
LW
659}
660
661PP(pp_modulo)
662{
663 dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
664 {
665 register unsigned long tmpulong;
666 register long tmplong;
667 I32 value;
668
669 tmpulong = (unsigned long) POPn;
670 if (tmpulong == 0L)
671 DIE("Illegal modulus zero");
672 value = TOPn;
673 if (value >= 0.0)
674 value = (I32)(((unsigned long)value) % tmpulong);
675 else {
676 tmplong = (long)value;
677 value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
678 }
679 SETi(value);
680 RETURN;
79072805 681 }
a0d0e21e 682}
79072805 683
a0d0e21e
LW
684PP(pp_repeat)
685{
748a9306
LW
686 dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
687 {
a0d0e21e
LW
688 register I32 count = POPi;
689 if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
690 dMARK;
691 I32 items = SP - MARK;
692 I32 max;
79072805 693
a0d0e21e
LW
694 max = items * count;
695 MEXTEND(MARK, max);
696 if (count > 1) {
697 while (SP > MARK) {
698 if (*SP)
699 SvTEMP_off((*SP));
700 SP--;
79072805 701 }
a0d0e21e
LW
702 MARK++;
703 repeatcpy((char*)(MARK + items), (char*)MARK,
704 items * sizeof(SV*), count - 1);
705 SP += max;
79072805 706 }
a0d0e21e
LW
707 else if (count <= 0)
708 SP -= items;
79072805 709 }
a0d0e21e
LW
710 else { /* Note: mark already snarfed by pp_list */
711 SV *tmpstr;
712 STRLEN len;
713
714 tmpstr = POPs;
715 if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
716 if (SvREADONLY(tmpstr) && curcop != &compiling)
717 DIE("Can't x= to readonly value");
718 if (SvROK(tmpstr))
719 sv_unref(tmpstr);
93a17b20 720 }
a0d0e21e
LW
721 SvSetSV(TARG, tmpstr);
722 SvPV_force(TARG, len);
723 if (count >= 1) {
724 SvGROW(TARG, (count * len) + 1);
725 if (count > 1)
726 repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
727 SvCUR(TARG) *= count;
728 *SvEND(TARG) = '\0';
729 (void)SvPOK_only(TARG);
730 }
731 else
732 sv_setsv(TARG, &sv_no);
733 PUSHTARG;
79072805 734 }
a0d0e21e 735 RETURN;
748a9306 736 }
a0d0e21e 737}
79072805 738
a0d0e21e
LW
739PP(pp_subtract)
740{
741 dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
742 {
743 dPOPTOPnnrl;
744 SETn( left - right );
745 RETURN;
79072805 746 }
a0d0e21e 747}
79072805 748
a0d0e21e
LW
749PP(pp_left_shift)
750{
751 dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
752 {
748a9306
LW
753 dPOPTOPiirl;
754 SETi( left << right );
755 RETURN;
79072805 756 }
a0d0e21e 757}
79072805 758
a0d0e21e
LW
759PP(pp_right_shift)
760{
761 dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
762 {
763 dPOPTOPiirl;
764 SETi( left >> right );
765 RETURN;
93a17b20 766 }
79072805
LW
767}
768
a0d0e21e 769PP(pp_lt)
79072805 770{
a0d0e21e
LW
771 dSP; tryAMAGICbinSET(lt,0);
772 {
773 dPOPnv;
774 SETs((TOPn < value) ? &sv_yes : &sv_no);
775 RETURN;
79072805 776 }
a0d0e21e 777}
79072805 778
a0d0e21e
LW
779PP(pp_gt)
780{
781 dSP; tryAMAGICbinSET(gt,0);
782 {
783 dPOPnv;
784 SETs((TOPn > value) ? &sv_yes : &sv_no);
785 RETURN;
79072805 786 }
a0d0e21e
LW
787}
788
789PP(pp_le)
790{
791 dSP; tryAMAGICbinSET(le,0);
792 {
793 dPOPnv;
794 SETs((TOPn <= value) ? &sv_yes : &sv_no);
795 RETURN;
79072805 796 }
a0d0e21e
LW
797}
798
799PP(pp_ge)
800{
801 dSP; tryAMAGICbinSET(ge,0);
802 {
803 dPOPnv;
804 SETs((TOPn >= value) ? &sv_yes : &sv_no);
805 RETURN;
79072805 806 }
a0d0e21e 807}
79072805 808
a0d0e21e
LW
809PP(pp_ne)
810{
811 dSP; tryAMAGICbinSET(ne,0);
812 {
813 dPOPnv;
814 SETs((TOPn != value) ? &sv_yes : &sv_no);
815 RETURN;
816 }
79072805
LW
817}
818
a0d0e21e 819PP(pp_ncmp)
79072805 820{
a0d0e21e
LW
821 dSP; dTARGET; tryAMAGICbin(ncmp,0);
822 {
823 dPOPTOPnnrl;
824 I32 value;
79072805 825
a0d0e21e
LW
826 if (left > right)
827 value = 1;
828 else if (left < right)
829 value = -1;
830 else
831 value = 0;
832 SETi(value);
833 RETURN;
79072805 834 }
a0d0e21e 835}
79072805 836
a0d0e21e
LW
837PP(pp_slt)
838{
839 dSP; tryAMAGICbinSET(slt,0);
840 {
841 dPOPTOPssrl;
842 SETs( sv_cmp(left, right) < 0 ? &sv_yes : &sv_no );
843 RETURN;
844 }
79072805
LW
845}
846
a0d0e21e 847PP(pp_sgt)
79072805 848{
a0d0e21e
LW
849 dSP; tryAMAGICbinSET(sgt,0);
850 {
851 dPOPTOPssrl;
852 SETs( sv_cmp(left, right) > 0 ? &sv_yes : &sv_no );
853 RETURN;
854 }
855}
79072805 856
a0d0e21e
LW
857PP(pp_sle)
858{
859 dSP; tryAMAGICbinSET(sle,0);
860 {
861 dPOPTOPssrl;
862 SETs( sv_cmp(left, right) <= 0 ? &sv_yes : &sv_no );
863 RETURN;
79072805 864 }
79072805
LW
865}
866
a0d0e21e
LW
867PP(pp_sge)
868{
869 dSP; tryAMAGICbinSET(sge,0);
870 {
871 dPOPTOPssrl;
872 SETs( sv_cmp(left, right) >= 0 ? &sv_yes : &sv_no );
873 RETURN;
874 }
875}
79072805 876
a0d0e21e 877PP(pp_sne)
79072805 878{
a0d0e21e
LW
879 dSP; tryAMAGICbinSET(sne,0);
880 {
881 dPOPTOPssrl;
882 SETs( !sv_eq(left, right) ? &sv_yes : &sv_no );
883 RETURN;
463ee0b2 884 }
79072805
LW
885}
886
a0d0e21e 887PP(pp_scmp)
79072805 888{
a0d0e21e
LW
889 dSP; dTARGET; tryAMAGICbin(scmp,0);
890 {
891 dPOPTOPssrl;
892 SETi( sv_cmp(left, right) );
893 RETURN;
894 }
895}
79072805 896
a0d0e21e
LW
897PP(pp_bit_and) {
898 dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
899 {
900 dPOPTOPssrl;
4633a7c4 901 if (SvNIOKp(left) || SvNIOKp(right)) {
a0d0e21e
LW
902 unsigned long value = U_L(SvNV(left));
903 value = value & U_L(SvNV(right));
904 SETn((double)value);
905 }
906 else {
907 do_vop(op->op_type, TARG, left, right);
908 SETTARG;
909 }
910 RETURN;
911 }
912}
79072805 913
a0d0e21e
LW
914PP(pp_bit_xor)
915{
916 dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
917 {
918 dPOPTOPssrl;
4633a7c4 919 if (SvNIOKp(left) || SvNIOKp(right)) {
a0d0e21e
LW
920 unsigned long value = U_L(SvNV(left));
921 value = value ^ U_L(SvNV(right));
922 SETn((double)value);
923 }
924 else {
925 do_vop(op->op_type, TARG, left, right);
926 SETTARG;
927 }
928 RETURN;
929 }
930}
79072805 931
a0d0e21e
LW
932PP(pp_bit_or)
933{
934 dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
935 {
936 dPOPTOPssrl;
4633a7c4 937 if (SvNIOKp(left) || SvNIOKp(right)) {
a0d0e21e
LW
938 unsigned long value = U_L(SvNV(left));
939 value = value | U_L(SvNV(right));
940 SETn((double)value);
941 }
942 else {
943 do_vop(op->op_type, TARG, left, right);
944 SETTARG;
945 }
946 RETURN;
79072805 947 }
a0d0e21e 948}
79072805 949
a0d0e21e
LW
950PP(pp_negate)
951{
952 dSP; dTARGET; tryAMAGICun(neg);
953 {
954 dTOPss;
4633a7c4
LW
955 if (SvGMAGICAL(sv))
956 mg_get(sv);
957 if (SvNIOKp(sv))
a0d0e21e 958 SETn(-SvNV(sv));
4633a7c4 959 else if (SvPOKp(sv)) {
a0d0e21e
LW
960 STRLEN len;
961 char *s = SvPV(sv, len);
962 if (isALPHA(*s) || *s == '_') {
963 sv_setpvn(TARG, "-", 1);
964 sv_catsv(TARG, sv);
79072805 965 }
a0d0e21e
LW
966 else if (*s == '+' || *s == '-') {
967 sv_setsv(TARG, sv);
968 *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
79072805
LW
969 }
970 else
a0d0e21e
LW
971 sv_setnv(TARG, -SvNV(sv));
972 SETTARG;
79072805 973 }
4633a7c4
LW
974 else
975 SETn(-SvNV(sv));
79072805 976 }
a0d0e21e 977 RETURN;
79072805
LW
978}
979
a0d0e21e 980PP(pp_not)
79072805 981{
a0d0e21e
LW
982#ifdef OVERLOAD
983 dSP; tryAMAGICunSET(not);
984#endif /* OVERLOAD */
985 *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
986 return NORMAL;
79072805
LW
987}
988
a0d0e21e 989PP(pp_complement)
79072805 990{
a0d0e21e
LW
991 dSP; dTARGET; tryAMAGICun(compl);
992 {
993 dTOPss;
994 register I32 anum;
995
4633a7c4 996 if (SvNIOKp(sv)) {
748a9306
LW
997 IV iv = ~SvIV(sv);
998 if (iv < 0)
999 SETn( (double) ~U_L(SvNV(sv)) );
1000 else
1001 SETi( iv );
a0d0e21e
LW
1002 }
1003 else {
1004 register char *tmps;
1005 register long *tmpl;
1006 STRLEN len;
1007
1008 SvSetSV(TARG, sv);
1009 tmps = SvPV_force(TARG, len);
1010 anum = len;
1011#ifdef LIBERAL
1012 for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
1013 *tmps = ~*tmps;
1014 tmpl = (long*)tmps;
1015 for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
1016 *tmpl = ~*tmpl;
1017 tmps = (char*)tmpl;
1018#endif
1019 for ( ; anum > 0; anum--, tmps++)
1020 *tmps = ~*tmps;
1021
1022 SETs(TARG);
1023 }
1024 RETURN;
1025 }
79072805
LW
1026}
1027
a0d0e21e
LW
1028/* integer versions of some of the above */
1029
a0d0e21e 1030PP(pp_i_multiply)
79072805 1031{
a0d0e21e
LW
1032 dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
1033 {
1034 dPOPTOPiirl;
1035 SETi( left * right );
1036 RETURN;
1037 }
79072805
LW
1038}
1039
a0d0e21e 1040PP(pp_i_divide)
79072805 1041{
a0d0e21e
LW
1042 dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
1043 {
1044 dPOPiv;
1045 if (value == 0)
1046 DIE("Illegal division by zero");
1047 value = POPi / value;
1048 PUSHi( value );
1049 RETURN;
1050 }
79072805
LW
1051}
1052
a0d0e21e 1053PP(pp_i_modulo)
79072805 1054{
a0d0e21e 1055 dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
79072805 1056 {
a0d0e21e
LW
1057 dPOPTOPiirl;
1058 SETi( left % right );
1059 RETURN;
79072805 1060 }
79072805
LW
1061}
1062
a0d0e21e 1063PP(pp_i_add)
79072805 1064{
a0d0e21e
LW
1065 dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
1066 {
1067 dPOPTOPiirl;
1068 SETi( left + right );
1069 RETURN;
79072805 1070 }
79072805
LW
1071}
1072
a0d0e21e 1073PP(pp_i_subtract)
79072805 1074{
a0d0e21e
LW
1075 dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
1076 {
1077 dPOPTOPiirl;
1078 SETi( left - right );
1079 RETURN;
79072805 1080 }
79072805
LW
1081}
1082
a0d0e21e 1083PP(pp_i_lt)
79072805 1084{
a0d0e21e
LW
1085 dSP; tryAMAGICbinSET(lt,0);
1086 {
1087 dPOPTOPiirl;
1088 SETs((left < right) ? &sv_yes : &sv_no);
1089 RETURN;
1090 }
79072805
LW
1091}
1092
a0d0e21e 1093PP(pp_i_gt)
79072805 1094{
a0d0e21e
LW
1095 dSP; tryAMAGICbinSET(gt,0);
1096 {
1097 dPOPTOPiirl;
1098 SETs((left > right) ? &sv_yes : &sv_no);
1099 RETURN;
1100 }
79072805
LW
1101}
1102
a0d0e21e 1103PP(pp_i_le)
79072805 1104{
a0d0e21e
LW
1105 dSP; tryAMAGICbinSET(le,0);
1106 {
1107 dPOPTOPiirl;
1108 SETs((left <= right) ? &sv_yes : &sv_no);
1109 RETURN;
85e6fe83 1110 }
79072805
LW
1111}
1112
a0d0e21e 1113PP(pp_i_ge)
79072805 1114{
a0d0e21e
LW
1115 dSP; tryAMAGICbinSET(ge,0);
1116 {
1117 dPOPTOPiirl;
1118 SETs((left >= right) ? &sv_yes : &sv_no);
1119 RETURN;
1120 }
79072805
LW
1121}
1122
a0d0e21e 1123PP(pp_i_eq)
79072805 1124{
a0d0e21e
LW
1125 dSP; tryAMAGICbinSET(eq,0);
1126 {
1127 dPOPTOPiirl;
1128 SETs((left == right) ? &sv_yes : &sv_no);
1129 RETURN;
1130 }
79072805
LW
1131}
1132
a0d0e21e 1133PP(pp_i_ne)
79072805 1134{
a0d0e21e
LW
1135 dSP; tryAMAGICbinSET(ne,0);
1136 {
1137 dPOPTOPiirl;
1138 SETs((left != right) ? &sv_yes : &sv_no);
1139 RETURN;
1140 }
79072805
LW
1141}
1142
a0d0e21e 1143PP(pp_i_ncmp)
79072805 1144{
a0d0e21e
LW
1145 dSP; dTARGET; tryAMAGICbin(ncmp,0);
1146 {
1147 dPOPTOPiirl;
1148 I32 value;
79072805 1149
a0d0e21e 1150 if (left > right)
79072805 1151 value = 1;
a0d0e21e 1152 else if (left < right)
79072805 1153 value = -1;
a0d0e21e 1154 else
79072805 1155 value = 0;
a0d0e21e
LW
1156 SETi(value);
1157 RETURN;
79072805 1158 }
85e6fe83
LW
1159}
1160
1161PP(pp_i_negate)
1162{
a0d0e21e 1163 dSP; dTARGET; tryAMAGICun(neg);
85e6fe83
LW
1164 SETi(-TOPi);
1165 RETURN;
1166}
1167
79072805
LW
1168/* High falutin' math. */
1169
1170PP(pp_atan2)
1171{
a0d0e21e
LW
1172 dSP; dTARGET; tryAMAGICbin(atan2,0);
1173 {
1174 dPOPTOPnnrl;
1175 SETn(atan2(left, right));
1176 RETURN;
1177 }
79072805
LW
1178}
1179
1180PP(pp_sin)
1181{
a0d0e21e
LW
1182 dSP; dTARGET; tryAMAGICun(sin);
1183 {
1184 double value;
1185 value = POPn;
1186 value = sin(value);
1187 XPUSHn(value);
1188 RETURN;
1189 }
79072805
LW
1190}
1191
1192PP(pp_cos)
1193{
a0d0e21e
LW
1194 dSP; dTARGET; tryAMAGICun(cos);
1195 {
1196 double value;
1197 value = POPn;
1198 value = cos(value);
1199 XPUSHn(value);
1200 RETURN;
1201 }
79072805
LW
1202}
1203
1204PP(pp_rand)
1205{
1206 dSP; dTARGET;
1207 double value;
1208 if (MAXARG < 1)
1209 value = 1.0;
1210 else
1211 value = POPn;
1212 if (value == 0.0)
1213 value = 1.0;
1214#if RANDBITS == 31
1215 value = rand() * value / 2147483648.0;
1216#else
1217#if RANDBITS == 16
1218 value = rand() * value / 65536.0;
1219#else
1220#if RANDBITS == 15
1221 value = rand() * value / 32768.0;
1222#else
1223 value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1224#endif
1225#endif
1226#endif
1227 XPUSHn(value);
1228 RETURN;
1229}
1230
1231PP(pp_srand)
1232{
1233 dSP;
1234 I32 anum;
85e6fe83 1235 Time_t when;
79072805
LW
1236
1237 if (MAXARG < 1) {
1238 (void)time(&when);
1239 anum = when;
1240 }
1241 else
1242 anum = POPi;
1243 (void)srand(anum);
1244 EXTEND(SP, 1);
1245 RETPUSHYES;
1246}
1247
1248PP(pp_exp)
1249{
a0d0e21e
LW
1250 dSP; dTARGET; tryAMAGICun(exp);
1251 {
1252 double value;
1253 value = POPn;
1254 value = exp(value);
1255 XPUSHn(value);
1256 RETURN;
1257 }
79072805
LW
1258}
1259
1260PP(pp_log)
1261{
a0d0e21e
LW
1262 dSP; dTARGET; tryAMAGICun(log);
1263 {
1264 double value;
1265 value = POPn;
1266 if (value <= 0.0)
2304df62 1267 DIE("Can't take log of %g", value);
a0d0e21e
LW
1268 value = log(value);
1269 XPUSHn(value);
1270 RETURN;
1271 }
79072805
LW
1272}
1273
1274PP(pp_sqrt)
1275{
a0d0e21e
LW
1276 dSP; dTARGET; tryAMAGICun(sqrt);
1277 {
1278 double value;
1279 value = POPn;
1280 if (value < 0.0)
2304df62 1281 DIE("Can't take sqrt of %g", value);
a0d0e21e
LW
1282 value = sqrt(value);
1283 XPUSHn(value);
1284 RETURN;
1285 }
79072805
LW
1286}
1287
1288PP(pp_int)
1289{
1290 dSP; dTARGET;
1291 double value;
a0d0e21e 1292 value = POPn;
79072805
LW
1293 if (value >= 0.0)
1294 (void)modf(value, &value);
1295 else {
1296 (void)modf(-value, &value);
1297 value = -value;
1298 }
1299 XPUSHn(value);
1300 RETURN;
1301}
1302
463ee0b2
LW
1303PP(pp_abs)
1304{
a0d0e21e
LW
1305 dSP; dTARGET; tryAMAGICun(abs);
1306 {
1307 double value;
1308 value = POPn;
463ee0b2 1309
a0d0e21e 1310 if (value < 0.0)
463ee0b2
LW
1311 value = -value;
1312
a0d0e21e
LW
1313 XPUSHn(value);
1314 RETURN;
1315 }
463ee0b2
LW
1316}
1317
79072805
LW
1318PP(pp_hex)
1319{
1320 dSP; dTARGET;
1321 char *tmps;
464e2e8a 1322 unsigned long value;
79072805
LW
1323 I32 argtype;
1324
a0d0e21e 1325 tmps = POPp;
464e2e8a
PP
1326 value = scan_hex(tmps, 99, &argtype);
1327 if ((IV)value >= 0)
1328 XPUSHi(value);
1329 else
1330 XPUSHn(U_V(value));
79072805
LW
1331 RETURN;
1332}
1333
1334PP(pp_oct)
1335{
1336 dSP; dTARGET;
464e2e8a 1337 unsigned long value;
79072805
LW
1338 I32 argtype;
1339 char *tmps;
1340
a0d0e21e 1341 tmps = POPp;
464e2e8a
PP
1342 while (*tmps && isSPACE(*tmps))
1343 tmps++;
1344 if (*tmps == '0')
79072805
LW
1345 tmps++;
1346 if (*tmps == 'x')
464e2e8a
PP
1347 value = scan_hex(++tmps, 99, &argtype);
1348 else
1349 value = scan_oct(tmps, 99, &argtype);
1350 if ((IV)value >= 0)
1351 XPUSHi(value);
79072805 1352 else
464e2e8a 1353 XPUSHn(U_V(value));
79072805
LW
1354 RETURN;
1355}
1356
1357/* String stuff. */
1358
1359PP(pp_length)
1360{
1361 dSP; dTARGET;
a0d0e21e 1362 SETi( sv_len(TOPs) );
79072805
LW
1363 RETURN;
1364}
1365
1366PP(pp_substr)
1367{
1368 dSP; dTARGET;
1369 SV *sv;
1370 I32 len;
463ee0b2 1371 STRLEN curlen;
79072805
LW
1372 I32 pos;
1373 I32 rem;
a0d0e21e 1374 I32 lvalue = op->op_flags & OPf_MOD;
79072805 1375 char *tmps;
a0d0e21e 1376 I32 arybase = curcop->cop_arybase;
79072805
LW
1377
1378 if (MAXARG > 2)
1379 len = POPi;
1380 pos = POPi - arybase;
1381 sv = POPs;
a0d0e21e 1382 tmps = SvPV(sv, curlen);
79072805
LW
1383 if (pos < 0)
1384 pos += curlen + arybase;
2304df62 1385 if (pos < 0 || pos > curlen) {
a0d0e21e 1386 if (dowarn || lvalue)
2304df62
AD
1387 warn("substr outside of string");
1388 RETPUSHUNDEF;
1389 }
79072805
LW
1390 else {
1391 if (MAXARG < 3)
1392 len = curlen;
a0d0e21e 1393 else if (len < 0) {
748a9306 1394 len += curlen - pos;
a0d0e21e
LW
1395 if (len < 0)
1396 len = 0;
1397 }
79072805
LW
1398 tmps += pos;
1399 rem = curlen - pos; /* rem=how many bytes left*/
1400 if (rem > len)
1401 rem = len;
1402 sv_setpvn(TARG, tmps, rem);
1403 if (lvalue) { /* it's an lvalue! */
c07a80fd
PP
1404 if (!SvGMAGICAL(sv))
1405 (void)SvPOK_only(sv);
a0d0e21e
LW
1406 if (SvTYPE(TARG) < SVt_PVLV) {
1407 sv_upgrade(TARG, SVt_PVLV);
1408 sv_magic(TARG, Nullsv, 'x', Nullch, 0);
ed6116ce 1409 }
a0d0e21e 1410
79072805
LW
1411 LvTYPE(TARG) = 's';
1412 LvTARG(TARG) = sv;
a0d0e21e 1413 LvTARGOFF(TARG) = pos;
79072805
LW
1414 LvTARGLEN(TARG) = rem;
1415 }
1416 }
1417 PUSHs(TARG); /* avoid SvSETMAGIC here */
1418 RETURN;
1419}
1420
1421PP(pp_vec)
1422{
1423 dSP; dTARGET;
1424 register I32 size = POPi;
1425 register I32 offset = POPi;
1426 register SV *src = POPs;
a0d0e21e 1427 I32 lvalue = op->op_flags & OPf_MOD;
463ee0b2
LW
1428 STRLEN srclen;
1429 unsigned char *s = (unsigned char*)SvPV(src, srclen);
79072805
LW
1430 unsigned long retnum;
1431 I32 len;
1432
1433 offset *= size; /* turn into bit offset */
1434 len = (offset + size + 7) / 8;
1435 if (offset < 0 || size < 1)
1436 retnum = 0;
79072805 1437 else {
a0d0e21e
LW
1438 if (lvalue) { /* it's an lvalue! */
1439 if (SvTYPE(TARG) < SVt_PVLV) {
1440 sv_upgrade(TARG, SVt_PVLV);
1441 sv_magic(TARG, Nullsv, 'v', Nullch, 0);
1442 }
1443
1444 LvTYPE(TARG) = 'v';
1445 LvTARG(TARG) = src;
1446 LvTARGOFF(TARG) = offset;
1447 LvTARGLEN(TARG) = size;
1448 }
93a17b20 1449 if (len > srclen) {
a0d0e21e
LW
1450 if (size <= 8)
1451 retnum = 0;
1452 else {
1453 offset >>= 3;
748a9306
LW
1454 if (size == 16) {
1455 if (offset >= srclen)
1456 retnum = 0;
a0d0e21e 1457 else
748a9306
LW
1458 retnum = (unsigned long) s[offset] << 8;
1459 }
1460 else if (size == 32) {
1461 if (offset >= srclen)
1462 retnum = 0;
1463 else if (offset + 1 >= srclen)
a0d0e21e 1464 retnum = (unsigned long) s[offset] << 24;
748a9306
LW
1465 else if (offset + 2 >= srclen)
1466 retnum = ((unsigned long) s[offset] << 24) +
1467 ((unsigned long) s[offset + 1] << 16);
1468 else
1469 retnum = ((unsigned long) s[offset] << 24) +
1470 ((unsigned long) s[offset + 1] << 16) +
1471 (s[offset + 2] << 8);
a0d0e21e
LW
1472 }
1473 }
79072805 1474 }
a0d0e21e 1475 else if (size < 8)
79072805
LW
1476 retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1477 else {
1478 offset >>= 3;
1479 if (size == 8)
1480 retnum = s[offset];
1481 else if (size == 16)
1482 retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
1483 else if (size == 32)
1484 retnum = ((unsigned long) s[offset] << 24) +
1485 ((unsigned long) s[offset + 1] << 16) +
1486 (s[offset + 2] << 8) + s[offset+3];
1487 }
79072805
LW
1488 }
1489
1490 sv_setiv(TARG, (I32)retnum);
1491 PUSHs(TARG);
1492 RETURN;
1493}
1494
1495PP(pp_index)
1496{
1497 dSP; dTARGET;
1498 SV *big;
1499 SV *little;
1500 I32 offset;
1501 I32 retval;
1502 char *tmps;
1503 char *tmps2;
463ee0b2 1504 STRLEN biglen;
a0d0e21e 1505 I32 arybase = curcop->cop_arybase;
79072805
LW
1506
1507 if (MAXARG < 3)
1508 offset = 0;
1509 else
1510 offset = POPi - arybase;
1511 little = POPs;
1512 big = POPs;
463ee0b2 1513 tmps = SvPV(big, biglen);
79072805
LW
1514 if (offset < 0)
1515 offset = 0;
93a17b20
LW
1516 else if (offset > biglen)
1517 offset = biglen;
79072805 1518 if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
93a17b20 1519 (unsigned char*)tmps + biglen, little)))
79072805
LW
1520 retval = -1 + arybase;
1521 else
1522 retval = tmps2 - tmps + arybase;
1523 PUSHi(retval);
1524 RETURN;
1525}
1526
1527PP(pp_rindex)
1528{
1529 dSP; dTARGET;
1530 SV *big;
1531 SV *little;
463ee0b2
LW
1532 STRLEN blen;
1533 STRLEN llen;
79072805
LW
1534 SV *offstr;
1535 I32 offset;
1536 I32 retval;
1537 char *tmps;
1538 char *tmps2;
a0d0e21e 1539 I32 arybase = curcop->cop_arybase;
79072805 1540
a0d0e21e 1541 if (MAXARG >= 3)
79072805
LW
1542 offstr = POPs;
1543 little = POPs;
1544 big = POPs;
463ee0b2
LW
1545 tmps2 = SvPV(little, llen);
1546 tmps = SvPV(big, blen);
79072805 1547 if (MAXARG < 3)
463ee0b2 1548 offset = blen;
79072805 1549 else
463ee0b2 1550 offset = SvIV(offstr) - arybase + llen;
79072805
LW
1551 if (offset < 0)
1552 offset = 0;
463ee0b2
LW
1553 else if (offset > blen)
1554 offset = blen;
79072805 1555 if (!(tmps2 = rninstr(tmps, tmps + offset,
463ee0b2 1556 tmps2, tmps2 + llen)))
79072805
LW
1557 retval = -1 + arybase;
1558 else
1559 retval = tmps2 - tmps + arybase;
1560 PUSHi(retval);
1561 RETURN;
1562}
1563
1564PP(pp_sprintf)
1565{
1566 dSP; dMARK; dORIGMARK; dTARGET;
1567 do_sprintf(TARG, SP-MARK, MARK+1);
1568 SP = ORIGMARK;
1569 PUSHTARG;
1570 RETURN;
1571}
1572
79072805
LW
1573PP(pp_ord)
1574{
1575 dSP; dTARGET;
1576 I32 value;
1577 char *tmps;
79072805 1578
79072805 1579#ifndef I286
a0d0e21e 1580 tmps = POPp;
79072805
LW
1581 value = (I32) (*tmps & 255);
1582#else
a0d0e21e
LW
1583 I32 anum;
1584 tmps = POPp;
79072805
LW
1585 anum = (I32) *tmps;
1586 value = (I32) (anum & 255);
1587#endif
1588 XPUSHi(value);
1589 RETURN;
1590}
1591
463ee0b2
LW
1592PP(pp_chr)
1593{
1594 dSP; dTARGET;
1595 char *tmps;
1596
748a9306
LW
1597 (void)SvUPGRADE(TARG,SVt_PV);
1598 SvGROW(TARG,2);
463ee0b2
LW
1599 SvCUR_set(TARG, 1);
1600 tmps = SvPVX(TARG);
748a9306
LW
1601 *tmps++ = POPi;
1602 *tmps = '\0';
a0d0e21e 1603 (void)SvPOK_only(TARG);
463ee0b2
LW
1604 XPUSHs(TARG);
1605 RETURN;
1606}
1607
79072805
LW
1608PP(pp_crypt)
1609{
1610 dSP; dTARGET; dPOPTOPssrl;
1611#ifdef HAS_CRYPT
a0d0e21e 1612 char *tmps = SvPV(left, na);
79072805 1613#ifdef FCRYPT
a0d0e21e 1614 sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
79072805 1615#else
a0d0e21e 1616 sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
79072805
LW
1617#endif
1618#else
1619 DIE(
1620 "The crypt() function is unimplemented due to excessive paranoia.");
1621#endif
1622 SETs(TARG);
1623 RETURN;
1624}
1625
1626PP(pp_ucfirst)
1627{
1628 dSP;
1629 SV *sv = TOPs;
1630 register char *s;
1631
ed6116ce 1632 if (!SvPADTMP(sv)) {
79072805
LW
1633 dTARGET;
1634 sv_setsv(TARG, sv);
1635 sv = TARG;
1636 SETs(sv);
1637 }
a0d0e21e
LW
1638 s = SvPV_force(sv, na);
1639 if (isLOWER(*s))
1640 *s = toUPPER(*s);
79072805
LW
1641
1642 RETURN;
1643}
1644
1645PP(pp_lcfirst)
1646{
1647 dSP;
1648 SV *sv = TOPs;
1649 register char *s;
1650
ed6116ce 1651 if (!SvPADTMP(sv)) {
79072805
LW
1652 dTARGET;
1653 sv_setsv(TARG, sv);
1654 sv = TARG;
1655 SETs(sv);
1656 }
a0d0e21e
LW
1657 s = SvPV_force(sv, na);
1658 if (isUPPER(*s))
1659 *s = toLOWER(*s);
79072805
LW
1660
1661 SETs(sv);
1662 RETURN;
1663}
1664
1665PP(pp_uc)
1666{
1667 dSP;
1668 SV *sv = TOPs;
1669 register char *s;
1670 register char *send;
463ee0b2 1671 STRLEN len;
79072805 1672
ed6116ce 1673 if (!SvPADTMP(sv)) {
79072805
LW
1674 dTARGET;
1675 sv_setsv(TARG, sv);
1676 sv = TARG;
1677 SETs(sv);
1678 }
a0d0e21e 1679 s = SvPV_force(sv, len);
463ee0b2 1680 send = s + len;
79072805 1681 while (s < send) {
a0d0e21e
LW
1682 if (isLOWER(*s))
1683 *s = toUPPER(*s);
79072805
LW
1684 s++;
1685 }
1686 RETURN;
1687}
1688
1689PP(pp_lc)
1690{
1691 dSP;
1692 SV *sv = TOPs;
1693 register char *s;
1694 register char *send;
463ee0b2 1695 STRLEN len;
79072805 1696
ed6116ce 1697 if (!SvPADTMP(sv)) {
79072805
LW
1698 dTARGET;
1699 sv_setsv(TARG, sv);
1700 sv = TARG;
1701 SETs(sv);
1702 }
a0d0e21e 1703 s = SvPV_force(sv, len);
463ee0b2 1704 send = s + len;
79072805 1705 while (s < send) {
a0d0e21e
LW
1706 if (isUPPER(*s))
1707 *s = toLOWER(*s);
79072805
LW
1708 s++;
1709 }
1710 RETURN;
1711}
1712
a0d0e21e 1713PP(pp_quotemeta)
79072805 1714{
a0d0e21e
LW
1715 dSP; dTARGET;
1716 SV *sv = TOPs;
1717 STRLEN len;
1718 register char *s = SvPV(sv,len);
1719 register char *d;
79072805 1720
a0d0e21e
LW
1721 if (len) {
1722 (void)SvUPGRADE(TARG, SVt_PV);
c07a80fd 1723 SvGROW(TARG, (len * 2) + 1);
a0d0e21e
LW
1724 d = SvPVX(TARG);
1725 while (len--) {
1726 if (!isALNUM(*s))
1727 *d++ = '\\';
1728 *d++ = *s++;
79072805 1729 }
a0d0e21e
LW
1730 *d = '\0';
1731 SvCUR_set(TARG, d - SvPVX(TARG));
1732 (void)SvPOK_only(TARG);
79072805 1733 }
a0d0e21e
LW
1734 else
1735 sv_setpvn(TARG, s, len);
1736 SETs(TARG);
79072805
LW
1737 RETURN;
1738}
1739
a0d0e21e 1740/* Arrays. */
79072805 1741
a0d0e21e 1742PP(pp_aslice)
79072805 1743{
a0d0e21e
LW
1744 dSP; dMARK; dORIGMARK;
1745 register SV** svp;
1746 register AV* av = (AV*)POPs;
1747 register I32 lval = op->op_flags & OPf_MOD;
748a9306
LW
1748 I32 arybase = curcop->cop_arybase;
1749 I32 elem;
79072805 1750
a0d0e21e 1751 if (SvTYPE(av) == SVt_PVAV) {
748a9306
LW
1752 if (lval && op->op_private & OPpLVAL_INTRO) {
1753 I32 max = -1;
1754 for (svp = mark + 1; svp <= sp; svp++) {
1755 elem = SvIVx(*svp);
1756 if (elem > max)
1757 max = elem;
1758 }
1759 if (max > AvMAX(av))
1760 av_extend(av, max);
1761 }
a0d0e21e 1762 while (++MARK <= SP) {
748a9306 1763 elem = SvIVx(*MARK);
a0d0e21e 1764
748a9306
LW
1765 if (elem > 0)
1766 elem -= arybase;
a0d0e21e
LW
1767 svp = av_fetch(av, elem, lval);
1768 if (lval) {
1769 if (!svp || *svp == &sv_undef)
1770 DIE(no_aelem, elem);
1771 if (op->op_private & OPpLVAL_INTRO)
1772 save_svref(svp);
79072805 1773 }
a0d0e21e 1774 *MARK = svp ? *svp : &sv_undef;
79072805
LW
1775 }
1776 }
748a9306 1777 if (GIMME != G_ARRAY) {
a0d0e21e
LW
1778 MARK = ORIGMARK;
1779 *++MARK = *SP;
1780 SP = MARK;
1781 }
79072805
LW
1782 RETURN;
1783}
1784
1785/* Associative arrays. */
1786
1787PP(pp_each)
1788{
1789 dSP; dTARGET;
1790 HV *hash = (HV*)POPs;
c07a80fd 1791 HE *entry;
79072805
LW
1792 I32 i;
1793 char *tmps;
c07a80fd
PP
1794
1795 PUTBACK;
1796 entry = hv_iternext(hash); /* might clobber stack_sp */
1797 SPAGAIN;
79072805 1798
79072805
LW
1799 EXTEND(SP, 2);
1800 if (entry) {
c07a80fd 1801 tmps = hv_iterkey(entry, &i); /* won't clobber stack_sp */
8990e307
LW
1802 if (!i)
1803 tmps = "";
1804 PUSHs(sv_2mortal(newSVpv(tmps, i)));
79072805 1805 if (GIMME == G_ARRAY) {
c07a80fd
PP
1806 PUTBACK;
1807 sv_setsv(TARG, hv_iterval(hash, entry)); /* might clobber stack_sp */
1808 SPAGAIN;
8990e307 1809 PUSHs(TARG);
79072805 1810 }
79072805
LW
1811 }
1812 else if (GIMME == G_SCALAR)
1813 RETPUSHUNDEF;
1814
1815 RETURN;
1816}
1817
1818PP(pp_values)
1819{
1820 return do_kv(ARGS);
1821}
1822
1823PP(pp_keys)
1824{
1825 return do_kv(ARGS);
1826}
1827
1828PP(pp_delete)
1829{
1830 dSP;
1831 SV *sv;
1832 SV *tmpsv = POPs;
1833 HV *hv = (HV*)POPs;
1834 char *tmps;
463ee0b2 1835 STRLEN len;
a0d0e21e
LW
1836 if (SvTYPE(hv) != SVt_PVHV) {
1837 DIE("Not a HASH reference");
79072805 1838 }
463ee0b2 1839 tmps = SvPV(tmpsv, len);
748a9306
LW
1840 sv = hv_delete(hv, tmps, len,
1841 op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0);
79072805
LW
1842 if (!sv)
1843 RETPUSHUNDEF;
1844 PUSHs(sv);
1845 RETURN;
1846}
1847
a0d0e21e 1848PP(pp_exists)
79072805 1849{
a0d0e21e
LW
1850 dSP;
1851 SV *tmpsv = POPs;
1852 HV *hv = (HV*)POPs;
1853 char *tmps;
1854 STRLEN len;
1855 if (SvTYPE(hv) != SVt_PVHV) {
1856 DIE("Not a HASH reference");
1857 }
1858 tmps = SvPV(tmpsv, len);
1859 if (hv_exists(hv, tmps, len))
1860 RETPUSHYES;
1861 RETPUSHNO;
1862}
79072805 1863
a0d0e21e
LW
1864PP(pp_hslice)
1865{
1866 dSP; dMARK; dORIGMARK;
1867 register SV **svp;
1868 register HV *hv = (HV*)POPs;
1869 register I32 lval = op->op_flags & OPf_MOD;
79072805 1870
a0d0e21e
LW
1871 if (SvTYPE(hv) == SVt_PVHV) {
1872 while (++MARK <= SP) {
1873 STRLEN keylen;
1874 char *key = SvPV(*MARK, keylen);
79072805 1875
a0d0e21e
LW
1876 svp = hv_fetch(hv, key, keylen, lval);
1877 if (lval) {
1878 if (!svp || *svp == &sv_undef)
1879 DIE(no_helem, key);
1880 if (op->op_private & OPpLVAL_INTRO)
1881 save_svref(svp);
93a17b20 1882 }
a0d0e21e 1883 *MARK = svp ? *svp : &sv_undef;
79072805
LW
1884 }
1885 }
a0d0e21e
LW
1886 if (GIMME != G_ARRAY) {
1887 MARK = ORIGMARK;
1888 *++MARK = *SP;
1889 SP = MARK;
79072805 1890 }
a0d0e21e
LW
1891 RETURN;
1892}
1893
1894/* List operators. */
1895
1896PP(pp_list)
1897{
1898 dSP; dMARK;
1899 if (GIMME != G_ARRAY) {
1900 if (++MARK <= SP)
1901 *MARK = *SP; /* unwanted list, return last item */
8990e307 1902 else
a0d0e21e
LW
1903 *MARK = &sv_undef;
1904 SP = MARK;
79072805 1905 }
a0d0e21e 1906 RETURN;
79072805
LW
1907}
1908
a0d0e21e 1909PP(pp_lslice)
79072805
LW
1910{
1911 dSP;
a0d0e21e
LW
1912 SV **lastrelem = stack_sp;
1913 SV **lastlelem = stack_base + POPMARK;
1914 SV **firstlelem = stack_base + POPMARK + 1;
1915 register SV **firstrelem = lastlelem + 1;
1916 I32 arybase = curcop->cop_arybase;
4633a7c4
LW
1917 I32 lval = op->op_flags & OPf_MOD;
1918 I32 is_something_there = lval;
79072805 1919
a0d0e21e
LW
1920 register I32 max = lastrelem - lastlelem;
1921 register SV **lelem;
1922 register I32 ix;
1923
1924 if (GIMME != G_ARRAY) {
748a9306
LW
1925 ix = SvIVx(*lastlelem);
1926 if (ix < 0)
1927 ix += max;
1928 else
1929 ix -= arybase;
a0d0e21e
LW
1930 if (ix < 0 || ix >= max)
1931 *firstlelem = &sv_undef;
1932 else
1933 *firstlelem = firstrelem[ix];
1934 SP = firstlelem;
1935 RETURN;
1936 }
1937
1938 if (max == 0) {
1939 SP = firstlelem - 1;
1940 RETURN;
1941 }
1942
1943 for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
748a9306 1944 ix = SvIVx(*lelem);
a0d0e21e
LW
1945 if (ix < 0) {
1946 ix += max;
1947 if (ix < 0)
1948 *lelem = &sv_undef;
1949 else if (!(*lelem = firstrelem[ix]))
1950 *lelem = &sv_undef;
79072805 1951 }
748a9306
LW
1952 else {
1953 ix -= arybase;
1954 if (ix >= max || !(*lelem = firstrelem[ix]))
1955 *lelem = &sv_undef;
1956 }
4633a7c4
LW
1957 if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem)))
1958 is_something_there = TRUE;
79072805 1959 }
4633a7c4
LW
1960 if (is_something_there)
1961 SP = lastlelem;
1962 else
1963 SP = firstlelem - 1;
79072805
LW
1964 RETURN;
1965}
1966
a0d0e21e
LW
1967PP(pp_anonlist)
1968{
1969 dSP; dMARK;
1970 I32 items = SP - MARK;
1971 SP = MARK;
1972 XPUSHs((SV*)sv_2mortal((SV*)av_make(items, MARK+1)));
1973 RETURN;
1974}
1975
1976PP(pp_anonhash)
79072805
LW
1977{
1978 dSP; dMARK; dORIGMARK;
a0d0e21e
LW
1979 STRLEN len;
1980 HV* hv = (HV*)sv_2mortal((SV*)newHV());
1981
1982 while (MARK < SP) {
1983 SV* key = *++MARK;
1984 char *tmps;
1985 SV *val = NEWSV(46, 0);
1986 if (MARK < SP)
1987 sv_setsv(val, *++MARK);
1988 else
1989 warn("Odd number of elements in hash list");
1990 tmps = SvPV(key,len);
1991 (void)hv_store(hv,tmps,len,val,0);
79072805 1992 }
a0d0e21e
LW
1993 SP = ORIGMARK;
1994 XPUSHs((SV*)hv);
79072805
LW
1995 RETURN;
1996}
1997
a0d0e21e 1998PP(pp_splice)
79072805 1999{
a0d0e21e
LW
2000 dSP; dMARK; dORIGMARK;
2001 register AV *ary = (AV*)*++MARK;
2002 register SV **src;
2003 register SV **dst;
2004 register I32 i;
2005 register I32 offset;
2006 register I32 length;
2007 I32 newlen;
2008 I32 after;
2009 I32 diff;
2010 SV **tmparyval = 0;
79072805 2011
a0d0e21e 2012 SP++;
79072805 2013
a0d0e21e
LW
2014 if (++MARK < SP) {
2015 offset = SvIVx(*MARK);
2016 if (offset < 0)
2017 offset += AvFILL(ary) + 1;
2018 else
2019 offset -= curcop->cop_arybase;
2020 if (++MARK < SP) {
2021 length = SvIVx(*MARK++);
2022 if (length < 0)
2023 length = 0;
79072805
LW
2024 }
2025 else
a0d0e21e 2026 length = AvMAX(ary) + 1; /* close enough to infinity */
79072805 2027 }
a0d0e21e
LW
2028 else {
2029 offset = 0;
2030 length = AvMAX(ary) + 1;
2031 }
2032 if (offset < 0) {
2033 length += offset;
2034 offset = 0;
2035 if (length < 0)
2036 length = 0;
2037 }
2038 if (offset > AvFILL(ary) + 1)
2039 offset = AvFILL(ary) + 1;
2040 after = AvFILL(ary) + 1 - (offset + length);
2041 if (after < 0) { /* not that much array */
2042 length += after; /* offset+length now in array */
2043 after = 0;
2044 if (!AvALLOC(ary))
2045 av_extend(ary, 0);
2046 }
2047
2048 /* At this point, MARK .. SP-1 is our new LIST */
2049
2050 newlen = SP - MARK;
2051 diff = newlen - length;
2052
2053 if (diff < 0) { /* shrinking the area */
2054 if (newlen) {
2055 New(451, tmparyval, newlen, SV*); /* so remember insertion */
2056 Copy(MARK, tmparyval, newlen, SV*);
79072805 2057 }
a0d0e21e
LW
2058
2059 MARK = ORIGMARK + 1;
2060 if (GIMME == G_ARRAY) { /* copy return vals to stack */
2061 MEXTEND(MARK, length);
2062 Copy(AvARRAY(ary)+offset, MARK, length, SV*);
2063 if (AvREAL(ary)) {
2064 for (i = length, dst = MARK; i; i--)
2065 sv_2mortal(*dst++); /* free them eventualy */
2066 }
2067 MARK += length - 1;
79072805 2068 }
a0d0e21e
LW
2069 else {
2070 *MARK = AvARRAY(ary)[offset+length-1];
2071 if (AvREAL(ary)) {
2072 sv_2mortal(*MARK);
2073 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
2074 SvREFCNT_dec(*dst++); /* free them now */
79072805 2075 }
a0d0e21e
LW
2076 }
2077 AvFILL(ary) += diff;
2078
2079 /* pull up or down? */
2080
2081 if (offset < after) { /* easier to pull up */
2082 if (offset) { /* esp. if nothing to pull */
2083 src = &AvARRAY(ary)[offset-1];
2084 dst = src - diff; /* diff is negative */
2085 for (i = offset; i > 0; i--) /* can't trust Copy */
2086 *dst-- = *src--;
79072805 2087 }
a0d0e21e
LW
2088 dst = AvARRAY(ary);
2089 SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
2090 AvMAX(ary) += diff;
2091 }
2092 else {
2093 if (after) { /* anything to pull down? */
2094 src = AvARRAY(ary) + offset + length;
2095 dst = src + diff; /* diff is negative */
2096 Move(src, dst, after, SV*);
79072805 2097 }
a0d0e21e
LW
2098 dst = &AvARRAY(ary)[AvFILL(ary)+1];
2099 /* avoid later double free */
2100 }
2101 i = -diff;
2102 while (i)
2103 dst[--i] = &sv_undef;
2104
2105 if (newlen) {
2106 for (src = tmparyval, dst = AvARRAY(ary) + offset;
2107 newlen; newlen--) {
2108 *dst = NEWSV(46, 0);
2109 sv_setsv(*dst++, *src++);
79072805 2110 }
a0d0e21e
LW
2111 Safefree(tmparyval);
2112 }
2113 }
2114 else { /* no, expanding (or same) */
2115 if (length) {
2116 New(452, tmparyval, length, SV*); /* so remember deletion */
2117 Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
2118 }
2119
2120 if (diff > 0) { /* expanding */
2121
2122 /* push up or down? */
2123
2124 if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
2125 if (offset) {
2126 src = AvARRAY(ary);
2127 dst = src - diff;
2128 Move(src, dst, offset, SV*);
79072805 2129 }
a0d0e21e
LW
2130 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
2131 AvMAX(ary) += diff;
2132 AvFILL(ary) += diff;
79072805
LW
2133 }
2134 else {
a0d0e21e
LW
2135 if (AvFILL(ary) + diff >= AvMAX(ary)) /* oh, well */
2136 av_extend(ary, AvFILL(ary) + diff);
2137 AvFILL(ary) += diff;
2138
2139 if (after) {
2140 dst = AvARRAY(ary) + AvFILL(ary);
2141 src = dst - diff;
2142 for (i = after; i; i--) {
2143 *dst-- = *src--;
2144 }
79072805
LW
2145 }
2146 }
a0d0e21e
LW
2147 }
2148
2149 for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
2150 *dst = NEWSV(46, 0);
2151 sv_setsv(*dst++, *src++);
2152 }
2153 MARK = ORIGMARK + 1;
2154 if (GIMME == G_ARRAY) { /* copy return vals to stack */
2155 if (length) {
2156 Copy(tmparyval, MARK, length, SV*);
2157 if (AvREAL(ary)) {
2158 for (i = length, dst = MARK; i; i--)
2159 sv_2mortal(*dst++); /* free them eventualy */
79072805 2160 }
a0d0e21e 2161 Safefree(tmparyval);
79072805 2162 }
a0d0e21e
LW
2163 MARK += length - 1;
2164 }
2165 else if (length--) {
2166 *MARK = tmparyval[length];
2167 if (AvREAL(ary)) {
2168 sv_2mortal(*MARK);
2169 while (length-- > 0)
2170 SvREFCNT_dec(tmparyval[length]);
79072805 2171 }
a0d0e21e 2172 Safefree(tmparyval);
79072805 2173 }
a0d0e21e
LW
2174 else
2175 *MARK = &sv_undef;
79072805 2176 }
a0d0e21e 2177 SP = MARK;
79072805
LW
2178 RETURN;
2179}
2180
a0d0e21e 2181PP(pp_push)
79072805
LW
2182{
2183 dSP; dMARK; dORIGMARK; dTARGET;
a0d0e21e
LW
2184 register AV *ary = (AV*)*++MARK;
2185 register SV *sv = &sv_undef;
79072805 2186
a0d0e21e
LW
2187 for (++MARK; MARK <= SP; MARK++) {
2188 sv = NEWSV(51, 0);
2189 if (*MARK)
2190 sv_setsv(sv, *MARK);
2191 av_push(ary, sv);
79072805
LW
2192 }
2193 SP = ORIGMARK;
a0d0e21e 2194 PUSHi( AvFILL(ary) + 1 );
79072805
LW
2195 RETURN;
2196}
2197
a0d0e21e 2198PP(pp_pop)
79072805
LW
2199{
2200 dSP;
a0d0e21e
LW
2201 AV *av = (AV*)POPs;
2202 SV *sv = av_pop(av);
2203 if (sv != &sv_undef && AvREAL(av))
2204 (void)sv_2mortal(sv);
2205 PUSHs(sv);
79072805 2206 RETURN;
79072805
LW
2207}
2208
a0d0e21e 2209PP(pp_shift)
79072805
LW
2210{
2211 dSP;
a0d0e21e
LW
2212 AV *av = (AV*)POPs;
2213 SV *sv = av_shift(av);
79072805 2214 EXTEND(SP, 1);
a0d0e21e 2215 if (!sv)
79072805 2216 RETPUSHUNDEF;
a0d0e21e
LW
2217 if (sv != &sv_undef && AvREAL(av))
2218 (void)sv_2mortal(sv);
2219 PUSHs(sv);
79072805 2220 RETURN;
79072805
LW
2221}
2222
a0d0e21e 2223PP(pp_unshift)
79072805 2224{
a0d0e21e
LW
2225 dSP; dMARK; dORIGMARK; dTARGET;
2226 register AV *ary = (AV*)*++MARK;
2227 register SV *sv;
2228 register I32 i = 0;
79072805 2229
a0d0e21e
LW
2230 av_unshift(ary, SP - MARK);
2231 while (MARK < SP) {
2232 sv = NEWSV(27, 0);
2233 sv_setsv(sv, *++MARK);
2234 (void)av_store(ary, i++, sv);
79072805 2235 }
79072805 2236
a0d0e21e
LW
2237 SP = ORIGMARK;
2238 PUSHi( AvFILL(ary) + 1 );
79072805 2239 RETURN;
79072805
LW
2240}
2241
a0d0e21e 2242PP(pp_reverse)
79072805 2243{
a0d0e21e
LW
2244 dSP; dMARK;
2245 register SV *tmp;
2246 SV **oldsp = SP;
79072805 2247
a0d0e21e
LW
2248 if (GIMME == G_ARRAY) {
2249 MARK++;
2250 while (MARK < SP) {
2251 tmp = *MARK;
2252 *MARK++ = *SP;
2253 *SP-- = tmp;
2254 }
2255 SP = oldsp;
79072805
LW
2256 }
2257 else {
a0d0e21e
LW
2258 register char *up;
2259 register char *down;
2260 register I32 tmp;
2261 dTARGET;
2262 STRLEN len;
79072805 2263
a0d0e21e
LW
2264 if (SP - MARK > 1)
2265 do_join(TARG, &sv_no, MARK, SP);
2266 else
2267 sv_setsv(TARG, *SP);
2268 up = SvPV_force(TARG, len);
2269 if (len > 1) {
2270 down = SvPVX(TARG) + len - 1;
2271 while (down > up) {
2272 tmp = *up;
2273 *up++ = *down;
2274 *down-- = tmp;
2275 }
2276 (void)SvPOK_only(TARG);
79072805 2277 }
a0d0e21e
LW
2278 SP = MARK + 1;
2279 SETTARG;
79072805 2280 }
a0d0e21e 2281 RETURN;
79072805
LW
2282}
2283
a0d0e21e
LW
2284/* Explosives and implosives. */
2285
2286PP(pp_unpack)
79072805
LW
2287{
2288 dSP;
a0d0e21e 2289 dPOPPOPssrl;
ed6116ce 2290 SV *sv;
a0d0e21e
LW
2291 STRLEN llen;
2292 STRLEN rlen;
2293 register char *pat = SvPV(left, llen);
2294 register char *s = SvPV(right, rlen);
2295 char *strend = s + rlen;
2296 char *strbeg = s;
2297 register char *patend = pat + llen;
2298 I32 datumtype;
2299 register I32 len;
2300 register I32 bits;
79072805 2301
a0d0e21e
LW
2302 /* These must not be in registers: */
2303 I16 ashort;
2304 int aint;
2305 I32 along;
ecfc5424
AD
2306#ifdef HAS_QUAD
2307 Quad_t aquad;
a0d0e21e
LW
2308#endif
2309 U16 aushort;
2310 unsigned int auint;
2311 U32 aulong;
ecfc5424
AD
2312#ifdef HAS_QUAD
2313 unsigned Quad_t auquad;
a0d0e21e
LW
2314#endif
2315 char *aptr;
2316 float afloat;
2317 double adouble;
2318 I32 checksum = 0;
2319 register U32 culong;
2320 double cdouble;
2321 static char* bitcount = 0;
79072805 2322
a0d0e21e
LW
2323 if (GIMME != G_ARRAY) { /* arrange to do first one only */
2324 /*SUPPRESS 530*/
2325 for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
748a9306 2326 if (strchr("aAbBhHP", *patend) || *pat == '%') {
a0d0e21e
LW
2327 patend++;
2328 while (isDIGIT(*patend) || *patend == '*')
2329 patend++;
2330 }
2331 else
2332 patend++;
79072805 2333 }
a0d0e21e
LW
2334 while (pat < patend) {
2335 reparse:
2336 datumtype = *pat++;
2337 if (pat >= patend)
2338 len = 1;
2339 else if (*pat == '*') {
2340 len = strend - strbeg; /* long enough */
2341 pat++;
2342 }
2343 else if (isDIGIT(*pat)) {
2344 len = *pat++ - '0';
2345 while (isDIGIT(*pat))
2346 len = (len * 10) + (*pat++ - '0');
2347 }
2348 else
2349 len = (datumtype != '@');
2350 switch(datumtype) {
2351 default:
2352 break;
2353 case '%':
2354 if (len == 1 && pat[-1] != '1')
2355 len = 16;
2356 checksum = len;
2357 culong = 0;
2358 cdouble = 0;
2359 if (pat < patend)
2360 goto reparse;
2361 break;
2362 case '@':
2363 if (len > strend - strbeg)
2364 DIE("@ outside of string");
2365 s = strbeg + len;
2366 break;
2367 case 'X':
2368 if (len > s - strbeg)
2369 DIE("X outside of string");
2370 s -= len;
2371 break;
2372 case 'x':
2373 if (len > strend - s)
2374 DIE("x outside of string");
2375 s += len;
2376 break;
2377 case 'A':
2378 case 'a':
2379 if (len > strend - s)
2380 len = strend - s;
2381 if (checksum)
2382 goto uchar_checksum;
2383 sv = NEWSV(35, len);
2384 sv_setpvn(sv, s, len);
2385 s += len;
2386 if (datumtype == 'A') {
2387 aptr = s; /* borrow register */
2388 s = SvPVX(sv) + len - 1;
2389 while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
2390 s--;
2391 *++s = '\0';
2392 SvCUR_set(sv, s - SvPVX(sv));
2393 s = aptr; /* unborrow register */
2394 }
2395 XPUSHs(sv_2mortal(sv));
2396 break;
2397 case 'B':
2398 case 'b':
2399 if (pat[-1] == '*' || len > (strend - s) * 8)
2400 len = (strend - s) * 8;
2401 if (checksum) {
2402 if (!bitcount) {
2403 Newz(601, bitcount, 256, char);
2404 for (bits = 1; bits < 256; bits++) {
2405 if (bits & 1) bitcount[bits]++;
2406 if (bits & 2) bitcount[bits]++;
2407 if (bits & 4) bitcount[bits]++;
2408 if (bits & 8) bitcount[bits]++;
2409 if (bits & 16) bitcount[bits]++;
2410 if (bits & 32) bitcount[bits]++;
2411 if (bits & 64) bitcount[bits]++;
2412 if (bits & 128) bitcount[bits]++;
2413 }
2414 }
2415 while (len >= 8) {
2416 culong += bitcount[*(unsigned char*)s++];
2417 len -= 8;
2418 }
2419 if (len) {
2420 bits = *s;
2421 if (datumtype == 'b') {
2422 while (len-- > 0) {
2423 if (bits & 1) culong++;
2424 bits >>= 1;
2425 }
2426 }
2427 else {
2428 while (len-- > 0) {
2429 if (bits & 128) culong++;
2430 bits <<= 1;
2431 }
2432 }
2433 }
79072805
LW
2434 break;
2435 }
a0d0e21e
LW
2436 sv = NEWSV(35, len + 1);
2437 SvCUR_set(sv, len);
2438 SvPOK_on(sv);
2439 aptr = pat; /* borrow register */
2440 pat = SvPVX(sv);
2441 if (datumtype == 'b') {
2442 aint = len;
2443 for (len = 0; len < aint; len++) {
2444 if (len & 7) /*SUPPRESS 595*/
2445 bits >>= 1;
2446 else
2447 bits = *s++;
2448 *pat++ = '0' + (bits & 1);
2449 }
2450 }
2451 else {
2452 aint = len;
2453 for (len = 0; len < aint; len++) {
2454 if (len & 7)
2455 bits <<= 1;
2456 else
2457 bits = *s++;
2458 *pat++ = '0' + ((bits & 128) != 0);
2459 }
2460 }
2461 *pat = '\0';
2462 pat = aptr; /* unborrow register */
2463 XPUSHs(sv_2mortal(sv));
2464 break;
2465 case 'H':
2466 case 'h':
2467 if (pat[-1] == '*' || len > (strend - s) * 2)
2468 len = (strend - s) * 2;
2469 sv = NEWSV(35, len + 1);
2470 SvCUR_set(sv, len);
2471 SvPOK_on(sv);
2472 aptr = pat; /* borrow register */
2473 pat = SvPVX(sv);
2474 if (datumtype == 'h') {
2475 aint = len;
2476 for (len = 0; len < aint; len++) {
2477 if (len & 1)
2478 bits >>= 4;
2479 else
2480 bits = *s++;
2481 *pat++ = hexdigit[bits & 15];
2482 }
2483 }
2484 else {
2485 aint = len;
2486 for (len = 0; len < aint; len++) {
2487 if (len & 1)
2488 bits <<= 4;
2489 else
2490 bits = *s++;
2491 *pat++ = hexdigit[(bits >> 4) & 15];
2492 }
2493 }
2494 *pat = '\0';
2495 pat = aptr; /* unborrow register */
2496 XPUSHs(sv_2mortal(sv));
2497 break;
2498 case 'c':
2499 if (len > strend - s)
2500 len = strend - s;
2501 if (checksum) {
2502 while (len-- > 0) {
2503 aint = *s++;
2504 if (aint >= 128) /* fake up signed chars */
2505 aint -= 256;
2506 culong += aint;
2507 }
2508 }
2509 else {
2510 EXTEND(SP, len);
2511 while (len-- > 0) {
2512 aint = *s++;
2513 if (aint >= 128) /* fake up signed chars */
2514 aint -= 256;
2515 sv = NEWSV(36, 0);
2516 sv_setiv(sv, (I32)aint);
2517 PUSHs(sv_2mortal(sv));
2518 }
2519 }
2520 break;
2521 case 'C':
2522 if (len > strend - s)
2523 len = strend - s;
2524 if (checksum) {
2525 uchar_checksum:
2526 while (len-- > 0) {
2527 auint = *s++ & 255;
2528 culong += auint;
2529 }
2530 }
2531 else {
2532 EXTEND(SP, len);
2533 while (len-- > 0) {
2534 auint = *s++ & 255;
2535 sv = NEWSV(37, 0);
2536 sv_setiv(sv, (I32)auint);
2537 PUSHs(sv_2mortal(sv));
2538 }
2539 }
2540 break;
2541 case 's':
2542 along = (strend - s) / sizeof(I16);
2543 if (len > along)
2544 len = along;
2545 if (checksum) {
2546 while (len-- > 0) {
2547 Copy(s, &ashort, 1, I16);
2548 s += sizeof(I16);
2549 culong += ashort;
2550 }
2551 }
2552 else {
2553 EXTEND(SP, len);
2554 while (len-- > 0) {
2555 Copy(s, &ashort, 1, I16);
2556 s += sizeof(I16);
2557 sv = NEWSV(38, 0);
2558 sv_setiv(sv, (I32)ashort);
2559 PUSHs(sv_2mortal(sv));
2560 }
2561 }
2562 break;
2563 case 'v':
2564 case 'n':
2565 case 'S':
2566 along = (strend - s) / sizeof(U16);
2567 if (len > along)
2568 len = along;
2569 if (checksum) {
2570 while (len-- > 0) {
2571 Copy(s, &aushort, 1, U16);
2572 s += sizeof(U16);
2573#ifdef HAS_NTOHS
2574 if (datumtype == 'n')
2575 aushort = ntohs(aushort);
79072805 2576#endif
a0d0e21e
LW
2577#ifdef HAS_VTOHS
2578 if (datumtype == 'v')
2579 aushort = vtohs(aushort);
79072805 2580#endif
a0d0e21e
LW
2581 culong += aushort;
2582 }
2583 }
2584 else {
2585 EXTEND(SP, len);
2586 while (len-- > 0) {
2587 Copy(s, &aushort, 1, U16);
2588 s += sizeof(U16);
2589 sv = NEWSV(39, 0);
2590#ifdef HAS_NTOHS
2591 if (datumtype == 'n')
2592 aushort = ntohs(aushort);
79072805 2593#endif
a0d0e21e
LW
2594#ifdef HAS_VTOHS
2595 if (datumtype == 'v')
2596 aushort = vtohs(aushort);
79072805 2597#endif
a0d0e21e
LW
2598 sv_setiv(sv, (I32)aushort);
2599 PUSHs(sv_2mortal(sv));
2600 }
2601 }
2602 break;
2603 case 'i':
2604 along = (strend - s) / sizeof(int);
2605 if (len > along)
2606 len = along;
2607 if (checksum) {
2608 while (len-- > 0) {
2609 Copy(s, &aint, 1, int);
2610 s += sizeof(int);
2611 if (checksum > 32)
2612 cdouble += (double)aint;
2613 else
2614 culong += aint;
2615 }
2616 }
2617 else {
2618 EXTEND(SP, len);
2619 while (len-- > 0) {
2620 Copy(s, &aint, 1, int);
2621 s += sizeof(int);
2622 sv = NEWSV(40, 0);
2623 sv_setiv(sv, (I32)aint);
2624 PUSHs(sv_2mortal(sv));
2625 }
2626 }
2627 break;
2628 case 'I':
2629 along = (strend - s) / sizeof(unsigned int);
2630 if (len > along)
2631 len = along;
2632 if (checksum) {
2633 while (len-- > 0) {
2634 Copy(s, &auint, 1, unsigned int);
2635 s += sizeof(unsigned int);
2636 if (checksum > 32)
2637 cdouble += (double)auint;
2638 else
2639 culong += auint;
2640 }
2641 }
2642 else {
2643 EXTEND(SP, len);
2644 while (len-- > 0) {
2645 Copy(s, &auint, 1, unsigned int);
2646 s += sizeof(unsigned int);
2647 sv = NEWSV(41, 0);
2648 sv_setiv(sv, (I32)auint);
2649 PUSHs(sv_2mortal(sv));
2650 }
2651 }
2652 break;
2653 case 'l':
2654 along = (strend - s) / sizeof(I32);
2655 if (len > along)
2656 len = along;
2657 if (checksum) {
2658 while (len-- > 0) {
2659 Copy(s, &along, 1, I32);
2660 s += sizeof(I32);
2661 if (checksum > 32)
2662 cdouble += (double)along;
2663 else
2664 culong += along;
2665 }
2666 }
2667 else {
2668 EXTEND(SP, len);
2669 while (len-- > 0) {
2670 Copy(s, &along, 1, I32);
2671 s += sizeof(I32);
2672 sv = NEWSV(42, 0);
2673 sv_setiv(sv, (I32)along);
2674 PUSHs(sv_2mortal(sv));
2675 }
79072805 2676 }
a0d0e21e
LW
2677 break;
2678 case 'V':
2679 case 'N':
2680 case 'L':
2681 along = (strend - s) / sizeof(U32);
2682 if (len > along)
2683 len = along;
2684 if (checksum) {
2685 while (len-- > 0) {
2686 Copy(s, &aulong, 1, U32);
2687 s += sizeof(U32);
2688#ifdef HAS_NTOHL
2689 if (datumtype == 'N')
2690 aulong = ntohl(aulong);
79072805 2691#endif
a0d0e21e
LW
2692#ifdef HAS_VTOHL
2693 if (datumtype == 'V')
2694 aulong = vtohl(aulong);
79072805 2695#endif
a0d0e21e
LW
2696 if (checksum > 32)
2697 cdouble += (double)aulong;
2698 else
2699 culong += aulong;
2700 }
2701 }
2702 else {
2703 EXTEND(SP, len);
2704 while (len-- > 0) {
2705 Copy(s, &aulong, 1, U32);
2706 s += sizeof(U32);
2707 sv = NEWSV(43, 0);
2708#ifdef HAS_NTOHL
2709 if (datumtype == 'N')
2710 aulong = ntohl(aulong);
79072805 2711#endif
a0d0e21e
LW
2712#ifdef HAS_VTOHL
2713 if (datumtype == 'V')
2714 aulong = vtohl(aulong);
79072805 2715#endif
a0d0e21e
LW
2716 sv_setnv(sv, (double)aulong);
2717 PUSHs(sv_2mortal(sv));
2718 }
2719 }
2720 break;
2721 case 'p':
2722 along = (strend - s) / sizeof(char*);
2723 if (len > along)
2724 len = along;
2725 EXTEND(SP, len);
2726 while (len-- > 0) {
2727 if (sizeof(char*) > strend - s)
2728 break;
2729 else {
2730 Copy(s, &aptr, 1, char*);
2731 s += sizeof(char*);
2732 }
2733 sv = NEWSV(44, 0);
2734 if (aptr)
2735 sv_setpv(sv, aptr);
2736 PUSHs(sv_2mortal(sv));
2737 }
2738 break;
2739 case 'P':
2740 EXTEND(SP, 1);
2741 if (sizeof(char*) > strend - s)
2742 break;
2743 else {
2744 Copy(s, &aptr, 1, char*);
2745 s += sizeof(char*);
2746 }
2747 sv = NEWSV(44, 0);
2748 if (aptr)
2749 sv_setpvn(sv, aptr, len);
2750 PUSHs(sv_2mortal(sv));
2751 break;
ecfc5424 2752#ifdef HAS_QUAD
a0d0e21e
LW
2753 case 'q':
2754 EXTEND(SP, len);
2755 while (len-- > 0) {
ecfc5424 2756 if (s + sizeof(Quad_t) > strend)
a0d0e21e
LW
2757 aquad = 0;
2758 else {
ecfc5424
AD
2759 Copy(s, &aquad, 1, Quad_t);
2760 s += sizeof(Quad_t);
a0d0e21e
LW
2761 }
2762 sv = NEWSV(42, 0);
2763 sv_setiv(sv, (IV)aquad);
2764 PUSHs(sv_2mortal(sv));
2765 }
2766 break;
2767 case 'Q':
2768 EXTEND(SP, len);
2769 while (len-- > 0) {
ecfc5424 2770 if (s + sizeof(unsigned Quad_t) > strend)
a0d0e21e
LW
2771 auquad = 0;
2772 else {
ecfc5424
AD
2773 Copy(s, &auquad, 1, unsigned Quad_t);
2774 s += sizeof(unsigned Quad_t);
a0d0e21e
LW
2775 }
2776 sv = NEWSV(43, 0);
2777 sv_setiv(sv, (IV)auquad);
2778 PUSHs(sv_2mortal(sv));
2779 }
2780 break;
79072805 2781#endif
a0d0e21e
LW
2782 /* float and double added gnb@melba.bby.oz.au 22/11/89 */
2783 case 'f':
2784 case 'F':
2785 along = (strend - s) / sizeof(float);
2786 if (len > along)
2787 len = along;
2788 if (checksum) {
2789 while (len-- > 0) {
2790 Copy(s, &afloat, 1, float);
2791 s += sizeof(float);
2792 cdouble += afloat;
2793 }
2794 }
2795 else {
2796 EXTEND(SP, len);
2797 while (len-- > 0) {
2798 Copy(s, &afloat, 1, float);
2799 s += sizeof(float);
2800 sv = NEWSV(47, 0);
2801 sv_setnv(sv, (double)afloat);
2802 PUSHs(sv_2mortal(sv));
2803 }
2804 }
2805 break;
2806 case 'd':
2807 case 'D':
2808 along = (strend - s) / sizeof(double);
2809 if (len > along)
2810 len = along;
2811 if (checksum) {
2812 while (len-- > 0) {
2813 Copy(s, &adouble, 1, double);
2814 s += sizeof(double);
2815 cdouble += adouble;
2816 }
2817 }
2818 else {
2819 EXTEND(SP, len);
2820 while (len-- > 0) {
2821 Copy(s, &adouble, 1, double);
2822 s += sizeof(double);
2823 sv = NEWSV(48, 0);
2824 sv_setnv(sv, (double)adouble);
2825 PUSHs(sv_2mortal(sv));
2826 }
2827 }
2828 break;
2829 case 'u':
2830 along = (strend - s) * 3 / 4;
2831 sv = NEWSV(42, along);
2832 while (s < strend && *s > ' ' && *s < 'a') {
2833 I32 a, b, c, d;
2834 char hunk[4];
79072805 2835
a0d0e21e
LW
2836 hunk[3] = '\0';
2837 len = (*s++ - ' ') & 077;
2838 while (len > 0) {
2839 if (s < strend && *s >= ' ')
2840 a = (*s++ - ' ') & 077;
2841 else
2842 a = 0;
2843 if (s < strend && *s >= ' ')
2844 b = (*s++ - ' ') & 077;
2845 else
2846 b = 0;
2847 if (s < strend && *s >= ' ')
2848 c = (*s++ - ' ') & 077;
2849 else
2850 c = 0;
2851 if (s < strend && *s >= ' ')
2852 d = (*s++ - ' ') & 077;
2853 else
2854 d = 0;
2855 hunk[0] = a << 2 | b >> 4;
2856 hunk[1] = b << 4 | c >> 2;
2857 hunk[2] = c << 6 | d;
2858 sv_catpvn(sv, hunk, len > 3 ? 3 : len);
2859 len -= 3;
2860 }
2861 if (*s == '\n')
2862 s++;
2863 else if (s[1] == '\n') /* possible checksum byte */
2864 s += 2;
79072805 2865 }
a0d0e21e
LW
2866 XPUSHs(sv_2mortal(sv));
2867 break;
79072805 2868 }
a0d0e21e
LW
2869 if (checksum) {
2870 sv = NEWSV(42, 0);
2871 if (strchr("fFdD", datumtype) ||
2872 (checksum > 32 && strchr("iIlLN", datumtype)) ) {
2873 double trouble;
79072805 2874
a0d0e21e
LW
2875 adouble = 1.0;
2876 while (checksum >= 16) {
2877 checksum -= 16;
2878 adouble *= 65536.0;
2879 }
2880 while (checksum >= 4) {
2881 checksum -= 4;
2882 adouble *= 16.0;
2883 }
2884 while (checksum--)
2885 adouble *= 2.0;
2886 along = (1 << checksum) - 1;
2887 while (cdouble < 0.0)
2888 cdouble += adouble;
2889 cdouble = modf(cdouble / adouble, &trouble) * adouble;
2890 sv_setnv(sv, cdouble);
2891 }
2892 else {
2893 if (checksum < 32) {
2894 along = (1 << checksum) - 1;
2895 culong &= (U32)along;
2896 }
2897 sv_setnv(sv, (double)culong);
2898 }
2899 XPUSHs(sv_2mortal(sv));
2900 checksum = 0;
79072805 2901 }
79072805 2902 }
79072805 2903 RETURN;
79072805
LW
2904}
2905
a0d0e21e
LW
2906static void
2907doencodes(sv, s, len)
2908register SV *sv;
2909register char *s;
2910register I32 len;
79072805 2911{
a0d0e21e 2912 char hunk[5];
79072805 2913
a0d0e21e
LW
2914 *hunk = len + ' ';
2915 sv_catpvn(sv, hunk, 1);
2916 hunk[4] = '\0';
2917 while (len > 0) {
2918 hunk[0] = ' ' + (077 & (*s >> 2));
2919 hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
2920 hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
2921 hunk[3] = ' ' + (077 & (s[2] & 077));
2922 sv_catpvn(sv, hunk, 4);
2923 s += 3;
2924 len -= 3;
2925 }
2926 for (s = SvPVX(sv); *s; s++) {
2927 if (*s == ' ')
2928 *s = '`';
2929 }
2930 sv_catpvn(sv, "\n", 1);
79072805
LW
2931}
2932
a0d0e21e 2933PP(pp_pack)
79072805 2934{
a0d0e21e
LW
2935 dSP; dMARK; dORIGMARK; dTARGET;
2936 register SV *cat = TARG;
2937 register I32 items;
2938 STRLEN fromlen;
2939 register char *pat = SvPVx(*++MARK, fromlen);
2940 register char *patend = pat + fromlen;
2941 register I32 len;
2942 I32 datumtype;
2943 SV *fromstr;
2944 /*SUPPRESS 442*/
2945 static char null10[] = {0,0,0,0,0,0,0,0,0,0};
2946 static char *space10 = " ";
79072805 2947
a0d0e21e
LW
2948 /* These must not be in registers: */
2949 char achar;
2950 I16 ashort;
2951 int aint;
2952 unsigned int auint;
2953 I32 along;
2954 U32 aulong;
ecfc5424
AD
2955#ifdef HAS_QUAD
2956 Quad_t aquad;
2957 unsigned Quad_t auquad;
79072805 2958#endif
a0d0e21e
LW
2959 char *aptr;
2960 float afloat;
2961 double adouble;
79072805 2962
a0d0e21e
LW
2963 items = SP - MARK;
2964 MARK++;
2965 sv_setpvn(cat, "", 0);
2966 while (pat < patend) {
2967#define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
2968 datumtype = *pat++;
2969 if (*pat == '*') {
2970 len = strchr("@Xxu", datumtype) ? 0 : items;
2971 pat++;
2972 }
2973 else if (isDIGIT(*pat)) {
2974 len = *pat++ - '0';
2975 while (isDIGIT(*pat))
2976 len = (len * 10) + (*pat++ - '0');
2977 }
2978 else
2979 len = 1;
2980 switch(datumtype) {
2981 default:
2982 break;
2983 case '%':
2984 DIE("%% may only be used in unpack");
2985 case '@':
2986 len -= SvCUR(cat);
2987 if (len > 0)
2988 goto grow;
2989 len = -len;
2990 if (len > 0)
2991 goto shrink;
2992 break;
2993 case 'X':
2994 shrink:
2995 if (SvCUR(cat) < len)
2996 DIE("X outside of string");
2997 SvCUR(cat) -= len;
2998 *SvEND(cat) = '\0';
2999 break;
3000 case 'x':
3001 grow:
3002 while (len >= 10) {
3003 sv_catpvn(cat, null10, 10);
3004 len -= 10;
3005 }
3006 sv_catpvn(cat, null10, len);
3007 break;
3008 case 'A':
3009 case 'a':
3010 fromstr = NEXTFROM;
3011 aptr = SvPV(fromstr, fromlen);
3012 if (pat[-1] == '*')
3013 len = fromlen;
3014 if (fromlen > len)
3015 sv_catpvn(cat, aptr, len);
3016 else {
3017 sv_catpvn(cat, aptr, fromlen);
3018 len -= fromlen;
3019 if (datumtype == 'A') {
3020 while (len >= 10) {
3021 sv_catpvn(cat, space10, 10);
3022 len -= 10;
3023 }
3024 sv_catpvn(cat, space10, len);
3025 }
3026 else {
3027 while (len >= 10) {
3028 sv_catpvn(cat, null10, 10);
3029 len -= 10;
3030 }
3031 sv_catpvn(cat, null10, len);
3032 }
3033 }
3034 break;
3035 case 'B':
3036 case 'b':
3037 {
3038 char *savepat = pat;
3039 I32 saveitems;
79072805 3040
a0d0e21e
LW
3041 fromstr = NEXTFROM;
3042 saveitems = items;
3043 aptr = SvPV(fromstr, fromlen);
3044 if (pat[-1] == '*')
3045 len = fromlen;
3046 pat = aptr;
3047 aint = SvCUR(cat);
3048 SvCUR(cat) += (len+7)/8;
3049 SvGROW(cat, SvCUR(cat) + 1);
3050 aptr = SvPVX(cat) + aint;
3051 if (len > fromlen)
3052 len = fromlen;
3053 aint = len;
3054 items = 0;
3055 if (datumtype == 'B') {
3056 for (len = 0; len++ < aint;) {
3057 items |= *pat++ & 1;
3058 if (len & 7)
3059 items <<= 1;
3060 else {
3061 *aptr++ = items & 0xff;
3062 items = 0;
3063 }
3064 }
3065 }
3066 else {
3067 for (len = 0; len++ < aint;) {
3068 if (*pat++ & 1)
3069 items |= 128;
3070 if (len & 7)
3071 items >>= 1;
3072 else {
3073 *aptr++ = items & 0xff;
3074 items = 0;
3075 }
3076 }
3077 }
3078 if (aint & 7) {
3079 if (datumtype == 'B')
3080 items <<= 7 - (aint & 7);
3081 else
3082 items >>= 7 - (aint & 7);
3083 *aptr++ = items & 0xff;
3084 }
3085 pat = SvPVX(cat) + SvCUR(cat);
3086 while (aptr <= pat)
3087 *aptr++ = '\0';
79072805 3088
a0d0e21e
LW
3089 pat = savepat;
3090 items = saveitems;
3091 }
3092 break;
3093 case 'H':
3094 case 'h':
3095 {
3096 char *savepat = pat;
3097 I32 saveitems;
79072805 3098
a0d0e21e
LW
3099 fromstr = NEXTFROM;
3100 saveitems = items;
3101 aptr = SvPV(fromstr, fromlen);
3102 if (pat[-1] == '*')
3103 len = fromlen;
3104 pat = aptr;
3105 aint = SvCUR(cat);
3106 SvCUR(cat) += (len+1)/2;
3107 SvGROW(cat, SvCUR(cat) + 1);
3108 aptr = SvPVX(cat) + aint;
3109 if (len > fromlen)
3110 len = fromlen;
3111 aint = len;
3112 items = 0;
3113 if (datumtype == 'H') {
3114 for (len = 0; len++ < aint;) {
3115 if (isALPHA(*pat))
3116 items |= ((*pat++ & 15) + 9) & 15;
3117 else
3118 items |= *pat++ & 15;
3119 if (len & 1)
3120 items <<= 4;
3121 else {
3122 *aptr++ = items & 0xff;
3123 items = 0;
3124 }
3125 }
3126 }
3127 else {
3128 for (len = 0; len++ < aint;) {
3129 if (isALPHA(*pat))
3130 items |= (((*pat++ & 15) + 9) & 15) << 4;
3131 else
3132 items |= (*pat++ & 15) << 4;
3133 if (len & 1)
3134 items >>= 4;
3135 else {
3136 *aptr++ = items & 0xff;
3137 items = 0;
3138 }
3139 }
3140 }
3141 if (aint & 1)
3142 *aptr++ = items & 0xff;
3143 pat = SvPVX(cat) + SvCUR(cat);
3144 while (aptr <= pat)
3145 *aptr++ = '\0';
79072805 3146
a0d0e21e
LW
3147 pat = savepat;
3148 items = saveitems;
3149 }
3150 break;
3151 case 'C':
3152 case 'c':
3153 while (len-- > 0) {
3154 fromstr = NEXTFROM;
3155 aint = SvIV(fromstr);
3156 achar = aint;
3157 sv_catpvn(cat, &achar, sizeof(char));
3158 }
3159 break;
3160 /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */
3161 case 'f':
3162 case 'F':
3163 while (len-- > 0) {
3164 fromstr = NEXTFROM;
3165 afloat = (float)SvNV(fromstr);
3166 sv_catpvn(cat, (char *)&afloat, sizeof (float));
3167 }
3168 break;
3169 case 'd':
3170 case 'D':
3171 while (len-- > 0) {
3172 fromstr = NEXTFROM;
3173 adouble = (double)SvNV(fromstr);
3174 sv_catpvn(cat, (char *)&adouble, sizeof (double));
3175 }
3176 break;
3177 case 'n':
3178 while (len-- > 0) {
3179 fromstr = NEXTFROM;
3180 ashort = (I16)SvIV(fromstr);
3181#ifdef HAS_HTONS
3182 ashort = htons(ashort);
79072805 3183#endif
a0d0e21e
LW
3184 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3185 }
3186 break;
3187 case 'v':
3188 while (len-- > 0) {
3189 fromstr = NEXTFROM;
3190 ashort = (I16)SvIV(fromstr);
3191#ifdef HAS_HTOVS
3192 ashort = htovs(ashort);
79072805 3193#endif
a0d0e21e
LW
3194 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3195 }
3196 break;
3197 case 'S':
3198 case 's':
3199 while (len-- > 0) {
3200 fromstr = NEXTFROM;
3201 ashort = (I16)SvIV(fromstr);
3202 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3203 }
3204 break;
3205 case 'I':
3206 while (len-- > 0) {
3207 fromstr = NEXTFROM;
3208 auint = U_I(SvNV(fromstr));
3209 sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
3210 }
3211 break;
3212 case 'i':
3213 while (len-- > 0) {
3214 fromstr = NEXTFROM;
3215 aint = SvIV(fromstr);
3216 sv_catpvn(cat, (char*)&aint, sizeof(int));
3217 }
3218 break;
3219 case 'N':
3220 while (len-- > 0) {
3221 fromstr = NEXTFROM;
3222 aulong = U_L(SvNV(fromstr));
3223#ifdef HAS_HTONL
3224 aulong = htonl(aulong);
79072805 3225#endif
a0d0e21e
LW
3226 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3227 }
3228 break;
3229 case 'V':
3230 while (len-- > 0) {
3231 fromstr = NEXTFROM;
3232 aulong = U_L(SvNV(fromstr));
3233#ifdef HAS_HTOVL
3234 aulong = htovl(aulong);
79072805 3235#endif
a0d0e21e
LW
3236 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3237 }
3238 break;
3239 case 'L':
3240 while (len-- > 0) {
3241 fromstr = NEXTFROM;
3242 aulong = U_L(SvNV(fromstr));
3243 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3244 }
3245 break;
3246 case 'l':
3247 while (len-- > 0) {
3248 fromstr = NEXTFROM;
3249 along = SvIV(fromstr);
3250 sv_catpvn(cat, (char*)&along, sizeof(I32));
3251 }
3252 break;
ecfc5424 3253#ifdef HAS_QUAD
a0d0e21e
LW
3254 case 'Q':
3255 while (len-- > 0) {
3256 fromstr = NEXTFROM;
ecfc5424
AD
3257 auquad = (unsigned Quad_t)SvIV(fromstr);
3258 sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
a0d0e21e
LW
3259 }
3260 break;
3261 case 'q':
3262 while (len-- > 0) {
3263 fromstr = NEXTFROM;
ecfc5424
AD
3264 aquad = (Quad_t)SvIV(fromstr);
3265 sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
a0d0e21e
LW
3266 }
3267 break;
ecfc5424 3268#endif /* HAS_QUAD */
a0d0e21e
LW
3269 case 'P':
3270 len = 1; /* assume SV is correct length */
3271 /* FALL THROUGH */
3272 case 'p':
3273 while (len-- > 0) {
3274 fromstr = NEXTFROM;
3275 aptr = SvPV_force(fromstr, na); /* XXX Error if TEMP? */
3276 sv_catpvn(cat, (char*)&aptr, sizeof(char*));
3277 }
3278 break;
3279 case 'u':
3280 fromstr = NEXTFROM;
3281 aptr = SvPV(fromstr, fromlen);
3282 SvGROW(cat, fromlen * 4 / 3);
3283 if (len <= 1)
3284 len = 45;
3285 else
3286 len = len / 3 * 3;
3287 while (fromlen > 0) {
3288 I32 todo;
79072805 3289
a0d0e21e
LW
3290 if (fromlen > len)
3291 todo = len;
3292 else
3293 todo = fromlen;
3294 doencodes(cat, aptr, todo);
3295 fromlen -= todo;
3296 aptr += todo;
3297 }
3298 break;
3299 }
3300 }
3301 SvSETMAGIC(cat);
3302 SP = ORIGMARK;
3303 PUSHs(cat);
3304 RETURN;
79072805 3305}
a0d0e21e 3306#undef NEXTFROM
79072805 3307
a0d0e21e 3308PP(pp_split)
79072805 3309{
a0d0e21e
LW
3310 dSP; dTARG;
3311 AV *ary;
3312 register I32 limit = POPi; /* note, negative is forever */
3313 SV *sv = POPs;
3314 STRLEN len;
3315 register char *s = SvPV(sv, len);
3316 char *strend = s + len;
3317 register PMOP *pm = (PMOP*)POPs;
3318 register SV *dstr;
3319 register char *m;
3320 I32 iters = 0;
3321 I32 maxiters = (strend - s) + 10;
3322 I32 i;
3323 char *orig;
3324 I32 origlimit = limit;
3325 I32 realarray = 0;
3326 I32 base;
3327 AV *oldstack = stack;
3328 register REGEXP *rx = pm->op_pmregexp;
3329 I32 gimme = GIMME;
c07a80fd 3330 I32 oldsave = savestack_ix;
79072805 3331
a0d0e21e
LW
3332 if (!pm || !s)
3333 DIE("panic: do_split");
3334 if (pm->op_pmreplroot)
3335 ary = GvAVn((GV*)pm->op_pmreplroot);
3336 else if (gimme != G_ARRAY)
3337 ary = GvAVn(defgv);
79072805 3338 else
a0d0e21e
LW
3339 ary = Nullav;
3340 if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
3341 realarray = 1;
3342 if (!AvREAL(ary)) {
3343 AvREAL_on(ary);
3344 for (i = AvFILL(ary); i >= 0; i--)
3345 AvARRAY(ary)[i] = &sv_undef; /* don't free mere refs */
79072805 3346 }
a0d0e21e
LW
3347 av_extend(ary,0);
3348 av_clear(ary);
3349 /* temporarily switch stacks */
3350 SWITCHSTACK(stack, ary);
79072805 3351 }
a0d0e21e
LW
3352 base = SP - stack_base;
3353 orig = s;
3354 if (pm->op_pmflags & PMf_SKIPWHITE) {
3355 while (isSPACE(*s))
3356 s++;
3357 }
c07a80fd
PP
3358 if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
3359 SAVEINT(multiline);
3360 multiline = pm->op_pmflags & PMf_MULTILINE;
3361 }
3362
a0d0e21e
LW
3363 if (!limit)
3364 limit = maxiters + 2;
3365 if (pm->op_pmflags & PMf_WHITE) {
3366 while (--limit) {
3367 /*SUPPRESS 530*/
3368 for (m = s; m < strend && !isSPACE(*m); m++) ;
3369 if (m >= strend)
3370 break;
3371 dstr = NEWSV(30, m-s);
3372 sv_setpvn(dstr, s, m-s);
3373 if (!realarray)
3374 sv_2mortal(dstr);
3375 XPUSHs(dstr);
3376 /*SUPPRESS 530*/
3377 for (s = m + 1; s < strend && isSPACE(*s); s++) ;
79072805
LW
3378 }
3379 }
a0d0e21e
LW
3380 else if (strEQ("^", rx->precomp)) {
3381 while (--limit) {
3382 /*SUPPRESS 530*/
3383 for (m = s; m < strend && *m != '\n'; m++) ;
3384 m++;
3385 if (m >= strend)
3386 break;
3387 dstr = NEWSV(30, m-s);
3388 sv_setpvn(dstr, s, m-s);
3389 if (!realarray)
3390 sv_2mortal(dstr);
3391 XPUSHs(dstr);
3392 s = m;
3393 }
3394 }
3395 else if (pm->op_pmshort) {
3396 i = SvCUR(pm->op_pmshort);
3397 if (i == 1) {
3398 I32 fold = (pm->op_pmflags & PMf_FOLD);
3399 i = *SvPVX(pm->op_pmshort);
3400 if (fold && isUPPER(i))
3401 i = toLOWER(i);
3402 while (--limit) {
3403 if (fold) {
3404 for ( m = s;
3405 m < strend && *m != i &&
3406 (!isUPPER(*m) || toLOWER(*m) != i);
3407 m++) /*SUPPRESS 530*/
3408 ;
3409 }
3410 else /*SUPPRESS 530*/
3411 for (m = s; m < strend && *m != i; m++) ;
3412 if (m >= strend)
3413 break;
3414 dstr = NEWSV(30, m-s);
3415 sv_setpvn(dstr, s, m-s);
3416 if (!realarray)
3417 sv_2mortal(dstr);
3418 XPUSHs(dstr);
3419 s = m + 1;
3420 }
3421 }
3422 else {
3423#ifndef lint
3424 while (s < strend && --limit &&
3425 (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
3426 pm->op_pmshort)) )
79072805 3427#endif
a0d0e21e
LW
3428 {
3429 dstr = NEWSV(31, m-s);
3430 sv_setpvn(dstr, s, m-s);
3431 if (!realarray)
3432 sv_2mortal(dstr);
3433 XPUSHs(dstr);
3434 s = m + i;
3435 }
463ee0b2 3436 }
463ee0b2 3437 }
a0d0e21e
LW
3438 else {
3439 maxiters += (strend - s) * rx->nparens;
3440 while (s < strend && --limit &&
e50aee73 3441 pregexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
a0d0e21e
LW
3442 if (rx->subbase
3443 && rx->subbase != orig) {
3444 m = s;
3445 s = orig;
3446 orig = rx->subbase;
3447 s = orig + (m - s);
3448 strend = s + (strend - m);
3449 }
3450 m = rx->startp[0];
3451 dstr = NEWSV(32, m-s);
3452 sv_setpvn(dstr, s, m-s);
3453 if (!realarray)
3454 sv_2mortal(dstr);
3455 XPUSHs(dstr);
3456 if (rx->nparens) {
3457 for (i = 1; i <= rx->nparens; i++) {
3458 s = rx->startp[i];
3459 m = rx->endp[i];
748a9306
LW
3460 if (m && s) {
3461 dstr = NEWSV(33, m-s);
3462 sv_setpvn(dstr, s, m-s);
3463 }
3464 else
3465 dstr = NEWSV(33, 0);
a0d0e21e
LW
3466 if (!realarray)
3467 sv_2mortal(dstr);
3468 XPUSHs(dstr);
3469 }
3470 }
3471 s = rx->endp[0];
3472 }
79072805 3473 }
c07a80fd 3474 LEAVE_SCOPE(oldsave);
a0d0e21e
LW
3475 iters = (SP - stack_base) - base;
3476 if (iters > maxiters)
3477 DIE("Split loop");
3478
3479 /* keep field after final delim? */
3480 if (s < strend || (iters && origlimit)) {
3481 dstr = NEWSV(34, strend-s);
3482 sv_setpvn(dstr, s, strend-s);
3483 if (!realarray)
3484 sv_2mortal(dstr);
3485 XPUSHs(dstr);
3486 iters++;
79072805 3487 }
a0d0e21e
LW
3488 else if (!origlimit) {
3489 while (iters > 0 && SvCUR(TOPs) == 0)
3490 iters--, SP--;
3491 }
3492 if (realarray) {
3493 SWITCHSTACK(ary, oldstack);
3494 if (gimme == G_ARRAY) {
3495 EXTEND(SP, iters);
3496 Copy(AvARRAY(ary), SP + 1, iters, SV*);
3497 SP += iters;
3498 RETURN;
3499 }
3500 }
3501 else {
3502 if (gimme == G_ARRAY)
3503 RETURN;
3504 }
3505 if (iters || !pm->op_pmreplroot) {
3506 GETTARGET;
3507 PUSHi(iters);
3508 RETURN;
3509 }
3510 RETPUSHUNDEF;
79072805 3511}
85e6fe83 3512