lang/m2/comp/desig.c

   1 /*
   2  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3  * See the copyright notice in the ACK home directory, in the file "Copyright".
   4  *
   5  * Author: Ceriel J.H. Jacobs
   6  */
   7
   8 /* D E S I G N A T O R   E V A L U A T I O N */
   9
  10 /* $Id: desig.c,v 1.43 1994/06/24 12:40:36 ceriel Exp $ */
  11
  12 /*      Code generation for designators.
  13         This file contains some routines that generate code common to address
  14         as well as value computations, and leave a description in a "desig"
  15         structure.  It also contains routines to load an address, load a value
  16         or perform a store.
  17 */
  18
  19 #include        "debug.h"
  20
  21 #include        <em_arith.h>
  22 #include        <em_label.h>
  23 #include        <em_code.h>
  24 #include        <assert.h>
  25 #include        <alloc.h>
  26
  27 #include        "type.h"
  28 #include        "LLlex.h"
  29 #include        "def.h"
  30 #include        "scope.h"
  31 #include        "desig.h"
  32 #include        "node.h"
  33 #include        "warning.h"
  34 #include        "walk.h"
  35 #include        "squeeze.h"
  36
  37 extern int      proclevel;
  38 extern arith    NewPtr();
  39 extern char     options[];
  40
  41 int
  42 WordOrDouble(ds, size)
  43         t_desig *ds;
  44         arith size;
  45 {
  46         /*      Check if designator is suitable for word or double-word
  47                 operation
  48         */
  49         if ((int) (ds->dsg_offset) % word_align == 0) {
  50                 if (size == word_size) return 1;
  51                 if (size == dword_size) return 2;
  52         }
  53         return 0;
  54 }
  55
  56 LOL(offset, size)
  57         arith offset, size;
  58 {
  59         if (size == word_size) {
  60                 C_lol(offset);
  61         }
  62         else if (size == dword_size) {
  63                 C_ldl(offset);
  64         }
  65         else {
  66                 C_lal(offset);
  67                 C_loi(size);
  68         }
  69 }
  70
  71 STL(offset, size)
  72         arith offset, size;
  73 {
  74         if (size == word_size) {
  75                 C_stl(offset);
  76         }
  77         else if (size == dword_size) {
  78                 C_sdl(offset);
  79         }
  80         else {
  81                 C_lal(offset);
  82                 C_sti(size);
  83         }
  84 }
  85
  86 int
  87 DoLoad(ds, size)
  88         register t_desig *ds;
  89         arith size;
  90 {
  91         /*      Try to load designator with word or double-word operation.
  92                 Return 0 if not done
  93         */
  94         switch (WordOrDouble(ds, size)) {
  95         default:
  96                 return 0;
  97         case 1:
  98                 if (ds->dsg_name) {
  99                         C_loe_dnam(ds->dsg_name, ds->dsg_offset);
 100                 }
 101                 else    C_lol(ds->dsg_offset);
 102                 break;
 103         case 2:
 104                 if (ds->dsg_name) {
 105                         C_lde_dnam(ds->dsg_name, ds->dsg_offset);
 106                 }
 107                 else    C_ldl(ds->dsg_offset);
 108                 break;
 109         }
 110         return 1;
 111 }
 112
 113 int
 114 DoStore(ds, size)
 115         register t_desig *ds;
 116         arith size;
 117 {
 118         /*      Try to store designator with word or double-word operation.
 119                 Return 0 if not done
 120         */
 121         switch (WordOrDouble(ds, size)) {
 122         default:
 123                 return 0;
 124         case 1:
 125                 if (ds->dsg_name) {
 126                         C_ste_dnam(ds->dsg_name, ds->dsg_offset);
 127                 }
 128                 else    C_stl(ds->dsg_offset);
 129                 break;
 130         case 2:
 131                 if (ds->dsg_name) {
 132                         C_sde_dnam(ds->dsg_name, ds->dsg_offset);
 133                 }
 134                 else    C_sdl(ds->dsg_offset);
 135                 break;
 136         }
 137         return 1;
 138 }
 139
 140         /*      Return 1 if the type indicated by tp has a size that is a
 141                 multiple of the word_size and is also word_aligned
 142         */
 143 #define word_multiple(tp) \
 144         ( (int)(tp->tp_size) % (int)word_size == 0 && \
 145           tp->tp_align >= word_align)
 146
 147         /*      Return 1 if the type indicated by tp has a size that is a proper
 148                 dividor of the word_size, and has alignment >= size or
 149                 alignment >= word_align
 150         */
 151 #define word_dividor(tp) \
 152         (       tp->tp_size < word_size &&  \
 153                 (int)word_size % (int)(tp->tp_size) == 0 && \
 154                 (tp->tp_align >= word_align || \
 155                  tp->tp_align >= (int)(tp->tp_size)))
 156
 157 #define USE_LOI_STI     0
 158 #define USE_LOS_STS     1
 159 #define USE_LOAD_STORE  2
 160 #define USE_BLM         3       /* like USE_LOI_STI, but more restricted:
 161                                    multiple of word_size only
 162                                 */
 163
 164 STATIC int
 165 suitable_move(tp)
 166         register t_type *tp;
 167 {
 168         /*      Find out how to load or store the value indicated by "ds".
 169                 There are four ways:
 170                 - suitable for BLM/LOI/STI
 171                 - suitable for LOI/STI
 172                 - suitable for LOS/STS/BLS
 173                 - suitable for calls to load/store/blockmove
 174         */
 175
 176         if (! word_multiple(tp)) {
 177                 if (word_dividor(tp)) return USE_LOI_STI;
 178                 return USE_LOAD_STORE;
 179         }
 180         if (! fit(tp->tp_size, (int) word_size)) return USE_LOS_STS;
 181         return USE_BLM;
 182 }
 183
 184 CodeValue(ds, tp)
 185         register t_desig *ds;
 186         register t_type *tp;
 187 {
 188         /*      Generate code to load the value of the designator described
 189                 in "ds".
 190         */
 191         arith sz;
 192
 193         switch(ds->dsg_kind) {
 194         case DSG_LOADED:
 195                 break;
 196
 197         case DSG_FIXED:
 198                 if (DoLoad(ds, tp->tp_size)) break;
 199                 /* Fall through */
 200         case DSG_PLOADED:
 201         case DSG_PFIXED:
 202                 switch (suitable_move(tp)) {
 203                 case USE_BLM:
 204                 case USE_LOI_STI:
 205 #ifndef SQUEEZE
 206                         CodeAddress(ds);
 207                         C_loi(tp->tp_size);
 208                         break;
 209 #endif
 210                 case USE_LOS_STS:
 211                         CodeAddress(ds);
 212                         CodeConst(tp->tp_size, (int)pointer_size);
 213                         C_los(pointer_size);
 214                         break;
 215                 case USE_LOAD_STORE:
 216                         sz = WA(tp->tp_size);
 217                         if (ds->dsg_kind != DSG_PFIXED) {
 218                                 arith tmp = NewPtr();
 219
 220                                 CodeAddress(ds);
 221                                 STL(tmp, pointer_size);
 222                                 CodeConst(-sz, (int) pointer_size);
 223                                 C_ass(pointer_size);
 224                                 LOL(tmp, pointer_size);
 225                                 FreePtr(tmp);
 226                         }
 227                         else  {
 228                                 CodeConst(-sz, (int) pointer_size);
 229                                 C_ass(pointer_size);
 230                                 CodeAddress(ds);
 231                         }
 232                         CodeConst(tp->tp_size, (int) pointer_size);
 233                         CAL("load", (int)pointer_size + (int)pointer_size);
 234                         break;
 235                 }
 236                 break;
 237
 238         case DSG_INDEXED:
 239                 C_lar(word_size);
 240                 break;
 241
 242         default:
 243                 crash("(CodeValue)");
 244         }
 245
 246         ds->dsg_kind = DSG_LOADED;
 247 }
 248
 249 ChkForFOR(nd)
 250         register t_node *nd;
 251 {
 252         /*      Check for an assignment to a FOR-loop control variable
 253         */
 254         if (nd->nd_class == Def) {
 255                 register t_def *df = nd->nd_def;
 256
 257                 if (df->df_flags & D_FORLOOP) {
 258                         node_warning(nd,
 259                                      W_ORDINARY,
 260                                      "assignment to FOR-loop control variable");
 261                         df->df_flags &= ~D_FORLOOP;
 262                                         /* only procude warning once */
 263                 }
 264         }
 265 }
 266
 267 CodeStore(ds, tp)
 268         register t_desig *ds;
 269         register t_type *tp;
 270 {
 271         /*      Generate code to store the value on the stack in the designator
 272                 described in "ds"
 273         */
 274
 275         switch(ds->dsg_kind) {
 276         case DSG_FIXED:
 277                 if (DoStore(ds, tp->tp_size)) break;
 278                 /* Fall through */
 279         case DSG_PLOADED:
 280         case DSG_PFIXED:
 281                 CodeAddress(ds);
 282                 switch (suitable_move(tp)) {
 283                 case USE_BLM:
 284                 case USE_LOI_STI:
 285 #ifndef SQUEEZE
 286                         C_sti(tp->tp_size);
 287                         break;
 288 #endif
 289                 case USE_LOS_STS:
 290                         CodeConst(tp->tp_size, (int) pointer_size);
 291                         C_sts(pointer_size);
 292                         break;
 293                 case USE_LOAD_STORE:
 294                         CodeConst(tp->tp_size, (int) pointer_size);
 295                         C_cal("store");
 296                         CodeConst(pointer_size + pointer_size + WA(tp->tp_size),
 297                                 (int) pointer_size);
 298                         C_ass(pointer_size);
 299                         break;
 300                 }
 301                 break;
 302
 303         case DSG_INDEXED:
 304                 C_sar(word_size);
 305                 break;
 306
 307         default:
 308                 crash("(CodeStore)");
 309         }
 310
 311         ds->dsg_kind = DSG_INIT;
 312 }
 313
 314 CodeCopy(lhs, rhs, sz, psize)
 315         register t_desig *lhs, *rhs;
 316         arith sz, *psize;
 317 {
 318         /*      Do part of a copy, which is assumed to be "reasonable",
 319                 so that it can be done with LOI/STI or BLM.
 320         */
 321         t_desig l, r;
 322
 323         l = *lhs; r = *rhs;
 324         *psize -= sz;
 325         lhs->dsg_offset += sz;
 326         rhs->dsg_offset += sz;
 327         CodeAddress(&r);
 328         if (sz <= dword_size) {
 329                 C_loi(sz);
 330                 CodeAddress(&l);
 331                 C_sti(sz);
 332         }
 333         else {
 334                 CodeAddress(&l);
 335                 C_blm(sz);
 336         }
 337 }
 338
 339 t_desig null_desig;
 340
 341 CodeMove(rhs, left, rtp)
 342         register t_desig *rhs;
 343         register t_node *left;
 344         t_type *rtp;
 345 {
 346         /*      Generate code for an assignment. Testing of type
 347                 compatibility and the like is already done.
 348                 Go through some (considerable) trouble to see if a BLM can be
 349                 generated.
 350         */
 351         t_desig lhs;
 352         register t_type *tp = left->nd_type;
 353         int loadedflag = 0;
 354
 355         lhs = null_desig;
 356         ChkForFOR(left);
 357         switch(rhs->dsg_kind) {
 358         case DSG_LOADED:
 359                 CodeDesig(left, &lhs);
 360                 if (rtp->tp_fund == T_STRING) {
 361                         /* size of a string literal fits in an
 362                            int of size word_size
 363                         */
 364                         CodeAddress(&lhs);
 365                         C_loc(rtp->tp_size);
 366                         C_loc(tp->tp_size);
 367                         CAL("StringAssign", (int)pointer_size + (int)pointer_size + (int)dword_size);
 368                         break;
 369                 }
 370                 CodeStore(&lhs, tp);
 371                 break;
 372         case DSG_FIXED:
 373                 CodeDesig(left, &lhs);
 374                 if (lhs.dsg_kind == DSG_FIXED &&
 375                     fit(tp->tp_size, (int) word_size) &&
 376                     (int) (lhs.dsg_offset) % word_align ==
 377                     (int) (rhs->dsg_offset) % word_align) {
 378                         register int sz = 1;
 379                         arith size = tp->tp_size;
 380
 381                         while (size && sz < word_align) {
 382                                 /*      First copy up to word-aligned
 383                                         boundaries
 384                                 */
 385                                 if (!((int)(lhs.dsg_offset)%(sz+sz))) {
 386                                         sz += sz;
 387                                 }
 388                                 else    CodeCopy(&lhs, rhs, (arith) sz, &size);
 389                         }
 390                         /*      Now copy the bulk
 391                         */
 392                         sz = (int) size % (int) word_size;
 393                         size -= sz;
 394                         CodeCopy(&lhs, rhs, size, &size);
 395                         size = sz;
 396                         sz = word_size;
 397                         while (size) {
 398                                 /*      And then copy remaining parts
 399                                 */
 400                                 sz >>= 1;
 401                                 if (size >= sz) {
 402                                         CodeCopy(&lhs, rhs, (arith) sz, &size);
 403                                 }
 404                         }
 405                         break;
 406                 }
 407                 CodeAddress(&lhs);
 408                 loadedflag = 1;
 409                 /* Fall through */
 410         case DSG_PLOADED:
 411         case DSG_PFIXED:
 412                 assert(! loadedflag || rhs->dsg_kind == DSG_FIXED);
 413                 CodeAddress(rhs);
 414                 if (loadedflag) {
 415                         C_exg(pointer_size);
 416                 }
 417                 else {
 418                         CodeDesig(left, &lhs);
 419                         CodeAddress(&lhs);
 420                 }
 421                 switch (suitable_move(tp)) {
 422                 case USE_BLM:
 423 #ifndef SQUEEZE
 424                         C_blm(tp->tp_size);
 425                         break;
 426 #endif
 427                 case USE_LOS_STS:
 428                         CodeConst(tp->tp_size, (int) pointer_size);
 429                         C_bls(pointer_size);
 430                         break;
 431                 case USE_LOAD_STORE:
 432                 case USE_LOI_STI:
 433                         CodeConst(tp->tp_size, (int) pointer_size);
 434                         CAL("blockmove", 3 * (int)pointer_size);
 435                         break;
 436                 }
 437                 break;
 438         default:
 439                 crash("CodeMove");
 440         }
 441 }
 442
 443 CodeAddress(ds)
 444         register t_desig *ds;
 445 {
 446         /*      Generate code to load the address of the designator described
 447                 in "ds"
 448         */
 449
 450         switch(ds->dsg_kind) {
 451         case DSG_PLOADED:
 452                 if (ds->dsg_offset) {
 453                         C_adp(ds->dsg_offset);
 454                 }
 455                 break;
 456
 457         case DSG_FIXED:
 458                 if (ds->dsg_name) {
 459                         C_lae_dnam(ds->dsg_name, ds->dsg_offset);
 460                         break;
 461                 }
 462                 C_lal(ds->dsg_offset);
 463                 if (ds->dsg_def) ds->dsg_def->df_flags |= D_NOREG;
 464                 break;
 465
 466         case DSG_PFIXED:
 467                 if (! DoLoad(ds, pointer_size)) {
 468                         assert(0);
 469                 }
 470                 break;
 471
 472         case DSG_INDEXED:
 473                 C_aar(word_size);
 474                 break;
 475
 476         default:
 477                 crash("(CodeAddress)");
 478         }
 479
 480         ds->dsg_offset = 0;
 481         ds->dsg_kind = DSG_PLOADED;
 482 }
 483
 484 CodeFieldDesig(df, ds)
 485         register t_def *df;
 486         register t_desig *ds;
 487 {
 488         /* Generate code for a field designator. Only the code common for
 489            address as well as value computation is generated, and the
 490            resulting information on where to find the designator is placed
 491            in "ds". "df" indicates the definition of the field.
 492         */
 493
 494         if (ds->dsg_kind == DSG_INIT) {
 495                 /* In a WITH statement. We must find the designator in the
 496                    WITH statement, and act as if the field is a selection
 497                    of this designator.
 498                    So, first find the right WITH statement, which is the
 499                    first one of the proper record type, which is
 500                    recognized by its scope indication.
 501                 */
 502                 register struct withdesig *wds = WithDesigs;
 503
 504                 assert(wds != 0);
 505
 506                 while (wds->w_scope != df->df_scope) {
 507                         wds = wds->w_next;
 508                         assert(wds != 0);
 509                 }
 510
 511                 /* Found it. Now, act like it was a selection.
 512                 */
 513                 *ds = wds->w_desig;
 514                 wds->w_flags |= df->df_flags;
 515                 assert(ds->dsg_kind == DSG_PFIXED);
 516         }
 517
 518         switch(ds->dsg_kind) {
 519         case DSG_PLOADED:
 520         case DSG_FIXED:
 521                 ds->dsg_offset += df->fld_off;
 522                 break;
 523
 524         case DSG_PFIXED:
 525         case DSG_INDEXED:
 526                 CodeAddress(ds);
 527                 ds->dsg_kind = DSG_PLOADED;
 528                 ds->dsg_offset = df->fld_off;
 529                 break;
 530
 531         default:
 532                 crash("(CodeFieldDesig)");
 533         }
 534 }
 535
 536 CodeVarDesig(df, ds)
 537         register t_def *df;
 538         register t_desig *ds;
 539 {
 540         /*      Generate code for a variable represented by a "def" structure.
 541                 Of course, there are numerous cases: the variable is local,
 542                 it is a value parameter, it is a var parameter, it is one of
 543                 those of an enclosing procedure, or it is global.
 544         */
 545         register t_scope *sc = df->df_scope;
 546         int difflevel;
 547
 548         /* Selections from a module are handled earlier, when identifying
 549            the variable, so ...
 550         */
 551         assert(ds->dsg_kind == DSG_INIT);
 552
 553         if (df->df_flags & D_ADDRGIVEN) {
 554                 /* the programmer specified an address in the declaration of
 555                    the variable. Generate code to push the address.
 556                 */
 557                 CodeConst(df->var_off, (int) pointer_size);
 558                 ds->dsg_kind = DSG_PLOADED;
 559                 ds->dsg_offset = 0;
 560                 return;
 561         }
 562
 563         if (df->var_name) {
 564                 /* this variable has been given a name, so it is global.
 565                    It is directly accessible.
 566                 */
 567                 ds->dsg_name = df->var_name;
 568                 ds->dsg_offset = 0;
 569                 ds->dsg_kind = DSG_FIXED;
 570                 return;
 571         }
 572
 573         if ((difflevel = proclevel - sc->sc_level) != 0) {
 574                 /* the variable is local to a statically enclosing procedure.
 575                 */
 576                 assert(difflevel > 0);
 577
 578                 df->df_flags |= D_NOREG;
 579                 if (df->df_flags & (D_VARPAR|D_VALPAR)) {
 580                         /* value or var parameter
 581                         */
 582                         C_lxa((arith) difflevel);
 583                         if ((df->df_flags & D_VARPAR) ||
 584                             IsConformantArray(df->df_type)) {
 585                                 /* var parameter or conformant array.
 586                                    The address is passed.
 587                                 */
 588                                 C_adp(df->var_off);
 589                                 C_loi(pointer_size);
 590                                 ds->dsg_offset = 0;
 591                                 ds->dsg_kind = DSG_PLOADED;
 592                                 return;
 593                         }
 594                 }
 595                 else    C_lxl((arith) difflevel);
 596                 ds->dsg_kind = DSG_PLOADED;
 597                 ds->dsg_offset = df->var_off;
 598                 return;
 599         }
 600
 601         /* Now, finally, we have a local variable or a local parameter
 602         */
 603         if ((df->df_flags & D_VARPAR) ||
 604             IsConformantArray(df->df_type)) {
 605                 /* a var parameter; address directly accessible.
 606                 */
 607                 ds->dsg_kind = DSG_PFIXED;
 608         }
 609         else    ds->dsg_kind = DSG_FIXED;
 610         ds->dsg_offset = df->var_off;
 611         ds->dsg_def = df;
 612 }
 613
 614 CodeDesig(nd, ds)
 615         register t_node *nd;
 616         register t_desig *ds;
 617 {
 618         /*      Generate code for a designator. Use divide and conquer
 619                 principle
 620         */
 621         register t_def *df;
 622
 623         switch(nd->nd_class) {  /* Divide */
 624         case Def:
 625                 df = nd->nd_def;
 626                 if (nd->nd_NEXT) CodeDesig(nd->nd_NEXT, ds);
 627
 628                 switch(df->df_kind) {
 629                 case D_FIELD:
 630                         CodeFieldDesig(df, ds);
 631                         break;
 632
 633                 case D_VARIABLE:
 634                         CodeVarDesig(df, ds);
 635                         break;
 636
 637                 default:
 638                         crash("(CodeDesig) Def");
 639                 }
 640                 break;
 641
 642         case Arrsel:
 643                 assert(nd->nd_symb == '[' || nd->nd_symb == ',');
 644
 645                 CodeDesig(nd->nd_LEFT, ds);
 646                 CodeAddress(ds);
 647                 CodePExpr(nd->nd_RIGHT);
 648                 nd = nd->nd_LEFT;
 649
 650                 /* Now load address of descriptor
 651                 */
 652                 if (IsConformantArray(nd->nd_type)) {
 653                         arith off;
 654                         assert(nd->nd_class == Def);
 655
 656                         df = nd->nd_def;
 657                         off = df->var_off + pointer_size;
 658                         if (proclevel > df->df_scope->sc_level) {
 659                             C_lxa((arith) (proclevel - df->df_scope->sc_level));
 660                             C_adp(off);
 661                         }
 662                         else    C_lal(off);
 663                 }
 664                 else    {
 665                         C_loc(nd->nd_type->arr_low);
 666                         C_sbu(int_size);
 667                         c_lae_dlb(nd->nd_type->arr_descr);
 668                 }
 669                 if (options['A']) {
 670                         C_cal("rcka");
 671                 }
 672                 ds->dsg_kind = DSG_INDEXED;
 673                 break;
 674
 675         case Arrow:
 676                 assert(nd->nd_symb == '^');
 677
 678                 nd = nd->nd_RIGHT;
 679                 CodeDesig(nd, ds);
 680                 switch(ds->dsg_kind) {
 681                 case DSG_LOADED:
 682                         ds->dsg_kind = DSG_PLOADED;
 683                         break;
 684
 685                 case DSG_INDEXED:
 686                 case DSG_PLOADED:
 687                 case DSG_PFIXED:
 688                         CodeValue(ds, nd->nd_type);
 689                         ds->dsg_kind = DSG_PLOADED;
 690                         ds->dsg_offset = 0;
 691                         break;
 692
 693                 case DSG_FIXED:
 694                         ds->dsg_kind = DSG_PFIXED;
 695                         break;
 696
 697                 default:
 698                         crash("(CodeDesig) Uoper");
 699                 }
 700                 break;
 701
 702         default:
 703                 crash("(CodeDesig) class");
 704         }
 705 }