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