lang/pc/comp/desig.c

   1 /* D E S I G N A T O R   E V A L U A T I O N */
   2
   3 /*      Code generation for designators.
   4         This file contains some routines that generate code common to address
   5         as well as value computations, and leave a description in a "desig"
   6         structure. It also contains routines to load an address, load a value
   7         or perform a store.
   8 */
   9
  10 #include        "debug.h"
  11
  12 #include        <assert.h>
  13 #include        <em.h>
  14
  15 #include        "LLlex.h"
  16 #include        "def.h"
  17 #include        "desig.h"
  18 #include        "main.h"
  19 /* next line DEBUG */
  20 #include        "idf.h"
  21 #include        "node.h"
  22 #include        "scope.h"
  23 #include        "type.h"
  24
  25 struct desig    InitDesig = {DSG_INIT, 0, 0, NULLDEF, 0};
  26 struct withdesig *WithDesigs;
  27
  28
  29 STATIC int
  30 properly(ds, size, al)
  31         register struct desig *ds;
  32         arith size;
  33 {
  34         /*      Check if it is allowed to load or store the value indicated
  35                 by "ds" with LOI/STI.
  36                 - if the size is not either a multiple or a dividor of the
  37                   wordsize, then not.
  38                 - if the alignment is at least "word" then OK.
  39                 - if size is dividor of word_size and alignment >= size then OK.
  40                 - otherwise check alignment of address. This can only be done
  41                   with DSG_FIXED.
  42         */
  43
  44         arith szmodword = size % word_size;     /* 0 if multiple of wordsize */
  45         arith wordmodsz = word_size % size;     /* 0 if dividor of wordsize */
  46
  47         if( szmodword && wordmodsz ) return 0;
  48         if( al >= word_align ) return 1;
  49         if( szmodword && al >= szmodword ) return 1;
  50
  51         return ds->dsg_kind == DSG_FIXED &&
  52                ((! szmodword && ds->dsg_offset % word_align == 0) ||
  53                 (! wordmodsz && ds->dsg_offset % size == 0));
  54 }
  55
  56 CodeCopy(lhs, rhs, sz, psize)
  57         register struct desig *lhs, *rhs;
  58         arith sz, *psize;
  59 {
  60         struct desig l, r;
  61
  62         l = *lhs;
  63         r = *rhs;
  64         *psize -= sz;
  65         lhs->dsg_offset += sz;
  66         rhs->dsg_offset += sz;
  67         CodeAddress(&r);
  68         C_loi(sz);
  69         CodeAddress(&l);
  70         C_sti(sz);
  71 }
  72
  73 CodeMove(rhs, left, rtp)
  74         register struct desig *rhs;
  75         register struct node *left;
  76         struct type *rtp;
  77 {
  78         struct desig dsl;
  79         register struct desig *lhs = &dsl;
  80         register struct type *ltp = left->nd_type;
  81
  82         dsl = InitDesig;
  83         /*      Generate code for an assignment. Testing of type
  84                 compatibility and the like is already done.
  85                 Go through some (considerable) trouble to see if
  86                 a BLM can be generated.
  87         */
  88
  89         switch( rhs->dsg_kind ) {
  90         case DSG_LOADED:
  91                 CodeDesig(left, lhs);
  92                 if( rtp->tp_fund == T_STRINGCONST )     {
  93                         CodeAddress(lhs);
  94                         C_blm(lhs->dsg_packed ? ltp->tp_psize : ltp->tp_size);
  95                         return;
  96                 }
  97                 CodeStore(lhs, ltp);
  98                 return;
  99
 100         case DSG_PLOADED:
 101         case DSG_PFIXED:
 102                 CodeAddress(rhs);
 103                 CodeValue(rhs, rtp);
 104                 CodeDStore(left);
 105                 return;
 106
 107         case DSG_FIXED: {
 108                 arith tpsize;
 109
 110                 CodeDesig(left, lhs);
 111                 tpsize = lhs->dsg_packed ? ltp->tp_psize : ltp->tp_size;
 112                 if( lhs->dsg_kind == DSG_FIXED &&
 113                     lhs->dsg_offset % word_size == rhs->dsg_offset % word_size
 114                   )     {
 115                         arith size = tpsize;
 116
 117                         if( size > 6 * word_size )      {
 118                                 /*      Do a block move
 119                                 */
 120                                 struct desig l, r;
 121
 122                                 l = *lhs;
 123                                 r = *rhs;
 124                                 CodeAddress(&r);
 125                                 CodeAddress(&l);
 126                                 C_blm(size);
 127                         }
 128                         else    {
 129                                 register arith sz;
 130
 131                                 for( sz = 2 * word_size; sz; sz -= word_size) {
 132                                         while( size >= sz )
 133                                         /*      Then copy dwords, words.
 134                                                 Depend on peephole optimizer
 135                                         */
 136                                         CodeCopy(lhs, rhs, sz, &size);
 137                                 }
 138                         }
 139                         return;
 140                 }
 141                 if( lhs->dsg_kind == DSG_PLOADED ||
 142                     lhs->dsg_kind == DSG_INDEXED )      {
 143                         CodeAddress(lhs);
 144                 }
 145         }
 146         default:
 147                 crash("(CodeMove)");
 148                 /*NOTREACHED*/
 149         }
 150 }
 151
 152 CodeValue(ds, tp)
 153         register struct desig *ds;
 154         register struct type *tp;
 155 {
 156         /*      Generate code to load the value of the designator described
 157                 in "ds"
 158         */
 159         arith size = ds->dsg_packed ? tp->tp_psize : tp->tp_size;
 160         int algn = ds->dsg_packed ? tp->tp_palign : tp->tp_align;
 161
 162         switch( ds->dsg_kind )  {
 163         case DSG_LOADED:
 164                 return;
 165
 166         case DSG_FIXED:
 167                 if( ds->dsg_offset % word_size == 0 ) {
 168                         if ( size == word_size ) {
 169                                 if( ds->dsg_name )
 170                                         C_loe_dnam(ds->dsg_name, ds->dsg_offset);
 171                                 else
 172                                         C_lol(ds->dsg_offset);
 173                                 break;
 174                         } else if ( size == word_size * 2) {
 175                                 if( ds->dsg_name )
 176                                         C_lde_dnam(ds->dsg_name, ds->dsg_offset);
 177                                 else
 178                                         C_ldl(ds->dsg_offset);
 179                                 break;
 180                         }
 181                 }
 182                 /* Fall through */
 183         case DSG_PLOADED:
 184         case DSG_PFIXED:
 185                 if( properly(ds, size, algn) )  {
 186                         CodeAddress(ds);
 187                         C_loi(size);
 188                         break;
 189                 }
 190                 crash("(CodeValue)");
 191                 break;
 192
 193         case DSG_INDEXED:
 194                 C_lar(word_size);
 195                 break;
 196
 197         default:
 198                 crash("(CodeValue)");
 199                 /*NOTREACHED*/
 200         }
 201
 202         if (size < word_size && tp->tp_fund == T_SUBRANGE &&
 203             BaseType(tp)->tp_fund == T_INTEGER && tp->sub_lb < 0) {
 204                 C_loc(size);
 205                 C_loc(word_size);
 206                 C_cii();
 207         }
 208         ds->dsg_kind = DSG_LOADED;
 209 }
 210
 211 CodeStore(ds, tp)
 212         register struct desig *ds;
 213         register struct type *tp;
 214 {
 215         /*      Generate code to store the value on the stack in the designator
 216                 described in "ds"
 217         */
 218         struct desig save;
 219         arith size = ds->dsg_packed ? tp->tp_psize : tp->tp_size;
 220         int algn = ds->dsg_packed ? tp->tp_palign : tp->tp_align;
 221
 222         save = *ds;
 223
 224         switch( ds->dsg_kind )  {
 225         case DSG_FIXED:
 226                 if( ds->dsg_offset % word_size == 0 ) {
 227                         if ( size == word_size ) {
 228                                 if( ds->dsg_name )
 229                                         C_ste_dnam(ds->dsg_name, ds->dsg_offset);
 230                                 else
 231                                         C_stl(ds->dsg_offset);
 232                                 break;
 233                         } else if ( size == word_size * 2) {
 234                                 if( ds->dsg_name )
 235                                         C_sde_dnam(ds->dsg_name, ds->dsg_offset);
 236                                 else
 237                                         C_sdl(ds->dsg_offset);
 238                                 break;
 239                         }
 240                 }
 241                 /* Fall through */
 242         case DSG_PLOADED:
 243         case DSG_PFIXED:
 244                 CodeAddress(&save);
 245                 if( properly(ds, size, algn) )  {
 246                         C_sti(size);
 247                         break;
 248                 }
 249                 crash("(CodeStore)");
 250                 break;
 251
 252         case DSG_INDEXED:
 253                 C_sar(word_size);
 254                 break;
 255
 256         default:
 257                 crash("(CodeStore)");
 258                 /*NOTREACHED*/
 259         }
 260
 261         ds->dsg_kind = DSG_INIT;
 262 }
 263
 264 CodeAddress(ds)
 265         register struct desig *ds;
 266 {
 267         /*      Generate code to load the address of the designator described
 268                 in "ds"
 269         */
 270
 271         switch( ds->dsg_kind )  {
 272         case DSG_PLOADED:
 273                 if( ds->dsg_offset )
 274                         C_adp(ds->dsg_offset);
 275                 break;
 276
 277         case DSG_FIXED:
 278                 if( ds->dsg_name )      {
 279                         C_lae_dnam(ds->dsg_name, ds->dsg_offset);
 280                         break;
 281                 }
 282                 C_lal(ds->dsg_offset);
 283                 if( ds->dsg_def )
 284                         ds->dsg_def->df_flags |= D_NOREG;
 285                 break;
 286
 287         case DSG_PFIXED:
 288                 if ( word_size == pointer_size ) {
 289                         if( ds->dsg_name )
 290                                 C_loe_dnam(ds->dsg_name, ds->dsg_offset);
 291                         else
 292                                 C_lol(ds->dsg_offset);
 293                         break;
 294                 } else {
 295                         if( ds->dsg_name )
 296                                 C_lde_dnam(ds->dsg_name, ds->dsg_offset);
 297                         else
 298                                 C_ldl(ds->dsg_offset);
 299                         break;
 300                 }
 301
 302         case DSG_INDEXED:
 303                 C_aar(word_size);
 304                 break;
 305
 306         default:
 307                 crash("(CodeAddress)");
 308                 /*NOTREACHED*/
 309         }
 310
 311         ds->dsg_offset = 0;
 312         ds->dsg_kind = DSG_PLOADED;
 313 }
 314
 315 CodeFieldDesig(df, ds)
 316         register struct def *df;
 317         register struct desig *ds;
 318 {
 319         /* Generate code for a field designator. Only the code common for
 320            address as well as value computation is generated, and the
 321            resulting information on where to find the designator is placed
 322            in "ds". "df" indicates the definition of the field.
 323         */
 324
 325         if( ds->dsg_kind == DSG_INIT )  {
 326                 /* In a WITH statement. We must find the designator in the
 327                    WITH statement, and act as if the field is a selection
 328                    of this designator.
 329                    So, first find the right WITH statement, which is the
 330                    first one of the proper record type, which is
 331                    recognized by its scope indication.
 332                 */
 333                 register struct withdesig *wds = WithDesigs;
 334
 335                 assert(wds != 0);
 336
 337                 while( wds->w_scope != df->df_scope )   {
 338                         wds = wds->w_next;
 339                         assert(wds != 0);
 340                 }
 341
 342                 /* Found it. Now, act like it was a selection.
 343                 */
 344                 *ds = wds->w_desig;
 345                 assert(ds->dsg_kind == DSG_PFIXED);
 346         }
 347
 348         switch( ds->dsg_kind )  {
 349                 case DSG_PLOADED:
 350                 case DSG_FIXED:
 351                         ds->dsg_offset += df->fld_off;
 352                         break;
 353
 354                 case DSG_PFIXED:
 355                 case DSG_INDEXED:
 356                         CodeAddress(ds);
 357                         ds->dsg_kind = DSG_PLOADED;
 358                         ds->dsg_offset = df->fld_off;
 359                         break;
 360
 361                 default:
 362                         crash("(CodeFieldDesig)");
 363         }
 364
 365         ds->dsg_packed = df->fld_flags & F_PACKED;
 366 }
 367
 368 CodeVarDesig(df, ds)
 369         register struct def *df;
 370         register struct desig *ds;
 371 {
 372         /*      Generate code for a variable represented by a "def" structure.
 373                 Of course, there are numerous cases: the variable is local,
 374                 it is a value parameter, it is a var parameter, it is one of
 375                 those of an enclosing procedure, or it is global.
 376         */
 377         register struct scope *sc = df->df_scope;
 378
 379         assert(ds->dsg_kind == DSG_INIT);
 380
 381         if( df->var_name )      {
 382                 /* this variable has been given a name, so it is global.
 383                    It is directly accessible.
 384                 */
 385                 ds->dsg_name = df->var_name;
 386                 ds->dsg_offset = 0;
 387                 ds->dsg_kind = DSG_FIXED;
 388                 return;
 389         }
 390
 391         if( sc->sc_level != proclevel ) {
 392                 /* the variable is local to a statically enclosing procedure.
 393                 */
 394                 assert(proclevel > sc->sc_level);
 395
 396                 df->df_flags |= D_NOREG;
 397                 if( df->df_flags & (D_VARPAR|D_VALPAR) )        {
 398                         /* value or var parameter
 399                         */
 400                         C_lxa((arith) (proclevel - sc->sc_level));
 401                         if( (df->df_flags & D_VARPAR) ||
 402                             IsConformantArray(df->df_type) )    {
 403                                 /* var parameter or conformant array.
 404                                    For conformant array's, the address is
 405                                    passed.
 406                                 */
 407                                 C_adp(df->var_off);
 408                                 C_loi(pointer_size);
 409                                 ds->dsg_offset = 0;
 410                                 ds->dsg_kind = DSG_PLOADED;
 411                                 return;
 412                         }
 413                 }
 414                 else
 415                         C_lxl((arith) (proclevel - sc->sc_level));
 416
 417                 ds->dsg_kind = DSG_PLOADED;
 418                 ds->dsg_offset = df->var_off;
 419                 return;
 420         }
 421
 422         /* Now, finally, we have a local variable or a local parameter
 423         */
 424         if( (df->df_flags & D_VARPAR) || IsConformantArray(df->df_type) )
 425                 /* a var parameter; address directly accessible. */
 426                 ds->dsg_kind = DSG_PFIXED;
 427         else
 428                 ds->dsg_kind = DSG_FIXED;
 429
 430         ds->dsg_offset = df->var_off;
 431         ds->dsg_def = df;
 432 }
 433
 434 CodeBoundDesig(df, ds)
 435         register struct def *df;
 436         register struct desig *ds;
 437 {
 438         /* Generate code for the lower- and upperbound of a conformant array */
 439
 440         assert(ds->dsg_kind == DSG_INIT);
 441
 442         if( df->df_scope->sc_level < proclevel )        {
 443                 C_lxa((arith) (proclevel - df->df_scope->sc_level));
 444                 C_lof(df->bnd_type->arr_cfdescr);
 445                 if( df->df_kind == D_UBOUND )   {
 446                         C_lxa((arith) (proclevel - df->df_scope->sc_level));
 447                         C_lof(df->bnd_type->arr_cfdescr+word_size);
 448                         C_adi(word_size);
 449                 }
 450         }
 451         else    {
 452                 C_lol(df->bnd_type->arr_cfdescr);
 453                 if( df->df_kind == D_UBOUND )   {
 454                         C_lol(df->bnd_type->arr_cfdescr+word_size);
 455                         C_adi(word_size);
 456                 }
 457         }
 458
 459         ds->dsg_kind = DSG_LOADED;
 460 }
 461
 462 CodeFuncDesig(df, ds)
 463         register struct def *df;
 464         register struct desig *ds;
 465 {
 466         /* generate code to store the function result */
 467
 468         if( df->df_scope->sc_level + 1 < proclevel )    {
 469                 /* Assignment to function-identifier in the declaration-part of
 470                    the function (i.e. in the statement-part of a nested function
 471                    or procedure).
 472                 */
 473                 if( !options['R'] ) {
 474                         C_loc((arith)1);
 475                         C_lxl((arith) (proclevel - df->df_scope->sc_level - 1));
 476                         C_adp(df->prc_bool);
 477                         C_sti(int_size);
 478                 }
 479
 480                 C_lxl((arith) (proclevel - df->df_scope->sc_level - 1));
 481                 ds->dsg_kind = DSG_PLOADED;
 482         }
 483         else    {
 484                 /* Assignment to function-identifier in the statement-part of
 485                    the function.
 486                 */
 487                 if( !options['R'] ) {
 488                         C_loc((arith)1);
 489                         C_stl(df->prc_bool);
 490                 }
 491
 492                 ds->dsg_kind = DSG_FIXED;
 493         }
 494         assert(df->prc_res < 0);
 495         ds->dsg_offset = df->prc_res;
 496 }
 497
 498 CodeDesig(nd, ds)
 499         register struct node *nd;
 500         register struct desig *ds;
 501 {
 502         /*      Generate code for a designator. Use divide and conquer
 503                 principle
 504         */
 505         register struct def *df;
 506
 507         switch( nd->nd_class )  {       /* Divide */
 508         case Def:
 509                 df = nd->nd_def;
 510
 511                 switch( (int) df->df_kind )     {
 512                 case D_FIELD:
 513                         CodeFieldDesig(df, ds);
 514                         break;
 515
 516                 case D_VARIABLE:
 517                         CodeVarDesig(df, ds);
 518                         break;
 519
 520                 case D_LBOUND:
 521                 case D_UBOUND:
 522                         CodeBoundDesig(df, ds);
 523                         break;
 524
 525                 case D_FUNCTION:
 526                         CodeFuncDesig(df, ds);
 527                         break;
 528
 529                 default:
 530                         crash("(CodeDesig) Def");
 531                 }
 532                 break;
 533
 534         case LinkDef:
 535                 assert(nd->nd_symb == '.');
 536
 537                 CodeDesig(nd->nd_left, ds);
 538                 CodeFieldDesig(nd->nd_def, ds);
 539                 break;
 540
 541         case Arrsel:    {
 542                 struct type *tp;
 543
 544                 assert(nd->nd_symb == '[');
 545
 546                 CodeDesig(nd->nd_left, ds);
 547                 CodeAddress(ds);
 548                 CodePExpr(nd->nd_right);
 549
 550                 /* Now load address of descriptor
 551                 */
 552                 tp = nd->nd_left->nd_type;
 553                 if( IsConformantArray(tp) )     {
 554                         if( tp->arr_sclevel < proclevel )       {
 555                                 C_lxa((arith) (proclevel - tp->arr_sclevel));
 556                                 C_adp(tp->arr_cfdescr);
 557                         }
 558                         else
 559                                 C_lal(tp->arr_cfdescr);
 560                 }
 561                 else
 562                         C_lae_dlb(tp->arr_ardescr, (arith) 0);
 563
 564                 if( options['A'] ) {
 565                         C_cal("_rcka");
 566                 }
 567                 ds->dsg_kind = DSG_INDEXED;
 568                 ds->dsg_packed = IsPacked(tp);
 569                 break;
 570         }
 571
 572         case Arrow:
 573                 assert(nd->nd_symb == '^');
 574
 575                 if( nd->nd_right->nd_type->tp_fund == T_FILE )  {
 576                         CodeDAddress(nd->nd_right);
 577                         C_cal("_wdw");
 578                         C_asp(pointer_size);
 579                         C_lfr(pointer_size);
 580                         ds->dsg_kind = DSG_PLOADED;
 581                         ds->dsg_packed = 1;
 582                         break;
 583                 }
 584
 585                 CodeDesig(nd->nd_right, ds);
 586                 switch(ds->dsg_kind) {
 587                 case DSG_LOADED:
 588                         ds->dsg_kind = DSG_PLOADED;
 589                         break;
 590
 591                 case DSG_INDEXED:
 592                 case DSG_PLOADED:
 593                 case DSG_PFIXED:
 594                         CodeValue(ds, nd->nd_right->nd_type);
 595                         ds->dsg_kind = DSG_PLOADED;
 596                         ds->dsg_offset = 0;
 597                         break;
 598
 599                 case DSG_FIXED:
 600                         ds->dsg_kind = DSG_PFIXED;
 601                         break;
 602
 603                 default:
 604                         crash("(CodeDesig) Uoper");
 605                 }
 606                 break;
 607
 608         default:
 609                 crash("(CodeDesig) class");
 610         }
 611 }