/* $Header: consarg.c,v 3.0.1.8 91/01/11 17:37:31 lwall Locked $ * * Copyright (c) 1989, 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. * * $Log: consarg.c,v $ * Revision 3.0.1.8 91/01/11 17:37:31 lwall * patch42: assignment to a slice didn't supply an array context to RHS * patch42: suppressed variable suicide on local($a,$b) = @_ * * Revision 3.0.1.7 90/10/15 15:55:28 lwall * patch29: defined @foo was behaving inconsistently * patch29: -5 % 5 was wrong * patch29: package behavior is now more consistent * * 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 * * Revision 3.0.1.4 90/03/12 16:24:40 lwall * patch13: return (@array) did counter-intuitive things * * 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 3.0.1.2 89/11/17 15:11:34 lwall * patch5: defined $foo{'bar'} should not create element * * 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 3.0 89/10/18 15:10:30 lwall * 3.0 baseline * */ #include "EXTERN.h" #include "perl.h" static int nothing_in_common(); static int arg_common(); static int spat_common(); ARG * make_split(stab,arg,limarg) register STAB *stab; register ARG *arg; ARG *limarg; { register SPAT *spat; if (arg->arg_type != O_MATCH) { Newz(201,spat,1,SPAT); spat->spat_next = curstash->tbl_spatroot; /* link into spat list */ curstash->tbl_spatroot = spat; spat->spat_runtime = arg; arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat); } Renew(arg,4,ARG); arg->arg_len = 3; if (limarg) { if (limarg->arg_type == O_ITEM) { Copy(limarg+1,arg+3,1,ARG); limarg[1].arg_type = A_NULL; arg_free(limarg); } else { arg[3].arg_flags = 0; arg[3].arg_type = A_EXPR; arg[3].arg_ptr.arg_arg = limarg; } } else arg[3].arg_type = A_NULL; arg->arg_type = O_SPLIT; spat = arg[2].arg_ptr.arg_spat; spat->spat_repl = stab2arg(A_STAB,aadd(stab)); if (spat->spat_short) { /* exact match can bypass regexec() */ if (!((spat->spat_flags & SPAT_SCANFIRST) && (spat->spat_flags & SPAT_ALL) )) { str_free(spat->spat_short); spat->spat_short = Nullstr; } } return arg; } ARG * mod_match(type,left,pat) register ARG *left; 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 || pat->arg_type == O_SPLIT ) && pat[1].arg_ptr.arg_stab == defstab ) { switch (pat->arg_type) { case O_MATCH: newarg = make_op(type == O_MATCH ? O_MATCH : O_NMATCH, pat->arg_len, left,Nullarg,Nullarg); break; case O_SUBST: newarg = l(make_op(type == O_MATCH ? O_SUBST : O_NSUBST, pat->arg_len, left,Nullarg,Nullarg)); break; case O_TRANS: newarg = l(make_op(type == O_MATCH ? O_TRANS : O_NTRANS, pat->arg_len, left,Nullarg,Nullarg)); break; case O_SPLIT: newarg = make_op(type == O_MATCH ? O_SPLIT : O_SPLIT, pat->arg_len, left,Nullarg,Nullarg); break; } if (pat->arg_len >= 2) { newarg[2].arg_type = pat[2].arg_type; newarg[2].arg_ptr = pat[2].arg_ptr; 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_flags = pat[3].arg_flags; } } Safefree(pat); } else { Newz(202,spat,1,SPAT); spat->spat_next = curstash->tbl_spatroot; /* link into spat list */ curstash->tbl_spatroot = spat; spat->spat_runtime = pat; newarg = make_op(type,2,left,Nullarg,Nullarg); newarg[2].arg_type = A_SPAT | A_DONT; newarg[2].arg_ptr.arg_spat = spat; } return newarg; } ARG * make_op(type,newlen,arg1,arg2,arg3) int type; int newlen; ARG *arg1; ARG *arg2; ARG *arg3; { register ARG *arg; register ARG *chld; 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; if (chld = arg1) { if (chld->arg_type == O_ITEM && (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 = chld[1].arg_type; arg[1].arg_ptr = chld[1].arg_ptr; arg[1].arg_flags |= chld[1].arg_flags; arg[1].arg_len = chld[1].arg_len; free_arg(chld); } else { arg[1].arg_type = A_EXPR; arg[1].arg_ptr.arg_arg = chld; } } if (chld = arg2) { if (chld->arg_type == O_ITEM && (hoistable[chld[1].arg_type&A_MASK] || (type == O_ASSIGN && ((chld[1].arg_type == A_READ && !(arg[1].arg_type & A_DONT)) || (chld[1].arg_type == A_INDREAD && !(arg[1].arg_type & A_DONT)) || (chld[1].arg_type == A_GLOB && !(arg[1].arg_type & A_DONT)) ) ) ) ) { arg[2].arg_type = chld[1].arg_type; arg[2].arg_ptr = chld[1].arg_ptr; arg[2].arg_len = chld[1].arg_len; free_arg(chld); } else { arg[2].arg_type = A_EXPR; arg[2].arg_ptr.arg_arg = chld; } } if (chld = arg3) { 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; free_arg(chld); } else { arg[3].arg_type = A_EXPR; arg[3].arg_ptr.arg_arg = chld; } } if (newlen >= 4 && (chld = arg4)) { 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; free_arg(chld); } else { arg[4].arg_type = A_EXPR; arg[4].arg_ptr.arg_arg = chld; } } if (newlen >= 5 && (chld = arg5)) { 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; free_arg(chld); } else { arg[5].arg_type = A_EXPR; 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]); if (arg1) fprintf(stderr,",%s=%lx", argname[arg[1].arg_type&A_MASK],arg[1].arg_ptr.arg_arg); if (arg2) fprintf(stderr,",%s=%lx", argname[arg[2].arg_type&A_MASK],arg[2].arg_ptr.arg_arg); if (arg3) fprintf(stderr,",%s=%lx", argname[arg[3].arg_type&A_MASK],arg[3].arg_ptr.arg_arg); if (newlen >= 4) fprintf(stderr,",%s=%lx", argname[arg[4].arg_type&A_MASK],arg[4].arg_ptr.arg_arg); if (newlen >= 5) fprintf(stderr,",%s=%lx", argname[arg[5].arg_type&A_MASK],arg[5].arg_ptr.arg_arg); fprintf(stderr,")\n"); } #endif evalstatic(arg); /* see if we can consolidate anything */ return arg; } void evalstatic(arg) register ARG *arg; { register STR *str; register STR *s1; register STR *s2; double value; /* must not be register */ register char *tmps; int i; unsigned long tmplong; long tmp2; double exp(), log(), sqrt(), modf(); char *crypt(); double sin(), cos(), atan2(), pow(); if (!arg || !arg->arg_len) return; if ((arg[1].arg_type == A_SINGLE || arg->arg_type == O_AELEM) && (arg->arg_len == 1 || arg[2].arg_type == A_SINGLE) ) { str = Str_new(20,0); 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; 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); 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 = (unsigned long)str_gnum(s2); if (tmplong == 0L) { yyerror("Illegal modulus of constant zero"); break; } tmp2 = (long)str_gnum(s1); #ifndef lint if (tmp2 >= 0) str_numset(str,(double)(tmp2 % tmplong)); else str_numset(str,(double)((tmplong-((-tmp2 - 1) % tmplong)) - 1)); #else 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); #ifndef lint str_numset(str,(double)(((long)value) << i)); #endif break; case O_RIGHT_SHIFT: value = str_gnum(s1); i = (int)str_gnum(s2); #ifndef lint 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_NCMP: 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: value = str_gnum(s1); #ifndef lint str_numset(str,(double)(U_L(value) & U_L(str_gnum(s2)))); #endif break; case O_XOR: value = str_gnum(s1); #ifndef lint str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2)))); #endif break; case O_BIT_OR: value = str_gnum(s1); #ifndef lint 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: #ifndef lint 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_SCMP: str_numset(str,(double)(str_cmp(s1,s2))); break; case O_CRYPT: #ifdef CRYPT tmps = str_get(s1); str_set(str,crypt(tmps,str_get(s2))); #else 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: #ifndef I286 str_numset(str,(double)(*str_get(s1))); #else { 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; } } } ARG * l(arg) register ARG *arg; { register int i; register ARG *arg1; register ARG *arg2; SPAT *spat; int arghog = 0; i = arg[1].arg_type & A_MASK; arg->arg_flags |= AF_COMMON; /* assume something in common */ /* which forces us to copy things */ if (i == A_ARYLEN) { arg[1].arg_type = A_LARYLEN; return arg; } if (i == A_ARYSTAB) { arg[1].arg_type = A_LARYSTAB; return arg; } /* see if it's an array reference */ if (i == A_EXPR || i == A_LEXPR) { arg1 = arg[1].arg_ptr.arg_arg; if (arg1->arg_type == O_LIST || arg1->arg_type == O_ITEM) { /* assign to list */ if (arg->arg_len > 1) { dehoist(arg,2); arg2 = arg[2].arg_ptr.arg_arg; if (nothing_in_common(arg1,arg2)) arg->arg_flags &= ~AF_COMMON; if (arg->arg_type == O_ASSIGN) { if (arg1->arg_flags & AF_LOCAL) arg->arg_flags |= AF_LOCAL; arg[1].arg_flags |= AF_ARYOK; arg[2].arg_flags |= AF_ARYOK; } } else if (arg->arg_type != O_CHOP) arg->arg_type = O_ASSIGN; /* possible local(); */ for (i = arg1->arg_len; i >= 1; i--) { switch (arg1[i].arg_type) { case A_STAR: case A_LSTAR: arg1[i].arg_type = A_LSTAR; break; case A_STAB: case A_LVAL: arg1[i].arg_type = A_LVAL; break; case A_ARYLEN: case A_LARYLEN: arg1[i].arg_type = A_LARYLEN; break; case A_ARYSTAB: case A_LARYSTAB: arg1[i].arg_type = A_LARYSTAB; break; case A_EXPR: case A_LEXPR: arg1[i].arg_type = A_LEXPR; switch(arg1[i].arg_ptr.arg_arg->arg_type) { case O_ARRAY: case O_LARRAY: arg1[i].arg_ptr.arg_arg->arg_type = O_LARRAY; arghog = 1; break; case O_AELEM: case O_LAELEM: arg1[i].arg_ptr.arg_arg->arg_type = O_LAELEM; break; case O_HASH: case O_LHASH: arg1[i].arg_ptr.arg_arg->arg_type = O_LHASH; arghog = 1; break; case O_HELEM: case O_LHELEM: arg1[i].arg_ptr.arg_arg->arg_type = O_LHELEM; break; case O_ASLICE: case O_LASLICE: arg1[i].arg_ptr.arg_arg->arg_type = O_LASLICE; break; case O_HSLICE: case O_LHSLICE: arg1[i].arg_ptr.arg_arg->arg_type = O_LHSLICE; break; default: goto ill_item; } break; default: ill_item: (void)sprintf(tokenbuf, "Illegal item (%s) as lvalue", argname[arg1[i].arg_type&A_MASK]); yyerror(tokenbuf); } } if (arg->arg_len > 1) { if (arg2->arg_type == O_SPLIT && !arg2[3].arg_type && !arghog) { arg2[3].arg_type = A_SINGLE; arg2[3].arg_ptr.arg_str = str_nmake((double)arg1->arg_len + 1); /* limit split len*/ } } } else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM) if (arg->arg_type == O_DEFINED) arg1->arg_type = O_AELEM; else arg1->arg_type = O_LAELEM; else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) { arg1->arg_type = O_LARRAY; if (arg->arg_len > 1) { dehoist(arg,2); arg2 = arg[2].arg_ptr.arg_arg; if (arg2->arg_type == O_SPLIT) { /* use split's builtin =?*/ spat = arg2[2].arg_ptr.arg_spat; if (!(spat->spat_flags & SPAT_ONCE) && nothing_in_common(arg1,spat->spat_repl)) { spat->spat_repl[1].arg_ptr.arg_stab = arg1[1].arg_ptr.arg_stab; spat->spat_flags |= SPAT_ONCE; arg_free(arg1); /* recursive */ free_arg(arg); /* non-recursive */ return arg2; /* split has builtin assign */ } } else if (nothing_in_common(arg1,arg2)) arg->arg_flags &= ~AF_COMMON; if (arg->arg_type == O_ASSIGN) { arg[1].arg_flags |= AF_ARYOK; arg[2].arg_flags |= AF_ARYOK; } } else if (arg->arg_type == O_ASSIGN) arg[1].arg_flags |= AF_ARYOK; } else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM) if (arg->arg_type == O_DEFINED) arg1->arg_type = O_HELEM; /* avoid creating one */ else arg1->arg_type = O_LHELEM; else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) { arg1->arg_type = O_LHASH; if (arg->arg_len > 1) { dehoist(arg,2); arg2 = arg[2].arg_ptr.arg_arg; if (nothing_in_common(arg1,arg2)) arg->arg_flags &= ~AF_COMMON; if (arg->arg_type == O_ASSIGN) { arg[1].arg_flags |= AF_ARYOK; arg[2].arg_flags |= AF_ARYOK; } } else if (arg->arg_type == O_ASSIGN) arg[1].arg_flags |= AF_ARYOK; } 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; } } else if ((arg->arg_type == O_DEFINED || arg->arg_type == O_UNDEF) && (arg1->arg_type == (perldb ? O_DBSUBR : O_SUBR)) ) { arg[1].arg_type |= A_DONT; } else if (arg1->arg_type == O_SUBSTR || arg1->arg_type == O_VEC) { (void)l(arg1); 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 { (void)sprintf(tokenbuf, "Illegal expression (%s) as lvalue",opname[arg1->arg_type]); yyerror(tokenbuf); } arg[1].arg_type = A_LEXPR | (arg[1].arg_type & A_DONT); if (arg->arg_type == O_ASSIGN && (arg1[1].arg_flags & AF_ARYOK)) { arg[1].arg_flags |= AF_ARYOK; if (arg->arg_len > 1) arg[2].arg_flags |= AF_ARYOK; } #ifdef DEBUGGING if (debug & 16) fprintf(stderr,"lval LEXPR\n"); #endif return arg; } if (i == A_STAR || i == A_LSTAR) { arg[1].arg_type = A_LSTAR | (arg[1].arg_type & A_DONT); return arg; } /* not an array reference, should be a register name */ if (i != A_STAB && i != A_LVAL) { (void)sprintf(tokenbuf, "Illegal item (%s) as lvalue",argname[arg[1].arg_type&A_MASK]); yyerror(tokenbuf); } arg[1].arg_type = A_LVAL | (arg[1].arg_type & A_DONT); #ifdef DEBUGGING if (debug & 16) fprintf(stderr,"lval LVAL\n"); #endif return arg; } ARG * fixl(type,arg) int type; ARG *arg; { if (type == O_DEFINED || type == O_UNDEF) { if (arg->arg_type != O_ITEM) arg = hide_ary(arg); if (arg->arg_type == O_ITEM) { type = arg[1].arg_type & A_MASK; if (type == A_EXPR || type == A_LEXPR) arg[1].arg_type = A_LEXPR|A_DONT; } } return arg; } dehoist(arg,i) ARG *arg; { ARG *tmparg; if (arg[i].arg_type != A_EXPR) { /* dehoist */ tmparg = make_op(O_ITEM,1,Nullarg,Nullarg,Nullarg); tmparg[1] = arg[i]; arg[i].arg_ptr.arg_arg = tmparg; arg[i].arg_type = A_EXPR; } } ARG * addflags(i,flags,arg) register ARG *arg; { arg[i].arg_flags |= flags; return arg; } ARG * hide_ary(arg) ARG *arg; { if (arg->arg_type == O_ARRAY || arg->arg_type == O_HASH) return make_op(O_ITEM,1,arg,Nullarg,Nullarg); return arg; } /* maybe do a join on multiple array dimensions */ ARG * jmaybe(arg) register ARG *arg; { if (arg && arg->arg_type == O_COMMA) { arg = listish(arg); arg = make_op(O_JOIN, 2, stab2arg(A_STAB,stabent(";",TRUE)), make_list(arg), Nullarg); } return arg; } ARG * make_list(arg) register ARG *arg; { register int i; register ARG *node; register ARG *nxtnode; register int j; STR *tmpstr; if (!arg) { arg = op_new(0); arg->arg_type = O_LIST; } if (arg->arg_type != O_COMMA) { if (arg->arg_type != O_ARRAY) arg->arg_flags |= AF_LISTISH; /* see listish() below */ return arg; } for (i = 2, node = arg; ; i++) { if (node->arg_len < 2) break; if (node[1].arg_type != A_EXPR) break; node = node[1].arg_ptr.arg_arg; if (node->arg_type != O_COMMA) break; } if (i > 2) { 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 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 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 free_arg(node); break; } nxtnode = node[1].arg_ptr.arg_arg; free_arg(node); node = nxtnode; } } arg[1].arg_flags |= AF_ARYOK; arg[2].arg_flags |= AF_ARYOK; arg->arg_type = O_LIST; arg->arg_len = i; return arg; } /* turn a single item into a list */ ARG * listish(arg) ARG *arg; { if (arg->arg_flags & AF_LISTISH) arg = make_op(O_LIST,1,arg,Nullarg,Nullarg); return arg; } ARG * maybelistish(optype, arg) int optype; ARG *arg; { 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); return arg; } /* mark list of local variables */ ARG * localize(arg) ARG *arg; { arg->arg_flags |= AF_LOCAL; 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); } return arg; } ARG * stab2arg(atype,stab) int atype; register STAB *stab; { register ARG *arg; arg = op_new(1); arg->arg_type = O_ITEM; arg[1].arg_type = atype; arg[1].arg_ptr.arg_stab = stab; return arg; } ARG * cval_to_arg(cval) register char *cval; { register ARG *arg; arg = op_new(1); arg->arg_type = O_ITEM; arg[1].arg_type = A_SINGLE; arg[1].arg_ptr.arg_str = str_make(cval,0); Safefree(cval); return arg; } ARG * op_new(numargs) int numargs; { register ARG *arg; Newz(203,arg, numargs + 1, ARG); arg->arg_ptr.arg_str = Str_new(21,0); arg->arg_len = numargs; return arg; } void free_arg(arg) ARG *arg; { str_free(arg->arg_ptr.arg_str); Safefree(arg); } ARG * make_match(type,expr,spat) int type; ARG *expr; SPAT *spat; { register ARG *arg; arg = make_op(type,2,expr,Nullarg,Nullarg); arg[2].arg_type = A_SPAT|A_DONT; arg[2].arg_ptr.arg_spat = spat; #ifdef DEBUGGING if (debug & 16) fprintf(stderr,"make_match SPAT=%lx\n",(long)spat); #endif if (type == O_SUBST || type == O_NSUBST) { if (arg[1].arg_type != A_STAB) { yyerror("Illegal lvalue"); } arg[1].arg_type = A_LVAL; } return arg; } ARG * cmd_to_arg(cmd) CMD *cmd; { register ARG *arg; arg = op_new(1); arg->arg_type = O_ITEM; arg[1].arg_type = A_CMD; arg[1].arg_ptr.arg_cmd = cmd; return arg; } /* Check two expressions to see if there is any identifier in common */ static int nothing_in_common(arg1,arg2) ARG *arg1; ARG *arg2; { static int thisexpr = 0; /* I don't care if this wraps */ 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; } /* Recursively descend an expression and mark any identifier or check * it to see if it was marked already. */ static int arg_common(arg,exprnum,marking) register ARG *arg; int exprnum; int marking; { register int i; if (!arg) return 0; for (i = arg->arg_len; i >= 1; i--) { switch (arg[i].arg_type & A_MASK) { case A_NULL: break; case A_LEXPR: case A_EXPR: if (arg_common(arg[i].arg_ptr.arg_arg,exprnum,marking)) return 1; break; case A_CMD: return 1; /* assume hanky panky */ case A_STAR: case A_LSTAR: case A_STAB: case A_LVAL: case A_ARYLEN: case A_LARYLEN: if (marking) stab_lastexpr(arg[i].arg_ptr.arg_stab) = exprnum; else if (stab_lastexpr(arg[i].arg_ptr.arg_stab) == exprnum) return 1; break; case A_DOUBLE: case A_BACKTICK: { register char *s = arg[i].arg_ptr.arg_str->str_ptr; register char *send = s + arg[i].arg_ptr.arg_str->str_cur; register STAB *stab; while (*s) { if (*s == '$' && s[1]) { s = scanreg(s,send,tokenbuf); stab = stabent(tokenbuf,TRUE); if (marking) stab_lastexpr(stab) = exprnum; else if (stab_lastexpr(stab) == exprnum) return 1; continue; } else if (*s == '\\' && s[1]) s++; s++; } } break; case A_SPAT: if (spat_common(arg[i].arg_ptr.arg_spat,exprnum,marking)) return 1; break; case A_READ: case A_INDREAD: case A_GLOB: case A_WORD: case A_SINGLE: break; } } switch (arg->arg_type) { case O_ARRAY: case O_LARRAY: if ((arg[1].arg_type & A_MASK) == A_STAB) (void)aadd(arg[1].arg_ptr.arg_stab); break; case O_HASH: case O_LHASH: if ((arg[1].arg_type & A_MASK) == A_STAB) (void)hadd(arg[1].arg_ptr.arg_stab); break; case O_EVAL: case O_SUBR: case O_DBSUBR: return 1; } return 0; } static int spat_common(spat,exprnum,marking) register SPAT *spat; int exprnum; int marking; { if (spat->spat_runtime) if (arg_common(spat->spat_runtime,exprnum,marking)) return 1; if (spat->spat_repl) { if (arg_common(spat->spat_repl,exprnum,marking)) return 1; } return 0; }