This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.0 alpha 5
[perl5.git] / pp.c
1 /***********************************************************
2  *
3  * $Header: /usr/src/local/lwall/perl5/RCS/pp.c, v 4.1 92/08/07 18:26:21 lwall Exp Locker: lwall $
4  *
5  * Description:
6  *      Push/Pop code.
7  *
8  * Standards:
9  *
10  * Created:
11  *      Mon Jun 15 16:45:59 1992
12  *
13  * Author:
14  *      Larry Wall <lwall@netlabs.com>
15  *
16  * $Log:        pp.c, v $
17  * Revision 4.1  92/08/07  18:26:21  lwall
18  * 
19  *
20  **********************************************************/
21
22 #include "EXTERN.h"
23 #include "perl.h"
24
25 #ifdef HAS_SOCKET
26 #include <sys/socket.h>
27 #include <netdb.h>
28 #ifndef ENOTSOCK
29 #include <net/errno.h>
30 #endif
31 #endif
32
33 #ifdef HAS_SELECT
34 #ifdef I_SYS_SELECT
35 #ifndef I_SYS_TIME
36 #include <sys/select.h>
37 #endif
38 #endif
39 #endif
40
41 #ifdef HOST_NOT_FOUND
42 extern int h_errno;
43 #endif
44
45 #ifdef I_PWD
46 #include <pwd.h>
47 #endif
48 #ifdef I_GRP
49 #include <grp.h>
50 #endif
51 #ifdef I_UTIME
52 #include <utime.h>
53 #endif
54 #ifdef I_FCNTL
55 #include <fcntl.h>
56 #endif
57 #ifdef I_SYS_FILE
58 #include <sys/file.h>
59 #endif
60
61 #ifdef I_VARARGS
62 #  include <varargs.h>
63 #endif
64
65 static I32 dopoptosub P((I32 startingblock));
66
67 /* Nothing. */
68
69 PP(pp_null)
70 {
71     return NORMAL;
72 }
73
74 PP(pp_stub)
75 {
76     dSP;
77     if (GIMME != G_ARRAY) {
78         XPUSHs(&sv_undef);
79     }
80     RETURN;
81 }
82
83 PP(pp_scalar)
84 {
85     return NORMAL;
86 }
87
88 /* Pushy stuff. */
89
90 PP(pp_pushmark)
91 {
92     if (++markstack_ptr == markstack_max) {
93         I32 oldmax = markstack_max - markstack;
94         I32 newmax = oldmax * 3 / 2;
95
96         Renew(markstack, newmax, I32);
97         markstack_ptr = markstack + oldmax;
98         markstack_max = markstack + newmax;
99     }
100     *markstack_ptr = stack_sp - stack_base;
101     return NORMAL;
102 }
103
104 PP(pp_wantarray)
105 {
106     dSP;
107     I32 cxix;
108     EXTEND(SP, 1);
109
110     cxix = dopoptosub(cxstack_ix);
111     if (cxix < 0)
112         RETPUSHUNDEF;
113
114     if (cxstack[cxix].blk_gimme == G_ARRAY)
115         RETPUSHYES;
116     else
117         RETPUSHNO;
118 }
119
120 PP(pp_const)
121 {
122     dSP;
123     XPUSHs(cSVOP->op_sv);
124     RETURN;
125 }
126
127 static void
128 ucase(s,send)
129 register char *s;
130 register char *send;
131 {
132     while (s < send) {
133         if (isLOWER(*s))
134             *s = toupper(*s);
135         s++;
136     }
137 }
138
139 static void
140 lcase(s,send)
141 register char *s;
142 register char *send;
143 {
144     while (s < send) {
145         if (isUPPER(*s))
146             *s = tolower(*s);
147         s++;
148     }
149 }
150
151 PP(pp_interp)
152 {
153     DIE("panic: pp_interp");
154 }
155
156 PP(pp_gvsv)
157 {
158     dSP;
159     EXTEND(sp,1);
160     if (op->op_flags & OPf_INTRO)
161         PUSHs(save_scalar(cGVOP->op_gv));
162     else
163         PUSHs(GvSV(cGVOP->op_gv));
164     RETURN;
165 }
166
167 PP(pp_gv)
168 {
169     dSP;
170     XPUSHs((SV*)cGVOP->op_gv);
171     RETURN;
172 }
173
174 PP(pp_padsv)
175 {
176     dSP; dTARGET;
177     XPUSHs(TARG);
178     if ((op->op_flags & (OPf_INTRO|OPf_SPECIAL)) == OPf_INTRO)
179         SvOK_off(TARG);
180     RETURN;
181 }
182
183 PP(pp_padav)
184 {
185     dSP; dTARGET;
186     XPUSHs(TARG);
187     if ((op->op_flags & (OPf_INTRO|OPf_SPECIAL)) == OPf_INTRO)
188         av_clear((AV*)TARG);
189     if (op->op_flags & OPf_LVAL)
190         RETURN;
191     PUTBACK;
192     return pp_rv2av();
193 }
194
195 PP(pp_padhv)
196 {
197     dSP; dTARGET;
198     XPUSHs(TARG);
199     if ((op->op_flags & (OPf_INTRO|OPf_SPECIAL)) == OPf_INTRO)
200         hv_clear((HV*)TARG);
201     if (op->op_flags & OPf_LVAL)
202         RETURN;
203     PUTBACK;
204     return pp_rv2hv();
205 }
206
207 PP(pp_padany)
208 {
209     DIE("NOT IMPL LINE %d",__LINE__);
210 }
211
212 PP(pp_pushre)
213 {
214     dSP;
215     XPUSHs((SV*)op);
216     RETURN;
217 }
218
219 /* Translations. */
220
221 PP(pp_rv2gv)
222 {
223     dSP; dTOPss;
224     if (SvROK(sv)) {
225         sv = SvRV(sv);
226         if (SvTYPE(sv) != SVt_PVGV)
227             DIE("Not a glob reference");
228     }
229     else {
230         if (SvTYPE(sv) != SVt_PVGV) {
231             if (!SvOK(sv))
232                 DIE(no_usym);
233             sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE);
234         }
235     }
236     if (op->op_flags & OPf_INTRO) {
237         GP *ogp = GvGP(sv);
238
239         SSCHECK(3);
240         SSPUSHPTR(sv);
241         SSPUSHPTR(ogp);
242         SSPUSHINT(SAVEt_GP);
243
244         if (op->op_flags & OPf_SPECIAL)
245             GvGP(sv)->gp_refcnt++;              /* will soon be assigned */
246         else {
247             GP *gp;
248             Newz(602,gp, 1, GP);
249             GvGP(sv) = gp;
250             GvREFCNT(sv) = 1;
251             GvSV(sv) = NEWSV(72,0);
252             GvLINE(sv) = curcop->cop_line;
253             GvEGV(sv) = sv;
254         }
255     }
256     SETs(sv);
257     RETURN;
258 }
259
260 PP(pp_sv2len)
261 {
262     dSP; dTARGET;
263     dPOPss;
264     PUSHi(sv_len(sv));
265     RETURN;
266 }
267
268 PP(pp_rv2sv)
269 {
270     dSP; dTOPss;
271
272     if (SvROK(sv)) {
273         sv = SvRV(sv);
274         switch (SvTYPE(sv)) {
275         case SVt_PVAV:
276         case SVt_PVHV:
277         case SVt_PVCV:
278             DIE("Not a scalar reference");
279         }
280     }
281     else {
282         GV *gv = sv;
283         if (SvTYPE(gv) != SVt_PVGV) {
284             if (!SvOK(sv))
285                 DIE(no_usym);
286             gv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE);
287         }
288         sv = GvSV(gv);
289         if (op->op_private == OP_RV2HV &&
290           (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVHV)) {
291             sv_free(sv);
292             sv = NEWSV(0,0);
293             sv_upgrade(sv, SVt_RV);
294             SvRV(sv) = sv_ref((SV*)newHV());
295             SvROK_on(sv);
296             GvSV(gv) = sv;
297         }
298         else if (op->op_private == OP_RV2AV &&
299           (!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV)) {
300             sv_free(sv);
301             sv = NEWSV(0,0);
302             sv_upgrade(sv, SVt_RV);
303             SvRV(sv) = sv_ref((SV*)newAV());
304             SvROK_on(sv);
305             GvSV(gv) = sv;
306         }
307     }
308     if (op->op_flags & OPf_INTRO)
309         SETs(save_scalar((GV*)TOPs));
310     else
311         SETs(sv);
312     RETURN;
313 }
314
315 PP(pp_av2arylen)
316 {
317     dSP;
318     AV *av = (AV*)TOPs;
319     SV *sv = AvARYLEN(av);
320     if (!sv) {
321         AvARYLEN(av) = sv = NEWSV(0,0);
322         sv_upgrade(sv, SVt_IV);
323         sv_magic(sv, (SV*)av, '#', Nullch, 0);
324     }
325     SETs(sv);
326     RETURN;
327 }
328
329 PP(pp_rv2cv)
330 {
331     dSP;
332     SV *sv;
333     GV *gv;
334     HV *stash;
335     CV *cv = sv_2cv(TOPs, &stash, &gv, 0);
336
337     SETs((SV*)cv);
338     RETURN;
339 }
340
341 PP(pp_refgen)
342 {
343     dSP; dTOPss;
344     SV* rv;
345     if (!sv)
346         RETSETUNDEF;
347     rv = sv_mortalcopy(&sv_undef);
348     sv_upgrade(rv, SVt_RV);
349     SvRV(rv) = sv_ref(sv);
350     SvROK_on(rv);
351     SETs(rv);
352     RETURN;
353 }
354
355 PP(pp_ref)
356 {
357     dSP; dTARGET;
358     SV *sv;
359     char *pv;
360
361     if (MAXARG < 1) {
362         sv = GvSV(defgv);
363         EXTEND(SP, 1);
364     }
365     else
366         sv = POPs;
367     if (!SvROK(sv))
368         RETPUSHUNDEF;
369
370     sv = SvRV(sv);
371     if (SvOBJECT(sv))
372         pv = HvNAME(SvSTASH(sv));
373     else {
374         switch (SvTYPE(sv)) {
375         case SVt_NULL:
376         case SVt_IV:
377         case SVt_NV:
378         case SVt_RV:
379         case SVt_PV:
380         case SVt_PVIV:
381         case SVt_PVNV:
382         case SVt_PVMG:
383         case SVt_PVBM:
384                                 if (SvROK(sv))
385                                     pv = "REF";
386                                 else
387                                     pv = "SCALAR";
388                                 break;
389         case SVt_PVLV:          pv = "LVALUE";          break;
390         case SVt_PVAV:          pv = "ARRAY";           break;
391         case SVt_PVHV:          pv = "HASH";            break;
392         case SVt_PVCV:          pv = "CODE";            break;
393         case SVt_PVGV:          pv = "GLOB";            break;
394         case SVt_PVFM:          pv = "FORMLINE";        break;
395         default:                pv = "UNKNOWN";         break;
396         }
397     }
398     PUSHp(pv, strlen(pv));
399     RETURN;
400 }
401
402 PP(pp_bless)
403 {
404     dSP;
405     register SV* ref;
406     SV *sv;
407     HV *stash;
408
409     if (MAXARG == 1)
410         stash = curcop->cop_stash;
411     else
412         stash = fetch_stash(POPs, TRUE);
413
414     sv = TOPs;
415     if (!SvROK(sv))
416         DIE("Can't bless non-reference value");
417     ref = SvRV(sv);
418     SvOBJECT_on(ref);
419     SvUPGRADE(ref, SVt_PVMG);
420     SvSTASH(ref) = stash;
421     RETURN;
422 }
423
424 /* Pushy I/O. */
425
426 PP(pp_backtick)
427 {
428     dSP; dTARGET;
429     FILE *fp;
430     char *tmps = POPp;
431     TAINT_PROPER("``");
432     fp = my_popen(tmps, "r");
433     if (fp) {
434         sv_setpv(TARG, "");     /* note that this preserves previous buffer */
435         if (GIMME == G_SCALAR) {
436             while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
437                 /*SUPPRESS 530*/
438                 ;
439             XPUSHs(TARG);
440         }
441         else {
442             SV *sv;
443
444             for (;;) {
445                 sv = NEWSV(56, 80);
446                 if (sv_gets(sv, fp, 0) == Nullch) {
447                     sv_free(sv);
448                     break;
449                 }
450                 XPUSHs(sv_2mortal(sv));
451                 if (SvLEN(sv) - SvCUR(sv) > 20) {
452                     SvLEN_set(sv, SvCUR(sv)+1);
453                     Renew(SvPVX(sv), SvLEN(sv), char);
454                 }
455             }
456         }
457         statusvalue = my_pclose(fp);
458     }
459     else {
460         statusvalue = -1;
461         if (GIMME == G_SCALAR)
462             RETPUSHUNDEF;
463     }
464
465     RETURN;
466 }
467
468 OP *
469 do_readline()
470 {
471     dSP; dTARGETSTACKED;
472     register SV *sv;
473     STRLEN tmplen;
474     STRLEN offset;
475     FILE *fp;
476     register IO *io = GvIO(last_in_gv);
477     register I32 type = op->op_type;
478
479     fp = Nullfp;
480     if (io) {
481         fp = io->ifp;
482         if (!fp) {
483             if (io->flags & IOf_ARGV) {
484                 if (io->flags & IOf_START) {
485                     io->flags &= ~IOf_START;
486                     io->lines = 0;
487                     if (av_len(GvAVn(last_in_gv)) < 0) {
488                         SV *tmpstr = newSVpv("-", 1); /* assume stdin */
489                         (void)av_push(GvAVn(last_in_gv), tmpstr);
490                     }
491                 }
492                 fp = nextargv(last_in_gv);
493                 if (!fp) { /* Note: fp != io->ifp */
494                     (void)do_close(last_in_gv, FALSE); /* now it does*/
495                     io->flags |= IOf_START;
496                 }
497             }
498             else if (type == OP_GLOB) {
499                 SV *tmpcmd = NEWSV(55, 0);
500                 SV *tmpglob = POPs;
501 #ifdef DOSISH
502                 sv_setpv(tmpcmd, "perlglob ");
503                 sv_catsv(tmpcmd, tmpglob);
504                 sv_catpv(tmpcmd, " |");
505 #else
506 #ifdef CSH
507                 sv_setpvn(tmpcmd, cshname, cshlen);
508                 sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
509                 sv_catsv(tmpcmd, tmpglob);
510                 sv_catpv(tmpcmd, "'|");
511 #else
512                 sv_setpv(tmpcmd, "echo ");
513                 sv_catsv(tmpcmd, tmpglob);
514                 sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
515 #endif /* !CSH */
516 #endif /* !MSDOS */
517                 (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd));
518                 fp = io->ifp;
519                 sv_free(tmpcmd);
520             }
521         }
522         else if (type == OP_GLOB)
523             SP--;
524     }
525     if (!fp) {
526         if (dowarn)
527             warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
528         if (GIMME == G_SCALAR)
529             RETPUSHUNDEF;
530         RETURN;
531     }
532     if (GIMME == G_ARRAY) {
533         sv = sv_2mortal(NEWSV(57, 80));
534         offset = 0;
535     }
536     else {
537         sv = TARG;
538         SvUPGRADE(sv, SVt_PV);
539         tmplen = SvLEN(sv);     /* remember if already alloced */
540         if (!tmplen)
541             Sv_Grow(sv, 80);    /* try short-buffering it */
542         if (type == OP_RCATLINE)
543             offset = SvCUR(sv);
544         else
545             offset = 0;
546     }
547     for (;;) {
548         if (!sv_gets(sv, fp, offset)) {
549             clearerr(fp);
550             if (io->flags & IOf_ARGV) {
551                 fp = nextargv(last_in_gv);
552                 if (fp)
553                     continue;
554                 (void)do_close(last_in_gv, FALSE);
555                 io->flags |= IOf_START;
556             }
557             else if (type == OP_GLOB) {
558                 (void)do_close(last_in_gv, FALSE);
559             }
560             if (GIMME == G_SCALAR)
561                 RETPUSHUNDEF;
562             RETURN;
563         }
564         io->lines++;
565         XPUSHs(sv);
566         if (tainting) {
567             tainted = TRUE;
568             SvTAINT(sv); /* Anything from the outside world...*/
569         }
570         if (type == OP_GLOB) {
571             char *tmps;
572
573             if (SvCUR(sv) > 0)
574                 SvCUR(sv)--;
575             if (*SvEND(sv) == rschar)
576                 *SvEND(sv) = '\0';
577             else
578                 SvCUR(sv)++;
579             for (tmps = SvPVX(sv); *tmps; tmps++)
580                 if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
581                     strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
582                         break;
583             if (*tmps && stat(SvPVX(sv), &statbuf) < 0) {
584                 POPs;           /* Unmatched wildcard?  Chuck it... */
585                 continue;
586             }
587         }
588         if (GIMME == G_ARRAY) {
589             if (SvLEN(sv) - SvCUR(sv) > 20) {
590                 SvLEN_set(sv, SvCUR(sv)+1);
591                 Renew(SvPVX(sv), SvLEN(sv), char);
592             }
593             sv = sv_2mortal(NEWSV(58, 80));
594             continue;
595         }
596         else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
597             /* try to reclaim a bit of scalar space (only on 1st alloc) */
598             if (SvCUR(sv) < 60)
599                 SvLEN_set(sv, 80);
600             else
601                 SvLEN_set(sv, SvCUR(sv)+40);    /* allow some slop */
602             Renew(SvPVX(sv), SvLEN(sv), char);
603         }
604         RETURN;
605     }
606 }
607
608 PP(pp_glob)
609 {
610     OP *result;
611     ENTER;
612     SAVEINT(rschar);
613     SAVEINT(rslen);
614
615     SAVESPTR(last_in_gv);       /* We don't want this to be permanent. */
616     last_in_gv = (GV*)*stack_sp--;
617
618     rslen = 1;
619 #ifdef DOSISH
620     rschar = 0;
621 #else
622 #ifdef CSH
623     rschar = 0;
624 #else
625     rschar = '\n';
626 #endif  /* !CSH */
627 #endif  /* !MSDOS */
628     result = do_readline();
629     LEAVE;
630     return result;
631 }
632
633 PP(pp_readline)
634 {
635     last_in_gv = (GV*)(*stack_sp--);
636     return do_readline();
637 }
638
639 PP(pp_indread)
640 {
641     last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE);
642     return do_readline();
643 }
644
645 PP(pp_rcatline)
646 {
647     last_in_gv = cGVOP->op_gv;
648     return do_readline();
649 }
650
651 PP(pp_regcmaybe)
652 {
653     return NORMAL;
654 }
655
656 PP(pp_regcomp) {
657     dSP;
658     register PMOP *pm = (PMOP*)cLOGOP->op_other;
659     register char *t;
660     I32 global;
661     SV *tmpstr;
662     register REGEXP *rx = pm->op_pmregexp;
663     STRLEN len;
664
665     global = pm->op_pmflags & PMf_GLOBAL;
666     tmpstr = POPs;
667     t = SvPV(tmpstr, len);
668     if (!global && rx)
669         regfree(rx);
670     pm->op_pmregexp = Null(REGEXP*);    /* crucial if regcomp aborts */
671     pm->op_pmregexp = regcomp(t, t + len,
672         pm->op_pmflags & PMf_FOLD);
673     if (!pm->op_pmregexp->prelen && curpm)
674         pm = curpm;
675     if (pm->op_pmflags & PMf_KEEP) {
676         if (!(pm->op_pmflags & PMf_FOLD))
677             scan_prefix(pm, pm->op_pmregexp->precomp,
678                 pm->op_pmregexp->prelen);
679         pm->op_pmflags &= ~PMf_RUNTIME; /* no point compiling again */
680         hoistmust(pm);
681         cLOGOP->op_first->op_next = op->op_next;
682         /* XXX delete push code */
683     }
684     RETURN;
685 }
686
687 PP(pp_match)
688 {
689     dSP; dTARG;
690     register PMOP *pm = cPMOP;
691     register char *t;
692     register char *s;
693     char *strend;
694     SV *tmpstr;
695     I32 global;
696     I32 safebase;
697     char *truebase;
698     register REGEXP *rx = pm->op_pmregexp;
699     I32 gimme = GIMME;
700     STRLEN len;
701
702     if (op->op_flags & OPf_STACKED)
703         TARG = POPs;
704     else {
705         TARG = GvSV(defgv);
706         EXTEND(SP,1);
707     }
708     s = SvPV(TARG, len);
709     strend = s + len;
710     if (!s)
711         DIE("panic: do_match");
712
713     if (pm->op_pmflags & PMf_USED) {
714         if (gimme == G_ARRAY)
715             RETURN;
716         RETPUSHNO;
717     }
718
719     if (!rx->prelen && curpm) {
720         pm = curpm;
721         rx = pm->op_pmregexp;
722     }
723     truebase = t = s;
724     if (global = pm->op_pmflags & PMf_GLOBAL) {
725         rx->startp[0] = 0;
726         if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
727             MAGIC* mg = mg_find(TARG, 'g');
728             if (mg && mg->mg_ptr) {
729                 rx->startp[0] = mg->mg_ptr;
730                 rx->endp[0] = mg->mg_ptr + mg->mg_len;
731             }
732         }
733     }
734     safebase = (gimme == G_ARRAY) || global;
735
736 play_it_again:
737     if (global && rx->startp[0]) {
738         t = s = rx->endp[0];
739         if (s == rx->startp[0])
740             s++, t++;
741         if (s > strend)
742             goto nope;
743     }
744     if (pm->op_pmshort) {
745         if (pm->op_pmflags & PMf_SCANFIRST) {
746             if (SvSCREAM(TARG)) {
747                 if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
748                     goto nope;
749                 else if (!(s = screaminstr(TARG, pm->op_pmshort)))
750                     goto nope;
751                 else if (pm->op_pmflags & PMf_ALL)
752                     goto yup;
753             }
754             else if (!(s = fbm_instr((unsigned char*)s,
755               (unsigned char*)strend, pm->op_pmshort)))
756                 goto nope;
757             else if (pm->op_pmflags & PMf_ALL)
758                 goto yup;
759             if (s && rx->regback >= 0) {
760                 ++BmUSEFUL(pm->op_pmshort);
761                 s -= rx->regback;
762                 if (s < t)
763                     s = t;
764             }
765             else
766                 s = t;
767         }
768         else if (!multiline) {
769             if (*SvPVX(pm->op_pmshort) != *s ||
770               bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
771                 if (pm->op_pmflags & PMf_FOLD) {
772                     if (ibcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) )
773                         goto nope;
774                 }
775                 else
776                     goto nope;
777             }
778         }
779         if (--BmUSEFUL(pm->op_pmshort) < 0) {
780             sv_free(pm->op_pmshort);
781             pm->op_pmshort = Nullsv;    /* opt is being useless */
782         }
783     }
784     if (!rx->nparens && !global) {
785         gimme = G_SCALAR;                       /* accidental array context? */
786         safebase = FALSE;
787     }
788     if (regexec(rx, s, strend, truebase, 0,
789       SvSCREAM(TARG) ? TARG : Nullsv,
790       safebase)) {
791         curpm = pm;
792         if (pm->op_pmflags & PMf_ONCE)
793             pm->op_pmflags |= PMf_USED;
794         goto gotcha;
795     }
796     else
797         goto ret_no;
798     /*NOTREACHED*/
799
800   gotcha:
801     if (gimme == G_ARRAY) {
802         I32 iters, i, len;
803
804         iters = rx->nparens;
805         if (global && !iters)
806             i = 1;
807         else
808             i = 0;
809         EXTEND(SP, iters + i);
810         for (i = !i; i <= iters; i++) {
811             PUSHs(sv_mortalcopy(&sv_no));
812             /*SUPPRESS 560*/
813             if (s = rx->startp[i]) {
814                 len = rx->endp[i] - s;
815                 if (len > 0)
816                     sv_setpvn(*SP, s, len);
817             }
818         }
819         if (global) {
820             truebase = rx->subbeg;
821             goto play_it_again;
822         }
823         RETURN;
824     }
825     else {
826         if (global) {
827             MAGIC* mg = 0;
828             if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
829                 mg = mg_find(TARG, 'g');
830             if (!mg) {
831                 sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
832                 mg = mg_find(TARG, 'g');
833             }
834             mg->mg_ptr = rx->startp[0];
835             mg->mg_len = rx->endp[0] - rx->startp[0];
836         }
837         RETPUSHYES;
838     }
839
840 yup:
841     ++BmUSEFUL(pm->op_pmshort);
842     curpm = pm;
843     if (pm->op_pmflags & PMf_ONCE)
844         pm->op_pmflags |= PMf_USED;
845     if (global) {
846         rx->subbeg = truebase;
847         rx->subend = strend;
848         rx->startp[0] = s;
849         rx->endp[0] = s + SvCUR(pm->op_pmshort);
850         goto gotcha;
851     }
852     if (sawampersand) {
853         char *tmps;
854
855         if (rx->subbase)
856             Safefree(rx->subbase);
857         tmps = rx->subbase = nsavestr(t, strend-t);
858         rx->subbeg = tmps;
859         rx->subend = tmps + (strend-t);
860         tmps = rx->startp[0] = tmps + (s - t);
861         rx->endp[0] = tmps + SvCUR(pm->op_pmshort);
862     }
863     RETPUSHYES;
864
865 nope:
866     if (pm->op_pmshort)
867         ++BmUSEFUL(pm->op_pmshort);
868
869 ret_no:
870     if (global) {
871         if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
872             MAGIC* mg = mg_find(TARG, 'g');
873             if (mg) {
874                 mg->mg_ptr = 0;
875                 mg->mg_len = 0;
876             }
877         }
878     }
879     if (gimme == G_ARRAY)
880         RETURN;
881     RETPUSHNO;
882 }
883
884 PP(pp_subst)
885 {
886     dSP; dTARG;
887     register PMOP *pm = cPMOP;
888     PMOP *rpm = pm;
889     register SV *dstr;
890     register char *s;
891     char *strend;
892     register char *m;
893     char *c;
894     register char *d;
895     STRLEN clen;
896     I32 iters = 0;
897     I32 maxiters;
898     register I32 i;
899     bool once;
900     char *orig;
901     I32 safebase;
902     register REGEXP *rx = pm->op_pmregexp;
903     STRLEN len;
904
905     if (pm->op_pmflags & PMf_CONST)     /* known replacement string? */
906         dstr = POPs;
907     if (op->op_flags & OPf_STACKED)
908         TARG = POPs;
909     else {
910         TARG = GvSV(defgv);
911         EXTEND(SP,1);
912     }
913     s = SvPV(TARG, len);
914     if (!pm || !s)
915         DIE("panic: do_subst");
916
917     strend = s + len;
918     maxiters = (strend - s) + 10;
919
920     if (!rx->prelen && curpm) {
921         pm = curpm;
922         rx = pm->op_pmregexp;
923     }
924     safebase = ((!rx || !rx->nparens) && !sawampersand);
925     orig = m = s;
926     if (pm->op_pmshort) {
927         if (pm->op_pmflags & PMf_SCANFIRST) {
928             if (SvSCREAM(TARG)) {
929                 if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
930                     goto nope;
931                 else if (!(s = screaminstr(TARG, pm->op_pmshort)))
932                     goto nope;
933             }
934             else if (!(s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
935               pm->op_pmshort)))
936                 goto nope;
937             if (s && rx->regback >= 0) {
938                 ++BmUSEFUL(pm->op_pmshort);
939                 s -= rx->regback;
940                 if (s < m)
941                     s = m;
942             }
943             else
944                 s = m;
945         }
946         else if (!multiline) {
947             if (*SvPVX(pm->op_pmshort) != *s ||
948               bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
949                 if (pm->op_pmflags & PMf_FOLD) {
950                     if (ibcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) )
951                         goto nope;
952                 }
953                 else
954                     goto nope;
955             }
956         }
957         if (--BmUSEFUL(pm->op_pmshort) < 0) {
958             sv_free(pm->op_pmshort);
959             pm->op_pmshort = Nullsv;    /* opt is being useless */
960         }
961     }
962     once = !(rpm->op_pmflags & PMf_GLOBAL);
963     if (rpm->op_pmflags & PMf_CONST) {  /* known replacement string? */
964         c = SvPV(dstr, clen);
965         if (clen <= rx->minlen) {
966                                         /* can do inplace substitution */
967             if (regexec(rx, s, strend, orig, 0,
968               SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
969                 if (rx->subbase)        /* oops, no we can't */
970                     goto long_way;
971                 d = s;
972                 curpm = pm;
973                 SvSCREAM_off(TARG);     /* disable possible screamer */
974                 if (once) {
975                     m = rx->startp[0];
976                     d = rx->endp[0];
977                     s = orig;
978                     if (m - s > strend - d) {   /* faster to shorten from end */
979                         if (clen) {
980                             Copy(c, m, clen, char);
981                             m += clen;
982                         }
983                         i = strend - d;
984                         if (i > 0) {
985                             Move(d, m, i, char);
986                             m += i;
987                         }
988                         *m = '\0';
989                         SvCUR_set(TARG, m - s);
990                         SvPOK_only(TARG);
991                         SvSETMAGIC(TARG);
992                         PUSHs(&sv_yes);
993                         RETURN;
994                     }
995                     /*SUPPRESS 560*/
996                     else if (i = m - s) {       /* faster from front */
997                         d -= clen;
998                         m = d;
999                         sv_chop(TARG, d-i);
1000                         s += i;
1001                         while (i--)
1002                             *--d = *--s;
1003                         if (clen)
1004                             Copy(c, m, clen, char);
1005                         SvPOK_only(TARG);
1006                         SvSETMAGIC(TARG);
1007                         PUSHs(&sv_yes);
1008                         RETURN;
1009                     }
1010                     else if (clen) {
1011                         d -= clen;
1012                         sv_chop(TARG, d);
1013                         Copy(c, d, clen, char);
1014                         SvPOK_only(TARG);
1015                         SvSETMAGIC(TARG);
1016                         PUSHs(&sv_yes);
1017                         RETURN;
1018                     }
1019                     else {
1020                         sv_chop(TARG, d);
1021                         SvPOK_only(TARG);
1022                         SvSETMAGIC(TARG);
1023                         PUSHs(&sv_yes);
1024                         RETURN;
1025                     }
1026                     /* NOTREACHED */
1027                 }
1028                 do {
1029                     if (iters++ > maxiters)
1030                         DIE("Substitution loop");
1031                     m = rx->startp[0];
1032                     /*SUPPRESS 560*/
1033                     if (i = m - s) {
1034                         if (s != d)
1035                             Move(s, d, i, char);
1036                         d += i;
1037                     }
1038                     if (clen) {
1039                         Copy(c, d, clen, char);
1040                         d += clen;
1041                     }
1042                     s = rx->endp[0];
1043                 } while (regexec(rx, s, strend, orig, s == m,
1044                     Nullsv, TRUE));     /* (don't match same null twice) */
1045                 if (s != d) {
1046                     i = strend - s;
1047                     SvCUR_set(TARG, d - SvPVX(TARG) + i);
1048                     Move(s, d, i+1, char);              /* include the Null */
1049                 }
1050                 SvPOK_only(TARG);
1051                 SvSETMAGIC(TARG);
1052                 PUSHs(sv_2mortal(newSVnv((double)iters)));
1053                 RETURN;
1054             }
1055             PUSHs(&sv_no);
1056             RETURN;
1057         }
1058     }
1059     else
1060         c = Nullch;
1061     if (regexec(rx, s, strend, orig, 0,
1062       SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
1063     long_way:
1064         dstr = NEWSV(25, sv_len(TARG));
1065         sv_setpvn(dstr, m, s-m);
1066         curpm = pm;
1067         if (!c) {
1068             register CONTEXT *cx;
1069             PUSHSUBST(cx);
1070             RETURNOP(cPMOP->op_pmreplroot);
1071         }
1072         do {
1073             if (iters++ > maxiters)
1074                 DIE("Substitution loop");
1075             if (rx->subbase && rx->subbase != orig) {
1076                 m = s;
1077                 s = orig;
1078                 orig = rx->subbase;
1079                 s = orig + (m - s);
1080                 strend = s + (strend - m);
1081             }
1082             m = rx->startp[0];
1083             sv_catpvn(dstr, s, m-s);
1084             s = rx->endp[0];
1085             if (clen)
1086                 sv_catpvn(dstr, c, clen);
1087             if (once)
1088                 break;
1089         } while (regexec(rx, s, strend, orig, s == m, Nullsv,
1090             safebase));
1091         sv_catpvn(dstr, s, strend - s);
1092         sv_replace(TARG, dstr);
1093         SvPOK_only(TARG);
1094         SvSETMAGIC(TARG);
1095         PUSHs(sv_2mortal(newSVnv((double)iters)));
1096         RETURN;
1097     }
1098     PUSHs(&sv_no);
1099     RETURN;
1100
1101 nope:
1102     ++BmUSEFUL(pm->op_pmshort);
1103     PUSHs(&sv_no);
1104     RETURN;
1105 }
1106
1107 PP(pp_substcont)
1108 {
1109     dSP;
1110     register PMOP *pm = (PMOP*) cLOGOP->op_other;
1111     register CONTEXT *cx = &cxstack[cxstack_ix];
1112     register SV *dstr = cx->sb_dstr;
1113     register char *s = cx->sb_s;
1114     register char *m = cx->sb_m;
1115     char *orig = cx->sb_orig;
1116     register REGEXP *rx = pm->op_pmregexp;
1117
1118     if (cx->sb_iters++) {
1119         if (cx->sb_iters > cx->sb_maxiters)
1120             DIE("Substitution loop");
1121
1122         sv_catsv(dstr, POPs);
1123         if (rx->subbase)
1124             Safefree(rx->subbase);
1125         rx->subbase = cx->sb_subbase;
1126
1127         /* Are we done */
1128         if (cx->sb_once || !regexec(rx, s, cx->sb_strend, orig,
1129                                 s == m, Nullsv, cx->sb_safebase))
1130         {
1131             SV *targ = cx->sb_targ;
1132             sv_catpvn(dstr, s, cx->sb_strend - s);
1133             sv_replace(targ, dstr);
1134             SvPOK_only(targ);
1135             SvSETMAGIC(targ);
1136             PUSHs(sv_2mortal(newSVnv((double)(cx->sb_iters - 1))));
1137             POPSUBST(cx);
1138             RETURNOP(pm->op_next);
1139         }
1140     }
1141     if (rx->subbase && rx->subbase != orig) {
1142         m = s;
1143         s = orig;
1144         cx->sb_orig = orig = rx->subbase;
1145         s = orig + (m - s);
1146         cx->sb_strend = s + (cx->sb_strend - m);
1147     }
1148     cx->sb_m = m = rx->startp[0];
1149     sv_catpvn(dstr, s, m-s);
1150     cx->sb_s = rx->endp[0];
1151     cx->sb_subbase = rx->subbase;
1152
1153     rx->subbase = Nullch;       /* so recursion works */
1154     RETURNOP(pm->op_pmreplstart);
1155 }
1156
1157 PP(pp_trans)
1158 {
1159     dSP; dTARG;
1160     SV *sv;
1161
1162     if (op->op_flags & OPf_STACKED)
1163         sv = POPs;
1164     else {
1165         sv = GvSV(defgv);
1166         EXTEND(SP,1);
1167     }
1168     TARG = NEWSV(27,0);
1169     PUSHi(do_trans(sv, op));
1170     RETURN;
1171 }
1172
1173 /* Lvalue operators. */
1174
1175 PP(pp_sassign)
1176 {
1177     dSP; dPOPTOPssrl;
1178     if (tainting && tainted && (!SvMAGICAL(lstr) || !mg_find(lstr, 't'))) {
1179         TAINT_NOT;
1180     }
1181     SvSetSV(rstr, lstr);
1182     SvSETMAGIC(rstr);
1183     SETs(rstr);
1184     RETURN;
1185 }
1186
1187 PP(pp_aassign)
1188 {
1189     dSP;
1190     SV **lastlelem = stack_sp;
1191     SV **lastrelem = stack_base + POPMARK;
1192     SV **firstrelem = stack_base + POPMARK + 1;
1193     SV **firstlelem = lastrelem + 1;
1194
1195     register SV **relem;
1196     register SV **lelem;
1197
1198     register SV *sv;
1199     register AV *ary;
1200
1201     HV *hash;
1202     I32 i;
1203     int magic;
1204
1205     delaymagic = DM_DELAY;              /* catch simultaneous items */
1206
1207     /* If there's a common identifier on both sides we have to take
1208      * special care that assigning the identifier on the left doesn't
1209      * clobber a value on the right that's used later in the list.
1210      */
1211     if (op->op_private & OPpASSIGN_COMMON) {
1212         for (relem = firstrelem; relem <= lastrelem; relem++) {
1213             /*SUPPRESS 560*/
1214             if (sv = *relem)
1215                 *relem = sv_mortalcopy(sv);
1216         }
1217     }
1218
1219     relem = firstrelem;
1220     lelem = firstlelem;
1221     ary = Null(AV*);
1222     hash = Null(HV*);
1223     while (lelem <= lastlelem) {
1224         sv = *lelem++;
1225         switch (SvTYPE(sv)) {
1226         case SVt_PVAV:
1227             ary = (AV*)sv;
1228             magic = SvMAGICAL(ary) != 0;
1229             AvREAL_on(ary);
1230             AvFILL(ary) = -1;
1231             i = 0;
1232             while (relem <= lastrelem) {        /* gobble up all the rest */
1233                 sv = NEWSV(28,0);
1234                 if (*relem)
1235                     sv_setsv(sv,*relem);
1236                 *(relem++) = sv;
1237                 (void)av_store(ary,i++,sv);
1238                 if (magic)
1239                     mg_set(sv);
1240             }
1241             break;
1242         case SVt_PVHV: {
1243                 char *tmps;
1244                 SV *tmpstr;
1245
1246                 hash = (HV*)sv;
1247                 magic = SvMAGICAL(hash) != 0;
1248                 hv_clear(hash);
1249
1250                 while (relem < lastrelem) {     /* gobble up all the rest */
1251                     STRLEN len;
1252                     if (*relem)
1253                         sv = *(relem++);
1254                     else
1255                         sv = &sv_no, relem++;
1256                     tmps = SvPV(sv, len);
1257                     tmpstr = NEWSV(29,0);
1258                     if (*relem)
1259                         sv_setsv(tmpstr,*relem);        /* value */
1260                     *(relem++) = tmpstr;
1261                     (void)hv_store(hash,tmps,len,tmpstr,0);
1262                     if (magic)
1263                         mg_set(tmpstr);
1264                 }
1265             }
1266             break;
1267         default:
1268             if (SvTHINKFIRST(sv)) {
1269                 if (SvREADONLY(sv)) {
1270                     if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
1271                         DIE(no_modify);
1272                     if (relem <= lastrelem)
1273                         relem++;
1274                 }
1275                 if (SvROK(sv))
1276                     sv_unref(sv);
1277                 break;
1278             }
1279             if (relem <= lastrelem) {
1280                 sv_setsv(sv, *relem);
1281                 *(relem++) = sv;
1282             }
1283             else
1284                 sv_setsv(sv, &sv_undef);
1285             SvSETMAGIC(sv);
1286             break;
1287         }
1288     }
1289     if (delaymagic & ~DM_DELAY) {
1290         if (delaymagic & DM_UID) {
1291 #ifdef HAS_SETREUID
1292             (void)setreuid(uid,euid);
1293 #else /* not HAS_SETREUID */
1294 #ifdef HAS_SETRUID
1295             if ((delaymagic & DM_UID) == DM_RUID) {
1296                 (void)setruid(uid);
1297                 delaymagic =~ DM_RUID;
1298             }
1299 #endif /* HAS_SETRUID */
1300 #ifdef HAS_SETEUID
1301             if ((delaymagic & DM_UID) == DM_EUID) {
1302                 (void)seteuid(uid);
1303                 delaymagic =~ DM_EUID;
1304             }
1305 #endif /* HAS_SETEUID */
1306             if (delaymagic & DM_UID) {
1307                 if (uid != euid)
1308                     DIE("No setreuid available");
1309                 (void)setuid(uid);
1310             }
1311 #endif /* not HAS_SETREUID */
1312             uid = (int)getuid();
1313             euid = (int)geteuid();
1314         }
1315         if (delaymagic & DM_GID) {
1316 #ifdef HAS_SETREGID
1317             (void)setregid(gid,egid);
1318 #else /* not HAS_SETREGID */
1319 #ifdef HAS_SETRGID
1320             if ((delaymagic & DM_GID) == DM_RGID) {
1321                 (void)setrgid(gid);
1322                 delaymagic =~ DM_RGID;
1323             }
1324 #endif /* HAS_SETRGID */
1325 #ifdef HAS_SETEGID
1326             if ((delaymagic & DM_GID) == DM_EGID) {
1327                 (void)setegid(gid);
1328                 delaymagic =~ DM_EGID;
1329             }
1330 #endif /* HAS_SETEGID */
1331             if (delaymagic & DM_GID) {
1332                 if (gid != egid)
1333                     DIE("No setregid available");
1334                 (void)setgid(gid);
1335             }
1336 #endif /* not HAS_SETREGID */
1337             gid = (int)getgid();
1338             egid = (int)getegid();
1339         }
1340         tainting |= (euid != uid || egid != gid);
1341     }
1342     delaymagic = 0;
1343     if (GIMME == G_ARRAY) {
1344         if (ary || hash)
1345             SP = lastrelem;
1346         else
1347             SP = firstrelem + (lastlelem - firstlelem);
1348         RETURN;
1349     }
1350     else {
1351         dTARGET;
1352         SP = firstrelem;
1353         SETi(lastrelem - firstrelem + 1);
1354         RETURN;
1355     }
1356 }
1357
1358 PP(pp_schop)
1359 {
1360     dSP; dTARGET;
1361     SV *sv;
1362
1363     if (MAXARG < 1)
1364         sv = GvSV(defgv);
1365     else
1366         sv = POPs;
1367     do_chop(TARG, sv);
1368     PUSHTARG;
1369     RETURN;
1370 }
1371
1372 PP(pp_chop)
1373 {
1374     dSP; dMARK; dTARGET;
1375     while (SP > MARK)
1376         do_chop(TARG, POPs);
1377     PUSHTARG;
1378     RETURN;
1379 }
1380
1381 PP(pp_defined)
1382 {
1383     dSP;
1384     register SV* sv;
1385
1386     if (MAXARG < 1) {
1387         sv = GvSV(defgv);
1388         EXTEND(SP, 1);
1389     }
1390     else
1391         sv = POPs;
1392     if (!sv || !SvANY(sv))
1393         RETPUSHNO;
1394     switch (SvTYPE(sv)) {
1395     case SVt_PVAV:
1396         if (AvMAX(sv) >= 0)
1397             RETPUSHYES;
1398         break;
1399     case SVt_PVHV:
1400         if (HvARRAY(sv))
1401             RETPUSHYES;
1402         break;
1403     case SVt_PVCV:
1404         if (CvROOT(sv))
1405             RETPUSHYES;
1406         break;
1407     default:
1408         if (SvOK(sv))
1409             RETPUSHYES;
1410     }
1411     RETPUSHNO;
1412 }
1413
1414 PP(pp_undef)
1415 {
1416     dSP;
1417     SV *sv;
1418
1419     if (!op->op_private)
1420         RETPUSHUNDEF;
1421
1422     sv = POPs;
1423     if (!sv)
1424         RETPUSHUNDEF;
1425
1426     if (SvTHINKFIRST(sv)) {
1427         if (SvREADONLY(sv))
1428             RETPUSHUNDEF;
1429         if (SvROK(sv))
1430             sv_unref(sv);
1431     }
1432
1433     switch (SvTYPE(sv)) {
1434     case SVt_NULL:
1435         break;
1436     case SVt_PVAV:
1437         av_undef((AV*)sv);
1438         break;
1439     case SVt_PVHV:
1440         hv_undef((HV*)sv);
1441         break;
1442     case SVt_PVCV:
1443         sub_generation++;
1444         cv_clear((CV*)sv);
1445         break;
1446     default:
1447         if (sv != GvSV(defgv)) {
1448             if (SvPOK(sv) && SvLEN(sv)) {
1449                 SvOOK_off(sv);
1450                 Safefree(SvPVX(sv));
1451                 SvPV_set(sv, Nullch);
1452                 SvLEN_set(sv, 0);
1453             }
1454             SvOK_off(sv);
1455             SvSETMAGIC(sv);
1456         }
1457     }
1458
1459     RETPUSHUNDEF;
1460 }
1461
1462 PP(pp_study)
1463 {
1464     dSP; dTARGET;
1465     register unsigned char *s;
1466     register I32 pos;
1467     register I32 ch;
1468     register I32 *sfirst;
1469     register I32 *snext;
1470     I32 retval;
1471     STRLEN len;
1472
1473     s = (unsigned char*)(SvPV(TARG, len));
1474     pos = len;
1475     if (lastscream)
1476         SvSCREAM_off(lastscream);
1477     lastscream = TARG;
1478     if (pos <= 0) {
1479         retval = 0;
1480         goto ret;
1481     }
1482     if (pos > maxscream) {
1483         if (maxscream < 0) {
1484             maxscream = pos + 80;
1485             New(301, screamfirst, 256, I32);
1486             New(302, screamnext, maxscream, I32);
1487         }
1488         else {
1489             maxscream = pos + pos / 4;
1490             Renew(screamnext, maxscream, I32);
1491         }
1492     }
1493
1494     sfirst = screamfirst;
1495     snext = screamnext;
1496
1497     if (!sfirst || !snext)
1498         DIE("do_study: out of memory");
1499
1500     for (ch = 256; ch; --ch)
1501         *sfirst++ = -1;
1502     sfirst -= 256;
1503
1504     while (--pos >= 0) {
1505         ch = s[pos];
1506         if (sfirst[ch] >= 0)
1507             snext[pos] = sfirst[ch] - pos;
1508         else
1509             snext[pos] = -pos;
1510         sfirst[ch] = pos;
1511
1512         /* If there were any case insensitive searches, we must assume they
1513          * all are.  This speeds up insensitive searches much more than
1514          * it slows down sensitive ones.
1515          */
1516         if (sawi)
1517             sfirst[fold[ch]] = pos;
1518     }
1519
1520     SvSCREAM_on(TARG);
1521     retval = 1;
1522   ret:
1523     XPUSHs(sv_2mortal(newSVnv((double)retval)));
1524     RETURN;
1525 }
1526
1527 PP(pp_preinc)
1528 {
1529     dSP;
1530     sv_inc(TOPs);
1531     SvSETMAGIC(TOPs);
1532     return NORMAL;
1533 }
1534
1535 PP(pp_predec)
1536 {
1537     dSP;
1538     sv_dec(TOPs);
1539     SvSETMAGIC(TOPs);
1540     return NORMAL;
1541 }
1542
1543 PP(pp_postinc)
1544 {
1545     dSP; dTARGET;
1546     sv_setsv(TARG, TOPs);
1547     sv_inc(TOPs);
1548     SvSETMAGIC(TOPs);
1549     SETs(TARG);
1550     return NORMAL;
1551 }
1552
1553 PP(pp_postdec)
1554 {
1555     dSP; dTARGET;
1556     sv_setsv(TARG, TOPs);
1557     sv_dec(TOPs);
1558     SvSETMAGIC(TOPs);
1559     SETs(TARG);
1560     return NORMAL;
1561 }
1562
1563 /* Ordinary operators. */
1564
1565 PP(pp_pow)
1566 {
1567     dSP; dATARGET; dPOPTOPnnrl;
1568     SETn( pow( left, right) );
1569     RETURN;
1570 }
1571
1572 PP(pp_multiply)
1573 {
1574     dSP; dATARGET; dPOPTOPnnrl;
1575     SETn( left * right );
1576     RETURN;
1577 }
1578
1579 PP(pp_divide)
1580 {
1581     dSP; dATARGET; dPOPnv;
1582     if (value == 0.0)
1583         DIE("Illegal division by zero");
1584 #ifdef SLOPPYDIVIDE
1585     /* insure that 20./5. == 4. */
1586     {
1587         double x;
1588         I32    k;
1589         x =  POPn;
1590         if ((double)(I32)x     == x &&
1591             (double)(I32)value == value &&
1592             (k = (I32)x/(I32)value)*(I32)value == (I32)x) {
1593             value = k;
1594         } else {
1595             value = x/value;
1596         }
1597     }
1598 #else
1599     value = POPn / value;
1600 #endif
1601     PUSHn( value );
1602     RETURN;
1603 }
1604
1605 PP(pp_modulo)
1606 {
1607     dSP; dATARGET;
1608     register unsigned long tmpulong;
1609     register long tmplong;
1610     I32 value;
1611
1612     tmpulong = (unsigned long) POPn;
1613     if (tmpulong == 0L)
1614         DIE("Illegal modulus zero");
1615     value = TOPn;
1616     if (value >= 0.0)
1617         value = (I32)(((unsigned long)value) % tmpulong);
1618     else {
1619         tmplong = (long)value;
1620         value = (I32)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1;
1621     }
1622     SETi(value);
1623     RETURN;
1624 }
1625
1626 PP(pp_repeat)
1627 {
1628     dSP; dATARGET;
1629     register I32 count = POPi;
1630     if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
1631         dMARK;
1632         I32 items = SP - MARK;
1633         I32 max;
1634
1635         max = items * count;
1636         MEXTEND(MARK, max);
1637         if (count > 1) {
1638             while (SP > MARK) {
1639                 if (*SP)
1640                     SvTEMP_off((*SP));
1641                 SP--;
1642             }
1643             MARK++;
1644             repeatcpy((char*)(MARK + items), (char*)MARK,
1645                 items * sizeof(SV*), count - 1);
1646         }
1647         SP += max;
1648     }
1649     else {      /* Note: mark already snarfed by pp_list */
1650         SV *tmpstr;
1651         char *tmps;
1652
1653         tmpstr = POPs;
1654         if (SvTHINKFIRST(tmpstr)) {
1655             if (SvREADONLY(tmpstr))
1656                 DIE("Can't x= to readonly value");
1657             if (SvROK(tmpstr))
1658                 sv_unref(tmpstr);
1659         }
1660         SvSetSV(TARG, tmpstr);
1661         if (count >= 1) {
1662             STRLEN len;
1663             STRLEN tlen;
1664             tmpstr = NEWSV(50, 0);
1665             tmps = SvPV(TARG, len);
1666             sv_setpvn(tmpstr, tmps, len);
1667             tmps = SvPV(tmpstr, tlen);  /* force to be string */
1668             SvGROW(TARG, (count * len) + 1);
1669             repeatcpy((char*)SvPVX(TARG), tmps, tlen, count);
1670             SvCUR(TARG) *= count;
1671             *SvEND(TARG) = '\0';
1672             SvPOK_only(TARG);
1673             sv_free(tmpstr);
1674         }
1675         else
1676             sv_setsv(TARG, &sv_no);
1677         PUSHTARG;
1678     }
1679     RETURN;
1680 }
1681
1682 PP(pp_add)
1683 {
1684     dSP; dATARGET; dPOPTOPnnrl;
1685     SETn( left + right );
1686     RETURN;
1687 }
1688
1689 PP(pp_intadd)
1690 {
1691     dSP; dATARGET; dPOPTOPiirl;
1692     SETi( left + right );
1693     RETURN;
1694 }
1695
1696 PP(pp_subtract)
1697 {
1698     dSP; dATARGET; dPOPTOPnnrl;
1699     SETn( left - right );
1700     RETURN;
1701 }
1702
1703 PP(pp_concat)
1704 {
1705     dSP; dATARGET; dPOPTOPssrl;
1706     SvSetSV(TARG, lstr);
1707     sv_catsv(TARG, rstr);
1708     SETTARG;
1709     RETURN;
1710 }
1711
1712 PP(pp_left_shift)
1713 {
1714     dSP; dATARGET;
1715     I32 anum = POPi;
1716     double value = TOPn;
1717     SETi( U_L(value) << anum );
1718     RETURN;
1719 }
1720
1721 PP(pp_right_shift)
1722 {
1723     dSP; dATARGET;
1724     I32 anum = POPi;
1725     double value = TOPn;
1726     SETi( U_L(value) >> anum );
1727     RETURN;
1728 }
1729
1730 PP(pp_lt)
1731 {
1732     dSP; dPOPnv;
1733     SETs((TOPn < value) ? &sv_yes : &sv_no);
1734     RETURN;
1735 }
1736
1737 PP(pp_gt)
1738 {
1739     dSP; dPOPnv;
1740     SETs((TOPn > value) ? &sv_yes : &sv_no);
1741     RETURN;
1742 }
1743
1744 PP(pp_le)
1745 {
1746     dSP; dPOPnv;
1747     SETs((TOPn <= value) ? &sv_yes : &sv_no);
1748     RETURN;
1749 }
1750
1751 PP(pp_ge)
1752 {
1753     dSP; dPOPnv;
1754     SETs((TOPn >= value) ? &sv_yes : &sv_no);
1755     RETURN;
1756 }
1757
1758 PP(pp_eq)
1759 {
1760     dSP; dPOPnv;
1761     SETs((TOPn == value) ? &sv_yes : &sv_no);
1762     RETURN;
1763 }
1764
1765 PP(pp_ne)
1766 {
1767     dSP; dPOPnv;
1768     SETs((TOPn != value) ? &sv_yes : &sv_no);
1769     RETURN;
1770 }
1771
1772 PP(pp_ncmp)
1773 {
1774     dSP; dTARGET; dPOPTOPnnrl;
1775     I32 value;
1776
1777     if (left > right)
1778         value = 1;
1779     else if (left < right)
1780         value = -1;
1781     else
1782         value = 0;
1783     SETi(value);
1784     RETURN;
1785 }
1786
1787 PP(pp_slt)
1788 {
1789     dSP; dPOPTOPssrl;
1790     SETs( sv_cmp(lstr, rstr) < 0 ? &sv_yes : &sv_no );
1791     RETURN;
1792 }
1793
1794 PP(pp_sgt)
1795 {
1796     dSP; dPOPTOPssrl;
1797     SETs( sv_cmp(lstr, rstr) > 0 ? &sv_yes : &sv_no );
1798     RETURN;
1799 }
1800
1801 PP(pp_sle)
1802 {
1803     dSP; dPOPTOPssrl;
1804     SETs( sv_cmp(lstr, rstr) <= 0 ? &sv_yes : &sv_no );
1805     RETURN;
1806 }
1807
1808 PP(pp_sge)
1809 {
1810     dSP; dPOPTOPssrl;
1811     SETs( sv_cmp(lstr, rstr) >= 0 ? &sv_yes : &sv_no );
1812     RETURN;
1813 }
1814
1815 PP(pp_seq)
1816 {
1817     dSP; dPOPTOPssrl;
1818     SETs( sv_eq(lstr, rstr) ? &sv_yes : &sv_no );
1819     RETURN;
1820 }
1821
1822 PP(pp_sne)
1823 {
1824     dSP; dPOPTOPssrl;
1825     SETs( !sv_eq(lstr, rstr) ? &sv_yes : &sv_no );
1826     RETURN;
1827 }
1828
1829 PP(pp_scmp)
1830 {
1831     dSP; dTARGET;
1832     dPOPTOPssrl;
1833     SETi( sv_cmp(lstr, rstr) );
1834     RETURN;
1835 }
1836
1837 PP(pp_bit_and)
1838 {
1839     dSP; dATARGET; dPOPTOPssrl;
1840     if (SvNIOK(lstr) || SvNIOK(rstr)) {
1841         I32 value = SvIV(lstr);
1842         value = value & SvIV(rstr);
1843         SETi(value);
1844     }
1845     else {
1846         do_vop(op->op_type, TARG, lstr, rstr);
1847         SETTARG;
1848     }
1849     RETURN;
1850 }
1851
1852 PP(pp_xor)
1853 {
1854     dSP; dATARGET; dPOPTOPssrl;
1855     if (SvNIOK(lstr) || SvNIOK(rstr)) {
1856         I32 value = SvIV(lstr);
1857         value = value ^ SvIV(rstr);
1858         SETi(value);
1859     }
1860     else {
1861         do_vop(op->op_type, TARG, lstr, rstr);
1862         SETTARG;
1863     }
1864     RETURN;
1865 }
1866
1867 PP(pp_bit_or)
1868 {
1869     dSP; dATARGET; dPOPTOPssrl;
1870     if (SvNIOK(lstr) || SvNIOK(rstr)) {
1871         I32 value = SvIV(lstr);
1872         value = value | SvIV(rstr);
1873         SETi(value);
1874     }
1875     else {
1876         do_vop(op->op_type, TARG, lstr, rstr);
1877         SETTARG;
1878     }
1879     RETURN;
1880 }
1881
1882 PP(pp_negate)
1883 {
1884     dSP; dTARGET;
1885     SETn(-TOPn);
1886     RETURN;
1887 }
1888
1889 PP(pp_not)
1890 {
1891     *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
1892     return NORMAL;
1893 }
1894
1895 PP(pp_complement)
1896 {
1897     dSP; dTARGET; dTOPss;
1898     register I32 anum;
1899
1900     if (SvNIOK(sv)) {
1901         SETi(  ~SvIV(sv) );
1902     }
1903     else {
1904         register char *tmps;
1905         register long *tmpl;
1906         STRLEN len;
1907
1908         SvSetSV(TARG, sv);
1909         tmps = SvPV(TARG, len);
1910         anum = len;
1911 #ifdef LIBERAL
1912         for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
1913             *tmps = ~*tmps;
1914         tmpl = (long*)tmps;
1915         for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
1916             *tmpl = ~*tmpl;
1917         tmps = (char*)tmpl;
1918 #endif
1919         for ( ; anum > 0; anum--, tmps++)
1920             *tmps = ~*tmps;
1921
1922         SETs(TARG);
1923     }
1924     RETURN;
1925 }
1926
1927 /* High falutin' math. */
1928
1929 PP(pp_atan2)
1930 {
1931     dSP; dTARGET; dPOPTOPnnrl;
1932     SETn(atan2(left, right));
1933     RETURN;
1934 }
1935
1936 PP(pp_sin)
1937 {
1938     dSP; dTARGET;
1939     double value;
1940     if (MAXARG < 1)
1941         value = SvNVx(GvSV(defgv));
1942     else
1943         value = POPn;
1944     value = sin(value);
1945     XPUSHn(value);
1946     RETURN;
1947 }
1948
1949 PP(pp_cos)
1950 {
1951     dSP; dTARGET;
1952     double value;
1953     if (MAXARG < 1)
1954         value = SvNVx(GvSV(defgv));
1955     else
1956         value = POPn;
1957     value = cos(value);
1958     XPUSHn(value);
1959     RETURN;
1960 }
1961
1962 PP(pp_rand)
1963 {
1964     dSP; dTARGET;
1965     double value;
1966     if (MAXARG < 1)
1967         value = 1.0;
1968     else
1969         value = POPn;
1970     if (value == 0.0)
1971         value = 1.0;
1972 #if RANDBITS == 31
1973     value = rand() * value / 2147483648.0;
1974 #else
1975 #if RANDBITS == 16
1976     value = rand() * value / 65536.0;
1977 #else
1978 #if RANDBITS == 15
1979     value = rand() * value / 32768.0;
1980 #else
1981     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1982 #endif
1983 #endif
1984 #endif
1985     XPUSHn(value);
1986     RETURN;
1987 }
1988
1989 PP(pp_srand)
1990 {
1991     dSP;
1992     I32 anum;
1993     time_t when;
1994
1995     if (MAXARG < 1) {
1996         (void)time(&when);
1997         anum = when;
1998     }
1999     else
2000         anum = POPi;
2001     (void)srand(anum);
2002     EXTEND(SP, 1);
2003     RETPUSHYES;
2004 }
2005
2006 PP(pp_exp)
2007 {
2008     dSP; dTARGET;
2009     double value;
2010     if (MAXARG < 1)
2011         value = SvNVx(GvSV(defgv));
2012     else
2013         value = POPn;
2014     value = exp(value);
2015     XPUSHn(value);
2016     RETURN;
2017 }
2018
2019 PP(pp_log)
2020 {
2021     dSP; dTARGET;
2022     double value;
2023     if (MAXARG < 1)
2024         value = SvNVx(GvSV(defgv));
2025     else
2026         value = POPn;
2027     if (value <= 0.0)
2028         DIE("Can't take log of %g\n", value);
2029     value = log(value);
2030     XPUSHn(value);
2031     RETURN;
2032 }
2033
2034 PP(pp_sqrt)
2035 {
2036     dSP; dTARGET;
2037     double value;
2038     if (MAXARG < 1)
2039         value = SvNVx(GvSV(defgv));
2040     else
2041         value = POPn;
2042     if (value < 0.0)
2043         DIE("Can't take sqrt of %g\n", value);
2044     value = sqrt(value);
2045     XPUSHn(value);
2046     RETURN;
2047 }
2048
2049 PP(pp_int)
2050 {
2051     dSP; dTARGET;
2052     double value;
2053     if (MAXARG < 1)
2054         value = SvNVx(GvSV(defgv));
2055     else
2056         value = POPn;
2057     if (value >= 0.0)
2058         (void)modf(value, &value);
2059     else {
2060         (void)modf(-value, &value);
2061         value = -value;
2062     }
2063     XPUSHn(value);
2064     RETURN;
2065 }
2066
2067 PP(pp_abs)
2068 {
2069     dSP; dTARGET;
2070     double value;
2071     if (MAXARG < 1)
2072         value = SvNVx(GvSV(defgv));
2073     else
2074         value = POPn;
2075
2076     if (value < 0.0)
2077         value = -value;
2078
2079     XPUSHn(value);
2080     RETURN;
2081 }
2082
2083 PP(pp_hex)
2084 {
2085     dSP; dTARGET;
2086     char *tmps;
2087     I32 argtype;
2088
2089     if (MAXARG < 1)
2090         tmps = SvPVx(GvSV(defgv), na);
2091     else
2092         tmps = POPp;
2093     XPUSHi( scan_hex(tmps, 99, &argtype) );
2094     RETURN;
2095 }
2096
2097 PP(pp_oct)
2098 {
2099     dSP; dTARGET;
2100     I32 value;
2101     I32 argtype;
2102     char *tmps;
2103
2104     if (MAXARG < 1)
2105         tmps = SvPVx(GvSV(defgv), na);
2106     else
2107         tmps = POPp;
2108     while (*tmps && (isSPACE(*tmps) || *tmps == '0'))
2109         tmps++;
2110     if (*tmps == 'x')
2111         value = (I32)scan_hex(++tmps, 99, &argtype);
2112     else
2113         value = (I32)scan_oct(tmps, 99, &argtype);
2114     XPUSHi(value);
2115     RETURN;
2116 }
2117
2118 /* String stuff. */
2119
2120 PP(pp_length)
2121 {
2122     dSP; dTARGET;
2123     if (MAXARG < 1) {
2124         XPUSHi( sv_len(GvSV(defgv)) );
2125     }
2126     else
2127         SETi( sv_len(TOPs) );
2128     RETURN;
2129 }
2130
2131 PP(pp_substr)
2132 {
2133     dSP; dTARGET;
2134     SV *sv;
2135     I32 len;
2136     STRLEN curlen;
2137     I32 pos;
2138     I32 rem;
2139     I32 lvalue = op->op_flags & OPf_LVAL;
2140     char *tmps;
2141
2142     if (MAXARG > 2)
2143         len = POPi;
2144     pos = POPi - arybase;
2145     sv = POPs;
2146     tmps = SvPV(sv, curlen);            /* force conversion to string */
2147     if (pos < 0)
2148         pos += curlen + arybase;
2149     if (pos < 0 || pos > curlen)
2150         sv_setpvn(TARG, "", 0);
2151     else {
2152         if (MAXARG < 3)
2153             len = curlen;
2154         if (len < 0)
2155             len = 0;
2156         tmps += pos;
2157         rem = curlen - pos;     /* rem=how many bytes left*/
2158         if (rem > len)
2159             rem = len;
2160         sv_setpvn(TARG, tmps, rem);
2161         if (lvalue) {                   /* it's an lvalue! */
2162             if (SvTHINKFIRST(sv)) {
2163                 if (SvREADONLY(sv))
2164                     DIE(no_modify);
2165                 if (SvROK(sv))
2166                     sv_unref(sv);
2167             }
2168             LvTYPE(TARG) = 's';
2169             LvTARG(TARG) = sv;
2170             LvTARGOFF(TARG) = tmps - SvPV(sv, na); 
2171             LvTARGLEN(TARG) = rem; 
2172         }
2173     }
2174     PUSHs(TARG);                /* avoid SvSETMAGIC here */
2175     RETURN;
2176 }
2177
2178 PP(pp_vec)
2179 {
2180     dSP; dTARGET;
2181     register I32 size = POPi;
2182     register I32 offset = POPi;
2183     register SV *src = POPs;
2184     I32 lvalue = op->op_flags & OPf_LVAL;
2185     STRLEN srclen;
2186     unsigned char *s = (unsigned char*)SvPV(src, srclen);
2187     unsigned long retnum;
2188     I32 len;
2189
2190     offset *= size;             /* turn into bit offset */
2191     len = (offset + size + 7) / 8;
2192     if (offset < 0 || size < 1)
2193         retnum = 0;
2194     else if (!lvalue && len > srclen)
2195         retnum = 0;
2196     else {
2197         if (len > srclen) {
2198             SvGROW(src, len);
2199             (void)memzero(SvPVX(src) + srclen, len - srclen);
2200             SvCUR_set(src, len);
2201         }
2202         s = (unsigned char*)SvPV(src, na);
2203         if (size < 8)
2204             retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
2205         else {
2206             offset >>= 3;
2207             if (size == 8)
2208                 retnum = s[offset];
2209             else if (size == 16)
2210                 retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
2211             else if (size == 32)
2212                 retnum = ((unsigned long) s[offset] << 24) +
2213                         ((unsigned long) s[offset + 1] << 16) +
2214                         (s[offset + 2] << 8) + s[offset+3];
2215         }
2216
2217         if (lvalue) {                      /* it's an lvalue! */
2218             if (SvTHINKFIRST(src)) {
2219                 if (SvREADONLY(src))
2220                     DIE(no_modify);
2221                 if (SvROK(src))
2222                     sv_unref(src);
2223             }
2224             LvTYPE(TARG) = 'v';
2225             LvTARG(TARG) = src;
2226             LvTARGOFF(TARG) = offset; 
2227             LvTARGLEN(TARG) = size; 
2228         }
2229     }
2230
2231     sv_setiv(TARG, (I32)retnum);
2232     PUSHs(TARG);
2233     RETURN;
2234 }
2235
2236 PP(pp_index)
2237 {
2238     dSP; dTARGET;
2239     SV *big;
2240     SV *little;
2241     I32 offset;
2242     I32 retval;
2243     char *tmps;
2244     char *tmps2;
2245     STRLEN biglen;
2246
2247     if (MAXARG < 3)
2248         offset = 0;
2249     else
2250         offset = POPi - arybase;
2251     little = POPs;
2252     big = POPs;
2253     tmps = SvPV(big, biglen);
2254     if (offset < 0)
2255         offset = 0;
2256     else if (offset > biglen)
2257         offset = biglen;
2258     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
2259       (unsigned char*)tmps + biglen, little)))
2260         retval = -1 + arybase;
2261     else
2262         retval = tmps2 - tmps + arybase;
2263     PUSHi(retval);
2264     RETURN;
2265 }
2266
2267 PP(pp_rindex)
2268 {
2269     dSP; dTARGET;
2270     SV *big;
2271     SV *little;
2272     STRLEN blen;
2273     STRLEN llen;
2274     SV *offstr;
2275     I32 offset;
2276     I32 retval;
2277     char *tmps;
2278     char *tmps2;
2279
2280     if (MAXARG == 3)
2281         offstr = POPs;
2282     little = POPs;
2283     big = POPs;
2284     tmps2 = SvPV(little, llen);
2285     tmps = SvPV(big, blen);
2286     if (MAXARG < 3)
2287         offset = blen;
2288     else
2289         offset = SvIV(offstr) - arybase + llen;
2290     if (offset < 0)
2291         offset = 0;
2292     else if (offset > blen)
2293         offset = blen;
2294     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
2295                           tmps2, tmps2 + llen)))
2296         retval = -1 + arybase;
2297     else
2298         retval = tmps2 - tmps + arybase;
2299     PUSHi(retval);
2300     RETURN;
2301 }
2302
2303 PP(pp_sprintf)
2304 {
2305     dSP; dMARK; dORIGMARK; dTARGET;
2306     do_sprintf(TARG, SP-MARK, MARK+1);
2307     SP = ORIGMARK;
2308     PUSHTARG;
2309     RETURN;
2310 }
2311
2312 static void
2313 doparseform(sv)
2314 SV *sv;
2315 {
2316     STRLEN len;
2317     register char *s = SvPV(sv, len);
2318     register char *send = s + len;
2319     register char *base;
2320     register I32 skipspaces = 0;
2321     bool noblank;
2322     bool repeat;
2323     bool postspace = FALSE;
2324     U16 *fops;
2325     register U16 *fpc;
2326     U16 *linepc;
2327     register I32 arg;
2328     bool ischop;
2329
2330     New(804, fops, send - s, U16);      /* Almost certainly too long... */
2331     fpc = fops;
2332
2333     if (s < send) {
2334         linepc = fpc;
2335         *fpc++ = FF_LINEMARK;
2336         noblank = repeat = FALSE;
2337         base = s;
2338     }
2339
2340     while (s <= send) {
2341         switch (*s++) {
2342         default:
2343             skipspaces = 0;
2344             continue;
2345
2346         case '~':
2347             if (*s == '~') {
2348                 repeat = TRUE;
2349                 *s = ' ';
2350             }
2351             noblank = TRUE;
2352             s[-1] = ' ';
2353             /* FALL THROUGH */
2354         case ' ': case '\t':
2355             skipspaces++;
2356             continue;
2357             
2358         case '\n': case 0:
2359             arg = s - base;
2360             skipspaces++;
2361             arg -= skipspaces;
2362             if (arg) {
2363                 if (postspace) {
2364                     *fpc++ = FF_SPACE;
2365                     postspace = FALSE;
2366                 }
2367                 *fpc++ = FF_LITERAL;
2368                 *fpc++ = arg;
2369             }
2370             if (s <= send)
2371                 skipspaces--;
2372             if (skipspaces) {
2373                 *fpc++ = FF_SKIP;
2374                 *fpc++ = skipspaces;
2375             }
2376             skipspaces = 0;
2377             if (s <= send)
2378                 *fpc++ = FF_NEWLINE;
2379             if (noblank) {
2380                 *fpc++ = FF_BLANK;
2381                 if (repeat)
2382                     arg = fpc - linepc + 1;
2383                 else
2384                     arg = 0;
2385                 *fpc++ = arg;
2386             }
2387             if (s < send) {
2388                 linepc = fpc;
2389                 *fpc++ = FF_LINEMARK;
2390                 noblank = repeat = FALSE;
2391                 base = s;
2392             }
2393             else
2394                 s++;
2395             continue;
2396
2397         case '@':
2398         case '^':
2399             ischop = s[-1] == '^';
2400
2401             if (postspace) {
2402                 *fpc++ = FF_SPACE;
2403                 postspace = FALSE;
2404             }
2405             arg = (s - base) - 1;
2406             if (arg) {
2407                 *fpc++ = FF_LITERAL;
2408                 *fpc++ = arg;
2409             }
2410
2411             base = s - 1;
2412             *fpc++ = FF_FETCH;
2413             if (*s == '*') {
2414                 s++;
2415                 *fpc++ = 0;
2416                 *fpc++ = FF_LINEGLOB;
2417             }
2418             else if (*s == '#' || (*s == '.' && s[1] == '#')) {
2419                 arg = ischop ? 512 : 0;
2420                 base = s - 1;
2421                 while (*s == '#')
2422                     s++;
2423                 if (*s == '.') {
2424                     char *f;
2425                     s++;
2426                     f = s;
2427                     while (*s == '#')
2428                         s++;
2429                     arg |= 256 + (s - f);
2430                 }
2431                 *fpc++ = s - base;              /* fieldsize for FETCH */
2432                 *fpc++ = FF_DECIMAL;
2433                 *fpc++ = arg;
2434             }
2435             else {
2436                 I32 prespace = 0;
2437                 bool ismore = FALSE;
2438
2439                 if (*s == '>') {
2440                     while (*++s == '>') ;
2441                     prespace = FF_SPACE;
2442                 }
2443                 else if (*s == '|') {
2444                     while (*++s == '|') ;
2445                     prespace = FF_HALFSPACE;
2446                     postspace = TRUE;
2447                 }
2448                 else {
2449                     if (*s == '<')
2450                         while (*++s == '<') ;
2451                     postspace = TRUE;
2452                 }
2453                 if (*s == '.' && s[1] == '.' && s[2] == '.') {
2454                     s += 3;
2455                     ismore = TRUE;
2456                 }
2457                 *fpc++ = s - base;              /* fieldsize for FETCH */
2458
2459                 *fpc++ = ischop ? FF_CHECKCHOP : FF_CHECKNL;
2460
2461                 if (prespace)
2462                     *fpc++ = prespace;
2463                 *fpc++ = FF_ITEM;
2464                 if (ismore)
2465                     *fpc++ = FF_MORE;
2466                 if (ischop)
2467                     *fpc++ = FF_CHOP;
2468             }
2469             base = s;
2470             skipspaces = 0;
2471             continue;
2472         }
2473     }
2474     *fpc++ = FF_END;
2475
2476     arg = fpc - fops;
2477     SvGROW(sv, SvCUR(sv) + arg * sizeof(U16) + 4);
2478
2479     s = SvPVX(sv) + SvCUR(sv);
2480     s += 2 + (SvCUR(sv) & 1);
2481
2482     Copy(fops, s, arg, U16);
2483     Safefree(fops);
2484 }
2485
2486 PP(pp_formline)
2487 {
2488     dSP; dMARK; dORIGMARK;
2489     register SV *form = *++MARK;
2490     register U16 *fpc;
2491     register char *t;
2492     register char *f;
2493     register char *s;
2494     register char *send;
2495     register I32 arg;
2496     register SV *sv;
2497     I32 itemsize;
2498     I32 fieldsize;
2499     I32 lines = 0;
2500     bool chopspace = (strchr(chopset, ' ') != Nullch);
2501     char *chophere;
2502     char *linemark;
2503     char *formmark;
2504     SV **markmark;
2505     double value;
2506     bool gotsome;
2507     STRLEN len;
2508
2509     if (!SvCOMPILED(form))
2510         doparseform(form);
2511
2512     SvUPGRADE(formtarget, SVt_PV);
2513     SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1);
2514     t = SvPV(formtarget, len);
2515     t += len;
2516     f = SvPV(form, len);
2517
2518     s = f + len;
2519     s += 2 + (len & 1);
2520
2521     fpc = (U16*)s;
2522
2523     for (;;) {
2524         DEBUG_f( {
2525             char *name = "???";
2526             arg = -1;
2527             switch (*fpc) {
2528             case FF_LITERAL:    arg = fpc[1]; name = "LITERAL"; break;
2529             case FF_BLANK:      arg = fpc[1]; name = "BLANK";   break;
2530             case FF_SKIP:       arg = fpc[1]; name = "SKIP";    break;
2531             case FF_FETCH:      arg = fpc[1]; name = "FETCH";   break;
2532             case FF_DECIMAL:    arg = fpc[1]; name = "DECIMAL"; break;
2533
2534             case FF_CHECKNL:    name = "CHECKNL";       break;
2535             case FF_CHECKCHOP:  name = "CHECKCHOP";     break;
2536             case FF_SPACE:      name = "SPACE";         break;
2537             case FF_HALFSPACE:  name = "HALFSPACE";     break;
2538             case FF_ITEM:       name = "ITEM";          break;
2539             case FF_CHOP:       name = "CHOP";          break;
2540             case FF_LINEGLOB:   name = "LINEGLOB";      break;
2541             case FF_NEWLINE:    name = "NEWLINE";       break;
2542             case FF_MORE:       name = "MORE";          break;
2543             case FF_LINEMARK:   name = "LINEMARK";      break;
2544             case FF_END:        name = "END";           break;
2545             }
2546             if (arg >= 0)
2547                 fprintf(stderr, "%-16s%d\n", name, arg);
2548             else
2549                 fprintf(stderr, "%-16s\n", name);
2550         } )
2551         switch (*fpc++) {
2552         case FF_LINEMARK:
2553             linemark = t;
2554             formmark = f;
2555             markmark = MARK;
2556             lines++;
2557             gotsome = FALSE;
2558             break;
2559
2560         case FF_LITERAL:
2561             arg = *fpc++;
2562             while (arg--)
2563                 *t++ = *f++;
2564             break;
2565
2566         case FF_SKIP:
2567             f += *fpc++;
2568             break;
2569
2570         case FF_FETCH:
2571             arg = *fpc++;
2572             f += arg;
2573             fieldsize = arg;
2574
2575             if (MARK < SP)
2576                 sv = *++MARK;
2577             else {
2578                 sv = &sv_no;
2579                 if (dowarn)
2580                     warn("Not enough format arguments");
2581             }
2582             break;
2583
2584         case FF_CHECKNL:
2585             s = SvPV(sv, len);
2586             itemsize = len;
2587             if (itemsize > fieldsize)
2588                 itemsize = fieldsize;
2589             send = chophere = s + itemsize;
2590             while (s < send) {
2591                 if (*s & ~31)
2592                     gotsome = TRUE;
2593                 else if (*s == '\n')
2594                     break;
2595                 s++;
2596             }
2597             itemsize = s - SvPVX(sv);
2598             break;
2599
2600         case FF_CHECKCHOP:
2601             s = SvPV(sv, len);
2602             itemsize = len;
2603             if (itemsize > fieldsize)
2604                 itemsize = fieldsize;
2605             send = chophere = s + itemsize;
2606             while (s < send || (s == send && isSPACE(*s))) {
2607                 if (isSPACE(*s)) {
2608                     if (chopspace)
2609                         chophere = s;
2610                     if (*s == '\r')
2611                         break;
2612                 }
2613                 else {
2614                     if (*s & ~31)
2615                         gotsome = TRUE;
2616                     if (strchr(chopset, *s))
2617                         chophere = s + 1;
2618                 }
2619                 s++;
2620             }
2621             itemsize = chophere - SvPVX(sv);
2622             break;
2623
2624         case FF_SPACE:
2625             arg = fieldsize - itemsize;
2626             if (arg) {
2627                 fieldsize -= arg;
2628                 while (arg-- > 0)
2629                     *t++ = ' ';
2630             }
2631             break;
2632
2633         case FF_HALFSPACE:
2634             arg = fieldsize - itemsize;
2635             if (arg) {
2636                 arg /= 2;
2637                 fieldsize -= arg;
2638                 while (arg-- > 0)
2639                     *t++ = ' ';
2640             }
2641             break;
2642
2643         case FF_ITEM:
2644             arg = itemsize;
2645             s = SvPVX(sv);
2646             while (arg--) {
2647                 if ((*t++ = *s++) < ' ')
2648                     t[-1] = ' ';
2649             }
2650             break;
2651
2652         case FF_CHOP:
2653             s = chophere;
2654             if (chopspace) {
2655                 while (*s && isSPACE(*s))
2656                     s++;
2657             }
2658             sv_chop(sv,s);
2659             break;
2660
2661         case FF_LINEGLOB:
2662             s = SvPV(sv, len);
2663             itemsize = len;
2664             if (itemsize) {
2665                 gotsome = TRUE;
2666                 send = s + itemsize;
2667                 while (s < send) {
2668                     if (*s++ == '\n') {
2669                         if (s == send)
2670                             itemsize--;
2671                         else
2672                             lines++;
2673                     }
2674                 }
2675                 SvCUR_set(formtarget, t - SvPVX(formtarget));
2676                 sv_catpvn(formtarget, SvPVX(sv), itemsize);
2677                 SvGROW(formtarget, SvCUR(formtarget) + SvCUR(form) + 1);
2678                 t = SvPVX(formtarget) + SvCUR(formtarget);
2679             }
2680             break;
2681
2682         case FF_DECIMAL:
2683             /* If the field is marked with ^ and the value is undefined,
2684                blank it out. */
2685             arg = *fpc++;
2686             if ((arg & 512) && !SvOK(sv)) {
2687                 arg = fieldsize;
2688                 while (arg--)
2689                     *t++ = ' ';
2690                 break;
2691             }
2692             gotsome = TRUE;
2693             value = SvNV(sv);
2694             if (arg & 256) {
2695                 sprintf(t, "%#*.*f", fieldsize, arg & 255, value);
2696             } else {
2697                 sprintf(t, "%*.0f", fieldsize, value);
2698             }
2699             t += fieldsize;
2700             break;
2701
2702         case FF_NEWLINE:
2703             f++;
2704             while (t-- > linemark && *t == ' ') ;
2705             t++;
2706             *t++ = '\n';
2707             break;
2708
2709         case FF_BLANK:
2710             arg = *fpc++;
2711             if (gotsome) {
2712                 if (arg) {              /* repeat until fields exhausted? */
2713                     fpc -= arg;
2714                     f = formmark;
2715                     MARK = markmark;
2716                     if (lines == 200) {
2717                         arg = t - linemark;
2718                         if (strnEQ(linemark, linemark - t, arg))
2719                             DIE("Runaway format");
2720                     }
2721                     arg = t - SvPVX(formtarget);
2722                     SvGROW(formtarget,
2723                         (t - SvPVX(formtarget)) + (f - formmark) + 1);
2724                     t = SvPVX(formtarget) + arg;
2725                 }
2726             }
2727             else {
2728                 t = linemark;
2729                 lines--;
2730             }
2731             break;
2732
2733         case FF_MORE:
2734             if (SvCUROK(sv)) {
2735                 arg = fieldsize - itemsize;
2736                 if (arg) {
2737                     fieldsize -= arg;
2738                     while (arg-- > 0)
2739                         *t++ = ' ';
2740                 }
2741                 s = t - 3;
2742                 if (strnEQ(s,"   ",3)) {
2743                     while (s > SvPVX(formtarget) && isSPACE(s[-1]))
2744                         s--;
2745                 }
2746                 *s++ = '.';
2747                 *s++ = '.';
2748                 *s++ = '.';
2749             }
2750             break;
2751
2752         case FF_END:
2753             *t = '\0';
2754             SvCUR_set(formtarget, t - SvPVX(formtarget));
2755             FmLINES(formtarget) += lines;
2756             SP = ORIGMARK;
2757             RETPUSHYES;
2758         }
2759     }
2760 }
2761
2762 PP(pp_ord)
2763 {
2764     dSP; dTARGET;
2765     I32 value;
2766     char *tmps;
2767     I32 anum;
2768
2769     if (MAXARG < 1)
2770         tmps = SvPVx(GvSV(defgv), na);
2771     else
2772         tmps = POPp;
2773 #ifndef I286
2774     value = (I32) (*tmps & 255);
2775 #else
2776     anum = (I32) *tmps;
2777     value = (I32) (anum & 255);
2778 #endif
2779     XPUSHi(value);
2780     RETURN;
2781 }
2782
2783 PP(pp_chr)
2784 {
2785     dSP; dTARGET;
2786     char *tmps;
2787
2788     if (SvTYPE(TARG) == SVt_NULL) {
2789         sv_upgrade(TARG,SVt_PV);
2790         SvGROW(TARG,1);
2791     }
2792     SvCUR_set(TARG, 1);
2793     tmps = SvPVX(TARG);
2794     if (MAXARG < 1)
2795         *tmps = SvIVx(GvSV(defgv));
2796     else
2797         *tmps = POPi;
2798     SvPOK_only(TARG);
2799     XPUSHs(TARG);
2800     RETURN;
2801 }
2802
2803 PP(pp_crypt)
2804 {
2805     dSP; dTARGET; dPOPTOPssrl;
2806 #ifdef HAS_CRYPT
2807     char *tmps = SvPV(lstr, na);
2808 #ifdef FCRYPT
2809     sv_setpv(TARG, fcrypt(tmps, SvPV(rstr, na)));
2810 #else
2811     sv_setpv(TARG, crypt(tmps, SvPV(rstr, na)));
2812 #endif
2813 #else
2814     DIE(
2815       "The crypt() function is unimplemented due to excessive paranoia.");
2816 #endif
2817     SETs(TARG);
2818     RETURN;
2819 }
2820
2821 PP(pp_ucfirst)
2822 {
2823     dSP;
2824     SV *sv = TOPs;
2825     register char *s;
2826
2827     if (!SvPADTMP(sv)) {
2828         dTARGET;
2829         sv_setsv(TARG, sv);
2830         sv = TARG;
2831         SETs(sv);
2832     }
2833     s = SvPV(sv, na);
2834     if (isascii(*s) && islower(*s))
2835         *s = toupper(*s);
2836
2837     RETURN;
2838 }
2839
2840 PP(pp_lcfirst)
2841 {
2842     dSP;
2843     SV *sv = TOPs;
2844     register char *s;
2845
2846     if (!SvPADTMP(sv)) {
2847         dTARGET;
2848         sv_setsv(TARG, sv);
2849         sv = TARG;
2850         SETs(sv);
2851     }
2852     s = SvPV(sv, na);
2853     if (isascii(*s) && isupper(*s))
2854         *s = tolower(*s);
2855
2856     SETs(sv);
2857     RETURN;
2858 }
2859
2860 PP(pp_uc)
2861 {
2862     dSP;
2863     SV *sv = TOPs;
2864     register char *s;
2865     register char *send;
2866     STRLEN len;
2867
2868     if (!SvPADTMP(sv)) {
2869         dTARGET;
2870         sv_setsv(TARG, sv);
2871         sv = TARG;
2872         SETs(sv);
2873     }
2874     s = SvPV(sv, len);
2875     send = s + len;
2876     while (s < send) {
2877         if (isascii(*s) && islower(*s))
2878             *s = toupper(*s);
2879         s++;
2880     }
2881     RETURN;
2882 }
2883
2884 PP(pp_lc)
2885 {
2886     dSP;
2887     SV *sv = TOPs;
2888     register char *s;
2889     register char *send;
2890     STRLEN len;
2891
2892     if (!SvPADTMP(sv)) {
2893         dTARGET;
2894         sv_setsv(TARG, sv);
2895         sv = TARG;
2896         SETs(sv);
2897     }
2898     s = SvPV(sv, len);
2899     send = s + len;
2900     while (s < send) {
2901         if (isascii(*s) && isupper(*s))
2902             *s = tolower(*s);
2903         s++;
2904     }
2905     RETURN;
2906 }
2907
2908 /* Arrays. */
2909
2910 PP(pp_rv2av)
2911 {
2912     dSP; dPOPss;
2913
2914     AV *av;
2915
2916     if (SvROK(sv)) {
2917         av = (AV*)SvRV(sv);
2918         if (SvTYPE(av) != SVt_PVAV)
2919             DIE("Not an array reference");
2920         if (op->op_flags & OPf_LVAL) {
2921             if (op->op_flags & OPf_INTRO)
2922                 av = (AV*)save_svref((SV**)sv);
2923             PUSHs((SV*)av);
2924             RETURN;
2925         }
2926     }
2927     else {
2928         if (SvTYPE(sv) == SVt_PVAV) {
2929             av = (AV*)sv;
2930             if (op->op_flags & OPf_LVAL) {
2931                 PUSHs((SV*)av);
2932                 RETURN;
2933             }
2934         }
2935         else {
2936             if (SvTYPE(sv) != SVt_PVGV) {
2937                 if (!SvOK(sv))
2938                     DIE(no_usym);
2939                 sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE);
2940             }
2941             av = GvAVn(sv);
2942             if (op->op_flags & OPf_LVAL) {
2943                 if (op->op_flags & OPf_INTRO)
2944                     av = save_ary(sv);
2945                 PUSHs((SV*)av);
2946                 RETURN;
2947             }
2948         }
2949     }
2950
2951     if (GIMME == G_ARRAY) {
2952         I32 maxarg = AvFILL(av) + 1;
2953         EXTEND(SP, maxarg);
2954         Copy(AvARRAY(av), SP+1, maxarg, SV*);
2955         SP += maxarg;
2956     }
2957     else {
2958         dTARGET;
2959         I32 maxarg = AvFILL(av) + 1;
2960         PUSHi(maxarg);
2961     }
2962     RETURN;
2963 }
2964
2965 PP(pp_aelemfast)
2966 {
2967     dSP;
2968     AV *av = (AV*)cSVOP->op_sv;
2969     SV** svp = av_fetch(av, op->op_private - arybase, FALSE);
2970     PUSHs(svp ? *svp : &sv_undef);
2971     RETURN;
2972 }
2973
2974 PP(pp_aelem)
2975 {
2976     dSP;
2977     SV** svp;
2978     I32 elem = POPi - arybase;
2979     AV *av = (AV*)POPs;
2980
2981     if (op->op_flags & OPf_LVAL) {
2982         svp = av_fetch(av, elem, TRUE);
2983         if (!svp || *svp == &sv_undef)
2984             DIE(no_aelem, elem);
2985         if (op->op_flags & OPf_INTRO)
2986             save_svref(svp);
2987         else if (!SvOK(*svp)) {
2988             if (op->op_private == OP_RV2HV) {
2989                 sv_free(*svp);
2990                 *svp = NEWSV(0,0);
2991                 sv_upgrade(*svp, SVt_RV);
2992                 SvRV(*svp) = sv_ref((SV*)newHV());
2993                 SvROK_on(*svp);
2994             }
2995             else if (op->op_private == OP_RV2AV) {
2996                 sv_free(*svp);
2997                 *svp = NEWSV(0,0);
2998                 sv_upgrade(*svp, SVt_RV);
2999                 SvRV(*svp) = sv_ref((SV*)newAV());
3000                 SvROK_on(*svp);
3001             }
3002         }
3003     }
3004     else
3005         svp = av_fetch(av, elem, FALSE);
3006     PUSHs(svp ? *svp : &sv_undef);
3007     RETURN;
3008 }
3009
3010 PP(pp_aslice)
3011 {
3012     dSP; dMARK; dORIGMARK;
3013     register SV** svp;
3014     register AV* av = (AV*)POPs;
3015     register I32 lval = op->op_flags & OPf_LVAL;
3016     I32 is_something_there = lval;
3017
3018     while (++MARK <= SP) {
3019         I32 elem = SvIVx(*MARK);
3020
3021         if (lval) {
3022             svp = av_fetch(av, elem, TRUE);
3023             if (!svp || *svp == &sv_undef)
3024                 DIE(no_aelem, elem);
3025             if (op->op_flags & OPf_INTRO)
3026                 save_svref(svp);
3027         }
3028         else {
3029             svp = av_fetch(av, elem, FALSE);
3030             if (!is_something_there && svp && SvOK(*svp))
3031                 is_something_there = TRUE;
3032         }
3033         *MARK = svp ? *svp : &sv_undef;
3034     }
3035     if (!is_something_there)
3036         SP = ORIGMARK;
3037     RETURN;
3038 }
3039
3040 /* Associative arrays. */
3041
3042 PP(pp_each)
3043 {
3044     dSP; dTARGET;
3045     HV *hash = (HV*)POPs;
3046     HE *entry = hv_iternext(hash);
3047     I32 i;
3048     char *tmps;
3049
3050     if (mystrk) {
3051         sv_free(mystrk);
3052         mystrk = Nullsv;
3053     }
3054
3055     EXTEND(SP, 2);
3056     if (entry) {
3057         if (GIMME == G_ARRAY) {
3058             tmps = hv_iterkey(entry, &i);
3059             if (!i)
3060                 tmps = "";
3061             mystrk = newSVpv(tmps, i);
3062             PUSHs(mystrk);
3063         }
3064         sv_setsv(TARG, hv_iterval(hash, entry));
3065         PUSHs(TARG);
3066     }
3067     else if (GIMME == G_SCALAR)
3068         RETPUSHUNDEF;
3069
3070     RETURN;
3071 }
3072
3073 PP(pp_values)
3074 {
3075     return do_kv(ARGS);
3076 }
3077
3078 PP(pp_keys)
3079 {
3080     return do_kv(ARGS);
3081 }
3082
3083 PP(pp_delete)
3084 {
3085     dSP;
3086     SV *sv;
3087     SV *tmpsv = POPs;
3088     HV *hv = (HV*)POPs;
3089     char *tmps;
3090     STRLEN len;
3091     if (!hv) {
3092         DIE("Not an associative array reference");
3093     }
3094     tmps = SvPV(tmpsv, len);
3095     sv = hv_delete(hv, tmps, len);
3096     if (!sv)
3097         RETPUSHUNDEF;
3098     PUSHs(sv);
3099     RETURN;
3100 }
3101
3102 PP(pp_rv2hv)
3103 {
3104
3105     dSP; dTOPss;
3106
3107     HV *hv;
3108
3109     if (SvTYPE(sv) == SVt_RV) {
3110         hv = (HV*)SvRV(sv);
3111         if (SvTYPE(hv) != SVt_PVHV)
3112             DIE("Not an associative array reference");
3113         if (op->op_flags & OPf_LVAL) {
3114             if (op->op_flags & OPf_INTRO)
3115                 hv = (HV*)save_svref((SV**)sv);
3116             SETs((SV*)hv);
3117             RETURN;
3118         }
3119     }
3120     else {
3121         if (SvTYPE(sv) == SVt_PVHV) {
3122             hv = (HV*)sv;
3123             if (op->op_flags & OPf_LVAL) {
3124                 SETs((SV*)hv);
3125                 RETURN;
3126             }
3127         }
3128         else {
3129             if (SvTYPE(sv) != SVt_PVGV) {
3130                 if (!SvOK(sv))
3131                     DIE(no_usym);
3132                 sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE);
3133             }
3134             hv = GvHVn(sv);
3135             if (op->op_flags & OPf_LVAL) {
3136                 if (op->op_flags & OPf_INTRO)
3137                     hv = save_hash(sv);
3138                 SETs((SV*)hv);
3139                 RETURN;
3140             }
3141         }
3142     }
3143
3144     if (GIMME == G_ARRAY) { /* array wanted */
3145         *stack_sp = (SV*)hv;
3146         return do_kv(ARGS);
3147     }
3148     else {
3149         dTARGET;
3150         if (HvFILL(hv))
3151             sv_setiv(TARG, 0);
3152         else {
3153             sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
3154             sv_setpv(TARG, buf);
3155         }
3156         SETTARG;
3157         RETURN;
3158     }
3159 }
3160
3161 PP(pp_helem)
3162 {
3163     dSP;
3164     SV** svp;
3165     SV *keysv = POPs;
3166     STRLEN keylen;
3167     char *key = SvPV(keysv, keylen);
3168     HV *hv = (HV*)POPs;
3169
3170     if (op->op_flags & OPf_LVAL) {
3171         svp = hv_fetch(hv, key, keylen, TRUE);
3172         if (!svp || *svp == &sv_undef)
3173             DIE(no_helem, key);
3174         if (op->op_flags & OPf_INTRO)
3175             save_svref(svp);
3176         else if (!SvOK(*svp)) {
3177             if (op->op_private == OP_RV2HV) {
3178                 sv_free(*svp);
3179                 *svp = NEWSV(0,0);
3180                 sv_upgrade(*svp, SVt_RV);
3181                 SvRV(*svp) = sv_ref((SV*)newHV());
3182                 SvROK_on(*svp);
3183             }
3184             else if (op->op_private == OP_RV2AV) {
3185                 sv_free(*svp);
3186                 *svp = NEWSV(0,0);
3187                 sv_upgrade(*svp, SVt_RV);
3188                 SvRV(*svp) = sv_ref((SV*)newAV());
3189                 SvROK_on(*svp);
3190             }
3191         }
3192     }
3193     else
3194         svp = hv_fetch(hv, key, keylen, FALSE);
3195     PUSHs(svp ? *svp : &sv_undef);
3196     RETURN;
3197 }
3198
3199 PP(pp_hslice)
3200 {
3201     dSP; dMARK; dORIGMARK;
3202     register SV **svp;
3203     register HV *hv = (HV*)POPs;
3204     register I32 lval = op->op_flags & OPf_LVAL;
3205     I32 is_something_there = lval;
3206
3207     while (++MARK <= SP) {
3208         STRLEN keylen;
3209         char *key = SvPV(*MARK, keylen);
3210
3211         if (lval) {
3212             svp = hv_fetch(hv, key, keylen, TRUE);
3213             if (!svp || *svp == &sv_undef)
3214                 DIE(no_helem, key);
3215             if (op->op_flags & OPf_INTRO)
3216                 save_svref(svp);
3217         }
3218         else {
3219             svp = hv_fetch(hv, key, keylen, FALSE);
3220             if (!is_something_there && svp && SvOK(*svp))
3221                 is_something_there = TRUE;
3222         }
3223         *MARK = svp ? *svp : &sv_undef;
3224     }
3225     if (!is_something_there)
3226         SP = ORIGMARK;
3227     RETURN;
3228 }
3229
3230 /* Explosives and implosives. */
3231
3232 PP(pp_unpack)
3233 {
3234     dSP;
3235     dPOPPOPssrl;
3236     SV *sv;
3237     STRLEN llen;
3238     STRLEN rlen;
3239     register char *pat = SvPV(lstr, llen);
3240     register char *s = SvPV(rstr, rlen);
3241     char *strend = s + rlen;
3242     char *strbeg = s;
3243     register char *patend = pat + llen;
3244     I32 datumtype;
3245     register I32 len;
3246     register I32 bits;
3247
3248     /* These must not be in registers: */
3249     I16 ashort;
3250     int aint;
3251     I32 along;
3252 #ifdef QUAD
3253     quad aquad;
3254 #endif
3255     U16 aushort;
3256     unsigned int auint;
3257     U32 aulong;
3258 #ifdef QUAD
3259     unsigned quad auquad;
3260 #endif
3261     char *aptr;
3262     float afloat;
3263     double adouble;
3264     I32 checksum = 0;
3265     register U32 culong;
3266     double cdouble;
3267     static char* bitcount = 0;
3268
3269     if (GIMME != G_ARRAY) {             /* arrange to do first one only */
3270         /*SUPPRESS 530*/
3271         for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
3272         if (strchr("aAbBhH", *patend) || *pat == '%') {
3273             patend++;
3274             while (isDIGIT(*patend) || *patend == '*')
3275                 patend++;
3276         }
3277         else
3278             patend++;
3279     }
3280     while (pat < patend) {
3281       reparse:
3282         datumtype = *pat++;
3283         if (pat >= patend)
3284             len = 1;
3285         else if (*pat == '*') {
3286             len = strend - strbeg;      /* long enough */
3287             pat++;
3288         }
3289         else if (isDIGIT(*pat)) {
3290             len = *pat++ - '0';
3291             while (isDIGIT(*pat))
3292                 len = (len * 10) + (*pat++ - '0');
3293         }
3294         else
3295             len = (datumtype != '@');
3296         switch(datumtype) {
3297         default:
3298             break;
3299         case '%':
3300             if (len == 1 && pat[-1] != '1')
3301                 len = 16;
3302             checksum = len;
3303             culong = 0;
3304             cdouble = 0;
3305             if (pat < patend)
3306                 goto reparse;
3307             break;
3308         case '@':
3309             if (len > strend - strbeg)
3310                 DIE("@ outside of string");
3311             s = strbeg + len;
3312             break;
3313         case 'X':
3314             if (len > s - strbeg)
3315                 DIE("X outside of string");
3316             s -= len;
3317             break;
3318         case 'x':
3319             if (len > strend - s)
3320                 DIE("x outside of string");
3321             s += len;
3322             break;
3323         case 'A':
3324         case 'a':
3325             if (len > strend - s)
3326                 len = strend - s;
3327             if (checksum)
3328                 goto uchar_checksum;
3329             sv = NEWSV(35, len);
3330             sv_setpvn(sv, s, len);
3331             s += len;
3332             if (datumtype == 'A') {
3333                 aptr = s;       /* borrow register */
3334                 s = SvPVX(sv) + len - 1;
3335                 while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
3336                     s--;
3337                 *++s = '\0';
3338                 SvCUR_set(sv, s - SvPVX(sv));
3339                 s = aptr;       /* unborrow register */
3340             }
3341             XPUSHs(sv_2mortal(sv));
3342             break;
3343         case 'B':
3344         case 'b':
3345             if (pat[-1] == '*' || len > (strend - s) * 8)
3346                 len = (strend - s) * 8;
3347             if (checksum) {
3348                 if (!bitcount) {
3349                     Newz(601, bitcount, 256, char);
3350                     for (bits = 1; bits < 256; bits++) {
3351                         if (bits & 1)   bitcount[bits]++;
3352                         if (bits & 2)   bitcount[bits]++;
3353                         if (bits & 4)   bitcount[bits]++;
3354                         if (bits & 8)   bitcount[bits]++;
3355                         if (bits & 16)  bitcount[bits]++;
3356                         if (bits & 32)  bitcount[bits]++;
3357                         if (bits & 64)  bitcount[bits]++;
3358                         if (bits & 128) bitcount[bits]++;
3359                     }
3360                 }
3361                 while (len >= 8) {
3362                     culong += bitcount[*(unsigned char*)s++];
3363                     len -= 8;
3364                 }
3365                 if (len) {
3366                     bits = *s;
3367                     if (datumtype == 'b') {
3368                         while (len-- > 0) {
3369                             if (bits & 1) culong++;
3370                             bits >>= 1;
3371                         }
3372                     }
3373                     else {
3374                         while (len-- > 0) {
3375                             if (bits & 128) culong++;
3376                             bits <<= 1;
3377                         }
3378                     }
3379                 }
3380                 break;
3381             }
3382             sv = NEWSV(35, len + 1);
3383             SvCUR_set(sv, len);
3384             SvPOK_on(sv);
3385             aptr = pat;                 /* borrow register */
3386             pat = SvPVX(sv);
3387             if (datumtype == 'b') {
3388                 aint = len;
3389                 for (len = 0; len < aint; len++) {
3390                     if (len & 7)                /*SUPPRESS 595*/
3391                         bits >>= 1;
3392                     else
3393                         bits = *s++;
3394                     *pat++ = '0' + (bits & 1);
3395                 }
3396             }
3397             else {
3398                 aint = len;
3399                 for (len = 0; len < aint; len++) {
3400                     if (len & 7)
3401                         bits <<= 1;
3402                     else
3403                         bits = *s++;
3404                     *pat++ = '0' + ((bits & 128) != 0);
3405                 }
3406             }
3407             *pat = '\0';
3408             pat = aptr;                 /* unborrow register */
3409             XPUSHs(sv_2mortal(sv));
3410             break;
3411         case 'H':
3412         case 'h':
3413             if (pat[-1] == '*' || len > (strend - s) * 2)
3414                 len = (strend - s) * 2;
3415             sv = NEWSV(35, len + 1);
3416             SvCUR_set(sv, len);
3417             SvPOK_on(sv);
3418             aptr = pat;                 /* borrow register */
3419             pat = SvPVX(sv);
3420             if (datumtype == 'h') {
3421                 aint = len;
3422                 for (len = 0; len < aint; len++) {
3423                     if (len & 1)
3424                         bits >>= 4;
3425                     else
3426                         bits = *s++;
3427                     *pat++ = hexdigit[bits & 15];
3428                 }
3429             }
3430             else {
3431                 aint = len;
3432                 for (len = 0; len < aint; len++) {
3433                     if (len & 1)
3434                         bits <<= 4;
3435                     else
3436                         bits = *s++;
3437                     *pat++ = hexdigit[(bits >> 4) & 15];
3438                 }
3439             }
3440             *pat = '\0';
3441             pat = aptr;                 /* unborrow register */
3442             XPUSHs(sv_2mortal(sv));
3443             break;
3444         case 'c':
3445             if (len > strend - s)
3446                 len = strend - s;
3447             if (checksum) {
3448                 while (len-- > 0) {
3449                     aint = *s++;
3450                     if (aint >= 128)    /* fake up signed chars */
3451                         aint -= 256;
3452                     culong += aint;
3453                 }
3454             }
3455             else {
3456                 EXTEND(SP, len);
3457                 while (len-- > 0) {
3458                     aint = *s++;
3459                     if (aint >= 128)    /* fake up signed chars */
3460                         aint -= 256;
3461                     sv = NEWSV(36, 0);
3462                     sv_setiv(sv, (I32)aint);
3463                     PUSHs(sv_2mortal(sv));
3464                 }
3465             }
3466             break;
3467         case 'C':
3468             if (len > strend - s)
3469                 len = strend - s;
3470             if (checksum) {
3471               uchar_checksum:
3472                 while (len-- > 0) {
3473                     auint = *s++ & 255;
3474                     culong += auint;
3475                 }
3476             }
3477             else {
3478                 EXTEND(SP, len);
3479                 while (len-- > 0) {
3480                     auint = *s++ & 255;
3481                     sv = NEWSV(37, 0);
3482                     sv_setiv(sv, (I32)auint);
3483                     PUSHs(sv_2mortal(sv));
3484                 }
3485             }
3486             break;
3487         case 's':
3488             along = (strend - s) / sizeof(I16);
3489             if (len > along)
3490                 len = along;
3491             if (checksum) {
3492                 while (len-- > 0) {
3493                     Copy(s, &ashort, 1, I16);
3494                     s += sizeof(I16);
3495                     culong += ashort;
3496                 }
3497             }
3498             else {
3499                 EXTEND(SP, len);
3500                 while (len-- > 0) {
3501                     Copy(s, &ashort, 1, I16);
3502                     s += sizeof(I16);
3503                     sv = NEWSV(38, 0);
3504                     sv_setiv(sv, (I32)ashort);
3505                     PUSHs(sv_2mortal(sv));
3506                 }
3507             }
3508             break;
3509         case 'v':
3510         case 'n':
3511         case 'S':
3512             along = (strend - s) / sizeof(U16);
3513             if (len > along)
3514                 len = along;
3515             if (checksum) {
3516                 while (len-- > 0) {
3517                     Copy(s, &aushort, 1, U16);
3518                     s += sizeof(U16);
3519 #ifdef HAS_NTOHS
3520                     if (datumtype == 'n')
3521                         aushort = ntohs(aushort);
3522 #endif
3523 #ifdef HAS_VTOHS
3524                     if (datumtype == 'v')
3525                         aushort = vtohs(aushort);
3526 #endif
3527                     culong += aushort;
3528                 }
3529             }
3530             else {
3531                 EXTEND(SP, len);
3532                 while (len-- > 0) {
3533                     Copy(s, &aushort, 1, U16);
3534                     s += sizeof(U16);
3535                     sv = NEWSV(39, 0);
3536 #ifdef HAS_NTOHS
3537                     if (datumtype == 'n')
3538                         aushort = ntohs(aushort);
3539 #endif
3540 #ifdef HAS_VTOHS
3541                     if (datumtype == 'v')
3542                         aushort = vtohs(aushort);
3543 #endif
3544                     sv_setiv(sv, (I32)aushort);
3545                     PUSHs(sv_2mortal(sv));
3546                 }
3547             }
3548             break;
3549         case 'i':
3550             along = (strend - s) / sizeof(int);
3551             if (len > along)
3552                 len = along;
3553             if (checksum) {
3554                 while (len-- > 0) {
3555                     Copy(s, &aint, 1, int);
3556                     s += sizeof(int);
3557                     if (checksum > 32)
3558                         cdouble += (double)aint;
3559                     else
3560                         culong += aint;
3561                 }
3562             }
3563             else {
3564                 EXTEND(SP, len);
3565                 while (len-- > 0) {
3566                     Copy(s, &aint, 1, int);
3567                     s += sizeof(int);
3568                     sv = NEWSV(40, 0);
3569                     sv_setiv(sv, (I32)aint);
3570                     PUSHs(sv_2mortal(sv));
3571                 }
3572             }
3573             break;
3574         case 'I':
3575             along = (strend - s) / sizeof(unsigned int);
3576             if (len > along)
3577                 len = along;
3578             if (checksum) {
3579                 while (len-- > 0) {
3580                     Copy(s, &auint, 1, unsigned int);
3581                     s += sizeof(unsigned int);
3582                     if (checksum > 32)
3583                         cdouble += (double)auint;
3584                     else
3585                         culong += auint;
3586                 }
3587             }
3588             else {
3589                 EXTEND(SP, len);
3590                 while (len-- > 0) {
3591                     Copy(s, &auint, 1, unsigned int);
3592                     s += sizeof(unsigned int);
3593                     sv = NEWSV(41, 0);
3594                     sv_setiv(sv, (I32)auint);
3595                     PUSHs(sv_2mortal(sv));
3596                 }
3597             }
3598             break;
3599         case 'l':
3600             along = (strend - s) / sizeof(I32);
3601             if (len > along)
3602                 len = along;
3603             if (checksum) {
3604                 while (len-- > 0) {
3605                     Copy(s, &along, 1, I32);
3606                     s += sizeof(I32);
3607                     if (checksum > 32)
3608                         cdouble += (double)along;
3609                     else
3610                         culong += along;
3611                 }
3612             }
3613             else {
3614                 EXTEND(SP, len);
3615                 while (len-- > 0) {
3616                     Copy(s, &along, 1, I32);
3617                     s += sizeof(I32);
3618                     sv = NEWSV(42, 0);
3619                     sv_setiv(sv, (I32)along);
3620                     PUSHs(sv_2mortal(sv));
3621                 }
3622             }
3623             break;
3624         case 'V':
3625         case 'N':
3626         case 'L':
3627             along = (strend - s) / sizeof(U32);
3628             if (len > along)
3629                 len = along;
3630             if (checksum) {
3631                 while (len-- > 0) {
3632                     Copy(s, &aulong, 1, U32);
3633                     s += sizeof(U32);
3634 #ifdef HAS_NTOHL
3635                     if (datumtype == 'N')
3636                         aulong = ntohl(aulong);
3637 #endif
3638 #ifdef HAS_VTOHL
3639                     if (datumtype == 'V')
3640                         aulong = vtohl(aulong);
3641 #endif
3642                     if (checksum > 32)
3643                         cdouble += (double)aulong;
3644                     else
3645                         culong += aulong;
3646                 }
3647             }
3648             else {
3649                 EXTEND(SP, len);
3650                 while (len-- > 0) {
3651                     Copy(s, &aulong, 1, U32);
3652                     s += sizeof(U32);
3653                     sv = NEWSV(43, 0);
3654 #ifdef HAS_NTOHL
3655                     if (datumtype == 'N')
3656                         aulong = ntohl(aulong);
3657 #endif
3658 #ifdef HAS_VTOHL
3659                     if (datumtype == 'V')
3660                         aulong = vtohl(aulong);
3661 #endif
3662                     sv_setnv(sv, (double)aulong);
3663                     PUSHs(sv_2mortal(sv));
3664                 }
3665             }
3666             break;
3667         case 'p':
3668             along = (strend - s) / sizeof(char*);
3669             if (len > along)
3670                 len = along;
3671             EXTEND(SP, len);
3672             while (len-- > 0) {
3673                 if (sizeof(char*) > strend - s)
3674                     break;
3675                 else {
3676                     Copy(s, &aptr, 1, char*);
3677                     s += sizeof(char*);
3678                 }
3679                 sv = NEWSV(44, 0);
3680                 if (aptr)
3681                     sv_setpv(sv, aptr);
3682                 PUSHs(sv_2mortal(sv));
3683             }
3684             break;
3685         case 'P':
3686             EXTEND(SP, 1);
3687             if (sizeof(char*) > strend - s)
3688                 break;
3689             else {
3690                 Copy(s, &aptr, 1, char*);
3691                 s += sizeof(char*);
3692             }
3693             sv = NEWSV(44, 0);
3694             if (aptr)
3695                 sv_setpvn(sv, aptr, len);
3696             PUSHs(sv_2mortal(sv));
3697             break;
3698 #ifdef QUAD
3699         case 'q':
3700             EXTEND(SP, len);
3701             while (len-- > 0) {
3702                 if (s + sizeof(quad) > strend)
3703                     aquad = 0;
3704                 else {
3705                     Copy(s, &aquad, 1, quad);
3706                     s += sizeof(quad);
3707                 }
3708                 sv = NEWSV(42, 0);
3709                 sv_setnv(sv, (double)aquad);
3710                 PUSHs(sv_2mortal(sv));
3711             }
3712             break;
3713         case 'Q':
3714             EXTEND(SP, len);
3715             while (len-- > 0) {
3716                 if (s + sizeof(unsigned quad) > strend)
3717                     auquad = 0;
3718                 else {
3719                     Copy(s, &auquad, 1, unsigned quad);
3720                     s += sizeof(unsigned quad);
3721                 }
3722                 sv = NEWSV(43, 0);
3723                 sv_setnv(sv, (double)auquad);
3724                 PUSHs(sv_2mortal(sv));
3725             }
3726             break;
3727 #endif
3728         /* float and double added gnb@melba.bby.oz.au 22/11/89 */
3729         case 'f':
3730         case 'F':
3731             along = (strend - s) / sizeof(float);
3732             if (len > along)
3733                 len = along;
3734             if (checksum) {
3735                 while (len-- > 0) {
3736                     Copy(s, &afloat, 1, float);
3737                     s += sizeof(float);
3738                     cdouble += afloat;
3739                 }
3740             }
3741             else {
3742                 EXTEND(SP, len);
3743                 while (len-- > 0) {
3744                     Copy(s, &afloat, 1, float);
3745                     s += sizeof(float);
3746                     sv = NEWSV(47, 0);
3747                     sv_setnv(sv, (double)afloat);
3748                     PUSHs(sv_2mortal(sv));
3749                 }
3750             }
3751             break;
3752         case 'd':
3753         case 'D':
3754             along = (strend - s) / sizeof(double);
3755             if (len > along)
3756                 len = along;
3757             if (checksum) {
3758                 while (len-- > 0) {
3759                     Copy(s, &adouble, 1, double);
3760                     s += sizeof(double);
3761                     cdouble += adouble;
3762                 }
3763             }
3764             else {
3765                 EXTEND(SP, len);
3766                 while (len-- > 0) {
3767                     Copy(s, &adouble, 1, double);
3768                     s += sizeof(double);
3769                     sv = NEWSV(48, 0);
3770                     sv_setnv(sv, (double)adouble);
3771                     PUSHs(sv_2mortal(sv));
3772                 }
3773             }
3774             break;
3775         case 'u':
3776             along = (strend - s) * 3 / 4;
3777             sv = NEWSV(42, along);
3778             while (s < strend && *s > ' ' && *s < 'a') {
3779                 I32 a, b, c, d;
3780                 char hunk[4];
3781
3782                 hunk[3] = '\0';
3783                 len = (*s++ - ' ') & 077;
3784                 while (len > 0) {
3785                     if (s < strend && *s >= ' ')
3786                         a = (*s++ - ' ') & 077;
3787                     else
3788                         a = 0;
3789                     if (s < strend && *s >= ' ')
3790                         b = (*s++ - ' ') & 077;
3791                     else
3792                         b = 0;
3793                     if (s < strend && *s >= ' ')
3794                         c = (*s++ - ' ') & 077;
3795                     else
3796                         c = 0;
3797                     if (s < strend && *s >= ' ')
3798                         d = (*s++ - ' ') & 077;
3799                     else
3800                         d = 0;
3801                     hunk[0] = a << 2 | b >> 4;
3802                     hunk[1] = b << 4 | c >> 2;
3803                     hunk[2] = c << 6 | d;
3804                     sv_catpvn(sv, hunk, len > 3 ? 3 : len);
3805                     len -= 3;
3806                 }
3807                 if (*s == '\n')
3808                     s++;
3809                 else if (s[1] == '\n')          /* possible checksum byte */
3810                     s += 2;
3811             }
3812             XPUSHs(sv_2mortal(sv));
3813             break;
3814         }
3815         if (checksum) {
3816             sv = NEWSV(42, 0);
3817             if (strchr("fFdD", datumtype) ||
3818               (checksum > 32 && strchr("iIlLN", datumtype)) ) {
3819                 double modf();
3820                 double trouble;
3821
3822                 adouble = 1.0;
3823                 while (checksum >= 16) {
3824                     checksum -= 16;
3825                     adouble *= 65536.0;
3826                 }
3827                 while (checksum >= 4) {
3828                     checksum -= 4;
3829                     adouble *= 16.0;
3830                 }
3831                 while (checksum--)
3832                     adouble *= 2.0;
3833                 along = (1 << checksum) - 1;
3834                 while (cdouble < 0.0)
3835                     cdouble += adouble;
3836                 cdouble = modf(cdouble / adouble, &trouble) * adouble;
3837                 sv_setnv(sv, cdouble);
3838             }
3839             else {
3840                 if (checksum < 32) {
3841                     along = (1 << checksum) - 1;
3842                     culong &= (U32)along;
3843                 }
3844                 sv_setnv(sv, (double)culong);
3845             }
3846             XPUSHs(sv_2mortal(sv));
3847             checksum = 0;
3848         }
3849     }
3850     RETURN;
3851 }
3852
3853 static void
3854 doencodes(sv, s, len)
3855 register SV *sv;
3856 register char *s;
3857 register I32 len;
3858 {
3859     char hunk[5];
3860
3861     *hunk = len + ' ';
3862     sv_catpvn(sv, hunk, 1);
3863     hunk[4] = '\0';
3864     while (len > 0) {
3865         hunk[0] = ' ' + (077 & (*s >> 2));
3866         hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
3867         hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
3868         hunk[3] = ' ' + (077 & (s[2] & 077));
3869         sv_catpvn(sv, hunk, 4);
3870         s += 3;
3871         len -= 3;
3872     }
3873     for (s = SvPVX(sv); *s; s++) {
3874         if (*s == ' ')
3875             *s = '`';
3876     }
3877     sv_catpvn(sv, "\n", 1);
3878 }
3879
3880 PP(pp_pack)
3881 {
3882     dSP; dMARK; dORIGMARK; dTARGET;
3883     register SV *cat = TARG;
3884     register I32 items;
3885     STRLEN fromlen;
3886     register char *pat = SvPVx(*++MARK, fromlen);
3887     register char *patend = pat + fromlen;
3888     register I32 len;
3889     I32 datumtype;
3890     SV *fromstr;
3891     /*SUPPRESS 442*/
3892     static char null10[] = {0,0,0,0,0,0,0,0,0,0};
3893     static char *space10 = "          ";
3894
3895     /* These must not be in registers: */
3896     char achar;
3897     I16 ashort;
3898     int aint;
3899     unsigned int auint;
3900     I32 along;
3901     U32 aulong;
3902 #ifdef QUAD
3903     quad aquad;
3904     unsigned quad auquad;
3905 #endif
3906     char *aptr;
3907     float afloat;
3908     double adouble;
3909
3910     items = SP - MARK;
3911     MARK++;
3912     sv_setpvn(cat, "", 0);
3913     while (pat < patend) {
3914 #define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
3915         datumtype = *pat++;
3916         if (*pat == '*') {
3917             len = strchr("@Xxu", datumtype) ? 0 : items;
3918             pat++;
3919         }
3920         else if (isDIGIT(*pat)) {
3921             len = *pat++ - '0';
3922             while (isDIGIT(*pat))
3923                 len = (len * 10) + (*pat++ - '0');
3924         }
3925         else
3926             len = 1;
3927         switch(datumtype) {
3928         default:
3929             break;
3930         case '%':
3931             DIE("% may only be used in unpack");
3932         case '@':
3933             len -= SvCUR(cat);
3934             if (len > 0)
3935                 goto grow;
3936             len = -len;
3937             if (len > 0)
3938                 goto shrink;
3939             break;
3940         case 'X':
3941           shrink:
3942             if (SvCUR(cat) < len)
3943                 DIE("X outside of string");
3944             SvCUR(cat) -= len;
3945             *SvEND(cat) = '\0';
3946             break;
3947         case 'x':
3948           grow:
3949             while (len >= 10) {
3950                 sv_catpvn(cat, null10, 10);
3951                 len -= 10;
3952             }
3953             sv_catpvn(cat, null10, len);
3954             break;
3955         case 'A':
3956         case 'a':
3957             fromstr = NEXTFROM;
3958             aptr = SvPV(fromstr, fromlen);
3959             if (pat[-1] == '*')
3960                 len = fromlen;
3961             if (fromlen > len)
3962                 sv_catpvn(cat, aptr, len);
3963             else {
3964                 sv_catpvn(cat, aptr, fromlen);
3965                 len -= fromlen;
3966                 if (datumtype == 'A') {
3967                     while (len >= 10) {
3968                         sv_catpvn(cat, space10, 10);
3969                         len -= 10;
3970                     }
3971                     sv_catpvn(cat, space10, len);
3972                 }
3973                 else {
3974                     while (len >= 10) {
3975                         sv_catpvn(cat, null10, 10);
3976                         len -= 10;
3977                     }
3978                     sv_catpvn(cat, null10, len);
3979                 }
3980             }
3981             break;
3982         case 'B':
3983         case 'b':
3984             {
3985                 char *savepat = pat;
3986                 I32 saveitems;
3987
3988                 fromstr = NEXTFROM;
3989                 saveitems = items;
3990                 aptr = SvPV(fromstr, fromlen);
3991                 if (pat[-1] == '*')
3992                     len = fromlen;
3993                 pat = aptr;
3994                 aint = SvCUR(cat);
3995                 SvCUR(cat) += (len+7)/8;
3996                 SvGROW(cat, SvCUR(cat) + 1);
3997                 aptr = SvPVX(cat) + aint;
3998                 if (len > fromlen)
3999                     len = fromlen;
4000                 aint = len;
4001                 items = 0;
4002                 if (datumtype == 'B') {
4003                     for (len = 0; len++ < aint;) {
4004                         items |= *pat++ & 1;
4005                         if (len & 7)
4006                             items <<= 1;
4007                         else {
4008                             *aptr++ = items & 0xff;
4009                             items = 0;
4010                         }
4011                     }
4012                 }
4013                 else {
4014                     for (len = 0; len++ < aint;) {
4015                         if (*pat++ & 1)
4016                             items |= 128;
4017                         if (len & 7)
4018                             items >>= 1;
4019                         else {
4020                             *aptr++ = items & 0xff;
4021                             items = 0;
4022                         }
4023                     }
4024                 }
4025                 if (aint & 7) {
4026                     if (datumtype == 'B')
4027                         items <<= 7 - (aint & 7);
4028                     else
4029                         items >>= 7 - (aint & 7);
4030                     *aptr++ = items & 0xff;
4031                 }
4032                 pat = SvPVX(cat) + SvCUR(cat);
4033                 while (aptr <= pat)
4034                     *aptr++ = '\0';
4035
4036                 pat = savepat;
4037                 items = saveitems;
4038             }
4039             break;
4040         case 'H':
4041         case 'h':
4042             {
4043                 char *savepat = pat;
4044                 I32 saveitems;
4045
4046                 fromstr = NEXTFROM;
4047                 saveitems = items;
4048                 aptr = SvPV(fromstr, fromlen);
4049                 if (pat[-1] == '*')
4050                     len = fromlen;
4051                 pat = aptr;
4052                 aint = SvCUR(cat);
4053                 SvCUR(cat) += (len+1)/2;
4054                 SvGROW(cat, SvCUR(cat) + 1);
4055                 aptr = SvPVX(cat) + aint;
4056                 if (len > fromlen)
4057                     len = fromlen;
4058                 aint = len;
4059                 items = 0;
4060                 if (datumtype == 'H') {
4061                     for (len = 0; len++ < aint;) {
4062                         if (isALPHA(*pat))
4063                             items |= ((*pat++ & 15) + 9) & 15;
4064                         else
4065                             items |= *pat++ & 15;
4066                         if (len & 1)
4067                             items <<= 4;
4068                         else {
4069                             *aptr++ = items & 0xff;
4070                             items = 0;
4071                         }
4072                     }
4073                 }
4074                 else {
4075                     for (len = 0; len++ < aint;) {
4076                         if (isALPHA(*pat))
4077                             items |= (((*pat++ & 15) + 9) & 15) << 4;
4078                         else
4079                             items |= (*pat++ & 15) << 4;
4080                         if (len & 1)
4081                             items >>= 4;
4082                         else {
4083                             *aptr++ = items & 0xff;
4084                             items = 0;
4085                         }
4086                     }
4087                 }
4088                 if (aint & 1)
4089                     *aptr++ = items & 0xff;
4090                 pat = SvPVX(cat) + SvCUR(cat);
4091                 while (aptr <= pat)
4092                     *aptr++ = '\0';
4093
4094                 pat = savepat;
4095                 items = saveitems;
4096             }
4097             break;
4098         case 'C':
4099         case 'c':
4100             while (len-- > 0) {
4101                 fromstr = NEXTFROM;
4102                 aint = SvIV(fromstr);
4103                 achar = aint;
4104                 sv_catpvn(cat, &achar, sizeof(char));
4105             }
4106             break;
4107         /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
4108         case 'f':
4109         case 'F':
4110             while (len-- > 0) {
4111                 fromstr = NEXTFROM;
4112                 afloat = (float)SvNV(fromstr);
4113                 sv_catpvn(cat, (char *)&afloat, sizeof (float));
4114             }
4115             break;
4116         case 'd':
4117         case 'D':
4118             while (len-- > 0) {
4119                 fromstr = NEXTFROM;
4120                 adouble = (double)SvNV(fromstr);
4121                 sv_catpvn(cat, (char *)&adouble, sizeof (double));
4122             }
4123             break;
4124         case 'n':
4125             while (len-- > 0) {
4126                 fromstr = NEXTFROM;
4127                 ashort = (I16)SvIV(fromstr);
4128 #ifdef HAS_HTONS
4129                 ashort = htons(ashort);
4130 #endif
4131                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
4132             }
4133             break;
4134         case 'v':
4135             while (len-- > 0) {
4136                 fromstr = NEXTFROM;
4137                 ashort = (I16)SvIV(fromstr);
4138 #ifdef HAS_HTOVS
4139                 ashort = htovs(ashort);
4140 #endif
4141                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
4142             }
4143             break;
4144         case 'S':
4145         case 's':
4146             while (len-- > 0) {
4147                 fromstr = NEXTFROM;
4148                 ashort = (I16)SvIV(fromstr);
4149                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
4150             }
4151             break;
4152         case 'I':
4153             while (len-- > 0) {
4154                 fromstr = NEXTFROM;
4155                 auint = U_I(SvNV(fromstr));
4156                 sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
4157             }
4158             break;
4159         case 'i':
4160             while (len-- > 0) {
4161                 fromstr = NEXTFROM;
4162                 aint = SvIV(fromstr);
4163                 sv_catpvn(cat, (char*)&aint, sizeof(int));
4164             }
4165             break;
4166         case 'N':
4167             while (len-- > 0) {
4168                 fromstr = NEXTFROM;
4169                 aulong = U_L(SvNV(fromstr));
4170 #ifdef HAS_HTONL
4171                 aulong = htonl(aulong);
4172 #endif
4173                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
4174             }
4175             break;
4176         case 'V':
4177             while (len-- > 0) {
4178                 fromstr = NEXTFROM;
4179                 aulong = U_L(SvNV(fromstr));
4180 #ifdef HAS_HTOVL
4181                 aulong = htovl(aulong);
4182 #endif
4183                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
4184             }
4185             break;
4186         case 'L':
4187             while (len-- > 0) {
4188                 fromstr = NEXTFROM;
4189                 aulong = U_L(SvNV(fromstr));
4190                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
4191             }
4192             break;
4193         case 'l':
4194             while (len-- > 0) {
4195                 fromstr = NEXTFROM;
4196                 along = SvIV(fromstr);
4197                 sv_catpvn(cat, (char*)&along, sizeof(I32));
4198             }
4199             break;
4200 #ifdef QUAD
4201         case 'Q':
4202             while (len-- > 0) {
4203                 fromstr = NEXTFROM;
4204                 auquad = (unsigned quad)SvNV(fromstr);
4205                 sv_catpvn(cat, (char*)&auquad, sizeof(unsigned quad));
4206             }
4207             break;
4208         case 'q':
4209             while (len-- > 0) {
4210                 fromstr = NEXTFROM;
4211                 aquad = (quad)SvNV(fromstr);
4212                 sv_catpvn(cat, (char*)&aquad, sizeof(quad));
4213             }
4214             break;
4215 #endif /* QUAD */
4216         case 'P':
4217             len = 1;            /* assume SV is correct length */
4218             /* FALL THROUGH */
4219         case 'p':
4220             while (len-- > 0) {
4221                 fromstr = NEXTFROM;
4222                 aptr = SvPV(fromstr, na);
4223                 sv_catpvn(cat, (char*)&aptr, sizeof(char*));
4224             }
4225             break;
4226         case 'u':
4227             fromstr = NEXTFROM;
4228             aptr = SvPV(fromstr, fromlen);
4229             SvGROW(cat, fromlen * 4 / 3);
4230             if (len <= 1)
4231                 len = 45;
4232             else
4233                 len = len / 3 * 3;
4234             while (fromlen > 0) {
4235                 I32 todo;
4236
4237                 if (fromlen > len)
4238                     todo = len;
4239                 else
4240                     todo = fromlen;
4241                 doencodes(cat, aptr, todo);
4242                 fromlen -= todo;
4243                 aptr += todo;
4244             }
4245             break;
4246         }
4247     }
4248     SvSETMAGIC(cat);
4249     SP = ORIGMARK;
4250     PUSHs(cat);
4251     RETURN;
4252 }
4253 #undef NEXTFROM
4254
4255 PP(pp_split)
4256 {
4257     dSP; dTARG;
4258     AV *ary;
4259     register I32 limit = POPi;                  /* note, negative is forever */
4260     SV *sv = POPs;
4261     STRLEN len;
4262     register char *s = SvPV(sv, len);
4263     char *strend = s + len;
4264     register PMOP *pm = (PMOP*)POPs;
4265     register SV *dstr;
4266     register char *m;
4267     I32 iters = 0;
4268     I32 maxiters = (strend - s) + 10;
4269     I32 i;
4270     char *orig;
4271     I32 origlimit = limit;
4272     I32 realarray = 0;
4273     I32 base;
4274     AV *oldstack;
4275     register REGEXP *rx = pm->op_pmregexp;
4276     I32 gimme = GIMME;
4277
4278     if (!pm || !s)
4279         DIE("panic: do_split");
4280     if (pm->op_pmreplroot)
4281         ary = GvAVn((GV*)pm->op_pmreplroot);
4282     else
4283         ary = Nullav;
4284     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
4285         realarray = 1;
4286         if (!AvREAL(ary)) {
4287             AvREAL_on(ary);
4288             for (i = AvFILL(ary); i >= 0; i--)
4289                 AvARRAY(ary)[i] = Nullsv;       /* don't free mere refs */
4290         }
4291         av_fill(ary,0);         /* force allocation */
4292         av_fill(ary,-1);
4293         /* temporarily switch stacks */
4294         oldstack = stack;
4295         SWITCHSTACK(stack, ary);
4296     }
4297     base = SP - stack_base + 1;
4298     orig = s;
4299     if (pm->op_pmflags & PMf_SKIPWHITE) {
4300         while (isSPACE(*s))
4301             s++;
4302     }
4303     if (!limit)
4304         limit = maxiters + 2;
4305     if (strEQ("\\s+", rx->precomp)) {
4306         while (--limit) {
4307             /*SUPPRESS 530*/
4308             for (m = s; m < strend && !isSPACE(*m); m++) ;
4309             if (m >= strend)
4310                 break;
4311             dstr = NEWSV(30, m-s);
4312             sv_setpvn(dstr, s, m-s);
4313             if (!realarray)
4314                 sv_2mortal(dstr);
4315             XPUSHs(dstr);
4316             /*SUPPRESS 530*/
4317             for (s = m + 1; s < strend && isSPACE(*s); s++) ;
4318         }
4319     }
4320     else if (strEQ("^", rx->precomp)) {
4321         while (--limit) {
4322             /*SUPPRESS 530*/
4323             for (m = s; m < strend && *m != '\n'; m++) ;
4324             m++;
4325             if (m >= strend)
4326                 break;
4327             dstr = NEWSV(30, m-s);
4328             sv_setpvn(dstr, s, m-s);
4329             if (!realarray)
4330                 sv_2mortal(dstr);
4331             XPUSHs(dstr);
4332             s = m;
4333         }
4334     }
4335     else if (pm->op_pmshort) {
4336         i = SvCUR(pm->op_pmshort);
4337         if (i == 1) {
4338             I32 fold = (pm->op_pmflags & PMf_FOLD);
4339             i = *SvPVX(pm->op_pmshort);
4340             if (fold && isUPPER(i))
4341                 i = tolower(i);
4342             while (--limit) {
4343                 if (fold) {
4344                     for ( m = s;
4345                           m < strend && *m != i &&
4346                             (!isUPPER(*m) || tolower(*m) != i);
4347                           m++)                  /*SUPPRESS 530*/
4348                         ;
4349                 }
4350                 else                            /*SUPPRESS 530*/
4351                     for (m = s; m < strend && *m != i; m++) ;
4352                 if (m >= strend)
4353                     break;
4354                 dstr = NEWSV(30, m-s);
4355                 sv_setpvn(dstr, s, m-s);
4356                 if (!realarray)
4357                     sv_2mortal(dstr);
4358                 XPUSHs(dstr);
4359                 s = m + 1;
4360             }
4361         }
4362         else {
4363 #ifndef lint
4364             while (s < strend && --limit &&
4365               (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
4366                     pm->op_pmshort)) )
4367 #endif
4368             {
4369                 dstr = NEWSV(31, m-s);
4370                 sv_setpvn(dstr, s, m-s);
4371                 if (!realarray)
4372                     sv_2mortal(dstr);
4373                 XPUSHs(dstr);
4374                 s = m + i;
4375             }
4376         }
4377     }
4378     else {
4379         maxiters += (strend - s) * rx->nparens;
4380         while (s < strend && --limit &&
4381             regexec(rx, s, strend, orig, 1, Nullsv, TRUE) ) {
4382             if (rx->subbase
4383               && rx->subbase != orig) {
4384                 m = s;
4385                 s = orig;
4386                 orig = rx->subbase;
4387                 s = orig + (m - s);
4388                 strend = s + (strend - m);
4389             }
4390             m = rx->startp[0];
4391             dstr = NEWSV(32, m-s);
4392             sv_setpvn(dstr, s, m-s);
4393             if (!realarray)
4394                 sv_2mortal(dstr);
4395             XPUSHs(dstr);
4396             if (rx->nparens) {
4397                 for (i = 1; i <= rx->nparens; i++) {
4398                     s = rx->startp[i];
4399                     m = rx->endp[i];
4400                     dstr = NEWSV(33, m-s);
4401                     sv_setpvn(dstr, s, m-s);
4402                     if (!realarray)
4403                         sv_2mortal(dstr);
4404                     XPUSHs(dstr);
4405                 }
4406             }
4407             s = rx->endp[0];
4408         }
4409     }
4410     iters = (SP - stack_base) - base;
4411     if (iters > maxiters)
4412         DIE("Split loop");
4413     if (s < strend || origlimit) {      /* keep field after final delim? */
4414         dstr = NEWSV(34, strend-s);
4415         sv_setpvn(dstr, s, strend-s);
4416         if (!realarray)
4417             sv_2mortal(dstr);
4418         XPUSHs(dstr);
4419         iters++;
4420     }
4421     else {
4422         while (iters > 0 && SvCUR(TOPs) == 0)
4423             iters--, SP--;
4424     }
4425     if (realarray) {
4426         SWITCHSTACK(ary, oldstack);
4427         if (gimme == G_ARRAY) {
4428             EXTEND(SP, iters);
4429             Copy(AvARRAY(ary), SP + 1, iters, SV*);
4430             SP += iters;
4431             RETURN;
4432         }
4433     }
4434     else {
4435         if (gimme == G_ARRAY)
4436             RETURN;
4437     }
4438     SP = stack_base + base;
4439     GETTARGET;
4440     PUSHi(iters);
4441     RETURN;
4442 }
4443
4444 PP(pp_join)
4445 {
4446     dSP; dMARK; dTARGET;
4447     MARK++;
4448     do_join(TARG, *MARK, MARK, SP);
4449     SP = MARK;
4450     SETs(TARG);
4451     RETURN;
4452 }
4453
4454 /* List operators. */
4455
4456 PP(pp_list)
4457 {
4458     dSP;
4459     if (GIMME != G_ARRAY) {
4460         dMARK;
4461         if (++MARK <= SP)
4462             *MARK = *SP;                /* unwanted list, return last item */
4463         else
4464             *MARK = &sv_undef;
4465         SP = MARK;
4466     }
4467     else if (op->op_private & OPpLIST_GUESSED)  /* didn't need that pushmark */
4468         markstack_ptr--;
4469     RETURN;
4470 }
4471
4472 PP(pp_lslice)
4473 {
4474     dSP;
4475     SV **lastrelem = stack_sp;
4476     SV **lastlelem = stack_base + POPMARK;
4477     SV **firstlelem = stack_base + POPMARK + 1;
4478     register SV **firstrelem = lastlelem + 1;
4479     I32 lval = op->op_flags & OPf_LVAL;
4480     I32 is_something_there = lval;
4481
4482     register I32 max = lastrelem - lastlelem;
4483     register SV **lelem;
4484     register I32 ix;
4485
4486     if (GIMME != G_ARRAY) {
4487         ix = SvIVx(*lastlelem) - arybase;
4488         if (ix < 0 || ix >= max)
4489             *firstlelem = &sv_undef;
4490         else
4491             *firstlelem = firstrelem[ix];
4492         SP = firstlelem;
4493         RETURN;
4494     }
4495
4496     if (max == 0) {
4497         SP = firstlelem - 1;
4498         RETURN;
4499     }
4500
4501     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
4502         ix = SvIVx(*lelem) - arybase;
4503         if (ix < 0) {
4504             ix += max;
4505             if (ix < 0)
4506                 *lelem = &sv_undef;
4507             else if (!(*lelem = firstrelem[ix]))
4508                 *lelem = &sv_undef;
4509         }
4510         else if (ix >= max || !(*lelem = firstrelem[ix]))
4511             *lelem = &sv_undef;
4512         if (!is_something_there && SvOK(*lelem))
4513             is_something_there = TRUE;
4514     }
4515     if (is_something_there)
4516         SP = lastlelem;
4517     else
4518         SP = firstlelem - 1;
4519     RETURN;
4520 }
4521
4522 PP(pp_anonlist)
4523 {
4524     dSP; dMARK;
4525     I32 items = SP - MARK;
4526     SP = MARK;
4527     XPUSHs((SV*)av_make(items, MARK+1));
4528     RETURN;
4529 }
4530
4531 PP(pp_anonhash)
4532 {
4533     dSP; dMARK; dORIGMARK;
4534     HV* hv = newHV();
4535     SvREFCNT(hv) = 0;
4536     while (MARK < SP) {
4537         SV* key = *++MARK;
4538         char *tmps;
4539         SV *val = NEWSV(46, 0);
4540         if (MARK < SP)
4541             sv_setsv(val, *++MARK);
4542         tmps = SvPVX(key);
4543         (void)hv_store(hv,tmps,SvCUROK(key),val,0);
4544     }
4545     SP = ORIGMARK;
4546     SvOK_on(hv);
4547     XPUSHs((SV*)hv);
4548     RETURN;
4549 }
4550
4551 PP(pp_splice)
4552 {
4553     dSP; dMARK; dORIGMARK;
4554     register AV *ary = (AV*)*++MARK;
4555     register SV **src;
4556     register SV **dst;
4557     register I32 i;
4558     register I32 offset;
4559     register I32 length;
4560     I32 newlen;
4561     I32 after;
4562     I32 diff;
4563     SV **tmparyval;
4564
4565     SP++;
4566
4567     if (++MARK < SP) {
4568         offset = SvIVx(*MARK);
4569         if (offset < 0)
4570             offset += AvFILL(ary) + 1;
4571         else
4572             offset -= arybase;
4573         if (++MARK < SP) {
4574             length = SvIVx(*MARK++);
4575             if (length < 0)
4576                 length = 0;
4577         }
4578         else
4579             length = AvMAX(ary) + 1;            /* close enough to infinity */
4580     }
4581     else {
4582         offset = 0;
4583         length = AvMAX(ary) + 1;
4584     }
4585     if (offset < 0) {
4586         length += offset;
4587         offset = 0;
4588         if (length < 0)
4589             length = 0;
4590     }
4591     if (offset > AvFILL(ary) + 1)
4592         offset = AvFILL(ary) + 1;
4593     after = AvFILL(ary) + 1 - (offset + length);
4594     if (after < 0) {                            /* not that much array */
4595         length += after;                        /* offset+length now in array */
4596         after = 0;
4597         if (!AvALLOC(ary)) {
4598             av_fill(ary, 0);
4599             av_fill(ary, -1);
4600         }
4601     }
4602
4603     /* At this point, MARK .. SP-1 is our new LIST */
4604
4605     newlen = SP - MARK;
4606     diff = newlen - length;
4607
4608     if (diff < 0) {                             /* shrinking the area */
4609         if (newlen) {
4610             New(451, tmparyval, newlen, SV*);   /* so remember insertion */
4611             Copy(MARK, tmparyval, newlen, SV*);
4612         }
4613
4614         MARK = ORIGMARK + 1;
4615         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
4616             MEXTEND(MARK, length);
4617             Copy(AvARRAY(ary)+offset, MARK, length, SV*);
4618             if (AvREAL(ary)) {
4619                 for (i = length, dst = MARK; i; i--)
4620                     sv_2mortal(*dst++); /* free them eventualy */
4621             }
4622             MARK += length - 1;
4623         }
4624         else {
4625             *MARK = AvARRAY(ary)[offset+length-1];
4626             if (AvREAL(ary)) {
4627                 sv_2mortal(*MARK);
4628                 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
4629                     sv_free(*dst++);    /* free them now */
4630             }
4631         }
4632         AvFILL(ary) += diff;
4633
4634         /* pull up or down? */
4635
4636         if (offset < after) {                   /* easier to pull up */
4637             if (offset) {                       /* esp. if nothing to pull */
4638                 src = &AvARRAY(ary)[offset-1];
4639                 dst = src - diff;               /* diff is negative */
4640                 for (i = offset; i > 0; i--)    /* can't trust Copy */
4641                     *dst-- = *src--;
4642             }
4643             Zero(AvARRAY(ary), -diff, SV*);
4644             AvARRAY(ary) -= diff;               /* diff is negative */
4645             AvMAX(ary) += diff;
4646         }
4647         else {
4648             if (after) {                        /* anything to pull down? */
4649                 src = AvARRAY(ary) + offset + length;
4650                 dst = src + diff;               /* diff is negative */
4651                 Move(src, dst, after, SV*);
4652             }
4653             Zero(&AvARRAY(ary)[AvFILL(ary)+1], -diff, SV*);
4654                                                 /* avoid later double free */
4655         }
4656         if (newlen) {
4657             for (src = tmparyval, dst = AvARRAY(ary) + offset;
4658               newlen; newlen--) {
4659                 *dst = NEWSV(46, 0);
4660                 sv_setsv(*dst++, *src++);
4661             }
4662             Safefree(tmparyval);
4663         }
4664     }
4665     else {                                      /* no, expanding (or same) */
4666         if (length) {
4667             New(452, tmparyval, length, SV*);   /* so remember deletion */
4668             Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
4669         }
4670
4671         if (diff > 0) {                         /* expanding */
4672
4673             /* push up or down? */
4674
4675             if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
4676                 if (offset) {
4677                     src = AvARRAY(ary);
4678                     dst = src - diff;
4679                     Move(src, dst, offset, SV*);
4680                 }
4681                 AvARRAY(ary) -= diff;           /* diff is positive */
4682                 AvMAX(ary) += diff;
4683                 AvFILL(ary) += diff;
4684             }
4685             else {
4686                 if (AvFILL(ary) + diff >= AvMAX(ary))   /* oh, well */
4687                     av_store(ary, AvFILL(ary) + diff, Nullsv);
4688                 else
4689                     AvFILL(ary) += diff;
4690                 dst = AvARRAY(ary) + AvFILL(ary);
4691                 for (i = diff; i > 0; i--) {
4692                     if (*dst)                   /* stuff was hanging around */
4693                         sv_free(*dst);          /*  after $#foo */
4694                     dst--;
4695                 }
4696                 if (after) {
4697                     dst = AvARRAY(ary) + AvFILL(ary);
4698                     src = dst - diff;
4699                     for (i = after; i; i--) {
4700                         *dst-- = *src--;
4701                     }
4702                 }
4703             }
4704         }
4705
4706         for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
4707             *dst = NEWSV(46, 0);
4708             sv_setsv(*dst++, *src++);
4709         }
4710         MARK = ORIGMARK + 1;
4711         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
4712             if (length) {
4713                 Copy(tmparyval, MARK, length, SV*);
4714                 if (AvREAL(ary)) {
4715                     for (i = length, dst = MARK; i; i--)
4716                         sv_2mortal(*dst++);     /* free them eventualy */
4717                 }
4718                 Safefree(tmparyval);
4719             }
4720             MARK += length - 1;
4721         }
4722         else if (length--) {
4723             *MARK = tmparyval[length];
4724             if (AvREAL(ary)) {
4725                 sv_2mortal(*MARK);
4726                 while (length-- > 0)
4727                     sv_free(tmparyval[length]);
4728             }
4729             Safefree(tmparyval);
4730         }
4731         else
4732             *MARK = &sv_undef;
4733     }
4734     SP = MARK;
4735     RETURN;
4736 }
4737
4738 PP(pp_push)
4739 {
4740     dSP; dMARK; dORIGMARK; dTARGET;
4741     register AV *ary = (AV*)*++MARK;
4742     register SV *sv = &sv_undef;
4743
4744     for (++MARK; MARK <= SP; MARK++) {
4745         sv = NEWSV(51, 0);
4746         if (*MARK)
4747             sv_setsv(sv, *MARK);
4748         (void)av_push(ary, sv);
4749     }
4750     SP = ORIGMARK;
4751     PUSHi( AvFILL(ary) + 1 );
4752     RETURN;
4753 }
4754
4755 PP(pp_pop)
4756 {
4757     dSP;
4758     AV *av = (AV*)POPs;
4759     SV *sv = av_pop(av);
4760     if (!sv)
4761         RETPUSHUNDEF;
4762     if (AvREAL(av))
4763         (void)sv_2mortal(sv);
4764     PUSHs(sv);
4765     RETURN;
4766 }
4767
4768 PP(pp_shift)
4769 {
4770     dSP;
4771     AV *av = (AV*)POPs;
4772     SV *sv = av_shift(av);
4773     EXTEND(SP, 1);
4774     if (!sv)
4775         RETPUSHUNDEF;
4776     if (AvREAL(av))
4777         (void)sv_2mortal(sv);
4778     PUSHs(sv);
4779     RETURN;
4780 }
4781
4782 PP(pp_unshift)
4783 {
4784     dSP; dMARK; dORIGMARK; dTARGET;
4785     register AV *ary = (AV*)*++MARK;
4786     register SV *sv;
4787     register I32 i = 0;
4788
4789     av_unshift(ary, SP - MARK);
4790     while (MARK < SP) {
4791         sv = NEWSV(27, 0);
4792         sv_setsv(sv, *++MARK);
4793         (void)av_store(ary, i++, sv);
4794     }
4795
4796     SP = ORIGMARK;
4797     PUSHi( AvFILL(ary) + 1 );
4798     RETURN;
4799 }
4800
4801 PP(pp_grepstart)
4802 {
4803     dSP;
4804     SV *src;
4805
4806     if (stack_base + *markstack_ptr == sp) {
4807         POPMARK;
4808         RETURNOP(op->op_next->op_next);
4809     }
4810     stack_sp = stack_base + *markstack_ptr + 1;
4811     pp_pushmark();                              /* push dst */
4812     pp_pushmark();                              /* push src */
4813     ENTER;                                      /* enter outer scope */
4814
4815     SAVETMPS;
4816     SAVESPTR(GvSV(defgv));
4817
4818     ENTER;                                      /* enter inner scope */
4819     SAVESPTR(curpm);
4820
4821     if (src = stack_base[*markstack_ptr]) {
4822         SvTEMP_off(src);
4823         GvSV(defgv) = src;
4824     }
4825     else
4826         GvSV(defgv) = sv_mortalcopy(&sv_undef);
4827
4828     RETURNOP(((LOGOP*)op->op_next)->op_other);
4829 }
4830
4831 PP(pp_grepwhile)
4832 {
4833     dSP;
4834
4835     if (SvTRUEx(POPs))
4836         stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
4837     ++*markstack_ptr;
4838     LEAVE;                                      /* exit inner scope */
4839