/************************************************************************/
/*                                                                      */
/* Copyright (c) 1988 -                                                 */
/*     The Rector and Visitors of the University of Virginia            */
/*                                                                      */
/* This code may not be distributed further without permission          */
/*      from the University of Virginia.                                */
/* This code is distributed WITHOUT ANY WARRANTY.  No claims are        */
/*      made as to whether it serves any particular purpose or even     */
/*      works at all.                                                   */
/*                                                                      */
/************************************************************************/

#include <stdio.h>
#include <string.h>
#include "types.h"
#include "scan.h"
#include "stopset.h"
#include "tword.h"
#include "object.h"
#include "node.h"
#include "ident.h"
#include "size.h"
#include "error.h"

/*
 * variable-access = identifier { selector } .
 *
 * selector = field-selector | index-selector | pointer-selector .
 */

OBJECT *
p_var_access(node, usage, stop)
	register NODE **node;
	int usage;
	STOPSET stop;
{
	STOPBUF mystop;
	register OBJECT *ob, *type;
	int packed, errflag=0;

	/*
	 * p_vaccess builds a parse tree node that has the address of
	 * the variable being accessed and returns the type of the
	 * variable.  The "usage" argument determines why the variable
	 * is being accessed, eg, to get its value, to store into it,
	 * to read into it, to use in a with stmt, etc.
	 */
	set_or(mystop, stop, select_begin, S0);
	ob = p_simple_var(usage, mystop);
	type = ob->ob_type;
	*node = nd_address(ob);
	while (set_in(symbol, select_begin)) {
		/*
		 * note that components of packed types may not be passed
		 * as variable parameters.
		 */
		packed = type->ob_flags & OB_PACKED;
		switch(symbol) {
		case SY_DOT:
			type = p_field_select(node, type, usage, mystop);
			if (packed && usage == VA_VARPARM)
				errflag++;
			break;
		case SY_UPARROW:
			type = p_ptr_select(node, type, usage, mystop);
			errflag = 0;
			break;
		case SY_LBRAC:
			type = p_index_select(node, type, mystop);
			if (packed && usage == VA_VARPARM)
				errflag++;
			break;
		}
	}
	if (errflag) {
		strcpy(err_text,
			"component of packed type passed as a variable parameter");
		err_msg(E_FATAL, E_PREVSYMBOL);
	}
	p_check(stop);

	/*
	 * do not return subrange type if parsing an expression.  The
	 * type of the expression is the parent type of the subrange.
	 */

	if (usage == VA_EXPR && type->ob_kind == OB_SUBRANGE)
		type = type->ob_type;
	if (type == std_universal) {  /* error recovery */
		nd_freetree(*node);
		*node = nd_label(0);  /* an inert node */
	}
	return(type);
}

/*
 * simple-variable = identifier .
 */

OBJECT *
p_simple_var(usage, stop)
	register int usage;
	STOPSET stop;
{
	IDENT *id;
	register OBJECT *ob;
	register int flags, errflag=0;

	/*
	 * returns the symbol table entry for an identifier, making sure
	 * that it is a variable or parameter, field, or function name.
	 * Keeps track of how a variable was used so that warnings can be
	 * issued for unused variables.
	 */
	switch(usage) {
	case VA_EXPR:
		flags = OB_USED;
		break;
	case VA_VARPARM:
	case VA_FORIDX:
	case VA_WITH:
		flags = (OB_INIT|OB_USED);
		break;
	case VA_ASSIGN:
	case VA_READ:
		flags = OB_INIT;
		break;
	}

	id = p_expectident(stop);
	if (!(ob = ob_searchall(id))) {
		if (id != id_noname) {
			sprintf(err_text, err_undef, "identifier", id->id_name);
			err_msg(E_FATAL, E_PREVSYMBOL);
		}
	}
	else {
		switch(ob->ob_kind) {
		case OB_BOUNDID:
			if (usage != VA_EXPR) {
				sprintf(err_text,
					"bound identifier \"%s\" modified",
					ob->ob_name);
				err_msg(E_FATAL, E_PREVSYMBOL);
			}
			break;
		case OB_FIELD:	/* inside a with statement */
			if ((ob->ob_flags & OB_TAGFIELD) && usage == VA_VARPARM) {
				sprintf(err_text, err_tag, ob->ob_name);
				err_msg(E_FATAL, E_PREVSYMBOL);
			}
			flags=0;
			break;
		case OB_VARIABLE:
			if (usage != VA_EXPR) {
				if (ob->ob_flags & OB_FORIDX) {
					sprintf(err_text,
						"for loop index \"%s\" modified inside loop",
						ob->ob_name);
					err_msg(E_FATAL, E_PREVSYMBOL);
				}
				if (ob->ob_level < ob_level)
					flags |= OB_THREAT;
			}
			break;
		case OB_FUNC:
			/*
			 * Function return value assignment requires that we are
			 * parsing an assignment statement, that the function
			 * encloses the current block, and that the left hand side
			 * is an identifier, i.e., disallow "f^ := expr".
			 */
			if (usage == VA_ASSIGN && ck_encloses(ob) && 
				symbol == SY_ASSIGN)
			{
				ob->ob_flags |= flags;
				ob = ob->ob.subp.retval;
			}
			else
				errflag++; 
			break;
		case OB_VALPARM:
		case OB_VARPARM:
			break;
		default:
			errflag++;
			break;
		}
		if (errflag) {
			sprintf(err_text, "illegal reference to %s \"%s\"",
				err_kind(ob->ob_kind), ob->ob_name);
			err_msg(E_FATAL, E_PREVSYMBOL);
			ob = OB_NULL;
		}
	}
	if (!ob) {  /* error recovery */
		ob = ob_tmpvar(TW_INT, SZ_INT, OB_VARIABLE);
		ob->ob_flags |= OB_FREETMP;
		ob->ob_type = std_universal;
	}
	if (ob->ob_type->ob_kind == OB_POINTER && symbol == SY_UPARROW)
		flags = OB_USED;
	if (usage == VA_READ && ck_hasfile(ob->ob_type))
		flags = OB_USED;
	ob->ob_flags |= flags;
	return(ob);
}

/*
 * field-selector = "." identifier .
 */

OBJECT *
p_field_select(node, rec, usage, stop)
	register NODE **node;
	OBJECT *rec;
	int usage;
	STOPSET stop;
{
	STOPBUF mystop;
	IDENT *id;
	register OBJECT *field;
	TWORD tw;

	/*
	 * be sure the field is in the record modify parse tree node
	 * to add field offset to the record variable's address.
	 */
	set_or(mystop, stop, set_cons(SY_IDENT, 0), S0);
	p_expect(SY_DOT, mystop);
	id = p_expectident(stop);
	if (rec->ob_kind == OB_RECORD) {
		for (field = rec->ob.record.field; field; field = field->ob_prev) {
			if (field->ob_kind == OB_FIELD &&
				field->ob_name == id->id_name)
			{
				break;
			}
		}
		if (field) {
			if ((field->ob_flags & OB_TAGFIELD) &&
				usage == VA_VARPARM)
			{
				sprintf(err_text, err_tag, field->ob_name);
				err_msg(E_FATAL, E_PREVSYMBOL);
			}
			tw = field->ob_tword;
			*node = nd_build(ND_PCONV, tw = TW_INCREF(tw), *node, ND_NULL);
			*node = nd_build(SY_PLUS, tw, *node,
				nd_icon(field->ob.field.offset, TW_INT));
			return(field->ob_type);
		}
		else if (id != id_noname) {
			sprintf(err_text, "record has no field \"%s\"", id->id_name);
			err_msg(E_FATAL, E_PREVSYMBOL);
		}
	}
	else if (rec != std_universal) {
		strcpy(err_text, "field selector (.) used on a non-record type");
		err_msg(E_FATAL, E_PREVSYMBOL);
	}
	return(std_universal);
}

/*
 * pointer-selector = "^" .
 */

OBJECT *
p_ptr_select(node, ptr, usage, stop)
	register NODE **node;
	OBJECT *ptr;
	int usage;
	STOPSET stop;
{
	TWORD tw;

	/*
	 * handles pointer dereference by building a parse tree that
	 * dereferences the address of the pointer.
	 * 
	 * handles file buffer-variable reference by emitting code to
	 * pass the address of the file variable to RT_wndo_ptr to
	 * get the address of the buffer-variable.
	 */
	p_expect(SY_UPARROW, stop);
	switch(ptr->ob_kind) {

	case OB_POINTER:
		tw = (*node)->nd_type;
		*node = nd_build (ND_DEREF, TW_DECREF(tw), *node, ND_NULL);
		return(ptr->ob_type);

	case OB_FILE:
		tw = ptr->ob_type->ob_tword;
		*node = nd_build(SY_COMMA, TW_UNDEF, *node,
			nd_icon(usage == VA_EXPR, TW_INT));
		*node = nd_build (ND_CALL, TW_INCREF(tw),
			nd_runtime("RT_wndo_ptr", TW_INCREF(tw)), *node);
		return(ptr->ob_type);

	default:
		if (ptr != std_universal) {
			strcpy(err_text,
				"pointer selector (^) used on a non- pointer/file type");
			err_msg(E_FATAL, E_PREVSYMBOL);
		}
	}
	return(std_universal);
}

/*
 * index-selector = "[" expression { "," expression } "]" .
 */

OBJECT *
p_index_select(node, array, stop)
	NODE **node;
	OBJECT *array;
	STOPSET stop;
{
	register OBJECT *index;
	STOPBUF mystop1, mystop2;
	NODE *idxnode;

	set_or(mystop1, stop, expr_begin, set_cons(SY_COMMA, SY_RBRAC, 0), S0);
	p_expect(SY_LBRAC, mystop1);
	set_or(mystop1, stop, set_cons(SY_COMMA, SY_RBRAC, 0), S0);
	set_or(mystop2, stop, expr_begin, set_cons(SY_RBRAC, 0), S0);
	for (;;) {
		index = p_expression(&idxnode, mystop1);
		array = p_array_index(node, array, index, idxnode);
		if (symbol != SY_COMMA)
			break;
		p_expect(SY_COMMA, mystop2);
	}
	p_expect(SY_RBRAC, stop);
	return(array);
}

/*
 * p_typesize builds an expression tree that computes the size of a
 * type.  Normally the size is a constant, but for conformant arrays
 * the size is passed as a parameter.
 */

NODE *
p_typesize(confa)
	OBJECT *confa;
{
	return (confa->ob_kind != OB_CONFARRAY ?
		nd_icon(confa->ob_size, TW_INT) :
		nd_value(confa->ob.confarray.size));
}

/*
 * p_array_index checks the type of the index expression and builds a
 * parse tree that indexes into an array.  We subtract the lower
 * bound from the index, multiply by the size of the base type,
 * and add to the address of the array.
 */

OBJECT *
p_array_index(node, array, index, idxnode)
	register NODE **node, *idxnode;
	register OBJECT *array, *index;
{
	OBJECT *myidx, *atype;
	TWORD tw;
	NODE *cnode;

	atype = array->ob_type;
	switch(array->ob_kind) {

	case OB_ARRAY:
		myidx = array->ob.array.indextype;
		break;

	case OB_CONFARRAY:
		myidx = array->ob.confarray.indextype;
		break;
	
	default:
		if (array != std_universal) {
			strcpy(err_text, "array index used on a non-array type");
			err_msg(E_FATAL, E_PREVSYMBOL);
		}
		atype = myidx = std_universal;
	}
	if (!ck_compatible(myidx, index)) {
		strcpy(err_text, "array index expression of wrong type");
		err_msg(E_FATAL, E_PREVSYMBOL);
		atype = std_universal;
	}
	idxnode = nd_build(ND_SCONV, TW_INT, idxnode, ND_NULL);

	switch (array->ob_kind) {

	case OB_ARRAY:
		idxnode = ck_range(idxnode,
			nd_icon(array->ob.array.lower, TW_INT),
			nd_icon(array->ob.array.upper, TW_INT), 0);
		idxnode = nd_build(SY_MINUS, TW_INT, idxnode,
			nd_icon(array->ob.array.lower, TW_INT));
		idxnode = nd_build(SY_STAR, TW_INT, idxnode, p_typesize(atype));
		break;

	case OB_CONFARRAY:
		idxnode = ck_range(idxnode, nd_value(array->ob.confarray.lower),
			nd_value(array->ob.confarray.upper), 0);
		cnode = nd_value(array->ob.confarray.lower);
		cnode = nd_build(ND_SCONV, TW_INT, cnode, ND_NULL);
		idxnode = nd_build(SY_MINUS, TW_INT, idxnode, cnode);
		idxnode = nd_build(SY_STAR, TW_INT, idxnode, p_typesize(atype));
		break;
	}
	tw = atype->ob_tword;
	tw = TW_INCREF(tw);
	*node = nd_build(ND_PCONV, tw, *node, ND_NULL);
	*node = nd_build(SY_PLUS, tw, idxnode, *node);
	return(atype);
}
