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