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