perl 3.0 patch #17 patch #16, continued
authorLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Tue, 27 Mar 1990 04:26:14 +0000 (04:26 +0000)
committerLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Tue, 27 Mar 1990 04:26:14 +0000 (04:26 +0000)
See patch #16.

17 files changed:
config.h.SH
consarg.c
doarg.c
doio.c
dolist.c
dump.c
eval.c
evalargs.xc
hash.c
lib/ctime.pl [new file with mode: 0644]
msdos/dir.h [new file with mode: 0644]
msdos/directory.c [new file with mode: 0644]
msdos/eg/crlf.bat [new file with mode: 0644]
msdos/eg/lf.bat [new file with mode: 0644]
msdos/glob.c [new file with mode: 0644]
msdos/msdos.c [new file with mode: 0644]
patchlevel.h

index 7215ef9..7af917f 100644 (file)
@@ -83,6 +83,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
  */
 #$d_bzero      BZERO           /**/
 
+/* CASTNEGFLOAT:
+ *     This symbol, if defined, indicates that this C compiler knows how to
+ *     cast negative numbers to unsigned longs, ints and shorts.
+ */
+#$d_castneg    CASTNEGFLOAT    /**/
+
 /* CHARSPRINTF:
  *     This symbol is defined if this system declares "char *sprintf()" in
  *     stdio.h.  The trend seems to be to declare it as "int sprintf()".  It
index 3ad6655..b918448 100644 (file)
--- a/consarg.c
+++ b/consarg.c
@@ -1,4 +1,4 @@
-/* $Header: consarg.c,v 3.0.1.4 90/03/12 16:24:40 lwall Locked $
+/* $Header: consarg.c,v 3.0.1.5 90/03/27 15:36:45 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       consarg.c,v $
+ * Revision 3.0.1.5  90/03/27  15:36:45  lwall
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * 
  * Revision 3.0.1.4  90/03/12  16:24:40  lwall
  * patch13: return (@array) did counter-intuitive things
  * 
@@ -338,7 +341,7 @@ register ARG *arg;
                str_numset(str,str_gnum(s1) / value);
            break;
        case O_MODULO:
-           tmplong = (long)str_gnum(s2);
+           tmplong = (unsigned long)str_gnum(s2);
            if (tmplong == 0L) {
                yyerror("Illegal modulus of constant zero");
                break;
@@ -407,19 +410,19 @@ register ARG *arg;
        case O_BIT_AND:
            value = str_gnum(s1);
 #ifndef lint
-           str_numset(str,(double)(((long)value) & ((long)str_gnum(s2))));
+           str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2))));
 #endif
            break;
        case O_XOR:
            value = str_gnum(s1);
 #ifndef lint
-           str_numset(str,(double)(((long)value) ^ ((long)str_gnum(s2))));
+           str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
 #endif
            break;
        case O_BIT_OR:
            value = str_gnum(s1);
 #ifndef lint
-           str_numset(str,(double)(((long)value) | ((long)str_gnum(s2))));
+           str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
 #endif
            break;
        case O_AND:
@@ -455,7 +458,7 @@ register ARG *arg;
            break;
        case O_COMPLEMENT:
 #ifndef lint
-           str_numset(str,(double)(~(long)str_gnum(s1)));
+           str_numset(str,(double)(~U_L(str_gnum(s1))));
 #endif
            break;
        case O_SIN:
diff --git a/doarg.c b/doarg.c
index c13b17c..029ba38 100644 (file)
--- a/doarg.c
+++ b/doarg.c
@@ -1,4 +1,4 @@
-/* $Header: doarg.c,v 3.0.1.4 90/03/12 16:28:42 lwall Locked $
+/* $Header: doarg.c,v 3.0.1.5 90/03/27 15:39:03 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       doarg.c,v $
+ * Revision 3.0.1.5  90/03/27  15:39:03  lwall
+ * patch16: MSDOS support
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * patch16: sprintf($s,...,$s,...) didn't work
+ * 
  * Revision 3.0.1.4  90/03/12  16:28:42  lwall
  * patch13: pack of ascii strings could call str_ncat() with negative length
  * patch13: printf("%s", *foo) was busted
@@ -41,6 +46,10 @@ extern unsigned char fold[];
 
 int wantarray;
 
+#ifdef BUGGY_MSC
+ #pragma function(memcmp)
+#endif /* BUGGY_MSC */
+
 int
 do_subst(str,arg,sp)
 STR *str;
@@ -289,6 +298,9 @@ nope:
     stack->ary_array[++sp] = arg->arg_ptr.arg_str;
     return sp;
 }
+#ifdef BUGGY_MSC
+ #pragma intrinsic(memcmp)
+#endif /* BUGGY_MSC */
 
 int
 do_trans(str,arg)
@@ -448,7 +460,7 @@ int *arglast;
        case 'I':
            while (len-- > 0) {
                fromstr = NEXTFROM;
-               auint = (unsigned int)str_gnum(fromstr);
+               auint = U_I(str_gnum(fromstr));
                str_ncat(str,(char*)&auint,sizeof(unsigned int));
            }
            break;
@@ -472,7 +484,7 @@ int *arglast;
        case 'L':
            while (len-- > 0) {
                fromstr = NEXTFROM;
-               aulong = (unsigned long)str_gnum(fromstr);
+               aulong = U_L(str_gnum(fromstr));
                str_ncat(str,(char*)&aulong,sizeof(unsigned long));
            }
            break;
@@ -511,10 +523,11 @@ register STR **sarg;
     char *xs;
     int xlen;
     double value;
+    char *origs;
 
     str_set(str,"");
     len--;                     /* don't count pattern string */
-    s = str_get(*sarg);
+    origs = s = str_get(*sarg);
     send = s + (*sarg)->str_cur;
     sarg++;
     for ( ; s < send; len--) {
@@ -578,19 +591,10 @@ register STR **sarg;
                ch = *(++t);
                *t = '\0';
                value = str_gnum(*(sarg++));
-#if defined(sun) && !defined(sparc)
-               if (value < 0.0) {              /* sigh */
-                   if (dolong)
-                       (void)sprintf(buf,s,(long)value);
-                   else
-                       (void)sprintf(buf,s,(int)value);
-               }
-               else
-#endif
                if (dolong)
-                   (void)sprintf(buf,s,(unsigned long)value);
+                   (void)sprintf(buf,s,U_L(value));
                else
-                   (void)sprintf(buf,s,(unsigned int)value);
+                   (void)sprintf(buf,s,U_I(value));
                s = t;
                *(t--) = ch;
                break;
@@ -616,10 +620,17 @@ register STR **sarg;
                if (strEQ(t-2,"%s")) {  /* some printfs fail on >128 chars */
                    *buf = '\0';
                    str_ncat(str,s,t - s - 2);
+                   *t = ch;
                    str_ncat(str,xs,xlen);  /* so handle simple case */
                }
-               else
+               else {
+                   if (origs == xs) {          /* sprintf($s,...$s...) */
+                       strcpy(tokenbuf+64,s);
+                       s = tokenbuf+64;
+                       *t = ch;
+                   }
                    (void)sprintf(buf,s,xs);
+               }
                sarg++;
                s = t;
                *(t--) = ch;
@@ -1165,7 +1176,7 @@ STR *str;
     register int offset;
     register int size;
     register unsigned char *s = (unsigned char*)mstr->str_ptr;
-    register unsigned long lval = (unsigned long)str_gnum(str);
+    register unsigned long lval = U_L(str_gnum(str));
     int mask;
 
     mstr->str_rare = 0;
diff --git a/doio.c b/doio.c
index e19a6f2..7667e5c 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,4 +1,4 @@
-/* $Header: doio.c,v 3.0.1.7 90/03/14 12:26:24 lwall Locked $
+/* $Header: doio.c,v 3.0.1.8 90/03/27 15:44:02 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       doio.c,v $
+ * Revision 3.0.1.8  90/03/27  15:44:02  lwall
+ * patch16: MSDOS support
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * patch16: system() can lose arguments passed to shell scripts on SysV machines
+ * 
  * Revision 3.0.1.7  90/03/14  12:26:24  lwall
  * patch15: commands involving execs could cause malloc arena corruption
  * 
@@ -283,7 +288,9 @@ register STAB *stab;
 #ifdef FCHOWN
                (void)fchown(fileno(stab_io(argvoutstab)->ifp),fileuid,filegid);
 #else
+#ifdef CHOWN
                (void)chown(oldname,fileuid,filegid);
+#endif
 #endif
            }
            str_free(str);
@@ -300,6 +307,7 @@ register STAB *stab;
     return Nullfp;
 }
 
+#ifdef PIPE
 void
 do_pipe(str, rstab, wstab)
 STR *str;
@@ -342,6 +350,7 @@ badexit:
     str_sset(str,&str_undef);
     return;
 }
+#endif
 
 bool
 do_close(stab,explicit)
@@ -361,7 +370,7 @@ bool explicit;
        if (stio->type == '|') {
            status = mypclose(stio->ifp);
            retval = (status >= 0);
-           statusvalue = (unsigned)status & 0xffff;
+           statusvalue = (unsigned short)status & 0xffff;
        }
        else if (stio->type == '-')
            retval = TRUE;
@@ -897,6 +906,7 @@ char *cmd;
     register char *s;
     char **argv;
     char flags[10];
+    char *cmd2;
 
 #ifdef TAINT
     taintenv();
@@ -949,9 +959,9 @@ char *cmd;
        }
     }
     New(402,argv, (s - cmd) / 2 + 2, char*);
-
+    cmd2 = nsavestr(cmd, s-cmd);
     a = argv;
-    for (s = cmd; *s;) {
+    for (s = cmd2; *s;) {
        while (*s && isspace(*s)) s++;
        if (*s)
            *(a++) = s;
@@ -962,9 +972,13 @@ char *cmd;
     *a = Nullch;
     if (argv[0]) {
        execvp(argv[0],argv);
-       if (errno == ENOEXEC)           /* for system V NIH syndrome */
+       if (errno == ENOEXEC) {         /* for system V NIH syndrome */
+           Safefree(argv);
+           Safefree(cmd2);
            goto doshell;
+       }
     }
+    Safefree(cmd2);
     Safefree(argv);
     return FALSE;
 }
@@ -1944,6 +1958,7 @@ int *arglast;
            }
        }
        break;
+#ifdef CHOWN
     case O_CHOWN:
 #ifdef TAINT
        taintproper("Insecure dependency in chown");
@@ -1959,6 +1974,8 @@ int *arglast;
            }
        }
        break;
+#endif
+#ifdef KILL
     case O_KILL:
 #ifdef TAINT
        taintproper("Insecure dependency in kill");
@@ -1994,6 +2011,7 @@ int *arglast;
            }
        }
        break;
+#endif
     case O_UNLINK:
 #ifdef TAINT
        taintproper("Insecure dependency in unlink");
index 2d8ec59..0e74a56 100644 (file)
--- a/dolist.c
+++ b/dolist.c
@@ -1,4 +1,4 @@
-/* $Header: dolist.c,v 3.0.1.6 90/03/12 16:33:02 lwall Locked $
+/* $Header: dolist.c,v 3.0.1.7 90/03/27 15:48:42 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,13 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       dolist.c,v $
+ * Revision 3.0.1.7  90/03/27  15:48:42  lwall
+ * patch16: MSDOS support
+ * patch16: use of $`, $& or $' sometimes causes memory leakage
+ * patch16: splice(@array,0,$n) case cause duplicate free
+ * patch16: grep blows up on undefined array values
+ * patch16: .. now works using magical string increment
+ * 
  * Revision 3.0.1.6  90/03/12  16:33:02  lwall
  * patch13: added list slice operator (LIST)[LIST]
  * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
 #include "perl.h"
 
 
+#ifdef BUGGY_MSC
+ #pragma function(memcmp)
+#endif /* BUGGY_MSC */
+
 int
 do_match(str,arg,gimme,arglast)
 STR *str;
@@ -242,6 +253,8 @@ yup:
     if (sawampersand) {
        char *tmps;
 
+       if (spat->spat_regexp->subbase)
+           Safefree(spat->spat_regexp->subbase);
        tmps = spat->spat_regexp->subbase = nsavestr(t,strend-t);
        tmps = spat->spat_regexp->startp[0] = tmps + (s - t);
        spat->spat_regexp->endp[0] = tmps + spat->spat_short->str_cur;
@@ -262,6 +275,10 @@ nope:
     return sp;
 }
 
+#ifdef BUGGY_MSC
+ #pragma intrinsic(memcmp)
+#endif /* BUGGY_MSC */
+
 int
 do_split(str,spat,limit,gimme,arglast)
 STR *str;
@@ -846,6 +863,7 @@ int *arglast;
                for (i = offset; i > 0; i--)    /* can't trust Copy */
                    *dst-- = *src--;
            }
+           Zero(ary->ary_array, -diff, STR*);
            ary->ary_array -= diff;             /* diff is negative */
            ary->ary_max += diff;
        }
@@ -956,7 +974,10 @@ int *arglast;
     }
     arg = arg[1].arg_ptr.arg_arg;
     while (i-- > 0) {
-       stab_val(defstab) = st[src];
+       if (st[src])
+           stab_val(defstab) = st[src];
+       else
+           stab_val(defstab) = str_static(&str_undef);
        (void)eval(arg,G_SCALAR,sp);
        st = stack->ary_array;
        if (str_true(st[sp+1]))
@@ -1124,17 +1145,36 @@ int *arglast;
 {
     STR **st = stack->ary_array;
     register int sp = arglast[0];
-    register int i = (int)str_gnum(st[sp+1]);
+    register int i;
     register ARRAY *ary = stack;
     register STR *str;
-    int max = (int)str_gnum(st[sp+2]);
+    int max;
 
     if (gimme != G_ARRAY)
        fatal("panic: do_range");
 
-    while (i <= max) {
-       (void)astore(ary, ++sp, str = str_static(&str_no));
-       str_numset(str,(double)i++);
+    if (st[sp+1]->str_nok ||
+      (looks_like_number(st[sp+1]) && *st[sp+1]->str_ptr != '0') ) {
+       i = (int)str_gnum(st[sp+1]);
+       max = (int)str_gnum(st[sp+2]);
+       while (i <= max) {
+           (void)astore(ary, ++sp, str = str_static(&str_no));
+           str_numset(str,(double)i++);
+       }
+    }
+    else {
+       STR *final = str_static(st[sp+2]);
+       char *tmps = str_get(final);
+
+       str = str_static(st[sp+1]);
+       while (!str->str_nok && str->str_cur <= final->str_cur &&
+           strNE(str->str_ptr,tmps) ) {
+           (void)astore(ary, ++sp, str);
+           str = str_static(str);
+           str_inc(str);
+       }
+       if (strEQ(str->str_ptr,tmps))
+           (void)astore(ary, ++sp, str);
     }
     return sp;
 }
diff --git a/dump.c b/dump.c
index 778dc3b..c5f2a31 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1,4 +1,4 @@
-/* $Header: dump.c,v 3.0 89/10/18 15:11:16 lwall Locked $
+/* $Header: dump.c,v 3.0.1.1 90/03/27 15:49:58 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       dump.c,v $
+ * Revision 3.0.1.1  90/03/27  15:49:58  lwall
+ * patch16: changed unsigned to unsigned int
+ * 
  * Revision 3.0  89/10/18  15:11:16  lwall
  * 3.0 baseline
  * 
@@ -217,7 +220,7 @@ register ARG *arg;
 
 dump_flags(b,flags)
 char *b;
-unsigned flags;
+unsigned int flags;
 {
     *b = '\0';
     if (flags & AF_ARYOK)
diff --git a/eval.c b/eval.c
index 18ce86e..9978779 100644 (file)
--- a/eval.c
+++ b/eval.c
@@ -1,4 +1,4 @@
-/* $Header: eval.c,v 3.0.1.5 90/03/12 16:37:40 lwall Locked $
+/* $Header: eval.c,v 3.0.1.6 90/03/27 15:53:51 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,11 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       eval.c,v $
+ * Revision 3.0.1.6  90/03/27  15:53:51  lwall
+ * patch16: MSDOS support
+ * patch16: support for machines that can't cast negative floats to unsigned ints
+ * patch16: ioctl didn't return values correctly
+ * 
  * Revision 3.0.1.5  90/03/12  16:37:40  lwall
  * patch13: undef $/ didn't work as advertised
  * patch13: added list slice operator (LIST)[LIST]
@@ -47,6 +52,9 @@
 
 #include <signal.h>
 
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
 #ifdef I_VFORK
 #   include <vfork.h>
 #endif
@@ -289,14 +297,14 @@ register int sp;
        value = str_gnum(st[1]);
        anum = (int)str_gnum(st[2]);
 #ifndef lint
-       value = (double)(((unsigned long)value) << anum);
+       value = (double)(U_L(value) << anum);
 #endif
        goto donumset;
     case O_RIGHT_SHIFT:
        value = str_gnum(st[1]);
        anum = (int)str_gnum(st[2]);
 #ifndef lint
-       value = (double)(((unsigned long)value) >> anum);
+       value = (double)(U_L(value) >> anum);
 #endif
        goto donumset;
     case O_LT:
@@ -332,8 +340,7 @@ register int sp;
        if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
            value = str_gnum(st[1]);
 #ifndef lint
-           value = (double)(((unsigned long)value) &
-                       (unsigned long)str_gnum(st[2]));
+           value = (double)(U_L(value) & U_L(str_gnum(st[2])));
 #endif
            goto donumset;
        }
@@ -344,8 +351,7 @@ register int sp;
        if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
            value = str_gnum(st[1]);
 #ifndef lint
-           value = (double)(((unsigned long)value) ^
-                       (unsigned long)str_gnum(st[2]));
+           value = (double)(U_L(value) ^ U_L(str_gnum(st[2])));
 #endif
            goto donumset;
        }
@@ -356,8 +362,7 @@ register int sp;
        if (!sawvec || st[1]->str_nok || st[2]->str_nok) {
            value = str_gnum(st[1]);
 #ifndef lint
-           value = (double)(((unsigned long)value) |
-                       (unsigned long)str_gnum(st[2]));
+           value = (double)(U_L(value) | U_L(str_gnum(st[2])));
 #endif
            goto donumset;
        }
@@ -436,7 +441,7 @@ register int sp;
        goto donumset;
     case O_COMPLEMENT:
 #ifndef lint
-       value = (double) ~(unsigned long)str_gnum(st[1]);
+       value = (double) ~U_L(str_gnum(st[1]));
 #endif
        goto donumset;
     case O_SELECT:
@@ -1330,27 +1335,32 @@ register int sp;
        }
        break;
     case O_FORK:
+#ifdef FORK
        anum = fork();
        if (!anum && (tmpstab = stabent("$",allstabs)))
            str_numset(STAB_STR(tmpstab),(double)getpid());
        value = (double)anum;
        goto donumset;
+#else
+       fatal("Unsupported function fork");
+       break;
+#endif
     case O_WAIT:
+#ifdef WAIT
 #ifndef lint
-       /* ihand = signal(SIGINT, SIG_IGN); */
-       /* qhand = signal(SIGQUIT, SIG_IGN); */
        anum = wait(&argflags);
        if (anum > 0)
            pidgone(anum,argflags);
        value = (double)anum;
-#else
-       /* ihand = qhand = 0; */
 #endif
-       /* (void)signal(SIGINT, ihand); */
-       /* (void)signal(SIGQUIT, qhand); */
        statusvalue = (unsigned short)argflags;
        goto donumset;
+#else
+       fatal("Unsupported function wait");
+       break;
+#endif
     case O_SYSTEM:
+#ifdef FORK
 #ifdef TAINT
        if (arglast[2] - arglast[1] == 1) {
            taintenv();
@@ -1392,6 +1402,16 @@ register int sp;
            value = (double)do_exec(str_get(str_static(st[2])));
        }
        _exit(-1);
+#else /* ! FORK */
+       if ((arg[1].arg_type & A_MASK) == A_STAB)
+           value = (double)do_aspawn(st[1],arglast);
+       else if (arglast[2] - arglast[1] != 1)
+           value = (double)do_aspawn(Nullstr,arglast);
+       else {
+           value = (double)do_spawn(str_get(str_static(st[2])));
+       }
+       goto donumset;
+#endif /* FORK */
     case O_EXEC:
        if ((arg[1].arg_type & A_MASK) == A_STAB)
            value = (double)do_aexec(st[1],arglast);
@@ -1443,14 +1463,29 @@ register int sp;
       out:
        value = (double)anum;
        goto donumset;
-    case O_CHMOD:
     case O_CHOWN:
+#ifdef CHOWN
+       value = (double)apply(optype,arglast);
+       goto donumset;
+#else
+       fatal("Unsupported function chown");
+       break;
+#endif
     case O_KILL:
+#ifdef KILL
+       value = (double)apply(optype,arglast);
+       goto donumset;
+#else
+       fatal("Unsupported function kill");
+       break;
+#endif
     case O_UNLINK:
+    case O_CHMOD:
     case O_UTIME:
        value = (double)apply(optype,arglast);
        goto donumset;
     case O_UMASK:
+#ifdef UMASK
        if (maxarg < 1) {
            anum = umask(0);
            (void)umask(anum);
@@ -1462,6 +1497,10 @@ register int sp;
        taintproper("Insecure dependency in umask");
 #endif
        goto donumset;
+#else
+       fatal("Unsupported function umask");
+       break;
+#endif
     case O_RENAME:
        tmps = str_get(st[1]);
        tmps2 = str_get(st[2]);
@@ -1480,6 +1519,7 @@ register int sp;
 #endif
        goto donumset;
     case O_LINK:
+#ifdef LINK
        tmps = str_get(st[1]);
        tmps2 = str_get(st[2]);
 #ifdef TAINT
@@ -1487,6 +1527,10 @@ register int sp;
 #endif
        value = (double)(link(tmps,tmps2) >= 0);
        goto donumset;
+#else
+       fatal("Unsupported function link");
+       break;
+#endif
     case O_MKDIR:
        tmps = str_get(st[1]);
        anum = (int)str_gnum(st[2]);
@@ -1566,8 +1610,13 @@ register int sp;
        goto one_liner;         /* see above in MKDIR */
 #endif
     case O_GETPPID:
+#ifdef GETPPID
        value = (double)getppid();
        goto donumset;
+#else
+       fatal("Unsupported function getppid");
+       break;
+#endif
     case O_GETPGRP:
 #ifdef GETPGRP
        if (maxarg < 1)
@@ -1618,6 +1667,7 @@ register int sp;
        break;
 #endif
     case O_CHROOT:
+#ifdef CHROOT
        if (maxarg < 1)
            tmps = str_get(stab_val(defstab));
        else
@@ -1627,6 +1677,10 @@ register int sp;
 #endif
        value = (double)(chroot(tmps) >= 0);
        goto donumset;
+#else
+       fatal("Unsupported function chroot");
+       break;
+#endif
     case O_FCNTL:
     case O_IOCTL:
        if (maxarg <= 0)
@@ -1635,15 +1689,17 @@ register int sp;
            stab = arg[1].arg_ptr.arg_stab;
        else
            stab = stabent(str_get(st[1]),TRUE);
-       argtype = (unsigned int)str_gnum(st[2]);
+       argtype = U_I(str_gnum(st[2]));
 #ifdef TAINT
        taintproper("Insecure dependency in ioctl");
 #endif
        anum = do_ctl(optype,stab,argtype,st[3]);
        if (anum == -1)
            goto say_undef;
-       if (anum != 0)
+       if (anum != 0) {
+           value = (double)anum;
            goto donumset;
+       }
        str_set(str,"0 but true");
        STABSET(str);
        break;
@@ -1762,8 +1818,12 @@ register int sp;
        anum = S_IFCHR;
        goto check_file_type;
     case O_FTBLK:
+#ifdef S_IFBLK
        anum = S_IFBLK;
        goto check_file_type;
+#else
+       goto say_no;
+#endif
     case O_FTFILE:
        anum = S_IFREG;
        goto check_file_type;
@@ -1802,7 +1862,7 @@ register int sp;
        value = (double)(symlink(tmps,tmps2) >= 0);
        goto donumset;
 #else
-       fatal("Unsupported function symlink()");
+       fatal("Unsupported function symlink");
 #endif
     case O_READLINK:
 #ifdef SYMLINK
@@ -1816,16 +1876,28 @@ register int sp;
        str_nset(str,buf,anum);
        break;
 #else
-       fatal("Unsupported function readlink()");
+       fatal("Unsupported function readlink");
 #endif
     case O_FTSUID:
+#ifdef S_ISUID
        anum = S_ISUID;
        goto check_xid;
+#else
+       goto say_no;
+#endif
     case O_FTSGID:
+#ifdef S_ISGID
        anum = S_ISGID;
        goto check_xid;
+#else
+       goto say_no;
+#endif
     case O_FTSVTX:
+#ifdef S_ISVTX
        anum = S_ISVTX;
+#else
+       goto say_no;
+#endif
       check_xid:
        if (mystat(arg,st[1]) < 0)
            goto say_undef;
@@ -2058,12 +2130,29 @@ register int sp;
            goto say_undef;
        value = fileno(fp);
        goto donumset;
+    case O_BINMODE:
+       if (maxarg < 1)
+           goto say_undef;
+       if ((arg[1].arg_type & A_MASK) == A_WORD)
+           stab = arg[1].arg_ptr.arg_stab;
+       else
+           stab = stabent(str_get(st[1]),TRUE);
+       if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp))
+           goto say_undef;
+#ifdef MSDOS
+       str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No);
+#else
+       str_set(str, Yes);
+#endif
+       STABSET(str);
+       break;
     case O_VEC:
        sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast);
        goto array_return;
     case O_GPWNAM:
     case O_GPWUID:
     case O_GPWENT:
+#ifdef PASSWD
        sp = do_gpwent(optype,
          gimme,arglast);
        goto array_return;
@@ -2073,9 +2162,16 @@ register int sp;
     case O_EPWENT:
        value = (double) endpwent();
        goto donumset;
+#else
+    case O_EPWENT:
+    case O_SPWENT:
+       fatal("Unsupported password function");
+       break;
+#endif
     case O_GGRNAM:
     case O_GGRGID:
     case O_GGRENT:
+#ifdef GROUP
        sp = do_ggrent(optype,
          gimme,arglast);
        goto array_return;
@@ -2085,10 +2181,20 @@ register int sp;
     case O_EGRENT:
        value = (double) endgrent();
        goto donumset;
+#else
+    case O_EGRENT:
+    case O_SGRENT:
+       fatal("Unsupported group function");
+       break;
+#endif
     case O_GETLOGIN:
+#ifdef GETLOGIN
        if (!(tmps = getlogin()))
            goto say_undef;
        str_set(str,tmps);
+#else
+       fatal("Unsupported function getlogin");
+#endif
        break;
     case O_OPENDIR:
     case O_READDIR:
@@ -2108,6 +2214,7 @@ register int sp;
        value = (double)do_syscall(arglast);
        goto donumset;
     case O_PIPE:
+#ifdef PIPE
        if ((arg[1].arg_type & A_MASK) == A_WORD)
            stab = arg[1].arg_ptr.arg_stab;
        else
@@ -2118,6 +2225,9 @@ register int sp;
            stab2 = stabent(str_get(st[2]),TRUE);
        do_pipe(str,stab,stab2);
        STABSET(str);
+#else
+       fatal("Unsupported function pipe");
+#endif
        break;
     }
 
index 76ac19a..711d9a9 100644 (file)
@@ -2,9 +2,12 @@
  * kit sizes from getting too big.
  */
 
-/* $Header: evalargs.xc,v 3.0.1.4 90/02/28 17:38:37 lwall Locked $
+/* $Header: evalargs.xc,v 3.0.1.5 90/03/27 15:54:42 lwall Locked $
  *
  * $Log:       evalargs.xc,v $
+ * Revision 3.0.1.5  90/03/27  15:54:42  lwall
+ * patch16: MSDOS support
+ * 
  * Revision 3.0.1.4  90/02/28  17:38:37  lwall
  * patch9: $#foo -= 2 didn't work
  * 
            argflags |= AF_POST;        /* enable newline chopping */
            last_in_stab = argptr.arg_stab;
            old_record_separator = record_separator;
+#ifdef MSDOS
+           record_separator = 0;
+#else
 #ifdef CSH
            record_separator = 0;
 #else
            record_separator = '\n';
-#endif
+#endif /* !CSH */
+#endif /* !MSDOS */
            goto do_read;
        case A_READ:
            last_in_stab = argptr.arg_stab;
                        (void) interp(str,stab_val(last_in_stab),sp);
                        st = stack->ary_array;
                        tmpstr = Str_new(55,0);
+#ifdef MSDOS
+                       str_set(tmpstr, "glob ");
+                       str_scat(tmpstr,str);
+                       str_cat(tmpstr," |");
+#else
 #ifdef CSH
                        str_nset(tmpstr,cshname,cshlen);
                        str_cat(tmpstr," -cf 'set nonomatch; glob ");
                        str_scat(tmpstr,str);
                        str_cat(tmpstr,
                          "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
-#endif
+#endif /* !CSH */
+#endif /* !MSDOS */
                        (void)do_open(last_in_stab,tmpstr->str_ptr,
                          tmpstr->str_cur);
                        fp = stab_io(last_in_stab)->ifp;
diff --git a/hash.c b/hash.c
index 5f18937..e0b00ea 100644 (file)
--- a/hash.c
+++ b/hash.c
@@ -1,4 +1,4 @@
-/* $Header: hash.c,v 3.0.1.2 89/12/21 20:03:39 lwall Locked $
+/* $Header: hash.c,v 3.0.1.3 90/03/27 15:59:09 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,9 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       hash.c,v $
+ * Revision 3.0.1.3  90/03/27  15:59:09  lwall
+ * patch16: @dbmvalues{'foo','bar'} could use the same cache entry for both values
+ * 
  * Revision 3.0.1.2  89/12/21  20:03:39  lwall
  * patch7: errno may now be a macro with an lvalue
  * 
@@ -161,12 +164,14 @@ register int hash;
     }
 #ifdef SOME_DBM
     else if (tb->tbl_dbm) {            /* is this just a cache for dbm file? */
+       void hentdelayfree();
+
        entry = tb->tbl_array[hash & tb->tbl_max];
        oentry = &entry->hent_next;
        entry = *oentry;
        while (entry) { /* trim chain down to 1 entry */
            *oentry = entry->hent_next;
-           hentfree(entry);            /* no doubt they'll want this next. */
+           hentdelayfree(entry);       /* no doubt they'll want this next. */
            entry = *oentry;
        }
     }
@@ -316,6 +321,17 @@ register HENT *hent;
     Safefree(hent);
 }
 
+void
+hentdelayfree(hent)
+register HENT *hent;
+{
+    if (!hent)
+       return;
+    str_2static(hent->hent_val);       /* free between statements */
+    Safefree(hent->hent_key);
+    Safefree(hent);
+}
+
 void
 hclear(tb)
 register HASH *tb;
diff --git a/lib/ctime.pl b/lib/ctime.pl
new file mode 100644 (file)
index 0000000..d3b0354
--- /dev/null
@@ -0,0 +1,36 @@
+;# ctime.pl is a simple Perl emulation for the well known ctime(3C) function.
+;#
+;# Waldemar Kebsch, Federal Republic of Germany, November 1988
+;# kebsch.pad@nixpbe.UUCP
+;# Modified March 1990 to better handle timezones
+;#  $Id: ctime.pl,v 1.3 90/03/22 10:49:10 hakanson Exp $
+;#   Marion Hakanson (hakanson@cse.ogi.edu)
+;#   Oregon Graduate Institute of Science and Technology
+;#
+;# usage:
+;#
+;#     #include <ctime.pl>          # see the -P and -I option in perl.man
+;#     $Date = do ctime(time);
+
+@DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
+@MoY = ('Jan','Feb','Mar','Apr','May','Jun',
+        'Jul','Aug','Sep','Oct','Nov','Dec');
+
+sub ctime {
+    local($time) = @_;
+    local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
+
+    # Use GMT if can't find local TZ
+    $TZ = defined($ENV{'TZ'}) ? $ENV{'TZ'} : 'GMT';
+    ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
+        ($TZ eq 'GMT') ? gmtime($time) : localtime($time);
+    # Hack to deal with 'PST8PDT' format of TZ
+    if ( $TZ =~ /-?\d+/ ) {
+        $TZ = $isdst ? $' : $`;
+    }
+    $TZ .= " " unless $TZ eq "";
+    $year += ($year < 70) ? 2000 : 1900;
+    sprintf("%s %s %2d %2d:%02d:%02d %s%4d\n",
+      $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZ, $year);
+}
+1;
diff --git a/msdos/dir.h b/msdos/dir.h
new file mode 100644 (file)
index 0000000..abda0c2
--- /dev/null
@@ -0,0 +1,55 @@
+/* $Header: dir.h,v 3.0.1.1 90/03/27 16:07:08 lwall Locked $
+ *
+ *    (C) Copyright 1987, 1990 Diomidis Spinellis.
+ *
+ *    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.
+ *
+ * $Log:       dir.h,v $
+ * Revision 3.0.1.1  90/03/27  16:07:08  lwall
+ * patch16: MSDOS support
+ * 
+ * Revision 1.1  90/03/18  20:32:29  dds
+ * Initial revision
+ *
+ *
+ */
+
+/*
+ * defines the type returned by the directory(3) functions
+ */
+
+#ifndef __DIR_INCLUDED
+#define __DIR_INCLUDED
+
+/*Directory entry size */
+#ifdef DIRSIZ
+#undef DIRSIZ
+#endif
+#define DIRSIZ(rp)     (sizeof(struct direct))
+
+/*
+ * Structure of a directory entry
+ */
+struct direct  {
+       ino_t   d_ino;                  /* inode number (not used by MS-DOS) */
+       int     d_namlen;               /* Name length */
+       char    d_name[13];             /* file name */
+};
+
+struct _dir_struc {                    /* Structure used by dir operations */
+       char *start;                    /* Starting position */
+       char *curr;                     /* Current position */
+       struct direct dirstr;           /* Directory structure to return */
+};
+
+typedef struct _dir_struc DIR;         /* Type returned by dir operations */
+
+DIR *cdecl opendir(char *filename);
+struct direct *readdir(DIR *dirp);
+long telldir(DIR *dirp);
+void seekdir(DIR *dirp,long loc);
+void rewinddir(DIR *dirp);
+void closedir(DIR *dirp);
+
+#endif /* __DIR_INCLUDED */
diff --git a/msdos/directory.c b/msdos/directory.c
new file mode 100644 (file)
index 0000000..b435453
--- /dev/null
@@ -0,0 +1,178 @@
+/* $Header: directory.c,v 3.0.1.1 90/03/27 16:07:37 lwall Locked $
+ *
+ *    (C) Copyright 1987, 1988, 1990 Diomidis Spinellis.
+ *
+ *    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.
+ *
+ * $Log:       directory.c,v $
+ * Revision 3.0.1.1  90/03/27  16:07:37  lwall
+ * patch16: MSDOS support
+ * 
+ * Revision 1.3  90/03/16  22:39:40  dds
+ * Fixed malloc problem.
+ *
+ * Revision 1.2  88/07/23  00:08:39  dds
+ * Added inode non-zero filling.
+ *
+ * Revision 1.1  88/07/23  00:03:50  dds
+ * Initial revision
+ *
+ */
+
+/*
+ * UNIX compatible directory access functions
+ */
+
+#include <sys/types.h>
+#include <sys/dir.h>
+#include <stddef.h>
+#include <stdlib.h>
+#include <string.h>
+#include <dos.h>
+#include <ctype.h>
+
+/*
+ * File names are converted to lowercase if the
+ * CONVERT_TO_LOWER_CASE variable is defined.
+ */
+#define CONVERT_TO_LOWER_CASE
+
+#define PATHLEN 65
+
+#ifndef lint
+static char     rcsid[] = "$Header: director.c;v 1.3 90/03/16 22:39:40 dds Exp
+ $";
+#endif
+
+DIR *
+opendir(char *filename)
+{
+       DIR            *p;
+       char           *oldresult, *result;
+       union REGS      srv;
+       struct SREGS    segregs;
+       register        reslen = 0;
+       char            scannamespc[PATHLEN];
+       char            *scanname = scannamespc;        /* To take address we need a pointer */
+
+       /*
+        * Structure used by the MS-DOS directory system calls.
+        */
+       struct dir_buff {
+               char            reserved[21];   /* Reserved for MS-DOS */
+               unsigned char   attribute;      /* Attribute */
+               unsigned int    time;           /* Time */
+               unsigned int    date;           /* Date */
+               long            size;           /* Size of file */
+               char            fn[13];         /* Filename */
+       } buffspc, *buff = &buffspc;
+
+
+       if (!(p = (DIR *) malloc(sizeof(DIR))))
+               return NULL;
+
+       /* Initialize result to use realloc on it */
+       if (!(result = malloc(1))) {
+               free(p);
+               return NULL;
+       }
+
+       /* Create the search pattern */
+       strcpy(scanname, filename);
+       if (strchr("/\\", *(scanname + strlen(scanname) - 1)) == NULL)
+               strcat(scanname, "/*.*");
+       else
+               strcat(scanname, "*.*");
+
+       segread(&segregs);
+#if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) )
+       segregs.ds = FP_SEG(buff);
+       srv.x.dx = FP_OFF(buff);
+#else
+       srv.x.dx = (unsigned int) buff;
+#endif
+       srv.h.ah = 0x1a;        /* Set DTA to DS:DX */
+       intdosx(&srv, &srv, &segregs);
+
+#if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) )
+       segregs.ds = FP_SEG(scanname);
+       srv.x.dx = FP_OFF(scanname);
+#else
+       srv.x.dx = (unsigned int) scanname;
+#endif
+       srv.x.cx = 0xff;        /* Search mode */
+
+       for (srv.h.ah = 0x4e; !intdosx(&srv, &srv, &segregs); srv.h.ah = 0x4f) {
+               if ((result = (char *) realloc(result, reslen + strlen(buff->fn) + 1)) ==
+ NULL) {
+                       free(p);
+                       free(oldresult);
+                       return NULL;
+               }
+               oldresult = result;
+#ifdef CONVERT_TO_LOWER_CASE
+               strcpy(result + reslen, strlwr(buff->fn));
+#else
+               strcpy(result + reslen, buff->fn);
+#endif
+               reslen += strlen(buff->fn) + 1;
+       }
+
+       if (!(result = realloc(result, reslen + 1))) {
+               free(p);
+               free(oldresult);
+               return NULL;
+       } else {
+               p->start = result;
+               p->curr = result;
+               *(result + reslen) = '\0';
+               return p;
+       }
+}
+
+
+struct direct  *
+readdir(DIR *dirp)
+{
+       char           *p;
+       register        len;
+       static          dummy;
+
+       p = dirp->curr;
+       len = strlen(p);
+       if (*p) {
+               dirp->curr += len + 1;
+               strcpy(dirp->dirstr.d_name, p);
+               dirp->dirstr.d_namlen = len;
+               /* To fool programs */
+               dirp->dirstr.d_ino = ++dummy;
+               return &(dirp->dirstr);
+       } else
+               return NULL;
+}
+
+long
+telldir(DIR *dirp)
+{
+       return (long) dirp->curr;       /* ouch! pointer to long cast */
+}
+
+void
+seekdir(DIR *dirp, long loc)
+{
+       dirp->curr = (char *) loc;      /* ouch! long to pointer cast */
+}
+
+void
+rewinddir(DIR *dirp)
+{
+       dirp->curr = dirp->start;
+}
+
+void
+closedir(DIR *dirp)
+{
+       free(dirp->start);
+       free(dirp);
+}
diff --git a/msdos/eg/crlf.bat b/msdos/eg/crlf.bat
new file mode 100644 (file)
index 0000000..24d7366
--- /dev/null
@@ -0,0 +1,32 @@
+@REM=("
+@perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
+@end ") if 0 ;
+
+# Convert all the files in the current directory from unix to MS-DOS
+# line ending conventions.
+#
+# By Diomidis Spinellis
+#
+open(FILES, 'find . -print |');
+while ($file = <FILES>) {
+       $file =^ s/[\n\r]//;
+       if (-f $file) {
+               if (-B $file) {
+                       print STDERR "Skipping binary file $file\n";
+                       next;
+               }
+               ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime,
+ $blksize, $blocks) = stat($file);
+               open(IFILE, "$file");
+               open(OFILE, ">xl$$");
+               while (<IFILE>) {
+                       print OFILE;
+               }
+               close(OFILE) || die "close xl$$: $!\n";
+               close(IFILE) || die "close $file: $!\n";
+               unlink($file) || die "unlink $file: $!\n";
+               rename("xl$$", $file) || die "rename(xl$$, $file): $!\n";
+               chmod($mode, $file) || die "chmod($mode, $file: $!\n";
+               utime($atime, $mtime, $file) || die "utime($atime, $mtime, $file): $!\n";
+       }
+}
diff --git a/msdos/eg/lf.bat b/msdos/eg/lf.bat
new file mode 100644 (file)
index 0000000..9c13eef
--- /dev/null
@@ -0,0 +1,33 @@
+@REM=("
+@perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
+@end ") if 0 ;
+
+# Convert all the files in the current directory from MS-DOS to unix
+# line ending conventions.
+#
+# By Diomidis Spinellis
+#
+open(FILES, 'find . -print |');
+while ($file = <FILES>) {
+       $file =^ s/[\n\r]//;
+       if (-f $file) {
+               if (-B $file) {
+                       print STDERR "Skipping binary file $file\n";
+                       next;
+               }
+               ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime,
+ $blksize, $blocks) = stat($file);
+               open(IFILE, "$file");
+               open(OFILE, ">xl$$");
+               binmode OFILE || die "binmode xl$$: $!\n";
+               while (<IFILE>) {
+                       print OFILE;
+               }
+               close(OFILE) || die "close xl$$: $!\n";
+               close(IFILE) || die "close $file: $!\n";
+               unlink($file) || die "unlink $file: $!\n";
+               rename("xl$$", $file) || die "rename(xl$$, $file): $!\n";
+               chmod($mode, $file) || die "chmod($mode, $file: $!\n";
+               utime($atime, $mtime, $file) || die "utime($atime, $mtime, $file): $!\n";
+       }
+}
diff --git a/msdos/glob.c b/msdos/glob.c
new file mode 100644 (file)
index 0000000..19fb2ab
--- /dev/null
@@ -0,0 +1,17 @@
+/*
+ * Globbing for MS-DOS.  Relies on the expansion done by the library
+ * startup code. (dds)
+ */
+
+#include <stdio.h>
+#include <string.h>
+
+main(int argc, char *argv[])
+{
+       register i;
+
+       for (i = 1; i < argc; i++) {
+               fputs(strlwr(argv[i]), stdout);
+               putchar(0);
+       }
+}
diff --git a/msdos/msdos.c b/msdos/msdos.c
new file mode 100644 (file)
index 0000000..7deb0aa
--- /dev/null
@@ -0,0 +1,246 @@
+/* $Header: msdos.c,v 3.0.1.1 90/03/27 16:10:41 lwall Locked $
+ *
+ *    (C) Copyright 1989, 1990 Diomidis Spinellis.
+ *
+ *    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.
+ *
+ * $Log:       msdos.c,v $
+ * Revision 3.0.1.1  90/03/27  16:10:41  lwall
+ * patch16: MSDOS support
+ * 
+ * Revision 1.1  90/03/18  20:32:01  dds
+ * Initial revision
+ *
+ */
+
+/*
+ * Various Unix compatibility functions for MS-DOS.
+ */
+
+#include <stdio.h>
+#include <errno.h>
+#include <dos.h>
+#include <time.h>
+#include <process.h>
+
+#include "EXTERN.h"
+#include "perl.h"
+
+/*
+ * Interface to the MS-DOS ioctl system call.
+ * The function is encoded as follows:
+ * The lowest nibble of the function code goes to AL
+ * The two middle nibbles go to CL
+ * The high nibble goes to CH
+ *
+ * The return code is -1 in the case of an error and if successful
+ * for functions AL = 00, 09, 0a the value of the register DX
+ * for functions AL = 02 - 08, 0e the value of the register AX
+ * for functions AL = 01, 0b - 0f the number 0
+ *
+ * Notice that this restricts the ioctl subcodes stored in AL to 00-0f
+ * In the Ralf Borwn interrupt list 90.1 there are no subcodes above AL=0f
+ * so we are ok.
+ * Furthermore CH is also restriced in the same area.  Where CH is used as a
+ * code it always is between 00-0f.  In the case where it forms a count
+ * together with CL we arbitrarily set the highest count limit to 4095.  It
+ * sounds reasonable for an ioctl.
+ * The other alternative would have been to use the pointer argument to
+ * point the the values of CX.  The problem with this approach is that
+ * of accessing wild regions when DX is used as a number and not as a
+ * pointer.
+ */
+int
+ioctl(int handle, unsigned int function, char *data)
+{
+       union REGS      srv;
+       struct SREGS    segregs;
+
+       srv.h.ah = 0x44;
+       srv.h.al = function & 0xf;
+       srv.x.bx = handle;
+       srv.x.cx = function >> 4;
+       segread(&segregs);
+#if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) )
+       segregs.ds = FP_SEG(data);
+       srv.x.dx = FP_OFF(data);
+#else
+       srv.x.dx = (unsigned int) data;
+#endif
+       intdosx(&srv, &srv, &segregs);
+       if (srv.x.cflag & 1) {
+               switch(srv.x.ax ){
+               case 1:
+                       errno = EINVAL;
+                       break;
+               case 2:
+               case 3:
+                       errno = ENOENT;
+                       break;
+               case 4:
+                       errno = EMFILE;
+                       break;
+               case 5:
+                       errno = EPERM;
+                       break;
+               case 6:
+                       errno = EBADF;
+                       break;
+               case 8:
+                       errno = ENOMEM;
+                       break;
+               case 0xc:
+               case 0xd:
+               case 0xf:
+                       errno = EINVAL;
+                       break;
+               case 0x11:
+                       errno = EXDEV;
+                       break;
+               case 0x12:
+                       errno = ENFILE;
+                       break;
+               default:
+                       errno = EZERO;
+                       break;
+               }
+               return -1;
+       } else {
+               switch (function & 0xf) {
+               case 0: case 9: case 0xa:
+                       return srv.x.dx;
+               case 2: case 3: case 4: case 5:
+               case 6: case 7: case 8: case 0xe:
+                       return srv.x.ax;
+               case 1: case 0xb: case 0xc: case 0xd:
+               case 0xf:
+               default:
+                       return 0;
+               }
+       }
+}
+
+
+/*
+ * Sleep function.
+ */
+void
+sleep(unsigned len)
+{
+       time_t end;
+
+       end = time((time_t *)0) + len;
+       while (time((time_t *)0) < end)
+               ;
+}
+
+/*
+ * Just pretend that everyone is a superuser
+ */
+int
+getuid(void)
+{
+       return 0;
+}
+
+int
+geteuid(void)
+{
+       return 0;
+}
+
+int
+getgid(void)
+{
+       return 0;
+}
+
+int
+getegid(void)
+{
+       return 0;
+}
+
+/*
+ * The following code is based on the do_exec and do_aexec functions
+ * in file doio.c
+ */
+int
+do_aspawn(really,arglast)
+STR *really;
+int *arglast;
+{
+    register STR **st = stack->ary_array;
+    register int sp = arglast[1];
+    register int items = arglast[2] - sp;
+    register char **a;
+    char **argv;
+    char *tmps;
+    int status;
+
+    if (items) {
+       New(1101,argv, items+1, char*);
+       a = argv;
+       for (st += ++sp; items > 0; items--,st++) {
+           if (*st)
+               *a++ = str_get(*st);
+           else
+               *a++ = "";
+       }
+       *a = Nullch;
+       if (really && *(tmps = str_get(really)))
+           status = spawnvp(P_WAIT,tmps,argv);
+       else
+           status = spawnvp(P_WAIT,argv[0],argv);
+       Safefree(argv);
+    }
+    return status;
+}
+
+char *getenv(char *name);
+
+int
+do_spawn(cmd)
+char *cmd;
+{
+    register char **a;
+    register char *s;
+    char **argv;
+    char flags[10];
+    int status;
+    char *shell, *cmd2;
+
+    /* save an extra exec if possible */
+    if ((shell = getenv("COMSPEC")) == 0)
+       shell = "\\command.com";
+
+    /* see if there are shell metacharacters in it */
+    if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|'))
+         doshell:
+           return spawnl(P_WAIT,shell,shell,"/c",cmd,(char*)0);
+
+    New(1102,argv, strlen(cmd) / 2 + 2, char*);
+
+    New(1103,cmd2, strlen(cmd) + 1, char);
+    strcpy(cmd2, cmd);
+    a = argv;
+    for (s = cmd2; *s;) {
+       while (*s && isspace(*s)) s++;
+       if (*s)
+           *(a++) = s;
+       while (*s && !isspace(*s)) s++;
+       if (*s)
+           *s++ = '\0';
+    }
+    *a = Nullch;
+    if (argv[0])
+       if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) {
+           Safefree(argv);
+           Safefree(cmd2);
+           goto doshell;
+       }
+    Safefree(cmd2);
+    Safefree(argv);
+    return status;
+}
index 29d9127..6dbf069 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 16
+#define PATCHLEVEL 17