perl 4.0 patch 13: patch #11, continued
Larry Wall [Tue, 5 Nov 1991 06:28:20 +0000 (06:28 +0000)]
See patch #11.

config_h.SH
cons.c
consarg.c
doSH
doarg.c
patchlevel.h
usub/curses.mus

index 895703a..dc2281e 100644 (file)
@@ -24,6 +24,7 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
  * that running config.h.SH again will wipe out any changes you've made.
  * For a more permanent change edit config.sh and rerun config.h.SH.
  */
+ /*SUPPRESS 460*/
 
 
 /* EUNICE
@@ -55,7 +56,7 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
 
 /* BYTEORDER
  *     This symbol contains an encoding of the order of bytes in a long.
- *     Usual values (in octal) are 01234, 04321, 02143, 03412...
+ *     Usual values (in hex) are 0x1234, 0x4321, 0x2143, 0x3412...
  */
 #define BYTEORDER 0x$byteorder         /**/
 
@@ -752,9 +753,14 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef!/\*#undef!'
 #$i_my_dir     I_MY_DIR        /**/
 #$d_dirnamlen  DIRNAMLEN       /**/
 
+/* MYMALLOC
+ *     This symbol, if defined, indicates that we're using our own malloc.
+ */
 /* MALLOCPTRTYPE
  *     This symbol defines the kind of ptr returned by malloc and realloc.
  */
+#$d_mymalloc MYMALLOC                  /**/
+
 #define MALLOCPTRTYPE $mallocptrtype         /**/
 
 
diff --git a/cons.c b/cons.c
index f8ff4a6..a3572b3 100644 (file)
--- a/cons.c
+++ b/cons.c
@@ -1,4 +1,4 @@
-/* $RCSfile: cons.c,v $$Revision: 4.0.1.1 $$Date: 91/06/07 10:31:15 $
+/* $RCSfile: cons.c,v $$Revision: 4.0.1.2 $$Date: 91/11/05 16:15:13 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,10 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       cons.c,v $
+ * Revision 4.0.1.2  91/11/05  16:15:13  lwall
+ * patch11: debugger got confused over nested subroutine definitions
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * 
  * Revision 4.0.1.1  91/06/07  10:31:15  lwall
  * patch4: new copyright notice
  * patch4: added global modifier for pattern matches
@@ -74,8 +78,7 @@ CMD *cmd;
        STR *str;
        STR *tmpstr = str_mortal(&str_undef);
 
-       sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr,
-         (long)subline);
+       sprintf(buf,"%s:%ld",stab_val(curcmd->c_filestab)->str_ptr, subline);
        str = str_make(buf,0);
        str_cat(str,"-");
        sprintf(buf,"%ld",(long)curcmd->c_line);
@@ -83,9 +86,7 @@ CMD *cmd;
        name = str_get(subname);
        stab_fullname(tmpstr,stab);
        hstore(stab_xhash(DBsub), tmpstr->str_ptr, tmpstr->str_cur, str, 0);
-       str_set(subname,"main");
     }
-    subline = 0;
     return sub;
 }
 
@@ -732,6 +733,7 @@ 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) {
+               /*SUPPRESS 594*/
                char *junk = str_get(arg[2].arg_ptr.arg_str);
 
                cmd->c_stab  = arg[1].arg_ptr.arg_stab;
@@ -908,7 +910,7 @@ char *s;
 
     if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
       oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
-       while (isspace(*oldoldbufptr))
+       while (isSPACE(*oldoldbufptr))
            oldoldbufptr++;
        strncpy(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
        tmp2buf[bufptr - oldoldbufptr] = '\0';
@@ -916,7 +918,7 @@ char *s;
     }
     else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
       oldbufptr != bufptr) {
-       while (isspace(*oldbufptr))
+       while (isSPACE(*oldbufptr))
            oldbufptr++;
        strncpy(tmp2buf, oldbufptr, bufptr - oldbufptr);
        tmp2buf[bufptr - oldbufptr] = '\0';
@@ -1083,6 +1085,7 @@ register CMD *cmd;
                break;
            tail = tail->c_next;
        }
+       /*SUPPRESS 530*/
        for ( ; tail->c_next; tail = tail->c_next) ;
     }
 
@@ -1118,7 +1121,7 @@ register CMD *cmd;
     cmd->c_flags &= ~CF_OPTIMIZE;      /* clear optimization type */
     cmd->c_flags |= CFT_ARRAY;         /* and set it to do the iteration */
     cmd->c_stab = eachstab;
-    cmd->c_short = str_new(0);         /* just to save a field in struct cmd */
+    cmd->c_short = Str_new(23,0);      /* just to save a field in struct cmd */
     cmd->c_short->str_u.str_useful = -1;
 
     return cmd;
@@ -1268,6 +1271,7 @@ register SPAT *spat;
            for (sp = stash->tbl_spatroot;
              sp && sp->spat_next != spat;
              sp = sp->spat_next)
+               /*SUPPRESS 530*/
                ;
            if (sp)
                sp->spat_next = spat->spat_next;
index b338e6d..2ff52d9 100644 (file)
--- a/consarg.c
+++ b/consarg.c
@@ -1,4 +1,4 @@
-/* $RCSfile: consarg.c,v $$Revision: 4.0.1.2 $$Date: 91/06/07 10:33:12 $
+/* $RCSfile: consarg.c,v $$Revision: 4.0.1.3 $$Date: 91/11/05 16:21:16 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,13 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       consarg.c,v $
+ * Revision 4.0.1.3  91/11/05  16:21:16  lwall
+ * patch11: random cleanup
+ * patch11: added eval {}
+ * patch11: added sort {} LIST
+ * patch11: "foo" x -1 dumped core
+ * patch11: substr() and vec() weren't allowed in an lvalue list
+ * 
  * Revision 4.0.1.2  91/06/07  10:33:12  lwall
  * patch4: new copyright notice
  * patch4: length($`), length($&), length($') now optimized to avoid string copy
@@ -54,8 +61,11 @@ ARG *limarg;
            arg[3].arg_ptr.arg_arg = limarg;
        }
     }
-    else
+    else {
+       arg[3].arg_flags = 0;
        arg[3].arg_type = A_NULL;
+       arg[3].arg_ptr.arg_arg = Nullarg;
+    }
     arg->arg_type = O_SPLIT;
     spat = arg[2].arg_ptr.arg_spat;
     spat->spat_repl = stab2arg(A_STAB,aadd(stab));
@@ -154,6 +164,7 @@ ARG *arg3;
 
     arg = op_new(newlen);
     arg->arg_type = type;
+    /*SUPPRESS 560*/
     if (chld = arg1) {
        if (chld->arg_type == O_ITEM &&
            (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
@@ -173,6 +184,7 @@ ARG *arg3;
            arg[1].arg_ptr.arg_arg = chld;
        }
     }
+    /*SUPPRESS 560*/
     if (chld = arg2) {
        if (chld->arg_type == O_ITEM && 
            (hoistable[chld[1].arg_type&A_MASK] || 
@@ -193,6 +205,7 @@ ARG *arg3;
            arg[2].arg_ptr.arg_arg = chld;
        }
     }
+    /*SUPPRESS 560*/
     if (chld = arg3) {
        if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
            arg[3].arg_type = chld[1].arg_type;
@@ -300,6 +313,19 @@ register ARG *arg;
     switch (arg->arg_type) {
     default:
        return arg;
+    case O_SORT:
+       if (arg[1].arg_type == A_CMD)
+           arg[1].arg_type |= A_DONT;
+       return arg;
+    case O_EVAL:
+       if (arg[1].arg_type == A_CMD) {
+           arg->arg_type = O_TRY;
+           arg[1].arg_type |= A_DONT;
+           return arg;
+       }
+       CHECK1;
+       arg->arg_type = O_EVALONCE;
+       return arg;
     case O_AELEM:
        CHECK2;
        i = (int)str_gnum(s2);
@@ -322,10 +348,12 @@ register ARG *arg;
        i = (int)str_gnum(s2);
        tmps = str_get(s1);
        str_nset(str,"",0);
-       STR_GROW(str, i * s1->str_cur + 1);
-       repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
-       str->str_cur = i * s1->str_cur;
-       str->str_ptr[str->str_cur] = '\0';
+       if (i > 0) {
+           STR_GROW(str, i * s1->str_cur + 1);
+           repeatcpy(str->str_ptr, tmps, s1->str_cur, i);
+           str->str_cur = i * s1->str_cur;
+           str->str_ptr[str->str_cur] = '\0';
+       }
        break;
     case O_MULTIPLY:
        CHECK12;
@@ -338,7 +366,7 @@ register ARG *arg;
        if (value == 0.0)
            yyerror("Illegal division by constant zero");
        else
-#ifdef cray
+#ifdef SLOPPYDIVIDE
        /* insure that 20./5. == 4. */
        {
            double x;
@@ -497,7 +525,11 @@ register ARG *arg;
        break;
     case O_NOT:
        CHECK1;
+#ifdef NOTNOT
+       { char xxx = str_true(s1); str_numset(str,(double)!xxx); }
+#else
        str_numset(str,(double)(!str_true(s1)));
+#endif
        break;
     case O_COMPLEMENT:
        CHECK1;
@@ -704,6 +736,12 @@ register ARG *arg;
                    case O_HSLICE: case O_LHSLICE:
                        arg1[i].arg_ptr.arg_arg->arg_type = O_LHSLICE;
                        break;
+                   case O_SUBSTR: case O_VEC:
+                       (void)l(arg1[i].arg_ptr.arg_arg);
+                       Renewc(arg1[i].arg_ptr.arg_arg->arg_ptr.arg_str, 1,
+                         struct lstring, STR);
+                           /* grow string struct to hold an lstring struct */
+                       break;
                    default:
                        goto ill_item;
                    }
@@ -802,10 +840,9 @@ register ARG *arg;
            Renewc(arg1->arg_ptr.arg_str, 1, struct lstring, STR);
                        /* grow string struct to hold an lstring struct */
        }
-       else if (arg1->arg_type == O_ASSIGN) {
-/*         if (arg->arg_type == O_CHOP)
-               arg[1].arg_flags &= ~AF_ARYOK;  /* grandfather chop idiom */
-       }
+       else if (arg1->arg_type == O_ASSIGN)
+           /*SUPPRESS 530*/
+           ;
        else {
            (void)sprintf(tokenbuf,
              "Illegal expression (%s) as lvalue",opname[arg1->arg_type]);
@@ -980,7 +1017,7 @@ ARG *
 listish(arg)
 ARG *arg;
 {
-    if (arg->arg_flags & AF_LISTISH)
+    if (arg && arg->arg_flags & AF_LISTISH)
        arg = make_op(O_LIST,1,arg,Nullarg,Nullarg);
     return arg;
 }
diff --git a/doSH b/doSH
index 4b02784..ec3a1fc 100644 (file)
--- a/doSH
+++ b/doSH
@@ -3,6 +3,8 @@
 : if this fails, just run all the .SH files by hand
 . ./config.sh
 
+rm -f x2p/config.sh
+
 echo " "
 echo "Doing variable substitutions on .SH files..."
 set x `awk '{print $1}' <MANIFEST | grep '\.SH'`
@@ -21,16 +23,17 @@ for file in $*; do
     */*)
        dir=`expr X$file : 'X\(.*\)/'`
        file=`expr X$file : 'X.*/\(.*\)'`
-       (cd $dir && . $file)
+       (cd $dir && . ./$file)
        ;;
     *)
-       . $file
+       . ./$file
        ;;
     esac
 done
 if test -f config.h.SH; then
     if test ! -f config.h; then
        : oops, they left it out of MANIFEST, probably, so do it anyway.
-       . config.h.SH
+       . ./config.h.SH
     fi
 fi
+exit 0
diff --git a/doarg.c b/doarg.c
index e339536..9785d46 100644 (file)
--- a/doarg.c
+++ b/doarg.c
@@ -1,4 +1,4 @@
-/* $RCSfile: doarg.c,v $$Revision: 4.0.1.3 $$Date: 91/06/10 01:18:41 $
+/* $RCSfile: doarg.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 16:35:06 $
  *
  *    Copyright (c) 1991, Larry Wall
  *
@@ -6,6 +6,15 @@
  *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       doarg.c,v $
+ * Revision 4.0.1.4  91/11/05  16:35:06  lwall
+ * patch11: /$foo/o optimizer could access deallocated data
+ * patch11: minimum match length calculation in regexp is now cumulative
+ * patch11: added some support for 64-bit integers
+ * patch11: prepared for ctype implementations that don't define isascii()
+ * patch11: sprintf() now supports any length of s field
+ * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work
+ * patch11: defined(&$foo) and undef(&$foo) didn't work
+ * 
  * Revision 4.0.1.3  91/06/10  01:18:41  lwall
  * patch10: pack(hh,1) dumped core
  * 
@@ -78,9 +87,9 @@ int sp;
        spat->spat_regexp = regcomp(m,m+dstr->str_cur,
            spat->spat_flags & SPAT_FOLD);
        if (spat->spat_flags & SPAT_KEEP) {
+           scanconst(spat, m, dstr->str_cur);
            arg_free(spat->spat_runtime);       /* it won't change, so */
            spat->spat_runtime = Nullarg;       /* no point compiling again */
-           scanconst(spat, m, dstr->str_cur);
            hoistmust(spat);
             if (curcmd->c_expr && (curcmd->c_flags & CF_OPTIMIZE) == CFT_EVAL) {
                 curcmd->c_flags &= ~CF_OPTIMIZE;
@@ -151,7 +160,7 @@ int sp;
        }
        c = str_get(dstr);
        clen = dstr->str_cur;
-       if (clen <= spat->spat_slen + (int)spat->spat_regexp->regback) {
+       if (clen <= spat->spat_regexp->minlen) {
                                        /* can do inplace substitution */
            if (regexec(spat->spat_regexp, s, strend, orig, 0,
              str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) {
@@ -181,6 +190,7 @@ int sp;
                        stack->ary_array[++sp] = arg->arg_ptr.arg_str;
                        return sp;
                    }
+                   /*SUPPRESS 560*/
                    else if (i = m - s) {       /* faster from front */
                        d -= clen;
                        m = d;
@@ -217,6 +227,7 @@ int sp;
                    if (iters++ > maxiters)
                        fatal("Substitution loop");
                    m = spat->spat_regexp->startp[0];
+                   /*SUPPRESS 560*/
                    if (i = m - s) {
                        if (s != d)
                            (void)bcopy(s,d,i);
@@ -407,6 +418,7 @@ int *arglast;
     register int len;
     int datumtype;
     STR *fromstr;
+    /*SUPPRESS 442*/
     static char *null10 = "\0\0\0\0\0\0\0\0\0\0";
     static char *space10 = "          ";
 
@@ -417,6 +429,10 @@ int *arglast;
     unsigned int auint;
     long along;
     unsigned long aulong;
+#ifdef QUAD
+    quad aquad;
+    unsigned quad auquad;
+#endif
     char *aptr;
     float afloat;
     double adouble;
@@ -431,9 +447,9 @@ int *arglast;
            len = index("@Xxu",datumtype) ? 0 : items;
            pat++;
        }
-       else if (isdigit(*pat)) {
+       else if (isDIGIT(*pat)) {
            len = *pat++ - '0';
-           while (isdigit(*pat))
+           while (isDIGIT(*pat))
                len = (len * 10) + (*pat++ - '0');
        }
        else
@@ -573,7 +589,7 @@ int *arglast;
                items = 0;
                if (datumtype == 'H') {
                    for (len = 0; len++ < aint;) {
-                       if (isalpha(*pat))
+                       if (isALPHA(*pat))
                            items |= ((*pat++ & 15) + 9) & 15;
                        else
                            items |= *pat++ & 15;
@@ -587,7 +603,7 @@ int *arglast;
                }
                else {
                    for (len = 0; len++ < aint;) {
-                       if (isalpha(*pat))
+                       if (isALPHA(*pat))
                            items |= (((*pat++ & 15) + 9) & 15) << 4;
                        else
                            items |= (*pat++ & 15) << 4;
@@ -691,6 +707,22 @@ int *arglast;
                str_ncat(str,(char*)&along,sizeof(long));
            }
            break;
+#ifdef QUAD
+       case 'Q':
+           while (len-- > 0) {
+               fromstr = NEXTFROM;
+               auquad = (unsigned quad)str_gnum(fromstr);
+               str_ncat(str,(char*)&auquad,sizeof(unsigned quad));
+           }
+           break;
+       case 'q':
+           while (len-- > 0) {
+               fromstr = NEXTFROM;
+               aquad = (quad)str_gnum(fromstr);
+               str_ncat(str,(char*)&aquad,sizeof(quad));
+           }
+           break;
+#endif /* QUAD */
        case 'p':
            while (len-- > 0) {
                fromstr = NEXTFROM;
@@ -761,38 +793,49 @@ register STR **sarg;
     register char *t;
     register char *f;
     bool dolong;
+#ifdef QUAD
+    bool doquad;
+#endif /* QUAD */
     char ch;
     static STR *sargnull = &str_no;
     register char *send;
+    register STR *arg;
     char *xs;
     int xlen;
+    int pre;
+    int post;
     double value;
-    char *origs;
 
     str_set(str,"");
     len--;                     /* don't count pattern string */
-    origs = t = s = str_get(*sarg);
+    t = s = str_get(*sarg);
     send = s + (*sarg)->str_cur;
     sarg++;
     for ( ; ; len--) {
-       if (len <= 0 || !*sarg) {
-           sarg = &sargnull;
-           len = 0;
-       }
+
+       /*SUPPRESS 560*/
+       if (len <= 0 || !(arg = *sarg++))
+           arg = sargnull;
+
+       /*SUPPRESS 530*/
        for ( ; t < send && *t != '%'; t++) ;
        if (t >= send)
            break;              /* end of format string, ignore extra args */
        f = t;
        *buf = '\0';
        xs = buf;
+#ifdef QUAD
+       doquad =
+#endif /* QUAD */
        dolong = FALSE;
+       pre = post = 0;
        for (t++; t < send; t++) {
            switch (*t) {
            default:
                ch = *(++t);
                *t = '\0';
                (void)sprintf(xs,f);
-               len++;
+               len++, sarg--;
                xlen = strlen(xs);
                break;
            case '0': case '1': case '2': case '3': case '4':
@@ -800,12 +843,18 @@ register STR **sarg;
            case '.': case '#': case '-': case '+': case ' ':
                continue;
            case 'l':
+#ifdef QUAD
+               if (dolong) {
+                   dolong = FALSE;
+                   doquad = TRUE;
+               } else
+#endif
                dolong = TRUE;
                continue;
            case 'c':
                ch = *(++t);
                *t = '\0';
-               xlen = (int)str_gnum(*(sarg++));
+               xlen = (int)str_gnum(arg);
                if (strEQ(f,"%c")) { /* some printfs fail on null chars */
                    *xs = xlen;
                    xs[1] = '\0';
@@ -822,10 +871,15 @@ register STR **sarg;
            case 'd':
                ch = *(++t);
                *t = '\0';
+#ifdef QUAD
+               if (doquad)
+                   (void)sprintf(buf,s,(quad)str_gnum(arg));
+               else
+#endif
                if (dolong)
-                   (void)sprintf(xs,f,(long)str_gnum(*(sarg++)));
+                   (void)sprintf(xs,f,(long)str_gnum(arg));
                else
-                   (void)sprintf(xs,f,(int)str_gnum(*(sarg++)));
+                   (void)sprintf(xs,f,(int)str_gnum(arg));
                xlen = strlen(xs);
                break;
            case 'X': case 'O':
@@ -834,7 +888,12 @@ register STR **sarg;
            case 'x': case 'o': case 'u':
                ch = *(++t);
                *t = '\0';
-               value = str_gnum(*(sarg++));
+               value = str_gnum(arg);
+#ifdef QUAD
+               if (doquad)
+                   (void)sprintf(buf,s,(unsigned quad)value);
+               else
+#endif
                if (dolong)
                    (void)sprintf(xs,f,U_L(value));
                else
@@ -844,28 +903,55 @@ register STR **sarg;
            case 'E': case 'e': case 'f': case 'G': case 'g':
                ch = *(++t);
                *t = '\0';
-               (void)sprintf(xs,f,str_gnum(*(sarg++)));
+               (void)sprintf(xs,f,str_gnum(arg));
                xlen = strlen(xs);
                break;
            case 's':
                ch = *(++t);
                *t = '\0';
-               xs = str_get(*sarg);
-               xlen = (*sarg)->str_cur;
+               xs = str_get(arg);
+               xlen = arg->str_cur;
                if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0'
                  && xlen == sizeof(STBP)) {
                    STR *tmpstr = Str_new(24,0);
 
-                   stab_fullname(tmpstr, ((STAB*)(*sarg))); /* a stab value! */
+                   stab_fullname(tmpstr, ((STAB*)arg)); /* a stab value! */
                    sprintf(tokenbuf,"*%s",tmpstr->str_ptr);
                                        /* reformat to non-binary */
                    xs = tokenbuf;
                    xlen = strlen(tokenbuf);
                    str_free(tmpstr);
                }
-               sarg++;
                if (strEQ(f,"%s")) {    /* some printfs fail on >128 chars */
-                   break;              /* so handle simple case */
+                   break;              /* so handle simple cases */
+               }
+               else if (f[1] == '-') {
+                   char *mp = index(f, '.');
+                   int min = atoi(f+2);
+
+                   if (xlen < min)
+                       post = min - xlen;
+                   else if (mp) {
+                       int max = atoi(mp+1);
+
+                       if (xlen > max)
+                           xlen = max;
+                   }
+                   break;
+               }
+               else if (isDIGIT(f[1])) {
+                   char *mp = index(f, '.');
+                   int min = atoi(f+1);
+
+                   if (xlen < min)
+                       pre = min - xlen;
+                   else if (mp) {
+                       int max = atoi(mp+1);
+
+                       if (xlen > max)
+                           xlen = max;
+                   }
+                   break;
                }
                strcpy(tokenbuf+64,f);  /* sprintf($s,...$s...) */
                *t = ch;
@@ -876,9 +962,17 @@ register STR **sarg;
            }
            /* end of switch, copy results */
            *t = ch;
-           STR_GROW(str, str->str_cur + (f - s) + len + 1);
+           STR_GROW(str, str->str_cur + (f - s) + xlen + 1 + pre + post);
            str_ncat(str, s, f - s);
+           if (pre) {
+               repeatcpy(str->str_ptr + str->str_cur, " ", 1, pre);
+               str->str_cur += pre;
+           }
            str_ncat(str, xs, xlen);
+           if (post) {
+               repeatcpy(str->str_ptr + str->str_cur, " ", 1, post);
+               str->str_cur += post;
+           }
            s = t;
            break;              /* break from for loop */
        }
@@ -946,7 +1040,7 @@ int *arglast;
     if ((arg[1].arg_type & A_MASK) == A_WORD)
        stab = arg[1].arg_ptr.arg_stab;
     else {
-       STR *tmpstr = stab_val(arg[1].arg_ptr.arg_stab);
+       STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
 
        if (tmpstr)
            stab = stabent(str_get(tmpstr),TRUE);
@@ -1034,7 +1128,7 @@ int *arglast;
     HASH *hash;
     int i;
 
-    makelocal = (arg->arg_flags & AF_LOCAL);
+    makelocal = (arg->arg_flags & AF_LOCAL) != 0;
     localizing = makelocal;
     delaymagic = DM_DELAY;             /* catch simultaneous items */
 
@@ -1044,6 +1138,7 @@ int *arglast;
      */
     if (arg->arg_flags & AF_COMMON) {
        for (relem = firstrelem; relem <= lastrelem; relem++) {
+           /*SUPPRESS 560*/
            if (str = *relem)
                *relem = str_mortal(str);
        }
@@ -1179,7 +1274,7 @@ int *arglast;
     }
 }
 
-int
+int                                    /*SUPPRESS 590*/
 do_study(str,arg,gimme,arglast)
 STR *str;
 ARG *arg;
@@ -1254,7 +1349,7 @@ int *arglast;
     return retarg;
 }
 
-int
+int                                    /*SUPPRESS 590*/
 do_defined(str,arg,gimme,arglast)
 STR *str;
 register ARG *arg;
@@ -1272,8 +1367,15 @@ int *arglast;
     arg = arg[1].arg_ptr.arg_arg;
     type = arg->arg_type;
 
-    if (type == O_SUBR || type == O_DBSUBR)
-       retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
+    if (type == O_SUBR || type == O_DBSUBR) {
+       if ((arg[1].arg_type & A_MASK) == A_WORD)
+           retval = stab_sub(arg[1].arg_ptr.arg_stab) != 0;
+       else {
+           STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
+
+           retval = tmpstr && stab_sub(stabent(str_get(tmpstr),TRUE)) != 0;
+       }
+    }
     else if (type == O_ARRAY || type == O_LARRAY ||
             type == O_ASLICE || type == O_LASLICE )
        retval = ((ary = stab_xarray(arg[1].arg_ptr.arg_stab)) != 0
@@ -1289,7 +1391,7 @@ int *arglast;
     return retarg;
 }
 
-int
+int                                            /*SUPPRESS 590*/
 do_undef(str,arg,gimme,arglast)
 STR *str;
 register ARG *arg;
@@ -1325,7 +1427,15 @@ int *arglast;
     }
     else if (type == O_SUBR || type == O_DBSUBR) {
        stab = arg[1].arg_ptr.arg_stab;
-       if (stab_sub(stab)) {
+       if ((arg[1].arg_type & A_MASK) != A_WORD) {
+           STR *tmpstr = STAB_STR(arg[1].arg_ptr.arg_stab);
+
+           if (tmpstr)
+               stab = stabent(str_get(tmpstr),TRUE);
+           else
+               stab = Nullstab;
+       }
+       if (stab && stab_sub(stab)) {
            cmd_free(stab_sub(stab)->cmd);
            stab_sub(stab)->cmd = Nullcmd;
            afree(stab_sub(stab)->tosave);
@@ -1376,9 +1486,10 @@ int *arglast;
            if (size == 8)
                retnum = s[offset];
            else if (size == 16)
-               retnum = (s[offset] << 8) + s[offset+1];
+               retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
            else if (size == 32)
-               retnum = (s[offset] << 24) + (s[offset + 1] << 16) +
+               retnum = ((unsigned long) s[offset] << 24) +
+                       ((unsigned long) s[offset + 1] << 16) +
                        (s[offset + 2] << 8) + s[offset+3];
        }
 
@@ -1458,6 +1569,7 @@ register STR *str;
     if (str->str_state == SS_HASH) {
        hash = stab_hash(str->str_u.str_stab);
        (void)hiterinit(hash);
+       /*SUPPRESS 560*/
        while (entry = hiternext(hash))
            do_chop(astr,hiterval(hash,entry));
        return;
index bc5f1c8..910cae8 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 12
+#define PATCHLEVEL 13
index 7bacb6b..ce53a38 100644 (file)
@@ -1,6 +1,9 @@
-/* $Header: curses.mus,v 4.0 91/03/20 01:56:13 lwall Locked $
+/* $RCSfile: curses.mus,v $$Revision: 4.0.1.1 $$Date: 91/11/05 19:06:19 $
  *
  * $Log:       curses.mus,v $
+ * Revision 4.0.1.1  91/11/05  19:06:19  lwall
+ * patch11: usub/curses.mus now supports SysV curses
+ * 
  * Revision 4.0  91/03/20  01:56:13  lwall
  * 4.0 baseline.
  * 
 
 #include "EXTERN.h"
 #include "perl.h"
-extern int wantarray;
 
 char *savestr();
 
+#undef bool
 #include <curses.h>
 
+#ifndef A_UNDERLINE
+#define NOSETATTR
+#define A_STANDOUT  0x0200
+#define A_UNDERLINE 0x0100
+#define A_REVERSE   0x0200
+#define A_BLINK     0x0400
+#define A_BOLD      0x0800
+#define A_ALTCHARSET 0x1000    
+#define A_NORMAL    0
+#endif
+
+#ifdef USG
+static char *tcbuf = NULL;
+#endif
+
+#ifdef NOSETATTR
+static unsigned curattr = NORMAL;
+#endif
+
 static enum uservars {
     UV_curscr,
     UV_stdscr,
-    UV_Def_term,
-    UV_My_term,
     UV_ttytype,
     UV_LINES,
     UV_COLS,
     UV_ERR,
     UV_OK,
+#ifdef BSD
+    UV_Def_term,
+    UV_My_term,
+#endif    
+    UV_A_STANDOUT,
+    UV_A_UNDERLINE,
+    UV_A_REVERSE,
+    UV_A_BLINK,
+    UV_A_DIM,
+    UV_A_BOLD,
+    UV_A_NORMAL,
 };
 
 static enum usersubs {
@@ -48,7 +79,6 @@ static enum usersubs {
     US_wdeleteln,
     US_erase,
     US_werase,
-    US_flushok,
     US_idlok,
     US_insch,
     US_winsch,
@@ -58,8 +88,6 @@ static enum usersubs {
     US_wmove,
     US_overlay,
     US_overwrite,
-    US_printw,
-    US_wprintw,
     US_refresh,
     US_wrefresh,
     US_standout,
@@ -76,13 +104,10 @@ static enum usersubs {
     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,
@@ -90,7 +115,6 @@ static enum usersubs {
     US_killchar,
     US_leaveok,
     US_longname,
-    US_fullname,
     US_mvwin,
     US_newwin,
     US_nl,
@@ -98,7 +122,6 @@ static enum usersubs {
     US_scrollok,
     US_subwin,
     US_touchline,
-    US_touchoverlap,
     US_touchwin,
     US_unctrl,
     US_gettmode,
@@ -107,8 +130,28 @@ static enum usersubs {
     US_savetty,
     US_resetty,
     US_setterm,
+    US_attroff,
+    US_wattroff,
+    US_attron,
+    US_wattron,
+    US_attrset,
+    US_wattrset,
+#ifdef CURSEFMT
+    US_printw, /* remove */
+    US_wprintw, /* remove */
+    US_scanw,  /* delete */
+    US_wscanw,         /* delete */
+#endif
+    US_getcap,
+#ifdef BSD
+    US_flushok,
+    US_fullname,
+    US_touchoverlap,
     US_tstp,
     US__putchar,
+#endif
+    US_mysub,
+    US_testcallback,
 };
 
 static int usersub();
@@ -128,13 +171,22 @@ init_curses()
 
     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);
+#ifdef BSD
+    MAGICVAR("Def_term",UV_Def_term);
+    MAGICVAR("My_term",        UV_My_term);
+#endif
+    MAGICVAR("A_STANDOUT", UV_A_STANDOUT);
+    MAGICVAR("A_UNDERLINE", UV_A_UNDERLINE);
+    MAGICVAR("A_REVERSE", UV_A_REVERSE);
+    MAGICVAR("A_BLINK", UV_A_BLINK);
+    MAGICVAR("A_DIM", UV_A_DIM);
+    MAGICVAR("A_BOLD", UV_A_BOLD);
+    MAGICVAR("A_NORMAL", UV_A_NORMAL);
 
     make_usub("addch",         US_addch,       usersub, filename);
     make_usub("waddch",                US_waddch,      usersub, filename);
@@ -154,7 +206,6 @@ init_curses()
     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);
@@ -164,8 +215,6 @@ init_curses()
     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);
@@ -182,13 +231,10 @@ init_curses()
     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);
@@ -196,7 +242,6 @@ init_curses()
     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);
@@ -204,7 +249,6 @@ init_curses()
     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);
@@ -213,10 +257,97 @@ init_curses()
     make_usub("savetty",       US_savetty,     usersub, filename);
     make_usub("resetty",       US_resetty,     usersub, filename);
     make_usub("setterm",       US_setterm,     usersub, filename);
+    make_usub("getcap",                US_getcap,      usersub, filename);
+    make_usub("attroff",        US_attroff,    usersub, filename);
+    make_usub("wattroff",       US_wattroff,   usersub, filename);
+    make_usub("attron",         US_attron,     usersub, filename);
+    make_usub("wattron",        US_wattron,    usersub, filename);
+    make_usub("attrset",        US_attrset,    usersub, filename);
+    make_usub("wattrset",       US_wattrset,   usersub, filename);
+#ifdef CURSEFMT
+    make_usub("printw",                US_printw,      usersub, filename);
+    make_usub("wprintw",       US_wprintw,     usersub, filename);
+    make_usub("scanw",         US_scanw,       usersub, filename);
+    make_usub("wscanw",                US_wscanw,      usersub, filename);
+#endif
+#ifdef BSD
+    make_usub("flushok",       US_flushok,     usersub, filename);
+    make_usub("fullname",      US_fullname,    usersub, filename);
+    make_usub("touchoverlap",  US_touchoverlap,usersub, filename);
     make_usub("tstp",          US_tstp,        usersub, filename);
     make_usub("_putchar",      US__putchar,    usersub, filename);
-};
+#endif
+    make_usub("testcallback",  US_testcallback,usersub, filename);
+  };
+  
+#ifdef USG
+static char
+*getcap(cap)
+register char *cap;
+{
+    static char nocaperr[] = "Cannot read termcap entry.";
+
+    extern char *tgetstr();
+
+    if (tcbuf == NULL) {
+       if ((tcbuf = malloc(1024)) == NULL) {
+           fatal(nocaperr);
+       }
+       if (tgetent(tcbuf, ttytype) == -1) {
+           fatal(nocaperr);
+       }
+    }
+
+    return (tgetstr(cap, NULL));
+}
+#endif
+
+#ifdef NOSETATTR
+#define attron(attr)    wattron(stdscr, attr)
+#define attroff(attr)   wattroff(stdscr, attr)
+#define attset(attr)    wattset(stdscr, attr)
+
+int
+wattron(win, attr)
+WINDOW *win;
+chtype attr;
+{
+    curattr |= attr;
+    if (curattr & A_STANDOUT) {
+       return(wstandout(win));
+    } else {
+       return(wstandend(win));
+    }
+}
+
+int
+wattroff(win, attr)
+WINDOW *win;
+chtype attr;
+{
+    curattr &= (~attr);
+    if (curattr & A_STANDOUT) {
+       return(wstandout(win));
+    } else {
+       return(wstandend(win));
+    }
+}
 
+int
+wattrset(win, attr)
+WINDOW *win;
+chtype attr;
+{
+    curattr = attr;
+    if (curattr & A_STANDOUT) {
+       return(wstandout(win));
+    } else {
+       return(wstandend(win));
+    }
+}
+
+#endif
+    
 static int
 usersub(ix, sp, items)
 int ix;
@@ -300,11 +431,6 @@ 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
@@ -347,35 +473,6 @@ 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
 
@@ -410,47 +507,47 @@ CASE int noecho
 END
 
     case US_getch:
-        if (items != 0)
-            fatal("Usage: &getch()");
-        else {
-            int retval;
+       if (items != 0)
+           fatal("Usage: &getch()");
+       else {
+           int retval;
            char retch;
 
-            retval = getch();
+           retval = getch();
            if (retval == EOF)
                st[0] = &str_undef;
            else {
                retch = retval;
                str_nset(st[0], &retch, 1);
            }
-        }
-        return sp;
+       }
+       return sp;
 
     case US_wgetch:
-        if (items != 1)
-            fatal("Usage: &wgetch($win)");
-        else {
-            int retval;
+       if (items != 1)
+           fatal("Usage: &wgetch($win)");
+       else {
+           int retval;
            char retch;
-            WINDOW*     win =           *(WINDOW**)     str_get(st[1]);
+           WINDOW*     win =           *(WINDOW**)     str_get(st[1]);
 
-            retval = wgetch(win);
+           retval = wgetch(win);
            if (retval == EOF)
                st[0] = &str_undef;
            else {
                retch = retval;
                str_nset(st[0], &retch, 1);
            }
-        }
-        return sp;
+       }
+       return sp;
 
 CASE int getstr
-IO     char*           str
+O      char*           str
 END
 
 CASE int wgetstr
 I      WINDOW*         win
-IO     char*           str
+O      char*           str
 END
 
 CASE int raw
@@ -472,10 +569,6 @@ END
 CASE int erasechar
 END
 
-CASE char* getcap
-I      char*           str
-END
-
     case US_getyx:
        if (items != 3)
            fatal("Usage: &getyx($win, $y, $x)");
@@ -494,7 +587,6 @@ END
            str_free(str);
        }
        return sp;
-
        
 CASE int inch
 END
@@ -514,15 +606,17 @@ I WINDOW*         win
 I      bool            boolf
 END
 
+#ifdef BSD
 CASE char* longname
 I      char*           termbuf
 IO     char*           name
 END
-
-CASE int fullname
-I      char*           termbuf
-IO     char*           name
+#else
+CASE char* longname
+I      char*           termbug
+I      char*           name
 END
+#endif
 
 CASE int mvwin
 I      WINDOW*         win
@@ -563,11 +657,6 @@ I  int             startx
 I      int             endx
 END
 
-CASE int touchoverlap
-I      WINDOW*         win1
-I      WINDOW*         win2
-END
-
 CASE int touchwin
 I      WINDOW*         win
 END
@@ -600,6 +689,82 @@ CASE int setterm
 I      char*           name
 END
 
+CASE int attroff
+I       chtype          str
+END
+
+CASE int wattroff
+I       chtype          str
+END
+
+CASE int wattron
+I       chtype          str
+END
+
+CASE int attron
+I       chtype          str
+END
+
+CASE int attrset
+I       chtype          str
+END
+
+CASE int wattrset
+I       chtype          str
+END
+
+#ifdef CURSEFMT
+    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;
+
+#endif
+
+CASE char* getcap
+I      char*           str
+END
+
+#ifdef BSD
+CASE int flushok
+I      WINDOW*         win
+I      bool            boolf
+END
+
+CASE int fullname
+I      char*           termbuf
+IO     char*           name
+END
+
+CASE int touchoverlap
+I      WINDOW*         win1
+I      WINDOW*         win2
+END
+
 CASE int tstp
 END
 
@@ -607,6 +772,12 @@ CASE int _putchar
 I      char            ch
 END
 
+    case US_testcallback:
+       sp = callback("callback", sp + items, curcsv->wantarray, 1, items);
+       break;
+
+#endif
+
     default:
        fatal("Unimplemented user-defined subroutine");
     }
@@ -622,18 +793,12 @@ STR *str;
     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;
@@ -646,6 +811,35 @@ STR *str;
     case UV_ttytype:
        str_set(str, ttytype);
        break;
+#ifdef BSD
+    case UV_Def_term:
+       str_set(str, Def_term);
+       break;
+    case UV_My_term:
+       str_numset(str, (double)My_term);
+       break;
+#endif
+    case UV_A_STANDOUT:
+       str_numset(str, (double)A_STANDOUT);
+       break;
+    case UV_A_UNDERLINE:
+       str_numset(str, (double)A_UNDERLINE);
+       break;
+    case UV_A_REVERSE:
+       str_numset(str, (double)A_REVERSE);
+       break;
+    case UV_A_BLINK:
+       str_numset(str, (double)A_BLINK);
+       break;
+    case UV_A_DIM:
+       str_numset(str, (double)A_DIM);
+       break;
+    case UV_A_BOLD:
+       str_numset(str, (double)A_BOLD);
+       break;
+    case UV_A_NORMAL:
+       str_numset(str, (double)A_NORMAL);
+       break;
     }
     return 0;
 }
@@ -659,18 +853,26 @@ STR *str;
     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 */
+#ifdef USG
+       if (tcbuf != NULL) {
+           free(tcbuf);
+           tcbuf = NULL;
+       }
+#endif 
+       break;
+#ifdef BSD
+    case UV_Def_term:
+       Def_term = savestr(str_get(str));       /* never freed */
+       break;
+    case UV_My_term:
+       My_term = (bool)str_gnum(str);
        break;
+#endif
     }
     return 0;
 }