perl5.001 patch.1c
[p5sagit/p5-mst-13.2.git] / util.c
diff --git a/util.c b/util.c
index ca9362c..4a45c5e 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1,14 +1,15 @@
-/* $Header: util.c,v 4.0 91/03/20 01:56:39 lwall Locked $
+/*    util.c
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991-1994, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
- * $Log:       util.c,v $
- * Revision 4.0  91/03/20  01:56:39  lwall
- * 4.0 baseline.
- * 
+ */
+
+/*
+ * "Very useful, no doubt, that was to Saruman; yet it seems that he was
+ * not content."  --Gandalf
  */
 
 #include "EXTERN.h"
 #include <signal.h>
 #endif
 
+/* Omit this -- it causes too much grief on mixed systems.
+#ifdef I_UNISTD
+#  include <unistd.h>
+#endif
+*/
+
 #ifdef I_VFORK
 #  include <vfork.h>
 #endif
 
-#ifdef I_VARARGS
-#  include <varargs.h>
+/* Put this after #includes because fork and vfork prototypes may
+   conflict.
+*/
+#ifndef HAS_VFORK
+#   define vfork fork
 #endif
 
 #ifdef I_FCNTL
 
 #define FLUSH
 
-static char nomem[] = "Out of memory!\n";
+#ifdef LEAKTEST
+static void xstat _((void));
+#endif
 
-/* paranoid version of malloc */
+#ifndef safemalloc
 
-#ifdef DEBUGGING
-static int an = 0;
-#endif
+/* paranoid version of malloc */
 
 /* NOTE:  Do not call the next three routines directly.  Use the macros
  * in handy.h, so that we can easily redefine everything to do tracking of
@@ -56,41 +66,32 @@ unsigned long size;
 MEM_SIZE size;
 #endif /* MSDOS */
 {
-    char *ptr;
-#ifndef __STDC__
-    char *malloc();
-#endif /* ! __STDC__ */
-
+    char  *ptr;
 #ifdef MSDOS
        if (size > 0xffff) {
                fprintf(stderr, "Allocation too large: %lx\n", size) FLUSH;
-               exit(1);
+               my_exit(1);
        }
 #endif /* MSDOS */
 #ifdef DEBUGGING
     if ((long)size < 0)
-       fatal("panic: malloc");
+       croak("panic: malloc");
 #endif
     ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
-#ifdef DEBUGGING
-#  ifndef I286
-    if (debug & 128)
-       fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size);
-#  else
-    if (debug & 128)
-       fprintf(stderr,"0x%lx: (%05d) malloc %d bytes\n",ptr,an++,size);
-#  endif
+#if !(defined(I286) || defined(atarist))
+    DEBUG_m(fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
+#else
+    DEBUG_m(fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",ptr,an++,(long)size));
 #endif
     if (ptr != Nullch)
        return ptr;
+    else if (nomemok)
+       return Nullch;
     else {
-       fputs(nomem,stderr) FLUSH;
-       exit(1);
+       fputs(no_mem,stderr) FLUSH;
+       my_exit(1);
     }
     /*NOTREACHED*/
-#ifdef lint
-    return ptr;
-#endif
 }
 
 /* paranoid version of realloc */
@@ -105,46 +106,45 @@ unsigned long size;
 #endif /* MSDOS */
 {
     char *ptr;
-#ifndef __STDC__
+#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
     char *realloc();
-#endif /* ! __STDC__ */
+#endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */
 
 #ifdef MSDOS
        if (size > 0xffff) {
                fprintf(stderr, "Reallocation too large: %lx\n", size) FLUSH;
-               exit(1);
+               my_exit(1);
        }
 #endif /* MSDOS */
     if (!where)
-       fatal("Null realloc");
+       croak("Null realloc");
 #ifdef DEBUGGING
     if ((long)size < 0)
-       fatal("panic: realloc");
+       croak("panic: realloc");
 #endif
     ptr = realloc(where,size?size:1);  /* realloc(0) is NASTY on our system */
-#ifdef DEBUGGING
-#  ifndef I286
-    if (debug & 128) {
+
+#if !(defined(I286) || defined(atarist))
+    DEBUG_m( {
        fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
-       fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size);
-    }
-#  else
-    if (debug & 128) {
+       fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
+    } )
+#else
+    DEBUG_m( {
        fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
-       fprintf(stderr,"0x%lx: (%05d) realloc %d bytes\n",ptr,an++,size);
-    }
-#  endif
+       fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",ptr,an++,(long)size);
+    } )
 #endif
+
     if (ptr != Nullch)
        return ptr;
+    else if (nomemok)
+       return Nullch;
     else {
-       fputs(nomem,stderr) FLUSH;
-       exit(1);
+       fputs(no_mem,stderr) FLUSH;
+       my_exit(1);
     }
     /*NOTREACHED*/
-#ifdef lint
-    return ptr;
-#endif
 }
 
 /* safe version of free */
@@ -153,27 +153,26 @@ void
 safefree(where)
 char *where;
 {
-#ifdef DEBUGGING
-#  ifndef I286
-    if (debug & 128)
-       fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
-#  else
-    if (debug & 128)
-       fprintf(stderr,"0x%lx: (%05d) free\n",where,an++);
-#  endif
+#if !(defined(I286) || defined(atarist))
+    DEBUG_m( fprintf(stderr,"0x%x: (%05d) free\n",where,an++));
+#else
+    DEBUG_m( fprintf(stderr,"0x%lx: (%05d) free\n",where,an++));
 #endif
     if (where) {
+       /*SUPPRESS 701*/
        free(where);
     }
 }
 
+#endif /* !safemalloc */
+
 #ifdef LEAKTEST
 
 #define ALIGN sizeof(long)
 
 char *
 safexmalloc(x,size)
-int x;
+I32 x;
 MEM_SIZE size;
 {
     register char *where;
@@ -190,14 +189,15 @@ safexrealloc(where,size)
 char *where;
 MEM_SIZE size;
 {
-    return saferealloc(where - ALIGN, size + ALIGN) + ALIGN;
+    register char *new = saferealloc(where - ALIGN, size + ALIGN);
+    return new + ALIGN;
 }
 
 void
 safexfree(where)
 char *where;
 {
-    int x;
+    I32 x;
 
     if (!where)
        return;
@@ -207,12 +207,13 @@ char *where;
     safefree(where);
 }
 
+static void
 xstat()
 {
-    register int i;
+    register I32 i;
 
     for (i = 0; i < MAXXCOUNT; i++) {
-       if (xcount[i] != lastxcount[i]) {
+       if (xcount[i] > lastxcount[i]) {
            fprintf(stderr,"%2d %2d\t%ld\n", i / 100, i % 100, xcount[i]);
            lastxcount[i] = xcount[i];
        }
@@ -229,7 +230,7 @@ register char *to;
 register char *from;
 register char *fromend;
 register int delim;
-int *retlen;
+I32 *retlen;
 {
     char *origto = to;
 
@@ -258,7 +259,7 @@ register char *big;
 register char *little;
 {
     register char *s, *x;
-    register int first;
+    register I32 first;
 
     if (!little)
        return big;
@@ -292,11 +293,13 @@ char *little;
 char *lend;
 {
     register char *s, *x;
-    register int first = *little;
+    register I32 first = *little;
     register char *littleend = lend;
 
-    if (!first && little > littleend)
+    if (!first && little >= littleend)
        return big;
+    if (bigend - big < littleend - little)
+       return Nullch;
     bigend -= littleend - little++;
     while (big <= bigend) {
        if (*big++ != first)
@@ -324,10 +327,10 @@ char *lend;
 {
     register char *bigbeg;
     register char *s, *x;
-    register int first = *little;
+    register I32 first = *little;
     register char *littleend = lend;
 
-    if (!first && little > littleend)
+    if (!first && little >= littleend)
        return bigend;
     bigbeg = big;
     big = bigend - (littleend - little++);
@@ -346,102 +349,28 @@ char *lend;
     return Nullch;
 }
 
-unsigned char fold[] = {
-       0,      1,      2,      3,      4,      5,      6,      7,
-       8,      9,      10,     11,     12,     13,     14,     15,
-       16,     17,     18,     19,     20,     21,     22,     23,
-       24,     25,     26,     27,     28,     29,     30,     31,
-       32,     33,     34,     35,     36,     37,     38,     39,
-       40,     41,     42,     43,     44,     45,     46,     47,
-       48,     49,     50,     51,     52,     53,     54,     55,
-       56,     57,     58,     59,     60,     61,     62,     63,
-       64,     'a',    'b',    'c',    'd',    'e',    'f',    'g',
-       'h',    'i',    'j',    'k',    'l',    'm',    'n',    'o',
-       'p',    'q',    'r',    's',    't',    'u',    'v',    'w',
-       'x',    'y',    'z',    91,     92,     93,     94,     95,
-       96,     'A',    'B',    'C',    'D',    'E',    'F',    'G',
-       'H',    'I',    'J',    'K',    'L',    'M',    'N',    'O',
-       'P',    'Q',    'R',    'S',    'T',    'U',    'V',    'W',
-       'X',    'Y',    'Z',    123,    124,    125,    126,    127,
-       128,    129,    130,    131,    132,    133,    134,    135,
-       136,    137,    138,    139,    140,    141,    142,    143,
-       144,    145,    146,    147,    148,    149,    150,    151,
-       152,    153,    154,    155,    156,    157,    158,    159,
-       160,    161,    162,    163,    164,    165,    166,    167,
-       168,    169,    170,    171,    172,    173,    174,    175,
-       176,    177,    178,    179,    180,    181,    182,    183,
-       184,    185,    186,    187,    188,    189,    190,    191,
-       192,    193,    194,    195,    196,    197,    198,    199,
-       200,    201,    202,    203,    204,    205,    206,    207,
-       208,    209,    210,    211,    212,    213,    214,    215,
-       216,    217,    218,    219,    220,    221,    222,    223,    
-       224,    225,    226,    227,    228,    229,    230,    231,
-       232,    233,    234,    235,    236,    237,    238,    239,
-       240,    241,    242,    243,    244,    245,    246,    247,
-       248,    249,    250,    251,    252,    253,    254,    255
-};
-
-static unsigned char freq[] = {
-       1,      2,      84,     151,    154,    155,    156,    157,
-       165,    246,    250,    3,      158,    7,      18,     29,
-       40,     51,     62,     73,     85,     96,     107,    118,
-       129,    140,    147,    148,    149,    150,    152,    153,
-       255,    182,    224,    205,    174,    176,    180,    217,
-       233,    232,    236,    187,    235,    228,    234,    226,
-       222,    219,    211,    195,    188,    193,    185,    184,
-       191,    183,    201,    229,    181,    220,    194,    162,
-       163,    208,    186,    202,    200,    218,    198,    179,
-       178,    214,    166,    170,    207,    199,    209,    206,
-       204,    160,    212,    216,    215,    192,    175,    173,
-       243,    172,    161,    190,    203,    189,    164,    230,
-       167,    248,    227,    244,    242,    255,    241,    231,
-       240,    253,    169,    210,    245,    237,    249,    247,
-       239,    168,    252,    251,    254,    238,    223,    221,
-       213,    225,    177,    197,    171,    196,    159,    4,
-       5,      6,      8,      9,      10,     11,     12,     13,
-       14,     15,     16,     17,     19,     20,     21,     22,
-       23,     24,     25,     26,     27,     28,     30,     31,
-       32,     33,     34,     35,     36,     37,     38,     39,
-       41,     42,     43,     44,     45,     46,     47,     48,
-       49,     50,     52,     53,     54,     55,     56,     57,
-       58,     59,     60,     61,     63,     64,     65,     66,
-       67,     68,     69,     70,     71,     72,     74,     75,
-       76,     77,     78,     79,     80,     81,     82,     83,
-       86,     87,     88,     89,     90,     91,     92,     93,
-       94,     95,     97,     98,     99,     100,    101,    102,
-       103,    104,    105,    106,    108,    109,    110,    111,
-       112,    113,    114,    115,    116,    117,    119,    120,
-       121,    122,    123,    124,    125,    126,    127,    128,
-       130,    131,    132,    133,    134,    135,    136,    137,
-       138,    139,    141,    142,    143,    144,    145,    146
-};
-
 void
-fbmcompile(str, iflag)
-STR *str;
-int iflag;
+fbm_compile(sv, iflag)
+SV *sv;
+I32 iflag;
 {
     register unsigned char *s;
     register unsigned char *table;
-    register int i;
-    register int len = str->str_cur;
-    int rarest = 0;
-    unsigned int frequency = 256;
-
-    Str_Grow(str,len+258);
-#ifndef lint
-    table = (unsigned char*)(str->str_ptr + len + 1);
-#else
-    table = Null(unsigned char*);
-#endif
+    register U32 i;
+    register U32 len = SvCUR(sv);
+    I32 rarest = 0;
+    U32 frequency = 256;
+
+    if (len > 255)
+       return;                 /* can't have offsets that big */
+    Sv_Grow(sv,len+258);
+    table = (unsigned char*)(SvPVX(sv) + len + 1);
     s = table - 2;
     for (i = 0; i < 256; i++) {
        table[i] = len;
     }
     i = 0;
-#ifndef lint
-    while (s >= (unsigned char*)(str->str_ptr))
-#endif
+    while (s >= (unsigned char*)(SvPVX(sv)))
     {
        if (table[*s] == len) {
 #ifndef pdp11
@@ -449,7 +378,7 @@ int iflag;
                table[*s] = table[fold[*s]] = i;
 #else
            if (iflag) {
-               int j;
+               I32 j;
                j = fold[*s];
                table[j] = i;
                table[*s] = i;
@@ -460,16 +389,14 @@ int iflag;
        }
        s--,i++;
     }
-    str->str_pok |= SP_FBM;            /* deep magic */
+    sv_upgrade(sv, SVt_PVBM);
+    sv_magic(sv, Nullsv, 'B', Nullch, 0);                      /* deep magic */
+    SvVALID_on(sv);
 
-#ifndef lint
-    s = (unsigned char*)(str->str_ptr);                /* deeper magic */
-#else
-    s = Null(unsigned char*);
-#endif
+    s = (unsigned char*)(SvPVX(sv));           /* deeper magic */
     if (iflag) {
-       register unsigned int tmp, foldtmp;
-       str->str_pok |= SP_CASEFOLD;
+       register U32 tmp, foldtmp;
+       SvCASEFOLD_on(sv);
        for (i = 0; i < len; i++) {
            tmp=freq[s[i]];
            foldtmp=freq[fold[s[i]]];
@@ -488,69 +415,65 @@ int iflag;
            }
        }
     }
-    str->str_rare = s[rarest];
-    str->str_state = rarest;
-#ifdef DEBUGGING
-    if (debug & 512)
-       fprintf(stderr,"rarest char %c at %d\n",str->str_rare, str->str_state);
-#endif
+    BmRARE(sv) = s[rarest];
+    BmPREVIOUS(sv) = rarest;
+    DEBUG_r(fprintf(stderr,"rarest char %c at %d\n",BmRARE(sv),BmPREVIOUS(sv)));
 }
 
 char *
-fbminstr(big, bigend, littlestr)
+fbm_instr(big, bigend, littlestr)
 unsigned char *big;
 register unsigned char *bigend;
-STR *littlestr;
+SV *littlestr;
 {
     register unsigned char *s;
-    register int tmp;
-    register int littlelen;
+    register I32 tmp;
+    register I32 littlelen;
     register unsigned char *little;
     register unsigned char *table;
     register unsigned char *olds;
     register unsigned char *oldlittle;
 
-#ifndef lint
-    if (!(littlestr->str_pok & SP_FBM))
-       return ninstr((char*)big,(char*)bigend,
-               littlestr->str_ptr, littlestr->str_ptr + littlestr->str_cur);
-#endif
+    if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
+       STRLEN len;
+       char *l = SvPV(littlestr,len);
+       if (!len)
+           return (char*)big;
+       return ninstr((char*)big,(char*)bigend, l, l + len);
+    }
 
-    littlelen = littlestr->str_cur;
-#ifndef lint
-    if (littlestr->str_pok & SP_TAIL && !multiline) {  /* tail anchored? */
+    littlelen = SvCUR(littlestr);
+    if (SvTAIL(littlestr) && !multiline) {     /* tail anchored? */
        if (littlelen > bigend - big)
            return Nullch;
-       little = (unsigned char*)littlestr->str_ptr;
-       if (littlestr->str_pok & SP_CASEFOLD) { /* oops, fake it */
+       little = (unsigned char*)SvPVX(littlestr);
+       if (SvCASEFOLD(littlestr)) {    /* oops, fake it */
            big = bigend - littlelen;           /* just start near end */
            if (bigend[-1] == '\n' && little[littlelen-1] != '\n')
                big--;
        }
        else {
            s = bigend - littlelen;
-           if (*s == *little && bcmp(s,little,littlelen)==0)
+           if (*s == *little && bcmp((char*)s,(char*)little,littlelen)==0)
                return (char*)s;                /* how sweet it is */
            else if (bigend[-1] == '\n' && little[littlelen-1] != '\n'
              && s > big) {
                    s--;
-               if (*s == *little && bcmp(s,little,littlelen)==0)
+               if (*s == *little && bcmp((char*)s,(char*)little,littlelen)==0)
                    return (char*)s;
            }
            return Nullch;
        }
     }
-    table = (unsigned char*)(littlestr->str_ptr + littlelen + 1);
-#else
-    table = Null(unsigned char*);
-#endif
+    table = (unsigned char*)(SvPVX(littlestr) + littlelen + 1);
     if (--littlelen >= bigend - big)
        return Nullch;
     s = big + littlelen;
     oldlittle = little = table - 2;
-    if (littlestr->str_pok & SP_CASEFOLD) {    /* case insensitive? */
+    if (SvCASEFOLD(littlestr)) {       /* case insensitive? */
        if (s < bigend) {
          top1:
+           /*SUPPRESS 560*/
            if (tmp = table[*s]) {
 #ifdef POINTERRIGOR
                if (bigend - s > tmp) {
@@ -575,15 +498,14 @@ STR *littlestr;
                        goto top1;
                    return Nullch;
                }
-#ifndef lint
                return (char *)s;
-#endif
            }
        }
     }
     else {
        if (s < bigend) {
          top2:
+           /*SUPPRESS 560*/
            if (tmp = table[*s]) {
 #ifdef POINTERRIGOR
                if (bigend - s > tmp) {
@@ -608,9 +530,7 @@ STR *littlestr;
                        goto top2;
                    return Nullch;
                }
-#ifndef lint
                return (char *)s;
-#endif
            }
        }
     }
@@ -619,42 +539,68 @@ STR *littlestr;
 
 char *
 screaminstr(bigstr, littlestr)
-STR *bigstr;
-STR *littlestr;
+SV *bigstr;
+SV *littlestr;
 {
     register unsigned char *s, *x;
     register unsigned char *big;
-    register int pos;
-    register int previous;
-    register int first;
+    register I32 pos;
+    register I32 previous;
+    register I32 first;
     register unsigned char *little;
     register unsigned char *bigend;
     register unsigned char *littleend;
 
-    if ((pos = screamfirst[littlestr->str_rare]) < 0) 
+    if ((pos = screamfirst[BmRARE(littlestr)]) < 0) 
        return Nullch;
-#ifndef lint
-    little = (unsigned char *)(littlestr->str_ptr);
-#else
-    little = Null(unsigned char *);
-#endif
-    littleend = little + littlestr->str_cur;
+    little = (unsigned char *)(SvPVX(littlestr));
+    littleend = little + SvCUR(littlestr);
     first = *little++;
-    previous = littlestr->str_state;
-#ifndef lint
-    big = (unsigned char *)(bigstr->str_ptr);
-#else
-    big = Null(unsigned char*);
-#endif
-    bigend = big + bigstr->str_cur;
-    big -= previous;
+    previous = BmPREVIOUS(littlestr);
+    big = (unsigned char *)(SvPVX(bigstr));
+    bigend = big + SvCUR(bigstr);
     while (pos < previous) {
-#ifndef lint
        if (!(pos += screamnext[pos]))
-#endif
            return Nullch;
     }
-    if (littlestr->str_pok & SP_CASEFOLD) {    /* case insignificant? */
+#ifdef POINTERRIGOR
+    if (SvCASEFOLD(littlestr)) {       /* case insignificant? */
+       do {
+           if (big[pos-previous] != first && big[pos-previous] != fold[first])
+               continue;
+           for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
+               if (x >= bigend)
+                   return Nullch;
+               if (*s++ != *x++ && fold[*(s-1)] != *(x-1)) {
+                   s--;
+                   break;
+               }
+           }
+           if (s == littleend)
+               return (char *)(big+pos-previous);
+       } while (
+               pos += screamnext[pos]  /* does this goof up anywhere? */
+           );
+    }
+    else {
+       do {
+           if (big[pos-previous] != first)
+               continue;
+           for (x=big+pos+1-previous,s=little; s < littleend; /**/ ) {
+               if (x >= bigend)
+                   return Nullch;
+               if (*s++ != *x++) {
+                   s--;
+                   break;
+               }
+           }
+           if (s == littleend)
+               return (char *)(big+pos-previous);
+       } while ( pos += screamnext[pos] );
+    }
+#else /* !POINTERRIGOR */
+    big -= previous;
+    if (SvCASEFOLD(littlestr)) {       /* case insignificant? */
        do {
            if (big[pos] != first && big[pos] != fold[first])
                continue;
@@ -667,17 +613,9 @@ STR *littlestr;
                }
            }
            if (s == littleend)
-#ifndef lint
                return (char *)(big+pos);
-#else
-               return Nullch;
-#endif
        } while (
-#ifndef lint
                pos += screamnext[pos]  /* does this goof up anywhere? */
-#else
-               pos += screamnext[0]
-#endif
            );
     }
     else {
@@ -693,287 +631,358 @@ STR *littlestr;
                }
            }
            if (s == littleend)
-#ifndef lint
                return (char *)(big+pos);
-#else
-               return Nullch;
-#endif
        } while (
-#ifndef lint
                pos += screamnext[pos]
-#else
-               pos += screamnext[0]
-#endif
            );
     }
+#endif /* POINTERRIGOR */
     return Nullch;
 }
 
+I32
+ibcmp(a,b,len)
+register U8 *a;
+register U8 *b;
+register I32 len;
+{
+    while (len--) {
+       if (*a == *b) {
+           a++,b++;
+           continue;
+       }
+       if (fold[*a++] == *b++)
+           continue;
+       return 1;
+    }
+    return 0;
+}
+
 /* copy a string to a safe spot */
 
 char *
-savestr(str)
-char *str;
+savepv(sv)
+char *sv;
 {
     register char *newaddr;
 
-    New(902,newaddr,strlen(str)+1,char);
-    (void)strcpy(newaddr,str);
+    New(902,newaddr,strlen(sv)+1,char);
+    (void)strcpy(newaddr,sv);
     return newaddr;
 }
 
 /* same thing but with a known length */
 
 char *
-nsavestr(str, len)
-char *str;
-register int len;
+savepvn(sv, len)
+char *sv;
+register I32 len;
 {
     register char *newaddr;
 
     New(903,newaddr,len+1,char);
-    (void)bcopy(str,newaddr,len);      /* might not be null terminated */
+    Copy(sv,newaddr,len,char);         /* might not be null terminated */
     newaddr[len] = '\0';               /* is now */
     return newaddr;
 }
 
-/* grow a static string to at least a certain length */
+#if !defined(I_STDARG) && !defined(I_VARARGS)
 
-void
-growstr(strptr,curlen,newlen)
-char **strptr;
-int *curlen;
-int newlen;
-{
-    if (newlen > *curlen) {            /* need more room? */
-       if (*curlen)
-           Renew(*strptr,newlen,char);
-       else
-           New(905,*strptr,newlen,char);
-       *curlen = newlen;
-    }
-}
+/*
+ * Fallback on the old hackers way of doing varargs
+ */
 
-#ifndef VARARGS
 /*VARARGS1*/
+char *
 mess(pat,a1,a2,a3,a4)
 char *pat;
 long a1, a2, a3, a4;
 {
     char *s;
+    I32 usermess = strEQ(pat,"%s");
+    SV *tmpstr;
 
     s = buf;
-    (void)sprintf(s,pat,a1,a2,a3,a4);
-    s += strlen(s);
+    if (usermess) {
+       tmpstr = sv_newmortal();
+       sv_setpv(tmpstr, (char*)a1);
+       *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
+    }
+    else {
+       (void)sprintf(s,pat,a1,a2,a3,a4);
+       s += strlen(s);
+    }
+
     if (s[-1] != '\n') {
-       if (curcmd->c_line) {
-           (void)sprintf(s," at %s line %ld",
-             stab_val(curcmd->c_filestab)->str_ptr, (long)curcmd->c_line);
-           s += strlen(s);
-       }
-       if (last_in_stab &&
-           stab_io(last_in_stab) &&
-           stab_io(last_in_stab)->lines ) {
-           (void)sprintf(s,", <%s> line %ld",
-             last_in_stab == argvstab ? "" : stab_name(last_in_stab),
-             (long)stab_io(last_in_stab)->lines);
-           s += strlen(s);
+       if (dirty)
+           strcpy(s, " during global destruction.\n");
+       else {
+           if (curcop->cop_line) {
+               (void)sprintf(s," at %s line %ld",
+                 SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
+               s += strlen(s);
+           }
+           if (GvIO(last_in_gv) &&
+               IoLINES(GvIOp(last_in_gv)) ) {
+               (void)sprintf(s,", <%s> %s %ld",
+                 last_in_gv == argvgv ? "" : GvENAME(last_in_gv),
+                 strEQ(rs,"\n") ? "line" : "chunk", 
+                 (long)IoLINES(GvIOp(last_in_gv)));
+               s += strlen(s);
+           }
+           (void)strcpy(s,".\n");
        }
-       (void)strcpy(s,".\n");
+       if (usermess)
+           sv_catpv(tmpstr,buf+1);
     }
+    if (usermess)
+       return SvPVX(tmpstr);
+    else
+       return buf;
 }
 
 /*VARARGS1*/
-fatal(pat,a1,a2,a3,a4)
+void croak(pat,a1,a2,a3,a4)
 char *pat;
 long a1, a2, a3, a4;
 {
-    extern FILE *e_fp;
-    extern char *e_tmpname;
     char *tmps;
-
-    mess(pat,a1,a2,a3,a4);
+    char *message;
+    HV *stash;
+    GV *gv;
+    CV *cv;
+
+    message = mess(pat,a1,a2,a3,a4);
+    if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+       dSP;
+
+       PUSHMARK(sp);
+       EXTEND(sp, 1);
+       PUSHs(sv_2mortal(newSVpv(message,0)));
+       PUTBACK;
+       perl_call_sv((SV*)cv, G_DISCARD);
+    }
     if (in_eval) {
-       str_set(stab_val(stabent("@",TRUE)),buf);
-       tmps = "_EVAL_";
-       while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
-         strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
-#ifdef DEBUGGING
-           if (debug & 4) {
-               deb("(Skipping label #%d %s)\n",loop_ptr,
-                   loop_stack[loop_ptr].loop_label);
-           }
-#endif
-           loop_ptr--;
-       }
-#ifdef DEBUGGING
-       if (debug & 4) {
-           deb("(Found label #%d %s)\n",loop_ptr,
-               loop_stack[loop_ptr].loop_label);
-       }
-#endif
-       if (loop_ptr < 0) {
-           in_eval = 0;
-           fatal("Bad label: %s", tmps);
-       }
-       longjmp(loop_stack[loop_ptr].loop_env, 1);
+       restartop = die_where(message);
+       longjmp(top_env, 3);
     }
-    fputs(buf,stderr);
+    fputs(message,stderr);
     (void)fflush(stderr);
     if (e_fp)
        (void)UNLINK(e_tmpname);
-    statusvalue >>= 8;
-    exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+    statusvalue = SHIFTSTATUS(statusvalue);
+#ifdef VMS
+    my_exit((U32)vaxc$errno?vaxc$errno:errno?errno:statusvalue?statusvalue:SS$_ABORT);
+#else
+    my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+#endif
 }
 
 /*VARARGS1*/
-warn(pat,a1,a2,a3,a4)
+void warn(pat,a1,a2,a3,a4)
 char *pat;
 long a1, a2, a3, a4;
 {
-    mess(pat,a1,a2,a3,a4);
-    fputs(buf,stderr);
+    char *message;
+    SV *sv;
+    HV *stash;
+    GV *gv;
+    CV *cv;
+
+    message = mess(pat,a1,a2,a3,a4);
+    if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+       dSP;
+
+       PUSHMARK(sp);
+       EXTEND(sp, 1);
+       PUSHs(sv_2mortal(newSVpv(message,0)));
+       PUTBACK;
+       perl_call_sv((SV*)cv, G_DISCARD);
+    }
+    else {
+       fputs(message,stderr);
 #ifdef LEAKTEST
-#ifdef DEBUGGING
-    if (debug & 4096)
-       xstat();
+       DEBUG_L(xstat());
 #endif
-#endif
-    (void)fflush(stderr);
+       (void)fflush(stderr);
+    }
 }
+
+#else /* !defined(I_STDARG) && !defined(I_VARARGS) */
+
+#ifdef I_STDARG
+char *
+mess(char *pat, va_list *args)
 #else
 /*VARARGS0*/
-mess(args)
-va_list args;
-{
+char *
+mess(pat, args)
     char *pat;
+    va_list *args;
+#endif
+{
     char *s;
-#ifdef CHARVSPRINTF
+    SV *tmpstr;
+    I32 usermess;
+#ifndef HAS_VPRINTF
+#ifdef USE_CHAR_VSPRINTF
     char *vsprintf();
 #else
-    int vsprintf();
+    I32 vsprintf();
+#endif
 #endif
 
     s = buf;
-#ifdef lint
-    pat = Nullch;
-#else
-    pat = va_arg(args, char *);
-#endif
-    (void) vsprintf(s,pat,args);
+    usermess = strEQ(pat, "%s");
+    if (usermess) {
+       tmpstr = sv_newmortal();
+       sv_setpv(tmpstr, va_arg(*args, char *));
+       *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
+    }
+    else {
+       (void) vsprintf(s,pat,*args);
+       s += strlen(s);
+    }
+    va_end(*args);
 
-    s += strlen(s);
     if (s[-1] != '\n') {
-       if (curcmd->c_line) {
-           (void)sprintf(s," at %s line %ld",
-             stab_val(curcmd->c_filestab)->str_ptr, (long)curcmd->c_line);
-           s += strlen(s);
-       }
-       if (last_in_stab &&
-           stab_io(last_in_stab) &&
-           stab_io(last_in_stab)->lines ) {
-           (void)sprintf(s,", <%s> line %ld",
-             last_in_stab == argvstab ? "" : last_in_stab->str_magic->str_ptr,
-             (long)stab_io(last_in_stab)->lines);
-           s += strlen(s);
+       if (dirty)
+           strcpy(s, " during global destruction.\n");
+       else {
+           if (curcop->cop_line) {
+               (void)sprintf(s," at %s line %ld",
+                 SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
+               s += strlen(s);
+           }
+           if (GvIO(last_in_gv) &&
+               IoLINES(GvIOp(last_in_gv)) ) {
+               (void)sprintf(s,", <%s> %s %ld",
+                 last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
+                 strEQ(rs,"\n") ? "line" : "chunk", 
+                 (long)IoLINES(GvIOp(last_in_gv)));
+               s += strlen(s);
+           }
+           (void)strcpy(s,".\n");
        }
-       (void)strcpy(s,".\n");
+       if (usermess)
+           sv_catpv(tmpstr,buf+1);
     }
+
+    if (usermess)
+       return SvPVX(tmpstr);
+    else
+       return buf;
 }
 
+#ifdef I_STDARG
+void
+croak(char* pat, ...)
+#else
 /*VARARGS0*/
-fatal(va_alist)
-va_dcl
+void
+croak(pat, va_alist)
+    char *pat;
+    va_dcl
+#endif
 {
     va_list args;
-    extern FILE *e_fp;
-    extern char *e_tmpname;
-    char *tmps;
+    char *message;
+    HV *stash;
+    GV *gv;
+    CV *cv;
 
-#ifndef lint
-    va_start(args);
+#ifdef I_STDARG
+    va_start(args, pat);
 #else
-    args = 0;
+    va_start(args);
 #endif
-    mess(args);
+    message = mess(pat, &args);
     va_end(args);
+    if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+       dSP;
+
+       PUSHMARK(sp);
+       EXTEND(sp, 1);
+       PUSHs(sv_2mortal(newSVpv(message,0)));
+       PUTBACK;
+       perl_call_sv((SV*)cv, G_DISCARD);
+    }
     if (in_eval) {
-       str_set(stab_val(stabent("@",TRUE)),buf);
-       tmps = "_EVAL_";
-       while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label ||
-         strNE(tmps,loop_stack[loop_ptr].loop_label) )) {
-#ifdef DEBUGGING
-           if (debug & 4) {
-               deb("(Skipping label #%d %s)\n",loop_ptr,
-                   loop_stack[loop_ptr].loop_label);
-           }
-#endif
-           loop_ptr--;
-       }
-#ifdef DEBUGGING
-       if (debug & 4) {
-           deb("(Found label #%d %s)\n",loop_ptr,
-               loop_stack[loop_ptr].loop_label);
-       }
-#endif
-       if (loop_ptr < 0) {
-           in_eval = 0;
-           fatal("Bad label: %s", tmps);
-       }
-       longjmp(loop_stack[loop_ptr].loop_env, 1);
+       restartop = die_where(message);
+       longjmp(top_env, 3);
     }
-    fputs(buf,stderr);
+    fputs(message,stderr);
     (void)fflush(stderr);
     if (e_fp)
        (void)UNLINK(e_tmpname);
-    statusvalue >>= 8;
-    exit((int)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+    statusvalue = SHIFTSTATUS(statusvalue);
+#ifdef VMS
+    my_exit((U32)(vaxc$errno?vaxc$errno:(statusvalue?statusvalue:44)));
+#else
+    my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
+#endif
 }
 
+void
+#ifdef I_STDARG
+warn(char* pat,...)
+#else
 /*VARARGS0*/
-warn(va_alist)
-va_dcl
+warn(pat,va_alist)
+    char *pat;
+    va_dcl
+#endif
 {
     va_list args;
+    char *message;
+    HV *stash;
+    GV *gv;
+    CV *cv;
 
-#ifndef lint
-    va_start(args);
+#ifdef I_STDARG
+    va_start(args, pat);
 #else
-    args = 0;
+    va_start(args);
 #endif
-    mess(args);
+    message = mess(pat, &args);
     va_end(args);
 
-    fputs(buf,stderr);
+    if (warnhook && (cv = sv_2cv(warnhook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
+       dSP;
+
+       PUSHMARK(sp);
+       EXTEND(sp, 1);
+       PUSHs(sv_2mortal(newSVpv(message,0)));
+       PUTBACK;
+       perl_call_sv((SV*)cv, G_DISCARD);
+    }
+    else {
+       fputs(message,stderr);
 #ifdef LEAKTEST
-#ifdef DEBUGGING
-    if (debug & 4096)
-       xstat();
-#endif
+       DEBUG_L(xstat());
 #endif
-    (void)fflush(stderr);
+       (void)fflush(stderr);
+    }
 }
-#endif
-
-#ifndef __STDC__
-extern char **environ;
-#endif
+#endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
 
+#ifndef VMS  /* VMS' my_setenv() is in VMS.c */
 void
-setenv(nam,val)
+my_setenv(nam,val)
 char *nam, *val;
 {
-    register int i=envix(nam);         /* where does it go? */
+    register I32 i=setenv_getix(nam);          /* where does it go? */
 
     if (environ == origenviron) {      /* need we copy environment? */
-       int j;
-       int max;
+       I32 j;
+       I32 max;
        char **tmpenv;
 
+       /*SUPPRESS 530*/
        for (max = i; environ[max]; max++) ;
        New(901,tmpenv, max+2, char*);
        for (j=0; j<max; j++)           /* copy environment */
-           tmpenv[j] = savestr(environ[j]);
+           tmpenv[j] = savepv(environ[j]);
        tmpenv[max] = Nullch;
        environ = tmpenv;               /* tell exec where it is now */
     }
@@ -1004,11 +1013,11 @@ char *nam, *val;
 #endif /* MSDOS */
 }
 
-int
-envix(nam)
+I32
+setenv_getix(nam)
 char *nam;
 {
-    register int i, len = strlen(nam);
+    register I32 i, len = strlen(nam);
 
     for (i = 0; environ[i]; i++) {
        if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
@@ -1016,39 +1025,48 @@ char *nam;
     }                                  /* potential SEGV's */
     return i;
 }
+#endif /* !VMS */
 
 #ifdef EUNICE
+I32
 unlnk(f)       /* unlink all versions of a file */
 char *f;
 {
-    int i;
+    I32 i;
 
     for (i = 0; unlink(f) >= 0; i++) ;
     return i ? 0 : -1;
 }
 #endif
 
-#ifndef HAS_MEMCPY
-#ifndef HAS_BCOPY
+#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
 char *
-bcopy(from,to,len)
+my_bcopy(from,to,len)
 register char *from;
 register char *to;
-register int len;
+register I32 len;
 {
     char *retval = to;
 
-    while (len--)
-       *to++ = *from++;
+    if (from - to >= 0) {
+       while (len--)
+           *to++ = *from++;
+    }
+    else {
+       to += len;
+       from += len;
+       while (len--)
+           *(--to) = *(--from);
+    }
     return retval;
 }
 #endif
 
-#ifndef HAS_BZERO
+#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
 char *
-bzero(loc,len)
+my_bzero(loc,len)
 register char *loc;
-register int len;
+register I32 len;
 {
     char *retval = loc;
 
@@ -1057,12 +1075,28 @@ register int len;
     return retval;
 }
 #endif
-#endif
 
-#ifdef VARARGS
+#ifndef HAS_MEMCMP
+I32
+my_memcmp(s1,s2,len)
+register unsigned char *s1;
+register unsigned char *s2;
+register I32 len;
+{
+    register I32 tmp;
+
+    while (len--) {
+       if (tmp = *s1++ - *s2++)
+           return tmp;
+    }
+    return 0;
+}
+#endif /* HAS_MEMCMP */
+
+#ifdef I_VARARGS
 #ifndef HAS_VPRINTF
 
-#ifdef CHARVSPRINTF
+#ifdef USE_CHAR_VSPRINTF
 char *
 #else
 int
@@ -1074,17 +1108,19 @@ char *dest, *pat, *args;
 
     fakebuf._ptr = dest;
     fakebuf._cnt = 32767;
+#ifndef _IOSTRG
+#define _IOSTRG 0
+#endif
     fakebuf._flag = _IOWRT|_IOSTRG;
     _doprnt(pat, args, &fakebuf);      /* what a kludge */
     (void)putc('\0', &fakebuf);
-#ifdef CHARVSPRINTF
+#ifdef USE_CHAR_VSPRINTF
     return(dest);
 #else
     return 0;          /* perl doesn't use return value */
 #endif
 }
 
-#ifdef DEBUGGING
 int
 vfprintf(fd, pat, args)
 FILE *fd;
@@ -1093,15 +1129,18 @@ char *pat, *args;
     _doprnt(pat, args, fd);
     return 0;          /* wrong, but perl doesn't use the return value */
 }
-#endif
 #endif /* HAS_VPRINTF */
-#endif /* VARARGS */
+#endif /* I_VARARGS */
 
 #ifdef MYSWAP
 #if BYTEORDER != 0x4321
 short
+#ifndef CAN_PROTOTYPE
 my_swap(s)
 short s;
+#else
+my_swap(short s)
+#endif
 {
 #if (BYTEORDER & 1) == 0
     short result;
@@ -1114,8 +1153,12 @@ short s;
 }
 
 long
-htonl(l)
+#ifndef CAN_PROTOTYPE
+my_htonl(l)
 register long l;
+#else
+my_htonl(long l)
+#endif
 {
     union {
        long result;
@@ -1130,10 +1173,10 @@ register long l;
     return u.result;
 #else
 #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
-    fatal("Unknown BYTEORDER\n");
+    croak("Unknown BYTEORDER\n");
 #else
-    register int o;
-    register int s;
+    register I32 o;
+    register I32 s;
 
     for (o = BYTEORDER - 0x1111, s = 0; s < (sizeof(long)*8); o >>= 4, s += 8) {
        u.c[o & 0xf] = (l >> s) & 255;
@@ -1144,8 +1187,12 @@ register long l;
 }
 
 long
-ntohl(l)
+#ifndef CAN_PROTOTYPE
+my_ntohl(l)
 register long l;
+#else
+my_ntohl(long l)
+#endif
 {
     union {
        long l;
@@ -1160,10 +1207,10 @@ register long l;
     return u.l;
 #else
 #if ((BYTEORDER - 0x1111) & 0x444) || !(BYTEORDER & 0xf)
-    fatal("Unknown BYTEORDER\n");
+    croak("Unknown BYTEORDER\n");
 #else
-    register int o;
-    register int s;
+    register I32 o;
+    register I32 s;
 
     u.l = l;
     l = 0;
@@ -1176,34 +1223,99 @@ register long l;
 }
 
 #endif /* BYTEORDER != 0x4321 */
-#endif /* HAS_HTONS */
+#endif /* MYSWAP */
+
+/*
+ * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
+ * If these functions are defined,
+ * the BYTEORDER is neither 0x1234 nor 0x4321.
+ * However, this is not assumed.
+ * -DWS
+ */
 
-#ifndef MSDOS
+#define HTOV(name,type)                                                \
+       type                                                    \
+       name (n)                                                \
+       register type n;                                        \
+       {                                                       \
+           union {                                             \
+               type value;                                     \
+               char c[sizeof(type)];                           \
+           } u;                                                \
+           register I32 i;                                     \
+           register I32 s;                                     \
+           for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {  \
+               u.c[i] = (n >> s) & 0xFF;                       \
+           }                                                   \
+           return u.value;                                     \
+       }
+
+#define VTOH(name,type)                                                \
+       type                                                    \
+       name (n)                                                \
+       register type n;                                        \
+       {                                                       \
+           union {                                             \
+               type value;                                     \
+               char c[sizeof(type)];                           \
+           } u;                                                \
+           register I32 i;                                     \
+           register I32 s;                                     \
+           u.value = n;                                        \
+           n = 0;                                              \
+           for (i = 0, s = 0; i < sizeof(u.c); i++, s += 8) {  \
+               n += (u.c[i] & 0xFF) << s;                      \
+           }                                                   \
+           return n;                                           \
+       }
+
+#if defined(HAS_HTOVS) && !defined(htovs)
+HTOV(htovs,short)
+#endif
+#if defined(HAS_HTOVL) && !defined(htovl)
+HTOV(htovl,long)
+#endif
+#if defined(HAS_VTOHS) && !defined(vtohs)
+VTOH(vtohs,short)
+#endif
+#if defined(HAS_VTOHL) && !defined(vtohl)
+VTOH(vtohl,long)
+#endif
+
+#if  !defined(DOSISH) && !defined(VMS)  /* VMS' my_popen() is in VMS.c */
 FILE *
-mypopen(cmd,mode)
+my_popen(cmd,mode)
 char   *cmd;
 char   *mode;
 {
     int p[2];
-    register int this, that;
-    register int pid;
-    STR *str;
-    int doexec = strNE(cmd,"-");
+    register I32 this, that;
+    register I32 pid;
+    SV *sv;
+    I32 doexec = strNE(cmd,"-");
 
     if (pipe(p) < 0)
        return Nullfp;
     this = (*mode == 'w');
     that = !this;
+    if (tainting) {
+       if (doexec) {
+           taint_env();
+           taint_proper("Insecure %s%s", "EXEC");
+       }
+    }
     while ((pid = (doexec?vfork():fork())) < 0) {
        if (errno != EAGAIN) {
            close(p[this]);
            if (!doexec)
-               fatal("Can't fork");
+               croak("Can't fork");
            return Nullfp;
        }
        sleep(5);
     }
     if (pid == 0) {
+       GV* tmpgv;
+
 #define THIS that
 #define THAT this
        close(p[THAT]);
@@ -1212,22 +1324,23 @@ char    *mode;
            close(p[THIS]);
        }
        if (doexec) {
-#if !defined(I_FCNTL) || !defined(F_SETFD)
+#if !defined(HAS_FCNTL) || !defined(F_SETFD)
            int fd;
 
 #ifndef NOFILE
 #define NOFILE 20
 #endif
-           for (fd = 3; fd < NOFILE; fd++)
+           for (fd = maxsysfd + 1; fd < NOFILE; fd++)
                close(fd);
 #endif
            do_exec(cmd);       /* may or may not use the shell */
            _exit(1);
        }
-       if (tmpstab = stabent("$",allstabs))
-           str_numset(STAB_STR(tmpstab),(double)getpid());
+       /*SUPPRESS 560*/
+       if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
+           sv_setiv(GvSV(tmpgv),(I32)getpid());
        forkprocess = 0;
-       hclear(pidstatus, FALSE);       /* we have no children */
+       hv_clear(pidstatus);    /* we have no children */
        return Nullfp;
 #undef THIS
 #undef THAT
@@ -1239,15 +1352,28 @@ char    *mode;
        close(p[this]);
        p[this] = p[that];
     }
-    str = afetch(fdpid,p[this],TRUE);
-    str->str_u.str_useful = pid;
+    sv = *av_fetch(fdpid,p[this],TRUE);
+    (void)SvUPGRADE(sv,SVt_IV);
+    SvIVX(sv) = pid;
     forkprocess = pid;
     return fdopen(p[this], mode);
 }
-#endif /* !MSDOS */
+#else
+#ifdef atarist
+FILE *popen();
+FILE *
+my_popen(cmd,mode)
+char   *cmd;
+char   *mode;
+{
+    return popen(cmd, mode);
+}
+#endif
+
+#endif /* !DOSISH */
 
-#ifdef NOTDEF
-dumpfds(s)
+#ifdef DUMP_FDS
+dump_fds(s)
 char *s;
 {
     int fd;
@@ -1255,7 +1381,7 @@ char *s;
 
     fprintf(stderr,"%s", s);
     for (fd = 0; fd < 32; fd++) {
-       if (fstat(fd,&tmpstatbuf) >= 0)
+       if (Fstat(fd,&tmpstatbuf) >= 0)
            fprintf(stderr," %d",fd);
     }
     fprintf(stderr,"\n");
@@ -1263,151 +1389,155 @@ char *s;
 #endif
 
 #ifndef HAS_DUP2
+int
 dup2(oldfd,newfd)
 int oldfd;
 int newfd;
 {
 #if defined(HAS_FCNTL) && defined(F_DUPFD)
+    if (oldfd == newfd)
+       return oldfd;
     close(newfd);
-    fcntl(oldfd, F_DUPFD, newfd);
+    return fcntl(oldfd, F_DUPFD, newfd);
 #else
-    int fdtmp[20];
-    int fdx = 0;
+    int fdtmp[256];
+    I32 fdx = 0;
     int fd;
 
     if (oldfd == newfd)
-       return 0;
+       return oldfd;
     close(newfd);
-    while ((fd = dup(oldfd)) != newfd) /* good enough for low fd's */
+    while ((fd = dup(oldfd)) != newfd && fd >= 0) /* good enough for low fd's */
        fdtmp[fdx++] = fd;
     while (fdx > 0)
        close(fdtmp[--fdx]);
+    return fd;
 #endif
 }
 #endif
 
-#ifndef MSDOS
-int
-mypclose(ptr)
+#ifndef DOSISH
+#ifndef VMS /* VMS' my_pclose() is in VMS.c */
+I32
+my_pclose(ptr)
 FILE *ptr;
 {
-#ifdef VOIDSIG
-    void (*hstat)(), (*istat)(), (*qstat)();
-#else
-    int (*hstat)(), (*istat)(), (*qstat)();
-#endif
+    Signal_t (*hstat)(), (*istat)(), (*qstat)();
     int status;
-    STR *str;
+    SV **svp;
     int pid;
 
-    str = afetch(fdpid,fileno(ptr),TRUE);
-    astore(fdpid,fileno(ptr),Nullstr);
+    svp = av_fetch(fdpid,fileno(ptr),TRUE);
+    pid = (int)SvIVX(*svp);
+    SvREFCNT_dec(*svp);
+    *svp = &sv_undef;
     fclose(ptr);
-    pid = (int)str->str_u.str_useful;
+#ifdef UTS
+    if(kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
+#endif
     hstat = signal(SIGHUP, SIG_IGN);
     istat = signal(SIGINT, SIG_IGN);
     qstat = signal(SIGQUIT, SIG_IGN);
-    pid = wait4pid(pid, &status, 0);
+    do {
+       pid = wait4pid(pid, &status, 0);
+    } while (pid == -1 && errno == EINTR);
     signal(SIGHUP, hstat);
     signal(SIGINT, istat);
     signal(SIGQUIT, qstat);
     return(pid < 0 ? pid : status);
 }
-
-int
+#endif /* !VMS */
+I32
 wait4pid(pid,statusp,flags)
 int pid;
 int *statusp;
 int flags;
 {
-    int result;
-    STR *str;
+    SV *sv;
+    SV** svp;
     char spid[16];
 
     if (!pid)
        return -1;
-#ifdef HAS_WAIT4
-    return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
-#else
-#ifdef HAS_WAITPID
-    return waitpid(pid,statusp,flags);
-#else
     if (pid > 0) {
        sprintf(spid, "%d", pid);
-       str = hfetch(pidstatus,spid,strlen(spid),FALSE);
-       if (str != &str_undef) {
-           *statusp = (int)str->str_u.str_useful;
-           hdelete(pidstatus,spid,strlen(spid));
+       svp = hv_fetch(pidstatus,spid,strlen(spid),FALSE);
+       if (svp && *svp != &sv_undef) {
+           *statusp = SvIVX(*svp);
+           (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
            return pid;
        }
     }
     else {
-       HENT *entry;
+       HE *entry;
 
-       hiterinit(pidstatus);
-       if (entry = hiternext(pidstatus)) {
-           pid = atoi(hiterkey(entry,statusp));
-           str = hiterval(entry);
-           *statusp = (int)str->str_u.str_useful;
+       hv_iterinit(pidstatus);
+       if (entry = hv_iternext(pidstatus)) {
+           pid = atoi(hv_iterkey(entry,(I32*)statusp));
+           sv = hv_iterval(pidstatus,entry);
+           *statusp = SvIVX(sv);
            sprintf(spid, "%d", pid);
-           hdelete(pidstatus,spid,strlen(spid));
+           (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
            return pid;
        }
     }
-    if (flags)
-       fatal("Can't do waitpid with flags");
-    else {
-       while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
-           pidgone(result,*statusp);
-       if (result < 0)
-           *statusp = -1;
+#ifdef HAS_WAITPID
+    return waitpid(pid,statusp,flags);
+#else
+#ifdef HAS_WAIT4
+    return wait4((pid==-1)?0:pid,statusp,flags,Null(struct rusage *));
+#else
+    {
+       I32 result;
+       if (flags)
+           croak("Can't do waitpid with flags");
+       else {
+           while ((result = wait(statusp)) != pid && pid > 0 && result >= 0)
+               pidgone(result,*statusp);
+           if (result < 0)
+               *statusp = -1;
+       }
+       return result;
     }
-    return result;
 #endif
 #endif
 }
+#endif /* !DOSISH */
 
+void
+/*SUPPRESS 590*/
 pidgone(pid,status)
 int pid;
 int status;
 {
-#if defined(HAS_WAIT4) || defined(HAS_WAITPID)
-#else
-    register STR *str;
+    register SV *sv;
     char spid[16];
 
     sprintf(spid, "%d", pid);
-    str = hfetch(pidstatus,spid,strlen(spid),TRUE);
-    str->str_u.str_useful = status;
-#endif
+    sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);
+    (void)SvUPGRADE(sv,SVt_IV);
+    SvIVX(sv) = status;
     return;
 }
-#endif /* !MSDOS */
 
-#ifndef HAS_MEMCMP
-memcmp(s1,s2,len)
-register unsigned char *s1;
-register unsigned char *s2;
-register int len;
+#ifdef atarist
+int pclose();
+I32
+my_pclose(ptr)
+FILE *ptr;
 {
-    register int tmp;
-
-    while (len--) {
-       if (tmp = *s1++ - *s2++)
-           return tmp;
-    }
-    return 0;
+    return pclose(ptr);
 }
-#endif /* HAS_MEMCMP */
+#endif
 
 void
 repeatcpy(to,from,len,count)
 register char *to;
 register char *from;
-int len;
-register int count;
+I32 len;
+register I32 count;
 {
-    register int todo;
+    register I32 todo;
     register char *frombase = from;
 
     if (len == 1) {
@@ -1425,8 +1555,8 @@ register int count;
 }
 
 #ifndef CASTNEGFLOAT
-unsigned long
-castulong(f)
+U32
+cast_ulong(f)
 double f;
 {
     long along;
@@ -1441,16 +1571,50 @@ double f;
     along = (long)f;
     return (unsigned long)along;
 }
+# undef BIGDOUBLE
+#endif
+
+#ifndef CASTI32
+I32
+cast_i32(f)
+double f;
+{
+#   define BIGDOUBLE 2147483647.0        /* Assume 32 bit int's ! */
+#   define BIGNEGDOUBLE (-2147483648.0)
+    if (f >= BIGDOUBLE)
+       return (I32) BIGDOUBLE;
+    if (f <= BIGNEGDOUBLE)
+       return (I32) BIGNEGDOUBLE;
+    return (I32) f;
+}
+# undef BIGDOUBLE
+# undef BIGNEGDOUBLE
+
+IV
+cast_iv(f)
+double f;
+{
+    /* XXX  This should be fixed.  It assumes 32 bit IV's. */
+#   define BIGDOUBLE 2147483647.0        /* Assume 32 bit IV's ! */
+#   define BIGNEGDOUBLE (-2147483648.0)
+    if (f >= BIGDOUBLE)
+       return (IV) BIGDOUBLE;
+    if (f <= BIGNEGDOUBLE)
+       return (IV) BIGNEGDOUBLE;
+    return (IV) f;
+}
+# undef BIGDOUBLE
+# undef BIGNEGDOUBLE
 #endif
 
 #ifndef HAS_RENAME
-int
+I32
 same_dirent(a,b)
 char *a;
 char *b;
 {
-    char *fa = rindex(a,'/');
-    char *fb = rindex(b,'/');
+    char *fa = strrchr(a,'/');
+    char *fb = strrchr(b,'/');
     struct stat tmpstatbuf1;
     struct stat tmpstatbuf2;
 #ifndef MAXPATHLEN
@@ -1472,13 +1636,13 @@ char *b;
        strcpy(tmpbuf,".");
     else
        strncpy(tmpbuf, a, fa - a);
-    if (stat(tmpbuf, &tmpstatbuf1) < 0)
+    if (Stat(tmpbuf, &tmpstatbuf1) < 0)
        return FALSE;
     if (fb == b)
        strcpy(tmpbuf,".");
     else
        strncpy(tmpbuf, b, fb - b);
-    if (stat(tmpbuf, &tmpstatbuf2) < 0)
+    if (Stat(tmpbuf, &tmpstatbuf2) < 0)
        return FALSE;
     return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev &&
           tmpstatbuf1.st_ino == tmpstatbuf2.st_ino;
@@ -1486,33 +1650,36 @@ char *b;
 #endif /* !HAS_RENAME */
 
 unsigned long
-scanoct(start, len, retlen)
+scan_oct(start, len, retlen)
 char *start;
-int len;
-int *retlen;
+I32 len;
+I32 *retlen;
 {
     register char *s = start;
     register unsigned long retval = 0;
 
-    while (len-- && *s >= '0' && *s <= '7') {
+    while (len && *s >= '0' && *s <= '7') {
        retval <<= 3;
        retval |= *s++ - '0';
+       len--;
     }
+    if (dowarn && len && (*s == '8' || *s == '9'))
+       warn("Illegal octal digit ignored");
     *retlen = s - start;
     return retval;
 }
 
 unsigned long
-scanhex(start, len, retlen)
+scan_hex(start, len, retlen)
 char *start;
-int len;
-int *retlen;
+I32 len;
+I32 *retlen;
 {
     register char *s = start;
     register unsigned long retval = 0;
     char *tmp;
 
-    while (len-- && *s && (tmp = index(hexdigit, *s))) {
+    while (len-- && *s && (tmp = strchr(hexdigit, *s))) {
        retval <<= 4;
        retval |= (tmp - hexdigit) & 15;
        s++;