This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
af1a2b77ed802d46c07ebc4b813982b37196549b
[perl5.git] / util.c
1 /* $RCSfile: util.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 12:10:42 $
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:        util.c,v $
9  * Revision 4.0.1.2  91/06/07  12:10:42  lwall
10  * patch4: new copyright notice
11  * patch4: made some allowances for "semi-standard" C
12  * patch4: index() could blow up searching for null string
13  * patch4: taintchecks could improperly modify parent in vfork()
14  * patch4: exec would close files even if you cleared close-on-exec flag
15  * 
16  * Revision 4.0.1.1  91/04/12  09:19:25  lwall
17  * patch1: random cleanup in cpp namespace
18  * 
19  * Revision 4.0  91/03/20  01:56:39  lwall
20  * 4.0 baseline.
21  * 
22  */
23
24 #include "EXTERN.h"
25 #include "perl.h"
26
27 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
28 #include <signal.h>
29 #endif
30
31 #ifdef I_VFORK
32 #  include <vfork.h>
33 #endif
34
35 #ifdef I_VARARGS
36 #  include <varargs.h>
37 #endif
38
39 #ifdef I_FCNTL
40 #  include <fcntl.h>
41 #endif
42 #ifdef I_SYS_FILE
43 #  include <sys/file.h>
44 #endif
45
46 #define FLUSH
47
48 static char nomem[] = "Out of memory!\n";
49
50 /* paranoid version of malloc */
51
52 #ifdef DEBUGGING
53 static int an = 0;
54 #endif
55
56 /* NOTE:  Do not call the next three routines directly.  Use the macros
57  * in handy.h, so that we can easily redefine everything to do tracking of
58  * allocated hunks back to the original New to track down any memory leaks.
59  */
60
61 char *
62 safemalloc(size)
63 #ifdef MSDOS
64 unsigned long size;
65 #else
66 MEM_SIZE size;
67 #endif /* MSDOS */
68 {
69     char *ptr;
70 #ifndef STANDARD_C
71     char *malloc();
72 #endif /* ! STANDARD_C */
73
74 #ifdef MSDOS
75         if (size > 0xffff) {
76                 fprintf(stderr, "Allocation too large: %lx\n", size) FLUSH;
77                 exit(1);
78         }
79 #endif /* MSDOS */
80 #ifdef DEBUGGING
81     if ((long)size < 0)
82         fatal("panic: malloc");
83 #endif
84     ptr = malloc(size?size:1);  /* malloc(0) is NASTY on our system */
85 #ifdef DEBUGGING
86 #  ifndef I286
87     if (debug & 128)
88         fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size);
89 #  else
90     if (debug & 128)
91         fprintf(stderr,"0x%lx: (%05d) malloc %d bytes\n",ptr,an++,size);
92 #  endif
93 #endif
94     if (ptr != Nullch)
95         return ptr;
96     else {
97         fputs(nomem,stderr) FLUSH;
98         exit(1);
99     }
100     /*NOTREACHED*/
101 #ifdef lint
102     return ptr;
103 #endif
104 }
105
106 /* paranoid version of realloc */
107
108 char *
109 saferealloc(where,size)
110 char *where;
111 #ifndef MSDOS
112 MEM_SIZE size;
113 #else
114 unsigned long size;
115 #endif /* MSDOS */
116 {
117     char *ptr;
118 #ifndef STANDARD_C
119     char *realloc();
120 #endif /* ! STANDARD_C */
121
122 #ifdef MSDOS
123         if (size > 0xffff) {
124                 fprintf(stderr, "Reallocation too large: %lx\n", size) FLUSH;
125                 exit(1);
126         }
127 #endif /* MSDOS */
128     if (!where)
129         fatal("Null realloc");
130 #ifdef DEBUGGING
131     if ((long)size < 0)
132         fatal("panic: realloc");
133 #endif
134     ptr = realloc(where,size?size:1);   /* realloc(0) is NASTY on our system */
135 #ifdef DEBUGGING
136 #  ifndef I286
137     if (debug & 128) {
138         fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
139         fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size);
140     }
141 #  else
142     if (debug & 128) {
143         fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
144         fprintf(stderr,"0x%lx: (%05d) realloc %d bytes\n",ptr,an++,size);
145     }
146 #  endif
147 #endif
148     if (ptr != Nullch)
149         return ptr;
150     else {
151         fputs(nomem,stderr) FLUSH;
152         exit(1);
153     }
154     /*NOTREACHED*/
155 #ifdef lint
156     return ptr;
157 #endif
158 }
159
160 /* safe version of free */
161
162 void
163 safefree(where)
164 char *where;
165 {
166 #ifdef DEBUGGING
167 #  ifndef I286
168     if (debug & 128)
169         fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
170 #  else
171     if (debug & 128)
172         fprintf(stderr,"0x%lx: (%05d) free\n",where,an++);
173 #  endif
174 #endif
175     if (where) {
176         free(where);
177     }
178 }
179
180 #ifdef LEAKTEST
181
182 #define ALIGN sizeof(long)
183
184 char *
185 safexmalloc(x,size)
186 int x;
187 MEM_SIZE size;
188 {
189     register char *where;
190
191     where = safemalloc(size + ALIGN);
192     xcount[x]++;
193     where[0] = x % 100;
194     where[1] = x / 100;
195     return where + ALIGN;
196 }
197
198 char *
199 safexrealloc(where,size)
200 char *where;
201 MEM_SIZE size;
202 {
203     return saferealloc(where - ALIGN, size + ALIGN) + ALIGN;
204 }
205
206 void
207 safexfree(where)
208 char *where;
209 {
210     int x;
211
212     if (!where)
213         return;
214     where -= ALIGN;
215     x = where[0] + 100 * where[1];
216     xcount[x]--;
217     safefree(where);
218 }
219
220 xstat()
221 {
222     register int i;
223
224     for (i = 0; i < MAXXCOUNT; i++) {
225         if (xcount[i] != lastxcount[i]) {
226             fprintf(stderr,"%2d %2d\t%ld\n", i / 100, i % 100, xcount[i]);
227             lastxcount[i] = xcount[i];
228         }
229     }
230 }
231
232 #endif /* LEAKTEST */
233
234 /* copy a string up to some (non-backslashed) delimiter, if any */
235
236 char *
237 cpytill(to,from,fromend,delim,retlen)
238 register char *to;
239 register char *from;
240 register char *fromend;
241 register int delim;
242 int *retlen;
243 {
244     char *origto = to;
245
246     for (; from < fromend; from++,to++) {
247         if (*from == '\\') {
248             if (from[1] == delim)
249                 from++;
250             else if (from[1] == '\\')
251                 *to++ = *from++;
252         }
253         else if (*from == delim)
254             break;
255         *to = *from;
256     }
257     *to = '\0';
258     *retlen = to - origto;
259     return from;
260 }
261
262 /* return ptr to little string in big string, NULL if not found */
263 /* This routine was donated by Corey Satten. */
264
265 char *
266 instr(big, little)
267 register char *big;
268 register char *little;
269 {
270     register char *s, *x;
271     register int first;
272
273     if (!little)
274         return big;
275     first = *little++;
276     if (!first)
277         return big;
278     while (*big) {
279         if (*big++ != first)
280             continue;
281         for (x=big,s=little; *s; /**/ ) {
282             if (!*x)
283                 return Nullch;
284             if (*s++ != *x++) {
285                 s--;
286                 break;
287             }
288         }
289         if (!*s)
290             return big-1;
291     }
292     return Nullch;
293 }
294
295 /* same as instr but allow embedded nulls */
296
297 char *
298 ninstr(big, bigend, little, lend)
299 register char *big;
300 register char *bigend;
301 char *little;
302 char *lend;
303 {
304     register char *s, *x;
305     register int first = *little;
306     register char *littleend = lend;
307
308     if (!first && little > littleend)
309         return big;
310     bigend -= littleend - little++;
311     while (big <= bigend) {
312         if (*big++ != first)
313             continue;
314         for (x=big,s=little; s < littleend; /**/ ) {
315             if (*s++ != *x++) {
316                 s--;
317                 break;
318             }
319         }
320         if (s >= littleend)
321             return big-1;
322     }
323     return Nullch;
324 }
325
326 /* reverse of the above--find last substring */
327
328 char *
329 rninstr(big, bigend, little, lend)
330 register char *big;
331 char *bigend;
332 char *little;
333 char *lend;
334 {
335     register char *bigbeg;
336     register char *s, *x;
337     register int first = *little;
338     register char *littleend = lend;
339
340     if (!first && little > littleend)
341         return bigend;
342     bigbeg = big;
343     big = bigend - (littleend - little++);
344     while (big >= bigbeg) {
345         if (*big-- != first)
346             continue;
347         for (x=big+2,s=little; s < littleend; /**/ ) {
348             if (*s++ != *x++) {
349                 s--;
350                 break;
351             }
352         }
353         if (s >= littleend)
354             return big+1;
355     }
356     return Nullch;
357 }
358
359 unsigned char fold[] = {
360         0,      1,      2,      3,      4,      5,      6,      7,
361         8,      9,      10,     11,     12,     13,     14,     15,
362         16,     17,     18,     19,     20,     21,     22,     23,
363         24,     25,     26,     27,     28,     29,     30,     31,
364         32,     33,     34,     35,     36,     37,     38,     39,
365         40,     41,     42,     43,     44,     45,     46,     47,
366         48,     49,     50,     51,     52,     53,     54,     55,
367         56,     57,     58,     59,     60,     61,     62,     63,
368         64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
369         'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
370         'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
371         'x',    'y',    'z',    91,     92,     93,     94,     95,
372         96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
373         'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
374         'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
375         'X',    'Y',    'Z',    123,    124,    125,    126,    127,
376         128,    129,    130,    131,    132,    133,    134,    135,
377         136,    137,    138,    139,    140,    141,    142,    143,
378         144,    145,    146,    147,    148,    149,    150,    151,
379         152,    153,    154,    155,    156,    157,    158,    159,
380         160,    161,    162,    163,    164,    165,    166,    167,
381         168,    169,    170,    171,    172,    173,    174,    175,
382         176,    177,    178,    179,    180,    181,    182,    183,
383         184,    185,    186,    187,    188,    189,    190,    191,
384         192,    193,    194,    195,    196,    197,    198,    199,
385         200,    201,    202,    203,    204,    205,    206,    207,
386         208,    209,    210,    211,    212,    213,    214,    215,
387         216,    217,    218,    219,    220,    221,    222,    223,    
388         224,    225,    226,    227,    228,    229,    230,    231,
389         232,    233,    234,    235,    236,    237,    238,    239,
390         240,    241,    242,    243,    244,    245,    246,    247,
391         248,    249,    250,    251,    252,    253,    254,    255
392 };
393
394 static unsigned char freq[] = {
395         1,      2,      84,     151,    154,    155,    156,    157,
396         165,    246,    250,    3,      158,    7,      18,     29,
397         40,     51,     62,     73,     85,     96,     107,    118,
398         129,    140,    147,    148,    149,    150,    152,    153,
399         255,    182,    224,    205,    174,    176,    180,    217,
400         233,    232,    236,    187,    235,    228,    234,    226,
401         222,    219,    211,    195,    188,    193,    185,    184,
402         191,    183,    201,    229,    181,    220,    194,    162,
403         163,    208,    186,    202,    200,    218,    198,    179,
404         178,    214,    166,    170,    207,    199,    209,    206,
405         204,    160,    212,    216,    215,    192,    175,    173,
406         243,    172,    161,    190,    203,    189,    164,    230,
407         167,    248,    227,    244,    242,    255,    241,    231,
408         240,    253,    169,    210,    245,    237,    249,    247,
409         239,    168,    252,    251,    254,    238,    223,    221,
410         213,    225,    177,    197,    171,    196,    159,    4,
411         5,      6,      8,      9,      10,     11,     12,     13,
412         14,     15,     16,     17,     19,     20,     21,     22,
413         23,     24,     25,     26,     27,     28,     30,     31,
414         32,     33,     34,     35,     36,     37,     38,     39,
415         41,     42,     43,     44,     45,     46,     47,     48,
416         49,     50,     52,     53,     54,     55,     56,     57,
417         58,     59,     60,     61,     63,     64,     65,     66,
418         67,     68,     69,     70,     71,     72,     74,     75,
419         76,     77,     78,     79,     80,     81,     82,     83,
420         86,     87,     88,     89,     90,     91,     92,     93,
421         94,     95,     97,     98,     99,     100,    101,    102,
422         103,    104,    105,    106,    108,    109,    110,    111,
423         112,    113,    114,    115,    116,    117,    119,    120,
424         121,    122,    123,    124,    125,    126,    127,    128,
425         130,    131,    132,    133,    134,    135,    136,    137,
426         138,    139,    141,    142,    143,    144,    145,    146
427 };
428
429 void
430 fbmcompile(str, iflag)
431 STR *str;
432 int iflag;
433 {
434     register unsigned char *s;
435     register unsigned char *table;
436     register int i;
437     register int len = str->str_cur;
438     int rarest = 0;
439     unsigned int frequency = 256;
440
441     Str_Grow(str,len+258);
442 #ifndef lint
443     table = (unsigned char*)(str->str_ptr + len + 1);
444 #else
445     table = Null(unsigned char*);
446 #endif
447     s = table - 2;
448     for (i = 0; i < 256; i++) {
449         table[i] = len;
450     }
451     i = 0;
452 #ifndef lint
453     while (s >= (unsigned char*)(str->str_ptr))
454 #endif
455     {
456         if (table[*s] == len) {
457 #ifndef pdp11
458             if (iflag)
459                 table[*s] = table[fold[*s]] = i;
460 #else
461             if (iflag) {
462                 int j;
463                 j = fold[*s];
464                 table[j] = i;
465                 table[*s] = i;
466             }
467 #endif /* pdp11 */
468             else
469                 table[*s] = i;
470         }
471         s--,i++;
472     }
473     str->str_pok |= SP_FBM;             /* deep magic */
474
475 #ifndef lint
476     s = (unsigned char*)(str->str_ptr);         /* deeper magic */
477 #else
478     s = Null(unsigned char*);
479 #endif
480     if (iflag) {
481         register unsigned int tmp, foldtmp;
482         str->str_pok |= SP_CASEFOLD;
483         for (i = 0; i < len; i++) {
484             tmp=freq[s[i]];
485             foldtmp=freq[fold[s[i]]];
486             if (tmp < frequency && foldtmp < frequency) {
487                 rarest = i;
488                 /* choose most frequent among the two */
489                 frequency = (tmp > foldtmp) ? tmp : foldtmp;
490             }
491         }
492     }
493     else {
494         for (i = 0; i < len; i++) {
495             if (freq[s[i]] < frequency) {
496                 rarest = i;
497                 frequency = freq[s[i]];
498             }
499         }
500     }
501     str->str_rare = s[rarest];
502     str->str_state = rarest;
503 #ifdef DEBUGGING
504     if (debug & 512)
505         fprintf(stderr,"rarest char %c at %d\n",str->str_rare, str->str_state);
506 #endif
507 }
508
509 char *
510 fbminstr(big, bigend, littlestr)
511 unsigned char *big;
512 register unsigned char *bigend;
513 STR *littlestr;
514 {
515     register unsigned char *s;
516     register int tmp;
517     register int littlelen;
518     register unsigned char *little;
519     register unsigned char *table;
520     register unsigned char *olds;
521     register unsigned char *oldlittle;
522
523 #ifndef lint
524     if (!(littlestr->str_pok & SP_FBM)) {
525         if (!littlestr->str_ptr)
526             return (char*)big;
527         return ninstr((char*)big,(char*)bigend,
528                 littlestr->str_ptr, littlestr->str_ptr + littlestr->str_cur);
529     }
530 #endif
531
532     littlelen = littlestr->str_cur;
533 #ifndef lint
534     if (littlestr->str_pok & SP_TAIL && !multiline) {   /* tail anchored? */
535         if (littlelen > bigend - big)
536             return Nullch;
537         little = (unsigned char*)littlestr->str_ptr;
538         if (littlestr->str_pok & SP_CASEFOLD) { /* oops, fake it */
539             big = bigend - littlelen;           /* just start near end */
540             if (bigend[-1] == '\n' && little[littlelen-1] != '\n')
541                 big--;
542         }
543         else {
544             s = bigend - littlelen;
545             if (*s == *little && bcmp(s,little,littlelen)==0)
546                 return (char*)s;                /* how sweet it is */
547             else if (bigend[-1] == '\n' && little[littlelen-1] != '\n'
548               && s > big) {
549                     s--;
550                 if (*s == *little && bcmp(s,little,littlelen)==0)
551                     return (char*)s;
552             }
553             return Nullch;
554         }
555     }
556     table = (unsigned char*)(littlestr->str_ptr + littlelen + 1);
557 #else
558     table = Null(unsigned char*);
559 #endif
560     if (--littlelen >= bigend - big)
561         return Nullch;
562     s = big + littlelen;
563     oldlittle = little = table - 2;
564     if (littlestr->str_pok & SP_CASEFOLD) {     /* case insensitive? */
565         if (s < bigend) {
566           top1:
567             if (tmp = table[*s]) {
568 #ifdef POINTERRIGOR
569                 if (bigend - s > tmp) {
570                     s += tmp;
571                     goto top1;
572                 }
573 #else
574                 if ((s += tmp) < bigend)
575                     goto top1;
576 #endif
577                 return Nullch;
578             }
579             else {
580                 tmp = littlelen;        /* less expensive than calling strncmp() */
581                 olds = s;
582                 while (tmp--) {
583                     if (*--s == *--little || fold[*s] == *little)
584                         continue;
585                     s = olds + 1;       /* here we pay the price for failure */
586                     little = oldlittle;
587                     if (s < bigend)     /* fake up continue to outer loop */
588                         goto top1;
589                     return Nullch;
590                 }
591 #ifndef lint
592                 return (char *)s;
593 #endif
594             }
595         }
596     }
597     else {
598         if (s < bigend) {
599           top2:
600             if (tmp = table[*s]) {
601 #ifdef POINTERRIGOR
602                 if (bigend - s > tmp) {
603                     s += tmp;
604                     goto top2;
605                 }
606 #else
607                 if ((s += tmp) < bigend)
608                     goto top2;
609 #endif
610                 return Nullch;
611             }
612             else {
613                 tmp = littlelen;        /* less expensive than calling strncmp() */
614                 olds = s;
615                 while (tmp--) {
616                     if (*--s == *--little)
617                         continue;
618                     s = olds + 1;       /* here we pay the price for failure */
619                     little = oldlittle;
620                     if (s < bigend)     /* fake up continue to outer loop */
621                         goto top2;
622                     return Nullch;
623                 }
624 #ifndef lint
625                 return (char *)s;
626 #endif
627             }
628         }
629     }
630     return Nullch;
631 }
632
633 char *
634 screaminstr(bigstr, littlestr)
635 STR *bigstr;
636 STR *littlestr;
637 {
638     register unsigned char *s, *x;
639     register unsigned char *big;
640     register int pos;
641     register int previous;
642     register int first;
643     register unsigned char *little;
644     register unsigned char *bigend;
645     register unsigned char *littleend;
646
647     if ((pos = screamfirst[littlestr->str_rare]) < 0) 
648         return Nullch;
649 #ifndef lint
650     little = (unsigned char *)(littlestr->str_ptr);
651 #else
652     little = Null(unsigned char *);
653 #endif
654     littleend = little + littlestr->str_cur;
655     first = *little++;
656     previous = littlestr->str_state;
657 #ifndef lint
658     big = (unsigned char *)(bigstr->str_ptr);
659 #else
660     big = Null(unsigned char*);
661 #endif
662     bigend = big + bigstr->str_cur;
663     big -= previous;
664     while (pos < previous) {
665 #ifndef lint
666         if (!(pos += screamnext[pos]))
667 #endif
668             return Nullch;
669     }
670     if (littlestr->str_pok & SP_CASEFOLD) {     /* case insignificant? */
671         do {
672             if (big[pos] != first && big[pos] != fold[first])
673                 continue;
674             for (x=big+pos+1,s=little; s < littleend; /**/ ) {
675                 if (x >= bigend)
676                     return Nullch;
677                 if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
678                     s--;
679                     break;
680                 }
681             }
682             if (s == littleend)
683 #ifndef lint
684                 return (char *)(big+pos);
685 #else
686                 return Nullch;
687 #endif
688         } while (
689 #ifndef lint
690                 pos += screamnext[pos]  /* does this goof up anywhere? */
691 #else
692                 pos += screamnext[0]
693 #endif
694             );
695     }
696     else {
697         do {
698             if (big[pos] != first)
699                 continue;
700             for (x=big+pos+1,s=little; s < littleend; /**/ ) {
701                 if (x >= bigend)
702                     return Nullch;
703                 if (*s++ != *x++) {
704                     s--;
705                     break;
706                 }
707             }
708             if (s == littleend)
709 #ifndef lint
710                 return (char *)(big+pos);
711 #else
712                 return Nullch;
713 #endif
714         } while (
715 #ifndef lint
716                 pos += screamnext[pos]
717 #else
718                 pos += screamnext[0]
719 #endif
720             );
721     }
722     return Nullch;
723 }
724
725 /* copy a string to a safe spot */
726
727 char *
728 savestr(str)
729 char *str;
730 {
731     register char *newaddr;
732
733     New(902,newaddr,strlen(str)+1,char);
734     (void)strcpy(newaddr,str);
735     return newaddr;
736 }
737
738 /* same thing but with a known length */
739
740 char *
741 nsavestr(str, len)
742 char *str;
743 register int len;
744 {
745     register char *newaddr;
746
747     New(903,newaddr,len+1,char);
748     (void)bcopy(str,newaddr,len);       /* might not be null terminated */
749     newaddr[len] = '\0';                /* is now */
750     return newaddr;
751 }
752
753 /* grow a static string to at least a certain length */
754
755 void
756 growstr(strptr,curlen,newlen)
757 char **strptr;
758 int *curlen;
759 int newlen;
760 {
761     if (newlen > *curlen) {             /* need more room? */
762         if (*curlen)
763             Renew(*strptr,newlen,char);
764         else
765             New(905,*strptr,newlen,char);
766         *curlen = newlen;
767     }
768 }
769
770 #ifndef I_VARARGS
771 /*VARARGS1*/
772 mess(pat,a1,a2,a3,a4)
773 char *pat;
774 long a1, a2, a3, a4;
775 {
776     char *s;
777
778     s = buf;
779     (void)sprintf(s,pat,a1,a2,a3,a4);
780     s += strlen(s);
781     if (s[-1] != '\n') {
782         if (curcmd->c_line) {
783             (void)sprintf(s," at %s line %ld",
784               stab_val(curcmd->c_filestab)->str_ptr, (long)curcmd->c_line);
785             s += strlen(s);
786         }
787         if (last_in_stab &&
788             stab_io(last_in_stab) &&
789             stab_io(last_in_stab)->lines ) {
790             (void)sprintf(s,", <%s> line %ld",
791               last_in_stab == argvstab ? "" : stab_name(last_in_stab),
792               (long)stab_io(last_in_stab)->lines);
793             s += strlen(s);
794         }
795         (void)strcpy(s,".\n");
796     }
797 }
798
799 /*VARARGS1*/
800 fatal(pat,a1,a2,a3,a4)
801 char *pat;
802 long a1, a2, a3, a4;
803 {
804     extern FILE *e_fp;
805     extern char *e_tmpname;
806     char *tmps;
807
808     mess(pat,a1,a2,a3,a4);
809     if (in_eval) {
810         str_set(stab_val(stabent("@",TRUE)),buf);
811         tmps = "_EVAL_";
812         while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
813           strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
814 #ifdef DEBUGGING
815             if (debug & 4) {
816                 deb("(Skipping label #%d %s)\n",loop_ptr,
817                     loop_stack[loop_ptr].loop_label);
818             }
819 #endif
820             loop_ptr--;
821         }
822 #ifdef DEBUGGING
823         if (debug & 4) {
824             deb("(Found label #%d %s)\n",loop_ptr,
825                 loop_stack[loop_ptr].loop_label);
826         }
827 #endif
828         if (loop_ptr < 0) {
829             in_eval = 0;
830             fatal("Bad label: %s", tmps);
831         }
832         longjmp(loop_stack[loop_ptr].loop_env, 1);
833     }
834     fputs(buf,stderr);
835     (void)fflush(stderr);
836     if (e_fp)
837         (void)UNLINK(e_tmpname);
838     statusvalue >>= 8;
839     exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
840 }
841
842 /*VARARGS1*/
843 warn(pat,a1,a2,a3,a4)
844 char *pat;
845 long a1, a2, a3, a4;
846 {
847     mess(pat,a1,a2,a3,a4);
848     fputs(buf,stderr);
849 #ifdef LEAKTEST
850 #ifdef DEBUGGING
851     if (debug & 4096)
852         xstat();
853 #endif
854 #endif
855     (void)fflush(stderr);
856 }
857 #else
858 /*VARARGS0*/
859 mess(args)
860 va_list args;
861 {
862     char *pat;
863     char *s;
864 #ifndef HAS_VPRINTF
865 #ifdef CHARVSPRINTF
866     char *vsprintf();
867 #else
868     int vsprintf();
869 #endif
870 #endif
871
872     s = buf;
873 #ifdef lint
874     pat = Nullch;
875 #else
876     pat = va_arg(args, char *);
877 #endif
878     (void) vsprintf(s,pat,args);
879
880     s += strlen(s);
881     if (s[-1] != '\n') {
882         if (curcmd->c_line) {
883             (void)sprintf(s," at %s line %ld",
884               stab_val(curcmd->c_filestab)->str_ptr, (long)curcmd->c_line);
885             s += strlen(s);
886         }
887         if (last_in_stab &&
888             stab_io(last_in_stab) &&
889             stab_io(last_in_stab)->lines ) {
890             (void)sprintf(s,", <%s> line %ld",
891               last_in_stab == argvstab ? "" : last_in_stab->str_magic->str_ptr,
892               (long)stab_io(last_in_stab)->lines);
893             s += strlen(s);
894         }
895         (void)strcpy(s,".\n");
896     }
897 }
898
899 /*VARARGS0*/
900 fatal(va_alist)
901 va_dcl
902 {
903     va_list args;
904     extern FILE *e_fp;
905     extern char *e_tmpname;
906     char *tmps;
907
908 #ifndef lint
909     va_start(args);
910 #else
911     args = 0;
912 #endif
913     mess(args);
914     va_end(args);
915     if (in_eval) {
916         str_set(stab_val(stabent("@",TRUE)),buf);
917         tmps = "_EVAL_";
918         while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
919           strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
920 #ifdef DEBUGGING
921             if (debug & 4) {
922                 deb("(Skipping label #%d %s)\n",loop_ptr,
923                     loop_stack[loop_ptr].loop_label);
924             }
925 #endif
926             loop_ptr--;
927         }
928 #ifdef DEBUGGING
929         if (debug & 4) {
930             deb("(Found label #%d %s)\n",loop_ptr,
931                 loop_stack[loop_ptr].loop_label);
932         }
933 #endif
934         if (loop_ptr < 0) {
935             in_eval = 0;
936             fatal("Bad label: %s", tmps);
937         }
938         longjmp(loop_stack[loop_ptr].loop_env, 1);
939     }
940     fputs(buf,stderr);
941     (void)fflush(stderr);
942     if (e_fp)
943         (void)UNLINK(e_tmpname);
944     statusvalue >>= 8;
945     exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
946 }
947
948 /*VARARGS0*/
949 warn(va_alist)
950 va_dcl
951 {
952     va_list args;
953
954 #ifndef lint
955     va_start(args);
956 #else
957     args = 0;
958 #endif
959     mess(args);
960     va_end(args);
961
962     fputs(buf,stderr);
963 #ifdef LEAKTEST
964 #ifdef DEBUGGING
965     if (debug & 4096)
966         xstat();
967 #endif
968 #endif
969     (void)fflush(stderr);
970 }
971 #endif
972
973 void
974 setenv(nam,val)
975 char *nam, *val;
976 {
977     register int i=envix(nam);          /* where does it go? */
978
979     if (environ == origenviron) {       /* need we copy environment? */
980         int j;
981         int max;
982         char **tmpenv;
983
984         for (max = i; environ[max]; max++) ;
985         New(901,tmpenv, max+2, char*);
986         for (j=0; j<max; j++)           /* copy environment */
987             tmpenv[j] = savestr(environ[j]);
988         tmpenv[max] = Nullch;
989         environ = tmpenv;               /* tell exec where it is now */
990     }
991     if (!val) {
992         while (environ[i]) {
993             environ[i] = environ[i+1];
994             i++;
995         }
996         return;
997     }
998     if (!environ[i]) {                  /* does not exist yet */
999         Renew(environ, i+2, char*);     /* just expand it a bit */
1000         environ[i+1] = Nullch;  /* make sure it's null terminated */
1001     }
1002     else
1003         Safefree(environ[i]);
1004     New(904, environ[i], strlen(nam) + strlen(val) + 2, char);
1005 #ifndef MSDOS
1006     (void)sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
1007 #else
1008     /* MS-DOS requires environment variable names to be in uppercase */
1009     /* [Tom Dinger, 27 August 1990: Well, it doesn't _require_ it, but
1010      * some utilities and applications may break because they only look
1011      * for upper case strings. (Fixed strupr() bug here.)]
1012      */
1013     strcpy(environ[i],nam); strupr(environ[i]);
1014     (void)sprintf(environ[i] + strlen(nam),"=%s",val);
1015 #endif /* MSDOS */
1016 }
1017
1018 int
1019 envix(nam)
1020 char *nam;
1021 {
1022     register int i, len = strlen(nam);
1023
1024     for (i = 0; environ[i]; i++) {
1025         if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
1026             break;                      /* strnEQ must come first to avoid */
1027     }                                   /* potential SEGV's */
1028     return i;
1029 }
1030
1031 #ifdef EUNICE
1032 unlnk(f)        /* unlink all versions of a file */
1033 char *f;
1034 {
1035     int i;
1036
1037     for (i = 0; unlink(f) >= 0; i++) ;
1038     return i ? 0 : -1;
1039 }
1040 #endif
1041
1042 #ifndef HAS_MEMCPY
1043 #ifndef HAS_BCOPY
1044 char *
1045 bcopy(from,to,len)
1046 register char *from;
1047 register char *to;
1048 register int len;
1049 {
1050     char *retval = to;
1051
1052     while (len--)
1053         *to++ = *from++;
1054     return retval;
1055 }
1056 #endif
1057
1058 #ifndef HAS_BZERO
1059 char *
1060 bzero(loc,len)
1061 register char *loc;
1062 register int len;
1063 {
1064     char *retval = loc;
1065
1066     while (len--)
1067         *loc++ = 0;
1068     return retval;
1069 }
1070 #endif
1071 #endif
1072
1073 #ifdef I_VARARGS
1074 #ifndef HAS_VPRINTF
1075
1076 #ifdef CHARVSPRINTF
1077 char *
1078 #else
1079 int
1080 #endif
1081 vsprintf(dest, pat, args)
1082 char *dest, *pat, *args;
1083 {
1084     FILE fakebuf;
1085
1086     fakebuf._ptr = dest;
1087     fakebuf._cnt = 32767;
1088 #ifndef _IOSTRG
1089 #define _IOSTRG 0
1090 #endif
1091     fakebuf._flag = _IOWRT|_IOSTRG;
1092     _doprnt(pat, args, &fakebuf);       /* what a kludge */
1093     (void)putc('\0', &fakebuf);
1094 #ifdef CHARVSPRINTF
1095     return(dest);
1096 #else
1097     return 0;           /* perl doesn't use return value */
1098 #endif
1099 }
1100
1101 #ifdef DEBUGGING
1102 int
1103 vfprintf(fd, pat, args)
1104 FILE *fd;
1105 char *pat, *args;
1106 {
1107     _doprnt(pat, args, fd);
1108     return 0;           /* wrong, but perl doesn't use the return value */
1109 }
1110 #endif
1111 #endif /* HAS_VPRINTF */
1112 #endif /* I_VARARGS */
1113
1114 #ifdef MYSWAP
1115 #if BYTEORDER != 0x4321
1116 short
1117 my_swap(s)
1118 short s;
1119 {
1120 #if (BYTEORDER & 1) == 0
1121     short result;
1122
1123     result = ((s & 255) << 8) + ((s >> 8) & 255);
1124     return result;
1125 #else
1126     return s;
1127 #endif
1128 }
1129
1130 long
1131 htonl(l)
1132 register long l;
1133 {
1134     union {
1135         long result;
1136         char c[sizeof(long)];
1137     } u;
1138
1139 #if BYTEORDER == 0x1234
1140     u.c[0] = (l >> 24) & 255;
1141     u.c[1] = (l >> 16) & 255;
1142     u.c[2] = (l >> 8) & 255;
1143     u.c[3] = l & 255;
1144     return u.result;
1145 #else
1146 #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
1147     fatal("Unknown BYTEORDER\n");
1148 #else
1149     register int o;
1150     register int s;
1151
1152     for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
1153         u.c[o & 0xf] = (l >> s) & 255;
1154     }
1155     return u.result;
1156 #endif
1157 #endif
1158 }
1159
1160 long
1161 ntohl(l)
1162 register long l;
1163 {
1164     union {
1165         long l;
1166         char c[sizeof(long)];
1167     } u;
1168
1169 #if BYTEORDER == 0x1234
1170     u.c[0] = (l >> 24) & 255;
1171     u.c[1] = (l >> 16) & 255;
1172     u.c[2] = (l >> 8) & 255;
1173     u.c[3] = l & 255;
1174     return u.l;
1175 #else
1176 #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
1177     fatal("Unknown BYTEORDER\n");
1178 #else
1179     register int o;
1180     register int s;
1181
1182     u.l = l;
1183     l = 0;
1184     for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
1185         l |= (u.c[o & 0xf] & 255) << s;
1186     }
1187     return l;
1188 #endif
1189 #endif
1190 }
1191
1192 #endif /* BYTEORDER != 0x4321 */
1193 #endif /* HAS_HTONS */
1194
1195 #ifndef MSDOS
1196 FILE *
1197 mypopen(cmd,mode)
1198 char    *cmd;
1199 char    *mode;
1200 {
1201     int p[2];
1202     register int this, that;
1203     register int pid;
1204     STR *str;
1205     int doexec = strNE(cmd,"-");
1206
1207     if (pipe(p) < 0)
1208         return Nullfp;
1209     this = (*mode == 'w');
1210     that = !this;
1211 #ifdef TAINT
1212     if (doexec) {
1213         taintenv();
1214         taintproper("Insecure dependency in exec");
1215     }
1216 #endif
1217     while ((pid = (doexec?vfork():fork())) < 0) {
1218         if (errno != EAGAIN) {
1219             close(p[this]);
1220             if (!doexec)
1221                 fatal("Can't fork");
1222             return Nullfp;
1223         }
1224         sleep(5);
1225     }
1226     if (pid == 0) {
1227 #define THIS that
1228 #define THAT this
1229         close(p[THAT]);
1230         if (p[THIS] != (*mode == 'r')) {
1231             dup2(p[THIS], *mode == 'r');
1232             close(p[THIS]);
1233         }
1234         if (doexec) {
1235 #if !defined(HAS_FCNTL) || !defined(F_SETFD)
1236             int fd;
1237
1238 #ifndef NOFILE
1239 #define NOFILE 20
1240 #endif
1241             for (fd = maxsysfd + 1; fd < NOFILE; fd++)
1242                 close(fd);
1243 #endif
1244             do_exec(cmd);       /* may or may not use the shell */
1245             _exit(1);
1246         }
1247         if (tmpstab = stabent("$",allstabs))
1248             str_numset(STAB_STR(tmpstab),(double)getpid());
1249         forkprocess = 0;
1250         hclear(pidstatus, FALSE);       /* we have no children */
1251         return Nullfp;
1252 #undef THIS
1253 #undef THAT
1254     }
1255     do_execfree();      /* free any memory malloced by child on vfork */
1256     close(p[that]);
1257     if (p[that] < p[this]) {
1258         dup2(p[this], p[that]);
1259         close(p[this]);
1260         p[this] = p[that];
1261     }
1262     str = afetch(fdpid,p[this],TRUE);
1263     str->str_u.str_useful = pid;
1264     forkprocess = pid;
1265     return fdopen(p[this], mode);
1266 }
1267 #endif /* !MSDOS */
1268
1269 #ifdef NOTDEF
1270 dumpfds(s)
1271 char *s;
1272 {
1273     int fd;
1274     struct stat tmpstatbuf;
1275
1276     fprintf(stderr,"%s", s);
1277     for (fd = 0; fd < 32; fd++) {
1278         if (fstat(fd,&tmpstatbuf) >= 0)
1279             fprintf(stderr," %d",fd);
1280     }
1281     fprintf(stderr,"\n");
1282 }
1283 #endif
1284
1285 #ifndef HAS_DUP2
1286 dup2(oldfd,newfd)
1287 int oldfd;
1288 int newfd;
1289 {
1290 #if defined(HAS_FCNTL) && defined(F_DUPFD)
1291     close(newfd);
1292     fcntl(oldfd, F_DUPFD, newfd);
1293 #else
1294     int fdtmp[256];
1295     int fdx = 0;
1296     int fd;
1297
1298     if (oldfd == newfd)
1299         return 0;
1300     close(newfd);
1301     while ((fd = dup(oldfd)) != newfd)  /* good enough for low fd's */
1302         fdtmp[fdx++] = fd;
1303     while (fdx > 0)
1304         close(fdtmp[--fdx]);
1305 #endif
1306 }
1307 #endif
1308
1309 #ifndef MSDOS
1310 int
1311 mypclose(ptr)
1312 FILE *ptr;
1313 {
1314 #ifdef VOIDSIG
1315     void (*hstat)(), (*istat)(), (*qstat)();
1316 #else
1317     int (*hstat)(), (*istat)(), (*qstat)();
1318 #endif
1319     int status;
1320     STR *str;
1321     int pid;
1322
1323     str = afetch(fdpid,fileno(ptr),TRUE);
1324     astore(fdpid,fileno(ptr),Nullstr);
1325     fclose(ptr);
1326     pid = (int)str->str_u.str_useful;
1327     hstat = signal(SIGHUP, SIG_IGN);
1328     istat = signal(SIGINT, SIG_IGN);
1329     qstat = signal(SIGQUIT, SIG_IGN);
1330     pid = wait4pid(pid, &status, 0);
1331     signal(SIGHUP, hstat);
1332     signal(SIGINT, istat);
1333     signal(SIGQUIT, qstat);
1334     return(pid < 0 ? pid : status);
1335 }
1336
1337 int
1338 wait4pid(pid,statusp,flags)
1339 int pid;
1340 int *statusp;
1341 int flags;
1342 {
1343     int result;
1344     STR *str;
1345     char spid[16];
1346
1347     if (!pid)
1348         return -1;
1349 #ifdef HAS_WAIT4
1350     return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
1351 #else
1352 #ifdef HAS_WAITPID
1353     return waitpid(pid,statusp,flags);
1354 #else
1355     if (pid > 0) {
1356         sprintf(spid, "%d", pid);
1357         str = hfetch(pidstatus,spid,strlen(spid),FALSE);
1358         if (str != &str_undef) {
1359             *statusp = (int)str->str_u.str_useful;
1360             hdelete(pidstatus,spid,strlen(spid));
1361             return pid;
1362         }
1363     }
1364     else {
1365         HENT *entry;
1366
1367         hiterinit(pidstatus);
1368         if (entry = hiternext(pidstatus)) {
1369             pid = atoi(hiterkey(entry,statusp));
1370             str = hiterval(entry);
1371             *statusp = (int)str->str_u.str_useful;
1372             sprintf(spid, "%d", pid);
1373             hdelete(pidstatus,spid,strlen(spid));
1374             return pid;
1375         }
1376     }
1377     if (flags)
1378         fatal("Can't do waitpid with flags");
1379     else {
1380         while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
1381             pidgone(result,*statusp);
1382         if (result < 0)
1383             *statusp = -1;
1384     }
1385     return result;
1386 #endif
1387 #endif
1388 }
1389
1390 pidgone(pid,status)
1391 int pid;
1392 int status;
1393 {
1394 #if defined(HAS_WAIT4) || defined(HAS_WAITPID)
1395 #else
1396     register STR *str;
1397     char spid[16];
1398
1399     sprintf(spid, "%d", pid);
1400     str = hfetch(pidstatus,spid,strlen(spid),TRUE);
1401     str->str_u.str_useful = status;
1402 #endif
1403     return;
1404 }
1405 #endif /* !MSDOS */
1406
1407 #ifndef HAS_MEMCMP
1408 memcmp(s1,s2,len)
1409 register unsigned char *s1;
1410 register unsigned char *s2;
1411 register int len;
1412 {
1413     register int tmp;
1414
1415     while (len--) {
1416         if (tmp = *s1++ - *s2++)
1417             return tmp;
1418     }
1419     return 0;
1420 }
1421 #endif /* HAS_MEMCMP */
1422
1423 void
1424 repeatcpy(to,from,len,count)
1425 register char *to;
1426 register char *from;
1427 int len;
1428 register int count;
1429 {
1430     register int todo;
1431     register char *frombase = from;
1432
1433     if (len == 1) {
1434         todo = *from;
1435         while (count-- > 0)
1436             *to++ = todo;
1437         return;
1438     }
1439     while (count-- > 0) {
1440         for (todo = len; todo > 0; todo--) {
1441             *to++ = *from++;
1442         }
1443         from = frombase;
1444     }
1445 }
1446
1447 #ifndef CASTNEGFLOAT
1448 unsigned long
1449 castulong(f)
1450 double f;
1451 {
1452     long along;
1453
1454 #if CASTFLAGS & 2
1455 #   define BIGDOUBLE 2147483648.0
1456     if (f >= BIGDOUBLE)
1457         return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000;
1458 #endif
1459     if (f >= 0.0)
1460         return (unsigned long)f;
1461     along = (long)f;
1462     return (unsigned long)along;
1463 }
1464 #endif
1465
1466 #ifndef HAS_RENAME
1467 int
1468 same_dirent(a,b)
1469 char *a;
1470 char *b;
1471 {
1472     char *fa = rindex(a,'/');
1473     char *fb = rindex(b,'/');
1474     struct stat tmpstatbuf1;
1475     struct stat tmpstatbuf2;
1476 #ifndef MAXPATHLEN
1477 #define MAXPATHLEN 1024
1478 #endif
1479     char tmpbuf[MAXPATHLEN+1];
1480
1481     if (fa)
1482         fa++;
1483     else
1484         fa = a;
1485     if (fb)
1486         fb++;
1487     else
1488         fb = b;
1489     if (strNE(a,b))
1490         return FALSE;
1491     if (fa == a)
1492         strcpy(tmpbuf,".");
1493     else
1494         strncpy(tmpbuf, a, fa - a);
1495     if (stat(tmpbuf, &tmpstatbuf1) < 0)
1496         return FALSE;
1497     if (fb == b)
1498         strcpy(tmpbuf,".");
1499     else
1500         strncpy(tmpbuf, b, fb - b);
1501     if (stat(tmpbuf, &tmpstatbuf2) < 0)
1502         return FALSE;
1503     return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
1504            tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
1505 }
1506 #endif /* !HAS_RENAME */
1507
1508 unsigned long
1509 scanoct(start, len, retlen)
1510 char *start;
1511 int len;
1512 int *retlen;
1513 {
1514     register char *s = start;
1515     register unsigned long retval = 0;
1516
1517     while (len-- && *s >= '0' && *s <= '7') {
1518         retval <<= 3;
1519         retval |= *s++ - '0';
1520     }
1521     *retlen = s - start;
1522     return retval;
1523 }
1524
1525 unsigned long
1526 scanhex(start, len, retlen)
1527 char *start;
1528 int len;
1529 int *retlen;
1530 {
1531     register char *s = start;
1532     register unsigned long retval = 0;
1533     char *tmp;
1534
1535     while (len-- && *s && (tmp = index(hexdigit, *s))) {
1536         retval <<= 4;
1537         retval |= (tmp - hexdigit) & 15;
1538         s++;
1539     }
1540     *retlen = s - start;
1541     return retval;
1542 }