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