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