Change run to runops
[p5sagit/p5-mst-13.2.git] / util.c
diff --git a/util.c b/util.c
index 8f6845a..c8cbc2b 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1,48 +1,16 @@
-/* $RCSfile: util.c,v $$Revision: 4.1 $$Date: 92/08/07 18:29:00 $
+/*    util.c
  *
- *    Copyright (c) 1991, Larry Wall
+ *    Copyright (c) 1991-1994, Larry Wall
  *
  *    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.1  92/08/07  18:29:00  lwall
- * 
- * Revision 4.0.1.6  92/06/11  21:18:47  lwall
- * patch34: boneheaded typo in my_bcopy()
- * 
- * Revision 4.0.1.5  92/06/08  16:08:37  lwall
- * patch20: removed implicit int declarations on functions
- * patch20: Perl now distinguishes overlapped copies from non-overlapped
- * patch20: fixed confusion between a *var's real name and its effective name
- * patch20: bcopy() and memcpy() now tested for overlap safety
- * patch20: added Atari ST portability
- * 
- * Revision 4.0.1.4  91/11/11  16:48:54  lwall
- * patch19: study was busted by 4.018
- * patch19: added little-endian pack/unpack options
- * 
- * Revision 4.0.1.3  91/11/05  19:18:26  lwall
- * patch11: safe malloc code now integrated into Perl's malloc when possible
- * patch11: strchr("little", "longer string") could visit faraway places
- * patch11: warn '-' x 10000 dumped core
- * patch11: forked exec on non-existent program now issues a warning
- * 
- * Revision 4.0.1.2  91/06/07  12:10:42  lwall
- * patch4: new copyright notice
- * patch4: made some allowances for "semi-standard" C
- * patch4: strchr() could blow up searching for null string
- * patch4: taintchecks could improperly modify parent in vfork()
- * patch4: exec would close files even if you cleared close-on-exec flag
- * 
- * Revision 4.0.1.1  91/04/12  09:19:25  lwall
- * patch1: random cleanup in cpp namespace
- * 
- * Revision 4.0  91/03/20  01:56:39  lwall
- * 4.0 baseline.
- * 
  */
-/*SUPPRESS 112*/
+
+/*
+ * "Very useful, no doubt, that was to Saruman; yet it seems that he was
+ * not content."  --Gandalf
+ */
 
 #include "EXTERN.h"
 #include "perl.h"
 #include <signal.h>
 #endif
 
-#ifdef STANDARD_C
+/* 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_LIMITS  /* Needed for cast_xxx() functions below. */
+#  include <limits.h>
+#endif
+
+/* Put this after #includes because fork and vfork prototypes may
+   conflict.
+*/
+#ifndef HAS_VFORK
+#   define vfork fork
+#endif
+
 #ifdef I_FCNTL
 #  include <fcntl.h>
 #endif
 
 #define FLUSH
 
+#ifdef LEAKTEST
+static void xstat _((void));
+#endif
+
 #ifndef safemalloc
 
 /* paranoid version of malloc */
@@ -86,10 +71,6 @@ MEM_SIZE size;
 #endif /* MSDOS */
 {
     char  *ptr;
-#ifndef STANDARD_C
-    char *malloc();
-#endif /* ! STANDARD_C */
-
 #ifdef MSDOS
        if (size > 0xffff) {
                fprintf(stderr, "Allocation too large: %lx\n", size) FLUSH;
@@ -129,9 +110,9 @@ unsigned long size;
 #endif /* MSDOS */
 {
     char *ptr;
-#ifndef STANDARD_C
+#if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE)
     char *realloc();
-#endif /* ! STANDARD_C */
+#endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */
 
 #ifdef MSDOS
        if (size > 0xffff) {
@@ -212,7 +193,8 @@ 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
@@ -251,7 +233,7 @@ cpytill(to,from,fromend,delim,retlen)
 register char *to;
 register char *from;
 register char *fromend;
-register I32 delim;
+register int delim;
 I32 *retlen;
 {
     char *origto = to;
@@ -318,7 +300,7 @@ char *lend;
     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;
@@ -352,7 +334,7 @@ char *lend;
     register I32 first = *little;
     register char *littleend = lend;
 
-    if (!first && little > littleend)
+    if (!first && little >= littleend)
        return bigend;
     bigbeg = big;
     big = bigend - (littleend - little++);
@@ -371,6 +353,48 @@ char *lend;
     return Nullch;
 }
 
+/* Initialize locale (and the fold[] array).*/
+int
+perl_init_i18nl14n(printwarn)  
+    int printwarn;
+{
+    int ok = 1;
+    /* returns
+     *    1 = set ok or not applicable,
+     *    0 = fallback to C locale,
+     *   -1 = fallback to C locale failed
+     */
+#if defined(HAS_SETLOCALE) && defined(LC_CTYPE)
+    char * lang     = getenv("LANG");
+    char * lc_all   = getenv("LC_ALL");
+    char * lc_ctype = getenv("LC_CTYPE");
+    int i;
+
+    if (setlocale(LC_CTYPE, "") == NULL && (lc_all || lc_ctype || lang)) {
+       if (printwarn) {
+           fprintf(stderr, "warning: setlocale(LC_CTYPE, \"\") failed.\n");
+           fprintf(stderr,
+             "warning: LC_ALL = \"%s\", LC_CTYPE = \"%s\", LANG = \"%s\",\n",
+             lc_all   ? lc_all   : "(null)",
+             lc_ctype ? lc_ctype : "(null)",
+             lang     ? lang     : "(null)"
+             );
+           fprintf(stderr, "warning: falling back to the \"C\" locale.\n");
+       }
+       ok = 0;
+       if (setlocale(LC_CTYPE, "C") == NULL)
+           ok = -1;
+    }
+
+    for (i = 0; i < 256; i++) {
+       if (isUPPER(i)) fold[i] = toLOWER(i);
+       else if (isLOWER(i)) fold[i] = toUPPER(i);
+       else fold[i] = i;
+    }
+#endif
+    return ok;
+}
+
 void
 fbm_compile(sv, iflag)
 SV *sv;
@@ -383,6 +407,8 @@ I32 iflag;
     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;
@@ -410,7 +436,7 @@ I32 iflag;
        s--,i++;
     }
     sv_upgrade(sv, SVt_PVBM);
-    sv_magic(sv, 0, 'B', 0, 0);                        /* deep magic */
+    sv_magic(sv, Nullsv, 'B', Nullch, 0);                      /* deep magic */
     SvVALID_on(sv);
 
     s = (unsigned char*)(SvPVX(sv));           /* deeper magic */
@@ -455,10 +481,11 @@ SV *littlestr;
     register unsigned char *oldlittle;
 
     if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) {
-       if (!SvPOK(littlestr) || !SvPVX(littlestr))
+       STRLEN len;
+       char *l = SvPV(littlestr,len);
+       if (!len)
            return (char*)big;
-       return ninstr((char*)big,(char*)bigend,
-               SvPVX(littlestr), SvPVX(littlestr) + SvCUR(littlestr));
+       return ninstr((char*)big,(char*)bigend, l, l + len);
     }
 
     littlelen = SvCUR(littlestr);
@@ -473,12 +500,12 @@ SV *littlestr;
        }
        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;
@@ -661,8 +688,8 @@ SV *littlestr;
 
 I32
 ibcmp(a,b,len)
-register char *a;
-register char *b;
+register U8 *a;
+register U8 *b;
 register I32 len;
 {
     while (len--) {
@@ -680,7 +707,7 @@ register I32 len;
 /* copy a string to a safe spot */
 
 char *
-savestr(sv)
+savepv(sv)
 char *sv;
 {
     register char *newaddr;
@@ -693,7 +720,7 @@ char *sv;
 /* same thing but with a known length */
 
 char *
-nsavestr(sv, len)
+savepvn(sv, len)
 char *sv;
 register I32 len;
 {
@@ -705,7 +732,7 @@ register I32 len;
     return newaddr;
 }
 
-#if !defined(STANDARD_C) && !defined(I_VARARGS)
+#if !defined(I_STDARG) && !defined(I_VARARGS)
 
 /*
  * Fallback on the old hackers way of doing varargs
@@ -718,10 +745,11 @@ char *pat;
 long a1, a2, a3, a4;
 {
     char *s;
+    char *s_start;
     I32 usermess = strEQ(pat,"%s");
     SV *tmpstr;
 
-    s = buf;
+    s = s_start = buf;
     if (usermess) {
        tmpstr = sv_newmortal();
        sv_setpv(tmpstr, (char*)a1);
@@ -741,20 +769,29 @@ long a1, a2, a3, a4;
                  SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
                s += strlen(s);
            }
-           if (last_in_gv &&
-               GvIO(last_in_gv) &&
-               IoLINES(GvIO(last_in_gv)) ) {
+           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(GvIO(last_in_gv)));
+                 (long)IoLINES(GvIOp(last_in_gv)));
                s += strlen(s);
            }
            (void)strcpy(s,".\n");
+           s += 2;
        }
        if (usermess)
            sv_catpv(tmpstr,buf+1);
     }
+
+    if (s - s_start >= sizeof(buf)) {  /* Ooops! */
+       if (usermess)
+           fputs(SvPVX(tmpstr), stderr);
+       else
+           fputs(buf, stderr);
+       fputs("panic: message overflow - memory corrupted!\n",stderr);
+       my_exit(1);
+    }
     if (usermess)
        return SvPVX(tmpstr);
     else
@@ -768,14 +805,37 @@ long a1, a2, a3, a4;
 {
     char *tmps;
     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) {
+       restartop = die_where(message);
+       Siglongjmp(top_env, 3);
+    }
     fputs(message,stderr);
-    (void)fflush(stderr);
-    if (e_fp)
+    (void)Fflush(stderr);
+    if (e_fp) {
+       fclose(e_fp);
+       e_fp = Nullfp;
        (void)UNLINK(e_tmpname);
-    statusvalue >>= 8;
-    my_exit((I32)((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*/
@@ -784,18 +844,33 @@ char *pat;
 long a1, a2, a3, a4;
 {
     char *message;
+    SV *sv;
+    HV *stash;
+    GV *gv;
+    CV *cv;
 
     message = mess(pat,a1,a2,a3,a4);
-    fputs(message,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
-    DEBUG_L(xstat());
+       DEBUG_L(xstat());
 #endif
-    (void)fflush(stderr);
+       (void)Fflush(stderr);
+    }
 }
 
-#else /* !defined(STANDARD_C) && !defined(I_VARARGS) */
+#else /* !defined(I_STDARG) && !defined(I_VARARGS) */
 
-#ifdef STANDARD_C
+#ifdef I_STDARG
 char *
 mess(char *pat, va_list *args)
 #else
@@ -807,17 +882,18 @@ mess(pat, args)
 #endif
 {
     char *s;
+    char *s_start;
     SV *tmpstr;
     I32 usermess;
 #ifndef HAS_VPRINTF
-#ifdef CHARVSPRINTF
+#ifdef USE_CHAR_VSPRINTF
     char *vsprintf();
 #else
     I32 vsprintf();
 #endif
 #endif
 
-    s = buf;
+    s = s_start = buf;
     usermess = strEQ(pat, "%s");
     if (usermess) {
        tmpstr = sv_newmortal();
@@ -839,28 +915,37 @@ mess(pat, args)
                  SvPVX(GvSV(curcop->cop_filegv)), (long)curcop->cop_line);
                s += strlen(s);
            }
-           if (last_in_gv &&
-               GvIO(last_in_gv) &&
-               IoLINES(GvIO(last_in_gv)) ) {
+           if (GvIO(last_in_gv) && IoLINES(GvIOp(last_in_gv))) {
+               bool line_mode = (RsSIMPLE(rs) &&
+                                 SvLEN(rs) == 1 && *SvPVX(rs) == '\n');
                (void)sprintf(s,", <%s> %s %ld",
                  last_in_gv == argvgv ? "" : GvNAME(last_in_gv),
-                 strEQ(rs,"\n") ? "line" : "chunk", 
-                 (long)IoLINES(GvIO(last_in_gv)));
+                 line_mode ? "line" : "chunk", 
+                 (long)IoLINES(GvIOp(last_in_gv)));
                s += strlen(s);
            }
            (void)strcpy(s,".\n");
+           s += 2;
        }
        if (usermess)
            sv_catpv(tmpstr,buf+1);
     }
 
+    if (s - s_start >= sizeof(buf)) {  /* Ooops! */
+       if (usermess)
+           fputs(SvPVX(tmpstr), stderr);
+       else
+           fputs(buf, stderr);
+       fputs("panic: message overflow - memory corrupted!\n",stderr);
+       my_exit(1);
+    }
     if (usermess)
        return SvPVX(tmpstr);
     else
        return buf;
 }
 
-#ifdef STANDARD_C
+#ifdef I_STDARG
 void
 croak(char* pat, ...)
 #else
@@ -872,28 +957,48 @@ croak(pat, va_alist)
 #endif
 {
     va_list args;
-    char *tmps;
     char *message;
+    HV *stash;
+    GV *gv;
+    CV *cv;
 
-#ifdef STANDARD_C
+#ifdef I_STDARG
     va_start(args, pat);
 #else
     va_start(args);
 #endif
     message = mess(pat, &args);
     va_end(args);
-    if (restartop = die_where(message))
-       longjmp(top_env, 3);
+    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) {
+       restartop = die_where(message);
+       Siglongjmp(top_env, 3);
+    }
     fputs(message,stderr);
-    (void)fflush(stderr);
-    if (e_fp)
+    (void)Fflush(stderr);
+    if (e_fp) {
+       fclose(e_fp);
+       e_fp = Nullfp;
        (void)UNLINK(e_tmpname);
-    statusvalue >>= 8;
-    my_exit((I32)((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 STANDARD_C
+#ifdef I_STDARG
 warn(char* pat,...)
 #else
 /*VARARGS0*/
@@ -904,8 +1009,11 @@ warn(pat,va_alist)
 {
     va_list args;
     char *message;
+    HV *stash;
+    GV *gv;
+    CV *cv;
 
-#ifdef STANDARD_C
+#ifdef I_STDARG
     va_start(args, pat);
 #else
     va_start(args);
@@ -913,14 +1021,26 @@ warn(pat,va_alist)
     message = mess(pat, &args);
     va_end(args);
 
-    fputs(message,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
-    DEBUG_L(xstat());
+       DEBUG_L(xstat());
 #endif
-    (void)fflush(stderr);
+       (void)Fflush(stderr);
+    }
 }
-#endif /* !defined(STANDARD_C) && !defined(I_VARARGS) */
+#endif /* !defined(I_STDARG) && !defined(I_VARARGS) */
 
+#ifndef VMS  /* VMS' my_setenv() is in VMS.c */
 void
 my_setenv(nam,val)
 char *nam, *val;
@@ -936,7 +1056,7 @@ char *nam, *val;
        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 */
     }
@@ -979,8 +1099,9 @@ char *nam;
     }                                  /* potential SEGV's */
     return i;
 }
+#endif /* !VMS */
 
-#ifdef EUNICE
+#ifdef UNLINK_ALL_VERSIONS
 I32
 unlnk(f)       /* unlink all versions of a file */
 char *f;
@@ -992,7 +1113,7 @@ char *f;
 }
 #endif
 
-#if !defined(HAS_BCOPY) || !defined(SAFE_BCOPY)
+#if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
 char *
 my_bcopy(from,to,len)
 register char *from;
@@ -1046,10 +1167,10 @@ register I32 len;
 }
 #endif /* HAS_MEMCMP */
 
-#ifdef I_VARARGS
+#if defined(I_STDARG) || defined(I_VARARGS)
 #ifndef HAS_VPRINTF
 
-#ifdef CHARVSPRINTF
+#ifdef USE_CHAR_VSPRINTF
 char *
 #else
 int
@@ -1067,7 +1188,7 @@ char *dest, *pat, *args;
     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 */
@@ -1083,21 +1204,17 @@ char *pat, *args;
     return 0;          /* wrong, but perl doesn't use the return value */
 }
 #endif /* HAS_VPRINTF */
-#endif /* I_VARARGS */
+#endif /* I_VARARGS || I_STDARGS */
 
-/*
- * I think my_swap(), htonl() and ntohl() have never been used.
- * perl.h contains last-chance references to my_swap(), my_htonl()
- * and my_ntohl().  I presume these are the intended functions;
- * but htonl() and ntohl() have the wrong names.  There are no
- * functions my_htonl() and my_ntohl() defined anywhere.
- * -DWS
- */
 #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;
@@ -1110,8 +1227,12 @@ short s;
 }
 
 long
-htonl(l)
+#ifndef CAN_PROTOTYPE
+my_htonl(l)
 register long l;
+#else
+my_htonl(long l)
+#endif
 {
     union {
        long result;
@@ -1140,8 +1261,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;
@@ -1231,7 +1356,8 @@ VTOH(vtohs,short)
 VTOH(vtohl,long)
 #endif
 
-#ifndef DOSISH
+#if  !defined(DOSISH) && !defined(VMS)  /* VMS' my_popen() is in
+                                          VMS.c, same with OS/2. */
 FILE *
 my_popen(cmd,mode)
 char   *cmd;
@@ -1273,7 +1399,7 @@ char      *mode;
            close(p[THIS]);
        }
        if (doexec) {
-#if !defined(HAS_FCNTL) || !defined(FFt_SETFD)
+#if !defined(HAS_FCNTL) || !defined(F_SETFD)
            int fd;
 
 #ifndef NOFILE
@@ -1283,11 +1409,10 @@ char    *mode;
                close(fd);
 #endif
            do_exec(cmd);       /* may or may not use the shell */
-           warn("Can't exec \"%s\": %s", cmd, Strerror(errno));
            _exit(1);
        }
        /*SUPPRESS 560*/
-       if (tmpgv = gv_fetchpv("$",TRUE))
+       if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
            sv_setiv(GvSV(tmpgv),(I32)getpid());
        forkprocess = 0;
        hv_clear(pidstatus);    /* we have no children */
@@ -1303,13 +1428,13 @@ char    *mode;
        p[this] = p[that];
     }
     sv = *av_fetch(fdpid,p[this],TRUE);
-    SvUPGRADE(sv,SVt_IV);
+    (void)SvUPGRADE(sv,SVt_IV);
     SvIVX(sv) = pid;
     forkprocess = pid;
     return fdopen(p[this], mode);
 }
 #else
-#ifdef atarist
+#if defined(atarist)
 FILE *popen();
 FILE *
 my_popen(cmd,mode)
@@ -1322,7 +1447,7 @@ char      *mode;
 
 #endif /* !DOSISH */
 
-#ifdef NOTDEF
+#ifdef DUMP_FDS
 dump_fds(s)
 char *s;
 {
@@ -1331,7 +1456,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");
@@ -1339,46 +1464,47 @@ char *s;
 #endif
 
 #ifndef HAS_DUP2
+int
 dup2(oldfd,newfd)
 int oldfd;
 int newfd;
 {
-#if defined(HAS_FCNTL) && defined(FFt_DUPFD)
+#if defined(HAS_FCNTL) && defined(F_DUPFD)
+    if (oldfd == newfd)
+       return oldfd;
     close(newfd);
-    fcntl(oldfd, FFt_DUPFD, newfd);
+    return fcntl(oldfd, F_DUPFD, newfd);
 #else
     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 DOSISH
+#if  !defined(DOSISH) && !defined(VMS)  /* VMS' my_popen() 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;
-    SV *sv;
+    SV **svp;
     int pid;
 
-    sv = *av_fetch(fdpid,fileno(ptr),TRUE);
-    pid = SvIVX(sv);
-    av_store(fdpid,fileno(ptr),Nullsv);
+    svp = av_fetch(fdpid,fileno(ptr),TRUE);
+    pid = (int)SvIVX(*svp);
+    SvREFCNT_dec(*svp);
+    *svp = &sv_undef;
     fclose(ptr);
 #ifdef UTS
     if(kill(pid, 0) < 0) { return(pid); }   /* HOM 12/23/91 */
@@ -1386,20 +1512,23 @@ FILE *ptr;
     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);
 }
+#endif /* !DOSISH */
 
+#if  !defined(DOSISH) || defined(OS2)
 I32
 wait4pid(pid,statusp,flags)
 int pid;
 int *statusp;
 int flags;
 {
-    I32 result;
     SV *sv;
     SV** svp;
     char spid[16];
@@ -1411,7 +1540,7 @@ int flags;
        svp = hv_fetch(pidstatus,spid,strlen(spid),FALSE);
        if (svp && *svp != &sv_undef) {
            *statusp = SvIVX(*svp);
-           hv_delete(pidstatus,spid,strlen(spid));
+           (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
            return pid;
        }
     }
@@ -1420,29 +1549,32 @@ int flags;
 
        hv_iterinit(pidstatus);
        if (entry = hv_iternext(pidstatus)) {
-           pid = atoi(hv_iterkey(entry,statusp));
+           pid = atoi(hv_iterkey(entry,(I32*)statusp));
            sv = hv_iterval(pidstatus,entry);
            *statusp = SvIVX(sv);
            sprintf(spid, "%d", pid);
-           hv_delete(pidstatus,spid,strlen(spid));
+           (void)hv_delete(pidstatus,spid,strlen(spid),G_DISCARD);
            return pid;
        }
     }
-#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 (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;
+#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
 }
@@ -1459,12 +1591,12 @@ int status;
 
     sprintf(spid, "%d", pid);
     sv = *hv_fetch(pidstatus,spid,strlen(spid),TRUE);
-    SvUPGRADE(sv,SVt_IV);
+    (void)SvUPGRADE(sv,SVt_IV);
     SvIVX(sv) = status;
     return;
 }
 
-#ifdef atarist
+#if defined(atarist) || defined(OS2)
 int pclose();
 I32
 my_pclose(ptr)
@@ -1519,20 +1651,75 @@ double f;
 #endif
 
 #ifndef CASTI32
+
+/* Look for MAX and MIN integral values.  If we can't find them,
+   we'll use 32-bit two's complement defaults.
+*/
+#ifndef LONG_MAX
+#  ifdef MAXLONG    /* Often used in <values.h> */
+#    define LONG_MAX MAXLONG
+#  else
+#    define LONG_MAX        2147483647L
+#  endif
+#endif
+
+#ifndef LONG_MIN
+#    define LONG_MIN        (-LONG_MAX - 1)
+#endif
+
+#ifndef ULONG_MAX
+#  ifdef MAXULONG 
+#    define LONG_MAX MAXULONG
+#  else
+#    define ULONG_MAX       4294967295L
+#  endif
+#endif
+
+/* Unfortunately, on some systems the cast_uv() function doesn't
+   work with the system-supplied definition of ULONG_MAX.  The
+   comparison  (f >= ULONG_MAX) always comes out true.  It must be a
+   problem with the compiler constant folding.
+
+   In any case, this workaround should be fine on any two's complement
+   system.  If it's not, supply a '-DMY_ULONG_MAX=whatever' in your
+   ccflags.
+              --Andy Dougherty      <doughera@lafcol.lafayette.edu>
+*/
+#ifndef MY_ULONG_MAX
+#  define MY_ULONG_MAX ((UV)LONG_MAX * (UV)2 + (UV)1)
+#endif
+
 I32
 cast_i32(f)
 double f;
 {
-#   define BIGDOUBLE 2147483648.0        /* Assume 32 bit int's ! */
-#   define BIGNEGDOUBLE (-2147483648.0)
-    if (f >= BIGDOUBLE)
-       return (I32)fmod(f, BIGDOUBLE);
-    if (f <= BIGNEGDOUBLE)
-       return (I32)fmod(f, BIGNEGDOUBLE);
+    if (f >= LONG_MAX)
+       return (I32) LONG_MAX;
+    if (f <= LONG_MIN)
+       return (I32) LONG_MIN;
     return (I32) f;
 }
-# undef BIGDOUBLE
-# undef BIGNEGDOUBLE
+
+IV
+cast_iv(f)
+double f;
+{
+    if (f >= LONG_MAX)
+       return (IV) LONG_MAX;
+    if (f <= LONG_MIN)
+       return (IV) LONG_MIN;
+    return (IV) f;
+}
+
+UV
+cast_uv(f)
+double f;
+{
+    if (f >= MY_ULONG_MAX)
+       return (UV) MY_ULONG_MAX;
+    return (UV) f;
+}
+
 #endif
 
 #ifndef HAS_RENAME
@@ -1564,13 +1751,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;
@@ -1586,10 +1773,13 @@ 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;
 }