perl 3.0 patch #7 (combined patch)
[perl.git] / dolist.c
1 /* $Header: dolist.c,v 3.0.1.3 89/11/17 15:14:45 lwall Locked $
2  *
3  *    Copyright (c) 1989, Larry Wall
4  *
5  *    You may distribute under the terms of the GNU General Public License
6  *    as specified in the README file that comes with the perl 3.0 kit.
7  *
8  * $Log:        dolist.c,v $
9  * Revision 3.0.1.3  89/11/17  15:14:45  lwall
10  * patch5: grep() occasionally loses arguments or dumps core
11  * 
12  * Revision 3.0.1.2  89/11/11  04:28:17  lwall
13  * patch2: non-existent slice values are now undefined rather than null
14  * 
15  * Revision 3.0.1.1  89/10/26  23:11:51  lwall
16  * patch1: split in a subroutine wrongly freed referenced arguments
17  * patch1: reverse didn't work
18  * 
19  * Revision 3.0  89/10/18  15:11:02  lwall
20  * 3.0 baseline
21  * 
22  */
23
24 #include "EXTERN.h"
25 #include "perl.h"
26
27
28 int
29 do_match(str,arg,gimme,arglast)
30 STR *str;
31 register ARG *arg;
32 int gimme;
33 int *arglast;
34 {
35     register STR **st = stack->ary_array;
36     register SPAT *spat = arg[2].arg_ptr.arg_spat;
37     register char *t;
38     register int sp = arglast[0] + 1;
39     STR *srchstr = st[sp];
40     register char *s = str_get(st[sp]);
41     char *strend = s + st[sp]->str_cur;
42     STR *tmpstr;
43
44     if (!spat) {
45         if (gimme == G_ARRAY)
46             return --sp;
47         str_set(str,Yes);
48         STABSET(str);
49         st[sp] = str;
50         return sp;
51     }
52     if (!s)
53         fatal("panic: do_match");
54     if (spat->spat_flags & SPAT_USED) {
55 #ifdef DEBUGGING
56         if (debug & 8)
57             deb("2.SPAT USED\n");
58 #endif
59         if (gimme == G_ARRAY)
60             return --sp;
61         str_set(str,No);
62         STABSET(str);
63         st[sp] = str;
64         return sp;
65     }
66     --sp;
67     if (spat->spat_runtime) {
68         nointrp = "|)";
69         sp = eval(spat->spat_runtime,G_SCALAR,sp);
70         st = stack->ary_array;
71         t = str_get(tmpstr = st[sp--]);
72         nointrp = "";
73 #ifdef DEBUGGING
74         if (debug & 8)
75             deb("2.SPAT /%s/\n",t);
76 #endif
77         if (spat->spat_regexp)
78             regfree(spat->spat_regexp);
79         spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
80             spat->spat_flags & SPAT_FOLD,1);
81         if (!*spat->spat_regexp->precomp && lastspat)
82             spat = lastspat;
83         if (spat->spat_flags & SPAT_KEEP) {
84             arg_free(spat->spat_runtime);       /* it won't change, so */
85             spat->spat_runtime = Nullarg;       /* no point compiling again */
86         }
87         if (!spat->spat_regexp->nparens)
88             gimme = G_SCALAR;                   /* accidental array context? */
89         if (regexec(spat->spat_regexp, s, strend, s, 0,
90           srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
91           gimme == G_ARRAY)) {
92             if (spat->spat_regexp->subbase)
93                 curspat = spat;
94             lastspat = spat;
95             goto gotcha;
96         }
97         else {
98             if (gimme == G_ARRAY)
99                 return sp;
100             str_sset(str,&str_no);
101             STABSET(str);
102             st[++sp] = str;
103             return sp;
104         }
105     }
106     else {
107 #ifdef DEBUGGING
108         if (debug & 8) {
109             char ch;
110
111             if (spat->spat_flags & SPAT_ONCE)
112                 ch = '?';
113             else
114                 ch = '/';
115             deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
116         }
117 #endif
118         if (!*spat->spat_regexp->precomp && lastspat)
119             spat = lastspat;
120         t = s;
121         if (hint) {
122             if (hint < s || hint > strend)
123                 fatal("panic: hint in do_match");
124             s = hint;
125             hint = Nullch;
126             if (spat->spat_regexp->regback >= 0) {
127                 s -= spat->spat_regexp->regback;
128                 if (s < t)
129                     s = t;
130             }
131             else
132                 s = t;
133         }
134         else if (spat->spat_short) {
135             if (spat->spat_flags & SPAT_SCANFIRST) {
136                 if (srchstr->str_pok & SP_STUDIED) {
137                     if (screamfirst[spat->spat_short->str_rare] < 0)
138                         goto nope;
139                     else if (!(s = screaminstr(srchstr,spat->spat_short)))
140                         goto nope;
141                     else if (spat->spat_flags & SPAT_ALL)
142                         goto yup;
143                 }
144 #ifndef lint
145                 else if (!(s = fbminstr((unsigned char*)s,
146                   (unsigned char*)strend, spat->spat_short)))
147                     goto nope;
148 #endif
149                 else if (spat->spat_flags & SPAT_ALL)
150                     goto yup;
151                 if (s && spat->spat_regexp->regback >= 0) {
152                     ++spat->spat_short->str_u.str_useful;
153                     s -= spat->spat_regexp->regback;
154                     if (s < t)
155                         s = t;
156                 }
157                 else
158                     s = t;
159             }
160             else if (!multiline && (*spat->spat_short->str_ptr != *s ||
161               bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
162                 goto nope;
163             if (--spat->spat_short->str_u.str_useful < 0) {
164                 str_free(spat->spat_short);
165                 spat->spat_short = Nullstr;     /* opt is being useless */
166             }
167         }
168         if (!spat->spat_regexp->nparens)
169             gimme = G_SCALAR;                   /* accidental array context? */
170         if (regexec(spat->spat_regexp, s, strend, t, 0,
171           srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
172           gimme == G_ARRAY)) {
173             if (spat->spat_regexp->subbase)
174                 curspat = spat;
175             lastspat = spat;
176             if (spat->spat_flags & SPAT_ONCE)
177                 spat->spat_flags |= SPAT_USED;
178             goto gotcha;
179         }
180         else {
181             if (gimme == G_ARRAY)
182                 return sp;
183             str_sset(str,&str_no);
184             STABSET(str);
185             st[++sp] = str;
186             return sp;
187         }
188     }
189     /*NOTREACHED*/
190
191   gotcha:
192     if (gimme == G_ARRAY) {
193         int iters, i, len;
194
195         iters = spat->spat_regexp->nparens;
196         if (sp + iters >= stack->ary_max) {
197             astore(stack,sp + iters, Nullstr);
198             st = stack->ary_array;              /* possibly realloced */
199         }
200
201         for (i = 1; i <= iters; i++) {
202             st[++sp] = str_static(&str_no);
203             if (s = spat->spat_regexp->startp[i]) {
204                 len = spat->spat_regexp->endp[i] - s;
205                 if (len > 0)
206                     str_nset(st[sp],s,len);
207             }
208         }
209         return sp;
210     }
211     else {
212         str_sset(str,&str_yes);
213         STABSET(str);
214         st[++sp] = str;
215         return sp;
216     }
217
218 yup:
219     ++spat->spat_short->str_u.str_useful;
220     lastspat = spat;
221     if (spat->spat_flags & SPAT_ONCE)
222         spat->spat_flags |= SPAT_USED;
223     if (sawampersand) {
224         char *tmps;
225
226         tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
227         tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
228         spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
229         curspat = spat;
230     }
231     str_sset(str,&str_yes);
232     STABSET(str);
233     st[++sp] = str;
234     return sp;
235
236 nope:
237     ++spat->spat_short->str_u.str_useful;
238     if (gimme == G_ARRAY)
239         return sp;
240     str_sset(str,&str_no);
241     STABSET(str);
242     st[++sp] = str;
243     return sp;
244 }
245
246 int
247 do_split(str,spat,limit,gimme,arglast)
248 STR *str;
249 register SPAT *spat;
250 register int limit;
251 int gimme;
252 int *arglast;
253 {
254     register ARRAY *ary = stack;
255     STR **st = ary->ary_array;
256     register int sp = arglast[0] + 1;
257     register char *s = str_get(st[sp]);
258     char *strend = s + st[sp--]->str_cur;
259     register STR *dstr;
260     register char *m;
261     int iters = 0;
262     int i;
263     char *orig;
264     int origlimit = limit;
265     int realarray = 0;
266
267     if (!spat || !s)
268         fatal("panic: do_split");
269     else if (spat->spat_runtime) {
270         nointrp = "|)";
271         sp = eval(spat->spat_runtime,G_SCALAR,sp);
272         st = stack->ary_array;
273         m = str_get(dstr = st[sp--]);
274         nointrp = "";
275         if (!dstr->str_cur || (*m == ' ' && dstr->str_cur == 1)) {
276             str_set(dstr,"\\s+");
277             m = dstr->str_ptr;
278             spat->spat_flags |= SPAT_SKIPWHITE;
279         }
280         if (spat->spat_regexp)
281             regfree(spat->spat_regexp);
282         spat->spat_regexp = regcomp(m,m+dstr->str_cur,
283             spat->spat_flags & SPAT_FOLD,1);
284         if (spat->spat_flags & SPAT_KEEP ||
285             (spat->spat_runtime->arg_type == O_ITEM &&
286               (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
287             arg_free(spat->spat_runtime);       /* it won't change, so */
288             spat->spat_runtime = Nullarg;       /* no point compiling again */
289         }
290     }
291 #ifdef DEBUGGING
292     if (debug & 8) {
293         deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
294     }
295 #endif
296     ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
297     if (ary && ((ary->ary_flags & ARF_REAL) || gimme != G_ARRAY)) {
298         realarray = 1;
299         if (!(ary->ary_flags & ARF_REAL)) {
300             ary->ary_flags |= ARF_REAL;
301             for (i = ary->ary_fill; i >= 0; i--)
302                 ary->ary_array[i] = Nullstr;    /* don't free mere refs */
303         }
304         ary->ary_fill = -1;
305         sp = -1;        /* temporarily switch stacks */
306     }
307     else
308         ary = stack;
309     orig = s;
310     if (spat->spat_flags & SPAT_SKIPWHITE) {
311         while (isspace(*s))
312             s++;
313     }
314     if (!limit)
315         limit = 10001;
316     if (spat->spat_short) {
317         i = spat->spat_short->str_cur;
318         if (i == 1) {
319             i = *spat->spat_short->str_ptr;
320             while (--limit) {
321                 for (m = s; m < strend && *m != i; m++) ;
322                 if (m >= strend)
323                     break;
324                 if (realarray)
325                     dstr = Str_new(30,m-s);
326                 else
327                     dstr = str_static(&str_undef);
328                 str_nset(dstr,s,m-s);
329                 (void)astore(ary, ++sp, dstr);
330                 s = m + 1;
331             }
332         }
333         else {
334 #ifndef lint
335             while (s < strend && --limit &&
336               (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
337                     spat->spat_short)) )
338 #endif
339             {
340                 if (realarray)
341                     dstr = Str_new(31,m-s);
342                 else
343                     dstr = str_static(&str_undef);
344                 str_nset(dstr,s,m-s);
345                 (void)astore(ary, ++sp, dstr);
346                 s = m + i;
347             }
348         }
349     }
350     else {
351         while (s < strend && --limit &&
352             regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
353             if (spat->spat_regexp->subbase
354               && spat->spat_regexp->subbase != orig) {
355                 m = s;
356                 s = orig;
357                 orig = spat->spat_regexp->subbase;
358                 s = orig + (m - s);
359                 strend = s + (strend - m);
360             }
361             m = spat->spat_regexp->startp[0];
362             if (realarray)
363                 dstr = Str_new(32,m-s);
364             else
365                 dstr = str_static(&str_undef);
366             str_nset(dstr,s,m-s);
367             (void)astore(ary, ++sp, dstr);
368             if (spat->spat_regexp->nparens) {
369                 for (i = 1; i <= spat->spat_regexp->nparens; i++) {
370                     s = spat->spat_regexp->startp[i];
371                     m = spat->spat_regexp->endp[i];
372                     if (realarray)
373                         dstr = Str_new(33,m-s);
374                     else
375                         dstr = str_static(&str_undef);
376                     str_nset(dstr,s,m-s);
377                     (void)astore(ary, ++sp, dstr);
378                 }
379             }
380             s = spat->spat_regexp->endp[0];
381         }
382     }
383     if (realarray)
384         iters = sp + 1;
385     else
386         iters = sp - arglast[0];
387     if (iters > 9999)
388         fatal("Split loop");
389     if (s < strend || origlimit) {      /* keep field after final delim? */
390         if (realarray)
391             dstr = Str_new(34,strend-s);
392         else
393             dstr = str_static(&str_undef);
394         str_nset(dstr,s,strend-s);
395         (void)astore(ary, ++sp, dstr);
396         iters++;
397     }
398     else {
399 #ifndef I286
400         while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
401             iters--,sp--;
402 #else
403         char *zaps;
404         int   zapb;
405
406         if (iters > 0) {
407                 zaps = str_get(afetch(ary,sp,FALSE));
408                 zapb = (int) *zaps;
409         }
410         
411         while (iters > 0 && (!zapb)) {
412             iters--,sp--;
413             if (iters > 0) {
414                 zaps = str_get(afetch(ary,iters-1,FALSE));
415                 zapb = (int) *zaps;
416             }
417         }
418 #endif
419     }
420     if (realarray) {
421         ary->ary_fill = sp;
422         if (gimme == G_ARRAY) {
423             sp++;
424             astore(stack, arglast[0] + 1 + sp, Nullstr);
425             Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
426             return arglast[0] + sp;
427         }
428     }
429     else {
430         if (gimme == G_ARRAY)
431             return sp;
432     }
433     sp = arglast[0] + 1;
434     str_numset(str,(double)iters);
435     STABSET(str);
436     st[sp] = str;
437     return sp;
438 }
439
440 int
441 do_unpack(str,gimme,arglast)
442 STR *str;
443 int gimme;
444 int *arglast;
445 {
446     STR **st = stack->ary_array;
447     register int sp = arglast[0] + 1;
448     register char *pat = str_get(st[sp++]);
449     register char *s = str_get(st[sp]);
450     char *strend = s + st[sp--]->str_cur;
451     register char *patend = pat + st[sp]->str_cur;
452     int datumtype;
453     register int len;
454
455     /* These must not be in registers: */
456     char achar;
457     short ashort;
458     int aint;
459     long along;
460     unsigned char auchar;
461     unsigned short aushort;
462     unsigned int auint;
463     unsigned long aulong;
464     char *aptr;
465
466     if (gimme != G_ARRAY) {
467         str_sset(str,&str_undef);
468         STABSET(str);
469         st[sp] = str;
470         return sp;
471     }
472     sp--;
473     while (pat < patend) {
474         datumtype = *pat++;
475         if (isdigit(*pat)) {
476             len = atoi(pat);
477             while (isdigit(*pat))
478                 pat++;
479         }
480         else
481             len = 1;
482         switch(datumtype) {
483         default:
484             break;
485         case 'x':
486             s += len;
487             break;
488         case 'A':
489         case 'a':
490             if (s + len > strend)
491                 len = strend - s;
492             str = Str_new(35,len);
493             str_nset(str,s,len);
494             s += len;
495             if (datumtype == 'A') {
496                 aptr = s;       /* borrow register */
497                 s = str->str_ptr + len - 1;
498                 while (s >= str->str_ptr && (!*s || isspace(*s)))
499                     s--;
500                 *++s = '\0';
501                 str->str_cur = s - str->str_ptr;
502                 s = aptr;       /* unborrow register */
503             }
504             (void)astore(stack, ++sp, str_2static(str));
505             break;
506         case 'c':
507             while (len-- > 0) {
508                 if (s + sizeof(char) > strend)
509                     achar = 0;
510                 else {
511                     bcopy(s,(char*)&achar,sizeof(char));
512                     s += sizeof(char);
513                 }
514                 str = Str_new(36,0);
515                 aint = achar;
516                 if (aint >= 128)        /* fake up signed chars */
517                     aint -= 256;
518                 str_numset(str,(double)aint);
519                 (void)astore(stack, ++sp, str_2static(str));
520             }
521             break;
522         case 'C':
523             while (len-- > 0) {
524                 if (s + sizeof(unsigned char) > strend)
525                     auchar = 0;
526                 else {
527                     bcopy(s,(char*)&auchar,sizeof(unsigned char));
528                     s += sizeof(unsigned char);
529                 }
530                 str = Str_new(37,0);
531                 auint = auchar;         /* some can't cast uchar to double */
532                 str_numset(str,(double)auint);
533                 (void)astore(stack, ++sp, str_2static(str));
534             }
535             break;
536         case 's':
537             while (len-- > 0) {
538                 if (s + sizeof(short) > strend)
539                     ashort = 0;
540                 else {
541                     bcopy(s,(char*)&ashort,sizeof(short));
542                     s += sizeof(short);
543                 }
544                 str = Str_new(38,0);
545                 str_numset(str,(double)ashort);
546                 (void)astore(stack, ++sp, str_2static(str));
547             }
548             break;
549         case 'n':
550         case 'S':
551             while (len-- > 0) {
552                 if (s + sizeof(unsigned short) > strend)
553                     aushort = 0;
554                 else {
555                     bcopy(s,(char*)&aushort,sizeof(unsigned short));
556                     s += sizeof(unsigned short);
557                 }
558                 str = Str_new(39,0);
559 #ifdef NTOHS
560                 if (datumtype == 'n')
561                     aushort = ntohs(aushort);
562 #endif
563                 str_numset(str,(double)aushort);
564                 (void)astore(stack, ++sp, str_2static(str));
565             }
566             break;
567         case 'i':
568             while (len-- > 0) {
569                 if (s + sizeof(int) > strend)
570                     aint = 0;
571                 else {
572                     bcopy(s,(char*)&aint,sizeof(int));
573                     s += sizeof(int);
574                 }
575                 str = Str_new(40,0);
576                 str_numset(str,(double)aint);
577                 (void)astore(stack, ++sp, str_2static(str));
578             }
579             break;
580         case 'I':
581             while (len-- > 0) {
582                 if (s + sizeof(unsigned int) > strend)
583                     auint = 0;
584                 else {
585                     bcopy(s,(char*)&auint,sizeof(unsigned int));
586                     s += sizeof(unsigned int);
587                 }
588                 str = Str_new(41,0);
589                 str_numset(str,(double)auint);
590                 (void)astore(stack, ++sp, str_2static(str));
591             }
592             break;
593         case 'l':
594             while (len-- > 0) {
595                 if (s + sizeof(long) > strend)
596                     along = 0;
597                 else {
598                     bcopy(s,(char*)&along,sizeof(long));
599                     s += sizeof(long);
600                 }
601                 str = Str_new(42,0);
602                 str_numset(str,(double)along);
603                 (void)astore(stack, ++sp, str_2static(str));
604             }
605             break;
606         case 'N':
607         case 'L':
608             while (len-- > 0) {
609                 if (s + sizeof(unsigned long) > strend)
610                     aulong = 0;
611                 else {
612                     bcopy(s,(char*)&aulong,sizeof(unsigned long));
613                     s += sizeof(unsigned long);
614                 }
615                 str = Str_new(43,0);
616 #ifdef NTOHL
617                 if (datumtype == 'N')
618                     aulong = ntohl(aulong);
619 #endif
620                 str_numset(str,(double)aulong);
621                 (void)astore(stack, ++sp, str_2static(str));
622             }
623             break;
624         case 'p':
625             while (len-- > 0) {
626                 if (s + sizeof(char*) > strend)
627                     aptr = 0;
628                 else {
629                     bcopy(s,(char*)&aptr,sizeof(char*));
630                     s += sizeof(char*);
631                 }
632                 str = Str_new(44,0);
633                 if (aptr)
634                     str_set(str,aptr);
635                 (void)astore(stack, ++sp, str_2static(str));
636             }
637             break;
638         }
639     }
640     return sp;
641 }
642
643 int
644 do_slice(stab,numarray,lval,gimme,arglast)
645 register STAB *stab;
646 int numarray;
647 int lval;
648 int gimme;
649 int *arglast;
650 {
651     register STR **st = stack->ary_array;
652     register int sp = arglast[1];
653     register int max = arglast[2];
654     register char *tmps;
655     register int len;
656     register int magic = 0;
657
658     if (lval && !numarray) {
659         if (stab == envstab)
660             magic = 'E';
661         else if (stab == sigstab)
662             magic = 'S';
663 #ifdef SOME_DBM
664         else if (stab_hash(stab)->tbl_dbm)
665             magic = 'D';
666 #endif /* SOME_DBM */
667     }
668
669     if (gimme == G_ARRAY) {
670         if (numarray) {
671             while (sp < max) {
672                 if (st[++sp]) {
673                     st[sp-1] = afetch(stab_array(stab),(int)str_gnum(st[sp]),
674                         lval);
675                 }
676                 else
677                     st[sp-1] = &str_undef;
678             }
679         }
680         else {
681             while (sp < max) {
682                 if (st[++sp]) {
683                     tmps = str_get(st[sp]);
684                     len = st[sp]->str_cur;
685                     st[sp-1] = hfetch(stab_hash(stab),tmps,len, lval);
686                     if (magic)
687                         str_magic(st[sp-1],stab,magic,tmps,len);
688                 }
689                 else
690                     st[sp-1] = &str_undef;
691             }
692         }
693         sp--;
694     }
695     else {
696         if (numarray) {
697             if (st[max])
698                 st[sp] = afetch(stab_array(stab),(int)str_gnum(st[max]), lval);
699             else
700                 st[sp] = &str_undef;
701         }
702         else {
703             if (st[max]) {
704                 tmps = str_get(st[max]);
705                 len = st[max]->str_cur;
706                 st[sp] = hfetch(stab_hash(stab),tmps,len, lval);
707                 if (magic)
708                     str_magic(st[sp],stab,magic,tmps,len);
709             }
710             else
711                 st[sp] = &str_undef;
712         }
713     }
714     return sp;
715 }
716
717 int
718 do_grep(arg,str,gimme,arglast)
719 register ARG *arg;
720 STR *str;
721 int gimme;
722 int *arglast;
723 {
724     STR **st = stack->ary_array;
725     register int dst = arglast[1];
726     register int src = dst + 1;
727     register int sp = arglast[2];
728     register int i = sp - arglast[1];
729     int oldsave = savestack->ary_fill;
730
731     savesptr(&stab_val(defstab));
732     if ((arg[1].arg_type & A_MASK) != A_EXPR)
733         dehoist(arg,1);
734     arg = arg[1].arg_ptr.arg_arg;
735     while (i-- > 0) {
736         stab_val(defstab) = st[src];
737         (void)eval(arg,G_SCALAR,sp);
738         st = stack->ary_array;
739         if (str_true(st[sp+1]))
740             st[dst++] = st[src];
741         src++;
742     }
743     restorelist(oldsave);
744     if (gimme != G_ARRAY) {
745         str_sset(str,&str_undef);
746         STABSET(str);
747         st[arglast[0]+1] = str;
748         return arglast[0]+1;
749     }
750     return arglast[0] + (dst - arglast[1]);
751 }
752
753 int
754 do_reverse(str,gimme,arglast)
755 STR *str;
756 int gimme;
757 int *arglast;
758 {
759     STR **st = stack->ary_array;
760     register STR **up = &st[arglast[1]];
761     register STR **down = &st[arglast[2]];
762     register int i = arglast[2] - arglast[1];
763
764     if (gimme != G_ARRAY) {
765         str_sset(str,&str_undef);
766         STABSET(str);
767         st[arglast[0]+1] = str;
768         return arglast[0]+1;
769     }
770     while (i-- > 0) {
771         *up++ = *down;
772         if (i-- > 0)
773             *down-- = *up;
774     }
775     i = arglast[2] - arglast[1];
776     Copy(down+1,up,i/2,STR*);
777     return arglast[2] - 1;
778 }
779
780 static CMD *sortcmd;
781 static STAB *firststab = Nullstab;
782 static STAB *secondstab = Nullstab;
783
784 int
785 do_sort(str,stab,gimme,arglast)
786 STR *str;
787 STAB *stab;
788 int gimme;
789 int *arglast;
790 {
791     STR **st = stack->ary_array;
792     int sp = arglast[1];
793     register STR **up;
794     register int max = arglast[2] - sp;
795     register int i;
796     int sortcmp();
797     int sortsub();
798     STR *oldfirst;
799     STR *oldsecond;
800     ARRAY *oldstack;
801     static ARRAY *sortstack = Null(ARRAY*);
802
803     if (gimme != G_ARRAY) {
804         str_sset(str,&str_undef);
805         STABSET(str);
806         st[sp] = str;
807         return sp;
808     }
809     up = &st[sp];
810     for (i = 0; i < max; i++) {
811         if ((*up = up[1]) && !(*up)->str_pok)
812             (void)str_2ptr(*up);
813         up++;
814     }
815     sp--;
816     if (max > 1) {
817         if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) {
818             int oldtmps_base = tmps_base;
819
820             if (!sortstack) {
821                 sortstack = anew(Nullstab);
822                 sortstack->ary_flags = 0;
823             }
824             oldstack = stack;
825             stack = sortstack;
826             tmps_base = tmps_max;
827             if (!firststab) {
828                 firststab = stabent("a",TRUE);
829                 secondstab = stabent("b",TRUE);
830             }
831             oldfirst = stab_val(firststab);
832             oldsecond = stab_val(secondstab);
833 #ifndef lint
834             qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
835 #else
836             qsort(Nullch,max,sizeof(STR*),sortsub);
837 #endif
838             stab_val(firststab) = oldfirst;
839             stab_val(secondstab) = oldsecond;
840             tmps_base = oldtmps_base;
841             stack = oldstack;
842         }
843 #ifndef lint
844         else
845             qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
846 #endif
847     }
848     up = &st[arglast[1]];
849     while (max > 0 && !*up)
850         max--,up--;
851     return sp+max;
852 }
853
854 int
855 sortsub(str1,str2)
856 STR **str1;
857 STR **str2;
858 {
859     if (!*str1)
860         return -1;
861     if (!*str2)
862         return 1;
863     stab_val(firststab) = *str1;
864     stab_val(secondstab) = *str2;
865     cmd_exec(sortcmd,G_SCALAR,-1);
866     return (int)str_gnum(*stack->ary_array);
867 }
868
869 sortcmp(strp1,strp2)
870 STR **strp1;
871 STR **strp2;
872 {
873     register STR *str1 = *strp1;
874     register STR *str2 = *strp2;
875     int retval;
876
877     if (!str1)
878         return -1;
879     if (!str2)
880         return 1;
881
882     if (str1->str_cur < str2->str_cur) {
883         if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
884             return retval;
885         else
886             return -1;
887     }
888     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
889         return retval;
890     else if (str1->str_cur == str2->str_cur)
891         return 0;
892     else
893         return 1;
894 }
895
896 int
897 do_range(gimme,arglast)
898 int gimme;
899 int *arglast;
900 {
901     STR **st = stack->ary_array;
902     register int sp = arglast[0];
903     register int i = (int)str_gnum(st[sp+1]);
904     register ARRAY *ary = stack;
905     register STR *str;
906     int max = (int)str_gnum(st[sp+2]);
907
908     if (gimme != G_ARRAY)
909         fatal("panic: do_range");
910
911     while (i <= max) {
912         (void)astore(ary, ++sp, str = str_static(&str_no));
913         str_numset(str,(double)i++);
914     }
915     return sp;
916 }
917
918 int
919 do_tms(str,gimme,arglast)
920 STR *str;
921 int gimme;
922 int *arglast;
923 {
924     STR **st = stack->ary_array;
925     register int sp = arglast[0];
926
927     if (gimme != G_ARRAY) {
928         str_sset(str,&str_undef);
929         STABSET(str);
930         st[++sp] = str;
931         return sp;
932     }
933     (void)times(&timesbuf);
934
935 #ifndef HZ
936 #define HZ 60
937 #endif
938
939 #ifndef lint
940     (void)astore(stack,++sp,
941       str_2static(str_nmake(((double)timesbuf.tms_utime)/HZ)));
942     (void)astore(stack,++sp,
943       str_2static(str_nmake(((double)timesbuf.tms_stime)/HZ)));
944     (void)astore(stack,++sp,
945       str_2static(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
946     (void)astore(stack,++sp,
947       str_2static(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
948 #else
949     (void)astore(stack,++sp,
950       str_2static(str_nmake(0.0)));
951 #endif
952     return sp;
953 }
954
955 int
956 do_time(str,tmbuf,gimme,arglast)
957 STR *str;
958 struct tm *tmbuf;
959 int gimme;
960 int *arglast;
961 {
962     register ARRAY *ary = stack;
963     STR **st = ary->ary_array;
964     register int sp = arglast[0];
965
966     if (!tmbuf || gimme != G_ARRAY) {
967         str_sset(str,&str_undef);
968         STABSET(str);
969         st[++sp] = str;
970         return sp;
971     }
972     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_sec)));
973     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_min)));
974     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_hour)));
975     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mday)));
976     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mon)));
977     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_year)));
978     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_wday)));
979     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_yday)));
980     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_isdst)));
981     return sp;
982 }
983
984 int
985 do_kv(str,hash,kv,gimme,arglast)
986 STR *str;
987 HASH *hash;
988 int kv;
989 int gimme;
990 int *arglast;
991 {
992     register ARRAY *ary = stack;
993     STR **st = ary->ary_array;
994     register int sp = arglast[0];
995     int i;
996     register HENT *entry;
997     char *tmps;
998     STR *tmpstr;
999     int dokeys = (kv == O_KEYS || kv == O_HASH);
1000     int dovalues = (kv == O_VALUES || kv == O_HASH);
1001
1002     if (gimme != G_ARRAY) {
1003         str_sset(str,&str_undef);
1004         STABSET(str);
1005         st[++sp] = str;
1006         return sp;
1007     }
1008     (void)hiterinit(hash);
1009     while (entry = hiternext(hash)) {
1010         if (dokeys) {
1011             tmps = hiterkey(entry,&i);
1012             (void)astore(ary,++sp,str_2static(str_make(tmps,i)));
1013         }
1014         if (dovalues) {
1015             tmpstr = Str_new(45,0);
1016 #ifdef DEBUGGING
1017             if (debug & 8192) {
1018                 sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
1019                     hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
1020                 str_set(tmpstr,buf);
1021             }
1022             else
1023 #endif
1024             str_sset(tmpstr,hiterval(hash,entry));
1025             (void)astore(ary,++sp,str_2static(tmpstr));
1026         }
1027     }
1028     return sp;
1029 }
1030
1031 int
1032 do_each(str,hash,gimme,arglast)
1033 STR *str;
1034 HASH *hash;
1035 int gimme;
1036 int *arglast;
1037 {
1038     STR **st = stack->ary_array;
1039     register int sp = arglast[0];
1040     static STR *mystrk = Nullstr;
1041     HENT *entry = hiternext(hash);
1042     int i;
1043     char *tmps;
1044
1045     if (mystrk) {
1046         str_free(mystrk);
1047         mystrk = Nullstr;
1048     }
1049
1050     if (entry) {
1051         if (gimme == G_ARRAY) {
1052             tmps = hiterkey(entry, &i);
1053             st[++sp] = mystrk = str_make(tmps,i);
1054         }
1055         st[++sp] = str;
1056         str_sset(str,hiterval(hash,entry));
1057         STABSET(str);
1058         return sp;
1059     }
1060     else
1061         return sp;
1062 }