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

# define	ERROR	-1
# define	EXECUTE	-2

extern int	dflag;
/**********************************************************************/
/*   Structure  used  to  save  references  to  memory allocated for  */
/*   argument lists.						      */
/**********************************************************************/
struct saved {
	OPCODE		save_type;
	char		*save_str;
	};
/**********************************************************************/
/*   Prototypes.						      */
/**********************************************************************/
void	nexecute_macro PROTO((LIST *));
void	execute_macro PROTO((LIST *));
void	exec1 PROTO((LIST *, LIST *));
void	eval_args PROTO((BUILTIN *, LIST *));
void	free_saved PROTO((struct saved *, struct saved *));
int	eval_expr2 PROTO((int, LIST *, LISTV *));
void	arg_error PROTO((BUILTIN *, int, struct saved *, struct saved *, int));

static LIST f_halt = F_HALT;
LISTV	*argv;
int	argc;
int	*cur_line;
int	*cur_col;
extern	int	break_flag;
char	*command_name;		/* Name of macro primitive currently being */
				/* executed.				  */
int	doing_return = FALSE;	/* Set to TRUE when a 'return' is executed.*/

extern	int	ctrl_c;

void
eval_expr(lp)
LISTV	*lp;
{
	switch (lp->l_flags) {
	  case F_INT:
		acc_assign_int(lp->l_int);
		return;
	  case F_LIST:
		(void) execute_macro((LIST *) lp->l_list);
		return;
	  case F_RLIST:
		(void) execute_macro((LIST *) lp->l_ref->r_ptr);
		return;
	  default:
		ewprintf("eval_expr: Internal evaluation error");
	  }
}
/**********************************************************************/
/*   Function  to  take  a string like what the user can type at the  */
/*   command  prompt,  perform  a simple parse on it and execute the  */
/*   specified macro.						      */
/**********************************************************************/
int
str_exec(str)
char	*str;
{
	register char *cp = str;
	char	buf[256];
	char	*dp = buf;
# define	LIST_BUF_SIZE	128
	LIST	lp[LIST_BUF_SIZE];
	LIST	*lp1;
	int	ret;
	double	f;
	long	l;

	while (isspace(*cp))
		cp++;
	if (*cp == NULL)
		return 0;
	lp[0] = F_STR;
	LPUT32(lp, (long) dp);
	lp1 = lp + 5;
	while (*cp && !isspace(*cp))
		*dp++ = *cp++;
	*dp++ = NULL;
	while (*cp) {
		while (isspace(*cp))
			cp++;
		if (*cp == NULL)
			break;
		if (lp1 >= &lp[LIST_BUF_SIZE-10]) {
			ewprintf("Out of space in str_exec");
			return -1;
			}
		if (*cp == '-' || (*cp >= '0' && *cp <= '9') ||
		    (*cp == '.' && (cp[1] >= '0' && cp[1] <= '9'))) {
		    	int len;
		    	ret = parse_str_number(cp, &f, &l, &len);
			switch (ret) {
			  case PARSE_INTEGER:
			  	*lp1 = F_INT;
				LPUT32(lp1, l);
			  	break;
			  case PARSE_FLOAT:
			  	*lp1 = F_FLOAT;
				LPUT_FLOAT(lp1, f);
				lp1 += 4;
			  	break;
			  }
			cp += len;
			}
		else {
			register char *cp1;
			char	ch_term = ' ';

			if (*cp == '"')
				ch_term = '"', cp++;
			cp1 = cp;

			while (*cp) {
				if (*cp == '\\')
					 cp++;
				else if (*cp == ch_term)
					break;
				cp++;
				}

			*lp1 = F_LIT;
			LPUT32(lp1, (long) dp);
			for (cp = cp1; *cp && *cp != ch_term; ) {
				*dp++ = *cp++;
				} 

			*dp++ = NULL;
			if (*cp)
				cp++;
			}
		lp1 += 5;
		}
	*lp1 = F_HALT;
	nexecute_macro(lp);
	return 0;
}
void
nexecute_macro(lp)
LIST	*lp;
{	
	if (++nest_level >= MAX_NESTING)
		panic("Macro nesting overflow.");
	execute_macro(lp);
	delete_local_symbols();
}
void
execute_macro(lp)
register LIST	*lp;
{	static	int handling_ctrlc = FALSE;

	while (1) {
		switch (*lp) {
		  case F_LIST:
			if (ctrl_c && !handling_ctrlc) {
				handling_ctrlc = TRUE;
				trigger(REG_CTRLC);
				ctrl_c = FALSE;
				handling_ctrlc = FALSE;
				}
			execute_macro(lp + sizeof_atoms[*lp]);
			if (break_flag || doing_return)
				return;
			lp += LGET16(lp);
			continue;
		  case F_HALT:
		  	return;
		  default:
			if (dflag)
				trace_list(lp);
			exec1(lp, lp + sizeof_atoms[*lp]);
			return;
		  }
		}
}
void
exec1(lp_0, lp_argv)
register LIST	*lp_0;
LIST	*lp_argv;
{
	register BUILTIN *bp;
	char	*macro_name;
	register MACRO *mptr;
	int	saved_msg_level = 0;
	int	loop_count;
	MACRO	*saved_macro = NULL;
	int	opc = *lp_0;
	static	double	dval;

	switch (opc) {
	  case F_ID:
		bp = &builtin[LGET16(lp_0)];
		break;
	  case F_INT:
		acc_assign_int(LGET32(lp_0));
		return;
	  case F_FLOAT:
	  	LGET_FLOAT(lp_0, &dval);
		acc_assign_float(dval);
	  	return;
	  case F_LIT:
		acc_assign_str((char *) LGET32(lp_0), -1);
		return;
	  case F_RSTR:
	  	bp = lookup_builtin(((ref_t *) LGET32(lp_0))->r_ptr);
		break;
	  default:
	  	/***********************************************/
	  	/*   Should be F_STR.        		       */
	  	/***********************************************/
	  	bp = lookup_builtin((char *) LGET32(lp_0));
		break;
	  }

	if (bp) {
		if (bp->flags & B_REDEFINE) {
			if (bp->macro == NULL) {
				bp->macro = bp->first_macro;
				goto hell;
				}
			if (bp->macro == bp->first_macro)
				bp->argv = lp_argv;
			mptr = saved_macro = bp->macro;
			bp->macro = bp->macro->m_next;
			macro_name = bp->name;
			goto exec_macro;
			}
		else {
hell:			
	 		eval_args(bp, lp_argv);
			bp->argv = &f_halt;
			return;
			}
		}
	/*-------------------------------------------------*/
	/*   Lookup-defined macros.                        */
	/*-------------------------------------------------*/
	macro_name = opc == F_ID ? builtin[LGET16(lp_0)].name : 
				     (char *) LGET32(lp_0);
	for (loop_count = 0; loop_count < 2; loop_count++) {
		if (bp)
			mptr = saved_macro;
		else
			mptr = lookup_macro(macro_name);
		if (mptr)
			break;
		if (ld_macro(macro_name)) {
			extern int m_flag;
undefined_macro:
			if (m_flag == FALSE)
				errorf("%s undefined.", macro_name);
			return;
			}
		}
	if (mptr == NULL)
		goto undefined_macro;
	/*-------------------------------------------------*/
	/*   Check to see whether we need to autoload the  */
	/*   macro.                                        */
	/*-------------------------------------------------*/
exec_macro:
	if (mptr->m_flags & M_AUTOLOAD) {
		if (ld_macro((char *) mptr->m_list)) {
			return;
			}
		mptr = lookup_macro(macro_name);
		if (mptr->m_flags & M_AUTOLOAD)
			return;
		}
	lp_0 = mptr->m_list;
	if (*lp_0 == F_HALT)
		return;
	mac_stack[ms_cnt].name = macro_name;
	mac_stack[ms_cnt].argv = lp_argv;
	mac_stack[ms_cnt].nesting_level = nest_level + 1;
	if (ms_cnt++ == 0) {
		saved_msg_level = msg_level;
		msg_level = 1;
		}
	trace_log("Execute macro: %s\n", macro_name);
	nexecute_macro(lp_0);
	if (bp)
		bp->macro = saved_macro;
	mptr->m_ftime = FALSE;
	if (--ms_cnt == 0)
		msg_level = saved_msg_level;
}
int	cnt_x, cnt_y;
void
eval_args(bp, lp)
register BUILTIN *bp;
register LIST	*lp;
{
	register LISTV	*lap;
	int type;
	register unsigned char *bp_argp = bp->arg_types;
	int	bp_argc = bp->argc;
	register int	largc = 1;
	int	indefinite_args = FALSE;
	LIST	*bpargv = bp->argv;
	LIST	*optarg = &f_halt;
	struct saved	saved_str[MAX_ARGC];
	struct saved	*ssp;
	register int	i;
	LISTV	local_argv[MAX_ARGC];

	ssp = saved_str;
	lap = &local_argv[1];

	if (*lp == F_HALT) {
		lp = bpargv;
		bpargv = &f_halt;
		}

	/***********************************************/
	/*   If   number   of   valid  arguments  for  */
	/*   command  is  < 0, then take the absolute  */
	/*   value,  and  remember how many arguments  */
	/*   are  specified.  This  syntax is used to  */
	/*   mean  that  the same as '...' in ANSI C,  */
	/*   i.e.  allow  the  last  argument type to  */
	/*   repeat indefinitely.		       */
	/***********************************************/
	if (bp_argc < 0) {
		bp_argc = -bp_argc;
		indefinite_args = TRUE;
		}
		
	/***********************************************/
	/*   Keep  executing  following loop until we  */
	/*   run  out  of  arguments  passed  by  the  */
	/*   macro,   or   we've  processed  all  the  */
	/*   arguments needed by the primitive.	       */
	/***********************************************/
	while (bp_argc > 0 && *lp != F_HALT) {
		if (*bpargv != F_HALT) {
			optarg = bpargv;
			if (*bpargv == F_LIST)
				bpargv += LGET16(lp);
			else 
				bpargv += sizeof_atoms[*bpargv];
			}
		++largc;
		if ((*bp_argp & ARG_REST) == 0 && *lp == F_NULL) {
			if (optarg[0] != F_HALT) {
				type = eval_expr2(*bp_argp, optarg, lap);
				}
			else {
				if ((*bp_argp & ARG_OPT) == 0) {
					arg_error(bp, TRUE, saved_str, ssp, lap - local_argv);
					return;
					}
				lap->l_int = 0;
				lap->l_flags = F_NULL;
				type = F_HALT;
				}
			}
		else
			type = eval_expr2(*bp_argp, lp, lap);
		switch (type) {
		  case EXECUTE:
			goto execute;
		  case F_INT:
		  case F_FLOAT:
		  case F_NULL:
		  case F_HALT:
		  case F_LIT:
			break;
		  case F_STR:
			ssp->save_str = lap->l_str = strdup(lap->l_str);
			ssp->save_type = F_STR;
			ssp++;
			break;
		  case F_RLIST:
		  case F_RSTR:
			ssp->save_str = (char *) r_inc(lap->l_ref);
			ssp->save_type = type;
			lap->l_flags = type;
			ssp++;
			break;
		  case F_LIST:
			ssp->save_str = (char *) copy_list(lap->l_list, 0);
			ssp->save_type = F_LIST;
			lap->l_flags = F_LIST;
			ssp++;
			break;
		  case ERROR:
		  	/***********************************************/
		  	/*   One  last  chance  --  if  we  wanted an  */
		  	/*   int-value  but  we  have a float then do  */
		  	/*   a cast for the user.		       */
		  	/***********************************************/
			if ((*bp_argp & (ARG_LVAL|ARG_NUM)) == ARG_INT &&
				lap->l_flags == F_FLOAT) {
				lap->l_flags = F_INT;
				lap->l_int = (long) lap->l_float;
				break;
				}
			arg_error(bp, TRUE, saved_str, ssp, lap - local_argv);
			return;
		  default:
			ewprintf("%s: default case (type=%d)", bp->name, type);
			panic("default case");
		  }
		/***********************************************/
		/*   Skip  to  next argument descriptor. Dont  */
		/*   skip   to   next   one  if  we  have  an  */
		/*   indefinite  argument  list  and  this is  */
		/*   the last descriptor.		       */
		/***********************************************/
		if (!indefinite_args || bp_argc != 1) {
			bp_argc--;
			bp_argp++;
			}
		lap++;
		if ((i = *lp) == F_LIST) {
			lp += LGET16(lp);
			}
		else if (i == F_HALT)
			lp = bpargv;
		else
			lp += sizeof_atoms[i];
			
		/***********************************************/
		/*   Skip   rest   of  arguments  if  we  are  */
		/*   executing  a  return.  This  can  happen  */
		/*   for example on a symbol being undefined.  */
		/***********************************************/
		if (doing_return) {
			free_saved(saved_str, ssp);
			return;
			}
		}

	if (*lp != F_HALT) {
		ewprintf("%s: Too many arguments", bp->name);
		arg_error(bp, FALSE, saved_str, ssp, 0);
		return;
		}
		
	/***********************************************/
	/*   If    user   hasn't   specified   enough  */
	/*   arguments  then  complain  if any of the  */
	/*   arguments are mandatory.		       */
	/***********************************************/
	if (indefinite_args == FALSE) {
cnt_x++;
		while (bp_argc-- > 0) {
cnt_y++;
			if ((*bp_argp++ & ARG_OPT) == 0) {
				arg_error(bp, TRUE, saved_str, 
					ssp, lap - local_argv);
				return;
				}
			lap->l_flags = F_NULL;
			lap->l_int = 0;
			lap++;
			}
		}

execute:
	argv = local_argv;
	argc = largc;
	command_name = bp->name;
	set_hooked();
	(*bp->func)(bp->arg);
# ifndef	PRODUCTION
	if (dflag && (bp->flags & B_NOVALUE) == 0)
		acc_trace();
	bp->reference++;
# endif
	free_saved(saved_str, ssp);
}
void
free_saved(saved_str, ssp)
register struct saved *saved_str;
register struct saved *ssp;
{
	while (ssp > saved_str) {
		switch ((--ssp)->save_type) {
		  case F_STR:
			chk_free(ssp->save_str);
			break;
		  case F_LIST:
			free_list((LIST *) ssp->save_str);
			break;
		  case F_RLIST:
		  case F_RSTR:
			r_dec((ref_t *) ssp->save_str);
			break;
		  default:
		  	break;
		  }
		}
}
char state_tbl[][13] = { 
/*        ERROR HALT F_INT, F_STR, F_LIST, NULL,  F_ID, F_END, POLY, F_LIT, F_RSTR,F_FLOAT, F_RLIST*/
/*----*/ {   -1,  -1,   -1,    -1,     -1,   -1,    -1,    -1,   -1,    -1,     -1,     -1,     -1},
/*---i*/ {   -1,  -1,F_INT,    -1,     -1,   -1,    -1,    -1,   -1,    -1,     -1,     -1,     -1},
/*--f-*/ {   -1,  -1,   -1,    -1,     -1,   -1,    -1,    -1,   -1,    -1,     -1,F_FLOAT,     -1},
/*--fi*/ {   -1,  -1,F_INT,    -1,     -1,   -1,    -1,    -1,   -1,    -1,     -1,F_FLOAT,     -1},
/*-s--*/ {   -1,  -1,   -1, F_STR,     -1,   -1,  F_ID,    -1,   -1, F_LIT, F_RSTR,     -1,     -1},
/*-s-i*/ {   -1,  -1,F_INT, F_STR,     -1,   -1,  F_ID,    -1,   -1, F_LIT, F_RSTR,     -1,     -1},
/*-sf-*/ {   -1,  -1,   -1, F_STR,     -1,   -1,  F_ID,    -1,   -1, F_LIT, F_RSTR,F_FLOAT,     -1},
/*-sfi*/ {   -1,  -1,F_INT, F_STR,     -1,   -1,  F_ID,    -1,   -1, F_LIT, F_RSTR,F_FLOAT,     -1},
/*l---*/ {   -1,  -1,   -1,    -1, F_LIST,   -1,    -1,    -1,   -1,    -1,     -1,     -1, F_RLIST},
/*l--i*/ {   -1,  -1,F_INT,    -1, F_LIST,   -1,    -1,    -1,   -1,    -1,     -1,     -1, F_RLIST},
/*l-f-*/ {   -1,  -1,   -1,    -1, F_LIST,   -1,    -1,    -1,   -1,    -1,     -1,F_FLOAT, F_RLIST},
/*l-fi*/ {   -1,  -1,F_INT,    -1, F_LIST,   -1,    -1,    -1,   -1,    -1,     -1,F_FLOAT, F_RLIST},
/*ls--*/ {   -1,  -1,   -1, F_STR, F_LIST,   -1,  F_ID,    -1,   -1, F_LIT, F_RSTR,     -1, F_RLIST},
/*ls-i*/ {   -1,  -1,F_INT, F_STR, F_LIST,   -1,  F_ID,    -1,   -1, F_LIT, F_RSTR,     -1, F_RLIST},
/*lsf-*/ {   -1,  -1,   -1, F_STR, F_LIST,   -1,  F_ID,    -1,   -1, F_LIT, F_RSTR,F_FLOAT, F_RLIST},
/*lsfi*/ {   -1,  -1,F_INT, F_STR, F_LIST,F_NULL, F_ID,    -1,   -1, F_LIT, F_RSTR,F_FLOAT, F_RLIST},
	};
char	state2_tbl[][11] = {
/*        HALT F_INT,  F_STR, F_LIST, NULL,  F_ID, F_END, POLY, F_LIT, F_RSTR,F_FLOAT*/
/*----*/ {  -1,   -1,     -1,     -1,   -1,    -1,    -1,   -1,    -1,     -1,     -1},
/*---i*/ {  -1,F_HALT,    -1,     -1,   -1,    -1,    -1,   -1,    -1,     -1,     -1},
/*--f-*/ {  -1,   -1,     -1,     -1,   -1,    -1,    -1,   -1,    -1,     -1, F_HALT},
/*--fi*/ {  -1,F_HALT,    -1,     -1,   -1,    -1,    -1,   -1,    -1,     -1, F_HALT},
/*-s--*/ {  -1,   -1, F_HALT,     -1,   -1,    -1,    -1,   -1,    -1,     -1,     -1},
/*-s-i*/ {  -1,F_HALT,F_HALT,     -1,   -1,    -1,    -1,   -1,    -1,     -1,     -1},
/*-sf-*/ {  -1,   -1, F_HALT,     -1,   -1,    -1,    -1,   -1,    -1,     -1, F_HALT},
/*-sfi*/ {  -1,F_HALT,F_HALT,     -1,   -1,    -1,    -1,   -1,    -1,     -1, F_HALT},
/*l---*/ {  -1,   -1,     -1, F_HALT,   -1,    -1,    -1,   -1,    -1,     -1,     -1},
/*l--i*/ {  -1,F_HALT,    -1, F_HALT,   -1,    -1,    -1,   -1,    -1,     -1,     -1},
/*l-f-*/ {  -1,   -1,     -1, F_HALT,   -1,    -1,    -1,   -1,    -1,     -1, F_HALT},
/*l-fi*/ {  -1,F_HALT,    -1, F_HALT,   -1,    -1,    -1,   -1,    -1,     -1, F_HALT},
/*ls--*/ {  -1,   -1, F_HALT, F_HALT,   -1,    -1,    -1,   -1,    -1,     -1,     -1},
/*ls-i*/ {  -1,F_HALT,F_HALT, F_HALT,   -1,    -1,    -1,   -1,    -1,     -1,     -1},
/*lsf-*/ {  -1,   -1, F_HALT, F_HALT,   -1,    -1,    -1,   -1,    -1,     -1, F_HALT},
/*lsfi*/ {  -1,F_HALT,F_HALT, F_HALT,F_HALT,   -1,    -1,   -1,    -1,     -1, F_HALT},
	};
int
eval_expr2(arg, argp, lap)
int	arg;
LIST	*argp;
register LISTV *lap;
{	SYMBOL	*sp;

	switch (arg & (ARG_REST|ARG_COND|ARG_LVAL)) {
	  case ARG_LVAL:
		if (*argp != F_STR)
			return ERROR;
		if ((sp = lookup((char *) LGET32(argp))) == NULL)
			return ERROR;
		lap->l_sym = sp;
		lap->l_flags = sp->s_type;
		return state2_tbl[arg & ARG_ANY][sp->s_type];
	  case ARG_REST:
		lap->l_list = argp;
		lap->l_flags = F_LIST;
		return EXECUTE;
	  case ARG_COND:
		lap->l_list = argp;
		lap->l_flags = F_LIST;
		return F_HALT;
	  }
	return state_tbl[arg & ARG_ANY][eval(argp, lap) - F_ERROR];
}
void
arg_error(bp, msg, saved_str, ssp, arg)
BUILTIN *bp;
int	msg;
struct saved	*saved_str;
struct saved	*ssp;
int	arg;
{
	if (msg)
		errorf("%s: parameter %d invalid", bp->name, arg);
	free_saved(saved_str, ssp);
}
void
set_hooked()
{	static int junk_int;

	if (curwp && curwp->w_bufp == curbp) {
		cur_line = &curwp->w_line;
		cur_col = &curwp->w_col;
		cur_cmap = curbp->b_cmap ? curbp->b_cmap : curwp->w_cmap;
		}
	else if (curbp == NULL) {
		/***********************************************/
		/*   Allow  macro  code  to have something to  */
		/*   play with even if its non-sensical.       */
		/***********************************************/
		cur_line = &junk_int;
		cur_col = &junk_int;
		}
	else {
		cur_line = &curbp->b_line;
		cur_col = &curbp->b_col;
		cur_cmap = default_cmap;
		}
}
int
get_iarg1(str, l)
char	*str;
long	*l;
{
	char	buf[80];

	if (argv[1].l_flags == F_INT) {
		*l = argv[1].l_int;
		return 0;
		}
	if (ereply(str, buf, sizeof buf - 1) != TRUE || *buf == NULL)
		return -1;
	ewprintf("");
	sscanf(buf, "%ld", l);
	return 0;
}
char *
get_arg1(str, buf, bufsiz)
char	*str;
char	*buf;
int	bufsiz;
{	register char	*cp;
	LISTV	*saved_argv;
	
	switch (argv[1].l_flags) {
	  case F_STR:
	  case F_LIT:
		return argv[1].l_str;
	  case F_RSTR:
		return argv[1].l_ref->r_ptr;
	  default:
	  	break;
	  }
	
	saved_argv = argv;
	if (ereply(str, buf, bufsiz - 1) != TRUE || buf[0] == NULL) {
		argv = saved_argv;
		return (char *) NULL;
		}
	argv = saved_argv;
	for (cp = buf; *cp; cp++)
		if (*cp != ' ')
			break;
	return *cp == NULL ? (char *) NULL : buf;
}
