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