consarg.c

早期freebsd实现

/* $RCSfile: consarg.c,v $$Revision: 4.0.1.4 $$Date: 92/06/08 12:26:27 $
 *
 *    Copyright (c) 1991, Larry Wall
 *
 *    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 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 4.0.1.3  91/11/05  16:21:16  lwall
 * patch11: random cleanup
 * patch11: added eval {}
 * patch11: added sort {} LIST
 * patch11: "foo" x -1 dumped core
 * patch11: substr() and vec() weren't allowed in an lvalue list
 * 
 * Revision 4.0.1.2  91/06/07  10:33:12  lwall
 * patch4: new copyright notice
 * patch4: length($`), length($&), length($') now optimized to avoid string copy
 * 
 * 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_len = 0;
	    arg[3].arg_type = A_EXPR;
	    arg[3].arg_ptr.arg_arg = limarg;
	}
    }
    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));
    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;
    /*SUPPRESS 560*/
    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;
	}
    }
    /*SUPPRESS 560*/
    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;
	}
    }
    /*SUPPRESS 560*/
    if (chld = arg3) {
	if (chld->arg_type == O_ITEM && hoistable[chld[1].arg_type&A_MASK]) {
	    arg[3].arg_type = chld[1].arg_type;
	    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
    arg = evalstatic(arg);	/* see if we can consolidate anything */
    return arg;
}

ARG *
evalstatic(arg)
register ARG *arg;
{
    static STR *str = Nullstr;
    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 arg;

    if (!str)
	str = Str_new(20,0);

    if (arg[1].arg_type == A_SINGLE)
	s1 = arg[1].arg_ptr.arg_str;
    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:
	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;
	    }
	    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 (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;
#endif
	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));
#endif
	break;
    case O_RIGHT_SHIFT:
	CHECK12;
	value = str_gnum(s1);
	i = (int)str_gnum(s2);
#ifndef lint
	str_numset(str,(double)(((long)value) >> i));
#endif
	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)(U_L(value) & U_L(str_gnum(s2))));
#endif
	break;
    case O_XOR:
	CHECK12;
	value = str_gnum(s1);
#ifndef lint
	str_numset(str,(double)(U_L(value) ^ U_L(str_gnum(s2))));
#endif
	break;
    case O_BIT_OR:
	CHECK12;
	value = str_gnum(s1);
#ifndef lint
	str_numset(str,(double)(U_L(value) | U_L(str_gnum(s2))));
#endif
	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)(~U_L(str_gnum(s1))));
#endif
	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.");
#endif
	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)));
#else