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

SPTREE		*gsym_tbl;
SPTREE		*lsym_tbl[MAX_NESTING];

/**********************************************************************/
/*   Prototypes.						      */
/**********************************************************************/
void	sym_init PROTO((void));
void	do_extern PROTO((void));
void	make_local_variable PROTO((void));
void	do_global PROTO((void));
void	move_symbols PROTO((SPTREE *));
void	declare PROTO((int));
SPBLK	*create_symbol PROTO((char *, int));
SYMBOL *	sym_lookup PROTO((char *));
ref_t	*halt_list;
/**********************************************************************/
/*   Pointer to value field of errno global variable.		      */
/**********************************************************************/
long	*errno_ptr;

int	nest_level = 0;
extern int errno;

void
sym_init()
{	register int i;
	static char halt_buf = (char) F_HALT;
	SPBLK	*spb;

	gsym_tbl = spinit();
	for (i = 0; i < MAX_NESTING; )
		lsym_tbl[i++] = spinit();
	halt_list = r_init(F_LIST, (char *) copy_list((LIST *) &halt_buf, 0), 1);
	
	/***********************************************/
	/*   errno   is  a  global  int  variable  we  */
	/*   define  for  storing  result  of  system  */
	/*   call errors.			       */
	/***********************************************/
	spb = create_symbol("errno", F_INT);
	errno_ptr = &((SYMBOL *) spb->data)->s_int;
	spenq(spb, gsym_tbl);
}
void
do_extern()
{
}
void
make_local_variable()
{
	move_symbols(curbp->b_syms);
}
void
do_global()
{
	move_symbols(gsym_tbl);
}
void
move_symbols(sym_tbl)
SPTREE	*sym_tbl;
{	register LIST	*lp = argv[1].l_list;
	register SPBLK	*spb;
	register SPBLK	*spb2;
	SYMBOL	*sp;
	u_int16	type;

	for (; *lp != F_HALT; lp += sizeof_atoms[*lp]) {
		char	*str;
		if (*lp == F_INT) {
			type = (u_int16) LGET32(lp);
			lp += sizeof_atoms[F_INT];
			}
		else
			type = 0;
		if (*lp != F_STR)
			continue;
		str = (char *) LGET32(lp);
		if ((spb = splookup(str, lsym_tbl[nest_level])) == NULL) {
			if (splookup(str, sym_tbl) == NULL) {
				spb = create_symbol(str, type);
				spenq(spb, sym_tbl);
				}
			continue;
			}
		spdeq(spb, lsym_tbl[nest_level]);
		if ((spb2 = splookup(str, sym_tbl)) != NULL) {
			/* Free old version of symbol entry. */
			spdeq(spb2, sym_tbl);
			sp = (SYMBOL *) spb2->data;
			if (sp->s_type == F_STR || sp->s_type == F_LIST)
				r_dec(sp->s_obj);
			chk_free(spb2->data);
			spfreeblk(spb2);
			}
		spenq(spb, sym_tbl);
		}
}
/**********************************************************************/
/*   Function  to  create  a  new  symbol.  We return the splay tree  */
/*   block  so  the  caller can figure out which symbol table to put  */
/*   it in.							      */
/**********************************************************************/
SPBLK *
create_symbol(str, type)
char	*str;
int	type;
{	SPBLK	*spb;
	SYMBOL	*sp;
	
	spb = (SPBLK *) spblk(sizeof (SYMBOL));
	sp = (SYMBOL *) spb->data;
	strcpy(sp->s_name, str);
	sp->s_type = type;
	sp->s_flag = 0;
	switch (type) {
	  case F_INT:
		sp->s_int = 0;
		break;
	  case F_STR:
		sp->s_obj = r_init(F_STR, "", 1);
		break;
	  case F_LIST:
		sp->s_obj = r_inc(halt_list);
		break;
	  case F_FLOAT:
	  	sp->s_float = 0.0;
		break;
	  default:
	  	sp->s_type = F_INT;
	  }
	spb->key = sp->s_name;
	return spb;
}
void
declare(flag)
int	flag;
{	SYMBOL	*sp;
	SPBLK	*spb;
	register LIST *lp;

	for (lp = argv[1].l_list; *lp != F_HALT &&
		(*lp == F_STR || *lp == F_ID); lp += sizeof_atoms[*lp]) {
		extern BUILTIN builtin[];
		char	*str;
		if (*lp == F_ID)
			str = builtin[LGET16(lp)].name;
		else
			str = (char *) LGET32(lp);
		/* if (spb = splookup(str, gsym_tbl)) {
			sp = (SYMBOL *) spb->data;
			if (sp->s_type) {
				if (flag == F_POLY)
					sp->s_flag = SF_POLY;
				continue;
				}
			}
		else */ {
			if (spb = splookup(str, lsym_tbl[nest_level])) {
				sp = (SYMBOL *) spb->data;
				if (sp->s_type == F_STR)
					r_dec(sp->s_obj);
				else if (sp->s_type == F_LIST) {
					r_dec(sp->s_obj);
					}
				}
			else {
				spb = (SPBLK *) spblk(sizeof (SYMBOL));
				sp = (SYMBOL *) spb->data;
				spb->key = sp->s_name;
				strcpy(sp->s_name, str);
				spenq(spb, lsym_tbl[nest_level]);
				sp->s_flag = 0;
				sp->s_obj = NULL;
				}
			}
		if (flag == F_POLY) {
			sp->s_flag = SF_POLY;
			sp->s_type = F_INT;
			}
		else
			sp->s_type = flag;
		switch (sp->s_type) {
		  case F_INT:
			sp->s_int = 0;
			break;
		  case F_STR:
			sp->s_obj = r_init(F_STR, "", 1);
			break;
		  case F_LIST:
			sp->s_obj = r_inc(halt_list);
			break;
		  case F_FLOAT:
		  	sp->s_float = 0.0;
			break;
		  default:
			sp->s_obj = NULL;
			break;
		  }
		}

	if (*lp != F_HALT) {
		ewprintf("illegal variable name");
		return;
		}
}
void
delete_buffer_symbols(bp)
register BUFFER *bp;
{
	delete_symbols(bp->b_syms);
	spfree(bp->b_syms);
}
void
delete_local_symbols()
{	extern int doing_return;

	delete_symbols(lsym_tbl[nest_level]);
	nest_level--;
	doing_return = FALSE;
}
void
delete_symbols(sym_tbl)
SPTREE	*sym_tbl;
{	register SYMBOL *sp;

	while (!spempty(sym_tbl)) {
		SPBLK *sp1 = sphead(sym_tbl);
		spdeq(sp1, sym_tbl);
		sp = (SYMBOL *) sp1->data;
		if (sp->s_type == F_STR || sp->s_type == F_LIST)
			r_dec(sp->s_obj);
		chk_free(sp1->data);
		spfreeblk(sp1);
		}
}
SYMBOL *
lookup(name)
char	*name;
{
	SYMBOL *sp = sym_lookup(name);
	extern int doing_return;

	if (sp)
		return sp;
		
	/***********************************************/
	/*   Force  macro  to  return on an undefined  */
	/*   symbol error.			       */
	/***********************************************/
	doing_return = TRUE;
	ewprintf("Undefined symbol: %s", name);
	return NULL;
}
SYMBOL *
sym_lookup(name)
char	*name;
{	register int	i;
	int	loop_cnt;
	MACRO	*mptr;
	extern MACRO *lookup_macro();
	SPBLK	*spb;

	for (loop_cnt = 0; loop_cnt++ < 2; ) {
		for (i = nest_level; i > 0; i--)
			if (lsym_tbl[i] && (spb = splookup(name, lsym_tbl[i])))
				return (SYMBOL *) spb->data;
		/***********************************************/
		/*   Try   the  global  symbol  table  if  it  */
		/*   isn't in the local tables.		       */
		/***********************************************/
		if (spb = splookup(name, gsym_tbl))
			return (SYMBOL *) spb->data;

		/***********************************************/
		/*   See  if  symbol  exists in buffer symbol  */
		/*   table.				       */
		/***********************************************/
		if ((spb = splookup(name, curbp->b_syms)) != NULL)
			return (SYMBOL *) spb->data;

		mptr = lookup_macro(name);
		if (mptr && mptr->m_flags & M_AUTOLOAD)
			ld_macro((char *) mptr->m_list);
		}

	return NULL;
}
/**********************************************************************/
/*   Assign   a   freshly   created   list   to  a  symbol  and  the  */
/*   accumulator.  We're  given  the  length of the list so we don't  */
/*   need to calculate it.					      */
/**********************************************************************/
void
list_assign(symbol, list, len)
SYMBOL	*symbol;
LIST	*list;
int	len;
{
	/***********************************************/
	/*   Free the old list if there is one.	       */
	/***********************************************/
	if (symbol->s_obj)
		r_dec(symbol->s_obj);
	symbol->s_obj = r_init(F_RLIST, (char *) list, len);
	trace_sym(symbol);
}
/**********************************************************************/
/*   Assign a reference to a symbol.				      */
/**********************************************************************/
void
ref_assign(sp, rp)
SYMBOL	*sp;
ref_t	*rp;
{
	/***********************************************/
	/*   Free the old list if there is one.	       */
	/***********************************************/
	if (sp->s_obj)
		r_dec(sp->s_obj);
	sp->s_obj = r_inc(rp);
	trace_sym(sp);
}
void
str_rassign(symbol, rp)
SYMBOL	*symbol;
ref_t	*rp;
{
	if (symbol->s_obj != rp) {
		r_dec(symbol->s_obj);
		symbol->s_obj = r_inc(rp);
		}
}
void
str_assign(sym, str)
SYMBOL	*sym;
char	*str;
{
	r_dec(sym->s_obj);
	sym->s_obj = r_init(F_STR, str, strlen(str) + 1);
	trace_ilog("  %s := %s\n", sym->s_name, sym->s_obj->r_ptr);
}
void
int_assign(sym, value)
SYMBOL *sym;
long	value;
{
	trace_ilog("  %s := %d\n", sym->s_name, value);
	sym->s_int = value;
}

void
sym_assign_fval(sp, value)
SYMBOL	*sp;
double	value;
{
	sp->s_float = value;
	trace_ilog("  %s := %g\n", sp->s_name, value);
	acc_assign_float(value);
}
/**********************************************************************/
/*   Assign  a  long  value  to  a  symbol  if  the  argv element is  */
/*   pointing to a symbol name.					      */
/**********************************************************************/
void
argv_assign(n, val)
int	n;
long	val;
{
	if (argv[n].l_flags != F_NULL)
		int_assign(argv[n].l_sym, val);
}
/**********************************************************************/
/*   Function  called  with  the  result  of  a  system call. If the  */
/*   system  call  failed,  then  update  the  global variable errno  */
/*   with the C version of errno.				      */
/**********************************************************************/
int
system_call(ret)
int	ret;
{
	if (ret < 0)
		*errno_ptr = (long) errno;
	return ret;
}
