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