X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=consarg.c;h=fe4542b3da404e57255cb3ebc3dae35aa1054bca;hb=68decaef0a08fcd5db3193f825cfdfc539b67ccb;hp=4252ad57c49b1c4c78be3b18d5e1b19dbba49829;hpb=afd9f252e30d37007c653bd21680f0b5f6c32608;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/consarg.c b/consarg.c
index 4252ad5..fe4542b 100644
--- a/consarg.c
+++ b/consarg.c
@@ -1,25 +1,33 @@
-/* $Header: consarg.c,v 3.0.1.3 90/02/28 16:47:54 lwall Locked $
+/* $RCSfile: consarg.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 12:26:27 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:	consarg.c,v $
- * Revision 3.0.1.3  90/02/28  16:47:54  lwall
- * patch9: the x operator is now up to 10 times faster
- * patch9: @_ clobbered by ($foo,$bar) = split
+ * Revision 4.0.1.4  92/06/08  12:26:27  lwall
+ * patch20: new warning for use of x with non-numeric right operand
+ * patch20: modulus with highest bit in left operand set didn't always work
+ * patch20: illegal lvalue message could be followed by core dump
+ * patch20: deleted some minor memory leaks
  * 
- * Revision 3.0.1.2  89/11/17  15:11:34  lwall
- * patch5: defined $foo{'bar'} should not create element
+ * 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 3.0.1.1  89/11/11  04:14:30  lwall
- * patch2: '-' x 26 made warnings about undefined value
- * patch2: eval with no args caused strangeness
- * patch2: local(@foo) didn't work, but local(@foo,$bar) did
+ * 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
  * 
- * Revision 3.0  89/10/18  15:10:30  lwall
- * 3.0 baseline
+ * Revision 4.0.1.1  91/04/11  17:38:34  lwall
+ * patch1: fixed "Bad free" error
+ * 
+ * Revision 4.0  91/03/20  01:06:15  lwall
+ * 4.0 baseline.
  * 
  */
 
@@ -54,12 +62,18 @@ ARG *limarg;
 	    arg_free(limarg);
 	}
 	else {
+	    arg[3].arg_flags = 0;
+	    arg[3].arg_len = 0;
 	    arg[3].arg_type = A_EXPR;
 	    arg[3].arg_ptr.arg_arg = limarg;
 	}
     }
-    else
+    else {
+	arg[3].arg_flags = 0;
+	arg[3].arg_len = 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));
@@ -82,6 +96,9 @@ register ARG *pat;
     register SPAT *spat;
     register ARG *newarg;
 
+    if (!pat)
+	return Nullarg;
+
     if ((pat->arg_type == O_MATCH ||
 	 pat->arg_type == O_SUBST ||
 	 pat->arg_type == O_TRANS ||
@@ -113,14 +130,16 @@ register ARG *pat;
 	if (pat->arg_len >= 2) {
 	    newarg[2].arg_type = pat[2].arg_type;
 	    newarg[2].arg_ptr = pat[2].arg_ptr;
+	    newarg[2].arg_len = pat[2].arg_len;
 	    newarg[2].arg_flags = pat[2].arg_flags;
 	    if (pat->arg_len >= 3) {
 		newarg[3].arg_type = pat[3].arg_type;
 		newarg[3].arg_ptr = pat[3].arg_ptr;
+		newarg[3].arg_len = pat[3].arg_len;
 		newarg[3].arg_flags = pat[3].arg_flags;
 	    }
 	}
-	Safefree(pat);
+	free_arg(pat);
     }
     else {
 	Newz(202,spat,1,SPAT);
@@ -146,17 +165,18 @@ ARG *arg3;
 {
     register ARG *arg;
     register ARG *chld;
-    register int doarg;
+    register unsigned doarg;
+    register int i;
     extern ARG *arg4;	/* should be normal arguments, really */
     extern ARG *arg5;
 
     arg = op_new(newlen);
     arg->arg_type = type;
-    doarg = opargs[type];
+    /*SUPPRESS 560*/
     if (chld = arg1) {
 	if (chld->arg_type == O_ITEM &&
-	    (hoistable[chld[1].arg_type] || chld[1].arg_type == A_LVAL ||
-	     (chld[1].arg_type == A_LEXPR &&
+	    (hoistable[ i = (chld[1].arg_type&A_MASK)] || i == A_LVAL ||
+	     (i == A_LEXPR &&
 	      (chld[1].arg_ptr.arg_arg->arg_type == O_LIST ||
 	       chld[1].arg_ptr.arg_arg->arg_type == O_ARRAY ||
 	       chld[1].arg_ptr.arg_arg->arg_type == O_HASH ))))
@@ -171,15 +191,11 @@ ARG *arg3;
 	    arg[1].arg_type = A_EXPR;
 	    arg[1].arg_ptr.arg_arg = chld;
 	}
-	if (!(doarg & 1))
-	    arg[1].arg_type |= A_DONT;
-	if (doarg & 2)
-	    arg[1].arg_flags |= AF_ARYOK;
     }
-    doarg >>= 2;
+    /*SUPPRESS 560*/
     if (chld = arg2) {
 	if (chld->arg_type == O_ITEM && 
-	    (hoistable[chld[1].arg_type] || 
+	    (hoistable[chld[1].arg_type&A_MASK] || 
 	     (type == O_ASSIGN && 
 	      ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT))
 		||
@@ -196,14 +212,10 @@ ARG *arg3;
 	    arg[2].arg_type = A_EXPR;
 	    arg[2].arg_ptr.arg_arg = chld;
 	}
-	if (!(doarg & 1))
-	    arg[2].arg_type |= A_DONT;
-	if (doarg & 2)
-	    arg[2].arg_flags |= AF_ARYOK;
     }
-    doarg >>= 2;
+    /*SUPPRESS 560*/
     if (chld = arg3) {
-	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
+	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
 	    arg[3].arg_type = chld[1].arg_type;
 	    arg[3].arg_ptr = chld[1].arg_ptr;
 	    arg[3].arg_len = chld[1].arg_len;
@@ -213,13 +225,9 @@ ARG *arg3;
 	    arg[3].arg_type = A_EXPR;
 	    arg[3].arg_ptr.arg_arg = chld;
 	}
-	if (!(doarg & 1))
-	    arg[3].arg_type |= A_DONT;
-	if (doarg & 2)
-	    arg[3].arg_flags |= AF_ARYOK;
     }
     if (newlen >= 4 && (chld = arg4)) {
-	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
+	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
 	    arg[4].arg_type = chld[1].arg_type;
 	    arg[4].arg_ptr = chld[1].arg_ptr;
 	    arg[4].arg_len = chld[1].arg_len;
@@ -231,7 +239,7 @@ ARG *arg3;
 	}
     }
     if (newlen >= 5 && (chld = arg5)) {
-	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type]) {
+	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
 	    arg[5].arg_type = chld[1].arg_type;
 	    arg[5].arg_ptr = chld[1].arg_ptr;
 	    arg[5].arg_len = chld[1].arg_len;
@@ -242,6 +250,14 @@ ARG *arg3;
 	    arg[5].arg_ptr.arg_arg = chld;
 	}
     }
+    doarg = opargs[type];
+    for (i = 1; i <= newlen; ++i) {
+	if (!(doarg & 1))
+	    arg[i].arg_type |= A_DONT;
+	if (doarg & 2)
+	    arg[i].arg_flags |= AF_ARYOK;
+	doarg >>= 2;
+    }
 #ifdef DEBUGGING
     if (debug & 16) {
 	fprintf(stderr,"%lx <= make_op(%s",arg,opname[arg->arg_type]);
@@ -263,15 +279,15 @@ ARG *arg3;
 	fprintf(stderr,")\n");
     }
 #endif
-    evalstatic(arg);		/* see if we can consolidate anything */
+    arg = evalstatic(arg);	/* see if we can consolidate anything */
     return arg;
 }
 
-void
+ARG *
 evalstatic(arg)
 register ARG *arg;
 {
-    register STR *str;
+    static STR *str = Nullstr;
     register STR *s1;
     register STR *s2;
     double value;		/* must not be register */
@@ -284,262 +300,371 @@ register ARG *arg;
     double sin(), cos(), atan2(), pow();
 
     if (!arg || !arg->arg_len)
-	return;
+	return arg;
 
-    if ((arg[1].arg_type == A_SINGLE || arg->arg_type == O_AELEM) &&
-        (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) {
+    if (!str)
 	str = Str_new(20,0);
+
+    if (arg[1].arg_type == A_SINGLE)
 	s1 = arg[1].arg_ptr.arg_str;
-	if (arg->arg_len > 1)
-	    s2 = arg[2].arg_ptr.arg_str;
-	else
-	    s2 = Nullstr;
-	switch (arg->arg_type) {
-	case O_AELEM:
-	    i = (int)str_gnum(s2);
-	    if (i < 32767 && i >= 0) {
-		arg->arg_type = O_ITEM;
-		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 */
-	default:
-	    str_free(str);
-	    str = Nullstr;		/* can't be evaluated yet */
-	    break;
-	case O_CONCAT:
-	    str_sset(str,s1);
-	    str_scat(str,s2);
-	    break;
-	case O_REPEAT:
-	    i = (int)str_gnum(s2);
-	    tmps = str_get(s1);
-	    str_nset(str,"",0);
+    else
+	s1 = Nullstr;
+    if (arg->arg_len >= 2 && arg[2].arg_type == A_SINGLE)
+	s2 = arg[2].arg_ptr.arg_str;
+    else
+	s2 = Nullstr;
+
+#define CHECK1 if (!s1) return arg
+#define CHECK2 if (!s2) return arg
+#define CHECK12 if (!s1 || !s2) return 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);
+	if (i < 32767 && i >= 0) {
+	    arg->arg_type = O_ITEM;
+	    arg->arg_len = 1;
+	    arg[1].arg_type = A_ARYSTAB;	/* $abc[123] is hoistable now */
+	    arg[1].arg_len = i;
+	    str_free(s2);
+	    Renew(arg, 2, ARG);
+	}
+	return arg;
+    case O_CONCAT:
+	CHECK12;
+	str_sset(str,s1);
+	str_scat(str,s2);
+	break;
+    case O_REPEAT:
+	CHECK2;
+	if (dowarn && !s2->str_nok && !looks_like_number(s2))
+	    warn("Right operand of x is not numeric");
+	CHECK1;
+	i = (int)str_gnum(s2);
+	tmps = str_get(s1);
+	str_nset(str,"",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:
-	    value = str_gnum(s1);
-	    str_numset(str,value * str_gnum(s2));
-	    break;
-	case O_DIVIDE:
-	    value = str_gnum(s2);
-	    if (value == 0.0)
-		yyerror("Illegal division by constant zero");
-	    else
-		str_numset(str,str_gnum(s1) / value);
-	    break;
-	case O_MODULO:
-	    tmplong = (long)str_gnum(s2);
-	    if (tmplong == 0L) {
-		yyerror("Illegal modulus of constant zero");
-		break;
+	}
+	break;
+    case O_MULTIPLY:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,value * str_gnum(s2));
+	break;
+    case O_DIVIDE:
+	CHECK12;
+	value = str_gnum(s2);
+	if (value == 0.0)
+	    yyerror("Illegal division by constant zero");
+	else
+#ifdef SLOPPYDIVIDE
+	/* insure that 20./5. == 4. */
+	{
+	    double x;
+	    int    k;
+	    x =  str_gnum(s1);
+	    if ((double)(int)x     == x &&
+		(double)(int)value == value &&
+		(k = (int)x/(int)value)*(int)value == (int)x) {
+		value = k;
+	    } else {
+		value = x/value;
 	    }
-	    tmp2 = (long)str_gnum(s1);
+	    str_numset(str,value);
+	}
+#else
+	str_numset(str,str_gnum(s1) / value);
+#endif
+	break;
+    case O_MODULO:
+	CHECK12;
+	tmplong = (unsigned long)str_gnum(s2);
+	if (tmplong == 0L) {
+	    yyerror("Illegal modulus of constant zero");
+	    return arg;
+	}
+	value = str_gnum(s1);
 #ifndef lint
-	    if (tmp2 >= 0)
-		str_numset(str,(double)(tmp2 % tmplong));
-	    else
-		str_numset(str,(double)(tmplong - (-tmp2 % tmplong)));
+	if (value >= 0.0)
+	    str_numset(str,(double)(((unsigned long)value) % tmplong));
+	else {
+	    tmp2 = (long)value;
+	    str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1));
+	}
 #else
-	    tmp2 = tmp2;
+	tmp2 = tmp2;
 #endif
-	    break;
-	case O_ADD:
-	    value = str_gnum(s1);
-	    str_numset(str,value + str_gnum(s2));
-	    break;
-	case O_SUBTRACT:
-	    value = str_gnum(s1);
-	    str_numset(str,value - str_gnum(s2));
-	    break;
-	case O_LEFT_SHIFT:
-	    value = str_gnum(s1);
-	    i = (int)str_gnum(s2);
+	break;
+    case O_ADD:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,value + str_gnum(s2));
+	break;
+    case O_SUBTRACT:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,value - str_gnum(s2));
+	break;
+    case O_LEFT_SHIFT:
+	CHECK12;
+	value = str_gnum(s1);
+	i = (int)str_gnum(s2);
 #ifndef lint
-	    str_numset(str,(double)(((long)value) << i));
+	str_numset(str,(double)(((long)value) << i));
 #endif
-	    break;
-	case O_RIGHT_SHIFT:
-	    value = str_gnum(s1);
-	    i = (int)str_gnum(s2);
+	break;
+    case O_RIGHT_SHIFT:
+	CHECK12;
+	value = str_gnum(s1);
+	i = (int)str_gnum(s2);
 #ifndef lint
-	    str_numset(str,(double)(((long)value) >> i));
+	str_numset(str,(double)(((long)value) >> i));
 #endif
-	    break;
-	case O_LT:
-	    value = str_gnum(s1);
-	    str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0);
-	    break;
-	case O_GT:
-	    value = str_gnum(s1);
-	    str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0);
-	    break;
-	case O_LE:
-	    value = str_gnum(s1);
-	    str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0);
-	    break;
-	case O_GE:
-	    value = str_gnum(s1);
-	    str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0);
-	    break;
-	case O_EQ:
-	    if (dowarn) {
-		if ((!s1->str_nok && !looks_like_number(s1)) ||
-		    (!s2->str_nok && !looks_like_number(s2)) )
-		    warn("Possible use of == on string value");
-	    }
-	    value = str_gnum(s1);
-	    str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0);
-	    break;
-	case O_NE:
-	    value = str_gnum(s1);
-	    str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
-	    break;
-	case O_BIT_AND:
-	    value = str_gnum(s1);
+	break;
+    case O_LT:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,(value < str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_GT:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,(value > str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_LE:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,(value <= str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_GE:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,(value >= str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_EQ:
+	CHECK12;
+	if (dowarn) {
+	    if ((!s1->str_nok && !looks_like_number(s1)) ||
+		(!s2->str_nok && !looks_like_number(s2)) )
+		warn("Possible use of == on string value");
+	}
+	value = str_gnum(s1);
+	str_numset(str,(value == str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_NE:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,(value != str_gnum(s2)) ? 1.0 : 0.0);
+	break;
+    case O_NCMP:
+	CHECK12;
+	value = str_gnum(s1);
+	value -= str_gnum(s2);
+	if (value > 0.0)
+	    value = 1.0;
+	else if (value < 0.0)
+	    value = -1.0;
+	str_numset(str,value);
+	break;
+    case O_BIT_AND:
+	CHECK12;
+	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);
+	break;
+    case O_XOR:
+	CHECK12;
+	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);
+	break;
+    case O_BIT_OR:
+	CHECK12;
+	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:
-	    if (str_true(s1))
-		str_sset(str,s2);
-	    else
-		str_sset(str,s1);
-	    break;
-	case O_OR:
-	    if (str_true(s1))
-		str_sset(str,s1);
-	    else
-		str_sset(str,s2);
-	    break;
-	case O_COND_EXPR:
-	    if ((arg[3].arg_type & A_MASK) != A_SINGLE) {
-		str_free(str);
-		str = Nullstr;
-	    }
-	    else {
-		if (str_true(s1))
-		    str_sset(str,s2);
-		else
-		    str_sset(str,arg[3].arg_ptr.arg_str);
-		str_free(arg[3].arg_ptr.arg_str);
-	    }
-	    break;
-	case O_NEGATE:
-	    str_numset(str,(double)(-str_gnum(s1)));
-	    break;
-	case O_NOT:
-	    str_numset(str,(double)(!str_true(s1)));
-	    break;
-	case O_COMPLEMENT:
+	break;
+    case O_AND:
+	CHECK12;
+	if (str_true(s1))
+	    str_sset(str,s2);
+	else
+	    str_sset(str,s1);
+	break;
+    case O_OR:
+	CHECK12;
+	if (str_true(s1))
+	    str_sset(str,s1);
+	else
+	    str_sset(str,s2);
+	break;
+    case O_COND_EXPR:
+	CHECK12;
+	if ((arg[3].arg_type & A_MASK) != A_SINGLE)
+	    return arg;
+	if (str_true(s1))
+	    str_sset(str,s2);
+	else
+	    str_sset(str,arg[3].arg_ptr.arg_str);
+	str_free(arg[3].arg_ptr.arg_str);
+	Renew(arg, 3, ARG);
+	break;
+    case O_NEGATE:
+	CHECK1;
+	str_numset(str,(double)(-str_gnum(s1)));
+	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;
 #ifndef lint
-	    str_numset(str,(double)(~(long)str_gnum(s1)));
+	str_numset(str,(double)(~U_L(str_gnum(s1))));
 #endif
-	    break;
-	case O_SIN:
-	    str_numset(str,sin(str_gnum(s1)));
-	    break;
-	case O_COS:
-	    str_numset(str,cos(str_gnum(s1)));
-	    break;
-	case O_ATAN2:
-	    value = str_gnum(s1);
-	    str_numset(str,atan2(value, str_gnum(s2)));
-	    break;
-	case O_POW:
-	    value = str_gnum(s1);
-	    str_numset(str,pow(value, str_gnum(s2)));
-	    break;
-	case O_LENGTH:
-	    str_numset(str, (double)str_len(s1));
-	    break;
-	case O_SLT:
-	    str_numset(str,(double)(str_cmp(s1,s2) < 0));
-	    break;
-	case O_SGT:
-	    str_numset(str,(double)(str_cmp(s1,s2) > 0));
-	    break;
-	case O_SLE:
-	    str_numset(str,(double)(str_cmp(s1,s2) <= 0));
-	    break;
-	case O_SGE:
-	    str_numset(str,(double)(str_cmp(s1,s2) >= 0));
-	    break;
-	case O_SEQ:
-	    str_numset(str,(double)(str_eq(s1,s2)));
-	    break;
-	case O_SNE:
-	    str_numset(str,(double)(!str_eq(s1,s2)));
-	    break;
-	case O_CRYPT:
-#ifdef CRYPT
-	    tmps = str_get(s1);
-	    str_set(str,crypt(tmps,str_get(s2)));
+	break;
+    case O_SIN:
+	CHECK1;
+	str_numset(str,sin(str_gnum(s1)));
+	break;
+    case O_COS:
+	CHECK1;
+	str_numset(str,cos(str_gnum(s1)));
+	break;
+    case O_ATAN2:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,atan2(value, str_gnum(s2)));
+	break;
+    case O_POW:
+	CHECK12;
+	value = str_gnum(s1);
+	str_numset(str,pow(value, str_gnum(s2)));
+	break;
+    case O_LENGTH:
+	if (arg[1].arg_type == A_STAB) {
+	    arg->arg_type = O_ITEM;
+	    arg[1].arg_type = A_LENSTAB;
+	    return arg;
+	}
+	CHECK1;
+	str_numset(str, (double)str_len(s1));
+	break;
+    case O_SLT:
+	CHECK12;
+	str_numset(str,(double)(str_cmp(s1,s2) < 0));
+	break;
+    case O_SGT:
+	CHECK12;
+	str_numset(str,(double)(str_cmp(s1,s2) > 0));
+	break;
+    case O_SLE:
+	CHECK12;
+	str_numset(str,(double)(str_cmp(s1,s2) <= 0));
+	break;
+    case O_SGE:
+	CHECK12;
+	str_numset(str,(double)(str_cmp(s1,s2) >= 0));
+	break;
+    case O_SEQ:
+	CHECK12;
+	str_numset(str,(double)(str_eq(s1,s2)));
+	break;
+    case O_SNE:
+	CHECK12;
+	str_numset(str,(double)(!str_eq(s1,s2)));
+	break;
+    case O_SCMP:
+	CHECK12;
+	str_numset(str,(double)(str_cmp(s1,s2)));
+	break;
+    case O_CRYPT:
+	CHECK12;
+#ifdef HAS_CRYPT
+	tmps = str_get(s1);
+	str_set(str,crypt(tmps,str_get(s2)));
 #else
-	    yyerror(
-	    "The crypt() function is unimplemented due to excessive paranoia.");
+	yyerror(
+	"The crypt() function is unimplemented due to excessive paranoia.");
 #endif
-	    break;
-	case O_EXP:
-	    str_numset(str,exp(str_gnum(s1)));
-	    break;
-	case O_LOG:
-	    str_numset(str,log(str_gnum(s1)));
-	    break;
-	case O_SQRT:
-	    str_numset(str,sqrt(str_gnum(s1)));
-	    break;
-	case O_INT:
-	    value = str_gnum(s1);
-	    if (value >= 0.0)
-		(void)modf(value,&value);
-	    else {
-		(void)modf(-value,&value);
-		value = -value;
-	    }
-	    str_numset(str,value);
-	    break;
-	case O_ORD:
+	break;
+    case O_EXP:
+	CHECK1;
+	str_numset(str,exp(str_gnum(s1)));
+	break;
+    case O_LOG:
+	CHECK1;
+	str_numset(str,log(str_gnum(s1)));
+	break;
+    case O_SQRT:
+	CHECK1;
+	str_numset(str,sqrt(str_gnum(s1)));
+	break;
+    case O_INT:
+	CHECK1;
+	value = str_gnum(s1);
+	if (value >= 0.0)
+	    (void)modf(value,&value);
+	else {
+	    (void)modf(-value,&value);
+	    value = -value;
+	}
+	str_numset(str,value);
+	break;
+    case O_ORD:
+	CHECK1;
 #ifndef I286
-	    str_numset(str,(double)(*str_get(s1)));
+	str_numset(str,(double)(*str_get(s1)));
 #else
-	    {
-		int  zapc;
-		char *zaps;
+	{
+	    int  zapc;
+	    char *zaps;
 
-		zaps = str_get(s1);
-		zapc = (int) *zaps;
-		str_numset(str,(double)(zapc));
-	    }
-#endif
-	    break;
-	}
-	if (str) {
-	    arg->arg_type = O_ITEM;	/* note arg1 type is already SINGLE */
-	    str_free(s1);
-	    str_free(s2);
-	    arg[1].arg_ptr.arg_str = str;
+	    zaps = str_get(s1);
+	    zapc = (int) *zaps;
+	    str_numset(str,(double)(zapc));
 	}
+#endif
+	break;
+    }
+    arg->arg_type = O_ITEM;	/* note arg1 type is already SINGLE */
+    str_free(s1);
+    arg[1].arg_ptr.arg_str = str;
+    if (s2) {
+	str_free(s2);
+	arg[2].arg_ptr.arg_str = Nullstr;
+	arg[2].arg_type = A_NULL;
     }
+    str = Nullstr;
+
+    return arg;
 }
 
 ARG *
@@ -624,6 +749,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;
 		    }
@@ -659,8 +790,10 @@ register ARG *arg;
 		      nothing_in_common(arg1,spat->spat_repl)) {
 			spat->spat_repl[1].arg_ptr.arg_stab =
 			    arg1[1].arg_ptr.arg_stab;
+			arg1[1].arg_ptr.arg_stab = Nullstab;
 			spat->spat_flags |= SPAT_ONCE;
 			arg_free(arg1);	/* recursive */
+			arg[1].arg_ptr.arg_arg = Nullarg;
 			free_arg(arg);	/* non-recursive */
 			return arg2;	/* split has builtin assign */
 		    }
@@ -698,6 +831,7 @@ register ARG *arg;
 	else if (arg1->arg_type == O_ASLICE) {
 	    arg1->arg_type = O_LASLICE;
 	    if (arg->arg_type == O_ASSIGN) {
+		dehoist(arg,2);
 		arg[1].arg_flags |= AF_ARYOK;
 		arg[2].arg_flags |= AF_ARYOK;
 	    }
@@ -705,6 +839,7 @@ register ARG *arg;
 	else if (arg1->arg_type == O_HSLICE) {
 	    arg1->arg_type = O_LHSLICE;
 	    if (arg->arg_type == O_ASSIGN) {
+		dehoist(arg,2);
 		arg[1].arg_flags |= AF_ARYOK;
 		arg[2].arg_flags |= AF_ARYOK;
 	    }
@@ -718,14 +853,14 @@ 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]);
 	    yyerror(tokenbuf);
+	    return arg;
 	}
 	arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT);
 	if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) {
@@ -750,6 +885,7 @@ register ARG *arg;
 	(void)sprintf(tokenbuf,
 	  "Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]);
 	yyerror(tokenbuf);
+	return arg;
     }
     arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT);
 #ifdef DEBUGGING
@@ -776,6 +912,7 @@ ARG *arg;
     return arg;
 }
 
+void
 dehoist(arg,i)
 ARG *arg;
 {
@@ -839,6 +976,7 @@ register ARG *arg;
     if (arg->arg_type != O_COMMA) {
 	if (arg->arg_type != O_ARRAY)
 	    arg->arg_flags |= AF_LISTISH;	/* see listish() below */
+	    arg->arg_flags |= AF_LISTISH;	/* see listish() below */
 	return arg;
     }
     for (i = 2, node = arg; ; i++) {
@@ -854,26 +992,14 @@ register ARG *arg;
 	node = arg;
 	arg = op_new(i);
 	tmpstr = arg->arg_ptr.arg_str;
-#ifdef STRUCTCOPY
-	*arg = *node;		/* copy everything except the STR */
-#else
-	(void)bcopy((char *)node, (char *)arg, sizeof(ARG));
-#endif
+	StructCopy(node, arg, ARG);	/* copy everything except the STR */
 	arg->arg_ptr.arg_str = tmpstr;
 	for (j = i; ; ) {
-#ifdef STRUCTCOPY
-	    arg[j] = node[2];
-#else
-	    (void)bcopy((char *)(node+2), (char *)(arg+j), sizeof(ARG));
-#endif
+	    StructCopy(node+2, arg+j, ARG);
 	    arg[j].arg_flags |= AF_ARYOK;
 	    --j;		/* Bug in Xenix compiler */
 	    if (j < 2) {
-#ifdef STRUCTCOPY
-		arg[1] = node[1];
-#else
-		(void)bcopy((char *)(node+1), (char *)(arg+1), sizeof(ARG));
-#endif
+		StructCopy(node+1, arg+1, ARG);
 		free_arg(node);
 		break;
 	    }
@@ -886,6 +1012,8 @@ register ARG *arg;
     arg[2].arg_flags |= AF_ARYOK;
     arg->arg_type = O_LIST;
     arg->arg_len = i;
+    str_free(arg->arg_ptr.arg_str);
+    arg->arg_ptr.arg_str = Nullstr;
     return arg;
 }
 
@@ -895,7 +1023,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;
 }
@@ -905,7 +1033,16 @@ maybelistish(optype, arg)
 int optype;
 ARG *arg;
 {
-    if (optype == O_PRTF ||
+    ARG *tmparg = arg;
+
+    if (optype == O_RETURN && arg->arg_type == O_ITEM &&
+      arg[1].arg_type == A_EXPR && (tmparg = arg[1].arg_ptr.arg_arg) &&
+      ((tmparg->arg_flags & AF_LISTISH) || (tmparg->arg_type == O_ARRAY) )) {
+	tmparg = listish(tmparg);
+	free_arg(arg);
+	arg = tmparg;
+    }
+    else if (optype == O_PRTF ||
       (arg->arg_type == O_ASLICE || arg->arg_type == O_HSLICE ||
        arg->arg_type == O_F_OR_R) )
 	arg = listish(arg);
@@ -923,27 +1060,19 @@ ARG *arg;
 }
 
 ARG *
-fixeval(arg)
-ARG *arg;
-{
-    Renew(arg, 3, ARG);
-    if (arg->arg_len == 0)
-	arg[1].arg_type = A_NULL;
-    arg->arg_len = 2;
-    arg[2].arg_ptr.arg_hash = curstash;
-    arg[2].arg_type = A_NULL;
-    return arg;
-}
-
-ARG *
 rcatmaybe(arg)
 ARG *arg;
 {
-    if (arg->arg_type == O_CONCAT && arg[2].arg_type == A_READ) {
-	arg->arg_type = O_RCAT;	
-	arg[2].arg_type = arg[2].arg_ptr.arg_arg[1].arg_type;
-	arg[2].arg_ptr = arg[2].arg_ptr.arg_arg[1].arg_ptr;
-	free_arg(arg[2].arg_ptr.arg_arg);
+    ARG *arg2;
+
+    if (arg->arg_type == O_CONCAT && arg[2].arg_type == A_EXPR) {
+	arg2 = arg[2].arg_ptr.arg_arg;
+	if (arg2->arg_type == O_ITEM && arg2[1].arg_type == A_READ) {
+	    arg->arg_type = O_RCAT;	
+	    arg[2].arg_type = arg2[1].arg_type;
+	    arg[2].arg_ptr = arg2[1].arg_ptr;
+	    free_arg(arg2);
+	}
     }
     return arg;
 }
@@ -1047,6 +1176,7 @@ ARG *arg2;
     thisexpr++;
     if (arg_common(arg1,thisexpr,1))
 	return 0;	/* hit eval or do {} */
+    stab_lastexpr(defstab) = thisexpr;		/* pretend to hit @_ */
     if (arg_common(arg2,thisexpr,0))
 	return 0;	/* hit identifier again */
     return 1;
@@ -1097,7 +1227,7 @@ int marking;
 
 		while (*s) {
 		    if (*s == '$' && s[1]) {
-			s = scanreg(s,send,tokenbuf);
+			s = scanident(s,send,tokenbuf);
 			stab = stabent(tokenbuf,TRUE);
 			if (marking)
 			    stab_lastexpr(stab) = exprnum;