This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dbdcaa7a4945ce06918f3986aa888c53da44291c
[perl5.git] / dolist.c
1 /* $Header: dolist.c,v 3.0.1.9 90/08/13 22:15:35 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.9  90/08/13  22:15:35  lwall
10  * patch28: defined(@array) and defined(%array) didn't work right
11  * 
12  * Revision 3.0.1.8  90/08/09  03:15:56  lwall
13  * patch19: certain kinds of matching cause "panic: hint"
14  * patch19: $' broke on embedded nulls
15  * patch19: split on /\s+/, /^/ and ' ' is now special cased for speed
16  * patch19: split on /x/i didn't work
17  * patch19: couldn't unpack an 'A' or 'a' field in a scalar context
18  * patch19: unpack called bcopy on each character of a C/c field
19  * patch19: pack/unpack know about uudecode lines
20  * patch19: fixed sort on undefined strings and sped up slightly
21  * patch19: each and keys returned garbage on null key in DBM file
22  * 
23  * Revision 3.0.1.7  90/03/27  15:48:42  lwall
24  * patch16: MSDOS support
25  * patch16: use of $`, $& or $' sometimes causes memory leakage
26  * patch16: splice(@array,0,$n) case cause duplicate free
27  * patch16: grep blows up on undefined array values
28  * patch16: .. now works using magical string increment
29  * 
30  * Revision 3.0.1.6  90/03/12  16:33:02  lwall
31  * patch13: added list slice operator (LIST)[LIST]
32  * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
33  * patch13: made split('') act like split(//) rather than split(' ')
34  * 
35  * Revision 3.0.1.5  90/02/28  17:09:44  lwall
36  * patch9: split now can split into more than 10000 elements
37  * patch9: @_ clobbered by ($foo,$bar) = split
38  * patch9: sped up pack and unpack
39  * patch9: unpack of single item now works in a scalar context
40  * patch9: slices ignored value of $[
41  * patch9: grep now returns number of items matched in scalar context
42  * patch9: grep iterations no longer in the regexp context of previous iteration
43  * 
44  * Revision 3.0.1.4  89/12/21  19:58:46  lwall
45  * patch7: grep(1,@array) didn't work
46  * patch7: /$pat/; //; wrongly freed runtime pattern twice
47  * 
48  * Revision 3.0.1.3  89/11/17  15:14:45  lwall
49  * patch5: grep() occasionally loses arguments or dumps core
50  * 
51  * Revision 3.0.1.2  89/11/11  04:28:17  lwall
52  * patch2: non-existent slice values are now undefined rather than null
53  * 
54  * Revision 3.0.1.1  89/10/26  23:11:51  lwall
55  * patch1: split in a subroutine wrongly freed referenced arguments
56  * patch1: reverse didn't work
57  * 
58  * Revision 3.0  89/10/18  15:11:02  lwall
59  * 3.0 baseline
60  * 
61  */
62
63 #include "EXTERN.h"
64 #include "perl.h"
65
66
67 #ifdef BUGGY_MSC
68  #pragma function(memcmp)
69 #endif /* BUGGY_MSC */
70
71 int
72 do_match(str,arg,gimme,arglast)
73 STR *str;
74 register ARG *arg;
75 int gimme;
76 int *arglast;
77 {
78     register STR **st = stack->ary_array;
79     register SPAT *spat = arg[2].arg_ptr.arg_spat;
80     register char *t;
81     register int sp = arglast[0] + 1;
82     STR *srchstr = st[sp];
83     register char *s = str_get(st[sp]);
84     char *strend = s + st[sp]->str_cur;
85     STR *tmpstr;
86     char *myhint = hint;
87
88     hint = Nullch;
89     if (!spat) {
90         if (gimme == G_ARRAY)
91             return --sp;
92         str_set(str,Yes);
93         STABSET(str);
94         st[sp] = str;
95         return sp;
96     }
97     if (!s)
98         fatal("panic: do_match");
99     if (spat->spat_flags & SPAT_USED) {
100 #ifdef DEBUGGING
101         if (debug & 8)
102             deb("2.SPAT USED\n");
103 #endif
104         if (gimme == G_ARRAY)
105             return --sp;
106         str_set(str,No);
107         STABSET(str);
108         st[sp] = str;
109         return sp;
110     }
111     --sp;
112     if (spat->spat_runtime) {
113         nointrp = "|)";
114         sp = eval(spat->spat_runtime,G_SCALAR,sp);
115         st = stack->ary_array;
116         t = str_get(tmpstr = st[sp--]);
117         nointrp = "";
118 #ifdef DEBUGGING
119         if (debug & 8)
120             deb("2.SPAT /%s/\n",t);
121 #endif
122         if (spat->spat_regexp)
123             regfree(spat->spat_regexp);
124         spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
125             spat->spat_flags & SPAT_FOLD);
126         if (!*spat->spat_regexp->precomp && lastspat)
127             spat = lastspat;
128         if (spat->spat_flags & SPAT_KEEP) {
129             if (spat->spat_runtime)
130                 arg_free(spat->spat_runtime);   /* it won't change, so */
131             spat->spat_runtime = Nullarg;       /* no point compiling again */
132         }
133         if (!spat->spat_regexp->nparens)
134             gimme = G_SCALAR;                   /* accidental array context? */
135         if (regexec(spat->spat_regexp, s, strend, s, 0,
136           srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
137           gimme == G_ARRAY)) {
138             if (spat->spat_regexp->subbase)
139                 curspat = spat;
140             lastspat = spat;
141             goto gotcha;
142         }
143         else {
144             if (gimme == G_ARRAY)
145                 return sp;
146             str_sset(str,&str_no);
147             STABSET(str);
148             st[++sp] = str;
149             return sp;
150         }
151     }
152     else {
153 #ifdef DEBUGGING
154         if (debug & 8) {
155             char ch;
156
157             if (spat->spat_flags & SPAT_ONCE)
158                 ch = '?';
159             else
160                 ch = '/';
161             deb("2.SPAT %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
162         }
163 #endif
164         if (!*spat->spat_regexp->precomp && lastspat)
165             spat = lastspat;
166         t = s;
167         if (myhint) {
168             if (myhint < s || myhint > strend)
169                 fatal("panic: hint in do_match");
170             s = myhint;
171             if (spat->spat_regexp->regback >= 0) {
172                 s -= spat->spat_regexp->regback;
173                 if (s < t)
174                     s = t;
175             }
176             else
177                 s = t;
178         }
179         else if (spat->spat_short) {
180             if (spat->spat_flags & SPAT_SCANFIRST) {
181                 if (srchstr->str_pok & SP_STUDIED) {
182                     if (screamfirst[spat->spat_short->str_rare] < 0)
183                         goto nope;
184                     else if (!(s = screaminstr(srchstr,spat->spat_short)))
185                         goto nope;
186                     else if (spat->spat_flags & SPAT_ALL)
187                         goto yup;
188                 }
189 #ifndef lint
190                 else if (!(s = fbminstr((unsigned char*)s,
191                   (unsigned char*)strend, spat->spat_short)))
192                     goto nope;
193 #endif
194                 else if (spat->spat_flags & SPAT_ALL)
195                     goto yup;
196                 if (s && spat->spat_regexp->regback >= 0) {
197                     ++spat->spat_short->str_u.str_useful;
198                     s -= spat->spat_regexp->regback;
199                     if (s < t)
200                         s = t;
201                 }
202                 else
203                     s = t;
204             }
205             else if (!multiline && (*spat->spat_short->str_ptr != *s ||
206               bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
207                 goto nope;
208             if (--spat->spat_short->str_u.str_useful < 0) {
209                 str_free(spat->spat_short);
210                 spat->spat_short = Nullstr;     /* opt is being useless */
211             }
212         }
213         if (!spat->spat_regexp->nparens)
214             gimme = G_SCALAR;                   /* accidental array context? */
215         if (regexec(spat->spat_regexp, s, strend, t, 0,
216           srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
217           gimme == G_ARRAY)) {
218             if (spat->spat_regexp->subbase)
219                 curspat = spat;
220             lastspat = spat;
221             if (spat->spat_flags & SPAT_ONCE)
222                 spat->spat_flags |= SPAT_USED;
223             goto gotcha;
224         }
225         else {
226             if (gimme == G_ARRAY)
227                 return sp;
228             str_sset(str,&str_no);
229             STABSET(str);
230             st[++sp] = str;
231             return sp;
232         }
233     }
234     /*NOTREACHED*/
235
236   gotcha:
237     if (gimme == G_ARRAY) {
238         int iters, i, len;
239
240         iters = spat->spat_regexp->nparens;
241         if (sp + iters >= stack->ary_max) {
242             astore(stack,sp + iters, Nullstr);
243             st = stack->ary_array;              /* possibly realloced */
244         }
245
246         for (i = 1; i <= iters; i++) {
247             st[++sp] = str_static(&str_no);
248             if (s = spat->spat_regexp->startp[i]) {
249                 len = spat->spat_regexp->endp[i] - s;
250                 if (len > 0)
251                     str_nset(st[sp],s,len);
252             }
253         }
254         return sp;
255     }
256     else {
257         str_sset(str,&str_yes);
258         STABSET(str);
259         st[++sp] = str;
260         return sp;
261     }
262
263 yup:
264     ++spat->spat_short->str_u.str_useful;
265     lastspat = spat;
266     if (spat->spat_flags & SPAT_ONCE)
267         spat->spat_flags |= SPAT_USED;
268     if (sawampersand) {
269         char *tmps;
270
271         if (spat->spat_regexp->subbase)
272             Safefree(spat->spat_regexp->subbase);
273         tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
274         spat->spat_regexp->subend = tmps + (strend-t);
275         tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
276         spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
277         curspat = spat;
278     }
279     str_sset(str,&str_yes);
280     STABSET(str);
281     st[++sp] = str;
282     return sp;
283
284 nope:
285     ++spat->spat_short->str_u.str_useful;
286     if (gimme == G_ARRAY)
287         return sp;
288     str_sset(str,&str_no);
289     STABSET(str);
290     st[++sp] = str;
291     return sp;
292 }
293
294 #ifdef BUGGY_MSC
295  #pragma intrinsic(memcmp)
296 #endif /* BUGGY_MSC */
297
298 int
299 do_split(str,spat,limit,gimme,arglast)
300 STR *str;
301 register SPAT *spat;
302 register int limit;
303 int gimme;
304 int *arglast;
305 {
306     register ARRAY *ary = stack;
307     STR **st = ary->ary_array;
308     register int sp = arglast[0] + 1;
309     register char *s = str_get(st[sp]);
310     char *strend = s + st[sp--]->str_cur;
311     register STR *dstr;
312     register char *m;
313     int iters = 0;
314     int maxiters = (strend - s) + 10;
315     int i;
316     char *orig;
317     int origlimit = limit;
318     int realarray = 0;
319
320     if (!spat || !s)
321         fatal("panic: do_split");
322     else if (spat->spat_runtime) {
323         nointrp = "|)";
324         sp = eval(spat->spat_runtime,G_SCALAR,sp);
325         st = stack->ary_array;
326         m = str_get(dstr = st[sp--]);
327         nointrp = "";
328         if (*m == ' ' && dstr->str_cur == 1) {
329             str_set(dstr,"\\s+");
330             m = dstr->str_ptr;
331             spat->spat_flags |= SPAT_SKIPWHITE;
332         }
333         if (spat->spat_regexp)
334             regfree(spat->spat_regexp);
335         spat->spat_regexp = regcomp(m,m+dstr->str_cur,
336             spat->spat_flags & SPAT_FOLD);
337         if (spat->spat_flags & SPAT_KEEP ||
338             (spat->spat_runtime->arg_type == O_ITEM &&
339               (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
340             arg_free(spat->spat_runtime);       /* it won't change, so */
341             spat->spat_runtime = Nullarg;       /* no point compiling again */
342         }
343     }
344 #ifdef DEBUGGING
345     if (debug & 8) {
346         deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
347     }
348 #endif
349     ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
350     if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) {
351         realarray = 1;
352         if (!(ary->ary_flags & ARF_REAL)) {
353             ary->ary_flags |= ARF_REAL;
354             for (i = ary->ary_fill; i >= 0; i--)
355                 ary->ary_array[i] = Nullstr;    /* don't free mere refs */
356         }
357         ary->ary_fill = -1;
358         sp = -1;        /* temporarily switch stacks */
359     }
360     else
361         ary = stack;
362     orig = s;
363     if (spat->spat_flags & SPAT_SKIPWHITE) {
364         while (isspace(*s))
365             s++;
366     }
367     if (!limit)
368         limit = maxiters + 2;
369     if (strEQ("\\s+",spat->spat_regexp->precomp)) {
370         while (--limit) {
371             for (m = s; m < strend && !isspace(*m); m++) ;
372             if (m >= strend)
373                 break;
374             if (realarray)
375                 dstr = Str_new(30,m-s);
376             else
377                 dstr = str_static(&str_undef);
378             str_nset(dstr,s,m-s);
379             (void)astore(ary, ++sp, dstr);
380             for (s = m + 1; s < strend && isspace(*s); s++) ;
381         }
382     }
383     else if (strEQ("^",spat->spat_regexp->precomp)) {
384         while (--limit) {
385             for (m = s; m < strend && *m != '\n'; m++) ;
386             m++;
387             if (m >= strend)
388                 break;
389             if (realarray)
390                 dstr = Str_new(30,m-s);
391             else
392                 dstr = str_static(&str_undef);
393             str_nset(dstr,s,m-s);
394             (void)astore(ary, ++sp, dstr);
395             s = m;
396         }
397     }
398     else if (spat->spat_short) {
399         i = spat->spat_short->str_cur;
400         if (i == 1) {
401             int fold = (spat->spat_flags & SPAT_FOLD);
402
403             i = *spat->spat_short->str_ptr;
404             if (fold && isupper(i))
405                 i = tolower(i);
406             while (--limit) {
407                 if (fold) {
408                     for ( m = s;
409                           m < strend && *m != i &&
410                             (!isupper(*m) || tolower(*m) != i);
411                           m++)
412                         ;
413                 }
414                 else
415                     for (m = s; m < strend && *m != i; m++) ;
416                 if (m >= strend)
417                     break;
418                 if (realarray)
419                     dstr = Str_new(30,m-s);
420                 else
421                     dstr = str_static(&str_undef);
422                 str_nset(dstr,s,m-s);
423                 (void)astore(ary, ++sp, dstr);
424                 s = m + 1;
425             }
426         }
427         else {
428 #ifndef lint
429             while (s < strend && --limit &&
430               (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
431                     spat->spat_short)) )
432 #endif
433             {
434                 if (realarray)
435                     dstr = Str_new(31,m-s);
436                 else
437                     dstr = str_static(&str_undef);
438                 str_nset(dstr,s,m-s);
439                 (void)astore(ary, ++sp, dstr);
440                 s = m + i;
441             }
442         }
443     }
444     else {
445         maxiters += (strend - s) * spat->spat_regexp->nparens;
446         while (s < strend && --limit &&
447             regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
448             if (spat->spat_regexp->subbase
449               && spat->spat_regexp->subbase != orig) {
450                 m = s;
451                 s = orig;
452                 orig = spat->spat_regexp->subbase;
453                 s = orig + (m - s);
454                 strend = s + (strend - m);
455             }
456             m = spat->spat_regexp->startp[0];
457             if (realarray)
458                 dstr = Str_new(32,m-s);
459             else
460                 dstr = str_static(&str_undef);
461             str_nset(dstr,s,m-s);
462             (void)astore(ary, ++sp, dstr);
463             if (spat->spat_regexp->nparens) {
464                 for (i = 1; i <= spat->spat_regexp->nparens; i++) {
465                     s = spat->spat_regexp->startp[i];
466                     m = spat->spat_regexp->endp[i];
467                     if (realarray)
468                         dstr = Str_new(33,m-s);
469                     else
470                         dstr = str_static(&str_undef);
471                     str_nset(dstr,s,m-s);
472                     (void)astore(ary, ++sp, dstr);
473                 }
474             }
475             s = spat->spat_regexp->endp[0];
476         }
477     }
478     if (realarray)
479         iters = sp + 1;
480     else
481         iters = sp - arglast[0];
482     if (iters > maxiters)
483         fatal("Split loop");
484     if (s < strend || origlimit) {      /* keep field after final delim? */
485         if (realarray)
486             dstr = Str_new(34,strend-s);
487         else
488             dstr = str_static(&str_undef);
489         str_nset(dstr,s,strend-s);
490         (void)astore(ary, ++sp, dstr);
491         iters++;
492     }
493     else {
494 #ifndef I286x
495         while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
496             iters--,sp--;
497 #else
498         char *zaps;
499         int   zapb;
500
501         if (iters > 0) {
502                 zaps = str_get(afetch(ary,sp,FALSE));
503                 zapb = (int) *zaps;
504         }
505         
506         while (iters > 0 && (!zapb)) {
507             iters--,sp--;
508             if (iters > 0) {
509                 zaps = str_get(afetch(ary,iters-1,FALSE));
510                 zapb = (int) *zaps;
511             }
512         }
513 #endif
514     }
515     if (realarray) {
516         ary->ary_fill = sp;
517         if (gimme == G_ARRAY) {
518             sp++;
519             astore(stack, arglast[0] + 1 + sp, Nullstr);
520             Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
521             return arglast[0] + sp;
522         }
523     }
524     else {
525         if (gimme == G_ARRAY)
526             return sp;
527     }
528     sp = arglast[0] + 1;
529     str_numset(str,(double)iters);
530     STABSET(str);
531     st[sp] = str;
532     return sp;
533 }
534
535 int
536 do_unpack(str,gimme,arglast)
537 STR *str;
538 int gimme;
539 int *arglast;
540 {
541     STR **st = stack->ary_array;
542     register int sp = arglast[0] + 1;
543     register char *pat = str_get(st[sp++]);
544     register char *s = str_get(st[sp]);
545     char *strend = s + st[sp--]->str_cur;
546     char *strbeg = s;
547     register char *patend = pat + st[sp]->str_cur;
548     int datumtype;
549     register int len;
550
551     /* These must not be in registers: */
552     char achar;
553     short ashort;
554     int aint;
555     long along;
556     unsigned char auchar;
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(str,gimme,arglast)
1295 STR *str;
1296 int gimme;
1297 int *arglast;
1298 {
1299     STR **st = stack->ary_array;
1300     register STR **up = &st[arglast[1]];
1301     register STR **down = &st[arglast[2]];
1302     register int i = arglast[2] - arglast[1];
1303
1304     if (gimme != G_ARRAY) {
1305         str_sset(str,&str_undef);
1306         STABSET(str);
1307         st[arglast[0]+1] = str;
1308         return arglast[0]+1;
1309     }
1310     while (i-- > 0) {
1311         *up++ = *down;
1312         if (i-- > 0)
1313             *down-- = *up;
1314     }
1315     i = arglast[2] - arglast[1];
1316     Copy(down+1,up,i/2,STR*);
1317     return arglast[2] - 1;
1318 }
1319
1320 static CMD *sortcmd;
1321 static STAB *firststab = Nullstab;
1322 static STAB *secondstab = Nullstab;
1323
1324 int
1325 do_sort(str,stab,gimme,arglast)
1326 STR *str;
1327 STAB *stab;
1328 int gimme;
1329 int *arglast;
1330 {
1331     register STR **st = stack->ary_array;
1332     int sp = arglast[1];
1333     register STR **up;
1334     register int max = arglast[2] - sp;
1335     register int i;
1336     int sortcmp();
1337     int sortsub();
1338     STR *oldfirst;
1339     STR *oldsecond;
1340     ARRAY *oldstack;
1341     static ARRAY *sortstack = Null(ARRAY*);
1342
1343     if (gimme != G_ARRAY) {
1344         str_sset(str,&str_undef);
1345         STABSET(str);
1346         st[sp] = str;
1347         return sp;
1348     }
1349     up = &st[sp];
1350     st += sp;           /* temporarily make st point to args */
1351     for (i = 1; i <= max; i++) {
1352         if (*up = st[i]) {
1353             if (!(*up)->str_pok)
1354                 (void)str_2ptr(*up);
1355             up++;
1356         }
1357     }
1358     st -= sp;
1359     max = up - &st[sp];
1360     sp--;
1361     if (max > 1) {
1362         if (stab_sub(stab) && (sortcmd = stab_sub(stab)->cmd)) {
1363             int oldtmps_base = tmps_base;
1364
1365             if (!sortstack) {
1366                 sortstack = anew(Nullstab);
1367                 sortstack->ary_flags = 0;
1368             }
1369             oldstack = stack;
1370             stack = sortstack;
1371             tmps_base = tmps_max;
1372             if (!firststab) {
1373                 firststab = stabent("a",TRUE);
1374                 secondstab = stabent("b",TRUE);
1375             }
1376             oldfirst = stab_val(firststab);
1377             oldsecond = stab_val(secondstab);
1378 #ifndef lint
1379             qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
1380 #else
1381             qsort(Nullch,max,sizeof(STR*),sortsub);
1382 #endif
1383             stab_val(firststab) = oldfirst;
1384             stab_val(secondstab) = oldsecond;
1385             tmps_base = oldtmps_base;
1386             stack = oldstack;
1387         }
1388 #ifndef lint
1389         else
1390             qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
1391 #endif
1392     }
1393     return sp+max;
1394 }
1395
1396 int
1397 sortsub(str1,str2)
1398 STR **str1;
1399 STR **str2;
1400 {
1401     stab_val(firststab) = *str1;
1402     stab_val(secondstab) = *str2;
1403     cmd_exec(sortcmd,G_SCALAR,-1);
1404     return (int)str_gnum(*stack->ary_array);
1405 }
1406
1407 sortcmp(strp1,strp2)
1408 STR **strp1;
1409 STR **strp2;
1410 {
1411     register STR *str1 = *strp1;
1412     register STR *str2 = *strp2;
1413     int retval;
1414
1415     if (str1->str_cur < str2->str_cur) {
1416         if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
1417             return retval;
1418         else
1419             return -1;
1420     }
1421     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
1422         return retval;
1423     else if (str1->str_cur == str2->str_cur)
1424         return 0;
1425     else
1426         return 1;
1427 }
1428
1429 int
1430 do_range(gimme,arglast)
1431 int gimme;
1432 int *arglast;
1433 {
1434     STR **st = stack->ary_array;
1435     register int sp = arglast[0];
1436     register int i;
1437     register ARRAY *ary = stack;
1438     register STR *str;
1439     int max;
1440
1441     if (gimme != G_ARRAY)
1442         fatal("panic: do_range");
1443
1444     if (st[sp+1]->str_nok ||
1445       (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
1446         i = (int)str_gnum(st[sp+1]);
1447         max = (int)str_gnum(st[sp+2]);
1448         while (i <= max) {
1449             (void)astore(ary, ++sp, str = str_static(&str_no));
1450             str_numset(str,(double)i++);
1451         }
1452     }
1453     else {
1454         STR *final = str_static(st[sp+2]);
1455         char *tmps = str_get(final);
1456
1457         str = str_static(st[sp+1]);
1458         while (!str->str_nok && str->str_cur <= final->str_cur &&
1459             strNE(str->str_ptr,tmps) ) {
1460             (void)astore(ary, ++sp, str);
1461             str = str_static(str);
1462             str_inc(str);
1463         }
1464         if (strEQ(str->str_ptr,tmps))
1465             (void)astore(ary, ++sp, str);
1466     }
1467     return sp;
1468 }
1469
1470 int
1471 do_tms(str,gimme,arglast)
1472 STR *str;
1473 int gimme;
1474 int *arglast;
1475 {
1476     STR **st = stack->ary_array;
1477     register int sp = arglast[0];
1478
1479     if (gimme != G_ARRAY) {
1480         str_sset(str,&str_undef);
1481         STABSET(str);
1482         st[++sp] = str;
1483         return sp;
1484     }
1485     (void)times(&timesbuf);
1486
1487 #ifndef HZ
1488 #define HZ 60
1489 #endif
1490
1491 #ifndef lint
1492     (void)astore(stack,++sp,
1493       str_2static(str_nmake(((double)timesbuf.tms_utime)/HZ)));
1494     (void)astore(stack,++sp,
1495       str_2static(str_nmake(((double)timesbuf.tms_stime)/HZ)));
1496     (void)astore(stack,++sp,
1497       str_2static(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
1498     (void)astore(stack,++sp,
1499       str_2static(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
1500 #else
1501     (void)astore(stack,++sp,
1502       str_2static(str_nmake(0.0)));
1503 #endif
1504     return sp;
1505 }
1506
1507 int
1508 do_time(str,tmbuf,gimme,arglast)
1509 STR *str;
1510 struct tm *tmbuf;
1511 int gimme;
1512 int *arglast;
1513 {
1514     register ARRAY *ary = stack;
1515     STR **st = ary->ary_array;
1516     register int sp = arglast[0];
1517
1518     if (!tmbuf || gimme != G_ARRAY) {
1519         str_sset(str,&str_undef);
1520         STABSET(str);
1521         st[++sp] = str;
1522         return sp;
1523     }
1524     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_sec)));
1525     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_min)));
1526     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_hour)));
1527     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mday)));
1528     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_mon)));
1529     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_year)));
1530     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_wday)));
1531     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_yday)));
1532     (void)astore(ary,++sp,str_2static(str_nmake((double)tmbuf->tm_isdst)));
1533     return sp;
1534 }
1535
1536 int
1537 do_kv(str,hash,kv,gimme,arglast)
1538 STR *str;
1539 HASH *hash;
1540 int kv;
1541 int gimme;
1542 int *arglast;
1543 {
1544     register ARRAY *ary = stack;
1545     STR **st = ary->ary_array;
1546     register int sp = arglast[0];
1547     int i;
1548     register HENT *entry;
1549     char *tmps;
1550     STR *tmpstr;
1551     int dokeys = (kv == O_KEYS || kv == O_HASH);
1552     int dovalues = (kv == O_VALUES || kv == O_HASH);
1553
1554     if (gimme != G_ARRAY) {
1555         str_sset(str,&str_undef);
1556         STABSET(str);
1557         st[++sp] = str;
1558         return sp;
1559     }
1560     (void)hiterinit(hash);
1561     while (entry = hiternext(hash)) {
1562         if (dokeys) {
1563             tmps = hiterkey(entry,&i);
1564             if (!i)
1565                 tmps = "";
1566             (void)astore(ary,++sp,str_2static(str_make(tmps,i)));
1567         }
1568         if (dovalues) {
1569             tmpstr = Str_new(45,0);
1570 #ifdef DEBUGGING
1571             if (debug & 8192) {
1572                 sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
1573                     hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
1574                 str_set(tmpstr,buf);
1575             }
1576             else
1577 #endif
1578             str_sset(tmpstr,hiterval(hash,entry));
1579             (void)astore(ary,++sp,str_2static(tmpstr));
1580         }
1581     }
1582     return sp;
1583 }
1584
1585 int
1586 do_each(str,hash,gimme,arglast)
1587 STR *str;
1588 HASH *hash;
1589 int gimme;
1590 int *arglast;
1591 {
1592     STR **st = stack->ary_array;
1593     register int sp = arglast[0];
1594     static STR *mystrk = Nullstr;
1595     HENT *entry = hiternext(hash);
1596     int i;
1597     char *tmps;
1598
1599     if (mystrk) {
1600         str_free(mystrk);
1601         mystrk = Nullstr;
1602     }
1603
1604     if (entry) {
1605         if (gimme == G_ARRAY) {
1606             tmps = hiterkey(entry, &i);
1607             if (!i)
1608                 tmps = "";
1609             st[++sp] = mystrk = str_make(tmps,i);
1610         }
1611         st[++sp] = str;
1612         str_sset(str,hiterval(hash,entry));
1613         STABSET(str);
1614         return sp;
1615     }
1616     else
1617         return sp;
1618 }