util.c

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