text: #include "quip_config.h"
  
  #include <stdio.h>
  #include <ctype.h>
  #include <math.h>
  #include <string.h>
  
  #include "quip_prot.h"
  #include "data_obj.h"
  #include "vectree.h"
  #include "debug.h"
  //#include "query_stack.h"	// BUG?
  #include "vector_parser_data.h"
  
  /* for definition of function codes */
  #include "veclib/vecgen.h"
  
  #ifdef SGI
  #include <alloca.h>
  #endif
  
  Vec_Expr_Node *special_enp=NULL;	// JUST FOR DEBUGGING!!!
  Vec_Expr_Node *last_debugged_enp=NULL;	// JUST FOR DEBUGGING!!!
  
  static Vec_Expr_Node *dup_node(QSP_ARG_DECL  Vec_Expr_Node *enp);
  #define DUP_NODE(enp)			dup_node(QSP_ARG  enp)
  
  #ifdef FOOBAR
  // This appears in vectree.y, where it is used!?
  int whkeyword(Keyword *table,char *str)
  {
  	register int i;
  	register Keyword *kwp;
  
  	i=0;
  	kwp=table;
  	while( kwp->kw_code != -1 ){
  		if( !strcmp(str,kwp->kw_token) ) return(i);
  		kwp++;
  		i++;
  	}
  	return(-1);
  }
  #endif /* FOOBAR */
  
  static int node_serial=1;
  
  /* alloc_node doesn't do anything except grab some memory...
   * So it could just as well be a macro!
   */
  
  static Vec_Expr_Node * alloc_node(void)
  {
  	Vec_Expr_Node *enp;
  
  	enp = (Vec_Expr_Node *) getbuf(sizeof(*enp));
  //fprintf(stderr,"alloc_node returning new node at 0x%lx\n",(long)enp);
  
  	/* Do this after the code is set */
  	/* init_expr_node(enp); */
  
  	return(enp);
  }
  
  /* init_expr_node receives a virgin node with only the tree code filled in.
   * Here we initialize all the other fields.
   */
  
  void _init_expr_node(QSP_ARG_DECL  Vec_Expr_Node *enp)
  {
  	int i;
  
  	for(i=0;i<MAX_NODE_CHILDREN;i++)
  		SET_VN_CHILD(enp,i,NULL);
  	SET_VN_PARENT(enp,NULL);
  	SET_VN_SHAPE(enp, NULL);
  	SET_VN_PFDEV(enp, NULL);
  	SET_VN_FLAGS(enp, 0);
  	SET_VN_SERIAL(enp, node_serial++);
  	if( THIS_VPD != NULL ){
  		SET_VN_LINENO(enp, PARSER_LINE_NUM);	/* BUG need to point to filename also */
  		SET_VN_INFILE(enp, CURR_INFILE);
  		if( CURR_INFILE != NULL ){
  			INC_SR_COUNT(CURR_INFILE);
  		}
  	} else {
  		SET_VN_LINENO(enp, 0);
  		SET_VN_INFILE(enp, NULL);
  	}
  	SET_VN_RESOLVERS(enp, NULL);
  
  	switch( VN_DATA_TYPE(enp) ){
  		case ND_DECL:
  //fprintf(stderr,"initializing ND_DECL data for node at 0x%lx, code = %d\n",(long)enp,VN_CODE(enp));
  			SET_VN_DECL_NAME(enp, NULL);
  			SET_VN_DECL_CTX(enp, NULL);
  			SET_VN_DECL_PREC(enp, NULL );
  			SET_VN_DECL_REFS(enp, NULL);
  			SET_VN_DECL_FLAGS(enp, 0);
  			SET_VN_DECL_OBJ(enp, NULL);
  			break;
  		case ND_LIST:
  			SET_VN_N_ELTS(enp, 0);
  			break;
  		case ND_DBL:
  			SET_VN_DBLVAL(enp, 0.0);
  			break;
  		case ND_INT:
  			SET_VN_INTVAL(enp, 0);
  			break;
  		case ND_CALLF:
  			SET_VN_UK_ARGS(enp, NULL);
  			SET_VN_SUBRT(enp, NULL);
  			break;
  		case ND_STRING:
  			SET_VN_STRING(enp, NULL);
  			break;
  		case ND_CAST:
  			SET_VN_CAST_PREC_PTR(enp, NULL );
  			break;
  		case ND_FUNC:
  			SET_VN_FUNC_PTR(enp, NULL);
  			break;
  		case ND_SIZE_CHANGE:
  			SET_VN_SIZCH_SHAPE(enp, NULL);
  			break;
  		case ND_BMAP:
  			SET_VN_BM_CODE(enp, N_VEC_FUNCS);		/* illegal value */
  			SET_VN_BM_SHAPE(enp, NULL);
  			break;
  
  		case ND_DOBJ:
  			SET_VN_OBJ(enp,NULL);
  			break;
  
  		case ND_NONE:
  			/* this is legal and may happen */
  			break;
  
  		case ND_UNUSED:
  		case N_NODE_DATA_TYPES:
  			/* just here to suppress a compiler warning */
  			assert( AERROR("init_expr_node:  bad data type code!?") );
  			break;
  	}
  }
  
  static const char *data_type_names[N_NODE_DATA_TYPES];
  
  const char *node_data_type_desc(Node_Data_Type t)
  {
  	static int inited=0;
  
  	if( ! inited ){
  		assert( N_NODE_DATA_TYPES == 13 );
  
  		data_type_names[ ND_UNUSED ] = "unused";
  		data_type_names[ ND_NONE ] = "none";
  		data_type_names[ ND_LIST ] = "list";
  		data_type_names[ ND_DBL ] = "dbl";
  		data_type_names[ ND_INT ] = "int";
  		data_type_names[ ND_CALLF ] = "callf";
  		data_type_names[ ND_STRING ] = "string";
  		data_type_names[ ND_CAST ] = "cast";
  		data_type_names[ ND_FUNC ] = "func";
  		data_type_names[ ND_DECL ] = "decl";
  		data_type_names[ ND_SIZE_CHANGE ] = "size_change";
  		data_type_names[ ND_BMAP ] = "bmap";
  //		if( N_NODE_DATA_TYPES != 13 ){
  //			NERROR1("CAUTIOUS:  check initialization of data_type_names");
  //		}
  	}
  
  	return( data_type_names[t] );
  }
  
  /* set up a new node with the given code */
  
  #define another_node(code)	_another_node(QSP_ARG  code)
  
  static Vec_Expr_Node *_another_node(QSP_ARG_DECL  Tree_Code code)
  {
  	Vec_Expr_Node *enp;
  
  	enp = alloc_node();
  	// Clear the memory to be safe, we rely on things being NULL in a few places...
  	SET_VN_CODE(enp,code);
  	SET_LAST_NODE(NULL);
  	init_expr_node(enp);
  	SET_LAST_NODE(enp);
  	return(enp);
  }
  
  // nother child sets the child field int the parent, and if the child is not NULL
  // then sets the parent field in the child.
  
  static void another_child(Vec_Expr_Node * enp,Vec_Expr_Node * child,int index)
  {
  	SET_VN_CHILD(enp,index, child);
  	if( child != NULL ){
  //#ifdef CAUTIOUS
  		/* The strict tree structure is violated by plus-eq, do-while, etc */
  		/* what does that comment mean??? */
  		/* Perhaps something about how the nodes are created? */
  
  		/*
  //		if( VN_PARENT(child) != NULL ){
  //			sprintf(ERROR_STRING,
  //				"CAUTIOUS:  another_child:  node n%d (%s) has parent n%d (%s), rival n%d (%s)!?",
  //				child->en_serial,
  //				NNAME(child),
  //				VN_PARENT(child)->en_serial,
  //				NNAME(VN_PARENT(child)),
  //				enp->en_serial,
  //				NNAME(enp)
  //				);
  //			warn(ERROR_STRING);
  //		}
  		assert( VN_PARENT(child) == NULL );
  		*/
  //#endif /* CAUTIOUS */
  		SET_VN_PARENT(child, enp);
  	}
  }
  
  #define VERIFY_N_CHILDREN(code,n)							\
  	assert( tnt_tbl[code].tnt_nchildren == n );
  
  
  Vec_Expr_Node *_node3(QSP_ARG_DECL  Tree_Code code,Vec_Expr_Node *lchld,Vec_Expr_Node *rchld,Vec_Expr_Node *chld3)
  {
  	Vec_Expr_Node *enp;
  
  	VERIFY_N_CHILDREN(code,3);
  
  	enp = another_node(code);
  	another_child(enp,lchld,0);
  	another_child(enp,rchld,1);
  	another_child(enp,chld3,2);
  
  	return(enp);
  }
  
  
  
  Vec_Expr_Node *_node2(QSP_ARG_DECL  Tree_Code code,Vec_Expr_Node *lchld,Vec_Expr_Node *rchld)
  {
  	Vec_Expr_Node *enp;
  
  	VERIFY_N_CHILDREN(code,2);
  
  	enp=another_node(code);
  	another_child(enp,lchld,0);
  	another_child(enp,rchld,1);
  
  	return(enp);
  }
  
  
  Vec_Expr_Node *_node1(QSP_ARG_DECL  Tree_Code code,Vec_Expr_Node *lchld)
  {
  	Vec_Expr_Node *enp;
  
  	VERIFY_N_CHILDREN(code,1);
  
  	enp=another_node(code);
  	another_child(enp,lchld,0);
  
  	return(enp);
  }
  
  
  Vec_Expr_Node *_node0(QSP_ARG_DECL  Tree_Code code)
  {
  	VERIFY_N_CHILDREN(code,0);
  
  	return( another_node(code) );
  }
  
  static Vec_Expr_Node *dup_node(QSP_ARG_DECL  Vec_Expr_Node *enp)
  {
  	Vec_Expr_Node *new_enp;
  
  	new_enp = another_node(VN_CODE(enp));
  	/* now copy over the relevant data */
  	switch(VN_CODE(enp)){
  		case T_STRING:
  		case T_DYN_OBJ:
  		case T_POINTER:
  			SET_VN_STRING(new_enp, savestr(VN_STRING(enp)));
  			break;
  
  		case T_STATIC_OBJ:
  			SET_VN_OBJ(new_enp, VN_OBJ(enp));
  			break;
  
  		case T_LIT_DBL:
  			SET_VN_DBLVAL(new_enp, VN_DBLVAL(enp));
  			break;
  
  		case T_LIT_INT:
  			SET_VN_INTVAL(new_enp,VN_INTVAL(enp));
  			break;
  
  		case T_SIZE_FN:
  			SET_VN_FUNC_PTR(new_enp, VN_FUNC_PTR(enp));
  			break;
  
  		case T_CALL_NATIVE:
  		case T_MATH0_FN:
  		case T_MATH0_VFN:
  		case T_MATH1_FN:
  		case T_MATH1_VFN:
  			SET_VN_INTVAL(new_enp, VN_INTVAL(enp));
  			break;
  
  		case T_CALLFUNC:
  			SET_VN_SUBRT(new_enp, VN_SUBRT(enp) );
  			break;
  
  		/* safe do-nothing cases */
  		case T_ENTIRE_RANGE:
  		case T_DEREFERENCE:
  		case T_MINUS:
  		case T_PLUS:
  		case T_CURLY_SUBSCR:
  		case T_SQUARE_SUBSCR:
  		case T_IMAG_PART:
  		case T_SUBVEC:
  		case T_CSUBVEC:
  		case T_DIVIDE:
  		case T_INNER:
  
  		case T_ASSIGN:
  		/* matlab junk */
  		case T_ROW:
  		/* case T_ROWLIST: */
  		case T_UMINUS:
  		case T_TIMES:
  		/* matlab */
  		case T_NOP:
  		case T_I:
  		case T_SUBSCRIPT1:
  		case T_RANGE:
  		case T_RANGE2:
  		case T_FIRST_INDEX:
  		case T_LAST_INDEX:
  		case T_SUBMTRX:
  		case T_INDEX_SPEC:
  		case T_INDEX_LIST:
  		case T_EXPR_LIST:
  		case T_ARGLIST:
  			break;
  
  		default:
  			missing_case(enp,"dup_node");
  			break;
  	}
  	return(new_enp);
  }
  
  Vec_Expr_Node *_dup_tree(QSP_ARG_DECL  Vec_Expr_Node *enp)
  {
  	Vec_Expr_Node *new_enp;
  	int i;
  
  	new_enp = DUP_NODE(enp);
  
  	for(i=0;i<MAX_CHILDREN(enp);i++)
  		if( VN_CHILD(enp,i) != NULL ){
  			Vec_Expr_Node *new_child;
  			new_child = dup_tree(VN_CHILD(enp,i));
  			SET_VN_CHILD(new_enp,i, new_child);
  			SET_VN_PARENT(new_child, new_enp);
  		}
  
  	return(new_enp);
  }
  
  void _check_release(QSP_ARG_DECL  Vec_Expr_Node *enp)
  {
  	if( enp == NULL ) return;
  	if( NODE_IS_FINISHED(enp) ){
  		rls_vectree(enp);
  	} else if( VN_CODE(enp) == T_STAT_LIST ){
  		// Check children
  		check_release(VN_CHILD(enp,0));
  		check_release(VN_CHILD(enp,1));
  	}
  }
  
  //#ifdef NOT_USED
  
  /* We created this routine to get rid of function prototype arg decls...
   * But, in general this strategy is broken for fragments that are
   * multiply connected (e.g., child nodes with multiple parents)
   * because a child node could be visited twice!?
   * (how does that come about?)
   * Perhaps we could only release a child if the parent ptr
   * points to this node.
   * (what does that mean??)
   *
   * Another way to deal with that problem might be to have a reference count...
   */
  
  void _rls_vectree(QSP_ARG_DECL  Vec_Expr_Node *enp)
  {
  	int i;
  
  //DEBUG_IT_3(enp,rls_vectree BEGIN)
  //dump_tree(DEFAULT_QSP_ARG  enp);
  
  // BUG?  we could use the expected number of children based on node code...
  	for(i=0;i<MAX_CHILDREN(enp);i++)
  		if( VN_CHILD(enp,i) != NULL ){
  			assert( VN_PARENT(VN_CHILD(enp,i)) == enp );
  			rls_vectree(VN_CHILD(enp,i));
  		}
  
  //fprintf(stderr,"releasing %s\n",node_desc(enp));
  
  	/* now release this node */
  	if( VN_INFILE(enp) != NULL ){
  		DEC_SR_COUNT(VN_INFILE(enp));
  		// this gets done in vectree.y...
  		/* if( SR_COUNT(VN_INFILE(enp)) == 0 ){ rls_stringref(VN_INFILE(enp)); } */
  	}
  
  	switch( VN_DATA_TYPE(enp) ){
  		case ND_DECL:
  // we used to dump here, but children have already been freed!
   //           fprintf(stderr,"VN_DECL_OBJ(0x%lx) = 0x%lx\n",(long)enp,(long)VN_DECL_OBJ(enp));
  //if( VN_DECL_OBJ(enp) != NULL )
  //longlist(DEFAULT_QSP_ARG  VN_DECL_OBJ(enp) );
  //else
  //fprintf(stderr,"VN_DECL_OBJ is NULL...\n");
  //DEBUG_IT_3(enp,checking)
  			// Does this get initialized?
  			if( VN_DECL_OBJ(enp) != NULL )
  				SET_OBJ_EXTRA(VN_DECL_OBJ(enp),NULL);
  			break;
  		case ND_LIST:
  		case ND_DBL:
  		case ND_INT:
  		case ND_CALLF:
  		case ND_STRING:
  		case ND_CAST:
  		case ND_FUNC:
  		case ND_SIZE_CHANGE:
  			break;
  
  		case ND_BMAP:
  			if( VN_BM_SHAPE(enp) != NULL )
  				RELEASE_SHAPE_PTR( VN_BM_SHAPE(enp) );
  			break;
  		case ND_NONE:
  		case ND_UNUSED:
  			break;
  
  		case ND_DOBJ:
  			// The node points to an object - do we release the object???
  			// NO - it's just a reference...
  			break;
  
  		case N_NODE_DATA_TYPES:
  			/* just here to suppress a compiler warning */
  			assert( AERROR("init_expr_node:  bad data type code!?") );
  			break;
  		default:
  			sprintf(ERROR_STRING,
  "rls_vectree:  missing case for tree node data type %s",
  tnt_tbl[VN_CODE(enp)].tnt_name);
  			warn(ERROR_STRING);
  			break;
  	}
  
  	/* BUG we should check whether or not the node owns any lists,
  	 * shape info, etc.
  	 */
  	switch(VN_CODE(enp)){
  		case T_STRING:
  		case T_LABEL:
  		case T_PROTO:
  		case T_BADNAME:
  		case T_GO_BACK:
  		case T_GO_FWD:
  		case T_UNDEF:
  		case T_DYN_OBJ:
  		case T_STR_PTR:
  		case T_POINTER:
  		case T_SCAL_DECL:
  			// free the string data
  //DEBUG_IT_3(enp,releasing string)
  			rls_str(VN_STRING(enp));
  //DEBUG_IT_3(enp,done releasing string)
  			break;
  
  		case T_FUNCPTR_DECL:
  		case T_CSCAL_DECL:
  		case T_VEC_DECL:
  		case T_CVEC_DECL:
  		case T_IMG_DECL:
  		case T_CIMG_DECL:
  		case T_SEQ_DECL:
  		case T_CSEQ_DECL:
  		case T_PTR_DECL:
  			rls_str(VN_DECL_NAME(enp));
  			break;
  
  		default:
  			// do nothing?
  			break;
  	}
  
  	if( OWNS_SHAPE(enp) ){
  		rls_shape(VN_SHAPE(enp));
  	}
  
  	// Maybe better to have a free list of nodes?
  
  	givbuf(enp);
  }
  
  void set_global_ctx(SINGLE_QSP_ARG_DECL)
  {
  	Item_Context *icp;
  
  	icp = (Item_Context *)NODE_DATA(QLIST_TAIL(LIST_OF_DOBJ_CONTEXTS));
  #ifdef QUIP_DEBUG
  if( debug & scope_debug ){
  sprintf(ERROR_STRING,"set_global_ctx:  pushing global context %s",CTX_NAME(icp));
  advise(ERROR_STRING);
  }
  #endif /* QUIP_DEBUG */
  	//PUSH_ITEM_CONTEXT(DOBJ_ITEM_TYPE,icp);
  	push_dobj_context(icp);
  	icp = (Item_Context *)NODE_DATA(QLIST_TAIL(LIST_OF_ID_CONTEXTS));
  	PUSH_ID_CONTEXT(icp);
  }
  
  void unset_global_ctx(SINGLE_QSP_ARG_DECL)
  {
  #ifdef QUIP_DEBUG
  	Item_Context *icp;
  	icp = pop_item_context(dobj_itp);
  if( debug & scope_debug ){
  sprintf(ERROR_STRING,"unset_global_ctx:  global context %s popped",CTX_NAME(icp));
  advise(ERROR_STRING);
  }
  #else // ! QUIP_DEBUG
  	pop_item_context(dobj_itp);
  #endif /* QUIP_DEBUG */
  	
  	/*icp=*/ pop_item_context(id_itp);
  }
  
  
  void show_context_stack(QSP_ARG_DECL  Item_Type *itp)
  {
  	Node *np;
  	Item_Context *icp;
  
  	sprintf(ERROR_STRING,"Context stack for item type %s",IT_NAME(itp));
  	advise(ERROR_STRING);
  
  	np=QLIST_HEAD(LIST_OF_CONTEXTS(itp));
  
  	if( np==NULL ) {
  		warn("context list is empty");
  		return;
  	}
  	icp=(Item_Context *)NODE_DATA(np);
  	sprintf(ERROR_STRING,"%s (%s)",CTX_NAME(icp),CTX_NAME(current_context(itp)));
  	advise(ERROR_STRING);
  	np=NODE_NEXT(np);
  	while(np!=NULL){
  		icp=(Item_Context *)NODE_DATA(np);
  		sprintf(ERROR_STRING,"%s",CTX_NAME(icp));
  		advise(ERROR_STRING);
  		np=NODE_NEXT(np);
  	}
  }
  
  void _node_error(QSP_ARG_DECL  Vec_Expr_Node *enp)
  {
  	/* infile may be null if we are reading stdin??? */
  	if( VN_INFILE(enp) == NULL ){
  		return;
  	}
  
  	assert( string_is_printable(SR_STRING(VN_INFILE(enp))) );
  
  	sprintf(DEFAULT_ERROR_STRING,"File %s, line %d:",SR_STRING(VN_INFILE(enp)),VN_LINENO(enp));
  	advise(DEFAULT_ERROR_STRING);
  }
  
  