This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fa970a14b1372302a544fea9eda6dbce8b98194b
[perl5.git] / dolist.c
1 /* $Header: dolist.c,v 3.0.1.10 90/10/15 16:19:48 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.10  90/10/15  16:19:48  lwall
10  * patch29: added caller
11  * patch29: added scalar reverse
12  * patch29: sort undefined_subroutine @array is now a fatal error
13  * 
14  * Revision 3.0.1.9  90/08/13  22:15:35  lwall
15  * patch28: defined(@array) and defined(%array) didn't work right
16  * 
17  * Revision 3.0.1.8  90/08/09  03:15:56  lwall
18  * patch19: certain kinds of matching cause "panic: hint"
19  * patch19: $' broke on embedded nulls
20  * patch19: split on /\s+/, /^/ and ' ' is now special cased for speed
21  * patch19: split on /x/i didn't work
22  * patch19: couldn't unpack an 'A' or 'a' field in a scalar context
23  * patch19: unpack called bcopy on each character of a C/c field
24  * patch19: pack/unpack know about uudecode lines
25  * patch19: fixed sort on undefined strings and sped up slightly
26  * patch19: each and keys returned garbage on null key in DBM file
27  * 
28  * Revision 3.0.1.7  90/03/27  15:48:42  lwall
29  * patch16: MSDOS support
30  * patch16: use of $`, $& or $' sometimes causes memory leakage
31  * patch16: splice(@array,0,$n) case cause duplicate free
32  * patch16: grep blows up on undefined array values
33  * patch16: .. now works using magical string increment
34  * 
35  * Revision 3.0.1.6  90/03/12  16:33:02  lwall
36  * patch13: added list slice operator (LIST)[LIST]
37  * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
38  * patch13: made split('') act like split(//) rather than split(' ')
39  * 
40  * Revision 3.0.1.5  90/02/28  17:09:44  lwall
41  * patch9: split now can split into more than 10000 elements
42  * patch9: @_ clobbered by ($foo,$bar) = split
43  * patch9: sped up pack and unpack
44  * patch9: unpack of single item now works in a scalar context
45  * patch9: slices ignored value of $[
46  * patch9: grep now returns number of items matched in scalar context
47  * patch9: grep iterations no longer in the regexp context of previous iteration
48  * 
49  * Revision 3.0.1.4  89/12/21  19:58:46  lwall
50  * patch7: grep(1,@array) didn't work
51  * patch7: /$pat/; //; wrongly freed runtime pattern twice
52  * 
53  * Revision 3.0.1.3  89/11/17  15:14:45  lwall
54  * patch5: grep() occasionally loses arguments or dumps core
55  * 
56  * Revision 3.0.1.2  89/11/11  04:28:17  lwall
57  * patch2: non-existent slice values are now undefined rather than null
58  * 
59  * Revision 3.0.1.1  89/10/26  23:11:51  lwall
60  * patch1: split in a subroutine wrongly freed referenced arguments
61  * patch1: reverse didn't work
62  * 
63  * Revision 3.0  89/10/18  15:11:02  lwall
64  * 3.0 baseline
65  * 
66  */
67
68 #include "EXTERN.h"
69 #include "perl.h"
70
71
72 #ifdef BUGGY_MSC
73  #pragma function(memcmp)
74 #endif /* BUGGY_MSC */
75
76 int
77 do_match(str,arg,gimme,arglast)
78 STR *str;
79 register ARG *arg;
80 int gimme;
81 int *arglast;
82 {
83     register STR **st = stack->ary_array;
84     register SPAT *spat = arg[2].arg_ptr.arg_spat;
85     register char *t;
86     register int sp = arglast[0] + 1;
87     STR *srchstr = st[sp];
88     register char *s = str_get(st[sp]);
89     char *strend = s + st[sp]->str_cur;
90     STR *tmpstr;
91     char *myhint = hint;
92
93     hint = Nullch;
94     if (!spat) {
95         if (gimme == G_ARRAY)
96             return --sp;
97         str_set(str,Yes);
98         STABSET(str);
99         st[sp] = str;
100         return sp;
101     }
102     if (!s)
103         fatal("panic: do_match");
104     if (spat->spat_flags & SPAT_USED) {
105 #ifdef DEBUGGING
106         if (debug & 8)
107             deb("2.SPAT USED\n");
108 #endif
109         if (gimme == G_ARRAY)
110             return --sp;
111         str_set(str,No);
112         STABSET(str);
113         st[sp] = str;
114         return sp;
115     }
116     --sp;
117     if (spat->spat_runtime) {
118         nointrp = "|)";
119         sp = eval(spat->spat_runtime,G_SCALAR,sp);
120         st = stack->ary_array;
121         t = str_get(tmpstr = st[sp--]);
122         nointrp = "";
123 #ifdef DEBUGGING
124         if (debug & 8)
125             deb("2.SPAT /%s/\n",t);
126 #endif
127         if (spat->spat_regexp)
128             regfree(spat->spat_regexp);
129         spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
130             spat->spat_flags & SPAT_FOLD);
131         if (!*spat->spat_regexp->precomp && lastspat)
132             spat = lastspat;
133         if (spat->spat_flags & SPAT_KEEP) {
134             if (spat->spat_runtime)
135                 arg_free(spat->spat_runtime);   /* it won't change, so */
136             spat->spat_runtime = Nullarg;       /* no point compiling again */
137         }
138         if (!spat->spat_regexp->nparens)
139             gimme = G_SCALAR;                   /* accidental array context? */
140         if (regexec(spat->spat_regexp, s, strend, s, 0,
141           srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
142           gimme == G_ARRAY)) {
143             if (spat->spat_regexp->subbase)
144                 curspat = spat;
145             lastspat = spat;
146             goto gotcha;
147         }
148         else {
149             if (gimme == G_ARRAY)
150                 return sp;
151             str_sset(str,&str_no);
152             STABSET(str);
153             st[++sp] = str;
154             return sp;
155         }
156     }
157     else {
158 #ifdef DEBUGGING
159         if (debug & 8) {
160             char ch;
161
162             if (spat->spat_flags & SPAT_ONCE)
163                 ch = '?';
164             else
165                 ch = '/';
166             deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
167         }
168 #endif
169         if (!*spat->spat_regexp->precomp && lastspat)
170             spat = lastspat;
171         t = s;
172         if (myhint) {
173             if (myhint < s || myhint > strend)
174                 fatal("panic: hint in do_match");
175             s = myhint;
176             if (spat->spat_regexp->regback >= 0) {
177                 s -= spat->spat_regexp->regback;
178                 if (s < t)
179                     s = t;
180             }
181             else
182                 s = t;
183         }
184         else if (spat->spat_short) {
185             if (spat->spat_flags & SPAT_SCANFIRST) {
186                 if (srchstr->str_pok & SP_STUDIED) {
187                     if (screamfirst[spat->spat_short->str_rare] < 0)
188                         goto nope;
189                     else if (!(s = screaminstr(srchstr,spat->spat_short)))
190                         goto nope;
191                     else if (spat->spat_flags & SPAT_ALL)
192                         goto yup;
193                 }
194 #ifndef lint
195                 else if (!(s = fbminstr((unsigned char*)s,
196                   (unsigned char*)strend, spat->spat_short)))
197                     goto nope;
198 #endif
199                 else if (spat->spat_flags & SPAT_ALL)
200                     goto yup;
201                 if (s && spat->spat_regexp->regback >= 0) {
202                     ++spat->spat_short->str_u.str_useful;
203                     s -= spat->spat_regexp->regback;
204                     if (s < t)
205                         s = t;
206                 }
207                 else
208                     s = t;
209             }
210             else if (!multiline && (*spat->spat_short->str_ptr != *s ||
211               bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
212                 goto nope;
213             if (--spat->spat_short->str_u.str_useful < 0) {
214                 str_free(spat->spat_short);
215                 spat->spat_short = Nullstr;     /* opt is being useless */
216             }
217         }
218         if (!spat->spat_regexp->nparens)
219             gimme = G_SCALAR;                   /* accidental array context? */
220         if (regexec(spat->spat_regexp, s, strend, t, 0,
221           srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
222           gimme == G_ARRAY)) {
223             if (spat->spat_regexp->subbase)
224                 curspat = spat;
225             lastspat = spat;
226             if (spat->spat_flags & SPAT_ONCE)
227                 spat->spat_flags |= SPAT_USED;
228             goto gotcha;
229         }
230         else {
231             if (gimme == G_ARRAY)
232                 return sp;
233             str_sset(str,&str_no);
234             STABSET(str);
235             st[++sp] = str;
236             return sp;
237         }
238     }
239     /*NOTREACHED*/
240
241   gotcha:
242     if (gimme == G_ARRAY) {
243         int iters, i, len;
244
245         iters = spat->spat_regexp->nparens;
246         if (sp + iters >= stack->ary_max) {
247             astore(stack,sp + iters, Nullstr);
248             st = stack->ary_array;              /* possibly realloced */
249         }
250
251         for (i = 1; i <= iters; i++) {
252             st[++sp] = str_static(&str_no);
253             if (s = spat->spat_regexp->startp[i]) {
254                 len = spat->spat_regexp->endp[i] - s;
255                 if (len > 0)
256                     str_nset(st[sp],s,len);
257             }
258         }
259         return sp;
260     }
261     else {
262         str_sset(str,&str_yes);
263         STABSET(str);
264         st[++sp] = str;
265         return sp;
266     }
267
268 yup:
269     ++spat->spat_short->str_u.str_useful;
270     lastspat = spat;
271     if (spat->spat_flags & SPAT_ONCE)
272         spat->spat_flags |= SPAT_USED;
273     if (sawampersand) {
274         char *tmps;
275
276         if (spat->spat_regexp->subbase)
277             Safefree(spat->spat_regexp->subbase);
278         tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
279         spat->spat_regexp->subend = tmps + (strend-t);
280         tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
281         spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
282         curspat = spat;
283     }
284     str_sset(str,&str_yes);
285     STABSET(str);
286     st[++sp] = str;
287     return sp;
288
289 nope:
290     ++spat->spat_short->str_u.str_useful;
291     if (gimme == G_ARRAY)
292         return sp;
293     str_sset(str,&str_no);
294     STABSET(str);
295     st[++sp] = str;
296     return sp;
297 }
298
299 #ifdef BUGGY_MSC
300  #pragma intrinsic(memcmp)
301 #endif /* BUGGY_MSC */
302
303 int
304 do_split(str,spat,limit,gimme,arglast)
305 STR *str;
306 register SPAT *spat;
307 register int limit;
308 int gimme;
309 int *arglast;
310 {
311     register ARRAY *ary = stack;
312     STR **st = ary->ary_array;
313     register int sp = arglast[0] + 1;
314     register char *s = str_get(st[sp]);
315     char *strend = s + st[sp--]->str_cur;
316     register STR *dstr;
317     register char *m;
318     int iters = 0;
319     int maxiters = (strend - s) + 10;
320     int i;
321     char *orig;
322     int origlimit = limit;
323     int realarray = 0;
324
325     if (!spat || !s)
326         fatal("panic: do_split");
327     else if (spat->spat_runtime) {
328         nointrp = "|)";
329         sp = eval(spat->spat_runtime,G_SCALAR,sp);
330         st = stack->ary_array;
331         m = str_get(dstr = st[sp--]);
332         nointrp = "";
333         if (*m == ' ' && dstr->str_cur == 1) {
334             str_set(dstr,"\\s+");
335             m = dstr->str_ptr;
336             spat->spat_flags |= SPAT_SKIPWHITE;
337         }
338         if (spat->spat_regexp)
339             regfree(spat->spat_regexp);
340         spat->spat_regexp = regcomp(m,m+dstr->str_cur,
341             spat->spat_flags & SPAT_FOLD);
342         if (spat->spat_flags & SPAT_KEEP ||
343             (spat->spat_runtime->arg_type == O_ITEM &&
344               (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
345             arg_free(spat->spat_runtime);       /* it won't change, so */
346             spat->spat_runtime = Nullarg;       /* no point compiling again */
347         }
348     }
349 #ifdef DEBUGGING
350     if (debug & 8) {
351         deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
352     }
353 #endif
354     ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
355     if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) {
356         realarray = 1;
357         if (!(ary->ary_flags & ARF_REAL)) {
358             ary->ary_flags |= ARF_REAL;
359             for (i = ary->ary_fill; i >= 0; i--)
360                 ary->ary_array[i] = Nullstr;    /* don't free mere refs */
361         }
362         ary->ary_fill = -1;
363         sp = -1;        /* temporarily switch stacks */
364     }
365     else
366         ary = stack;
367     orig = s;
368     if (spat->spat_flags & SPAT_SKIPWHITE) {
369         while (isspace(*s))
370             s++;
371     }
372     if (!limit)
373         limit = maxiters + 2;
374     if (strEQ("\\s+",spat->spat_regexp->precomp)) {
375         while (--limit) {
376             for (m = s; m < strend && !isspace(*m); m++) ;
377             if (m >= strend)
378                 break;
379             if (realarray)
380                 dstr = Str_new(30,m-s);
381             else
382                 dstr = str_static(&str_undef);
383             str_nset(dstr,s,m-s);
384             (void)astore(ary, ++sp, dstr);
385             for (s = m + 1; s < strend && isspace(*s); s++) ;
386         }
387     }
388     else if (strEQ("^",spat->spat_regexp->precomp)) {
389         while (--limit) {
390             for (m = s; m < strend && *m != '\n'; m++) ;
391             m++;
392             if (m >= strend)
393                 break;
394             if (realarray)
395                 dstr = Str_new(30,m-s);
396             else
397                 dstr = str_static(&str_undef);
398             str_nset(dstr,s,m-s);
399             (void)astore(ary, ++sp, dstr);
400             s = m;
401         }
402     }
403     else if (spat->spat_short) {
404         i = spat->spat_short->str_cur;
405         if (i == 1) {
406             int fold = (spat->spat_flags & SPAT_FOLD);
407
408             i = *spat->spat_short->str_ptr;
409             if (fold && isupper(i))
410                 i = tolower(i);
411             while (--limit) {
412                 if (fold) {
413                     for ( m = s;
414                           m < strend && *m != i &&
415                             (!isupper(*m) || tolower(*m) != i);
416                           m++)
417                         ;
418                 }
419                 else
420                     for (m = s; m < strend && *m != i; m++) ;
421                 if (m >= strend)
422                     break;
423                 if (realarray)
424                     dstr = Str_new(30,m-s);
425                 else
426                     dstr = str_static(&str_undef);
427                 str_nset(dstr,s,m-s);
428                 (void)astore(ary, ++sp, dstr);
429                 s = m + 1;
430             }
431         }
432         else {
433 #ifndef lint
434             while (s < strend && --limit &&
435               (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
436                     spat->spat_short)) )
437 #endif
438             {
439                 if (realarray)
440                     dstr = Str_new(31,m-s);
441                 else
442                     dstr = str_static(&str_undef);
443                 str_nset(dstr,s,m-s);
444                 (void)astore(ary, ++sp, dstr);
445                 s = m + i;
446             }
447         }
448     }
449     else {
450         maxiters += (strend - s) * spat->spat_regexp->nparens;
451         while (s < strend && --limit &&
452             regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
453             if (spat->spat_regexp->subbase
454               && spat->spat_regexp->subbase != orig) {
455                 m = s;
456                 s = orig;
457                 orig = spat->spat_regexp->subbase;
458                 s = orig + (m - s);
459                 strend = s + (strend - m);
460             }
461             m = spat->spat_regexp->startp[0];
462             if (realarray)
463                 dstr = Str_new(32,m-s);
464             else
465                 dstr = str_static(&str_undef);
466             str_nset(dstr,s,m-s);
467             (void)astore(ary, ++sp, dstr);
468             if (spat->spat_regexp->nparens) {
469                 for (i = 1; i <= spat->spat_regexp->nparens; i++) {
470                     s = spat->spat_regexp->startp[i];
471                     m = spat->spat_regexp->endp[i];
472                     if (realarray)
473                         dstr = Str_new(33,m-s);
474                     else
475                         dstr = str_static(&str_undef);
476                     str_nset(dstr,s,m-s);
477                     (void)astore(ary, ++sp, dstr);
478                 }
479             }
480             s = spat->spat_regexp->endp[0];
481         }
482     }
483     if (realarray)
484         iters = sp + 1;
485     else
486         iters = sp - arglast[0];
487     if (iters > maxiters)
488         fatal("Split loop");
489     if (s < strend || origlimit) {      /* keep field after final delim? */
490         if (realarray)
491             dstr = Str_new(34,strend-s);
492         else
493             dstr = str_static(&str_undef);
494         str_nset(dstr,s,strend-s);
495         (void)astore(ary, ++sp, dstr);
496         iters++;
497     }
498     else {
499 #ifndef I286x
500         while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
501             iters--,sp--;
502 #else
503         char *zaps;
504         int   zapb;
505
506         if (iters > 0) {
507                 zaps = str_get(afetch(ary,sp,FALSE));
508                 zapb = (int) *zaps;
509         }
510         
511         while (iters > 0 && (!zapb)) {
512             iters--,sp--;
513             if (iters > 0) {
514                 zaps = str_get(afetch(ary,iters-1,FALSE));
515                 zapb = (int) *zaps;
516             }
517         }
518 #endif
519     }
520     if (realarray) {
521         ary->ary_fill = sp;
522         if (gimme == G_ARRAY) {
523             sp++;
524             astore(stack, arglast[0] + 1 + sp, Nullstr);
525             Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
526             return arglast[0] + sp;
527         }
528     }
529     else {
530         if (gimme == G_ARRAY)
531             return sp;
532     }
533     sp = arglast[0] + 1;
534     str_numset(str,(double)iters);
535     STABSET(str);
536     st[sp] = str;
537     return sp;
538 }
539
540 int
541 do_unpack(str,gimme,arglast)
542 STR *str;
543 int gimme;
544 int *arglast;
545 {
546     STR **st = stack->ary_array;
547     register int sp = arglast[0] + 1;
548     register char *pat = str_get(st[sp++]);
549     register char *s = str_get(st[sp]);
550     char *strend = s + st[sp--]->str_cur;
551     char *strbeg = s;
552     register char *patend = pat + st[sp]->str_cur;
553     int datumtype;
554     register int len;
555
556     /* These must not be in registers: */
557     char achar;
558     short ashort;
559     int aint;
560     long along;
561     unsigned char auchar;
562     unsigned short aushort;
563     unsigned int auint;
564     unsigned long aulong;
565     char *aptr;
566     float afloat;
567     double adouble;
568     int checksum = 0;
569     unsigned long culong;
570     double cdouble;
571
572     if (gimme != G_ARRAY) {             /* arrange to do first one only */
573         for (patend = pat; !isalpha(*patend); patend++);
574         if (*patend == 'a' || *patend == 'A' || *pat == '%') {
575             patend++;
576             while (isdigit(*patend) || *patend == '*')
577                 patend++;
578         }
579         else
580             patend++;
581     }
582     sp--;
583     while (pat < patend) {
584       reparse:
585         datumtype = *pat++;
586         if (pat >= patend)
587             len = 1;
588         else if (*pat == '*')
589             len = strend - strbeg;      /* long enough */
590         else if (isdigit(*pat)) {
591             len = *pat++ - '0';
592             while (isdigit(*pat))
593                 len = (len * 10) + (*pat++ - '0');
594         }
595         else
596             len = (datumtype != '@');
597         switch(datumtype) {
598         default:
599             break;
600         case '%':
601             if (len == 1 && pat[-1] != '1')
602                 len = 16;
603             checksum = len;
604             culong = 0;
605             cdouble = 0;
606             if (pat < patend)
607                 goto reparse;
608             break;
609         case '@':
610             if (len > strend - s)
611                 fatal("@ outside of string");
612             s = strbeg + len;
613             break;
614         case 'X':
615             if (len > s - strbeg)
616                 fatal("X outside of string");
617             s -= len;
618             break;
619         case 'x':
620             if (len > strend - s)
621                 fatal("x outside of string");
622             s += len;
623             break;
624         case 'A':
625         case 'a':
626             if (len > strend - s)
627                 len = strend - s;
628             if (checksum)
629                 goto uchar_checksum;
630             str = Str_new(35,len);
631             str_nset(str,s,len);
632             s += len;
633             if (datumtype == 'A') {
634                 aptr = s;       /* borrow register */
635                 s = str->str_ptr + len - 1;
636                 while (s >= str->str_ptr && (!*s || isspace(*s)))
637                     s--;
638                 *++s = '\0';
639                 str->str_cur = s - str->str_ptr;
640                 s = aptr;       /* unborrow register */
641             }
642             (void)astore(stack, ++sp, str_2static(str));
643             break;
644         case 'c':
645             if (len > strend - s)
646                 len = strend - s;
647             if (checksum) {
648                 while (len-- > 0) {
649                     aint = *s++;
650                     if (aint >= 128)    /* fake up signed chars */
651                         aint -= 256;
652                     culong += aint;
653                 }
654             }
655             else {
656                 while (len-- > 0) {
657                     aint = *s++;
658                     if (aint >= 128)    /* fake up signed chars */
659                         aint -= 256;
660                     str = Str_new(36,0);
661                     str_numset(str,(double)aint);
662                     (void)astore(stack, ++sp, str_2static(str));
663                 }
664             }
665             break;
666         case 'C':
667             if (len > strend - s)
668                 len = strend - s;
669             if (checksum) {
670               uchar_checksum:
671                 while (len-- > 0) {
672                     auint = *s++ & 255;
673                     culong += auint;
674                 }
675             }
676             else {
677                 while (len-- > 0) {
678                     auint = *s++ & 255;
679                     str = Str_new(37,0);
680                     str_numset(str,(double)auint);
681                     (void)astore(stack, ++sp, str_2static(str));
682                 }
683             }
684             break;
685         case 's':
686             along = (strend - s) / sizeof(short);
687             if (len > along)
688                 len = along;
689             if (checksum) {
690                 while (len-- > 0) {
691                     bcopy(s,(char*)&ashort,sizeof(short));
692                     s += sizeof(short);
693                     culong += ashort;
694                 }
695             }
696             else {
697                 while (len-- > 0) {
698                     bcopy(s,(char*)&ashort,sizeof(short));
699                     s += sizeof(short);
700                     str = Str_new(38,0);
701                     str_numset(str,(double)ashort);
702                     (void)astore(stack, ++sp, str_2static(str));
703                 }
704             }
705             break;
706         case 'n':
707         case 'S':
708             along = (strend - s) / sizeof(unsigned short);
709             if (len > along)
710                 len = along;
711             if (checksum) {
712                 while (len-- > 0) {
713                     bcopy(s,(char*)&aushort,sizeof(unsigned short));
714                     s += sizeof(unsigned short);
715 #ifdef NTOHS
716                     if (datumtype == 'n')
717                         aushort = ntohs(aushort);
718 #endif
719                     culong += aushort;
720                 }
721             }
722             else {
723                 while (len-- > 0) {
724                     bcopy(s,(char*)&aushort,sizeof(unsigned short));
725                     s += sizeof(unsigned short);
726                     str = Str_new(39,0);
727 #ifdef NTOHS
728                     if (datumtype == 'n')
729                         aushort = ntohs(aushort);
730 #endif
731                     str_numset(str,(double)aushort);
732                     (void)astore(stack, ++sp, str_2static(str));
733                 }
734             }
735             break;
736         case 'i':
737             along = (strend - s) / sizeof(int);
738             if (len > along)
739                 len = along;
740             if (checksum) {
741                 while (len-- > 0) {
742                     bcopy(s,(char*)&aint,sizeof(int));
743                     s += sizeof(int);
744                     if (checksum > 32)
745                         cdouble += (double)aint;
746                     else
747                         culong += aint;
748                 }
749             }
750             else {
751                 while (len-- > 0) {
752                     bcopy(s,(char*)&aint,sizeof(int));
753                     s += sizeof(int);
754                     str = Str_new(40,0);
755                     str_numset(str,(double)aint);
756                     (void)astore(stack, ++sp, str_2static(str));
757                 }
758             }
759             break;
760         case 'I':
761             along = (strend - s) / sizeof(unsigned int);
762             if (len > along)
763                 len = along;
764             if (checksum) {
765                 while (len-- > 0) {
766                     bcopy(s,(char*)&auint,sizeof(unsigned int));
767                     s += sizeof(unsigned int);
768                     if (checksum > 32)
769                         cdouble += (double)auint;
770                     else
771                         culong += auint;
772                 }
773             }
774             else {
775                 while (len-- > 0) {
776                     bcopy(s,(char*)&auint,sizeof(unsigned int));
777                     s += sizeof(unsigned int);
778                     str = Str_new(41,0);
779                     str_numset(str,(double)auint);
780                     (void)astore(stack, ++sp, str_2static(str));
781                 }
782             }
783             break;
784         case 'l':
785             along = (strend - s) / sizeof(long);
786             if (len > along)
787                 len = along;
788             if (checksum) {
789                 while (len-- > 0) {
790                     bcopy(s,(char*)&along,sizeof(long));
791                     s += sizeof(long);
792                     if (checksum > 32)
793                         cdouble += (double)along;
794                     else
795                         culong += along;
796                 }
797             }
798             else {
799                 while (len-- > 0) {
800                     bcopy(s,(char*)&along,sizeof(long));
801                     s += sizeof(long);
802                     str = Str_new(42,0);
803                     str_numset(str,(double)along);
804                     (void)astore(stack, ++sp, str_2static(str));
805                 }
806             }
807             break;
808         case 'N':
809         case 'L':
810             along = (strend - s) / sizeof(unsigned long);
811             if (len > along)
812                 len = along;
813             if (checksum) {
814                 while (len-- > 0) {
815                     bcopy(s,(char*)&aulong,sizeof(unsigned long));
816                     s += sizeof(unsigned long);
817 #ifdef NTOHL
818                     if (datumtype == 'N')
819                         aulong = ntohl(aulong);
820 #endif
821                     if (checksum > 32)
822                         cdouble += (double)aulong;
823                     else
824                         culong += aulong;
825                 }
826             }
827             else {
828                 while (len-- > 0) {
829                     bcopy(s,(char*)&aulong,sizeof(unsigned long));
830                     s += sizeof(unsigned long);
831                     str = Str_new(43,0);
832 #ifdef NTOHL
833                     if (datumtype == 'N')
834                         aulong = ntohl(aulong);
835 #endif
836                     str_numset(str,(double)aulong);
837                     (void)astore(stack, ++sp, str_2static(str));
838                 }
839             }
840             break;
841         case 'p':
842             along = (strend - s) / sizeof(char*);
843             if (len > along)
844                 len = along;
845             while (len-- > 0) {
846                 if (sizeof(char*) > strend - s)
847                     break;
848                 else {
849                     bcopy(s,(char*)&aptr,sizeof(char*));
850                     s += sizeof(char*);
851                 }
852                 str = Str_new(44,0);
853                 if (aptr)
854                     str_set(str,aptr);
855                 (void)astore(stack, ++sp, str_2static(str));
856             }
857             break;
858         /* float and double added gnb@melba.bby.oz.au 22/11/89 */
859         case 'f':
860         case 'F':
861             along = (strend - s) / sizeof(float);
862             if (len > along)
863                 len = along;
864             if (checksum) {
865                 while (len-- > 0) {
866                     bcopy(s, (char *)&afloat, sizeof(float));
867                     s += sizeof(float);
868                     cdouble += afloat;
869                 }
870             }
871             else {
872                 while (len-- > 0) {
873                     bcopy(s, (char *)&afloat, sizeof(float));
874                     s += sizeof(float);
875                     str = Str_new(47, 0);
876                     str_numset(str, (double)afloat);
877                     (void)astore(stack, ++sp, str_2static(str));
878                 }
879             }
880             break;
881         case 'd':
882         case 'D':
883             along = (strend - s) / sizeof(double);
884             if (len > along)
885                 len = along;
886             if (checksum) {
887                 while (len-- > 0) {
888                     bcopy(s, (char *)&adouble, sizeof(double));
889                     s += sizeof(double);
890                     cdouble += adouble;
891                 }
892             }
893             else {
894                 while (len-- > 0) {
895                     bcopy(s, (char *)&adouble, sizeof(double));
896                     s += sizeof(double);
897                     str = Str_new(48, 0);
898                     str_numset(str, (double)adouble);
899                     (void)astore(stack, ++sp, str_2static(str));
900                 }
901             }
902             break;
903         case 'u':
904             along = (strend - s) * 3 / 4;
905             str = Str_new(42,along);
906             while (s < strend && *s > ' ' && *s < 'a') {
907                 int a,b,c,d;
908                 char hunk[4];
909
910                 hunk[3] = '\0';
911                 len = (*s++ - ' ') & 077;
912                 while (len > 0) {
913                     if (s < strend && *s >= ' ')
914                         a = (*s++ - ' ') & 077;
915                     else
916                         a = 0;
917                     if (s < strend && *s >= ' ')
918                         b = (*s++ - ' ') & 077;
919                     else
920                         b = 0;
921                     if (s < strend && *s >= ' ')
922                         c = (*s++ - ' ') & 077;
923                     else
924                         c = 0;
925                     if (s < strend && *s >= ' ')
926                         d = (*s++ - ' ') & 077;
927                     else
928                         d = 0;
929                     hunk[0] = a << 2 | b >> 4;
930                     hunk[1] = b << 4 | c >> 2;
931                     hunk[2] = c << 6 | d;
932                     str_ncat(str,hunk, len > 3 ? 3 : len);
933                     len -= 3;
934                 }
935                 if (*s == '\n')
936                     s++;
937                 else if (s[1] == '\n')          /* possible checksum byte */
938                     s += 2;
939             }
940             (void)astore(stack, ++sp, str_2static(str));
941             break;
942         }
943         if (checksum) {
944             str = Str_new(42,0);
945             if (index("fFdD", datumtype) ||
946               (checksum > 32 && index("iIlLN", datumtype)) ) {
947                 double modf();
948                 double trouble;
949
950                 adouble = 1.0;
951                 while (checksum >= 16) {
952                     checksum -= 16;
953                     adouble *= 65536.0;
954                 }
955                 while (checksum >= 4) {
956                     checksum -= 4;
957                     adouble *= 16.0;
958                 }
959                 while (checksum--)
960                     adouble *= 2.0;
961                 along = (1 << checksum) - 1;
962                 while (cdouble < 0.0)
963                     cdouble += adouble;
964                 cdouble = modf(cdouble / adouble, &trouble) * adouble;
965                 str_numset(str,cdouble);
966             }
967             else {
968                 along = (1 << checksum) - 1;
969                 culong &= (unsigned long)along;
970                 str_numset(str,(double)culong);
971             }
972             (void)astore(stack, ++sp, str_2static(str));
973             checksum = 0;
974         }
975     }
976     return sp;
977 }
978
979 int
980 do_slice(stab,str,numarray,lval,gimme,arglast)
981 STAB *stab;
982 STR *str;
983 int numarray;
984 int lval;
985 int gimme;
986 int *arglast;
987 {
988     register STR **st = stack->ary_array;
989     register int sp = arglast[1];
990     register int max = arglast[2];
991     register char *tmps;
992     register int len;
993     register int magic = 0;
994     register ARRAY *ary;
995     register HASH *hash;
996     int oldarybase = arybase;
997
998     if (numarray) {
999         if (numarray == 2) {            /* a slice of a LIST */
1000             ary = stack;
1001             ary->ary_fill = arglast[3];
1002             arybase -= max + 1;
1003             st[sp] = str;               /* make stack size available */
1004             str_numset(str,(double)(sp - 1));
1005         }
1006         else
1007             ary = stab_array(stab);     /* a slice of an array */
1008     }
1009     else {
1010         if (lval) {
1011             if (stab == envstab)
1012                 magic = 'E';
1013             else if (stab == sigstab)
1014                 magic = 'S';
1015 #ifdef SOME_DBM
1016             else if (stab_hash(stab)->tbl_dbm)
1017                 magic = 'D';
1018 #endif /* SOME_DBM */
1019         }
1020         hash = stab_hash(stab);         /* a slice of an associative array */
1021     }
1022
1023     if (gimme == G_ARRAY) {
1024         if (numarray) {
1025             while (sp < max) {
1026                 if (st[++sp]) {
1027                     st[sp-1] = afetch(ary,
1028                       ((int)str_gnum(st[sp])) - arybase, lval);
1029                 }
1030                 else
1031                     st[sp-1] = &str_undef;
1032             }
1033         }
1034         else {
1035             while (sp < max) {
1036                 if (st[++sp]) {
1037                     tmps = str_get(st[sp]);
1038                     len = st[sp]->str_cur;
1039                     st[sp-1] = hfetch(hash,tmps,len, lval);
1040                     if (magic)
1041                         str_magic(st[sp-1],stab,magic,tmps,len);
1042                 }
1043                 else
1044                     st[sp-1] = &str_undef;
1045             }
1046         }
1047         sp--;
1048     }
1049     else {
1050         if (numarray) {
1051             if (st[max])
1052                 st[sp] = afetch(ary,
1053                   ((int)str_gnum(st[max])) - arybase, lval);
1054             else
1055                 st[sp] = &str_undef;
1056         }
1057         else {
1058             if (st[max]) {
1059                 tmps = str_get(st[max]);
1060                 len = st[max]->str_cur;
1061                 st[sp] = hfetch(hash,tmps,len, lval);
1062                 if (magic)
1063                     str_magic(st[sp],stab,magic,tmps,len);
1064             }
1065             else
1066                 st[sp] = &str_undef;
1067         }
1068     }
1069     arybase = oldarybase;
1070     return sp;
1071 }
1072
1073 int
1074 do_splice(ary,gimme,arglast)
1075 register ARRAY *ary;
1076 int gimme;
1077 int *arglast;
1078 {
1079     register STR **st = stack->ary_array;
1080     register int sp = arglast[1];
1081     int max = arglast[2] + 1;
1082     register STR **src;
1083     register STR **dst;
1084     register int i;
1085     register int offset;
1086     register int length;
1087     int newlen;
1088     int after;
1089     int diff;
1090     STR **tmparyval;
1091
1092     if (++sp < max) {
1093         offset = ((int)str_gnum(st[sp])) - arybase;
1094         if (offset < 0)
1095             offset += ary->ary_fill + 1;
1096         if (++sp < max) {
1097             length = (int)str_gnum(st[sp++]);
1098             if (length < 0)
1099                 length = 0;
1100         }
1101         else
1102             length = ary->ary_max;              /* close enough to infinity */
1103     }
1104     else {
1105         offset = 0;
1106         length = ary->ary_max;
1107     }
1108     if (offset < 0) {
1109         length += offset;
1110         offset = 0;
1111         if (length < 0)
1112             length = 0;
1113     }
1114     if (offset > ary->ary_fill + 1)
1115         offset = ary->ary_fill + 1;
1116     after = ary->ary_fill + 1 - (offset + length);
1117     if (after < 0) {                            /* not that much array */
1118         length += after;                        /* offset+length now in array */
1119         after = 0;
1120         if (!ary->ary_alloc) {
1121             afill(ary,0);
1122             afill(ary,-1);
1123         }
1124     }
1125
1126     /* At this point, sp .. max-1 is our new LIST */
1127
1128     newlen = max - sp;
1129     diff = newlen - length;
1130
1131     if (diff < 0) {                             /* shrinking the area */
1132         if (newlen) {
1133             New(451, tmparyval, newlen, STR*);  /* so remember insertion */
1134             Copy(st+sp, tmparyval, newlen, STR*);
1135         }
1136
1137         sp = arglast[0] + 1;
1138         if (gimme == G_ARRAY) {                 /* copy return vals to stack */
1139             if (sp + length >= stack->ary_max) {
1140                 astore(stack,sp + length, Nullstr);
1141                 st = stack->ary_array;
1142             }
1143             Copy(ary->ary_array+offset, st+sp, length, STR*);
1144             if (ary->ary_flags & ARF_REAL) {
1145                 for (i = length, dst = st+sp; i; i--)
1146                     str_2static(*dst++);        /* free them eventualy */
1147             }
1148             sp += length - 1;
1149         }
1150         else {
1151             st[sp] = ary->ary_array[offset+length-1];
1152             if (ary->ary_flags & ARF_REAL)
1153                 str_2static(st[sp]);
1154         }
1155         ary->ary_fill += diff;
1156
1157         /* pull up or down? */
1158
1159         if (offset < after) {                   /* easier to pull up */
1160             if (offset) {                       /* esp. if nothing to pull */
1161                 src = &ary->ary_array[offset-1];
1162                 dst = src - diff;               /* diff is negative */
1163                 for (i = offset; i > 0; i--)    /* can't trust Copy */
1164                     *dst-- = *src--;
1165             }
1166             Zero(ary->ary_array, -diff, STR*);
1167             ary->ary_array -= diff;             /* diff is negative */
1168             ary->ary_max += diff;
1169         }
1170         else {
1171             if (after) {                        /* anything to pull down? */
1172                 src = ary->ary_array + offset + length;
1173                 dst = src + diff;               /* diff is negative */
1174                 Copy(src, dst, after, STR*);
1175             }
1176             Zero(&ary->ary_array[ary->ary_fill+1], -diff, STR*);
1177                                                 /* avoid later double free */
1178         }
1179         if (newlen) {
1180             for (src = tmparyval, dst = ary->ary_array + offset;
1181               newlen; newlen--) {
1182                 *dst = Str_new(46,0);
1183                 str_sset(*dst++,*src++);
1184             }
1185             Safefree(tmparyval);
1186         }
1187     }
1188     else {                                      /* no, expanding (or same) */
1189         if (length) {
1190             New(452, tmparyval, length, STR*);  /* so remember deletion */
1191             Copy(ary->ary_array+offset, tmparyval, length, STR*);
1192         }
1193
1194         if (diff > 0) {                         /* expanding */
1195
1196             /* push up or down? */
1197
1198             if (offset < after && diff <= ary->ary_array - ary->ary_alloc) {
1199                 if (offset) {
1200                     src = ary->ary_array;
1201                     dst = src - diff;
1202                     Copy(src, dst, offset, STR*);
1203                 }
1204                 ary->ary_array -= diff;         /* diff is positive */
1205                 ary->ary_max += diff;
1206                 ary->ary_fill += diff;
1207             }
1208             else {
1209                 if (ary->ary_fill + diff >= ary->ary_max)       /* oh, well */
1210                     astore(ary, ary->ary_fill + diff, Nullstr);
1211                 else
1212                     ary->ary_fill += diff;
1213                 if (after) {
1214                     dst = ary->ary_array + ary->ary_fill;
1215                     src = dst - diff;
1216                     for (i = after; i; i--) {
1217                         if (*dst)               /* str was hanging around */
1218                             str_free(*dst);     /*  after $#foo */
1219                         *dst-- = *src;
1220                         *src-- = Nullstr;
1221                     }
1222                 }
1223             }
1224         }
1225
1226         for (src = st+sp, dst = ary->ary_array + offset; newlen; newlen--) {
1227             *dst = Str_new(46,0);
1228             str_sset(*dst++,*src++);
1229         }
1230         sp = arglast[0] + 1;
1231         if (gimme == G_ARRAY) {                 /* copy return vals to stack */
1232             if (length) {
1233                 Copy(tmparyval, st+sp, length, STR*);
1234                 if (ary->ary_flags & ARF_REAL) {
1235                     for (i = length, dst = st+sp; i; i--)
1236                         str_2static(*dst++);    /* free them eventualy */
1237                 }
1238                 Safefree(tmparyval);
1239             }
1240             sp += length - 1;
1241         }
1242         else if (length) {
1243             st[sp] = tmparyval[length-1];
1244             if (ary->ary_flags & ARF_REAL)
1245                 str_2static(st[sp]);
1246             Safefree(tmparyval);
1247         }
1248         else
1249             st[sp] = &str_undef;
1250     }
1251     return sp;
1252 }
1253
1254 int
1255 do_grep(arg,str,gimme,arglast)
1256 register ARG *arg;
1257 STR *str;
1258 int gimme;
1259 int *arglast;
1260 {
1261     STR **st = stack->ary_array;
1262     register int dst = arglast[1];
1263     register int src = dst + 1;
1264     register int sp = arglast[2];
1265     register int i = sp - arglast[1];
1266     int oldsave = savestack->ary_fill;
1267     SPAT *oldspat = curspat;
1268
1269     savesptr(&stab_val(defstab));
1270     if ((arg[1].arg_type & A_MASK) != A_EXPR) {
1271         arg[1].arg_type &= A_MASK;
1272         dehoist(arg,1);
1273         arg[1].arg_type |= A_DONT;
1274     }
1275     arg = arg[1].arg_ptr.arg_arg;
1276     while (i-- > 0) {
1277         if (st[src])
1278             stab_val(defstab) = st[src];
1279         else
1280             stab_val(defstab) = str_static(&str_undef);
1281         (void)eval(arg,G_SCALAR,sp);
1282         st = stack->ary_array;
1283         if (str_true(st[sp+1]))
1284             st[dst++] = st[src];
1285         src++;
1286         curspat = oldspat;
1287     }
1288     restorelist(oldsave);
1289     if (gimme != G_ARRAY) {
1290         str_numset(str,(double)(dst - arglast[1]));
1291         STABSET(str);
1292         st[arglast[0]+1] = str;
1293         return arglast[0]+1;
1294     }
1295     return arglast[0] + (dst - arglast[1]);
1296 }
1297
1298 int
1299 do_reverse(str,gimme,arglast)
1300 STR *str;
1301 int gimme;
1302 int *arglast;
1303 {
1304     STR **st = stack->ary_array;
1305     register STR **up = &st[arglast[1]];
1306     register STR **down = &st[arglast[2]];
1307     register int i = arglast[2] - arglast[1];
1308
1309     while (i-- > 0) {
1310         *up++ = *down;
1311         if (i-- > 0)
1312             *down-- = *up;
1313     }
1314     i = arglast[2] - arglast[1];
1315     Copy(down+1,up,i/2,STR*);
1316     return arglast[2] - 1;
1317 }
1318
1319 int
1320 do_sreverse(str,gimme,arglast)
1321 STR *str;
1322 int gimme;
1323 int *arglast;
1324 {
1325     STR **st = stack->ary_array;
1326     register char *up;
1327     register char *down;
1328     register int tmp;
1329
1330     str_sset(str,st[arglast[2]]);
1331     up = str_get(str);
1332     if (str->str_cur > 1) {
1333         down = str->str_ptr + str->str_cur - 1;
1334         while (down > up) {
1335             tmp = *up;
1336             *up++ = *down;
1337             *down-- = tmp;
1338         }
1339     }
1340     STABSET(str);
1341     st[arglast[0]+1] = str;
1342     return arglast[0]+1;
1343 }
1344
1345 static CMD *sortcmd;
1346 static STAB *firststab = Nullstab;
1347 static STAB *secondstab = Nullstab;
1348
1349 int
1350 do_sort(str,stab,gimme,arglast)
1351 STR *str;
1352 STAB *stab;
1353 int gimme;
1354 int *arglast;
1355 {
1356     register STR **st = stack->ary_array;
1357     int sp = arglast[1];
1358     register STR **up;
1359     register int max = arglast[2] - sp;
1360     register int i;
1361     int sortcmp();
1362     int sortsub();
1363     STR *oldfirst;
1364     STR *oldsecond;
1365     ARRAY *oldstack;
1366     static ARRAY *sortstack = Null(ARRAY*);
1367
1368     if (gimme != G_ARRAY) {
1369         str_sset(str,&str_undef);
1370         STABSET(str);
1371         st[sp] = str;
1372         return sp;
1373     }
1374     up = &st[sp];
1375     st += sp;           /* temporarily make st point to args */
1376     for (i = 1; i <= max; i++) {
1377         if (*up = st[i]) {
1378             if (!(*up)->str_pok)
1379                 (void)str_2ptr(*up);
1380             up++;
1381         }
1382     }
1383     st -= sp;
1384     max = up - &st[sp];
1385     sp--;
1386     if (max > 1) {
1387         if (stab) {
1388             int oldtmps_base = tmps_base;
1389
1390             if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
1391                 fatal("Undefined subroutine \"%s\" in sort", stab_name(stab));
1392             if (!sortstack) {
1393                 sortstack = anew(Nullstab);
1394                 sortstack->ary_flags = 0;
1395             }
1396             oldstack = stack;
1397             stack = sortstack;
1398             tmps_base = tmps_max;
1399             if (!firststab) {
1400                 firststab = stabent("a",TRUE);
1401                 secondstab = stabent("b",TRUE);
1402             }
1403             oldfirst = stab_val(firststab);
1404             oldsecond = stab_val(secondstab);
1405 #ifndef lint
1406             qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
1407 #else
1408             qsort(Nullch,max,sizeof(STR*),sortsub);
1409 #endif
1410             stab_val(firststab) = oldfirst;
1411             stab_val(secondstab) = oldsecond;
1412             tmps_base = oldtmps_base;
1413             stack = oldstack;
1414         }
1415 #ifndef lint
1416         else
1417             qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
1418 #endif
1419     }
1420     return sp+max;
1421 }
1422
1423 int
1424 sortsub(str1,str2)
1425 STR **str1;
1426 STR **str2;
1427 {
1428     stab_val(firststab) = *str1;
1429     stab_val(secondstab) = *str2;
1430     cmd_exec(sortcmd,G_SCALAR,-1);
1431     return (int)str_gnum(*stack->ary_array);
1432 }
1433
1434 sortcmp(strp1,strp2)
1435 STR **strp1;
1436 STR **strp2;
1437 {
1438     register STR *str1 = *strp1;
1439     register STR *str2 = *strp2;
1440     int retval;
1441
1442     if (str1->str_cur < str2->str_cur) {
1443         if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
1444             return retval;
1445         else
1446             return -1;
1447     }
1448     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
1449         return retval;
1450     else if (str1->str_cur == str2->str_cur)
1451         return 0;
1452     else
1453         return 1;
1454 }
1455
1456 int
1457 do_range(gimme,arglast)
1458 int gimme;
1459 int *arglast;
1460 {
1461     STR **st = stack->ary_array;
1462     register int sp = arglast[0];
1463     register int i;
1464     register ARRAY *ary = stack;
1465     register STR *str;
1466     int max;
1467
1468     if (gimme != G_ARRAY)
1469         fatal("panic: do_range");
1470
1471     if (st[sp+1]->str_nok ||
1472       (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
1473         i = (int)str_gnum(st[sp+1]);
1474         max = (int)str_gnum(st[sp+2]);
1475         while (i <= max) {
1476             (void)astore(ary, ++sp, str = str_static(&str_no));
1477             str_numset(str,(double)i++);
1478         }
1479     }
1480     else {
1481         STR *final = str_static(st[sp+2]);
1482         char *tmps = str_get(final);
1483
1484         str = str_static(st[sp+1]);
1485         while (!str->str_nok && str->str_cur <= final->str_cur &&
1486             strNE(str->str_ptr,tmps) ) {
1487             (void)astore(ary, ++sp, str);
1488             str = str_static(str);
1489             str_inc(str);
1490         }
1491         if (strEQ(str->str_ptr,tmps))
1492             (void)astore(ary, ++sp, str);
1493     }
1494     return sp;
1495 }
1496
1497 int
1498 do_caller(arg,maxarg,gimme,arglast)
1499 ARG *arg;
1500 int maxarg;
1501 int gimme;
1502 int *arglast;
1503 {
1504     STR **st = stack->ary_array;
1505     register int sp = arglast[0];
1506     register CSV *csv = curcsv;
1507     STR *str;
1508     int count = 0;
1509
1510     if (!csv)
1511         fatal("There is no caller");
1512     if (maxarg)
1513         count = (int) str_gnum(st[sp+1]);
1514     for (;;) {
1515         if (!csv)
1516             return sp;
1517         if (csv->curcsv && csv->curcsv->sub == stab_sub(DBsub))
1518             count++;
1519         if (!count--)
1520             break;
1521         csv = csv->curcsv;
1522     }
1523     if (gimme != G_ARRAY) {
1524         STR *str = arg->arg_ptr.arg_str;
1525         str_set(str,csv->curcmd->c_stash->tbl_name);
1526         STABSET(str);
1527         st[++sp] = str;
1528         return sp;
1529     }
1530
1531 #ifndef lint
1532     (void)astore(stack,++sp,
1533       str_2static(str_make(csv->curcmd->c_stash->tbl_name,0)) );
1534     (void)astore(stack,++sp,
1535       str_2static(str_make(stab_val(csv->curcmd->c_filestab)->str_ptr,0)) );
1536     (void)astore(stack,++sp,
1537       str_2static(str_nmake((double)csv->curcmd->c_line)) );
1538     if (!maxarg)
1539         return sp;
1540     str = str_static(&str_undef);
1541     stab_fullname(str, csv->stab);
1542     (void)astore(stack,++sp, str);
1543     (void)astore(stack,++sp,
1544       str_2static(str_nmake((double)csv->hasargs)) );
1545     (void)astore(stack,++sp,
1546       str_2static(str_nmake((double)csv->wantarray)) );
1547     if (csv->hasargs) {
1548         ARRAY *ary = csv->argarray;
1549
1550         if (dbargs->ary_max < ary->ary_fill)
1551             astore(dbargs,ary->ary_fill,Nullstr);
1552         Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*);
1553         dbargs->ary_fill = ary->ary_fill;
1554     }
1555 #else
1556     (void)astore(stack,++sp,
1557       str_2static(str_make("",0)));
1558 #endif
1559     return sp;
1560 }
1561
1562 int
1563 do_tms(str,gimme,arglast)
1564 STR *str;
1565 int gimme;
1566 int *arglast;
1567 {
1568 #ifdef MSDOS
1569     return -1;
1570 #else
1571     STR **st = stack->ary_array;
1572     register int sp = arglast[0];
1573
1574     if (gimme != G_ARRAY) {
1575         str_sset(str,&str_undef);
1576         STABSET(str);
1577         st[++sp] = str;
1578         return sp;
1579     }
1580     (void)times(&timesbuf);
1581
1582 #ifndef HZ
1583 #define HZ 60
1584 #endif
1585
1586 #ifndef lint
1587     (void)astore(stack,++sp,
1588       str_2static(str_nmake(((double)timesbuf.tms_utime)/HZ)));
1589     (void)astore(stack,++sp,
1590       str_2static(str_nmake(((double)timesbuf.tms_stime)/HZ)));
1591     (void)astore(stack,++sp,
1592       str_2static(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
1593     (void)astore(stack,++sp,
1594       str_2static(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
1595 #else
1596     (void)astore(stack,++sp,
1597       str_2static(str_nmake(0.0)));
1598 #endif
1599     return sp;
1600 #endif
1601 }
1602
1603 int
1604 do_time(str,tmbuf,gimme,arglast)
1605 STR *str;
1606 struct tm *tmbuf;
1607 int gimme;
1608 int *arglast;
1609 {
1610     register ARRAY *ary = stack;
1611     STR **st = ary->ary_array;
1612     register int sp = arglast[0];
1613
1614     if (!tmbuf || gimme != G_ARRAY) {
1615         str_sset(str,&str_undef);
1616         STABSET(str);
1617         st[++sp] = str;
1618         return sp;
1619     }
1620     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_sec)));
1621     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_min)));
1622     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_hour)));
1623     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mday)));
1624     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mon)));
1625     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_year)));
1626     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_wday)));
1627     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_yday)));
1628     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_isdst)));
1629     return sp;
1630 }
1631
1632 int
1633 do_kv(str,hash,kv,gimme,arglast)
1634 STR *str;
1635 HASH *hash;
1636 int kv;
1637 int gimme;
1638 int *arglast;
1639 {
1640     register ARRAY *ary = stack;
1641     STR **st = ary->ary_array;
1642     register int sp = arglast[0];
1643     int i;
1644     register HENT *entry;
1645     char *tmps;
1646     STR *tmpstr;
1647     int dokeys = (kv == O_KEYS || kv == O_HASH);
1648     int dovalues = (kv == O_VALUES || kv == O_HASH);
1649
1650     if (gimme != G_ARRAY) {
1651         str_sset(str,&str_undef);
1652         STABSET(str);
1653         st[++sp] = str;
1654         return sp;
1655     }
1656     (void)hiterinit(hash);
1657     while (entry = hiternext(hash)) {
1658         if (dokeys) {
1659             tmps = hiterkey(entry,&i);
1660             if (!i)
1661                 tmps = "";
1662             (void)astore(ary,++sp,str_2static(str_make(tmps,i)));
1663         }
1664         if (dovalues) {
1665             tmpstr = Str_new(45,0);
1666 #ifdef DEBUGGING
1667             if (debug & 8192) {
1668                 sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
1669                     hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
1670                 str_set(tmpstr,buf);
1671             }
1672             else
1673 #endif
1674             str_sset(tmpstr,hiterval(hash,entry));
1675             (void)astore(ary,++sp,str_2static(tmpstr));
1676         }
1677     }
1678     return sp;
1679 }
1680
1681 int
1682 do_each(str,hash,gimme,arglast)
1683 STR *str;
1684 HASH *hash;
1685 int gimme;
1686 int *arglast;
1687 {
1688     STR **st = stack->ary_array;
1689     register int sp = arglast[0];
1690     static STR *mystrk = Nullstr;
1691     HENT *entry = hiternext(hash);
1692     int i;
1693     char *tmps;
1694
1695     if (mystrk) {
1696         str_free(mystrk);
1697         mystrk = Nullstr;
1698     }
1699
1700     if (entry) {
1701         if (gimme == G_ARRAY) {
1702             tmps = hiterkey(entry, &i);
1703             if (!i)
1704                 tmps = "";
1705             st[++sp] = mystrk = str_make(tmps,i);
1706         }
1707         st[++sp] = str;
1708         str_sset(str,hiterval(hash,entry));
1709         STABSET(str);
1710         return sp;
1711     }
1712     else
1713         return sp;
1714 }