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