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