-/* $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.
*
*/
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));
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 ||
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);
{
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 ))))
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))
||
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;
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;
}
}
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;
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]);
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 */
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 *
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;
}
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 */
}
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;
}
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;
}
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)) {
(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
return arg;
}
+void
dehoist(arg,i)
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++) {
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;
}
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;
}
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;
}
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);
}
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;
}
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;
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;
projects / p5sagit/p5-mst-13.2.git / blobdiff