util.c

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