util.c

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