util.c

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