ack/lang/pc/comp/readwrite.c

/* R E A D ( L N )   &   W R I T E ( L N ) */

#include	"debug.h"

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

#include	"LLlex.h"
#include	"def.h"
#include	"main.h"
#include	"misc.h"
#include	"node.h"
#include	"scope.h"
#include	"type.h"

/* DEBUG */
#include	"idf.h"

extern char	*sprint();

ChkRead(arg)
	register struct node *arg;
{
	struct node *file;
	char *name = "read";
	char *message, buff[80];
	extern char *ChkAllowedVar();

	assert(arg);
	assert(arg->nd_symb == ',');

	if( arg->nd_left->nd_type->tp_fund == T_FILE )	{
		file = arg->nd_left;
		arg = arg->nd_right;
		if( !arg )	{
			error("\"%s\": variable-access expected", name);
			return;
		}
	}
	else if( !(file = ChkStdInOut(name, 0)) )
		return;

	while( arg )	{
		assert(arg->nd_symb == ',');

		if( file->nd_type != text_type )	{
					/* real var & file of integer */
			if( !TstAssCompat(arg->nd_left->nd_type,
					BaseType(file->nd_type->next)) ) {
				node_error(arg->nd_left,
					"\"%s\": illegal parameter type",name);
				return;
			}
			else if( (BaseType(file->nd_type->next) == long_type
				    && arg->nd_left->nd_type == int_type)
				||
				(BaseType(file->nd_type->next) == int_type
				    && arg->nd_left->nd_type == long_type) ) {
			    if( int_size != long_size ) {
				 node_error(arg->nd_left,
					"\"%s\": longs and integers have different sizes",name);
				    return;
			    }
			    else node_warning(arg->nd_left,
					"\"%s\": mixture of longs and integers", name);
			}
		}
		else if( !(BaseType(arg->nd_left->nd_type)->tp_fund &
					( T_CHAR | T_NUMERIC )) )	{
			node_error(arg->nd_left,
					"\"%s\": illegal parameter type",name);
			return;
		}
		message = ChkAllowedVar(arg->nd_left, 1);
		if( message ) {
			sprint(buff,"\"%%s\": %s can't be a variable parameter",
							    message);
			node_error(arg->nd_left, buff, name);
			return;
		}

		CodeRead(file, arg->nd_left);
		arg = arg->nd_right;
	}
}

ChkReadln(arg)
	register struct node *arg;
{
	struct node *file;
	char *name = "readln";
	char *message, buff[80];
	extern char *ChkAllowedVar();

	if( !arg )	{
		if( !(file = ChkStdInOut(name, 0)) )
			return;
		else	{
			CodeReadln(file);
			return;
		}
	}

	assert(arg->nd_symb == ',');

	if( arg->nd_left->nd_type->tp_fund == T_FILE )	{
		if( arg->nd_left->nd_type != text_type )	{
			node_error(arg->nd_left,
					"\"%s\": textfile expected", name);
			return;
		}
		else	{
			file = arg->nd_left;
			arg = arg->nd_right;
		}
	}
	else if( !(file = ChkStdInOut(name, 0)) )
		return;

	while( arg )	{
		assert(arg->nd_symb == ',');

		if( !(BaseType(arg->nd_left->nd_type)->tp_fund &
					( T_CHAR | T_NUMERIC )) )	{
			node_error(arg->nd_left,
					"\"%s\": illegal parameter type",name);
			return;
		}
		message = ChkAllowedVar(arg->nd_left, 1);
		if( message ) {
			sprint(buff,"\"%%s\": %s can't be a variable parameter",
							    message);
			node_error(arg->nd_left, buff, name);
			return;
		}
		CodeRead(file, arg->nd_left);
		arg = arg->nd_right;
	}
	CodeReadln(file);
}

ChkWrite(arg)
	register struct node *arg;
{
	struct node *left, *expp, *file;
	char *name = "write";

	assert(arg);
	assert(arg->nd_symb == ',');
	assert(arg->nd_left->nd_symb == ':');

	left = arg->nd_left;
	expp = left->nd_left;

	if( expp->nd_type->tp_fund == T_FILE )	{
		if( left->nd_right )	{
			node_error(expp,
			       "\"%s\": filevariable can't have a width",name);
			return;
		}
		file = expp;
		arg = arg->nd_right;
		if( !arg )	{
			error("\"%s\": expression expected", name);
			return;
		}
	}
	else if( !(file = ChkStdInOut(name, 1)) )
		return;

	while( arg )	{
		assert(arg->nd_symb == ',');

		if( !ChkWriteParameter(file->nd_type, arg->nd_left, name) )
			return;

		CodeWrite(file, arg->nd_left);
		arg = arg->nd_right;
	}
}

ChkWriteln(arg)
	register struct node *arg;
{
	struct node *left, *expp, *file;
	char *name = "writeln";

	if( !arg )	{
		if( !(file = ChkStdInOut(name, 1)) )
			return;
		else	{
			CodeWriteln(file);
			return;
		}
	}

	assert(arg->nd_symb == ',');
	assert(arg->nd_left->nd_symb == ':');

	left = arg->nd_left;
	expp = left->nd_left;

	if( expp->nd_type->tp_fund == T_FILE )	{
		if( expp->nd_type != text_type )	{
			node_error(expp, "\"%s\": textfile expected", name);
			return;
		}
		if( left->nd_right )	{
			node_error(expp,
			      "\"%s\": filevariable can't have a width", name);
			return;
		}
		file = expp;
		arg = arg->nd_right;
	}
	else if( !(file = ChkStdInOut(name, 1)) )
		return;

	while( arg )	{
		assert(arg->nd_symb == ',');

		if( !ChkWriteParameter(text_type, arg->nd_left, name) )
			return;

		CodeWrite(file, arg->nd_left);
		arg = arg->nd_right;
	}
	CodeWriteln(file);
}

ChkWriteParameter(filetype, arg, name)
	struct type *filetype;
	struct node *arg;
	char *name;
{
	struct type *tp;
	char *mess = "illegal write parameter";

	assert(arg->nd_symb == ':');

	tp = BaseType(arg->nd_left->nd_type);

	if( filetype == text_type )	{
		if( !(tp == bool_type ||
				tp->tp_fund & (T_CHAR | T_NUMERIC | T_STRING) ||
				IsString(tp)) )	{
			node_error(arg->nd_left, "\"%s\": %s", name, mess);
			return 0;
		}
	}
	else	{
		if( !TstAssCompat(BaseType(filetype->next), tp) )	{
			node_error(arg->nd_left, "\"%s\": %s", name, mess);
			return 0;
		}
		if( arg->nd_right )	{
			node_error(arg->nd_left, "\"%s\": %s", name, mess);
			return 0;
		}
		else
			return 1;
	}

	/* Here we have a text-file */

	if( arg = arg->nd_right )	{
		/* Total width */

		assert(arg->nd_symb == ':');
		if( BaseType(arg->nd_left->nd_type) != int_type )	{
			node_error(arg->nd_left, "\"%s\": %s", name, mess);
			return 0;
		}
	}
	else
		return 1;

	if( arg = arg->nd_right )	{
		/* Fractional Part */

		assert(arg->nd_symb == ':');
		if( tp != real_type )	{
			node_error(arg->nd_left, "\"%s\": %s", name, mess);
			return 0;
		}
		if( BaseType(arg->nd_left->nd_type) != int_type )	{
			node_error(arg->nd_left, "\"%s\": %s", name, mess);
			return 0;
		}
	}
	return 1;
}

struct node *
ChkStdInOut(name, st_out)
	char *name;
{
	register struct def *df;
	register struct node *nd;

	if( !(df = lookup(str2idf(st_out ? output : input, 0),
			    GlobalScope, D_INUSE)) ||
			!(df->df_flags & D_PROGPAR) )	{
		error("\"%s\": standard input/output not defined", name);
		return NULLNODE;
	}

	nd = MkLeaf(Def, &dot);
	nd->nd_def = df;
	nd->nd_type = df->df_type;
	df->df_flags |= D_USED;

	return nd;
}

CodeRead(file, arg)
	register struct node *file, *arg;
{
	struct type *tp = BaseType(arg->nd_type);

	if( err_occurred ) return;

	CodeDAddress(file);

	if( file->nd_type == text_type )	{
		switch( tp->tp_fund )	{
			case T_CHAR:
				C_cal("_rdc");
				break;

			case T_INTEGER:
				C_cal("_rdi");
				break;

			case T_LONG:
				C_cal("_rdl");
				break;

			case T_REAL:
				C_cal("_rdr");
				break;

			default:
				crash("(CodeRead)");
				/*NOTREACHED*/
		}
		C_asp(pointer_size);
		C_lfr(tp->tp_size);
		RangeCheck(arg->nd_type, file->nd_type->next);
		CodeDStore(arg);
	}
	else	{
		/* Keep the address of the file on the stack */
		C_dup(pointer_size);

		C_cal("_wdw");
		C_asp(pointer_size);
		C_lfr(pointer_size);
		RangeCheck(arg->nd_type, file->nd_type->next);

		C_loi(file->nd_type->next->tp_psize);
		if( tp == real_type ) {
		    if( BaseType(file->nd_type->next) == int_type ||
			BaseType(file->nd_type->next) == long_type )
			    Int2Real(file->nd_type->next->tp_psize);
		}

		CodeDStore(arg);
		C_cal("_get");
		C_asp(pointer_size);
	}
}

CodeReadln(file)
	struct node *file;
{
	if( err_occurred ) return;

	CodeDAddress(file);
	C_cal("_rln");
	C_asp(pointer_size);
}

CodeWrite(file, arg)
	register struct node *file, *arg;
{
	int width = 0;
	register arith nbpars = pointer_size;
	register struct node *expp = arg->nd_left;
	struct node *right = arg->nd_right;
	struct type *tp = BaseType(expp->nd_type);

	if( err_occurred ) return;

	CodeDAddress(file);
	CodePExpr(expp);

	if( file->nd_type == text_type )	{
		if( tp->tp_fund & (T_ARRAY | T_STRINGCONST) )	{
			C_loc(IsString(tp));
			nbpars += pointer_size + int_size;
		}
		else nbpars += tp->tp_size;

		if( right )	{
			width = 1;
			CodePExpr(right->nd_left);
			nbpars += int_size;
			right = right->nd_right;
		}

		switch( tp->tp_fund )	{
			case T_ENUMERATION:	/* boolean */
				C_cal(width ? "_wsb" : "_wrb");
				break;

			case T_CHAR:
				C_cal(width ? "_wsc" : "_wrc");
				break;

			case T_INTEGER:
				C_cal(width ? "_wsi" : "_wri");
				break;

			case T_LONG:
				C_cal(width ? "_wsl" : "_wrl");
				break;

			case T_REAL:
				if( right )	{
					CodePExpr(right->nd_left);
					nbpars += int_size;
					C_cal("_wrf");
				}
				else C_cal(width ? "_wsr" : "_wrr");
				break;

			case T_ARRAY:
			case T_STRINGCONST:
				C_cal(width ? "_wss" : "_wrs");
				break;

			case T_STRING:
				C_cal(width ? "_wsz" : "_wrz");
				break;

			default:
				crash("(CodeWrite)");
				/*NOTREACHED*/
		}
		C_asp(nbpars);
	}
	else	{
		if( file->nd_type->next == real_type && tp == int_type )
			Int2Real(int_size);
		else if( file->nd_type->next == real_type && tp == long_type )
			Int2Real(long_size);

		CodeDAddress(file);
		C_cal("_wdw");
		C_asp(pointer_size);
		C_lfr(pointer_size);
		C_sti(file->nd_type->next->tp_psize);

		C_cal("_put");
		C_asp(pointer_size);
	}
}

CodeWriteln(file)
	register struct node *file;
{
	if( err_occurred ) return;

	CodeDAddress(file);
	C_cal("_wln");
	C_asp(pointer_size);
}