util.c

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