util.c

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