perl 3.0 patch #21 patch #19, continued
authorLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Wed, 8 Aug 1990 17:07:00 +0000 (17:07 +0000)
committerLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Wed, 8 Aug 1990 17:07:00 +0000 (17:07 +0000)
See patch #19.

cons.c
consarg.c
doarg.c
doio.c
lib/ctime.pl
patchlevel.h
usub/curses.mus [new file with mode: 0644]

diff --git a/cons.c b/cons.c
index 3718685..17e317e 100644 (file)
--- a/cons.c
+++ b/cons.c
@@ -1,4 +1,4 @@
-/* $Header: cons.c,v 3.0.1.6 90/03/27 15:35:21 lwall Locked $
+/* $Header: cons.c,v 3.0.1.7 90/08/09 02:35:52 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,12 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       cons.c,v $
+ * Revision 3.0.1.7  90/08/09  02:35:52  lwall
+ * patch19: did preliminary work toward debugging packages and evals
+ * patch19: Added support for linked-in C subroutines
+ * patch19: Numeric literals are now stored only in floating point
+ * patch19: Added -c switch to do compilation only
+ * 
  * Revision 3.0.1.6  90/03/27  15:35:21  lwall
  * patch16: formats didn't work inside eval
  * patch16: $foo++ now optimized to ++$foo where value not required
@@ -57,15 +63,17 @@ CMD *cmd;
     Newz(101,sub,1,SUBR);
     if (stab_sub(stab)) {
        if (dowarn) {
-           line_t oldline = line;
+           CMD *oldcurcmd = curcmd;
 
            if (cmd)
-               line = cmd->c_line;
+               curcmd = cmd;
            warn("Subroutine %s redefined",name);
-           line = oldline;
+           curcmd = oldcurcmd;
+       }
+       if (stab_sub(stab)->cmd) {
+           cmd_free(stab_sub(stab)->cmd);
+           afree(stab_sub(stab)->tosave);
        }
-       cmd_free(stab_sub(stab)->cmd);
-       afree(stab_sub(stab)->tosave);
        Safefree(stab_sub(stab));
     }
     sub->filename = filename;
@@ -89,7 +97,7 @@ CMD *cmd;
        STR *str = str_nmake((double)subline);
 
        str_cat(str,"-");
-       sprintf(buf,"%ld",(long)line);
+       sprintf(buf,"%ld",(long)curcmd->c_line);
        str_cat(str,buf);
        name = str_get(subname);
        hstore(stab_xhash(DBsub),name,strlen(name),str,0);
@@ -99,6 +107,35 @@ CMD *cmd;
     return sub;
 }
 
+SUBR *
+make_usub(name, ix, subaddr, filename)
+char *name;
+int ix;
+int (*subaddr)();
+char *filename;
+{
+    register SUBR *sub;
+    STAB *stab = stabent(name,allstabs);
+
+    if (!stab)                         /* unused function */
+       return;
+    Newz(101,sub,1,SUBR);
+    if (stab_sub(stab)) {
+       if (dowarn)
+           warn("Subroutine %s redefined",name);
+       if (stab_sub(stab)->cmd) {
+           cmd_free(stab_sub(stab)->cmd);
+           afree(stab_sub(stab)->tosave);
+       }
+       Safefree(stab_sub(stab));
+    }
+    sub->filename = filename;
+    sub->usersub = subaddr;
+    sub->userindex = ix;
+    stab_sub(stab) = sub;
+    return sub;
+}
+
 make_form(stab,fcmd)
 STAB *stab;
 FCMD *fcmd;
@@ -428,6 +465,7 @@ CMD *cur;
     cmd->c_line = head->c_line;
     cmd->c_label = head->c_label;
     cmd->c_file = filename;
+    cmd->c_pack = curpack;
     return append_line(cmd, cur);
 }
 
@@ -448,12 +486,13 @@ ARG *arg;
     if (cond)
        cmd->c_flags |= CF_COND;
     if (cmdline == NOLINE)
-       cmd->c_line = line;
+       cmd->c_line = curcmd->c_line;
     else {
        cmd->c_line = cmdline;
        cmdline = NOLINE;
     }
     cmd->c_file = filename;
+    cmd->c_pack = curpack;
     if (perldb)
        cmd = dodb(cmd);
     return cmd;
@@ -475,7 +514,7 @@ struct compcmd cblock;
     if (arg)
        cmd->c_flags |= CF_COND;
     if (cmdline == NOLINE)
-       cmd->c_line = line;
+       cmd->c_line = curcmd->c_line;
     else {
        cmd->c_line = cmdline;
        cmdline = NOLINE;
@@ -506,7 +545,7 @@ struct compcmd cblock;
     if (arg)
        cmd->c_flags |= CF_COND;
     if (cmdline == NOLINE)
-       cmd->c_line = line;
+       cmd->c_line = curcmd->c_line;
     else {
        cmd->c_line = cmdline;
        cmdline = NOLINE;
@@ -701,6 +740,8 @@ int acmd;
             arg->arg_type == O_SLT || arg->arg_type == O_SGT) {
        if (arg[1].arg_type == A_STAB || arg[1].arg_type == A_LVAL) {
            if (arg[2].arg_type == A_SINGLE) {
+               char *junk = str_get(arg[2].arg_ptr.arg_str);
+
                cmd->c_stab  = arg[1].arg_ptr.arg_stab;
                cmd->c_short = str_smake(arg[2].arg_ptr.arg_str);
                cmd->c_slen  = cmd->c_short->str_cur+1;
@@ -898,8 +939,8 @@ char *s;
     else
        (void)sprintf(tname,"next char %c",yychar);
     (void)sprintf(buf, "%s in file %s at line %d, %s\n",
-      s,filename,line,tname);
-    if (line == multi_end && multi_start < multi_end)
+      s,filename,curcmd->c_line,tname);
+    if (curcmd->c_line == multi_end && multi_start < multi_end)
        sprintf(buf+strlen(buf),
          "  (Might be a runaway multi-line %c%c string starting on line %d)\n",
          multi_open,multi_close,multi_start);
@@ -908,7 +949,7 @@ char *s;
     else
        fputs(buf,stderr);
     if (++error_count >= 10)
-       fatal("Too many errors\n");
+       fatal("%s has too many errors.\n", filename);
 }
 
 void
@@ -1118,10 +1159,12 @@ register CMD *cmd;
        }
        tofree = cmd;
        cmd = cmd->c_next;
-       Safefree(tofree);
+       if (tofree != head)             /* to get Saber to shut up */
+           Safefree(tofree);
        if (cmd && cmd == head)         /* reached end of while loop */
            break;
     }
+    Safefree(head);
 }
 
 arg_free(arg)
index b918448..a7db58b 100644 (file)
--- a/consarg.c
+++ b/consarg.c
@@ -1,4 +1,4 @@
-/* $Header: consarg.c,v 3.0.1.5 90/03/27 15:36:45 lwall Locked $
+/* $Header: consarg.c,v 3.0.1.6 90/08/09 02:38:51 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.6  90/08/09  02:38:51  lwall
+ * patch19: fixed problem with % of negative number
+ * 
  * 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
  * 
@@ -60,6 +63,7 @@ ARG *limarg;
            arg_free(limarg);
        }
        else {
+           arg[3].arg_flags = 0;
            arg[3].arg_type = A_EXPR;
            arg[3].arg_ptr.arg_arg = limarg;
        }
@@ -308,7 +312,6 @@ register ARG *arg;
                arg->arg_len = 1;
                arg[1].arg_type = A_ARYSTAB;    /* $abc[123] is hoistable now */
                arg[1].arg_len = i;
-               arg[1].arg_ptr = arg[1].arg_ptr;        /* get stab pointer */
                str_free(s2);
            }
            /* FALL THROUGH */
@@ -351,7 +354,7 @@ register ARG *arg;
            if (tmp2 >= 0)
                str_numset(str,(double)(tmp2 % tmplong));
            else
-               str_numset(str,(double)(tmplong - (-tmp2 % tmplong)));
+               str_numset(str,(double)(tmplong - ((-tmp2 - 1) % tmplong))) - 1;
 #else
            tmp2 = tmp2;
 #endif
@@ -945,6 +948,7 @@ ARG *arg;
     if (arg->arg_len == 0)
        arg[1].arg_type = A_NULL;
     arg->arg_len = 2;
+    arg[2].arg_flags = 0;
     arg[2].arg_ptr.arg_hash = curstash;
     arg[2].arg_type = A_NULL;
     return arg;
diff --git a/doarg.c b/doarg.c
index 029ba38..48b614e 100644 (file)
--- a/doarg.c
+++ b/doarg.c
@@ -1,4 +1,4 @@
-/* $Header: doarg.c,v 3.0.1.5 90/03/27 15:39:03 lwall Locked $
+/* $Header: doarg.c,v 3.0.1.6 90/08/09 02:48:38 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,15 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       doarg.c,v $
+ * Revision 3.0.1.6  90/08/09  02:48:38  lwall
+ * patch19: fixed double include of <signal.h>
+ * patch19: pack/unpack can now do native float and double
+ * patch19: pack/unpack can now have absolute and negative positioning
+ * patch19: pack/unpack can now have use * to specify all the rest of input
+ * patch19: unpack can do checksumming
+ * patch19: $< and $> better supported on machines without setreuid
+ * patch19: Added support for linked-in C subroutines
+ * 
  * 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
@@ -40,7 +49,9 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+#ifndef NSIG
 #include <signal.h>
+#endif
 
 extern unsigned char fold[];
 
@@ -83,7 +94,7 @@ int sp;
        if (spat->spat_regexp)
            regfree(spat->spat_regexp);
        spat->spat_regexp = regcomp(m,m+dstr->str_cur,
-           spat->spat_flags & SPAT_FOLD,1);
+           spat->spat_flags & SPAT_FOLD);
        if (spat->spat_flags & SPAT_KEEP) {
            arg_free(spat->spat_runtime);       /* it won't change, so */
            spat->spat_runtime = Nullarg;       /* no point compiling again */
@@ -381,6 +392,8 @@ int *arglast;
     long along;
     unsigned long aulong;
     char *aptr;
+    float afloat;
+    double adouble;
 
     items = arglast[2] - sp;
     st += ++sp;
@@ -388,7 +401,11 @@ int *arglast;
     while (pat < patend) {
 #define NEXTFROM (items-- > 0 ? *st++ : &str_no)
        datumtype = *pat++;
-       if (isdigit(*pat)) {
+       if (*pat == '*') {
+           len = index("@Xxu",datumtype) ? 0 : items;
+           pat++;
+       }
+       else if (isdigit(*pat)) {
            len = *pat++ - '0';
            while (isdigit(*pat))
                len = (len * 10) + (*pat++ - '0');
@@ -398,7 +415,25 @@ int *arglast;
        switch(datumtype) {
        default:
            break;
+       case '%':
+           fatal("% may only be used in unpack");
+       case '@':
+           len -= str->str_cur;
+           if (len > 0)
+               goto grow;
+           len = -len;
+           if (len > 0)
+               goto shrink;
+           break;
+       case 'X':
+         shrink:
+           str->str_cur -= len;
+           if (str->str_cur < 0)
+               fatal("X outside of string");
+           str->str_ptr[str->str_cur] = '\0';
+           break;
        case 'x':
+         grow:
            while (len >= 10) {
                str_ncat(str,null10,10);
                len -= 10;
@@ -409,6 +444,8 @@ int *arglast;
        case 'a':
            fromstr = NEXTFROM;
            aptr = str_get(fromstr);
+           if (pat[-1] == '*')
+               len = fromstr->str_cur;
            if (fromstr->str_cur > len)
                str_ncat(str,aptr,len);
            else {
@@ -439,6 +476,23 @@ int *arglast;
                str_ncat(str,&achar,sizeof(char));
            }
            break;
+       /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
+       case 'f':
+       case 'F':
+           while (len-- > 0) {
+               fromstr = NEXTFROM;
+               afloat = (float)str_gnum(fromstr);
+               str_ncat(str, (char *)&afloat, sizeof (float));
+           }
+           break;
+       case 'd':
+       case 'D':
+           while (len-- > 0) {
+               fromstr = NEXTFROM;
+               adouble = (double)str_gnum(fromstr);
+               str_ncat(str, (char *)&adouble, sizeof (double));
+           }
+           break;
        case 'n':
            while (len-- > 0) {
                fromstr = NEXTFROM;
@@ -502,12 +556,55 @@ int *arglast;
                str_ncat(str,(char*)&aptr,sizeof(char*));
            }
            break;
+       case 'u':
+           fromstr = NEXTFROM;
+           aptr = str_get(fromstr);
+           aint = fromstr->str_cur;
+           STR_GROW(str,aint * 4 / 3);
+           if (len <= 1)
+               len = 45;
+           else
+               len = len / 3 * 3;
+           while (aint > 0) {
+               int todo;
+
+               if (aint > len)
+                   todo = len;
+               else
+                   todo = aint;
+               doencodes(str, aptr, todo);
+               aint -= todo;
+               aptr += todo;
+           }
+           break;
        }
     }
     STABSET(str);
 }
 #undef NEXTFROM
 
+doencodes(str, s, len)
+register STR *str;
+register char *s;
+register int len;
+{
+    char hunk[5];
+
+    *hunk = len + ' ';
+    str_ncat(str, hunk, 1);
+    hunk[4] = '\0';
+    while (len > 0) {
+       hunk[0] = ' ' + (077 & (*s >> 2));
+       hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
+       hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
+       hunk[3] = ' ' + (077 & (s[2] & 077));
+       str_ncat(str, hunk, 4);
+       s += 3;
+       len -= 3;
+    }
+    str_ncat(str, "\n", 1);
+}
+
 void
 do_sprintf(str,len,sarg)
 register STR *str;
@@ -718,17 +815,23 @@ int *arglast;
     }
     if (!stab)
        fatal("Undefined subroutine called");
+    saveint(&wantarray);
+    wantarray = gimme;
     sub = stab_sub(stab);
     if (!sub)
        fatal("Undefined subroutine \"%s\" called", stab_name(stab));
+    if (sub->usersub) {
+       st[sp] = arg->arg_ptr.arg_str;
+       if ((arg[2].arg_type & A_MASK) == A_NULL)
+           items = 0;
+       return sub->usersub(sub->userindex,sp,items);
+    }
     if ((arg[2].arg_type & A_MASK) != A_NULL) {
        savearray = stab_xarray(defstab);
        stab_xarray(defstab) = afake(defstab, items, &st[sp+1]);
     }
     savelong(&sub->depth);
     sub->depth++;
-    saveint(&wantarray);
-    wantarray = gimme;
     if (sub->depth >= 2) {     /* save temporaries on recursion? */
        if (sub->depth == 100 && dowarn)
            warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
@@ -783,9 +886,8 @@ int *arglast;
     }
     if (!stab)
        fatal("Undefined subroutine called");
-    sub = stab_sub(stab);
-    if (!sub)
-       fatal("Undefined subroutine \"%s\" called", stab_name(stab));
+    saveint(&wantarray);
+    wantarray = gimme;
 /* begin differences */
     str = stab_val(DBsub);
     saveitem(str);
@@ -800,8 +902,6 @@ int *arglast;
     }
     savelong(&sub->depth);
     sub->depth++;
-    saveint(&wantarray);
-    wantarray = gimme;
     if (sub->depth >= 2) {     /* save temporaries on recursion? */
        if (sub->depth == 100 && dowarn)
            warn("Deep recursion on subroutine \"%s\"",stab_name(stab));
@@ -938,14 +1038,22 @@ int *arglast;
        }
     }
     if (delaymagic > 1) {
+       if (delaymagic & DM_REUID) {
 #ifdef SETREUID
-       if (delaymagic & DM_REUID)
            setreuid(uid,euid);
+#else
+           if (uid != euid || setuid(uid) < 0)
+               fatal("No setreuid available");
 #endif
+       }
+       if (delaymagic & DM_REGID) {
 #ifdef SETREGID
-       if (delaymagic & DM_REGID)
            setregid(gid,egid);
+#else
+           if (gid != egid || setgid(gid) < 0)
+               fatal("No setregid available");
 #endif
+       }
     }
     delaymagic = 0;
     localizing = FALSE;
@@ -1057,12 +1165,12 @@ int *arglast;
        retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
     else if (type == O_HASH || type == O_LHASH)
        retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
-    else if (type == O_SUBR || type == O_DBSUBR)
-       retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
     else if (type == O_ASLICE || type == O_LASLICE)
        retval = stab_xarray(arg[1].arg_ptr.arg_stab) != 0;
     else if (type == O_HSLICE || type == O_LHSLICE)
        retval = stab_xhash(arg[1].arg_ptr.arg_stab) != 0;
+    else if (type == O_SUBR || type == O_DBSUBR)
+       retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
     else
        retval = FALSE;
     str_numset(str,(double)retval);
diff --git a/doio.c b/doio.c
index 7667e5c..88c0f4c 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1,4 +1,4 @@
-/* $Header: doio.c,v 3.0.1.8 90/03/27 15:44:02 lwall Locked $
+/* $Header: doio.c,v 3.0.1.9 90/08/09 02:56:19 lwall Locked $
  *
  *    Copyright (c) 1989, Larry Wall
  *
@@ -6,6 +6,14 @@
  *    as specified in the README file that comes with the perl 3.0 kit.
  *
  * $Log:       doio.c,v $
+ * Revision 3.0.1.9  90/08/09  02:56:19  lwall
+ * patch19: various MSDOS and OS/2 patches folded in
+ * patch19: prints now check error status better
+ * patch19: printing a list with null elements only printed front of list
+ * patch19: on machines with vfork child would allocate memory in parent
+ * patch19: getsockname and getpeername gave bogus warning on error
+ * patch19: MACH doesn't have seekdir or telldir
+ * 
  * 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
@@ -68,6 +76,9 @@
 #ifdef I_UTIME
 #include <utime.h>
 #endif
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
 
 bool
 do_open(stab,name,len)
@@ -261,9 +272,20 @@ register STAB *stab;
                fileuid = statbuf.st_uid;
                filegid = statbuf.st_gid;
                if (*inplace) {
+#ifdef SUFFIX
+                   add_suffix(str,inplace);
+#else
                    str_cat(str,inplace);
+#endif
 #ifdef RENAME
+#ifndef MSDOS
                    (void)rename(oldname,str->str_ptr);
+#else
+                   do_close(stab,FALSE);
+                   (void)unlink(str->str_ptr);
+                   (void)rename(oldname,str->str_ptr);
+                   do_open(stab,str->str_ptr,stab_val(stab)->str_cur);
+#endif /* MSDOS */
 #else
                    (void)UNLINK(str->str_ptr);
                    (void)link(oldname,str->str_ptr);
@@ -271,7 +293,11 @@ register STAB *stab;
 #endif
                }
                else {
+#ifndef MSDOS
                    (void)UNLINK(oldname);
+#else
+                   fatal("Can't do inplace edit without backup");
+#endif
                }
 
                str_nset(str,">",1);
@@ -510,7 +536,7 @@ STR *argstr;
        retval = 256;                   /* otherwise guess at what's safe */
 #endif
        if (argstr->str_cur < retval) {
-           str_grow(argstr,retval+1);
+           Str_Grow(argstr,retval+1);
            argstr->str_cur = retval;
        }
 
@@ -631,6 +657,64 @@ int *arglast;
     return sp;
 }
 
+int
+do_truncate(str,arg,gimme,arglast)
+STR *str;
+register ARG *arg;
+int gimme;
+int *arglast;
+{
+    register ARRAY *ary = stack;
+    register int sp = arglast[0] + 1;
+    off_t len = (off_t)str_gnum(ary->ary_array[sp+1]);
+    int result = 1;
+    STAB *tmpstab;
+
+#if defined(TRUNCATE) || defined(CHSIZE) || defined(F_FREESP)
+#ifdef TRUNCATE
+    if ((arg[1].arg_type & A_MASK) == A_WORD) {
+       tmpstab = arg[1].arg_ptr.arg_stab;
+       if (!stab_io(tmpstab) ||
+         ftruncate(fileno(stab_io(tmpstab)->ifp), len) < 0)
+           result = 0;
+    }
+    else if (truncate(str_get(ary->ary_array[sp]), len) < 0)
+       result = 0;
+#else
+#ifndef CHSIZE
+#define chsize(f,l) fcntl(f,F_FREESP,l)
+#endif
+    if ((arg[1].arg_type & A_MASK) == A_WORD) {
+       tmpstab = arg[1].arg_ptr.arg_stab;
+       if (!stab_io(tmpstab) ||
+         chsize(fileno(stab_io(tmpstab)->ifp), len) < 0)
+           result = 0;
+    }
+    else {
+       int tmpfd;
+
+       if ((tmpfd = open(str_get(ary->ary_array[sp]), 0)) < 0)
+           result = 0;
+       else {
+           if (chsize(tmpfd, len) < 0)
+               result = 0;
+           close(tmpfd);
+       }
+    }
+#endif
+
+    if (result)
+       str_sset(str,&str_yes);
+    else
+       str_sset(str,&str_undef);
+    STABSET(str);
+    ary->ary_array[sp] = str;
+    return sp;
+#else
+    fatal("truncate not implemented");
+#endif
+}
+
 int
 looks_like_number(str)
 STR *str;
@@ -687,11 +771,13 @@ FILE *fp;
        return FALSE;
     }
     if (!str)
-       return FALSE;
+       return TRUE;
     if (ofmt &&
       ((str->str_nok && str->str_u.str_nval != 0.0)
-       || (looks_like_number(str) && str_gnum(str) != 0.0) ) )
+       || (looks_like_number(str) && str_gnum(str) != 0.0) ) ) {
        fprintf(fp, ofmt, str->str_u.str_nval);
+       return !ferror(fp);
+    }
     else {
        tmps = str_get(str);
        if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'a' && tmps[3] == 'b'
@@ -700,7 +786,7 @@ FILE *fp;
            str = ((STAB*)str)->str_magic;
            putc('*',fp);
        }
-       if (str->str_cur && fwrite(tmps,1,str->str_cur,fp) == 0)
+       if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp)))
            return FALSE;
     }
     return TRUE;
@@ -731,7 +817,7 @@ int *arglast;
        retval = (items <= 0);
        for (; items > 0; items--,st++) {
            if (retval && ofslen) {
-               if (fwrite(ofs, 1, ofslen, fp) == 0) {
+               if (fwrite(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
                    retval = FALSE;
                    break;
                }
@@ -740,7 +826,7 @@ int *arglast;
                break;
        }
        if (retval && orslen)
-           if (fwrite(ors, 1, orslen, fp) == 0)
+           if (fwrite(ors, 1, orslen, fp) == 0 || ferror(fp))
                retval = FALSE;
     }
     return retval;
@@ -898,15 +984,29 @@ int *arglast;
     return FALSE;
 }
 
+static char **Argv = Null(char **);
+static char *Cmd = Nullch;
+
+int
+do_execfree()
+{
+    if (Argv) {
+       Safefree(Argv);
+       Argv = Null(char **);
+    }
+    if (Cmd) {
+       Safefree(Cmd);
+       Cmd = Nullch;
+    }
+}
+
 bool
 do_exec(cmd)
 char *cmd;
 {
     register char **a;
     register char *s;
-    char **argv;
     char flags[10];
-    char *cmd2;
 
 #ifdef TAINT
     taintenv();
@@ -958,10 +1058,10 @@ char *cmd;
            return FALSE;
        }
     }
-    New(402,argv, (s - cmd) / 2 + 2, char*);
-    cmd2 = nsavestr(cmd, s-cmd);
-    a = argv;
-    for (s = cmd2; *s;) {
+    New(402,Argv, (s - cmd) / 2 + 2, char*);
+    Cmd = nsavestr(cmd, s-cmd);
+    a = Argv;
+    for (s = Cmd; *s;) {
        while (*s && isspace(*s)) s++;
        if (*s)
            *(a++) = s;
@@ -970,16 +1070,14 @@ char *cmd;
            *s++ = '\0';
     }
     *a = Nullch;
-    if (argv[0]) {
-       execvp(argv[0],argv);
+    if (Argv[0]) {
+       execvp(Argv[0],Argv);
        if (errno == ENOEXEC) {         /* for system V NIH syndrome */
-           Safefree(argv);
-           Safefree(cmd2);
+           do_execfree();
            goto doshell;
        }
     }
-    Safefree(cmd2);
-    Safefree(argv);
+    do_execfree();
     return FALSE;
 }
 
@@ -1250,11 +1348,11 @@ int *arglast;
     switch (optype) {
     case O_GETSOCKNAME:
        if (getsockname(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
-           goto nuts;
+           goto nuts2;
        break;
     case O_GETPEERNAME:
        if (getpeername(fd, st[sp]->str_ptr, &st[sp]->str_cur) < 0)
-           goto nuts;
+           goto nuts2;
        break;
     }
     
@@ -1263,6 +1361,7 @@ int *arglast;
 nuts:
     if (dowarn)
        warn("get{sock,peer}name() on closed fd");
+nuts2:
     st[sp] = &str_undef;
     return sp;
 
@@ -1522,6 +1621,9 @@ int *arglast;
     return sp;
 }
 
+#endif /* SOCKET */
+
+#ifdef SELECT
 int
 do_select(gimme,arglast)
 int gimme;
@@ -1581,7 +1683,7 @@ int *arglast;
        j = str->str_len;
        if (j < growsize) {
            if (str->str_pok) {
-               str_grow(str,growsize);
+               Str_Grow(str,growsize);
                s = str_get(str) + j;
                while (++j <= growsize) {
                    *s++ = '\0';
@@ -1651,7 +1753,9 @@ int *arglast;
     }
     return sp;
 }
+#endif /* SELECT */
 
+#ifdef SOCKET
 int
 do_spair(stab1, stab2, arglast)
 STAB *stab1;
@@ -1711,13 +1815,11 @@ int *arglast;
 #ifdef I_PWD
     register ARRAY *ary = stack;
     register int sp = arglast[0];
-    register char **elem;
     register STR *str;
     struct passwd *getpwnam();
     struct passwd *getpwuid();
     struct passwd *getpwent();
     struct passwd *pwent;
-    unsigned long len;
 
     if (gimme != G_ARRAY) {
        astore(ary, ++sp, str_static(&str_undef));
@@ -1797,7 +1899,6 @@ int *arglast;
     struct group *getgrgid();
     struct group *getgrent();
     struct group *grent;
-    unsigned long len;
 
     if (gimme != G_ARRAY) {
        astore(ary, ++sp, str_static(&str_undef));
@@ -1895,6 +1996,11 @@ int *arglast;
 #endif
        }
        break;
+#if MACH
+    case O_TELLDIR:
+    case O_SEEKDIR:
+        goto nope;
+#else
     case O_TELLDIR:
        st[sp] = str_static(&str_undef);
        str_numset(st[sp], (double)telldir(stio->dirp));
@@ -1904,6 +2010,7 @@ int *arglast;
        along = (long)str_gnum(st[sp+1]);
        (void)seekdir(stio->dirp,along);
        break;
+#endif
     case O_REWINDDIR:
        st[sp] = str_static(&str_undef);
        (void)rewinddir(stio->dirp);
index d3b0354..f910db7 100644 (file)
@@ -10,7 +10,7 @@
 ;# usage:
 ;#
 ;#     #include <ctime.pl>          # see the -P and -I option in perl.man
-;#     $Date = do ctime(time);
+;#     $Date = &ctime(time);
 
 @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
 @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
index 37c7e31..49ea5df 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 20
+#define PATCHLEVEL 21
diff --git a/usub/curses.mus b/usub/curses.mus
new file mode 100644 (file)
index 0000000..9973684
--- /dev/null
@@ -0,0 +1,673 @@
+/* $Header: curses.mus,v 3.0.1.1 90/08/09 04:05:21 lwall Locked $
+ *
+ * $Log:       curses.mus,v $
+ * Revision 3.0.1.1  90/08/09  04:05:21  lwall
+ * patch19: Initial revision
+ * 
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+extern int wantarray;
+
+char *savestr();
+
+#include <curses.h>
+
+static enum uservars {
+    UV_curscr,
+    UV_stdscr,
+    UV_Def_term,
+    UV_My_term,
+    UV_ttytype,
+    UV_LINES,
+    UV_COLS,
+    UV_ERR,
+    UV_OK,
+};
+
+static enum usersubs {
+    US_addch,
+    US_waddch,
+    US_addstr,
+    US_waddstr,
+    US_box,
+    US_clear,
+    US_wclear,
+    US_clearok,
+    US_clrtobot,
+    US_wclrtobot,
+    US_clrtoeol,
+    US_wclrtoeol,
+    US_delch,
+    US_wdelch,
+    US_deleteln,
+    US_wdeleteln,
+    US_erase,
+    US_werase,
+    US_flushok,
+    US_idlok,
+    US_insch,
+    US_winsch,
+    US_insertln,
+    US_winsertln,
+    US_move,
+    US_wmove,
+    US_overlay,
+    US_overwrite,
+    US_printw,
+    US_wprintw,
+    US_refresh,
+    US_wrefresh,
+    US_standout,
+    US_wstandout,
+    US_standend,
+    US_wstandend,
+    US_cbreak,
+    US_nocbreak,
+    US_echo,
+    US_noecho,
+    US_getch,
+    US_wgetch,
+    US_getstr,
+    US_wgetstr,
+    US_raw,
+    US_noraw,
+    US_scanw,
+    US_wscanw,
+    US_baudrate,
+    US_delwin,
+    US_endwin,
+    US_erasechar,
+    US_getcap,
+    US_getyx,
+    US_inch,
+    US_winch,
+    US_initscr,
+    US_killchar,
+    US_leaveok,
+    US_longname,
+    US_fullname,
+    US_mvwin,
+    US_newwin,
+    US_nl,
+    US_nonl,
+    US_scrollok,
+    US_subwin,
+    US_touchline,
+    US_touchoverlap,
+    US_touchwin,
+    US_unctrl,
+    US_gettmode,
+    US_mvcur,
+    US_scroll,
+    US_savetty,
+    US_resetty,
+    US_setterm,
+    US_tstp,
+    US__putchar,
+};
+
+static int usersub();
+static int userset();
+static int userval();
+
+int
+init_curses()
+{
+    struct ufuncs uf;
+    char *filename = "curses.c";
+
+    uf.uf_set = userset;
+    uf.uf_val = userval;
+
+#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
+
+    MAGICVAR("curscr", UV_curscr);
+    MAGICVAR("stdscr", UV_stdscr);
+    MAGICVAR("Def_term",UV_Def_term);
+    MAGICVAR("My_term",        UV_My_term);
+    MAGICVAR("ttytype",        UV_ttytype);
+    MAGICVAR("LINES",  UV_LINES);
+    MAGICVAR("COLS",   UV_COLS);
+    MAGICVAR("ERR",    UV_ERR);
+    MAGICVAR("OK",     UV_OK);
+
+    make_usub("addch",         US_addch,       usersub, filename);
+    make_usub("waddch",                US_waddch,      usersub, filename);
+    make_usub("addstr",                US_addstr,      usersub, filename);
+    make_usub("waddstr",       US_waddstr,     usersub, filename);
+    make_usub("box",           US_box,         usersub, filename);
+    make_usub("clear",         US_clear,       usersub, filename);
+    make_usub("wclear",                US_wclear,      usersub, filename);
+    make_usub("clearok",       US_clearok,     usersub, filename);
+    make_usub("clrtobot",      US_clrtobot,    usersub, filename);
+    make_usub("wclrtobot",     US_wclrtobot,   usersub, filename);
+    make_usub("clrtoeol",      US_clrtoeol,    usersub, filename);
+    make_usub("wclrtoeol",     US_wclrtoeol,   usersub, filename);
+    make_usub("delch",         US_delch,       usersub, filename);
+    make_usub("wdelch",                US_wdelch,      usersub, filename);
+    make_usub("deleteln",      US_deleteln,    usersub, filename);
+    make_usub("wdeleteln",     US_wdeleteln,   usersub, filename);
+    make_usub("erase",         US_erase,       usersub, filename);
+    make_usub("werase",                US_werase,      usersub, filename);
+    make_usub("flushok",       US_flushok,     usersub, filename);
+    make_usub("idlok",         US_idlok,       usersub, filename);
+    make_usub("insch",         US_insch,       usersub, filename);
+    make_usub("winsch",                US_winsch,      usersub, filename);
+    make_usub("insertln",      US_insertln,    usersub, filename);
+    make_usub("winsertln",     US_winsertln,   usersub, filename);
+    make_usub("move",          US_move,        usersub, filename);
+    make_usub("wmove",         US_wmove,       usersub, filename);
+    make_usub("overlay",       US_overlay,     usersub, filename);
+    make_usub("overwrite",     US_overwrite,   usersub, filename);
+    make_usub("printw",                US_printw,      usersub, filename);
+    make_usub("wprintw",       US_wprintw,     usersub, filename);
+    make_usub("refresh",       US_refresh,     usersub, filename);
+    make_usub("wrefresh",      US_wrefresh,    usersub, filename);
+    make_usub("standout",      US_standout,    usersub, filename);
+    make_usub("wstandout",     US_wstandout,   usersub, filename);
+    make_usub("standend",      US_standend,    usersub, filename);
+    make_usub("wstandend",     US_wstandend,   usersub, filename);
+    make_usub("cbreak",                US_cbreak,      usersub, filename);
+    make_usub("nocbreak",      US_nocbreak,    usersub, filename);
+    make_usub("echo",          US_echo,        usersub, filename);
+    make_usub("noecho",                US_noecho,      usersub, filename);
+    make_usub("getch",         US_getch,       usersub, filename);
+    make_usub("wgetch",                US_wgetch,      usersub, filename);
+    make_usub("getstr",                US_getstr,      usersub, filename);
+    make_usub("wgetstr",       US_wgetstr,     usersub, filename);
+    make_usub("raw",           US_raw,         usersub, filename);
+    make_usub("noraw",         US_noraw,       usersub, filename);
+    make_usub("scanw",         US_scanw,       usersub, filename);
+    make_usub("wscanw",                US_wscanw,      usersub, filename);
+    make_usub("baudrate",      US_baudrate,    usersub, filename);
+    make_usub("delwin",                US_delwin,      usersub, filename);
+    make_usub("endwin",                US_endwin,      usersub, filename);
+    make_usub("erasechar",     US_erasechar,   usersub, filename);
+    make_usub("getcap",                US_getcap,      usersub, filename);
+    make_usub("getyx",         US_getyx,       usersub, filename);
+    make_usub("inch",          US_inch,        usersub, filename);
+    make_usub("winch",         US_winch,       usersub, filename);
+    make_usub("initscr",       US_initscr,     usersub, filename);
+    make_usub("killchar",      US_killchar,    usersub, filename);
+    make_usub("leaveok",       US_leaveok,     usersub, filename);
+    make_usub("longname",      US_longname,    usersub, filename);
+    make_usub("fullname",      US_fullname,    usersub, filename);
+    make_usub("mvwin",         US_mvwin,       usersub, filename);
+    make_usub("newwin",                US_newwin,      usersub, filename);
+    make_usub("nl",            US_nl,          usersub, filename);
+    make_usub("nonl",          US_nonl,        usersub, filename);
+    make_usub("scrollok",      US_scrollok,    usersub, filename);
+    make_usub("subwin",                US_subwin,      usersub, filename);
+    make_usub("touchline",     US_touchline,   usersub, filename);
+    make_usub("touchoverlap",  US_touchoverlap,usersub, filename);
+    make_usub("touchwin",      US_touchwin,    usersub, filename);
+    make_usub("unctrl",                US_unctrl,      usersub, filename);
+    make_usub("gettmode",      US_gettmode,    usersub, filename);
+    make_usub("mvcur",         US_mvcur,       usersub, filename);
+    make_usub("scroll",                US_scroll,      usersub, filename);
+    make_usub("savetty",       US_savetty,     usersub, filename);
+    make_usub("resetty",       US_resetty,     usersub, filename);
+    make_usub("setterm",       US_setterm,     usersub, filename);
+    make_usub("tstp",          US_tstp,        usersub, filename);
+    make_usub("_putchar",      US__putchar,    usersub, filename);
+};
+
+static int
+usersub(ix, sp, items)
+int ix;
+register int sp;
+register int items;
+{
+    STR **st = stack->ary_array + sp;
+    register int i;
+    register char *tmps;
+    register STR *Str;         /* used in str_get and str_gnum macros */
+
+    switch (ix) {
+CASE int addch
+I      char            ch
+END
+
+CASE int waddch
+I      WINDOW*         win
+I      char            ch
+END
+
+CASE int addstr
+I      char*           str
+END
+
+CASE int waddstr
+I      WINDOW*         win
+I      char*           str
+END
+
+CASE int box
+I      WINDOW*         win
+I      char            vert
+I      char            hor
+END
+
+CASE int clear
+END
+
+CASE int wclear
+I      WINDOW*         win
+END
+
+CASE int clearok
+I      WINDOW*         win
+I      bool            boolf
+END
+
+CASE int clrtobot
+END
+
+CASE int wclrtobot
+I      WINDOW*         win
+END
+
+CASE int clrtoeol
+END
+
+CASE int wclrtoeol
+I      WINDOW*         win
+END
+
+CASE int delch
+END
+
+CASE int wdelch
+I      WINDOW*         win
+END
+
+CASE int deleteln
+END
+
+CASE int wdeleteln
+I      WINDOW*         win
+END
+
+CASE int erase
+END
+
+CASE int werase
+I      WINDOW*         win
+END
+
+CASE int flushok
+I      WINDOW*         win
+I      bool            boolf
+END
+
+CASE int idlok
+I      WINDOW*         win
+I      bool            boolf
+END
+
+CASE int insch
+I      char            c
+END
+
+CASE int winsch
+I      WINDOW*         win
+I      char            c
+END
+
+CASE int insertln
+END
+
+CASE int winsertln
+I      WINDOW*         win
+END
+
+CASE int move
+I      int             y
+I      int             x
+END
+
+CASE int wmove
+I      WINDOW*         win
+I      int             y
+I      int             x
+END
+
+CASE int overlay
+I      WINDOW*         win1
+I      WINDOW*         win2
+END
+
+CASE int overwrite
+I      WINDOW*         win1
+I      WINDOW*         win2
+END
+
+    case US_printw:
+       if (items < 1)
+           fatal("Usage: &printw($fmt, $arg1, $arg2, ... )");
+       else {
+           int retval;
+           STR*        str =           str_new(0);
+
+           do_sprintf(str, items - 1, st + 1);
+           retval = addstr(str->str_ptr);
+           str_numset(st[0], (double) retval);
+           str_free(str);
+       }
+       return sp;
+
+    case US_wprintw:
+       if (items < 2)
+           fatal("Usage: &wprintw($win, $fmt, $arg1, $arg2, ... )");
+       else {
+           int retval;
+           STR*        str =           str_new(0);
+           WINDOW*     win =           *(WINDOW**)     str_get(st[1]);
+
+           do_sprintf(str, items - 1, st + 1);
+           retval = waddstr(win, str->str_ptr);
+           str_numset(st[0], (double) retval);
+           str_free(str);
+       }
+       return sp;
+
+CASE int refresh
+END
+
+CASE int wrefresh
+I      WINDOW*         win
+END
+
+CASE int standout
+END
+
+CASE int wstandout
+I      WINDOW*         win
+END
+
+CASE int standend
+END
+
+CASE int wstandend
+I      WINDOW*         win
+END
+
+CASE int cbreak
+END
+
+CASE int nocbreak
+END
+
+CASE int echo
+END
+
+CASE int noecho
+END
+
+    case US_getch:
+        if (items != 0)
+            fatal("Usage: &getch()");
+        else {
+            int retval;
+           char retch;
+
+            retval = getch();
+           if (retval == EOF)
+               st[0] = &str_undef;
+           else {
+               retch = retval;
+               str_nset(st[0], &retch, 1);
+           }
+        }
+        return sp;
+
+    case US_wgetch:
+        if (items != 1)
+            fatal("Usage: &wgetch($win)");
+        else {
+            int retval;
+           char retch;
+            WINDOW*     win =           *(WINDOW**)     str_get(st[1]);
+
+            retval = wgetch(win);
+           if (retval == EOF)
+               st[0] = &str_undef;
+           else {
+               retch = retval;
+               str_nset(st[0], &retch, 1);
+           }
+        }
+        return sp;
+
+CASE int getstr
+IO     char*           str
+END
+
+CASE int wgetstr
+I      WINDOW*         win
+IO     char*           str
+END
+
+CASE int raw
+END
+
+CASE int noraw
+END
+
+CASE int baudrate
+END
+
+CASE int delwin
+I      WINDOW*         win
+END
+
+CASE int endwin
+END
+
+CASE int erasechar
+END
+
+CASE char* getcap
+I      char*           str
+END
+
+    case US_getyx:
+       if (items != 3)
+           fatal("Usage: &getyx($win, $y, $x)");
+       else {
+           int retval;
+           STR*        str =           str_new(0);
+           WINDOW*     win =           *(WINDOW**)     str_get(st[1]);
+           int         y;
+           int         x;
+
+           do_sprintf(str, items - 1, st + 1);
+           retval = getyx(win, y, x);
+           str_numset(st[2], (double)y);
+           str_numset(st[3], (double)x);
+           str_numset(st[0], (double) retval);
+           str_free(str);
+       }
+       return sp;
+
+       
+CASE int inch
+END
+
+CASE int winch
+I      WINDOW*         win
+END
+
+CASE WINDOW* initscr
+END
+
+CASE int killchar
+END
+
+CASE int leaveok
+I      WINDOW*         win
+I      bool            boolf
+END
+
+CASE char* longname
+I      char*           termbuf
+IO     char*           name
+END
+
+CASE int fullname
+I      char*           termbuf
+IO     char*           name
+END
+
+CASE int mvwin
+I      WINDOW*         win
+I      int             y
+I      int             x
+END
+
+CASE WINDOW* newwin
+I      int             lines
+I      int             cols
+I      int             begin_y
+I      int             begin_x
+END
+
+CASE int nl
+END
+
+CASE int nonl
+END
+
+CASE int scrollok
+I      WINDOW*         win
+I      bool            boolf
+END
+
+CASE WINDOW* subwin
+I      WINDOW*         win
+I      int             lines
+I      int             cols
+I      int             begin_y
+I      int             begin_x
+END
+
+CASE int touchline
+I      WINDOW*         win
+I      int             y
+I      int             startx
+I      int             endx
+END
+
+CASE int touchoverlap
+I      WINDOW*         win1
+I      WINDOW*         win2
+END
+
+CASE int touchwin
+I      WINDOW*         win
+END
+
+CASE char* unctrl
+I      char            ch
+END
+
+CASE int gettmode
+END
+
+CASE int mvcur
+I      int             lasty
+I      int             lastx
+I      int             newy
+I      int             newx
+END
+
+CASE int scroll
+I      WINDOW*         win
+END
+
+CASE int savetty
+END
+
+CASE void resetty
+END
+
+CASE int setterm
+I      char*           name
+END
+
+CASE int tstp
+END
+
+CASE int _putchar
+I      char            ch
+END
+
+    default:
+       fatal("Unimplemented user-defined subroutine");
+    }
+    return sp;
+}
+
+static int
+userval(ix, str)
+int ix;
+STR *str;
+{
+    switch (ix) {
+    case UV_COLS:
+       str_numset(str, (double)COLS);
+       break;
+    case UV_Def_term:
+       str_set(str, Def_term);
+       break;
+    case UV_ERR:
+       str_numset(str, (double)ERR);
+       break;
+    case UV_LINES:
+       str_numset(str, (double)LINES);
+       break;
+    case UV_My_term:
+       str_numset(str, (double)My_term);
+       break;
+    case UV_OK:
+       str_numset(str, (double)OK);
+       break;
+    case UV_curscr:
+       str_nset(str, &curscr, sizeof(WINDOW*));
+       break;
+    case UV_stdscr:
+       str_nset(str, &stdscr, sizeof(WINDOW*));
+       break;
+    case UV_ttytype:
+       str_set(str, ttytype);
+       break;
+    }
+    return 0;
+}
+
+static int
+userset(ix, str)
+int ix;
+STR *str;
+{
+    switch (ix) {
+    case UV_COLS:
+       COLS = (int)str_gnum(str);
+       break;
+    case UV_Def_term:
+       Def_term = savestr(str_get(str));       /* never freed */
+       break;
+    case UV_LINES:
+       LINES = (int)str_gnum(str);
+       break;
+    case UV_My_term:
+       My_term = (bool)str_gnum(str);
+       break;
+    case UV_ttytype:
+       strcpy(ttytype, str_get(str));          /* hope it fits */
+       break;
+    }
+    return 0;
+}