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