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