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