lang/pc/comp/readwrite.c

   1 /* R E A D ( L N )   &   W R I T E ( L N ) */
   2
   3 #include        "debug.h"
   4
   5 #include        <assert.h>
   6 #include        <em.h>
   7
   8 #include        "LLlex.h"
   9 #include        "def.h"
  10 #include        "main.h"
  11 #include        "misc.h"
  12 #include        "node.h"
  13 #include        "scope.h"
  14 #include        "type.h"
  15
  16 /* DEBUG */
  17 #include        "idf.h"
  18
  19 extern char     *sprint();
  20
  21 ChkRead(arg)
  22         register struct node *arg;
  23 {
  24         struct node *file;
  25         char *name = "read";
  26         char *message, buff[80];
  27         extern char *ChkAllowedVar();
  28
  29         assert(arg);
  30         assert(arg->nd_symb == ',');
  31
  32         if( arg->nd_left->nd_type->tp_fund == T_FILE )  {
  33                 file = arg->nd_left;
  34                 arg = arg->nd_right;
  35                 if( !arg )      {
  36                         error("\"%s\": variable-access expected", name);
  37                         return;
  38                 }
  39                 MarkUsed(file);
  40         }
  41         else if( !(file = ChkStdInOut(name, 0)) )
  42                 return;
  43
  44         while( arg )    {
  45                 assert(arg->nd_symb == ',');
  46
  47                 if( file->nd_type != text_type )        {
  48                                         /* real var & file of integer */
  49                         if( !TstAssCompat(arg->nd_left->nd_type,
  50                                         BaseType(file->nd_type->next)) ) {
  51                                 node_error(arg->nd_left,
  52                                         "\"%s\": illegal parameter type",name);
  53                                 return;
  54                         }
  55                         else if( (BaseType(file->nd_type->next) == long_type
  56                                     && arg->nd_left->nd_type == int_type)
  57                                 ||
  58                                 (BaseType(file->nd_type->next) == int_type
  59                                     && arg->nd_left->nd_type == long_type) ) {
  60                             if( int_size != long_size ) {
  61                                  node_error(arg->nd_left,
  62                                         "\"%s\": longs and integers have different sizes",name);
  63                                     return;
  64                             }
  65                             else node_warning(arg->nd_left,
  66                                         "\"%s\": mixture of longs and integers", name);
  67                         }
  68                 }
  69                 else if( !(BaseType(arg->nd_left->nd_type)->tp_fund &
  70                                         ( T_CHAR | T_NUMERIC )) )       {
  71                         node_error(arg->nd_left,
  72                                         "\"%s\": illegal parameter type",name);
  73                         return;
  74                 }
  75                 message = ChkAllowedVar(arg->nd_left, 1);
  76                 if( message ) {
  77                         sprint(buff,"\"%%s\": %s can't be a variable parameter",
  78                                                             message);
  79                         node_error(arg->nd_left, buff, name);
  80                         return;
  81                 }
  82
  83                 CodeRead(file, arg->nd_left);
  84                 arg = arg->nd_right;
  85         }
  86 }
  87
  88 ChkReadln(arg)
  89         register struct node *arg;
  90 {
  91         struct node *file;
  92         char *name = "readln";
  93         char *message, buff[80];
  94         extern char *ChkAllowedVar();
  95
  96         if( !arg )      {
  97                 if( !(file = ChkStdInOut(name, 0)) )
  98                         return;
  99                 else    {
 100                         CodeReadln(file);
 101                         return;
 102                 }
 103         }
 104
 105         assert(arg->nd_symb == ',');
 106
 107         if( arg->nd_left->nd_type->tp_fund == T_FILE )  {
 108                 if( arg->nd_left->nd_type != text_type )        {
 109                         node_error(arg->nd_left,
 110                                         "\"%s\": textfile expected", name);
 111                         return;
 112                 }
 113                 else    {
 114                         file = arg->nd_left;
 115                         arg = arg->nd_right;
 116                         MarkUsed(file);
 117                 }
 118         }
 119         else if( !(file = ChkStdInOut(name, 0)) )
 120                 return;
 121
 122         while( arg )    {
 123                 assert(arg->nd_symb == ',');
 124
 125                 if( !(BaseType(arg->nd_left->nd_type)->tp_fund &
 126                                         ( T_CHAR | T_NUMERIC )) )       {
 127                         node_error(arg->nd_left,
 128                                         "\"%s\": illegal parameter type",name);
 129                         return;
 130                 }
 131                 message = ChkAllowedVar(arg->nd_left, 1);
 132                 if( message ) {
 133                         sprint(buff,"\"%%s\": %s can't be a variable parameter",
 134                                                             message);
 135                         node_error(arg->nd_left, buff, name);
 136                         return;
 137                 }
 138                 CodeRead(file, arg->nd_left);
 139                 arg = arg->nd_right;
 140         }
 141         CodeReadln(file);
 142 }
 143
 144 ChkWrite(arg)
 145         register struct node *arg;
 146 {
 147         struct node *left, *expp, *file;
 148         char *name = "write";
 149
 150         assert(arg);
 151         assert(arg->nd_symb == ',');
 152         assert(arg->nd_left->nd_symb == ':');
 153
 154         left = arg->nd_left;
 155         expp = left->nd_left;
 156
 157         if( expp->nd_type->tp_fund == T_FILE )  {
 158                 if( left->nd_right )    {
 159                         node_error(expp,
 160                                "\"%s\": filevariable can't have a width",name);
 161                         return;
 162                 }
 163                 file = expp;
 164                 MarkUsed(file);
 165                 arg = arg->nd_right;
 166                 if( !arg )      {
 167                         error("\"%s\": expression expected", name);
 168                         return;
 169                 }
 170         }
 171         else if( !(file = ChkStdInOut(name, 1)) )
 172                 return;
 173
 174         while( arg )    {
 175                 assert(arg->nd_symb == ',');
 176
 177                 if( !ChkWriteParameter(file->nd_type, arg->nd_left, name) )
 178                         return;
 179
 180                 CodeWrite(file, arg->nd_left);
 181                 arg = arg->nd_right;
 182         }
 183 }
 184
 185 ChkWriteln(arg)
 186         register struct node *arg;
 187 {
 188         struct node *left, *expp, *file;
 189         char *name = "writeln";
 190
 191         if( !arg )      {
 192                 if( !(file = ChkStdInOut(name, 1)) )
 193                         return;
 194                 else    {
 195                         CodeWriteln(file);
 196                         return;
 197                 }
 198         }
 199
 200         assert(arg->nd_symb == ',');
 201         assert(arg->nd_left->nd_symb == ':');
 202
 203         left = arg->nd_left;
 204         expp = left->nd_left;
 205
 206         if( expp->nd_type->tp_fund == T_FILE )  {
 207                 if( expp->nd_type != text_type )        {
 208                         node_error(expp, "\"%s\": textfile expected", name);
 209                         return;
 210                 }
 211                 if( left->nd_right )    {
 212                         node_error(expp,
 213                               "\"%s\": filevariable can't have a width", name);
 214                         return;
 215                 }
 216                 file = expp;
 217                 MarkUsed(file);
 218                 arg = arg->nd_right;
 219         }
 220         else if( !(file = ChkStdInOut(name, 1)) )
 221                 return;
 222
 223         while( arg )    {
 224                 assert(arg->nd_symb == ',');
 225
 226                 if( !ChkWriteParameter(text_type, arg->nd_left, name) )
 227                         return;
 228
 229                 CodeWrite(file, arg->nd_left);
 230                 arg = arg->nd_right;
 231         }
 232         CodeWriteln(file);
 233 }
 234
 235 ChkWriteParameter(filetype, arg, name)
 236         struct type *filetype;
 237         struct node *arg;
 238         char *name;
 239 {
 240         struct type *tp;
 241         char *mess = "illegal write parameter";
 242
 243         assert(arg->nd_symb == ':');
 244
 245         tp = BaseType(arg->nd_left->nd_type);
 246
 247         if( filetype == text_type )     {
 248                 if( !(tp == bool_type ||
 249                                 tp->tp_fund & (T_CHAR | T_NUMERIC | T_STRING) ||
 250                                 IsString(tp)) ) {
 251                         node_error(arg->nd_left, "\"%s\": %s", name, mess);
 252                         return 0;
 253                 }
 254         }
 255         else    {
 256                 if( !TstAssCompat(BaseType(filetype->next), tp) )       {
 257                         node_error(arg->nd_left, "\"%s\": %s", name, mess);
 258                         return 0;
 259                 }
 260                 if( arg->nd_right )     {
 261                         node_error(arg->nd_left, "\"%s\": %s", name, mess);
 262                         return 0;
 263                 }
 264                 else
 265                         return 1;
 266         }
 267
 268         /* Here we have a text-file */
 269
 270         if( arg = arg->nd_right )       {
 271                 /* Total width */
 272
 273                 assert(arg->nd_symb == ':');
 274                 if( BaseType(arg->nd_left->nd_type) != int_type )       {
 275                         node_error(arg->nd_left, "\"%s\": %s", name, mess);
 276                         return 0;
 277                 }
 278         }
 279         else
 280                 return 1;
 281
 282         if( arg = arg->nd_right )       {
 283                 /* Fractional Part */
 284
 285                 assert(arg->nd_symb == ':');
 286                 if( tp != real_type )   {
 287                         node_error(arg->nd_left, "\"%s\": %s", name, mess);
 288                         return 0;
 289                 }
 290                 if( BaseType(arg->nd_left->nd_type) != int_type )       {
 291                         node_error(arg->nd_left, "\"%s\": %s", name, mess);
 292                         return 0;
 293                 }
 294         }
 295         return 1;
 296 }
 297
 298 struct node *
 299 ChkStdInOut(name, st_out)
 300         char *name;
 301 {
 302         register struct def *df;
 303         register struct node *nd;
 304
 305         if( !(df = lookup(str2idf(st_out ? output : input, 0),
 306                             GlobalScope, D_INUSE)) ||
 307                         !(df->df_flags & D_PROGPAR) )   {
 308                 error("\"%s\": standard input/output not defined", name);
 309                 return NULLNODE;
 310         }
 311
 312         nd = MkLeaf(Def, &dot);
 313         nd->nd_def = df;
 314         nd->nd_type = df->df_type;
 315         df->df_flags |= D_USED;
 316
 317         return nd;
 318 }
 319
 320 CodeRead(file, arg)
 321         register struct node *file, *arg;
 322 {
 323         struct type *tp = BaseType(arg->nd_type);
 324
 325         if( err_occurred ) return;
 326
 327         CodeDAddress(file);
 328
 329         if( file->nd_type == text_type )        {
 330                 switch( tp->tp_fund )   {
 331                         case T_CHAR:
 332                                 C_cal("_rdc");
 333                                 break;
 334
 335                         case T_INTEGER:
 336                                 C_cal("_rdi");
 337                                 break;
 338
 339                         case T_LONG:
 340                                 C_cal("_rdl");
 341                                 break;
 342
 343                         case T_REAL:
 344                                 C_cal("_rdr");
 345                                 break;
 346
 347                         default:
 348                                 crash("(CodeRead)");
 349                                 /*NOTREACHED*/
 350                 }
 351                 C_asp(pointer_size);
 352                 C_lfr(tp->tp_size);
 353                 RangeCheck(arg->nd_type, file->nd_type->next);
 354                 CodeDStore(arg);
 355         }
 356         else    {
 357                 /* Keep the address of the file on the stack */
 358                 C_dup(pointer_size);
 359
 360                 C_cal("_wdw");
 361                 C_asp(pointer_size);
 362                 C_lfr(pointer_size);
 363                 RangeCheck(arg->nd_type, file->nd_type->next);
 364
 365                 C_loi(file->nd_type->next->tp_psize);
 366                 if( tp == real_type ) {
 367                     if( BaseType(file->nd_type->next) == int_type ||
 368                         BaseType(file->nd_type->next) == long_type )
 369                             Int2Real(file->nd_type->next->tp_psize);
 370                 }
 371
 372                 CodeDStore(arg);
 373                 C_cal("_get");
 374                 C_asp(pointer_size);
 375         }
 376 }
 377
 378 CodeReadln(file)
 379         struct node *file;
 380 {
 381         if( err_occurred ) return;
 382
 383         CodeDAddress(file);
 384         C_cal("_rln");
 385         C_asp(pointer_size);
 386 }
 387
 388 CodeWrite(file, arg)
 389         register struct node *file, *arg;
 390 {
 391         int width = 0;
 392         register arith nbpars = pointer_size;
 393         register struct node *expp = arg->nd_left;
 394         struct node *right = arg->nd_right;
 395         struct type *tp = BaseType(expp->nd_type);
 396
 397         if( err_occurred ) return;
 398
 399         CodeDAddress(file);
 400         CodePExpr(expp);
 401
 402         if( file->nd_type == text_type )        {
 403                 if( tp->tp_fund & (T_ARRAY | T_STRINGCONST) )   {
 404                         C_loc(IsString(tp));
 405                         nbpars += pointer_size + int_size;
 406                 }
 407                 else nbpars += tp->tp_size;
 408
 409                 if( right )     {
 410                         width = 1;
 411                         CodePExpr(right->nd_left);
 412                         nbpars += int_size;
 413                         right = right->nd_right;
 414                 }
 415
 416                 switch( tp->tp_fund )   {
 417                         case T_ENUMERATION:     /* boolean */
 418                                 C_cal(width ? "_wsb" : "_wrb");
 419                                 break;
 420
 421                         case T_CHAR:
 422                                 C_cal(width ? "_wsc" : "_wrc");
 423                                 break;
 424
 425                         case T_INTEGER:
 426                                 C_cal(width ? "_wsi" : "_wri");
 427                                 break;
 428
 429                         case T_LONG:
 430                                 C_cal(width ? "_wsl" : "_wrl");
 431                                 break;
 432
 433                         case T_REAL:
 434                                 if( right )     {
 435                                         CodePExpr(right->nd_left);
 436                                         nbpars += int_size;
 437                                         C_cal("_wrf");
 438                                 }
 439                                 else C_cal(width ? "_wsr" : "_wrr");
 440                                 break;
 441
 442                         case T_ARRAY:
 443                         case T_STRINGCONST:
 444                                 C_cal(width ? "_wss" : "_wrs");
 445                                 break;
 446
 447                         case T_STRING:
 448                                 C_cal(width ? "_wsz" : "_wrz");
 449                                 break;
 450
 451                         default:
 452                                 crash("(CodeWrite)");
 453                                 /*NOTREACHED*/
 454                 }
 455                 C_asp(nbpars);
 456         }
 457         else    {
 458                 if( file->nd_type->next == real_type && tp == int_type )
 459                         Int2Real(int_size);
 460                 else if( file->nd_type->next == real_type && tp == long_type )
 461                         Int2Real(long_size);
 462
 463                 CodeDAddress(file);
 464                 C_cal("_wdw");
 465                 C_asp(pointer_size);
 466                 C_lfr(pointer_size);
 467                 C_sti(file->nd_type->next->tp_psize);
 468
 469                 C_cal("_put");
 470                 C_asp(pointer_size);
 471         }
 472 }
 473
 474 CodeWriteln(file)
 475         register struct node *file;
 476 {
 477         if( err_occurred ) return;
 478
 479         CodeDAddress(file);
 480         C_cal("_wln");
 481         C_asp(pointer_size);
 482 }