ack/lang/pc/comp/body.c

#include    "parameters.h"
#include	"debug.h"

#include	<alloc.h>
#include	<assert.h>
#include	<em.h>

#include	"LLlex.h"
#include	"chk_expr.h"
#include	"def.h"
#include	"desig.h"
#include	"idf.h"
#include	"main.h"
#include	"misc.h"
#include	"node.h"
#include	"scope.h"
#include	"type.h"
#include    "code.h"
#include    "chk_expr.h"
#include    "tmpvar.h"
#include    "typequiv.h"
#include    "error.h"

void MarkDef(register struct node *nd, unsigned short flags, int on)
{
	while (nd && nd->nd_class != Def)
	{
		if ((nd->nd_class == Arrsel) || (nd->nd_class == LinkDef))
			nd = nd->nd_left;
		else if (nd->nd_class == Arrow)
			nd = nd->nd_right;
		else
			break;
	}
	if (nd && (nd->nd_class == Def))
	{
		if ((flags & D_SET) && on && BlockScope != nd->nd_def->df_scope)
			nd->nd_def->df_flags |= D_SETINHIGH;
		if (on)
		{
			/*
			 if( (flags & D_SET) &&
			 (nd->nd_def->df_flags & D_WITH) )
			 node_warning(nd,
			 "variable \"%s\" already referenced in with",
			 nd->nd_def->df_idf->id_text);
			 */
			nd->nd_def->df_flags |= flags;
		}
		else
			nd->nd_def->df_flags &= ~flags;
	}
}

void AssertStat(register struct node *expp, unsigned short line)
{
	struct desig dsr;

	if (!ChkExpression(expp))
	return;

	if (expp->nd_type != bool_type)
	{
		node_error(expp, "type of assertion should be boolean");
		return;
	}

	if (!options['a'] && !err_occurred)
	{
		dsr = InitDesig;
		CodeExpr(expp, &dsr, NO_LABEL);
		C_loc((arith) line);
		C_cal("_ass");
	}
}

void AssignStat(register struct node *left, register struct node *right)
{
	register struct type *ltp, *rtp;
	int retval = 0;
	struct desig dsr;

	retval = ChkExpression(right);
	MarkUsed(right);
	retval &= ChkLhs(left);

	ltp = left->nd_type;
	rtp = right->nd_type;

	MarkDef(left, (unsigned short) D_SET, 1);

	if (!retval)
		return;

	if (ltp == int_type && rtp == long_type)
	{
		right = MkNode(IntReduc, NULLNODE, right, &dot);
		right->nd_type = int_type;
	}
	else if (ltp == long_type && rtp == int_type)
	{
		right = MkNode(IntCoerc, NULLNODE, right, &dot);
		right->nd_type = long_type;
	}

	if (!TstAssCompat(ltp, rtp))
	{
		node_error(left, "type incompatibility in assignment");
		return;
	}

	if (left->nd_class == Def && (left->nd_def->df_flags & D_INLOOP))
	{
		node_error(left, "assignment to a control variable");
		return;
	}

	if (rtp == emptyset_type)
		right->nd_type = ltp;

	if (!err_occurred)
	{
		dsr = InitDesig;
		CodeExpr(right, &dsr, NO_LABEL);

		if (rtp->tp_fund & (T_ARRAY | T_RECORD))
			CodeAddress(&dsr);
		else
		{
			CodeValue(&dsr, rtp);

			if (ltp == real_type && BaseType(rtp) == int_type)
				Int2Real(rtp->tp_size);

			RangeCheck(ltp, rtp);
		}
		CodeMove(&dsr, left, rtp);
	}

	FreeNode(left);
	FreeNode(right);
}

void ProcStat(register struct node *nd)
{
	if (!ChkCall(nd))
		return;

	if (nd->nd_type)
	{
		node_error(nd, "procedure call expected");
		return;
	}
}

void ChkForStat(register struct node *nd)
{
	register struct def *df;
	int retvar = 0;

	retvar = ChkVariable(nd);
	retvar &= ChkExpression(nd->nd_left);
	MarkUsed(nd->nd_left);
	retvar &= ChkExpression(nd->nd_right);
	MarkUsed(nd->nd_right);
	if (!retvar)
		return;

	assert(nd->nd_class == Def);

	df = nd->nd_def;

	if (df->df_scope != BlockScope)
	{
		node_error(nd, "for loop: control variable must be local");
		return;
	}

	assert(df->df_kind == D_VARIABLE);

	if (df->df_scope != GlobalScope && df->var_off >= 0)
	{
		node_error(nd, "for loop: control variable can't be a parameter");
		MarkDef(nd, (unsigned short) (D_LOOPVAR | D_SET | D_USED), 1);
		return;
	}

	if (!(df->df_type->tp_fund & T_ORDINAL))
	{
		node_error(nd, "for loop: control variable must be ordinal");
		MarkDef(nd, (unsigned short) (D_LOOPVAR | D_SET | D_USED), 1);
		return;
	}

	if (!TstCompat(df->df_type, nd->nd_left->nd_type))
		node_error(nd,
				"for loop: initial value incompatible with control variable");

	if (!TstCompat(df->df_type, nd->nd_right->nd_type))
		node_error(nd,
				"for loop: final value incompatible with control variable");

	if (df->df_type == long_type)
		node_error(nd, "for loop: control variable can not be a long");

	if (df->df_flags & D_INLOOP)
		node_error(nd, "for loop: control variable already used");

	if (df->df_flags & D_SETINHIGH)
		node_error(nd, "for loop: control variable already set in block");

	MarkDef(nd, (unsigned short) (D_LOOPVAR | D_INLOOP | D_SET | D_USED), 1);

	return;
}

void EndForStat(register struct node *nd)
{
	register struct def *df;

	df = nd->nd_def;

	if ((df->df_scope != BlockScope)
			|| (df->df_scope != GlobalScope && df->var_off >= 0)
			|| !(df->df_type->tp_fund & T_ORDINAL))
		return;

	MarkDef(nd, (unsigned short) (D_INLOOP | D_SET), 0);
}

arith CodeInitFor(register struct node *nd, int priority)
{
	/* Push final-value, the value may only be evaluated
	 once, so generate a temporary for it, when not a constant.
	 */

	arith tmp;

	CodePExpr(nd);
	if (nd->nd_class != Value)
	{
		tmp = NewInt(priority);

		C_dup(int_size);
		C_stl(tmp);

		return tmp;
	}
	return (arith) 0;
}

void CodeFor(struct node *nd, int stepsize, label l1, label l2)
{
	/* Test if loop has to be done */
	if (stepsize == 1) /* TO */
		C_bgt(l2);
	else
		/* DOWNTO */
		C_blt(l2);

	/* Label at begin of the body */
	C_df_ilb(l1);

	RangeCheck(nd->nd_type, nd->nd_left->nd_type);
	CodeDStore(nd);
}

void CodeEndFor(struct node *nd, int stepsize, label l1, label l2, arith tmp2)
{
	/* Test if loop has to be done once more */
	CodePExpr(nd);
	C_dup(int_size);
	if (tmp2)
		C_lol(tmp2);
	else
		CodePExpr(nd->nd_right);
	C_beq(l2);

	/* Increment/decrement the control-variable */
	if (stepsize == 1) /* TO */
		C_inc();
	else
		/* DOWNTO */
		C_dec();
	C_bra(l1);

	/* Exit label */
	C_df_ilb(l2);
	C_asp(int_size);
}

void WithStat(struct node *nd)
{
	struct withdesig *wds;
	struct desig ds;
	struct scopelist *scl;

	if (nd->nd_type->tp_fund != T_RECORD)
	{
		node_error(nd, "record variable expected");
		return;
	}

	MarkDef(nd, (unsigned short) (D_USED | D_SET | D_WITH), 1);
	/*
	 if( (nd->nd_class == Arrow) &&
	 (nd->nd_right->nd_type->tp_fund & T_FILE) ) {
	 nd->nd_right->nd_def->df_flags |= D_WITH;
	 }
	 */

	scl = new_scopelist();
	scl->sc_scope = nd->nd_type->rec_scope;
	scl->next = CurrVis;
	CurrVis = scl;

	if (err_occurred)
		return;

	/* Generate code */

	CodeDAddress(nd);

	wds = new_withdesig();
	wds->w_next = WithDesigs;
	WithDesigs = wds;
	wds->w_scope = scl->sc_scope;

	/* create a desig structure for the temporary */
	ds.dsg_kind = DSG_FIXED;
	ds.dsg_offset = NewPtr(1);
	ds.dsg_name = 0;

	/* need some pointertype to store pointer */
	CodeStore(&ds, nil_type);

	/* record is indirectly available */
	ds.dsg_kind = DSG_PFIXED;
	wds->w_desig = ds;
}

void EndWith(struct scopelist *saved_scl, struct node *nd)
{
	/* restore scope, and release structures */
	struct scopelist *scl;
	struct withdesig *wds;
	struct node *nd1;

	while (CurrVis != saved_scl)
	{

		/* release scopelist */
		scl = CurrVis;
		CurrVis = CurrVis->next;
		free_scopelist(scl);

		if (WithDesigs == 0)
			continue; /* we didn't generate any code */

		/* release temporary */
		FreePtr(WithDesigs->w_desig.dsg_offset);

		/* release withdesig */
		wds = WithDesigs;
		WithDesigs = WithDesigs->w_next;
		free_withdesig(wds);
	}

	for (nd1 = nd; nd1 != NULLNODE; nd1 = nd1->nd_right)
	{
		MarkDef(nd1->nd_left, (unsigned short) (D_WITH), 0);
	}

	FreeNode(nd);
}