perl 3.0 patch #7 (combined patch)
[p5sagit/p5-mst-13.2.git] / util.c
CommitLineData
ffed7fef 1/* $Header: util.c,v 3.0.1.2 89/11/17 15:46:35 lwall Locked $
a687059c 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 7 *
8 * $Log: util.c,v $
ffed7fef 9 * Revision 3.0.1.2 89/11/17 15:46:35 lwall
10 * patch5: BZERO separate from BCOPY now
11 * patch5: byteorder now is a hex value
12 *
ae986130 13 * Revision 3.0.1.1 89/11/11 05:06:13 lwall
14 * patch2: made dup2 a little better
15 *
a687059c 16 * Revision 3.0 89/10/18 15:32:43 lwall
17 * 3.0 baseline
8d063cd8 18 *
19 */
20
8d063cd8 21#include "EXTERN.h"
8d063cd8 22#include "perl.h"
a687059c 23#include "errno.h"
24#include <signal.h>
25
26#ifdef I_VFORK
27# include <vfork.h>
28#endif
29
30#ifdef I_VARARGS
31# include <varargs.h>
32#endif
8d063cd8 33
34#define FLUSH
8d063cd8 35
36static char nomem[] = "Out of memory!\n";
37
38/* paranoid version of malloc */
39
378cc40b 40#ifdef DEBUGGING
8d063cd8 41static int an = 0;
378cc40b 42#endif
8d063cd8 43
a687059c 44/* NOTE: Do not call the next three routines directly. Use the macros
45 * in handy.h, so that we can easily redefine everything to do tracking of
46 * allocated hunks back to the original New to track down any memory leaks.
47 */
48
8d063cd8 49char *
50safemalloc(size)
51MEM_SIZE size;
52{
53 char *ptr;
54 char *malloc();
55
56 ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
57#ifdef DEBUGGING
a687059c 58# ifndef I286
8d063cd8 59 if (debug & 128)
60 fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size);
a687059c 61# else
62 if (debug & 128)
63 fprintf(stderr,"0x%lx: (%05d) malloc %d bytes\n",ptr,an++,size);
64# endif
8d063cd8 65#endif
66 if (ptr != Nullch)
67 return ptr;
68 else {
69 fputs(nomem,stdout) FLUSH;
70 exit(1);
71 }
72 /*NOTREACHED*/
a687059c 73#ifdef lint
74 return ptr;
75#endif
8d063cd8 76}
77
78/* paranoid version of realloc */
79
80char *
81saferealloc(where,size)
82char *where;
83MEM_SIZE size;
84{
85 char *ptr;
86 char *realloc();
87
378cc40b 88 if (!where)
89 fatal("Null realloc");
8d063cd8 90 ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
91#ifdef DEBUGGING
a687059c 92# ifndef I286
8d063cd8 93 if (debug & 128) {
94 fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
95 fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size);
96 }
a687059c 97# else
98 if (debug & 128) {
99 fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
100 fprintf(stderr,"0x%lx: (%05d) realloc %d bytes\n",ptr,an++,size);
101 }
102# endif
8d063cd8 103#endif
104 if (ptr != Nullch)
105 return ptr;
106 else {
107 fputs(nomem,stdout) FLUSH;
108 exit(1);
109 }
110 /*NOTREACHED*/
a687059c 111#ifdef lint
112 return ptr;
113#endif
8d063cd8 114}
115
116/* safe version of free */
117
a687059c 118void
8d063cd8 119safefree(where)
120char *where;
121{
122#ifdef DEBUGGING
a687059c 123# ifndef I286
8d063cd8 124 if (debug & 128)
125 fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
a687059c 126# else
127 if (debug & 128)
128 fprintf(stderr,"0x%lx: (%05d) free\n",where,an++);
129# endif
8d063cd8 130#endif
378cc40b 131 if (where) {
132 free(where);
133 }
8d063cd8 134}
135
a687059c 136#ifdef LEAKTEST
137
138#define ALIGN sizeof(long)
8d063cd8 139
140char *
a687059c 141safexmalloc(x,size)
142int x;
143MEM_SIZE size;
8d063cd8 144{
a687059c 145 register char *where;
8d063cd8 146
a687059c 147 where = safemalloc(size + ALIGN);
148 xcount[x]++;
149 where[0] = x % 100;
150 where[1] = x / 100;
151 return where + ALIGN;
8d063cd8 152}
8d063cd8 153
154char *
a687059c 155safexrealloc(where,size)
156char *where;
157MEM_SIZE size;
158{
159 return saferealloc(where - ALIGN, size + ALIGN) + ALIGN;
160}
161
162void
163safexfree(where)
164char *where;
165{
166 int x;
167
168 if (!where)
169 return;
170 where -= ALIGN;
171 x = where[0] + 100 * where[1];
172 xcount[x]--;
173 safefree(where);
174}
175
176xstat()
8d063cd8 177{
a687059c 178 register int i;
8d063cd8 179
a687059c 180 for (i = 0; i < MAXXCOUNT; i++) {
181 if (xcount[i] != lastxcount[i]) {
182 fprintf(stderr,"%2d %2d\t%ld\n", i / 100, i % 100, xcount[i]);
183 lastxcount[i] = xcount[i];
8d063cd8 184 }
185 }
8d063cd8 186}
a687059c 187
188#endif /* LEAKTEST */
8d063cd8 189
190/* copy a string up to some (non-backslashed) delimiter, if any */
191
192char *
a687059c 193cpytill(to,from,fromend,delim,retlen)
8d063cd8 194register char *to, *from;
a687059c 195register char *fromend;
8d063cd8 196register int delim;
a687059c 197int *retlen;
8d063cd8 198{
a687059c 199 char *origto = to;
200
201 for (; from < fromend; from++,to++) {
378cc40b 202 if (*from == '\\') {
203 if (from[1] == delim)
204 from++;
205 else if (from[1] == '\\')
206 *to++ = *from++;
207 }
8d063cd8 208 else if (*from == delim)
209 break;
210 *to = *from;
211 }
212 *to = '\0';
a687059c 213 *retlen = to - origto;
8d063cd8 214 return from;
215}
216
217/* return ptr to little string in big string, NULL if not found */
378cc40b 218/* This routine was donated by Corey Satten. */
8d063cd8 219
220char *
221instr(big, little)
378cc40b 222register char *big;
223register char *little;
224{
225 register char *s, *x;
a687059c 226 register int first;
378cc40b 227
a687059c 228 if (!little)
229 return big;
230 first = *little++;
378cc40b 231 if (!first)
232 return big;
233 while (*big) {
234 if (*big++ != first)
235 continue;
236 for (x=big,s=little; *s; /**/ ) {
237 if (!*x)
238 return Nullch;
239 if (*s++ != *x++) {
240 s--;
241 break;
242 }
243 }
244 if (!*s)
245 return big-1;
246 }
247 return Nullch;
248}
8d063cd8 249
a687059c 250/* same as instr but allow embedded nulls */
251
252char *
253ninstr(big, bigend, little, lend)
254register char *big;
255register char *bigend;
256char *little;
257char *lend;
8d063cd8 258{
a687059c 259 register char *s, *x;
260 register int first = *little;
261 register char *littleend = lend;
378cc40b 262
a687059c 263 if (!first && little > littleend)
264 return big;
265 bigend -= littleend - little++;
266 while (big <= bigend) {
267 if (*big++ != first)
268 continue;
269 for (x=big,s=little; s < littleend; /**/ ) {
270 if (*s++ != *x++) {
271 s--;
272 break;
273 }
274 }
275 if (s >= littleend)
276 return big-1;
378cc40b 277 }
a687059c 278 return Nullch;
279}
280
281/* reverse of the above--find last substring */
282
283char *
284rninstr(big, bigend, little, lend)
285register char *big;
286char *bigend;
287char *little;
288char *lend;
289{
290 register char *bigbeg;
291 register char *s, *x;
292 register int first = *little;
293 register char *littleend = lend;
294
295 if (!first && little > littleend)
296 return bigend;
297 bigbeg = big;
298 big = bigend - (littleend - little++);
299 while (big >= bigbeg) {
300 if (*big-- != first)
301 continue;
302 for (x=big+2,s=little; s < littleend; /**/ ) {
303 if (*s++ != *x++) {
304 s--;
305 break;
306 }
307 }
308 if (s >= littleend)
309 return big+1;
378cc40b 310 }
a687059c 311 return Nullch;
378cc40b 312}
a687059c 313
314unsigned char fold[] = {
315 0, 1, 2, 3, 4, 5, 6, 7,
316 8, 9, 10, 11, 12, 13, 14, 15,
317 16, 17, 18, 19, 20, 21, 22, 23,
318 24, 25, 26, 27, 28, 29, 30, 31,
319 32, 33, 34, 35, 36, 37, 38, 39,
320 40, 41, 42, 43, 44, 45, 46, 47,
321 48, 49, 50, 51, 52, 53, 54, 55,
322 56, 57, 58, 59, 60, 61, 62, 63,
323 64, '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', 91, 92, 93, 94, 95,
327 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G',
328 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
329 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
330 'X', 'Y', 'Z', 123, 124, 125, 126, 127,
331 128, 129, 130, 131, 132, 133, 134, 135,
332 136, 137, 138, 139, 140, 141, 142, 143,
333 144, 145, 146, 147, 148, 149, 150, 151,
334 152, 153, 154, 155, 156, 157, 158, 159,
335 160, 161, 162, 163, 164, 165, 166, 167,
336 168, 169, 170, 171, 172, 173, 174, 175,
337 176, 177, 178, 179, 180, 181, 182, 183,
338 184, 185, 186, 187, 188, 189, 190, 191,
339 192, 193, 194, 195, 196, 197, 198, 199,
340 200, 201, 202, 203, 204, 205, 206, 207,
341 208, 209, 210, 211, 212, 213, 214, 215,
342 216, 217, 218, 219, 220, 221, 222, 223,
343 224, 225, 226, 227, 228, 229, 230, 231,
344 232, 233, 234, 235, 236, 237, 238, 239,
345 240, 241, 242, 243, 244, 245, 246, 247,
346 248, 249, 250, 251, 252, 253, 254, 255
347};
378cc40b 348
349static unsigned char freq[] = {
350 1, 2, 84, 151, 154, 155, 156, 157,
351 165, 246, 250, 3, 158, 7, 18, 29,
352 40, 51, 62, 73, 85, 96, 107, 118,
353 129, 140, 147, 148, 149, 150, 152, 153,
354 255, 182, 224, 205, 174, 176, 180, 217,
355 233, 232, 236, 187, 235, 228, 234, 226,
356 222, 219, 211, 195, 188, 193, 185, 184,
357 191, 183, 201, 229, 181, 220, 194, 162,
358 163, 208, 186, 202, 200, 218, 198, 179,
359 178, 214, 166, 170, 207, 199, 209, 206,
360 204, 160, 212, 216, 215, 192, 175, 173,
361 243, 172, 161, 190, 203, 189, 164, 230,
362 167, 248, 227, 244, 242, 255, 241, 231,
363 240, 253, 169, 210, 245, 237, 249, 247,
364 239, 168, 252, 251, 254, 238, 223, 221,
365 213, 225, 177, 197, 171, 196, 159, 4,
366 5, 6, 8, 9, 10, 11, 12, 13,
367 14, 15, 16, 17, 19, 20, 21, 22,
368 23, 24, 25, 26, 27, 28, 30, 31,
369 32, 33, 34, 35, 36, 37, 38, 39,
370 41, 42, 43, 44, 45, 46, 47, 48,
371 49, 50, 52, 53, 54, 55, 56, 57,
372 58, 59, 60, 61, 63, 64, 65, 66,
373 67, 68, 69, 70, 71, 72, 74, 75,
374 76, 77, 78, 79, 80, 81, 82, 83,
375 86, 87, 88, 89, 90, 91, 92, 93,
376 94, 95, 97, 98, 99, 100, 101, 102,
377 103, 104, 105, 106, 108, 109, 110, 111,
378 112, 113, 114, 115, 116, 117, 119, 120,
379 121, 122, 123, 124, 125, 126, 127, 128,
380 130, 131, 132, 133, 134, 135, 136, 137,
381 138, 139, 141, 142, 143, 144, 145, 146
382};
8d063cd8 383
378cc40b 384void
a687059c 385fbmcompile(str, iflag)
378cc40b 386STR *str;
a687059c 387int iflag;
378cc40b 388{
a687059c 389 register unsigned char *s;
390 register unsigned char *table;
378cc40b 391 register int i;
392 register int len = str->str_cur;
393 int rarest = 0;
394 int frequency = 256;
395
a687059c 396 str_grow(str,len+258);
397#ifndef lint
398 table = (unsigned char*)(str->str_ptr + len + 1);
399#else
400 table = Null(unsigned char*);
401#endif
402 s = table - 2;
403 for (i = 0; i < 256; i++) {
378cc40b 404 table[i] = len;
405 }
406 i = 0;
a687059c 407#ifndef lint
408 while (s >= (unsigned char*)(str->str_ptr))
409#endif
410 {
411 if (table[*s] == len) {
412#ifndef pdp11
413 if (iflag)
414 table[*s] = table[fold[*s]] = i;
415#else
416 if (iflag) {
417 int j;
418 j = fold[*s];
419 table[j] = i;
420 table[*s] = i;
421 }
422#endif /* pdp11 */
423 else
424 table[*s] = i;
425 }
378cc40b 426 s--,i++;
427 }
a687059c 428 str->str_pok |= SP_FBM; /* deep magic */
378cc40b 429
a687059c 430#ifndef lint
431 s = (unsigned char*)(str->str_ptr); /* deeper magic */
432#else
433 s = Null(unsigned char*);
434#endif
435 if (iflag) {
436 register int tmp, foldtmp;
437 str->str_pok |= SP_CASEFOLD;
438 for (i = 0; i < len; i++) {
439 tmp=freq[s[i]];
440 foldtmp=freq[fold[s[i]]];
441 if (tmp < frequency && foldtmp < frequency) {
442 rarest = i;
443 /* choose most frequent among the two */
444 frequency = (tmp > foldtmp) ? tmp : foldtmp;
445 }
446 }
447 }
448 else {
449 for (i = 0; i < len; i++) {
450 if (freq[s[i]] < frequency) {
451 rarest = i;
452 frequency = freq[s[i]];
453 }
378cc40b 454 }
455 }
456 str->str_rare = s[rarest];
a687059c 457 str->str_state = rarest;
378cc40b 458#ifdef DEBUGGING
459 if (debug & 512)
a687059c 460 fprintf(stderr,"rarest char %c at %d\n",str->str_rare, str->str_state);
378cc40b 461#endif
462}
463
378cc40b 464char *
465fbminstr(big, bigend, littlestr)
a687059c 466unsigned char *big;
467register unsigned char *bigend;
378cc40b 468STR *littlestr;
469{
a687059c 470 register unsigned char *s;
378cc40b 471 register int tmp;
472 register int littlelen;
a687059c 473 register unsigned char *little;
474 register unsigned char *table;
475 register unsigned char *olds;
476 register unsigned char *oldlittle;
378cc40b 477
a687059c 478#ifndef lint
479 if (!(littlestr->str_pok & SP_FBM))
480 return instr((char*)big,littlestr->str_ptr);
481#endif
378cc40b 482
483 littlelen = littlestr->str_cur;
a687059c 484#ifndef lint
485 if (littlestr->str_pok & SP_TAIL && !multiline) { /* tail anchored? */
486 little = (unsigned char*)littlestr->str_ptr;
487 if (littlestr->str_pok & SP_CASEFOLD) { /* oops, fake it */
488 big = bigend - littlelen; /* just start near end */
489 if (bigend[-1] == '\n' && little[littlelen-1] != '\n')
490 big--;
378cc40b 491 }
492 else {
a687059c 493 s = bigend - littlelen;
494 if (*s == *little && bcmp(s,little,littlelen)==0)
495 return (char*)s; /* how sweet it is */
496 else if (bigend[-1] == '\n' && little[littlelen-1] != '\n') {
497 s--;
498 if (*s == *little && bcmp(s,little,littlelen)==0)
499 return (char*)s;
500 }
501 return Nullch;
502 }
503 }
504 table = (unsigned char*)(littlestr->str_ptr + littlelen + 1);
505#else
506 table = Null(unsigned char*);
507#endif
508 s = big + --littlelen;
509 oldlittle = little = table - 2;
510 if (littlestr->str_pok & SP_CASEFOLD) { /* case insensitive? */
511 while (s < bigend) {
512 top1:
513 if (tmp = table[*s]) {
514 s += tmp;
515 }
516 else {
517 tmp = littlelen; /* less expensive than calling strncmp() */
518 olds = s;
519 while (tmp--) {
520 if (*--s == *--little || fold[*s] == *little)
521 continue;
522 s = olds + 1; /* here we pay the price for failure */
523 little = oldlittle;
524 if (s < bigend) /* fake up continue to outer loop */
525 goto top1;
526 return Nullch;
527 }
528#ifndef lint
529 return (char *)s;
530#endif
531 }
532 }
533 }
534 else {
535 while (s < bigend) {
536 top2:
537 if (tmp = table[*s]) {
538 s += tmp;
539 }
540 else {
541 tmp = littlelen; /* less expensive than calling strncmp() */
542 olds = s;
543 while (tmp--) {
544 if (*--s == *--little)
545 continue;
546 s = olds + 1; /* here we pay the price for failure */
547 little = oldlittle;
548 if (s < bigend) /* fake up continue to outer loop */
549 goto top2;
550 return Nullch;
551 }
552#ifndef lint
553 return (char *)s;
554#endif
378cc40b 555 }
378cc40b 556 }
557 }
558 return Nullch;
559}
560
561char *
562screaminstr(bigstr, littlestr)
563STR *bigstr;
564STR *littlestr;
565{
a687059c 566 register unsigned char *s, *x;
567 register unsigned char *big;
378cc40b 568 register int pos;
569 register int previous;
570 register int first;
a687059c 571 register unsigned char *little;
572 register unsigned char *bigend;
573 register unsigned char *littleend;
378cc40b 574
575 if ((pos = screamfirst[littlestr->str_rare]) < 0)
576 return Nullch;
a687059c 577#ifndef lint
578 little = (unsigned char *)(littlestr->str_ptr);
579#else
580 little = Null(unsigned char *);
581#endif
582 littleend = little + littlestr->str_cur;
378cc40b 583 first = *little++;
a687059c 584 previous = littlestr->str_state;
585#ifndef lint
586 big = (unsigned char *)(bigstr->str_ptr);
587#else
588 big = Null(unsigned char*);
589#endif
590 bigend = big + bigstr->str_cur;
378cc40b 591 big -= previous;
592 while (pos < previous) {
a687059c 593#ifndef lint
378cc40b 594 if (!(pos += screamnext[pos]))
a687059c 595#endif
378cc40b 596 return Nullch;
597 }
a687059c 598 if (littlestr->str_pok & SP_CASEFOLD) { /* case insignificant? */
599 do {
600 if (big[pos] != first && big[pos] != fold[first])
601 continue;
602 for (x=big+pos+1,s=little; s < littleend; /**/ ) {
603 if (x >= bigend)
604 return Nullch;
605 if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
606 s--;
607 break;
608 }
609 }
610 if (s == littleend)
611#ifndef lint
612 return (char *)(big+pos);
613#else
8d063cd8 614 return Nullch;
a687059c 615#endif
616 } while (
617#ifndef lint
618 pos += screamnext[pos] /* does this goof up anywhere? */
619#else
620 pos += screamnext[0]
621#endif
622 );
623 }
624 else {
625 do {
626 if (big[pos] != first)
627 continue;
628 for (x=big+pos+1,s=little; s < littleend; /**/ ) {
629 if (x >= bigend)
630 return Nullch;
631 if (*s++ != *x++) {
632 s--;
633 break;
634 }
378cc40b 635 }
a687059c 636 if (s == littleend)
637#ifndef lint
638 return (char *)(big+pos);
639#else
640 return Nullch;
641#endif
642 } while (
643#ifndef lint
644 pos += screamnext[pos]
645#else
646 pos += screamnext[0]
647#endif
648 );
649 }
8d063cd8 650 return Nullch;
651}
652
653/* copy a string to a safe spot */
654
655char *
656savestr(str)
657char *str;
658{
a687059c 659 register char *newaddr;
8d063cd8 660
a687059c 661 New(902,newaddr,strlen(str)+1,char);
8d063cd8 662 (void)strcpy(newaddr,str);
663 return newaddr;
664}
665
a687059c 666/* same thing but with a known length */
667
668char *
669nsavestr(str, len)
670char *str;
671register int len;
672{
673 register char *newaddr;
674
675 New(903,newaddr,len+1,char);
676 (void)bcopy(str,newaddr,len); /* might not be null terminated */
677 newaddr[len] = '\0'; /* is now */
678 return newaddr;
679}
680
8d063cd8 681/* grow a static string to at least a certain length */
682
683void
684growstr(strptr,curlen,newlen)
685char **strptr;
686int *curlen;
687int newlen;
688{
689 if (newlen > *curlen) { /* need more room? */
690 if (*curlen)
a687059c 691 Renew(*strptr,newlen,char);
8d063cd8 692 else
a687059c 693 New(905,*strptr,newlen,char);
8d063cd8 694 *curlen = newlen;
695 }
696}
697
378cc40b 698extern int errno;
699
a687059c 700#ifndef VARARGS
378cc40b 701/*VARARGS1*/
702mess(pat,a1,a2,a3,a4)
703char *pat;
a687059c 704long a1, a2, a3, a4;
378cc40b 705{
706 char *s;
707
a687059c 708 s = buf;
709 (void)sprintf(s,pat,a1,a2,a3,a4);
378cc40b 710 s += strlen(s);
711 if (s[-1] != '\n') {
712 if (line) {
a687059c 713 (void)sprintf(s," at %s line %ld",
378cc40b 714 in_eval?filename:origfilename, (long)line);
715 s += strlen(s);
716 }
717 if (last_in_stab &&
a687059c 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 723 s += strlen(s);
724 }
a687059c 725 (void)strcpy(s,".\n");
378cc40b 726 }
727}
728
8d063cd8 729/*VARARGS1*/
730fatal(pat,a1,a2,a3,a4)
731char *pat;
a687059c 732long a1, a2, a3, a4;
8d063cd8 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 740 longjmp(eval_env,1);
741 }
a687059c 742 fputs(buf,stderr);
743 (void)fflush(stderr);
8d063cd8 744 if (e_fp)
a687059c 745 (void)UNLINK(e_tmpname);
378cc40b 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 754{
755 mess(pat,a1,a2,a3,a4);
a687059c 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 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 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 866 if (!val) {
867 while (environ[i]) {
868 environ[i] = environ[i+1];
869 i++;
870 }
871 return;
872 }
8d063cd8 873 if (!environ[i]) { /* does not exist yet */
874 if (firstsetenv) { /* need we copy environment? */
875 int j;
a687059c 876 char **tmpenv;
877
878 New(901,tmpenv, i+2, char*);
8d063cd8 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 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 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 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 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 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 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 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 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 1010 } u;
1011
ffed7fef 1012#if BYTEORDER == 0x1234
a687059c 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 1020 fatal("Unknown BYTEORDER\n");
1021#else
1022 register int o;
1023 register int s;
1024
ffed7fef 1025 for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
1026 u.c[o & 0xf] = (l >> s) & 255;
a687059c 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 1040 } u;
1041
ffed7fef 1042#if BYTEORDER == 0x1234
a687059c 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 1050 fatal("Unknown BYTEORDER\n");
1051#else
1052 register int o;
1053 register int s;
1054
1055 u.l = l;
1056 l = 0;
ffed7fef 1057 for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
1058 l |= (u.c[o & 0xf] & 255) << s;
a687059c 1059 }
1060 return l;
1061#endif
1062#endif
1063}
1064
ffed7fef 1065#endif /* BYTEORDER != 0x4321 */
a687059c 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 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 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 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 1143#ifndef DUP2
1144dup2(oldfd,newfd)
1145int oldfd;
1146int newfd;
1147{
ae986130 1148 int fdtmp[10];
1149 int fdx = 0;
1150 int fd;
1151
a687059c 1152 close(newfd);
ae986130 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 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 */