/**************************************************************
 *
 *	CRISP - Custom Reduced Instruction Set Programmers Editor
 *
 *	(C) Paul Fox, 1989
 *
 *    Please See COPYRIGHT notice.
 *
 **************************************************************/
# include	"list.h"
# include	"foxlib/pfloat.h"

extern int dflag;

int
eval(lp, lpv)
register LIST	*lp;
register LISTV	*lpv;
{

	switch (*lp) {
	  case F_INT:
		lpv->l_int = LGET32(lp);
		lpv->l_flags = F_INT;
		acc_assign_int(lpv->l_int);
		return F_INT;

	  case F_FLOAT:
	  	LGET_FLOAT(lp, &lpv->l_float);
		lpv->l_flags = F_FLOAT;
		acc_assign_float(lpv->l_float);
		return F_FLOAT;

	  case F_LIT:
		lpv->l_str = (char *) LGET32(lp);
		lpv->l_flags = F_LIT;
		acc_assign_lit(lpv->l_str);
		return F_LIT;

	  case F_ID:
		lpv->l_str = builtin[LGET16(lp)].name;
		lpv->l_flags = F_STR;
		acc_assign_str(lpv->l_str, -1);
		return F_LIT;

	  case F_NULL:
		return lpv->l_flags = F_NULL;

	  case F_STR: {
		SYMBOL	*sp;
		char *str = (char *) LGET32(lp);
		if ((sp = sym_lookup(str)) == NULL) {
			MACRO *mptr = lookup_macro(str);
			if (mptr == NULL) {
				extern int doing_return;
				/***********************************************/
				/*   On  an  error,  force  the current macro  */
				/*   to be aborted.			       */
				/***********************************************/
				ewprintf("Undefined symbol: %s", str);
				doing_return = TRUE;
				return F_ERROR;
				}
			trace_log("CODE<%s>\n", str);
			lpv->l_flags = F_LIST;
			lpv->l_list = mptr->m_list;
			return F_LIST;
			}
		if (dflag)
			trace_sym_ref(sp);
		switch (sp->s_type) {
		  case F_STR:
			lpv->l_flags = F_RSTR;
			lpv->l_ref = sp->s_obj;
			return F_RSTR;
		  case F_INT:
			lpv->l_flags = F_INT;
			lpv->l_int = sp->s_int;
			return F_INT;
		  case F_FLOAT:
			lpv->l_flags = F_FLOAT;
			lpv->l_float = sp->s_float;
			return F_FLOAT;
		  case F_LIST:
			lpv->l_flags = F_RLIST;
			lpv->l_ref = sp->s_obj;
			return F_RLIST;
		  case F_NULL:
		  	lpv->l_flags = F_NULL;
			return F_NULL;
		  default:
		  	panic("eval: what symtype ?");
		  }
		}
		
	  case F_LIST:
		execute_macro(lp + sizeof_atoms[F_LIST]);
		lpv->l_flags = acc_get_type();
		switch (lpv->l_flags) {
		  case F_INT:
			lpv->l_int = acc_get_ival();
			break;
		  case F_LIT:
		  case F_STR:
			lpv->l_str = acc_get_sval();
			break;
		  case F_RSTR:
			lpv->l_ref = acc_get_ref();
		  	break;
		  case F_LIST:
		  case F_RLIST:
		  	lpv->l_flags = F_RLIST;
			lpv->l_ref = acc_get_list();
			break;
		  case F_FLOAT:
		  	lpv->l_float = acc_get_fval();
			break;
		  case F_NULL:
		  	break;
		  default:
	  		panic("eval: what do I do with this ?");
			break;
		  }
		return lpv->l_flags;
		
	  default:
		return F_ERROR;
	  }
}
char *
get_str(n)
int	n;
{	register LISTV *lp = &argv[n];

	switch (lp->l_flags) {
	  case F_STR:
	  case F_LIT:
		return lp->l_str;
	  case F_RSTR:
		return lp->l_ref->r_ptr;
	  case F_INT:
	  case F_NULL:
	  case F_FLOAT:
		return "";
	  case F_LIST:
		return (char *) lp->l_list;
	  default:
		panic("get_str");
	  }
	/* NOTREACHED */
	return 0;
}
/**********************************************************************/
/*   Return  a  pointer  to  a  string  irrespective  of the type of  */
/*   string.							      */
/**********************************************************************/
char *
get_str_ptr(lp)
LIST	*lp;
{
	switch (*lp) {
	  case F_LIT:
	  case F_STR:
	  	return (char *) LGET32(lp);
	  case F_RSTR:
	  	return ((ref_t *) LGET32(lp))->r_ptr;
	  case F_ID:
		return builtin[LGET16(lp)].name;
	  default:
	  	return NULL;
	  }
}
int
get_len(n)
int	n;
{	register LISTV *lp = &argv[n];

	switch (lp->l_flags) {
	  case F_STR:
	  case F_LIT:
		return strlen(lp->l_str);
	  case F_RSTR:
		return lp->l_ref->r_used - 1;
	  case F_INT:
	  case F_NULL:
	  case F_FLOAT:
		return 0;
	  default:
		panic("get_len");
	  }
	/* NOTREACHED */
	return 0;
}
/**********************************************************************/
/*   Return  pointer  to  list  passed  as  an  argument. Handle the  */
/*   difference between an F_LIST and an F_RLIST.		      */
/**********************************************************************/
LIST *
get_list(n)
int	n;
{
	switch (argv[n].l_flags) {
	  case F_LIST:
		return argv[n].l_list;
	  case F_RLIST:
		return (LIST *) argv[n].l_ref->r_ptr;
	  case F_NULL:
	  	return (LIST *) NULL;
	  default:
	  	panic("get_list: what ?");
	  }
	return 0;
}
/*******************************************************************/
/*   This  function  is  used  to convert a string parameter into  */
/*   an underlying object. Useful for simple parsing.		   */
/*******************************************************************/
void
cvt_to_object()
{	char	*str = get_str(1);
	char	*start_str = str;
	double	dval;
	long	ival;
	int	len;
	int	ret;

	while (*str && *str != '"' && *str != '+' && *str != '-' && 
	       *str != '.' &&
	       (*str < '0' || *str > '9')) {
		str++;
		}
	if (*str == NULL) {
		len = str - start_str;
	  	acc_assign_int(0L);
		}
	else if (*str == '"') {
		str++;
		for (len = 0; str[len] && str[len] != '"'; len++) {
			if (str[len] == '\\' && str[len+1] != NULL)
				len++;
			}
		acc_assign_str(str, len);
		if (str[len])
			len++;
		len += str - start_str;
		}
	else {
		ret = parse_str_number(str, &dval, &ival, &len);
		len += str - start_str;
		switch (ret) {
		  case PARSE_INTEGER:
		  	acc_assign_int(ival);
			break;
		  case PARSE_FLOAT:
		  	acc_assign_float(dval);
			break;
		  default:
		  	len = -1;
		  	acc_assign_str("<Parse error>", -1);
			break;
		  }
		}
	if (argv[2].l_flags != F_NULL)
		int_assign(argv[2].l_sym, (long) (len+1));
}
char *
getv_str(lvp)
LISTV	*lvp;
{
	switch (lvp->l_flags) {
	  case F_LIT:
	  case F_STR:
	  	return lvp->l_str;
	  case F_RSTR:
	  	return lvp->l_ref->r_ptr;
	  default:
	  	return NULL;
	  }
}

