source: trunk/third/perl/dolist.c @ 9009

Revision 9009, 44.1 KB checked in by ghudson, 28 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r9008, which included commits to RCS files with non-trunk default branches.
Line 
1/* $RCSfile: dolist.c,v $$Revision: 1.1.1.1 $$Date: 1996-10-02 06:39:55 $
2 *
3 *    Copyright (c) 1991, Larry Wall
4 *
5 *    You may distribute under the terms of either the GNU General Public
6 *    License or the Artistic License, as specified in the README file.
7 *
8 * $Log: not supported by cvs2svn $
9 * Revision 4.0.1.5  92/06/08  13:13:27  lwall
10 * patch20: g pattern modifer sometimes returned extra values
11 * patch20: m/$pattern/g didn't work
12 * patch20: pattern modifiers i and o didn't interact right
13 * patch20: @ in unpack failed too often
14 * patch20: Perl now distinguishes overlapped copies from non-overlapped
15 * patch20: slice on null list in scalar context returned random value
16 * patch20: splice with negative offset didn't work with $[ = 1
17 * patch20: fixed some memory leaks in splice
18 * patch20: scalar keys %array now counts keys for you
19 *
20 * Revision 4.0.1.4  91/11/11  16:33:19  lwall
21 * patch19: added little-endian pack/unpack options
22 * patch19: sort $subname was busted by changes in 4.018
23 *
24 * Revision 4.0.1.3  91/11/05  17:07:02  lwall
25 * patch11: prepared for ctype implementations that don't define isascii()
26 * patch11: /$foo/o optimizer could access deallocated data
27 * patch11: certain optimizations of //g in array context returned too many values
28 * patch11: regexp with no parens in array context returned wacky $`, $& and $'
29 * patch11: $' not set right on some //g
30 * patch11: added some support for 64-bit integers
31 * patch11: grep of a split lost its values
32 * patch11: added sort {} LIST
33 * patch11: multiple reallocations now avoided in 1 .. 100000
34 *
35 * Revision 4.0.1.2  91/06/10  01:22:15  lwall
36 * patch10: //g only worked first time through
37 *
38 * Revision 4.0.1.1  91/06/07  10:58:28  lwall
39 * patch4: new copyright notice
40 * patch4: added global modifier for pattern matches
41 * patch4: // wouldn't use previous pattern if it started with a null character
42 * patch4: //o and s///o now optimize themselves fully at runtime
43 * patch4: $` was busted inside s///
44 * patch4: caller($arg) didn't work except under debugger
45 *
46 * Revision 4.0  91/03/20  01:08:03  lwall
47 * 4.0 baseline.
48 *
49 */
50
51#include "EXTERN.h"
52#include "perl.h"
53
54static int sortcmp();
55static int sortsub();
56
57#ifdef BUGGY_MSC
58 #pragma function(memcmp)
59#endif /* BUGGY_MSC */
60
61int
62do_match(str,arg,gimme,arglast)
63STR *str;
64register ARG *arg;
65int gimme;
66int *arglast;
67{
68    register STR **st = stack->ary_array;
69    register SPAT *spat = arg[2].arg_ptr.arg_spat;
70    register char *t;
71    register int sp = arglast[0] + 1;
72    STR *srchstr = st[sp];
73    register char *s = str_get(st[sp]);
74    char *strend = s + st[sp]->str_cur;
75    STR *tmpstr;
76    char *myhint = hint;
77    int global;
78    int safebase;
79    char *truebase = s;
80    register REGEXP *rx = spat->spat_regexp;
81
82    hint = Nullch;
83    if (!spat) {
84        if (gimme == G_ARRAY)
85            return --sp;
86        str_set(str,Yes);
87        STABSET(str);
88        st[sp] = str;
89        return sp;
90    }
91    global = spat->spat_flags & SPAT_GLOBAL;
92    safebase = (gimme == G_ARRAY) || global;
93    if (!s)
94        fatal("panic: do_match");
95    if (spat->spat_flags & SPAT_USED) {
96#ifdef DEBUGGING
97        if (debug & 8)
98            deb("2.SPAT USED\n");
99#endif
100        if (gimme == G_ARRAY)
101            return --sp;
102        str_set(str,No);
103        STABSET(str);
104        st[sp] = str;
105        return sp;
106    }
107    --sp;
108    if (spat->spat_runtime) {
109        nointrp = "|)";
110        sp = eval(spat->spat_runtime,G_SCALAR,sp);
111        st = stack->ary_array;
112        t = str_get(tmpstr = st[sp--]);
113        nointrp = "";
114#ifdef DEBUGGING
115        if (debug & 8)
116            deb("2.SPAT /%s/\n",t);
117#endif
118        if (!global && rx)
119            regfree(rx);
120        spat->spat_regexp = Null(REGEXP*);      /* crucial if regcomp aborts */
121        spat->spat_regexp = regcomp(t,t+tmpstr->str_cur,
122            spat->spat_flags & SPAT_FOLD);
123        if (!spat->spat_regexp->prelen && lastspat)
124            spat = lastspat;
125        if (spat->spat_flags & SPAT_KEEP) {
126            if (!(spat->spat_flags & SPAT_FOLD))
127                scanconst(spat,spat->spat_regexp->precomp,
128                    spat->spat_regexp->prelen);
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            hoistmust(spat);
133            if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
134                curcmd->c_flags &= ~CF_OPTIMIZE;
135                opt_arg(curcmd, 1, curcmd->c_type == C_EXPR);
136            }
137        }
138        if (global) {
139            if (rx) {
140                if (rx->startp[0]) {
141                    s = rx->endp[0];
142                    if (s == rx->startp[0])
143                        s++;
144                    if (s > strend) {
145                        regfree(rx);
146                        rx = spat->spat_regexp;
147                        goto nope;
148                    }
149                }
150                regfree(rx);
151            }
152        }
153        else if (!spat->spat_regexp->nparens)
154            gimme = G_SCALAR;                   /* accidental array context? */
155        rx = spat->spat_regexp;
156        if (regexec(rx, s, strend, s, 0,
157          srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
158          safebase)) {
159            if (rx->subbase || global)
160                curspat = spat;
161            lastspat = spat;
162            goto gotcha;
163        }
164        else {
165            if (gimme == G_ARRAY)
166                return sp;
167            str_sset(str,&str_no);
168            STABSET(str);
169            st[++sp] = str;
170            return sp;
171        }
172    }
173    else {
174#ifdef DEBUGGING
175        if (debug & 8) {
176            char ch;
177
178            if (spat->spat_flags & SPAT_ONCE)
179                ch = '?';
180            else
181                ch = '/';
182            deb("2.SPAT %c%s%c\n",ch,rx->precomp,ch);
183        }
184#endif
185        if (!rx->prelen && lastspat) {
186            spat = lastspat;
187            rx = spat->spat_regexp;
188        }
189        t = s;
190    play_it_again:
191        if (global && rx->startp[0]) {
192            t = s = rx->endp[0];
193            if (s == rx->startp[0])
194                s++,t++;
195            if (s > strend)
196                goto nope;
197        }
198        if (myhint) {
199            if (myhint < s || myhint > strend)
200                fatal("panic: hint in do_match");
201            s = myhint;
202            if (rx->regback >= 0) {
203                s -= rx->regback;
204                if (s < t)
205                    s = t;
206            }
207            else
208                s = t;
209        }
210        else if (spat->spat_short) {
211            if (spat->spat_flags & SPAT_SCANFIRST) {
212                if (srchstr->str_pok & SP_STUDIED) {
213                    if (screamfirst[spat->spat_short->str_rare] < 0)
214                        goto nope;
215                    else if (!(s = screaminstr(srchstr,spat->spat_short)))
216                        goto nope;
217                    else if (spat->spat_flags & SPAT_ALL)
218                        goto yup;
219                }
220#ifndef lint
221                else if (!(s = fbminstr((unsigned char*)s,
222                  (unsigned char*)strend, spat->spat_short)))
223                    goto nope;
224#endif
225                else if (spat->spat_flags & SPAT_ALL)
226                    goto yup;
227                if (s && rx->regback >= 0) {
228                    ++spat->spat_short->str_u.str_useful;
229                    s -= rx->regback;
230                    if (s < t)
231                        s = t;
232                }
233                else
234                    s = t;
235            }
236            else if (!multiline && (*spat->spat_short->str_ptr != *s ||
237              bcmp(spat->spat_short->str_ptr, s, spat->spat_slen) ))
238                goto nope;
239            if (--spat->spat_short->str_u.str_useful < 0) {
240                str_free(spat->spat_short);
241                spat->spat_short = Nullstr;     /* opt is being useless */
242            }
243        }
244        if (!rx->nparens && !global) {
245            gimme = G_SCALAR;                   /* accidental array context? */
246            safebase = FALSE;
247        }
248        if (regexec(rx, s, strend, truebase, 0,
249          srchstr->str_pok & SP_STUDIED ? srchstr : Nullstr,
250          safebase)) {
251            if (rx->subbase || global)
252                curspat = spat;
253            lastspat = spat;
254            if (spat->spat_flags & SPAT_ONCE)
255                spat->spat_flags |= SPAT_USED;
256            goto gotcha;
257        }
258        else {
259            if (global)
260                rx->startp[0] = Nullch;
261            if (gimme == G_ARRAY)
262                return sp;
263            str_sset(str,&str_no);
264            STABSET(str);
265            st[++sp] = str;
266            return sp;
267        }
268    }
269    /*NOTREACHED*/
270
271  gotcha:
272    if (gimme == G_ARRAY) {
273        int iters, i, len;
274
275        iters = rx->nparens;
276        if (global && !iters)
277            i = 1;
278        else
279            i = 0;
280        if (sp + iters + i >= stack->ary_max) {
281            astore(stack,sp + iters + i, Nullstr);
282            st = stack->ary_array;              /* possibly realloced */
283        }
284
285        for (i = !i; i <= iters; i++) {
286            st[++sp] = str_mortal(&str_no);
287            /*SUPPRESS 560*/
288            if (s = rx->startp[i]) {
289                len = rx->endp[i] - s;
290                if (len > 0)
291                    str_nset(st[sp],s,len);
292            }
293        }
294        if (global) {
295            truebase = rx->subbeg;
296            goto play_it_again;
297        }
298        return sp;
299    }
300    else {
301        str_sset(str,&str_yes);
302        STABSET(str);
303        st[++sp] = str;
304        return sp;
305    }
306
307yup:
308    ++spat->spat_short->str_u.str_useful;
309    lastspat = spat;
310    if (spat->spat_flags & SPAT_ONCE)
311        spat->spat_flags |= SPAT_USED;
312    if (global) {
313        rx->subbeg = t;
314        rx->subend = strend;
315        rx->startp[0] = s;
316        rx->endp[0] = s + spat->spat_short->str_cur;
317        curspat = spat;
318        goto gotcha;
319    }
320    if (sawampersand) {
321        char *tmps;
322
323        if (rx->subbase)
324            Safefree(rx->subbase);
325        tmps = rx->subbase = nsavestr(t,strend-t);
326        rx->subbeg = tmps;
327        rx->subend = tmps + (strend-t);
328        tmps = rx->startp[0] = tmps + (s - t);
329        rx->endp[0] = tmps + spat->spat_short->str_cur;
330        curspat = spat;
331    }
332    str_sset(str,&str_yes);
333    STABSET(str);
334    st[++sp] = str;
335    return sp;
336
337nope:
338    rx->startp[0] = Nullch;
339    if (spat->spat_short)
340        ++spat->spat_short->str_u.str_useful;
341    if (gimme == G_ARRAY)
342        return sp;
343    str_sset(str,&str_no);
344    STABSET(str);
345    st[++sp] = str;
346    return sp;
347}
348
349#ifdef BUGGY_MSC
350 #pragma intrinsic(memcmp)
351#endif /* BUGGY_MSC */
352
353int
354do_split(str,spat,limit,gimme,arglast)
355STR *str;
356register SPAT *spat;
357register int limit;
358int gimme;
359int *arglast;
360{
361    register ARRAY *ary = stack;
362    STR **st = ary->ary_array;
363    register int sp = arglast[0] + 1;
364    register char *s = str_get(st[sp]);
365    char *strend = s + st[sp--]->str_cur;
366    register STR *dstr;
367    register char *m;
368    int iters = 0;
369    int maxiters = (strend - s) + 10;
370    int i;
371    char *orig;
372    int origlimit = limit;
373    int realarray = 0;
374
375    if (!spat || !s)
376        fatal("panic: do_split");
377    else if (spat->spat_runtime) {
378        nointrp = "|)";
379        sp = eval(spat->spat_runtime,G_SCALAR,sp);
380        st = stack->ary_array;
381        m = str_get(dstr = st[sp--]);
382        nointrp = "";
383        if (*m == ' ' && dstr->str_cur == 1) {
384            str_set(dstr,"\\s+");
385            m = dstr->str_ptr;
386            spat->spat_flags |= SPAT_SKIPWHITE;
387        }
388        if (spat->spat_regexp) {
389            regfree(spat->spat_regexp);
390            spat->spat_regexp = Null(REGEXP*);  /* avoid possible double free */
391        }
392        spat->spat_regexp = regcomp(m,m+dstr->str_cur,
393            spat->spat_flags & SPAT_FOLD);
394        if (spat->spat_flags & SPAT_KEEP ||
395            (spat->spat_runtime->arg_type == O_ITEM &&
396              (spat->spat_runtime[1].arg_type & A_MASK) == A_SINGLE) ) {
397            arg_free(spat->spat_runtime);       /* it won't change, so */
398            spat->spat_runtime = Nullarg;       /* no point compiling again */
399        }
400    }
401#ifdef DEBUGGING
402    if (debug & 8) {
403        deb("2.SPAT /%s/\n",spat->spat_regexp->precomp);
404    }
405#endif
406    ary = stab_xarray(spat->spat_repl[1].arg_ptr.arg_stab);
407    if (ary && (gimme != G_ARRAY || (spat->spat_flags & SPAT_ONCE))) {
408        realarray = 1;
409        if (!(ary->ary_flags & ARF_REAL)) {
410            ary->ary_flags |= ARF_REAL;
411            for (i = ary->ary_fill; i >= 0; i--)
412                ary->ary_array[i] = Nullstr;    /* don't free mere refs */
413        }
414        ary->ary_fill = -1;
415        sp = -1;        /* temporarily switch stacks */
416    }
417    else
418        ary = stack;
419    orig = s;
420    if (spat->spat_flags & SPAT_SKIPWHITE) {
421        while (isSPACE(*s))
422            s++;
423    }
424    if (!limit)
425        limit = maxiters + 2;
426    if (strEQ("\\s+",spat->spat_regexp->precomp)) {
427        while (--limit) {
428            /*SUPPRESS 530*/
429            for (m = s; m < strend && !isSPACE(*m); m++) ;
430            if (m >= strend)
431                break;
432            dstr = Str_new(30,m-s);
433            str_nset(dstr,s,m-s);
434            if (!realarray)
435                str_2mortal(dstr);
436            (void)astore(ary, ++sp, dstr);
437            /*SUPPRESS 530*/
438            for (s = m + 1; s < strend && isSPACE(*s); s++) ;
439        }
440    }
441    else if (strEQ("^",spat->spat_regexp->precomp)) {
442        while (--limit) {
443            /*SUPPRESS 530*/
444            for (m = s; m < strend && *m != '\n'; m++) ;
445            m++;
446            if (m >= strend)
447                break;
448            dstr = Str_new(30,m-s);
449            str_nset(dstr,s,m-s);
450            if (!realarray)
451                str_2mortal(dstr);
452            (void)astore(ary, ++sp, dstr);
453            s = m;
454        }
455    }
456    else if (spat->spat_short) {
457        i = spat->spat_short->str_cur;
458        if (i == 1) {
459            int fold = (spat->spat_flags & SPAT_FOLD);
460
461            i = *spat->spat_short->str_ptr;
462            if (fold && isUPPER(i))
463                i = tolower(i);
464            while (--limit) {
465                if (fold) {
466                    for ( m = s;
467                          m < strend && *m != i &&
468                            (!isUPPER(*m) || tolower(*m) != i);
469                          m++)                  /*SUPPRESS 530*/
470                        ;
471                }
472                else                            /*SUPPRESS 530*/
473                    for (m = s; m < strend && *m != i; m++) ;
474                if (m >= strend)
475                    break;
476                dstr = Str_new(30,m-s);
477                str_nset(dstr,s,m-s);
478                if (!realarray)
479                    str_2mortal(dstr);
480                (void)astore(ary, ++sp, dstr);
481                s = m + 1;
482            }
483        }
484        else {
485#ifndef lint
486            while (s < strend && --limit &&
487              (m=fbminstr((unsigned char*)s, (unsigned char*)strend,
488                    spat->spat_short)) )
489#endif
490            {
491                dstr = Str_new(31,m-s);
492                str_nset(dstr,s,m-s);
493                if (!realarray)
494                    str_2mortal(dstr);
495                (void)astore(ary, ++sp, dstr);
496                s = m + i;
497            }
498        }
499    }
500    else {
501        maxiters += (strend - s) * spat->spat_regexp->nparens;
502        while (s < strend && --limit &&
503            regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, TRUE) ) {
504            if (spat->spat_regexp->subbase
505              && spat->spat_regexp->subbase != orig) {
506                m = s;
507                s = orig;
508                orig = spat->spat_regexp->subbase;
509                s = orig + (m - s);
510                strend = s + (strend - m);
511            }
512            m = spat->spat_regexp->startp[0];
513            dstr = Str_new(32,m-s);
514            str_nset(dstr,s,m-s);
515            if (!realarray)
516                str_2mortal(dstr);
517            (void)astore(ary, ++sp, dstr);
518            if (spat->spat_regexp->nparens) {
519                for (i = 1; i <= spat->spat_regexp->nparens; i++) {
520                    s = spat->spat_regexp->startp[i];
521                    m = spat->spat_regexp->endp[i];
522                    dstr = Str_new(33,m-s);
523                    str_nset(dstr,s,m-s);
524                    if (!realarray)
525                        str_2mortal(dstr);
526                    (void)astore(ary, ++sp, dstr);
527                }
528            }
529            s = spat->spat_regexp->endp[0];
530        }
531    }
532    if (realarray)
533        iters = sp + 1;
534    else
535        iters = sp - arglast[0];
536    if (iters > maxiters)
537        fatal("Split loop");
538    if (s < strend || origlimit) {      /* keep field after final delim? */
539        dstr = Str_new(34,strend-s);
540        str_nset(dstr,s,strend-s);
541        if (!realarray)
542            str_2mortal(dstr);
543        (void)astore(ary, ++sp, dstr);
544        iters++;
545    }
546    else {
547#ifndef I286x
548        while (iters > 0 && ary->ary_array[sp]->str_cur == 0)
549            iters--,sp--;
550#else
551        char *zaps;
552        int   zapb;
553
554        if (iters > 0) {
555                zaps = str_get(afetch(ary,sp,FALSE));
556                zapb = (int) *zaps;
557        }
558       
559        while (iters > 0 && (!zapb)) {
560            iters--,sp--;
561            if (iters > 0) {
562                zaps = str_get(afetch(ary,iters-1,FALSE));
563                zapb = (int) *zaps;
564            }
565        }
566#endif
567    }
568    if (realarray) {
569        ary->ary_fill = sp;
570        if (gimme == G_ARRAY) {
571            sp++;
572            astore(stack, arglast[0] + 1 + sp, Nullstr);
573            Copy(ary->ary_array, stack->ary_array + arglast[0] + 1, sp, STR*);
574            return arglast[0] + sp;
575        }
576    }
577    else {
578        if (gimme == G_ARRAY)
579            return sp;
580    }
581    sp = arglast[0] + 1;
582    str_numset(str,(double)iters);
583    STABSET(str);
584    st[sp] = str;
585    return sp;
586}
587
588int
589do_unpack(str,gimme,arglast)
590STR *str;
591int gimme;
592int *arglast;
593{
594    STR **st = stack->ary_array;
595    register int sp = arglast[0] + 1;
596    register char *pat = str_get(st[sp++]);
597    register char *s = str_get(st[sp]);
598    char *strend = s + st[sp--]->str_cur;
599    char *strbeg = s;
600    register char *patend = pat + st[sp]->str_cur;
601    int datumtype;
602    register int len;
603    register int bits;
604
605    /* These must not be in registers: */
606    short ashort;
607    int aint;
608    long along;
609#ifdef QUAD
610    quad aquad;
611#endif
612    unsigned short aushort;
613    unsigned int auint;
614    unsigned long aulong;
615#ifdef QUAD
616    unsigned quad auquad;
617#endif
618    char *aptr;
619    float afloat;
620    double adouble;
621    int checksum = 0;
622    unsigned long culong;
623    double cdouble;
624
625    if (gimme != G_ARRAY) {             /* arrange to do first one only */
626        /*SUPPRESS 530*/
627        for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
628        if (index("aAbBhH", *patend) || *pat == '%') {
629            patend++;
630            while (isDIGIT(*patend) || *patend == '*')
631                patend++;
632        }
633        else
634            patend++;
635    }
636    sp--;
637    while (pat < patend) {
638      reparse:
639        datumtype = *pat++;
640        if (pat >= patend)
641            len = 1;
642        else if (*pat == '*') {
643            len = strend - strbeg;      /* long enough */
644            pat++;
645        }
646        else if (isDIGIT(*pat)) {
647            len = *pat++ - '0';
648            while (isDIGIT(*pat))
649                len = (len * 10) + (*pat++ - '0');
650        }
651        else
652            len = (datumtype != '@');
653        switch(datumtype) {
654        default:
655            break;
656        case '%':
657            if (len == 1 && pat[-1] != '1')
658                len = 16;
659            checksum = len;
660            culong = 0;
661            cdouble = 0;
662            if (pat < patend)
663                goto reparse;
664            break;
665        case '@':
666            if (len > strend - strbeg)
667                fatal("@ outside of string");
668            s = strbeg + len;
669            break;
670        case 'X':
671            if (len > s - strbeg)
672                fatal("X outside of string");
673            s -= len;
674            break;
675        case 'x':
676            if (len > strend - s)
677                fatal("x outside of string");
678            s += len;
679            break;
680        case 'A':
681        case 'a':
682            if (len > strend - s)
683                len = strend - s;
684            if (checksum)
685                goto uchar_checksum;
686            str = Str_new(35,len);
687            str_nset(str,s,len);
688            s += len;
689            if (datumtype == 'A') {
690                aptr = s;       /* borrow register */
691                s = str->str_ptr + len - 1;
692                while (s >= str->str_ptr && (!*s || isSPACE(*s)))
693                    s--;
694                *++s = '\0';
695                str->str_cur = s - str->str_ptr;
696                s = aptr;       /* unborrow register */
697            }
698            (void)astore(stack, ++sp, str_2mortal(str));
699            break;
700        case 'B':
701        case 'b':
702            if (pat[-1] == '*' || len > (strend - s) * 8)
703                len = (strend - s) * 8;
704            str = Str_new(35, len + 1);
705            str->str_cur = len;
706            str->str_pok = 1;
707            aptr = pat;                 /* borrow register */
708            pat = str->str_ptr;
709            if (datumtype == 'b') {
710                aint = len;
711                for (len = 0; len < aint; len++) {
712                    if (len & 7)                /*SUPPRESS 595*/
713                        bits >>= 1;
714                    else
715                        bits = *s++;
716                    *pat++ = '0' + (bits & 1);
717                }
718            }
719            else {
720                aint = len;
721                for (len = 0; len < aint; len++) {
722                    if (len & 7)
723                        bits <<= 1;
724                    else
725                        bits = *s++;
726                    *pat++ = '0' + ((bits & 128) != 0);
727                }
728            }
729            *pat = '\0';
730            pat = aptr;                 /* unborrow register */
731            (void)astore(stack, ++sp, str_2mortal(str));
732            break;
733        case 'H':
734        case 'h':
735            if (pat[-1] == '*' || len > (strend - s) * 2)
736                len = (strend - s) * 2;
737            str = Str_new(35, len + 1);
738            str->str_cur = len;
739            str->str_pok = 1;
740            aptr = pat;                 /* borrow register */
741            pat = str->str_ptr;
742            if (datumtype == 'h') {
743                aint = len;
744                for (len = 0; len < aint; len++) {
745                    if (len & 1)
746                        bits >>= 4;
747                    else
748                        bits = *s++;
749                    *pat++ = hexdigit[bits & 15];
750                }
751            }
752            else {
753                aint = len;
754                for (len = 0; len < aint; len++) {
755                    if (len & 1)
756                        bits <<= 4;
757                    else
758                        bits = *s++;
759                    *pat++ = hexdigit[(bits >> 4) & 15];
760                }
761            }
762            *pat = '\0';
763            pat = aptr;                 /* unborrow register */
764            (void)astore(stack, ++sp, str_2mortal(str));
765            break;
766        case 'c':
767            if (len > strend - s)
768                len = strend - s;
769            if (checksum) {
770                while (len-- > 0) {
771                    aint = *s++;
772                    if (aint >= 128)    /* fake up signed chars */
773                        aint -= 256;
774                    culong += aint;
775                }
776            }
777            else {
778                while (len-- > 0) {
779                    aint = *s++;
780                    if (aint >= 128)    /* fake up signed chars */
781                        aint -= 256;
782                    str = Str_new(36,0);
783                    str_numset(str,(double)aint);
784                    (void)astore(stack, ++sp, str_2mortal(str));
785                }
786            }
787            break;
788        case 'C':
789            if (len > strend - s)
790                len = strend - s;
791            if (checksum) {
792              uchar_checksum:
793                while (len-- > 0) {
794                    auint = *s++ & 255;
795                    culong += auint;
796                }
797            }
798            else {
799                while (len-- > 0) {
800                    auint = *s++ & 255;
801                    str = Str_new(37,0);
802                    str_numset(str,(double)auint);
803                    (void)astore(stack, ++sp, str_2mortal(str));
804                }
805            }
806            break;
807        case 's':
808            along = (strend - s) / sizeof(short);
809            if (len > along)
810                len = along;
811            if (checksum) {
812                while (len-- > 0) {
813                    Copy(s,&ashort,1,short);
814                    s += sizeof(short);
815                    culong += ashort;
816                }
817            }
818            else {
819                while (len-- > 0) {
820                    Copy(s,&ashort,1,short);
821                    s += sizeof(short);
822                    str = Str_new(38,0);
823                    str_numset(str,(double)ashort);
824                    (void)astore(stack, ++sp, str_2mortal(str));
825                }
826            }
827            break;
828        case 'v':
829        case 'n':
830        case 'S':
831            along = (strend - s) / sizeof(unsigned short);
832            if (len > along)
833                len = along;
834            if (checksum) {
835                while (len-- > 0) {
836                    Copy(s,&aushort,1,unsigned short);
837                    s += sizeof(unsigned short);
838#ifdef HAS_NTOHS
839                    if (datumtype == 'n')
840                        aushort = ntohs(aushort);
841#endif
842#ifdef HAS_VTOHS
843                    if (datumtype == 'v')
844                        aushort = vtohs(aushort);
845#endif
846                    culong += aushort;
847                }
848            }
849            else {
850                while (len-- > 0) {
851                    Copy(s,&aushort,1,unsigned short);
852                    s += sizeof(unsigned short);
853                    str = Str_new(39,0);
854#ifdef HAS_NTOHS
855                    if (datumtype == 'n')
856                        aushort = ntohs(aushort);
857#endif
858#ifdef HAS_VTOHS
859                    if (datumtype == 'v')
860                        aushort = vtohs(aushort);
861#endif
862                    str_numset(str,(double)aushort);
863                    (void)astore(stack, ++sp, str_2mortal(str));
864                }
865            }
866            break;
867        case 'i':
868            along = (strend - s) / sizeof(int);
869            if (len > along)
870                len = along;
871            if (checksum) {
872                while (len-- > 0) {
873                    Copy(s,&aint,1,int);
874                    s += sizeof(int);
875                    if (checksum > 32)
876                        cdouble += (double)aint;
877                    else
878                        culong += aint;
879                }
880            }
881            else {
882                while (len-- > 0) {
883                    Copy(s,&aint,1,int);
884                    s += sizeof(int);
885                    str = Str_new(40,0);
886                    str_numset(str,(double)aint);
887                    (void)astore(stack, ++sp, str_2mortal(str));
888                }
889            }
890            break;
891        case 'I':
892            along = (strend - s) / sizeof(unsigned int);
893            if (len > along)
894                len = along;
895            if (checksum) {
896                while (len-- > 0) {
897                    Copy(s,&auint,1,unsigned int);
898                    s += sizeof(unsigned int);
899                    if (checksum > 32)
900                        cdouble += (double)auint;
901                    else
902                        culong += auint;
903                }
904            }
905            else {
906                while (len-- > 0) {
907                    Copy(s,&auint,1,unsigned int);
908                    s += sizeof(unsigned int);
909                    str = Str_new(41,0);
910                    str_numset(str,(double)auint);
911                    (void)astore(stack, ++sp, str_2mortal(str));
912                }
913            }
914            break;
915        case 'l':
916            along = (strend - s) / sizeof(long);
917            if (len > along)
918                len = along;
919            if (checksum) {
920                while (len-- > 0) {
921                    Copy(s,&along,1,long);
922                    s += sizeof(long);
923                    if (checksum > 32)
924                        cdouble += (double)along;
925                    else
926                        culong += along;
927                }
928            }
929            else {
930                while (len-- > 0) {
931                    Copy(s,&along,1,long);
932                    s += sizeof(long);
933                    str = Str_new(42,0);
934                    str_numset(str,(double)along);
935                    (void)astore(stack, ++sp, str_2mortal(str));
936                }
937            }
938            break;
939        case 'V':
940        case 'N':
941        case 'L':
942            along = (strend - s) / sizeof(unsigned long);
943            if (len > along)
944                len = along;
945            if (checksum) {
946                while (len-- > 0) {
947                    Copy(s,&aulong,1,unsigned long);
948                    s += sizeof(unsigned long);
949#ifdef HAS_NTOHL
950                    if (datumtype == 'N')
951                        aulong = ntohl(aulong);
952#endif
953#ifdef HAS_VTOHL
954                    if (datumtype == 'V')
955                        aulong = vtohl(aulong);
956#endif
957                    if (checksum > 32)
958                        cdouble += (double)aulong;
959                    else
960                        culong += aulong;
961                }
962            }
963            else {
964                while (len-- > 0) {
965                    Copy(s,&aulong,1,unsigned long);
966                    s += sizeof(unsigned long);
967                    str = Str_new(43,0);
968#ifdef HAS_NTOHL
969                    if (datumtype == 'N')
970                        aulong = ntohl(aulong);
971#endif
972#ifdef HAS_VTOHL
973                    if (datumtype == 'V')
974                        aulong = vtohl(aulong);
975#endif
976                    str_numset(str,(double)aulong);
977                    (void)astore(stack, ++sp, str_2mortal(str));
978                }
979            }
980            break;
981        case 'p':
982            along = (strend - s) / sizeof(char*);
983            if (len > along)
984                len = along;
985            while (len-- > 0) {
986                if (sizeof(char*) > strend - s)
987                    break;
988                else {
989                    Copy(s,&aptr,1,char*);
990                    s += sizeof(char*);
991                }
992                str = Str_new(44,0);
993                if (aptr)
994                    str_set(str,aptr);
995                (void)astore(stack, ++sp, str_2mortal(str));
996            }
997            break;
998#ifdef QUAD
999        case 'q':
1000            while (len-- > 0) {
1001                if (s + sizeof(quad) > strend)
1002                    aquad = 0;
1003                else {
1004                    Copy(s,&aquad,1,quad);
1005                    s += sizeof(quad);
1006                }
1007                str = Str_new(42,0);
1008                str_numset(str,(double)aquad);
1009                (void)astore(stack, ++sp, str_2mortal(str));
1010            }
1011            break;
1012        case 'Q':
1013            while (len-- > 0) {
1014                if (s + sizeof(unsigned quad) > strend)
1015                    auquad = 0;
1016                else {
1017                    Copy(s,&auquad,1,unsigned quad);
1018                    s += sizeof(unsigned quad);
1019                }
1020                str = Str_new(43,0);
1021                str_numset(str,(double)auquad);
1022                (void)astore(stack, ++sp, str_2mortal(str));
1023            }
1024            break;
1025#endif
1026        /* float and double added gnb@melba.bby.oz.au 22/11/89 */
1027        case 'f':
1028        case 'F':
1029            along = (strend - s) / sizeof(float);
1030            if (len > along)
1031                len = along;
1032            if (checksum) {
1033                while (len-- > 0) {
1034                    Copy(s, &afloat,1, float);
1035                    s += sizeof(float);
1036                    cdouble += afloat;
1037                }
1038            }
1039            else {
1040                while (len-- > 0) {
1041                    Copy(s, &afloat,1, float);
1042                    s += sizeof(float);
1043                    str = Str_new(47, 0);
1044                    str_numset(str, (double)afloat);
1045                    (void)astore(stack, ++sp, str_2mortal(str));
1046                }
1047            }
1048            break;
1049        case 'd':
1050        case 'D':
1051            along = (strend - s) / sizeof(double);
1052            if (len > along)
1053                len = along;
1054            if (checksum) {
1055                while (len-- > 0) {
1056                    Copy(s, &adouble,1, double);
1057                    s += sizeof(double);
1058                    cdouble += adouble;
1059                }
1060            }
1061            else {
1062                while (len-- > 0) {
1063                    Copy(s, &adouble,1, double);
1064                    s += sizeof(double);
1065                    str = Str_new(48, 0);
1066                    str_numset(str, (double)adouble);
1067                    (void)astore(stack, ++sp, str_2mortal(str));
1068                }
1069            }
1070            break;
1071        case 'u':
1072            along = (strend - s) * 3 / 4;
1073            str = Str_new(42,along);
1074            while (s < strend && *s > ' ' && *s < 'a') {
1075                int a,b,c,d;
1076                char hunk[4];
1077
1078                hunk[3] = '\0';
1079                len = (*s++ - ' ') & 077;
1080                while (len > 0) {
1081                    if (s < strend && *s >= ' ')
1082                        a = (*s++ - ' ') & 077;
1083                    else
1084                        a = 0;
1085                    if (s < strend && *s >= ' ')
1086                        b = (*s++ - ' ') & 077;
1087                    else
1088                        b = 0;
1089                    if (s < strend && *s >= ' ')
1090                        c = (*s++ - ' ') & 077;
1091                    else
1092                        c = 0;
1093                    if (s < strend && *s >= ' ')
1094                        d = (*s++ - ' ') & 077;
1095                    else
1096                        d = 0;
1097                    hunk[0] = a << 2 | b >> 4;
1098                    hunk[1] = b << 4 | c >> 2;
1099                    hunk[2] = c << 6 | d;
1100                    str_ncat(str,hunk, len > 3 ? 3 : len);
1101                    len -= 3;
1102                }
1103                if (*s == '\n')
1104                    s++;
1105                else if (s[1] == '\n')          /* possible checksum byte */
1106                    s += 2;
1107            }
1108            (void)astore(stack, ++sp, str_2mortal(str));
1109            break;
1110        }
1111        if (checksum) {
1112            str = Str_new(42,0);
1113            if (index("fFdD", datumtype) ||
1114              (checksum > 32 && index("iIlLN", datumtype)) ) {
1115                double modf();
1116                double trouble;
1117
1118                adouble = 1.0;
1119                while (checksum >= 16) {
1120                    checksum -= 16;
1121                    adouble *= 65536.0;
1122                }
1123                while (checksum >= 4) {
1124                    checksum -= 4;
1125                    adouble *= 16.0;
1126                }
1127                while (checksum--)
1128                    adouble *= 2.0;
1129                along = (1 << checksum) - 1;
1130                while (cdouble < 0.0)
1131                    cdouble += adouble;
1132                cdouble = modf(cdouble / adouble, &trouble) * adouble;
1133                str_numset(str,cdouble);
1134            }
1135            else {
1136                if (checksum < 32) {
1137                    along = (1 << checksum) - 1;
1138                    culong &= (unsigned long)along;
1139                }
1140                str_numset(str,(double)culong);
1141            }
1142            (void)astore(stack, ++sp, str_2mortal(str));
1143            checksum = 0;
1144        }
1145    }
1146    return sp;
1147}
1148
1149int
1150do_slice(stab,str,numarray,lval,gimme,arglast)
1151STAB *stab;
1152STR *str;
1153int numarray;
1154int lval;
1155int gimme;
1156int *arglast;
1157{
1158    register STR **st = stack->ary_array;
1159    register int sp = arglast[1];
1160    register int max = arglast[2];
1161    register char *tmps;
1162    register int len;
1163    register int magic = 0;
1164    register ARRAY *ary;
1165    register HASH *hash;
1166    int oldarybase = arybase;
1167
1168    if (numarray) {
1169        if (numarray == 2) {            /* a slice of a LIST */
1170            ary = stack;
1171            ary->ary_fill = arglast[3];
1172            arybase -= max + 1;
1173            st[sp] = str;               /* make stack size available */
1174            str_numset(str,(double)(sp - 1));
1175        }
1176        else
1177            ary = stab_array(stab);     /* a slice of an array */
1178    }
1179    else {
1180        if (lval) {
1181            if (stab == envstab)
1182                magic = 'E';
1183            else if (stab == sigstab)
1184                magic = 'S';
1185#ifdef SOME_DBM
1186            else if (stab_hash(stab)->tbl_dbm)
1187                magic = 'D';
1188#endif /* SOME_DBM */
1189        }
1190        hash = stab_hash(stab);         /* a slice of an associative array */
1191    }
1192
1193    if (gimme == G_ARRAY) {
1194        if (numarray) {
1195            while (sp < max) {
1196                if (st[++sp]) {
1197                    st[sp-1] = afetch(ary,
1198                      ((int)str_gnum(st[sp])) - arybase, lval);
1199                }
1200                else
1201                    st[sp-1] = &str_undef;
1202            }
1203        }
1204        else {
1205            while (sp < max) {
1206                if (st[++sp]) {
1207                    tmps = str_get(st[sp]);
1208                    len = st[sp]->str_cur;
1209                    st[sp-1] = hfetch(hash,tmps,len, lval);
1210                    if (magic)
1211                        str_magic(st[sp-1],stab,magic,tmps,len);
1212                }
1213                else
1214                    st[sp-1] = &str_undef;
1215            }
1216        }
1217        sp--;
1218    }
1219    else {
1220        if (sp == max)
1221            st[sp] = &str_undef;
1222        else if (numarray) {
1223            if (st[max])
1224                st[sp] = afetch(ary,
1225                  ((int)str_gnum(st[max])) - arybase, lval);
1226            else
1227                st[sp] = &str_undef;
1228        }
1229        else {
1230            if (st[max]) {
1231                tmps = str_get(st[max]);
1232                len = st[max]->str_cur;
1233                st[sp] = hfetch(hash,tmps,len, lval);
1234                if (magic)
1235                    str_magic(st[sp],stab,magic,tmps,len);
1236            }
1237            else
1238                st[sp] = &str_undef;
1239        }
1240    }
1241    arybase = oldarybase;
1242    return sp;
1243}
1244
1245int
1246do_splice(ary,gimme,arglast)
1247register ARRAY *ary;
1248int gimme;
1249int *arglast;
1250{
1251    register STR **st = stack->ary_array;
1252    register int sp = arglast[1];
1253    int max = arglast[2] + 1;
1254    register STR **src;
1255    register STR **dst;
1256    register int i;
1257    register int offset;
1258    register int length;
1259    int newlen;
1260    int after;
1261    int diff;
1262    STR **tmparyval;
1263
1264    if (++sp < max) {
1265        offset = (int)str_gnum(st[sp]);
1266        if (offset < 0)
1267            offset += ary->ary_fill + 1;
1268        else
1269            offset -= arybase;
1270        if (++sp < max) {
1271            length = (int)str_gnum(st[sp++]);
1272            if (length < 0)
1273                length = 0;
1274        }
1275        else
1276            length = ary->ary_max + 1;          /* close enough to infinity */
1277    }
1278    else {
1279        offset = 0;
1280        length = ary->ary_max + 1;
1281    }
1282    if (offset < 0) {
1283        length += offset;
1284        offset = 0;
1285        if (length < 0)
1286            length = 0;
1287    }
1288    if (offset > ary->ary_fill + 1)
1289        offset = ary->ary_fill + 1;
1290    after = ary->ary_fill + 1 - (offset + length);
1291    if (after < 0) {                            /* not that much array */
1292        length += after;                        /* offset+length now in array */
1293        after = 0;
1294        if (!ary->ary_alloc) {
1295            afill(ary,0);
1296            afill(ary,-1);
1297        }
1298    }
1299
1300    /* At this point, sp .. max-1 is our new LIST */
1301
1302    newlen = max - sp;
1303    diff = newlen - length;
1304
1305    if (diff < 0) {                             /* shrinking the area */
1306        if (newlen) {
1307            New(451, tmparyval, newlen, STR*);  /* so remember insertion */
1308            Copy(st+sp, tmparyval, newlen, STR*);
1309        }
1310
1311        sp = arglast[0] + 1;
1312        if (gimme == G_ARRAY) {                 /* copy return vals to stack */
1313            if (sp + length >= stack->ary_max) {
1314                astore(stack,sp + length, Nullstr);
1315                st = stack->ary_array;
1316            }
1317            Copy(ary->ary_array+offset, st+sp, length, STR*);
1318            if (ary->ary_flags & ARF_REAL) {
1319                for (i = length, dst = st+sp; i; i--)
1320                    str_2mortal(*dst++);        /* free them eventualy */
1321            }
1322            sp += length - 1;
1323        }
1324        else {
1325            st[sp] = ary->ary_array[offset+length-1];
1326            if (ary->ary_flags & ARF_REAL) {
1327                str_2mortal(st[sp]);
1328                for (i = length - 1, dst = &ary->ary_array[offset]; i > 0; i--)
1329                    str_free(*dst++);   /* free them now */
1330            }
1331        }
1332        ary->ary_fill += diff;
1333
1334        /* pull up or down? */
1335
1336        if (offset < after) {                   /* easier to pull up */
1337            if (offset) {                       /* esp. if nothing to pull */
1338                src = &ary->ary_array[offset-1];
1339                dst = src - diff;               /* diff is negative */
1340                for (i = offset; i > 0; i--)    /* can't trust Copy */
1341                    *dst-- = *src--;
1342            }
1343            Zero(ary->ary_array, -diff, STR*);
1344            ary->ary_array -= diff;             /* diff is negative */
1345            ary->ary_max += diff;
1346        }
1347        else {
1348            if (after) {                        /* anything to pull down? */
1349                src = ary->ary_array + offset + length;
1350                dst = src + diff;               /* diff is negative */
1351                Move(src, dst, after, STR*);
1352            }
1353            Zero(&ary->ary_array[ary->ary_fill+1], -diff, STR*);
1354                                                /* avoid later double free */
1355        }
1356        if (newlen) {
1357            for (src = tmparyval, dst = ary->ary_array + offset;
1358              newlen; newlen--) {
1359                *dst = Str_new(46,0);
1360                str_sset(*dst++,*src++);
1361            }
1362            Safefree(tmparyval);
1363        }
1364    }
1365    else {                                      /* no, expanding (or same) */
1366        if (length) {
1367            New(452, tmparyval, length, STR*);  /* so remember deletion */
1368            Copy(ary->ary_array+offset, tmparyval, length, STR*);
1369        }
1370
1371        if (diff > 0) {                         /* expanding */
1372
1373            /* push up or down? */
1374
1375            if (offset < after && diff <= ary->ary_array - ary->ary_alloc) {
1376                if (offset) {
1377                    src = ary->ary_array;
1378                    dst = src - diff;
1379                    Move(src, dst, offset, STR*);
1380                }
1381                ary->ary_array -= diff;         /* diff is positive */
1382                ary->ary_max += diff;
1383                ary->ary_fill += diff;
1384            }
1385            else {
1386                if (ary->ary_fill + diff >= ary->ary_max)       /* oh, well */
1387                    astore(ary, ary->ary_fill + diff, Nullstr);
1388                else
1389                    ary->ary_fill += diff;
1390                dst = ary->ary_array + ary->ary_fill;
1391                for (i = diff; i > 0; i--) {
1392                    if (*dst)                   /* str was hanging around */
1393                        str_free(*dst);         /*  after $#foo */
1394                    dst--;
1395                }
1396                if (after) {
1397                    dst = ary->ary_array + ary->ary_fill;
1398                    src = dst - diff;
1399                    for (i = after; i; i--) {
1400                        *dst-- = *src--;
1401                    }
1402                }
1403            }
1404        }
1405
1406        for (src = st+sp, dst = ary->ary_array + offset; newlen; newlen--) {
1407            *dst = Str_new(46,0);
1408            str_sset(*dst++,*src++);
1409        }
1410        sp = arglast[0] + 1;
1411        if (gimme == G_ARRAY) {                 /* copy return vals to stack */
1412            if (length) {
1413                Copy(tmparyval, st+sp, length, STR*);
1414                if (ary->ary_flags & ARF_REAL) {
1415                    for (i = length, dst = st+sp; i; i--)
1416                        str_2mortal(*dst++);    /* free them eventualy */
1417                }
1418                Safefree(tmparyval);
1419            }
1420            sp += length - 1;
1421        }
1422        else if (length--) {
1423            st[sp] = tmparyval[length];
1424            if (ary->ary_flags & ARF_REAL) {
1425                str_2mortal(st[sp]);
1426                while (length-- > 0)
1427                    str_free(tmparyval[length]);
1428            }
1429            Safefree(tmparyval);
1430        }
1431        else
1432            st[sp] = &str_undef;
1433    }
1434    return sp;
1435}
1436
1437int
1438do_grep(arg,str,gimme,arglast)
1439register ARG *arg;
1440STR *str;
1441int gimme;
1442int *arglast;
1443{
1444    STR **st = stack->ary_array;
1445    register int dst = arglast[1];
1446    register int src = dst + 1;
1447    register int sp = arglast[2];
1448    register int i = sp - arglast[1];
1449    int oldsave = savestack->ary_fill;
1450    SPAT *oldspat = curspat;
1451    int oldtmps_base = tmps_base;
1452
1453    savesptr(&stab_val(defstab));
1454    tmps_base = tmps_max;
1455    if ((arg[1].arg_type & A_MASK) != A_EXPR) {
1456        arg[1].arg_type &= A_MASK;
1457        dehoist(arg,1);
1458        arg[1].arg_type |= A_DONT;
1459    }
1460    arg = arg[1].arg_ptr.arg_arg;
1461    while (i-- > 0) {
1462        if (st[src]) {
1463            st[src]->str_pok &= ~SP_TEMP;
1464            stab_val(defstab) = st[src];
1465        }
1466        else
1467            stab_val(defstab) = str_mortal(&str_undef);
1468        (void)eval(arg,G_SCALAR,sp);
1469        st = stack->ary_array;
1470        if (str_true(st[sp+1]))
1471            st[dst++] = st[src];
1472        src++;
1473        curspat = oldspat;
1474    }
1475    restorelist(oldsave);
1476    tmps_base = oldtmps_base;
1477    if (gimme != G_ARRAY) {
1478        str_numset(str,(double)(dst - arglast[1]));
1479        STABSET(str);
1480        st[arglast[0]+1] = str;
1481        return arglast[0]+1;
1482    }
1483    return arglast[0] + (dst - arglast[1]);
1484}
1485
1486int
1487do_reverse(arglast)
1488int *arglast;
1489{
1490    STR **st = stack->ary_array;
1491    register STR **up = &st[arglast[1]];
1492    register STR **down = &st[arglast[2]];
1493    register int i = arglast[2] - arglast[1];
1494
1495    while (i-- > 0) {
1496        *up++ = *down;
1497        if (i-- > 0)
1498            *down-- = *up;
1499    }
1500    i = arglast[2] - arglast[1];
1501    Move(down+1,up,i/2,STR*);
1502    return arglast[2] - 1;
1503}
1504
1505int
1506do_sreverse(str,arglast)
1507STR *str;
1508int *arglast;
1509{
1510    STR **st = stack->ary_array;
1511    register char *up;
1512    register char *down;
1513    register int tmp;
1514
1515    str_sset(str,st[arglast[2]]);
1516    up = str_get(str);
1517    if (str->str_cur > 1) {
1518        down = str->str_ptr + str->str_cur - 1;
1519        while (down > up) {
1520            tmp = *up;
1521            *up++ = *down;
1522            *down-- = tmp;
1523        }
1524    }
1525    STABSET(str);
1526    st[arglast[0]+1] = str;
1527    return arglast[0]+1;
1528}
1529
1530static CMD *sortcmd;
1531static HASH *sortstash = Null(HASH*);
1532static STAB *firststab = Nullstab;
1533static STAB *secondstab = Nullstab;
1534
1535int
1536do_sort(str,arg,gimme,arglast)
1537STR *str;
1538ARG *arg;
1539int gimme;
1540int *arglast;
1541{
1542    register STR **st = stack->ary_array;
1543    int sp = arglast[1];
1544    register STR **up;
1545    register int max = arglast[2] - sp;
1546    register int i;
1547    int sortcmp();
1548    int sortsub();
1549    STR *oldfirst;
1550    STR *oldsecond;
1551    ARRAY *oldstack;
1552    HASH *stash;
1553    STR *sortsubvar;
1554    static ARRAY *sortstack = Null(ARRAY*);
1555
1556    if (gimme != G_ARRAY) {
1557        str_sset(str,&str_undef);
1558        STABSET(str);
1559        st[sp] = str;
1560        return sp;
1561    }
1562    up = &st[sp];
1563    sortsubvar = *up;
1564    st += sp;           /* temporarily make st point to args */
1565    for (i = 1; i <= max; i++) {
1566        /*SUPPRESS 560*/
1567        if (*up = st[i]) {
1568            if (!(*up)->str_pok)
1569                (void)str_2ptr(*up);
1570            else
1571                (*up)->str_pok &= ~SP_TEMP;
1572            up++;
1573        }
1574    }
1575    st -= sp;
1576    max = up - &st[sp];
1577    sp--;
1578    if (max > 1) {
1579        STAB *stab;
1580
1581        if (arg[1].arg_type == (A_CMD|A_DONT)) {
1582            sortcmd = arg[1].arg_ptr.arg_cmd;
1583            stash = curcmd->c_stash;
1584        }
1585        else {
1586            if ((arg[1].arg_type & A_MASK) == A_WORD)
1587                stab = arg[1].arg_ptr.arg_stab;
1588            else
1589                stab = stabent(str_get(sortsubvar),TRUE);
1590
1591            if (stab) {
1592                if (!stab_sub(stab) || !(sortcmd = stab_sub(stab)->cmd))
1593                    fatal("Undefined subroutine \"%s\" in sort",
1594                        stab_ename(stab));
1595                stash = stab_estash(stab);
1596            }
1597            else
1598                sortcmd = Nullcmd;
1599        }
1600
1601        if (sortcmd) {
1602            int oldtmps_base = tmps_base;
1603
1604            if (!sortstack) {
1605                sortstack = anew(Nullstab);
1606                astore(sortstack, 0, Nullstr);
1607                aclear(sortstack);
1608                sortstack->ary_flags = 0;
1609            }
1610            oldstack = stack;
1611            stack = sortstack;
1612            tmps_base = tmps_max;
1613            if (sortstash != stash) {
1614                firststab = stabent("a",TRUE);
1615                secondstab = stabent("b",TRUE);
1616                sortstash = stash;
1617            }
1618            oldfirst = stab_val(firststab);
1619            oldsecond = stab_val(secondstab);
1620#ifndef lint
1621            qsort((char*)(st+sp+1),max,sizeof(STR*),sortsub);
1622#else
1623            qsort(Nullch,max,sizeof(STR*),sortsub);
1624#endif
1625            stab_val(firststab) = oldfirst;
1626            stab_val(secondstab) = oldsecond;
1627            tmps_base = oldtmps_base;
1628            stack = oldstack;
1629        }
1630#ifndef lint
1631        else
1632            qsort((char*)(st+sp+1),max,sizeof(STR*),sortcmp);
1633#endif
1634    }
1635    return sp+max;
1636}
1637
1638static int
1639sortsub(str1,str2)
1640STR **str1;
1641STR **str2;
1642{
1643    stab_val(firststab) = *str1;
1644    stab_val(secondstab) = *str2;
1645    cmd_exec(sortcmd,G_SCALAR,-1);
1646    return (int)str_gnum(*stack->ary_array);
1647}
1648
1649static int
1650sortcmp(strp1,strp2)
1651STR **strp1;
1652STR **strp2;
1653{
1654    register STR *str1 = *strp1;
1655    register STR *str2 = *strp2;
1656    int retval;
1657
1658    if (str1->str_cur < str2->str_cur) {
1659        /*SUPPRESS 560*/
1660        if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
1661            return retval;
1662        else
1663            return -1;
1664    }
1665    /*SUPPRESS 560*/
1666    else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
1667        return retval;
1668    else if (str1->str_cur == str2->str_cur)
1669        return 0;
1670    else
1671        return 1;
1672}
1673
1674int
1675do_range(gimme,arglast)
1676int gimme;
1677int *arglast;
1678{
1679    STR **st = stack->ary_array;
1680    register int sp = arglast[0];
1681    register int i;
1682    register ARRAY *ary = stack;
1683    register STR *str;
1684    int max;
1685
1686    if (gimme != G_ARRAY)
1687        fatal("panic: do_range");
1688
1689    if (st[sp+1]->str_nok || !st[sp+1]->str_pok ||
1690      (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
1691        i = (int)str_gnum(st[sp+1]);
1692        max = (int)str_gnum(st[sp+2]);
1693        if (max > i)
1694            (void)astore(ary, sp + max - i + 1, Nullstr);
1695        while (i <= max) {
1696            (void)astore(ary, ++sp, str = str_mortal(&str_no));
1697            str_numset(str,(double)i++);
1698        }
1699    }
1700    else {
1701        STR *final = str_mortal(st[sp+2]);
1702        char *tmps = str_get(final);
1703
1704        str = str_mortal(st[sp+1]);
1705        while (!str->str_nok && str->str_cur <= final->str_cur &&
1706            strNE(str->str_ptr,tmps) ) {
1707            (void)astore(ary, ++sp, str);
1708            str = str_2mortal(str_smake(str));
1709            str_inc(str);
1710        }
1711        if (strEQ(str->str_ptr,tmps))
1712            (void)astore(ary, ++sp, str);
1713    }
1714    return sp;
1715}
1716
1717int
1718do_repeatary(arglast)
1719int *arglast;
1720{
1721    STR **st = stack->ary_array;
1722    register int sp = arglast[0];
1723    register int items = arglast[1] - sp;
1724    register int count = (int) str_gnum(st[arglast[2]]);
1725    register int i;
1726    int max;
1727
1728    max = items * count;
1729    if (max > 0 && sp + max > stack->ary_max) {
1730        astore(stack, sp + max, Nullstr);
1731        st = stack->ary_array;
1732    }
1733    if (count > 1) {
1734        for (i = arglast[1]; i > sp; i--)
1735            st[i]->str_pok &= ~SP_TEMP;
1736        repeatcpy((char*)&st[arglast[1]+1], (char*)&st[sp+1],
1737            items * sizeof(STR*), count);
1738    }
1739    sp += max;
1740
1741    return sp;
1742}
1743
1744int
1745do_caller(arg,maxarg,gimme,arglast)
1746ARG *arg;
1747int maxarg;
1748int gimme;
1749int *arglast;
1750{
1751    STR **st = stack->ary_array;
1752    register int sp = arglast[0];
1753    register CSV *csv = curcsv;
1754    STR *str;
1755    int count = 0;
1756
1757    if (!csv)
1758        fatal("There is no caller");
1759    if (maxarg)
1760        count = (int) str_gnum(st[sp+1]);
1761    for (;;) {
1762        if (!csv)
1763            return sp;
1764        if (DBsub && csv->curcsv && csv->curcsv->sub == stab_sub(DBsub))
1765            count++;
1766        if (!count--)
1767            break;
1768        csv = csv->curcsv;
1769    }
1770    if (gimme != G_ARRAY) {
1771        STR *str = arg->arg_ptr.arg_str;
1772        str_set(str,csv->curcmd->c_stash->tbl_name);
1773        STABSET(str);
1774        st[++sp] = str;
1775        return sp;
1776    }
1777
1778#ifndef lint
1779    (void)astore(stack,++sp,
1780      str_2mortal(str_make(csv->curcmd->c_stash->tbl_name,0)) );
1781    (void)astore(stack,++sp,
1782      str_2mortal(str_make(stab_val(csv->curcmd->c_filestab)->str_ptr,0)) );
1783    (void)astore(stack,++sp,
1784      str_2mortal(str_nmake((double)csv->curcmd->c_line)) );
1785    if (!maxarg)
1786        return sp;
1787    str = Str_new(49,0);
1788    stab_efullname(str, csv->stab);
1789    (void)astore(stack,++sp, str_2mortal(str));
1790    (void)astore(stack,++sp,
1791      str_2mortal(str_nmake((double)csv->hasargs)) );
1792    (void)astore(stack,++sp,
1793      str_2mortal(str_nmake((double)csv->wantarray)) );
1794    if (csv->hasargs) {
1795        ARRAY *ary = csv->argarray;
1796
1797        if (!dbargs)
1798            dbargs = stab_xarray(aadd(stabent("DB'args", TRUE)));
1799        if (dbargs->ary_max < ary->ary_fill)
1800            astore(dbargs,ary->ary_fill,Nullstr);
1801        Copy(ary->ary_array, dbargs->ary_array, ary->ary_fill+1, STR*);
1802        dbargs->ary_fill = ary->ary_fill;
1803    }
1804#else
1805    (void)astore(stack,++sp,
1806      str_2mortal(str_make("",0)));
1807#endif
1808    return sp;
1809}
1810
1811int
1812do_tms(str,gimme,arglast)
1813STR *str;
1814int gimme;
1815int *arglast;
1816{
1817#ifdef MSDOS
1818    return -1;
1819#else
1820    STR **st = stack->ary_array;
1821    register int sp = arglast[0];
1822
1823    if (gimme != G_ARRAY) {
1824        str_sset(str,&str_undef);
1825        STABSET(str);
1826        st[++sp] = str;
1827        return sp;
1828    }
1829    (void)times(&timesbuf);
1830
1831#ifndef HZ
1832#define HZ 60
1833#endif
1834
1835#ifndef lint
1836    (void)astore(stack,++sp,
1837      str_2mortal(str_nmake(((double)timesbuf.tms_utime)/HZ)));
1838    (void)astore(stack,++sp,
1839      str_2mortal(str_nmake(((double)timesbuf.tms_stime)/HZ)));
1840    (void)astore(stack,++sp,
1841      str_2mortal(str_nmake(((double)timesbuf.tms_cutime)/HZ)));
1842    (void)astore(stack,++sp,
1843      str_2mortal(str_nmake(((double)timesbuf.tms_cstime)/HZ)));
1844#else
1845    (void)astore(stack,++sp,
1846      str_2mortal(str_nmake(0.0)));
1847#endif
1848    return sp;
1849#endif
1850}
1851
1852int
1853do_time(str,tmbuf,gimme,arglast)
1854STR *str;
1855struct tm *tmbuf;
1856int gimme;
1857int *arglast;
1858{
1859    register ARRAY *ary = stack;
1860    STR **st = ary->ary_array;
1861    register int sp = arglast[0];
1862
1863    if (!tmbuf || gimme != G_ARRAY) {
1864        str_sset(str,&str_undef);
1865        STABSET(str);
1866        st[++sp] = str;
1867        return sp;
1868    }
1869    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_sec)));
1870    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_min)));
1871    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_hour)));
1872    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mday)));
1873    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_mon)));
1874    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_year)));
1875    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_wday)));
1876    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_yday)));
1877    (void)astore(ary,++sp,str_2mortal(str_nmake((double)tmbuf->tm_isdst)));
1878    return sp;
1879}
1880
1881int
1882do_kv(str,hash,kv,gimme,arglast)
1883STR *str;
1884HASH *hash;
1885int kv;
1886int gimme;
1887int *arglast;
1888{
1889    register ARRAY *ary = stack;
1890    STR **st = ary->ary_array;
1891    register int sp = arglast[0];
1892    int i;
1893    register HENT *entry;
1894    char *tmps;
1895    STR *tmpstr;
1896    int dokeys = (kv == O_KEYS || kv == O_HASH);
1897    int dovalues = (kv == O_VALUES || kv == O_HASH);
1898
1899    if (gimme != G_ARRAY) {
1900        i = 0;
1901        (void)hiterinit(hash);
1902        /*SUPPRESS 560*/
1903        while (entry = hiternext(hash)) {
1904            i++;
1905        }
1906        str_numset(str,(double)i);
1907        STABSET(str);
1908        st[++sp] = str;
1909        return sp;
1910    }
1911    (void)hiterinit(hash);
1912    /*SUPPRESS 560*/
1913    while (entry = hiternext(hash)) {
1914        if (dokeys) {
1915            tmps = hiterkey(entry,&i);
1916            if (!i)
1917                tmps = "";
1918            (void)astore(ary,++sp,str_2mortal(str_make(tmps,i)));
1919        }
1920        if (dovalues) {
1921            tmpstr = Str_new(45,0);
1922#ifdef DEBUGGING
1923            if (debug & 8192) {
1924                sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
1925                    hash->tbl_max+1,entry->hent_hash & hash->tbl_max);
1926                str_set(tmpstr,buf);
1927            }
1928            else
1929#endif
1930            str_sset(tmpstr,hiterval(hash,entry));
1931            (void)astore(ary,++sp,str_2mortal(tmpstr));
1932        }
1933    }
1934    return sp;
1935}
1936
1937int
1938do_each(str,hash,gimme,arglast)
1939STR *str;
1940HASH *hash;
1941int gimme;
1942int *arglast;
1943{
1944    STR **st = stack->ary_array;
1945    register int sp = arglast[0];
1946    static STR *mystrk = Nullstr;
1947    HENT *entry = hiternext(hash);
1948    int i;
1949    char *tmps;
1950
1951    if (mystrk) {
1952        str_free(mystrk);
1953        mystrk = Nullstr;
1954    }
1955
1956    if (entry) {
1957        if (gimme == G_ARRAY) {
1958            tmps = hiterkey(entry, &i);
1959            if (!i)
1960                tmps = "";
1961            st[++sp] = mystrk = str_make(tmps,i);
1962        }
1963        st[++sp] = str;
1964        str_sset(str,hiterval(hash,entry));
1965        STABSET(str);
1966        return sp;
1967    }
1968    else
1969        return sp;
1970}
Note: See TracBrowser for help on using the repository browser.