MultiSource/Benchmarks/MallocBench/perl/consarg.c

/* $RCSfile$$Revision$$Date$
 *
 *    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$
 * Revision 1.1  2004/02/17 22:21:15  criswell
 * Initial commit of the perl Malloc Benchmark.  I've cheated a little by
 * generating the yacc output files and committing them directly, but it was
 * easier than disabling the Bison Voodoo that gets executed by default.
 *
 * 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.
 * 
 */

#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_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;
	    }
	}
	free_arg(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);
		arg[2].arg_type = A_NULL;
		arg[2].arg_ptr.arg_str = Nullstr;
	    }
	    /* 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
#ifdef cray
	    /* 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;
		}
		str_numset(str,value);
	    }
#else
	    str_numset(str,str_gnum(s1) / value);
#endif
	    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);
		arg[3].arg_ptr.arg_str = Nullstr;
	    }
	    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 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.");
#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);
	    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;
	    }
	}
    }
}

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;
			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 (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 */
	    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;
{
    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;
}

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 = scanident(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;
}