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