This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 3.0 patch #18 patch #16, continued
[perl5.git] / str.c
1 /* $Header: str.c,v 3.0.1.7 90/03/27 16:24:11 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:        str.c,v $
9  * Revision 3.0.1.7  90/03/27  16:24:11  lwall
10  * patch16: strings with prefix chopped off sometimes freed wrong
11  * patch16: taint check blows up on undefined array element
12  * 
13  * Revision 3.0.1.6  90/03/12  17:02:14  lwall
14  * patch13: substr as lvalue didn't invalidate old numeric value
15  * 
16  * Revision 3.0.1.5  90/02/28  18:30:38  lwall
17  * patch9: you may now undef $/ to have no input record separator
18  * patch9: nested evals clobbered their longjmp environment
19  * patch9: sometimes perl thought ordinary data was a symbol table entry
20  * patch9: insufficient space allocated for numeric string on sun4
21  * patch9: underscore in an array name in a double-quoted string not recognized
22  * patch9: "@foo{}" not recognized unless %foo defined
23  * patch9: "$foo[$[]" gives error
24  * 
25  * Revision 3.0.1.4  89/12/21  20:21:35  lwall
26  * patch7: errno may now be a macro with an lvalue
27  * patch7: made nested or recursive foreach work right
28  * 
29  * Revision 3.0.1.3  89/11/17  15:38:23  lwall
30  * patch5: some machines typedef unchar too
31  * patch5: substitution on leading components occasionally caused <> corruption
32  * 
33  * Revision 3.0.1.2  89/11/11  04:56:22  lwall
34  * patch2: uchar gives Crays fits
35  * 
36  * Revision 3.0.1.1  89/10/26  23:23:41  lwall
37  * patch1: string ordering tests were wrong
38  * patch1: $/ now works even when STDSTDIO undefined
39  * 
40  * Revision 3.0  89/10/18  15:23:38  lwall
41  * 3.0 baseline
42  * 
43  */
44
45 #include "EXTERN.h"
46 #include "perl.h"
47 #include "perly.h"
48
49 extern char **environ;
50
51 #ifndef str_get
52 char *
53 str_get(str)
54 STR *str;
55 {
56 #ifdef TAINT
57     tainted |= str->str_tainted;
58 #endif
59     return str->str_pok ? str->str_ptr : str_2ptr(str);
60 }
61 #endif
62
63 /* dlb ... guess we have a "crippled cc".
64  * dlb the following functions are usually macros.
65  */
66 #ifndef str_true
67 str_true(Str)
68 STR *Str;
69 {
70         if (Str->str_pok) {
71             if (*Str->str_ptr > '0' ||
72               Str->str_cur > 1 ||
73               (Str->str_cur && *Str->str_ptr != '0'))
74                 return 1;
75             return 0;
76         }
77         if (Str->str_nok)
78                 return (Str->str_u.str_nval != 0.0);
79         return 0;
80 }
81 #endif /* str_true */
82
83 #ifndef str_gnum
84 double str_gnum(Str)
85 STR *Str;
86 {
87 #ifdef TAINT
88         tainted |= Str->str_tainted;
89 #endif /* TAINT*/
90         if (Str->str_nok)
91                 return Str->str_u.str_nval;
92         return str_2num(Str);
93 }
94 #endif /* str_gnum */
95 /* dlb ... end of crutch */
96
97 char *
98 str_grow(str,newlen)
99 register STR *str;
100 register int newlen;
101 {
102     register char *s = str->str_ptr;
103
104     if (str->str_state == SS_INCR) {            /* data before str_ptr? */
105         str->str_len += str->str_u.str_useful;
106         str->str_ptr -= str->str_u.str_useful;
107         str->str_u.str_useful = 0L;
108         bcopy(s, str->str_ptr, str->str_cur+1);
109         s = str->str_ptr;
110         str->str_state = SS_NORM;                       /* normal again */
111         if (newlen > str->str_len)
112             newlen += 10 * (newlen - str->str_cur); /* avoid copy each time */
113     }
114     if (newlen > str->str_len) {                /* need more room? */
115         if (str->str_len)
116             Renew(s,newlen,char);
117         else
118             New(703,s,newlen,char);
119         str->str_ptr = s;
120         str->str_len = newlen;
121     }
122     return s;
123 }
124
125 str_numset(str,num)
126 register STR *str;
127 double num;
128 {
129     if (str->str_pok) {
130         str->str_pok = 0;       /* invalidate pointer */
131         if (str->str_state == SS_INCR)
132             str_grow(str,0);
133     }
134     str->str_u.str_nval = num;
135     str->str_state = SS_NORM;
136     str->str_nok = 1;                   /* validate number */
137 #ifdef TAINT
138     str->str_tainted = tainted;
139 #endif
140 }
141
142 char *
143 str_2ptr(str)
144 register STR *str;
145 {
146     register char *s;
147     int olderrno;
148
149     if (!str)
150         return "";
151     if (str->str_nok) {
152 /* this is a problem on the sun 4... 24 bytes is not always enough and the
153         exponent blows away the malloc stack
154         PEJ Wed Jan 31 18:41:34 CST 1990
155 */
156 #ifdef sun4
157         STR_GROW(str, 30);
158 #else
159         STR_GROW(str, 24);
160 #endif /* sun 4 */
161         s = str->str_ptr;
162         olderrno = errno;       /* some Xenix systems wipe out errno here */
163 #if defined(scs) && defined(ns32000)
164         gcvt(str->str_u.str_nval,20,s);
165 #else
166 #ifdef apollo
167         if (str->str_u.str_nval == 0.0)
168             (void)strcpy(s,"0");
169         else
170 #endif /*apollo*/
171         (void)sprintf(s,"%.20g",str->str_u.str_nval);
172 #endif /*scs*/
173         errno = olderrno;
174         while (*s) s++;
175 #ifdef hcx
176         if (s[-1] == '.')
177             s--;
178 #endif
179     }
180     else {
181         if (str == &str_undef)
182             return No;
183         if (dowarn)
184             warn("Use of uninitialized variable");
185 #ifdef sun4
186         STR_GROW(str, 30);
187 #else
188         STR_GROW(str, 24);
189 #endif
190         s = str->str_ptr;
191     }
192     *s = '\0';
193     str->str_cur = s - str->str_ptr;
194     str->str_pok = 1;
195 #ifdef DEBUGGING
196     if (debug & 32)
197         fprintf(stderr,"0x%lx ptr(%s)\n",str,str->str_ptr);
198 #endif
199     return str->str_ptr;
200 }
201
202 double
203 str_2num(str)
204 register STR *str;
205 {
206     if (!str)
207         return 0.0;
208     if (str->str_state == SS_INCR)
209         str_grow(str,0);       /* just force copy down */
210     str->str_state = SS_NORM;
211     if (str->str_len && str->str_pok)
212         str->str_u.str_nval = atof(str->str_ptr);
213     else  {
214         if (str == &str_undef)
215             return 0.0;
216         if (dowarn)
217             warn("Use of uninitialized variable");
218         str->str_u.str_nval = 0.0;
219     }
220     str->str_nok = 1;
221 #ifdef DEBUGGING
222     if (debug & 32)
223         fprintf(stderr,"0x%lx num(%g)\n",str,str->str_u.str_nval);
224 #endif
225     return str->str_u.str_nval;
226 }
227
228 str_sset(dstr,sstr)
229 STR *dstr;
230 register STR *sstr;
231 {
232 #ifdef TAINT
233     if (sstr)
234         tainted |= sstr->str_tainted;
235 #endif
236     if (sstr == dstr)
237         return;
238     if (!sstr)
239         dstr->str_pok = dstr->str_nok = 0;
240     else if (sstr->str_pok) {
241         str_nset(dstr,sstr->str_ptr,sstr->str_cur);
242         if (sstr->str_nok) {
243             dstr->str_u.str_nval = sstr->str_u.str_nval;
244             dstr->str_nok = 1;
245             dstr->str_state = SS_NORM;
246         }
247         else if (sstr->str_cur == sizeof(STBP)) {
248             char *tmps = sstr->str_ptr;
249
250             if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
251                 dstr->str_magic = str_smake(sstr->str_magic);
252                 dstr->str_magic->str_rare = 'X';
253             }
254         }
255     }
256     else if (sstr->str_nok)
257         str_numset(dstr,sstr->str_u.str_nval);
258     else {
259         if (dstr->str_state == SS_INCR)
260             str_grow(dstr,0);       /* just force copy down */
261
262 #ifdef STRUCTCOPY
263         dstr->str_u = sstr->str_u;
264 #else
265         dstr->str_u.str_nval = sstr->str_u.str_nval;
266 #endif
267         dstr->str_pok = dstr->str_nok = 0;
268     }
269 }
270
271 str_nset(str,ptr,len)
272 register STR *str;
273 register char *ptr;
274 register int len;
275 {
276     STR_GROW(str, len + 1);
277     if (ptr)
278         (void)bcopy(ptr,str->str_ptr,len);
279     str->str_cur = len;
280     *(str->str_ptr+str->str_cur) = '\0';
281     str->str_nok = 0;           /* invalidate number */
282     str->str_pok = 1;           /* validate pointer */
283 #ifdef TAINT
284     str->str_tainted = tainted;
285 #endif
286 }
287
288 str_set(str,ptr)
289 register STR *str;
290 register char *ptr;
291 {
292     register int len;
293
294     if (!ptr)
295         ptr = "";
296     len = strlen(ptr);
297     STR_GROW(str, len + 1);
298     (void)bcopy(ptr,str->str_ptr,len+1);
299     str->str_cur = len;
300     str->str_nok = 0;           /* invalidate number */
301     str->str_pok = 1;           /* validate pointer */
302 #ifdef TAINT
303     str->str_tainted = tainted;
304 #endif
305 }
306
307 str_chop(str,ptr)       /* like set but assuming ptr is in str */
308 register STR *str;
309 register char *ptr;
310 {
311     register int delta;
312
313     if (!(str->str_pok))
314         fatal("str_chop: internal inconsistency");
315     delta = ptr - str->str_ptr;
316     str->str_len -= delta;
317     str->str_cur -= delta;
318     str->str_ptr += delta;
319     if (str->str_state == SS_INCR)
320         str->str_u.str_useful += delta;
321     else {
322         str->str_u.str_useful = delta;
323         str->str_state = SS_INCR;
324     }
325     str->str_nok = 0;           /* invalidate number */
326     str->str_pok = 1;           /* validate pointer (and unstudy str) */
327 }
328
329 str_ncat(str,ptr,len)
330 register STR *str;
331 register char *ptr;
332 register int len;
333 {
334     if (!(str->str_pok))
335         (void)str_2ptr(str);
336     STR_GROW(str, str->str_cur + len + 1);
337     (void)bcopy(ptr,str->str_ptr+str->str_cur,len);
338     str->str_cur += len;
339     *(str->str_ptr+str->str_cur) = '\0';
340     str->str_nok = 0;           /* invalidate number */
341     str->str_pok = 1;           /* validate pointer */
342 #ifdef TAINT
343     str->str_tainted |= tainted;
344 #endif
345 }
346
347 str_scat(dstr,sstr)
348 STR *dstr;
349 register STR *sstr;
350 {
351 #ifdef TAINT
352     tainted |= sstr->str_tainted;
353 #endif
354     if (!sstr)
355         return;
356     if (!(sstr->str_pok))
357         (void)str_2ptr(sstr);
358     if (sstr)
359         str_ncat(dstr,sstr->str_ptr,sstr->str_cur);
360 }
361
362 str_cat(str,ptr)
363 register STR *str;
364 register char *ptr;
365 {
366     register int len;
367
368     if (!ptr)
369         return;
370     if (!(str->str_pok))
371         (void)str_2ptr(str);
372     len = strlen(ptr);
373     STR_GROW(str, str->str_cur + len + 1);
374     (void)bcopy(ptr,str->str_ptr+str->str_cur,len+1);
375     str->str_cur += len;
376     str->str_nok = 0;           /* invalidate number */
377     str->str_pok = 1;           /* validate pointer */
378 #ifdef TAINT
379     str->str_tainted |= tainted;
380 #endif
381 }
382
383 char *
384 str_append_till(str,from,fromend,delim,keeplist)
385 register STR *str;
386 register char *from;
387 register char *fromend;
388 register int delim;
389 char *keeplist;
390 {
391     register char *to;
392     register int len;
393
394     if (!from)
395         return Nullch;
396     len = fromend - from;
397     STR_GROW(str, str->str_cur + len + 1);
398     str->str_nok = 0;           /* invalidate number */
399     str->str_pok = 1;           /* validate pointer */
400     to = str->str_ptr+str->str_cur;
401     for (; from < fromend; from++,to++) {
402         if (*from == '\\' && from+1 < fromend && delim != '\\') {
403             if (!keeplist) {
404                 if (from[1] == delim || from[1] == '\\')
405                     from++;
406                 else
407                     *to++ = *from++;
408             }
409             else if (from[1] && index(keeplist,from[1]))
410                 *to++ = *from++;
411             else
412                 from++;
413         }
414         else if (*from == delim)
415             break;
416         *to = *from;
417     }
418     *to = '\0';
419     str->str_cur = to - str->str_ptr;
420     return from;
421 }
422
423 STR *
424 #ifdef LEAKTEST
425 str_new(x,len)
426 int x;
427 #else
428 str_new(len)
429 #endif
430 int len;
431 {
432     register STR *str;
433     
434     if (freestrroot) {
435         str = freestrroot;
436         freestrroot = str->str_magic;
437         str->str_magic = Nullstr;
438         str->str_state = SS_NORM;
439     }
440     else {
441         Newz(700+x,str,1,STR);
442     }
443     if (len)
444         STR_GROW(str, len + 1);
445     return str;
446 }
447
448 void
449 str_magic(str, stab, how, name, namlen)
450 register STR *str;
451 STAB *stab;
452 int how;
453 char *name;
454 int namlen;
455 {
456     if (str->str_magic)
457         return;
458     str->str_magic = Str_new(75,namlen);
459     str = str->str_magic;
460     str->str_u.str_stab = stab;
461     str->str_rare = how;
462     if (name)
463         str_nset(str,name,namlen);
464 }
465
466 void
467 str_insert(bigstr,offset,len,little,littlelen)
468 STR *bigstr;
469 int offset;
470 int len;
471 char *little;
472 int littlelen;
473 {
474     register char *big;
475     register char *mid;
476     register char *midend;
477     register char *bigend;
478     register int i;
479
480     bigstr->str_nok = 0;
481     bigstr->str_pok = SP_VALID; /* disable possible screamer */
482
483     i = littlelen - len;
484     if (i > 0) {                        /* string might grow */
485         STR_GROW(bigstr, bigstr->str_cur + i + 1);
486         big = bigstr->str_ptr;
487         mid = big + offset + len;
488         midend = bigend = big + bigstr->str_cur;
489         bigend += i;
490         *bigend = '\0';
491         while (midend > mid)            /* shove everything down */
492             *--bigend = *--midend;
493         (void)bcopy(little,big+offset,littlelen);
494         bigstr->str_cur += i;
495         return;
496     }
497     else if (i == 0) {
498         (void)bcopy(little,bigstr->str_ptr+offset,len);
499         return;
500     }
501
502     big = bigstr->str_ptr;
503     mid = big + offset;
504     midend = mid + len;
505     bigend = big + bigstr->str_cur;
506
507     if (midend > bigend)
508         fatal("panic: str_insert");
509
510     if (mid - big > bigend - midend) {  /* faster to shorten from end */
511         if (littlelen) {
512             (void)bcopy(little, mid, littlelen);
513             mid += littlelen;
514         }
515         i = bigend - midend;
516         if (i > 0) {
517             (void)bcopy(midend, mid, i);
518             mid += i;
519         }
520         *mid = '\0';
521         bigstr->str_cur = mid - big;
522     }
523     else if (i = mid - big) {   /* faster from front */
524         midend -= littlelen;
525         mid = midend;
526         str_chop(bigstr,midend-i);
527         big += i;
528         while (i--)
529             *--midend = *--big;
530         if (littlelen)
531             (void)bcopy(little, mid, littlelen);
532     }
533     else if (littlelen) {
534         midend -= littlelen;
535         str_chop(bigstr,midend);
536         (void)bcopy(little,midend,littlelen);
537     }
538     else {
539         str_chop(bigstr,midend);
540     }
541     STABSET(bigstr);
542 }
543
544 /* make str point to what nstr did */
545
546 void
547 str_replace(str,nstr)
548 register STR *str;
549 register STR *nstr;
550 {
551     if (str->str_state == SS_INCR)
552         str_grow(str,0);        /* just force copy down */
553     if (nstr->str_state == SS_INCR)
554         str_grow(nstr,0);
555     if (str->str_ptr)
556         Safefree(str->str_ptr);
557     str->str_ptr = nstr->str_ptr;
558     str->str_len = nstr->str_len;
559     str->str_cur = nstr->str_cur;
560     str->str_pok = nstr->str_pok;
561     str->str_nok = nstr->str_nok;
562 #ifdef STRUCTCOPY
563     str->str_u = nstr->str_u;
564 #else
565     str->str_u.str_nval = nstr->str_u.str_nval;
566 #endif
567 #ifdef TAINT
568     str->str_tainted = nstr->str_tainted;
569 #endif
570     Safefree(nstr);
571 }
572
573 void
574 str_free(str)
575 register STR *str;
576 {
577     if (!str)
578         return;
579     if (str->str_state) {
580         if (str->str_state == SS_FREE)  /* already freed */
581             return;
582         if (str->str_state == SS_INCR && !(str->str_pok & 2)) {
583             str->str_ptr -= str->str_u.str_useful;
584             str->str_len += str->str_u.str_useful;
585         }
586     }
587     if (str->str_magic)
588         str_free(str->str_magic);
589 #ifdef LEAKTEST
590     if (str->str_len)
591         Safefree(str->str_ptr);
592     if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
593         arg_free(str->str_u.str_args);
594     Safefree(str);
595 #else /* LEAKTEST */
596     if (str->str_len) {
597         if (str->str_len > 127) {       /* next user not likely to want more */
598             Safefree(str->str_ptr);     /* so give it back to malloc */
599             str->str_ptr = Nullch;
600             str->str_len = 0;
601         }
602         else
603             str->str_ptr[0] = '\0';
604     }
605     if ((str->str_pok & SP_INTRP) && str->str_u.str_args)
606         arg_free(str->str_u.str_args);
607     str->str_cur = 0;
608     str->str_nok = 0;
609     str->str_pok = 0;
610     str->str_state = SS_FREE;
611 #ifdef TAINT
612     str->str_tainted = 0;
613 #endif
614     str->str_magic = freestrroot;
615     freestrroot = str;
616 #endif /* LEAKTEST */
617 }
618
619 str_len(str)
620 register STR *str;
621 {
622     if (!str)
623         return 0;
624     if (!(str->str_pok))
625         (void)str_2ptr(str);
626     if (str->str_ptr)
627         return str->str_cur;
628     else
629         return 0;
630 }
631
632 str_eq(str1,str2)
633 register STR *str1;
634 register STR *str2;
635 {
636     if (!str1)
637         return str2 == Nullstr;
638     if (!str2)
639         return 0;
640
641     if (!str1->str_pok)
642         (void)str_2ptr(str1);
643     if (!str2->str_pok)
644         (void)str_2ptr(str2);
645
646     if (str1->str_cur != str2->str_cur)
647         return 0;
648
649     return !bcmp(str1->str_ptr, str2->str_ptr, str1->str_cur);
650 }
651
652 str_cmp(str1,str2)
653 register STR *str1;
654 register STR *str2;
655 {
656     int retval;
657
658     if (!str1)
659         return str2 == Nullstr;
660     if (!str2)
661         return 0;
662
663     if (!str1->str_pok)
664         (void)str_2ptr(str1);
665     if (!str2->str_pok)
666         (void)str_2ptr(str2);
667
668     if (str1->str_cur < str2->str_cur) {
669         if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
670             return retval;
671         else
672             return -1;
673     }
674     else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
675         return retval;
676     else if (str1->str_cur == str2->str_cur)
677         return 0;
678     else
679         return 1;
680 }
681
682 char *
683 str_gets(str,fp,append)
684 register STR *str;
685 register FILE *fp;
686 int append;
687 {
688     register char *bp;          /* we're going to steal some values */
689     register int cnt;           /*  from the stdio struct and put EVERYTHING */
690     register STDCHAR *ptr;      /*   in the innermost loop into registers */
691     register int newline = record_separator;/* (assuming >= 6 registers) */
692     int i;
693     int bpx;
694     int obpx;
695     register int get_paragraph;
696     register char *oldbp;
697
698     if (get_paragraph = !rslen) {       /* yes, that's an assignment */
699         newline = '\n';
700         oldbp = Nullch;                 /* remember last \n position (none) */
701     }
702 #ifdef STDSTDIO         /* Here is some breathtakingly efficient cheating */
703
704     cnt = fp->_cnt;                     /* get count into register */
705     str->str_nok = 0;                   /* invalidate number */
706     str->str_pok = 1;                   /* validate pointer */
707     if (str->str_len <= cnt + 1)        /* make sure we have the room */
708         STR_GROW(str, append+cnt+2);    /* (remembering cnt can be -1) */
709     bp = str->str_ptr + append;         /* move these two too to registers */
710     ptr = fp->_ptr;
711     for (;;) {
712       screamer:
713         while (--cnt >= 0) {                    /* this */      /* eat */
714             if ((*bp++ = *ptr++) == newline)    /* really */    /* dust */
715                 goto thats_all_folks;           /* screams */   /* sed :-) */ 
716         }
717         
718         fp->_cnt = cnt;                 /* deregisterize cnt and ptr */
719         fp->_ptr = ptr;
720         i = _filbuf(fp);                /* get more characters */
721         cnt = fp->_cnt;
722         ptr = fp->_ptr;                 /* reregisterize cnt and ptr */
723
724         bpx = bp - str->str_ptr;        /* prepare for possible relocation */
725         if (get_paragraph && oldbp)
726             obpx = oldbp - str->str_ptr;
727         str->str_cur = bpx;
728         STR_GROW(str, bpx + cnt + 2);
729         bp = str->str_ptr + bpx;        /* reconstitute our pointer */
730         if (get_paragraph && oldbp)
731             oldbp = str->str_ptr + obpx;
732
733         if (i == newline) {             /* all done for now? */
734             *bp++ = i;
735             goto thats_all_folks;
736         }
737         else if (i == EOF)              /* all done for ever? */
738             goto thats_really_all_folks;
739         *bp++ = i;                      /* now go back to screaming loop */
740     }
741
742 thats_all_folks:
743     if (get_paragraph && bp - 1 != oldbp) {
744         oldbp = bp;     /* remember where this newline was */
745         goto screamer;  /* and go back to the fray */
746     }
747 thats_really_all_folks:
748     fp->_cnt = cnt;                     /* put these back or we're in trouble */
749     fp->_ptr = ptr;
750     *bp = '\0';
751     str->str_cur = bp - str->str_ptr;   /* set length */
752
753 #else /* !STDSTDIO */   /* The big, slow, and stupid way */
754
755     {
756         static char buf[8192];
757         char * bpe = buf + sizeof(buf) - 3;
758
759 screamer:
760         bp = buf;
761 filler:
762         while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe);
763         if (i == newline && get_paragraph &&
764             (i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe)
765             goto filler;
766
767         *bp = '\0';
768         if (append)
769             str_cat(str, buf);
770         else
771             str_set(str, buf);
772         if (i != newline && i != EOF) {
773             append = -1;
774             goto screamer;
775         }
776     }
777
778 #endif /* STDSTDIO */
779
780     return str->str_cur - append ? str->str_ptr : Nullch;
781 }
782
783 ARG *
784 parselist(str)
785 STR *str;
786 {
787     register CMD *cmd;
788     register ARG *arg;
789     line_t oldline = line;
790     int retval;
791     char *tmps;
792
793     str_sset(linestr,str);
794     in_eval++;
795     oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
796     bufend = bufptr + linestr->str_cur;
797     if (++loop_ptr >= loop_max) {
798         loop_max += 128;
799         Renew(loop_stack, loop_max, struct loop);
800     }
801     loop_stack[loop_ptr].loop_label = "_EVAL_";
802     loop_stack[loop_ptr].loop_sp = 0;
803 #ifdef DEBUGGING
804     if (debug & 4) {
805         deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
806     }
807 #endif
808     if (setjmp(loop_stack[loop_ptr].loop_env)) {
809         in_eval--;
810         loop_ptr--;
811         fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
812     }
813 #ifdef DEBUGGING
814     if (debug & 4) {
815         tmps = loop_stack[loop_ptr].loop_label;
816         deb("(Popping label #%d %s)\n",loop_ptr,
817             tmps ? tmps : "" );
818     }
819 #endif
820     loop_ptr--;
821     error_count = 0;
822     retval = yyparse();
823     in_eval--;
824     if (retval || error_count)
825         fatal("Invalid component in string or format");
826     cmd = eval_root;
827     arg = cmd->c_expr;
828     if (cmd->c_type != C_EXPR || cmd->c_next || arg->arg_type != O_LIST)
829         fatal("panic: error in parselist %d %x %d", cmd->c_type,
830           cmd->c_next, arg ? arg->arg_type : -1);
831     line = oldline;
832     Safefree(cmd);
833     return arg;
834 }
835
836 void
837 intrpcompile(src)
838 STR *src;
839 {
840     register char *s = str_get(src);
841     register char *send = s + src->str_cur;
842     register STR *str;
843     register char *t;
844     STR *toparse;
845     int len;
846     register int brackets;
847     register char *d;
848     STAB *stab;
849     char *checkpoint;
850
851     toparse = Str_new(76,0);
852     str = Str_new(77,0);
853
854     str_nset(str,"",0);
855     str_nset(toparse,"",0);
856     t = s;
857     while (s < send) {
858         if (*s == '\\' && s[1] && index("$@[{\\]}",s[1])) {
859             str_ncat(str, t, s - t);
860             ++s;
861             if (*nointrp && s+1 < send)
862                 if (*s != '@' && (*s != '$' || index(nointrp,s[1])))
863                     str_ncat(str,s-1,1);
864             str_ncat(str, "$b", 2);
865             str_ncat(str, s, 1);
866             ++s;
867             t = s;
868         }
869         else if ((*s == '@' || (*s == '$' && !index(nointrp,s[1]))) &&
870           s+1 < send) {
871             str_ncat(str,t,s-t);
872             t = s;
873             if (*s == '$' && s[1] == '#' && (isalpha(s[2]) || s[2] == '_'))
874                 s++;
875             s = scanreg(s,send,tokenbuf);
876             if (*t == '@' &&
877               (!(stab = stabent(tokenbuf,FALSE)) || 
878                  (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
879                 str_ncat(str,"@",1);
880                 s = ++t;
881                 continue;       /* grandfather @ from old scripts */
882             }
883             str_ncat(str,"$a",2);
884             str_ncat(toparse,",",1);
885             if (t[1] != '{' && (*s == '['  || *s == '{' /* }} */ ) &&
886               (stab = stabent(tokenbuf,FALSE)) &&
887               ((*s == '[') ? (stab_xarray(stab) != 0) : (stab_xhash(stab) != 0)) ) {
888                 brackets = 0;
889                 checkpoint = s;
890                 do {
891                     switch (*s) {
892                     case '[':
893                         if (s[-1] != '$')
894                             brackets++;
895                         break;
896                     case '{':
897                         brackets++;
898                         break;
899                     case ']':
900                         if (s[-1] != '$')
901                             brackets--;
902                         break;
903                     case '}':
904                         brackets--;
905                         break;
906                     case '\'':
907                     case '"':
908                         if (s[-1] != '$') {
909                             s = cpytill(tokenbuf,s+1,send,*s,&len);
910                             if (s >= send)
911                                 fatal("Unterminated string");
912                         }
913                         break;
914                     }
915                     s++;
916                 } while (brackets > 0 && s < send);
917                 if (s > send)
918                     fatal("Unmatched brackets in string");
919                 if (*nointrp) {         /* we're in a regular expression */
920                     d = checkpoint;
921                     if (*d == '{' && s[-1] == '}') {    /* maybe {n,m} */
922                         ++d;
923                         if (isdigit(*d)) {      /* matches /^{\d,?\d*}$/ */
924                             if (*++d == ',')
925                                 ++d;
926                             while (isdigit(*d))
927                                 d++;
928                             if (d == s - 1)
929                                 s = checkpoint;         /* Is {n,m}! Backoff! */
930                         }
931                     }
932                     else if (*d == '[' && s[-1] == ']') { /* char class? */
933                         int weight = 2;         /* let's weigh the evidence */
934                         char seen[256];
935                         unsigned char un_char = 0, last_un_char;
936
937                         Zero(seen,256,char);
938                         *--s = '\0';
939                         if (d[1] == '^')
940                             weight += 150;
941                         else if (d[1] == '$')
942                             weight -= 3;
943                         if (isdigit(d[1])) {
944                             if (d[2]) {
945                                 if (isdigit(d[2]) && !d[3])
946                                     weight -= 10;
947                             }
948                             else
949                                 weight -= 100;
950                         }
951                         for (d++; d < s; d++) {
952                             last_un_char = un_char;
953                             un_char = (unsigned char)*d;
954                             switch (*d) {
955                             case '&':
956                             case '$':
957                                 weight -= seen[un_char] * 10;
958                                 if (isalpha(d[1]) || isdigit(d[1]) ||
959                                   d[1] == '_') {
960                                     d = scanreg(d,s,tokenbuf);
961                                     if (stabent(tokenbuf,FALSE))
962                                         weight -= 100;
963                                     else
964                                         weight -= 10;
965                                 }
966                                 else if (*d == '$' && d[1] &&
967                                   index("[#!%*<>()-=",d[1])) {
968                                     if (!d[2] || /*{*/ index("])} =",d[2]))
969                                         weight -= 10;
970                                     else
971                                         weight -= 1;
972                                 }
973                                 break;
974                             case '\\':
975                                 un_char = 254;
976                                 if (d[1]) {
977                                     if (index("wds",d[1]))
978                                         weight += 100;
979                                     else if (seen['\''] || seen['"'])
980                                         weight += 1;
981                                     else if (index("rnftb",d[1]))
982                                         weight += 40;
983                                     else if (isdigit(d[1])) {
984                                         weight += 40;
985                                         while (d[1] && isdigit(d[1]))
986                                             d++;
987                                     }
988                                 }
989                                 else
990                                     weight += 100;
991                                 break;
992                             case '-':
993                                 if (last_un_char < d[1] || d[1] == '\\') {
994                                     if (index("aA01! ",last_un_char))
995                                         weight += 30;
996                                     if (index("zZ79~",d[1]))
997                                         weight += 30;
998                                 }
999                                 else
1000                                     weight -= 1;
1001                             default:
1002                                 if (isalpha(*d) && d[1] && isalpha(d[1])) {
1003                                     bufptr = d;
1004                                     if (yylex() != WORD)
1005                                         weight -= 150;
1006                                     d = bufptr;
1007                                 }
1008                                 if (un_char == last_un_char + 1)
1009                                     weight += 5;
1010                                 weight -= seen[un_char];
1011                                 break;
1012                             }
1013                             seen[un_char]++;
1014                         }
1015 #ifdef DEBUGGING
1016                         if (debug & 512)
1017                             fprintf(stderr,"[%s] weight %d\n",
1018                               checkpoint+1,weight);
1019 #endif
1020                         *s++ = ']';
1021                         if (weight >= 0)        /* probably a character class */
1022                             s = checkpoint;
1023                     }
1024                 }
1025             }
1026             if (*t == '@')
1027                 str_ncat(toparse, "join($\",", 8);
1028             if (t[1] == '{' && s[-1] == '}') {
1029                 str_ncat(toparse, t, 1);
1030                 str_ncat(toparse, t+2, s - t - 3);
1031             }
1032             else
1033                 str_ncat(toparse, t, s - t);
1034             if (*t == '@')
1035                 str_ncat(toparse, ")", 1);
1036             t = s;
1037         }
1038         else
1039             s++;
1040     }
1041     str_ncat(str,t,s-t);
1042     if (toparse->str_ptr && *toparse->str_ptr == ',') {
1043         *toparse->str_ptr = '(';
1044         str_ncat(toparse,",$$);",5);
1045         str->str_u.str_args = parselist(toparse);
1046         str->str_u.str_args->arg_len--;         /* ignore $$ reference */
1047     }
1048     else
1049         str->str_u.str_args = Nullarg;
1050     str_free(toparse);
1051     str->str_pok |= SP_INTRP;
1052     str->str_nok = 0;
1053     str_replace(src,str);
1054 }
1055
1056 STR *
1057 interp(str,src,sp)
1058 register STR *str;
1059 STR *src;
1060 int sp;
1061 {
1062     register char *s;
1063     register char *t;
1064     register char *send;
1065     register STR **elem;
1066
1067     if (!(src->str_pok & SP_INTRP)) {
1068         int oldsave = savestack->ary_fill;
1069
1070         (void)savehptr(&curstash);
1071         curstash = src->str_u.str_hash; /* so stabent knows right package */
1072         intrpcompile(src);
1073         restorelist(oldsave);
1074     }
1075     s = src->str_ptr;           /* assumed valid since str_pok set */
1076     t = s;
1077     send = s + src->str_cur;
1078
1079     if (src->str_u.str_args) {
1080         (void)eval(src->str_u.str_args,G_ARRAY,sp);
1081         /* Assuming we have correct # of args */
1082         elem = stack->ary_array + sp;
1083     }
1084
1085     str_nset(str,"",0);
1086     while (s < send) {
1087         if (*s == '$' && s+1 < send) {
1088             str_ncat(str,t,s-t);
1089             switch(*++s) {
1090             case 'a':
1091                 str_scat(str,*++elem);
1092                 break;
1093             case 'b':
1094                 str_ncat(str,++s,1);
1095                 break;
1096             }
1097             t = ++s;
1098         }
1099         else
1100             s++;
1101     }
1102     str_ncat(str,t,s-t);
1103     return str;
1104 }
1105
1106 void
1107 str_inc(str)
1108 register STR *str;
1109 {
1110     register char *d;
1111
1112     if (!str)
1113         return;
1114     if (str->str_nok) {
1115         str->str_u.str_nval += 1.0;
1116         str->str_pok = 0;
1117         return;
1118     }
1119     if (!str->str_pok || !*str->str_ptr) {
1120         str->str_u.str_nval = 1.0;
1121         str->str_nok = 1;
1122         str->str_pok = 0;
1123         return;
1124     }
1125     d = str->str_ptr;
1126     while (isalpha(*d)) d++;
1127     while (isdigit(*d)) d++;
1128     if (*d) {
1129         str_numset(str,atof(str->str_ptr) + 1.0);  /* punt */
1130         return;
1131     }
1132     d--;
1133     while (d >= str->str_ptr) {
1134         if (isdigit(*d)) {
1135             if (++*d <= '9')
1136                 return;
1137             *(d--) = '0';
1138         }
1139         else {
1140             ++*d;
1141             if (isalpha(*d))
1142                 return;
1143             *(d--) -= 'z' - 'a' + 1;
1144         }
1145     }
1146     /* oh,oh, the number grew */
1147     STR_GROW(str, str->str_cur + 2);
1148     str->str_cur++;
1149     for (d = str->str_ptr + str->str_cur; d > str->str_ptr; d--)
1150         *d = d[-1];
1151     if (isdigit(d[1]))
1152         *d = '1';
1153     else
1154         *d = d[1];
1155 }
1156
1157 void
1158 str_dec(str)
1159 register STR *str;
1160 {
1161     if (!str)
1162         return;
1163     if (str->str_nok) {
1164         str->str_u.str_nval -= 1.0;
1165         str->str_pok = 0;
1166         return;
1167     }
1168     if (!str->str_pok) {
1169         str->str_u.str_nval = -1.0;
1170         str->str_nok = 1;
1171         return;
1172     }
1173     str_numset(str,atof(str->str_ptr) - 1.0);
1174 }
1175
1176 /* Make a string that will exist for the duration of the expression
1177  * evaluation.  Actually, it may have to last longer than that, but
1178  * hopefully cmd_exec won't free it until it has been assigned to a
1179  * permanent location. */
1180
1181 static long tmps_size = -1;
1182
1183 STR *
1184 str_static(oldstr)
1185 STR *oldstr;
1186 {
1187     register STR *str = Str_new(78,0);
1188
1189     str_sset(str,oldstr);
1190     if (++tmps_max > tmps_size) {
1191         tmps_size = tmps_max;
1192         if (!(tmps_size & 127)) {
1193             if (tmps_size)
1194                 Renew(tmps_list, tmps_size + 128, STR*);
1195             else
1196                 New(702,tmps_list, 128, STR*);
1197         }
1198     }
1199     tmps_list[tmps_max] = str;
1200     return str;
1201 }
1202
1203 /* same thing without the copying */
1204
1205 STR *
1206 str_2static(str)
1207 register STR *str;
1208 {
1209     if (++tmps_max > tmps_size) {
1210         tmps_size = tmps_max;
1211         if (!(tmps_size & 127)) {
1212             if (tmps_size)
1213                 Renew(tmps_list, tmps_size + 128, STR*);
1214             else
1215                 New(704,tmps_list, 128, STR*);
1216         }
1217     }
1218     tmps_list[tmps_max] = str;
1219     return str;
1220 }
1221
1222 STR *
1223 str_make(s,len)
1224 char *s;
1225 int len;
1226 {
1227     register STR *str = Str_new(79,0);
1228
1229     if (!len)
1230         len = strlen(s);
1231     str_nset(str,s,len);
1232     return str;
1233 }
1234
1235 STR *
1236 str_nmake(n)
1237 double n;
1238 {
1239     register STR *str = Str_new(80,0);
1240
1241     str_numset(str,n);
1242     return str;
1243 }
1244
1245 /* make an exact duplicate of old */
1246
1247 STR *
1248 str_smake(old)
1249 register STR *old;
1250 {
1251     register STR *new = Str_new(81,0);
1252
1253     if (!old)
1254         return Nullstr;
1255     if (old->str_state == SS_FREE) {
1256         warn("semi-panic: attempt to dup freed string");
1257         return Nullstr;
1258     }
1259     if (old->str_state == SS_INCR && !(old->str_pok & 2))
1260         str_grow(old,0);
1261     if (new->str_ptr)
1262         Safefree(new->str_ptr);
1263     Copy(old,new,1,STR);
1264     if (old->str_ptr)
1265         new->str_ptr = nsavestr(old->str_ptr,old->str_len);
1266     return new;
1267 }
1268
1269 str_reset(s,stash)
1270 register char *s;
1271 HASH *stash;
1272 {
1273     register HENT *entry;
1274     register STAB *stab;
1275     register STR *str;
1276     register int i;
1277     register SPAT *spat;
1278     register int max;
1279
1280     if (!*s) {          /* reset ?? searches */
1281         for (spat = stash->tbl_spatroot;
1282           spat != Nullspat;
1283           spat = spat->spat_next) {
1284             spat->spat_flags &= ~SPAT_USED;
1285         }
1286         return;
1287     }
1288
1289     /* reset variables */
1290
1291     while (*s) {
1292         i = *s;
1293         if (s[1] == '-') {
1294             s += 2;
1295         }
1296         max = *s++;
1297         for ( ; i <= max; i++) {
1298             for (entry = stash->tbl_array[i];
1299               entry;
1300               entry = entry->hent_next) {
1301                 stab = (STAB*)entry->hent_val;
1302                 str = stab_val(stab);
1303                 str->str_cur = 0;
1304                 str->str_nok = 0;
1305 #ifdef TAINT
1306                 str->str_tainted = tainted;
1307 #endif
1308                 if (str->str_ptr != Nullch)
1309                     str->str_ptr[0] = '\0';
1310                 if (stab_xarray(stab)) {
1311                     aclear(stab_xarray(stab));
1312                 }
1313                 if (stab_xhash(stab)) {
1314                     hclear(stab_xhash(stab));
1315                     if (stab == envstab)
1316                         environ[0] = Nullch;
1317                 }
1318             }
1319         }
1320     }
1321 }
1322
1323 #ifdef TAINT
1324 taintproper(s)
1325 char *s;
1326 {
1327 #ifdef DEBUGGING
1328     if (debug & 2048)
1329         fprintf(stderr,"%s %d %d %d\n",s,tainted,uid, euid);
1330 #endif
1331     if (tainted && (!euid || euid != uid)) {
1332         if (!unsafe)
1333             fatal("%s", s);
1334         else if (dowarn)
1335             warn("%s", s);
1336     }
1337 }
1338
1339 taintenv()
1340 {
1341     register STR *envstr;
1342
1343     envstr = hfetch(stab_hash(envstab),"PATH",4,FALSE);
1344     if (!envstr || envstr->str_tainted) {
1345         tainted = 1;
1346         taintproper("Insecure PATH");
1347     }
1348     envstr = hfetch(stab_hash(envstab),"IFS",3,FALSE);
1349     if (envstr && envstr->str_tainted) {
1350         tainted = 1;
1351         taintproper("Insecure IFS");
1352     }
1353 }
1354 #endif /* TAINT */