123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421 |
- /* 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);
- }
|