ack/lang/basic/src/eval.c

/*
 * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
 * See the copyright notice in the ACK home directory, in the file "Copyright".
 */

#include "bem.h"

#ifndef NORSCID
static char rcs_id[] = "$Id$" ;
#endif


/* Here you find all routines to evaluate expressions and
   generate code for assignment statements
*/

exprtype(ltype,rtype)
int	ltype,rtype;
{
	/* determine the result type of an expression */
	if ( ltype==STRINGTYPE || rtype==STRINGTYPE)
	{
		if ( ltype!=rtype)
			error("type conflict, string expected");
		return( STRINGTYPE);
	}
	/* take maximum */
	if ( ltype<rtype) return(rtype);
	return(ltype);
}



conversion(oldtype,newtype)
int oldtype,newtype;
{
	/* the value on top of the stack should be converted */
	if ( oldtype==newtype) return;

	switch( oldtype)
	{
	case INTTYPE:
		if ( newtype==FLOATTYPE || newtype==DOUBLETYPE)
		{
			C_loc((arith)BEMINTSIZE);
			C_loc((arith)BEMFLTSIZE);
			C_cif ();
		} else {
			if (debug) 
				print("type n=%d o=%d\n",newtype,oldtype);
			error("conversion error");
		}
		break;
	case FLOATTYPE:
	case DOUBLETYPE:
		if ( newtype==INTTYPE)
		{
			/* rounded ! */
			C_cal("_cint");
			C_asp((arith)BEMFLTSIZE);
			C_lfr((arith)BEMINTSIZE);
			break;
		} else if ( newtype==FLOATTYPE || newtype==DOUBLETYPE)
			break;
	default:
		if (debug) 
			print("type n=%d o=%d\n",newtype,oldtype);
		error("conversion error");
	}
}



extraconvert(oldtype,newtype,topstack)
int oldtype,newtype,topstack;
{
	/* the value below the top of the stack should be converted */
	if ( oldtype==newtype ) return;
	if ( debug) print("extra convert %d %d %d\n",oldtype,newtype,topstack);
	/* save top in dummy */

	switch( topstack)
	{
	case INTTYPE:
		C_ste_dnam("dummy1",(arith)0);
		break;
	case FLOATTYPE:
	case DOUBLETYPE:
		/* rounded ! */
		C_lae_dnam("dummy1",(arith)0);
		C_sti((arith)BEMFLTSIZE);
		break;
	default:
		error("conversion error");
		return;
	}
	/* now its on top of the stack */

	conversion(oldtype,newtype);
	/* restore top */

	switch( topstack)
	{
	case INTTYPE:
		C_loe_dnam("dummy1",(arith)0);
		break;
	case FLOATTYPE:
	case DOUBLETYPE:
		/* rounded ! */
		C_lae_dnam("dummy1",(arith)0);
		C_loi((arith)BEMFLTSIZE);
	}
}

	

boolop(ltype,rtype,operator)
int	ltype,rtype,operator;
{
	if ( operator != NOTSYM)
	{
		extraconvert(ltype,INTTYPE,rtype);
		conversion(rtype,INTTYPE);
	} else conversion(ltype,INTTYPE);

	switch( operator)
	{
	case NOTSYM:
		C_com((arith)BEMINTSIZE);
		break;
	case ANDSYM:
		C_and((arith)BEMINTSIZE);
		break;
	case ORSYM:
		C_ior((arith)BEMINTSIZE);
		break;
	case XORSYM:
		C_xor((arith)BEMINTSIZE);
		break;
	case EQVSYM:
		C_xor((arith)BEMINTSIZE);
		C_com((arith)BEMINTSIZE);
		break;
	case IMPSYM:
		/* implies */
		C_com((arith)BEMINTSIZE);
		C_and((arith)BEMINTSIZE);
		C_com((arith)BEMINTSIZE);
		break;
	default:	
		error("boolop:unexpected");
	}

	return(INTTYPE);
}



genbool(operator)
int operator;
{
	int l1,l2;

	l1= genlabel();
	l2= genlabel();

	switch(operator)
	{
		case '<':	C_zlt((label)l1); break;
		case '>':	C_zgt((label)l1); break;
		case '=':	C_zeq((label)l1); break;
		case NESYM:	C_zne((label)l1); break;
		case LESYM:	C_zle((label)l1); break;
		case GESYM:	C_zge((label)l1); break;
		default:	error("relop:unexpected operator");
	}

	C_loc((arith)0);
	C_bra((label)l2);
	C_df_ilb((label)l1);
	C_loc((arith)-1);
	C_df_ilb((label)l2);
}



relop( ltype,rtype,operator)
int	ltype,rtype,operator;
{
	int	result;

	if (debug) print("relop %d %d op=%d\n",ltype,rtype,operator);
	result= exprtype(ltype,rtype);
	extraconvert(ltype,result,rtype);
	conversion(rtype,result);
	/* compare the objects */
	if ( result==INTTYPE)
		C_cmi((arith)BEMINTSIZE);
	else if ( result==FLOATTYPE || result==DOUBLETYPE)
		  C_cmf((arith)BEMFLTSIZE);
	     else if ( result==STRINGTYPE)
		  {
			  C_cal("_strcomp");
			  C_asp((arith)(2*BEMPTRSIZE));
                	  C_lfr((arith)BEMINTSIZE);
		  } else error("relop:unexpected");
	/* handle the relational operators */
	genbool(operator);
	return(INTTYPE);
}



plusmin(ltype,rtype,operator)
int	ltype,rtype,operator;
{
	int result;

	result= exprtype(ltype,rtype);
	if ( result== STRINGTYPE)
	{
		if ( operator== '+')
		{
                        C_cal("_concat");
                        C_asp((arith)(2*BEMPTRSIZE));
                        C_lfr((arith)BEMPTRSIZE);
		} else error("illegal operator");
	} else {
		extraconvert(ltype,result,rtype);
		conversion(rtype,result);
		if ( result== INTTYPE)
		{
			if ( operator=='+') 
                                C_adi((arith)BEMINTSIZE);
			else C_sbi((arith)BEMINTSIZE);
		} else {
			if ( operator=='+') 
                                C_adf((arith)BEMFLTSIZE);
			else C_sbf((arith)BEMFLTSIZE);
		}
	}
	return(result);
}



muldiv(ltype,rtype,operator)
int	ltype,rtype,operator;
{
	int result;

	result=exprtype(ltype,rtype);
	if (operator==MODSYM || operator== '\\') result=INTTYPE;
	extraconvert(ltype,result,rtype);
	conversion(rtype,result);
	if ( result== INTTYPE)
	{
		if ( operator=='/') 
		{
			result=DOUBLETYPE;
			extraconvert(ltype,result,rtype);
			conversion(rtype,result);
                        C_dvf((arith)BEMFLTSIZE);
		} else
		if ( operator=='\\')
                        C_dvi((arith)BEMINTSIZE);
		else
		if ( operator=='*') 
                        C_mli((arith)BEMINTSIZE);
		else	
		if ( operator==MODSYM)
                        C_rmi((arith)BEMINTSIZE);
		else	error("illegal operator");
	} else {
		if ( operator=='/') 
                        C_dvf((arith)BEMFLTSIZE);
		else
		if ( operator=='*') 
                        C_mlf((arith)BEMFLTSIZE);
		else	error("illegal operator");
	}
	return(result);
}



negate(type)
int type;
{
	switch(type)
	{
		case INTTYPE:
                	C_ngi((arith)BEMINTSIZE); 
			break;
		case DOUBLETYPE:
		case FLOATTYPE:
                	C_ngf((arith)BEMFLTSIZE); 
			break;
		default:
			error("Illegal operator");
	}
	return(type);
}



#ifdef ___
power(ltype,rtype)
int	ltype,rtype;
{
	int resulttype = exprtype(ltype, rtype);

	extraconvert(ltype,resulttype,rtype);
	conversion(rtype,resulttype);
	switch(resulttype) {
	case INTTYPE:
		C_cal("_ipower");
		break;
	case DOUBLETYPE:
	case FLOATTYPE:
        	C_cal("_power");
		break;
	default:
		error("Illegal operator");
	}
        C_asp((arith)(2*typestring(resulttype)));
        C_lfr((arith)typestring(resulttype));
	return(resulttype);
}
#else
power(ltype,rtype)
int	ltype,rtype;
{
	extraconvert(ltype,DOUBLETYPE,rtype);
	conversion(rtype,DOUBLETYPE);
        C_cal("_power");
        C_asp((arith)(2*BEMFLTSIZE));
        C_lfr((arith)BEMFLTSIZE);
	return(DOUBLETYPE);
}
#endif


int typesize(ltype)
int ltype;
{
	switch( ltype)
	{
	case INTTYPE:
		return(BEMINTSIZE);
	case FLOATTYPE:
	case DOUBLETYPE:
		return(BEMFLTSIZE);
	case STRINGTYPE:
		return(BEMPTRSIZE);
	default:
		error("typesize:unexpected");
		if (debug) print("type received %d\n",ltype);
	}
	return(BEMINTSIZE);
}



int typestring(type)
int type;
{
	switch(type)
	{
		case INTTYPE:
			return(BEMINTSIZE);
		case FLOATTYPE:
		case DOUBLETYPE:
			return(BEMFLTSIZE);
		case STRINGTYPE:
			return(BEMPTRSIZE);
		default:
			error("typestring: unexpected type");
	}
	return(0);
}



loadvar(type)
int type;
{
	/* load a simple variable  its address is on the stack*/
        C_loi((arith)typestring(type));
}



loadint(value)
int value;
{
        C_loc((arith)value);
	return(INTTYPE);
}



loaddbl(value)
char *value;
{
	int index;

	index=genlabel();
	C_df_dlb((label)index);
	C_bss_fcon((arith)BEMFLTSIZE,value,(arith)BEMFLTSIZE,1);
	C_lae_dlb((label)index,(arith)0);
	C_loi((arith)BEMFLTSIZE);
	return(DOUBLETYPE);
}



loadstr(value)
int value;
{
	C_lae_dlb((label)value,(arith)0);
}



loadaddr(s)
Symbol *s;
{
	extern Symbol *fcn;
	int i,j;
	arith sum;

	if (debug) print("load %s %d\n",s->symname,s->symtype);
	if ( s->symalias>0)
		C_lae_dlb((label)s->symalias,(arith)0);
	else {	
		j= -s->symalias;
		if (debug) print("load parm %d\n",j);
		/* first count the sizes. */
		sum = 0;
		for(i=fcn->dimensions;i>j;i--)
			sum += typesize(fcn->dimlimit[i-1]);
		C_lal(sum);
	}
	return(s->symtype);
}



/* This is a new routine */
save_address()
{
	C_lae_dnam("dummy3",(arith)0);
	C_sti((arith)BEMPTRSIZE);
}



assign(type,lt)
int type,lt;
{
	extern int e1,e2;

	conversion(lt,type);
	C_lae_dnam("dummy3",(arith)0); /* Statement added by us */
	C_loi((arith)BEMPTRSIZE);
	/* address is on stack already */
	C_sti((arith)typestring(type));
}



storevar(lab,type)
int lab,type;
{
	/*store value back */
	C_lae_dlb((label)lab,(arith)0);
	C_sti((arith)typestring(type));
}



/* maintain a stack of array references */
int	dimstk[MAXDIMENSIONS], dimtop= -1;
Symbol  *arraystk[MAXDIMENSIONS];



newarrayload(s)
Symbol *s;
{
	if ( dimtop<MAXDIMENSIONS) dimtop++;
	if ( s->dimensions==0)
	{
		s->dimensions=1;
		defarray(s);
	}
	dimstk[dimtop]= 0;
	arraystk[dimtop]= s;
	C_lae_dlb((label)s->symalias,(arith)0);
}



endarrayload()
{
	return(arraystk[dimtop--]->symtype);
}



loadarray(type)
int	type;
{
	int	dim;
	Symbol	*s;

	if ( dimtop<0 || dimtop>=MAXDIMENSIONS)
		fatal("too many nested array references");
	/* index expression is on top of stack */
	s=arraystk[dimtop];
	dim= dimstk[dimtop];
	if ( dim>=s->dimensions)
	{
		error("too many indices");
		dimstk[dimtop]=0;
		return;
	}
	conversion(type,INTTYPE);
	C_lae_dlb((label)s->dimalias[dim],(arith)0);
	C_aar((arith)BEMINTSIZE);
	dimstk[dimtop]++;
}