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