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