421 lines
7.7 KiB
C
421 lines
7.7 KiB
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 "node.h"
|
|
#include "scope.h"
|
|
#include "type.h"
|
|
|
|
ChkRead(arg)
|
|
register struct node *arg;
|
|
{
|
|
struct node *file;
|
|
char *name = "read";
|
|
|
|
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(arg->nd_left->nd_type)->tp_fund &
|
|
( T_CHAR | T_NUMERIC )) ) {
|
|
node_error(arg->nd_left,
|
|
"\"%s\": illegal parameter type",name);
|
|
return;
|
|
}
|
|
CodeRead(file, arg->nd_left);
|
|
arg = arg->nd_right;
|
|
}
|
|
}
|
|
|
|
ChkReadln(arg)
|
|
register struct node *arg;
|
|
{
|
|
struct node *file;
|
|
char *name = "readln";
|
|
|
|
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;
|
|
}
|
|
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) ||
|
|
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)) ||
|
|
!(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;
|
|
|
|
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_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( BaseType(file->nd_type->next) == int_type &&
|
|
tp == real_type )
|
|
Int2Real();
|
|
|
|
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_STRING) ) {
|
|
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_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_STRING:
|
|
C_cal(width ? "_wss" : "_wrs");
|
|
break;
|
|
|
|
default:
|
|
crash("CodeWrite)");
|
|
/*NOTREACHED*/
|
|
}
|
|
C_asp(nbpars);
|
|
}
|
|
else {
|
|
if( file->nd_type->next == real_type && tp == int_type )
|
|
Int2Real();
|
|
|
|
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);
|
|
}
|