gcc/m2/gm2-gcc/m2statement.cc

   1 /* m2statement.cc provides an interface to GCC statement trees.
   2
   3 Copyright (C) 2012-2024 Free Software Foundation, Inc.
   4 Contributed by Gaius Mulley <gaius@glam.ac.uk>.
   5
   6 This file is part of GNU Modula-2.
   7
   8 GNU Modula-2 is free software; you can redistribute it and/or modify
   9 it under the terms of the GNU General Public License as published by
  10 the Free Software Foundation; either version 3, or (at your option)
  11 any later version.
  12
  13 GNU Modula-2 is distributed in the hope that it will be useful, but
  14 WITHOUT ANY WARRANTY; without even the implied warranty of
  15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16 General Public License for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with GNU Modula-2; see the file COPYING3.  If not see
  20 <http://www.gnu.org/licenses/>.  */
  21
  22 #include "gcc-consolidation.h"
  23
  24 #include "../gm2-lang.h"
  25 #include "../m2-tree.h"
  26
  27 /* Prototypes.  */
  28
  29 #define m2statement_c
  30 #include "m2assert.h"
  31 #include "m2block.h"
  32 #include "m2decl.h"
  33 #include "m2expr.h"
  34 #include "m2statement.h"
  35 #include "m2tree.h"
  36 #include "m2treelib.h"
  37 #include "m2type.h"
  38 #include "m2convert.h"
  39
  40 static GTY (()) tree param_list = NULL_TREE; /* Ready for the next time we
  41                                                 call/define a function.  */
  42 static GTY (()) tree last_function = NULL_TREE;
  43
  44
  45 /* BuildStartFunctionCode - generate function entry code.  */
  46
  47 void
  48 m2statement_BuildStartFunctionCode (location_t location, tree fndecl,
  49                                     bool isexported, bool isinline)
  50 {
  51   tree param_decl;
  52
  53   ASSERT_BOOL (isexported);
  54   ASSERT_BOOL (isinline);
  55   /* Announce we are compiling this function.  */
  56   announce_function (fndecl);
  57
  58   /* Set up to compile the function and enter it.  */
  59
  60   DECL_INITIAL (fndecl) = NULL_TREE;
  61
  62   current_function_decl = fndecl;
  63   m2block_pushFunctionScope (fndecl);
  64   m2statement_SetBeginLocation (location);
  65
  66   ASSERT_BOOL ((cfun != NULL));
  67   /* Initialize the RTL code for the function.  */
  68   allocate_struct_function (fndecl, false);
  69   /* Begin the statement tree for this function.  */
  70   DECL_SAVED_TREE (fndecl) = NULL_TREE;
  71
  72   /* Set the context of these parameters to this function.  */
  73   for (param_decl = DECL_ARGUMENTS (fndecl); param_decl;
  74        param_decl = TREE_CHAIN (param_decl))
  75     DECL_CONTEXT (param_decl) = fndecl;
  76
  77   /* This function exists in static storage.  (This does not mean
  78   `static' in the C sense!) */
  79   TREE_STATIC (fndecl) = 1;
  80   TREE_PUBLIC (fndecl) = isexported;
  81   /* We could do better here by detecting ADR
  82      or type PROC used on this function.  --fixme--  */
  83   TREE_ADDRESSABLE (fndecl) = 1;
  84   DECL_DECLARED_INLINE_P (fndecl) = 0; /* isinline;  */
  85 }
  86
  87 /* BuildEndFunctionCode - generates the function epilogue.  */
  88
  89 void
  90 m2statement_BuildEndFunctionCode (location_t location, tree fndecl, bool nested)
  91 {
  92   tree block = DECL_INITIAL (fndecl);
  93
  94   BLOCK_SUPERCONTEXT (block) = fndecl;
  95
  96   /* Must mark the RESULT_DECL as being in this function.  */
  97   DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
  98
  99   /* And attach it to the function.  */
 100   DECL_INITIAL (fndecl) = block;
 101
 102   m2block_finishFunctionCode (fndecl);
 103   m2statement_SetEndLocation (location);
 104
 105   gm2_genericize (fndecl);
 106   if (nested)
 107     (void)cgraph_node::get_create (fndecl);
 108   else
 109     cgraph_node::finalize_function (fndecl, false);
 110
 111   m2block_popFunctionScope ();
 112
 113   /* We're leaving the context of this function, so zap cfun.  It's
 114      still in DECL_STRUCT_FUNCTION, and we'll restore it in
 115      tree_rest_of_compilation.  */
 116   set_cfun (NULL);
 117   current_function_decl = NULL;
 118 }
 119
 120 /* BuildPushFunctionContext - pushes the current function context.
 121    Maps onto push_function_context in ../function.cc.  */
 122
 123 void
 124 m2statement_BuildPushFunctionContext (void)
 125 {
 126   push_function_context ();
 127 }
 128
 129 /* BuildPopFunctionContext - pops the current function context.  Maps
 130    onto pop_function_context in ../function.cc.  */
 131
 132 void
 133 m2statement_BuildPopFunctionContext (void)
 134 {
 135   pop_function_context ();
 136 }
 137
 138 void
 139 m2statement_SetBeginLocation (location_t location)
 140 {
 141   if (cfun != NULL)
 142     cfun->function_start_locus = location;
 143 }
 144
 145 void
 146 m2statement_SetEndLocation (location_t location)
 147 {
 148   if (cfun != NULL)
 149     cfun->function_end_locus = location;
 150 }
 151
 152 /* BuildAssignmentTree builds the assignment of, des, and, expr.
 153    It returns, des.  */
 154
 155 tree
 156 m2statement_BuildAssignmentTree (location_t location, tree des, tree expr)
 157 {
 158   tree result;
 159
 160   m2assert_AssertLocation (location);
 161   STRIP_TYPE_NOPS (expr);
 162
 163   if (TREE_CODE (expr) == FUNCTION_DECL)
 164     result = build2 (MODIFY_EXPR, TREE_TYPE (des), des,
 165                      m2expr_BuildAddr (location, expr, false));
 166   else
 167     {
 168       gcc_assert (TREE_CODE (TREE_TYPE (des)) != TYPE_DECL);
 169       if (TREE_TYPE (expr) == TREE_TYPE (des))
 170         result = build2 (MODIFY_EXPR, TREE_TYPE (des), des, expr);
 171       else
 172         result = build2 (
 173             MODIFY_EXPR, TREE_TYPE (des), des,
 174             m2convert_BuildConvert (location, TREE_TYPE (des), expr, false));
 175     }
 176
 177   TREE_SIDE_EFFECTS (result) = true;
 178   TREE_USED (des) = true;
 179   TREE_USED (expr) = true;
 180   add_stmt (location, result);
 181   return des;
 182 }
 183
 184 /* BuildAssignmentStatement builds the assignment of, des, and, expr.  */
 185
 186 void
 187 m2statement_BuildAssignmentStatement (location_t location, tree des, tree expr)
 188 {
 189   m2statement_BuildAssignmentTree (location, des, expr);
 190 }
 191
 192 /* BuildGoto builds a goto operation.  */
 193
 194 void
 195 m2statement_BuildGoto (location_t location, char *name)
 196 {
 197   tree label = m2block_getLabel (location, name);
 198
 199   m2assert_AssertLocation (location);
 200   TREE_USED (label) = true;
 201   add_stmt (location, build1 (GOTO_EXPR, void_type_node, label));
 202 }
 203
 204 /* DeclareLabel - create a label, name.  */
 205
 206 void
 207 m2statement_DeclareLabel (location_t location, char *name)
 208 {
 209   tree label = m2block_getLabel (location, name);
 210
 211   m2assert_AssertLocation (location);
 212   add_stmt (location, build1 (LABEL_EXPR, void_type_node, label));
 213 }
 214
 215 /* BuildParam - build a list of parameters, ready for a subsequent
 216    procedure call.  */
 217
 218 void
 219 m2statement_BuildParam (location_t location, tree param)
 220 {
 221   m2assert_AssertLocation (location);
 222
 223   TREE_USED (param) = true;
 224   if (TREE_CODE (param) == FUNCTION_DECL)
 225     param = m2expr_BuildAddr (location, param, false);
 226
 227   param_list = chainon (build_tree_list (NULL_TREE, param), param_list);
 228 }
 229
 230 /* nCount - return the number of chained tree nodes in list, t.  */
 231
 232 static int
 233 nCount (tree t)
 234 {
 235   int i = 0;
 236
 237   while (t != NULL)
 238     {
 239       i++;
 240       t = TREE_CHAIN (t);
 241     }
 242   return i;
 243 }
 244
 245 /* BuildProcedureCallTree - creates a procedure call from a procedure
 246    and parameter list and the return type, rettype.  */
 247
 248 tree
 249 m2statement_BuildProcedureCallTree (location_t location, tree procedure,
 250                                     tree rettype)
 251 {
 252   tree functype = TREE_TYPE (procedure);
 253   tree funcptr = build1 (ADDR_EXPR, build_pointer_type (functype), procedure);
 254   tree call;
 255   int n = nCount (param_list);
 256   tree *argarray = XALLOCAVEC (tree, n);
 257   tree t = param_list;
 258   int i;
 259
 260   m2assert_AssertLocation (location);
 261   ASSERT_CONDITION (
 262       last_function
 263       == NULL_TREE); /* Previous function value has not been collected.  */
 264   TREE_USED (procedure) = true;
 265
 266   for (i = 0; i < n; i++)
 267     {
 268       argarray[i] = TREE_VALUE (t);
 269       t = TREE_CHAIN (t);
 270     }
 271
 272   if (rettype == NULL_TREE)
 273     {
 274       rettype = void_type_node;
 275       call = build_call_array_loc (location, rettype, funcptr, n, argarray);
 276       TREE_USED (call) = true;
 277       TREE_SIDE_EFFECTS (call) = true;
 278
 279 #if defined(DEBUG_PROCEDURE_CALLS)
 280       fprintf (stderr, "built the modula-2 call, here is the tree\n");
 281       fflush (stderr);
 282       debug_tree (call);
 283 #endif
 284
 285       param_list
 286           = NULL_TREE; /* Ready for the next time we call a procedure.  */
 287       last_function = NULL_TREE;
 288       return call;
 289     }
 290   else
 291     {
 292       last_function = build_call_array_loc (
 293           location, m2tree_skip_type_decl (rettype), funcptr, n, argarray);
 294       TREE_USED (last_function) = true;
 295       TREE_SIDE_EFFECTS (last_function) = true;
 296       param_list
 297           = NULL_TREE; /* Ready for the next time we call a procedure.  */
 298       return last_function;
 299     }
 300 }
 301
 302 /* BuildIndirectProcedureCallTree - creates a procedure call from a
 303    procedure and parameter list and the return type, rettype.  */
 304
 305 tree
 306 m2statement_BuildIndirectProcedureCallTree (location_t location,
 307                                             tree procedure, tree rettype)
 308 {
 309   tree call;
 310   int n = nCount (param_list);
 311   tree *argarray = XALLOCAVEC (tree, n);
 312   tree t = param_list;
 313   int i;
 314
 315   m2assert_AssertLocation (location);
 316   TREE_USED (procedure) = true;
 317   TREE_SIDE_EFFECTS (procedure) = true;
 318
 319   for (i = 0; i < n; i++)
 320     {
 321       argarray[i] = TREE_VALUE (t);
 322       t = TREE_CHAIN (t);
 323     }
 324
 325   if (rettype == NULL_TREE)
 326     {
 327       rettype = void_type_node;
 328       call = build_call_array_loc (location, rettype, procedure, n, argarray);
 329       TREE_USED (call) = true;
 330       TREE_SIDE_EFFECTS (call) = true;
 331
 332 #if defined(DEBUG_PROCEDURE_CALLS)
 333       fprintf (stderr, "built the modula-2 call, here is the tree\n");
 334       fflush (stderr);
 335       debug_tree (call);
 336 #endif
 337
 338       last_function = NULL_TREE;
 339       param_list
 340           = NULL_TREE; /* Ready for the next time we call a procedure.  */
 341       return call;
 342     }
 343   else
 344     {
 345       last_function = build_call_array_loc (
 346           location, m2tree_skip_type_decl (rettype), procedure, n, argarray);
 347       TREE_USED (last_function) = true;
 348       TREE_SIDE_EFFECTS (last_function) = true;
 349       param_list
 350           = NULL_TREE; /* Ready for the next time we call a procedure.  */
 351       return last_function;
 352     }
 353 }
 354
 355
 356 /* BuildBuiltinCallTree calls the builtin procedure.  */
 357
 358 tree
 359 m2statement_BuildBuiltinCallTree (location_t location, tree func)
 360 {
 361   TREE_USED (func) = true;
 362   TREE_SIDE_EFFECTS (func) = true;
 363   param_list
 364     = NULL_TREE; /* Ready for the next time we call a procedure.  */
 365   return func;
 366 }
 367
 368
 369 /* BuildFunctValue - generates code for value :=
 370    last_function(foobar); */
 371
 372 tree
 373 m2statement_BuildFunctValue (location_t location, tree value)
 374 {
 375   tree assign
 376       = m2treelib_build_modify_expr (location, value, NOP_EXPR, last_function);
 377
 378   m2assert_AssertLocation (location);
 379   ASSERT_CONDITION (
 380       last_function
 381       != NULL_TREE);  /* No value available, possible used before.  */
 382
 383   TREE_SIDE_EFFECTS (assign) = true;
 384   TREE_USED (assign) = true;
 385   TREE_USED (value) = true;
 386   last_function = NULL_TREE;
 387   return assign;
 388   // return m2statement_BuildAssignmentTree (location, value, assign);
 389 }
 390
 391 /* BuildCall2 - builds a tree representing: function (arg1, arg2).  */
 392
 393 tree
 394 m2statement_BuildCall2 (location_t location, tree function, tree rettype,
 395                         tree arg1, tree arg2)
 396 {
 397   m2assert_AssertLocation (location);
 398   ASSERT_CONDITION (param_list == NULL_TREE);
 399
 400   param_list = chainon (build_tree_list (NULL_TREE, arg2), param_list);
 401   param_list = chainon (build_tree_list (NULL_TREE, arg1), param_list);
 402   return m2statement_BuildProcedureCallTree (location, function, rettype);
 403 }
 404
 405 /* BuildCall3 - builds a tree representing: function (arg1, arg2,
 406    arg3).  */
 407
 408 tree
 409 m2statement_BuildCall3 (location_t location, tree function, tree rettype,
 410                         tree arg1, tree arg2, tree arg3)
 411 {
 412   m2assert_AssertLocation (location);
 413   ASSERT_CONDITION (param_list == NULL_TREE);
 414
 415   param_list = chainon (build_tree_list (NULL_TREE, arg3), param_list);
 416   param_list = chainon (build_tree_list (NULL_TREE, arg2), param_list);
 417   param_list = chainon (build_tree_list (NULL_TREE, arg1), param_list);
 418   return m2statement_BuildProcedureCallTree (location, function, rettype);
 419 }
 420
 421 /* BuildFunctionCallTree - creates a procedure function call from
 422    a procedure and parameter list and the return type, rettype.
 423    No tree is returned as the tree is held in the last_function global
 424    variable.  It is expected the BuildFunctValue is to be called after
 425    a call to BuildFunctionCallTree.  */
 426
 427 void
 428 m2statement_BuildFunctionCallTree (location_t location, tree procedure,
 429                                    tree rettype)
 430 {
 431   m2statement_BuildProcedureCallTree (location, procedure, rettype);
 432 }
 433
 434 /* SetLastFunction - assigns last_function to, t.  */
 435
 436 void
 437 m2statement_SetLastFunction (tree t)
 438 {
 439   last_function = t;
 440 }
 441
 442 /* SetParamList - assigns param_list to, t.  */
 443
 444 void
 445 m2statement_SetParamList (tree t)
 446 {
 447   param_list = t;
 448 }
 449
 450 /* GetLastFunction - returns, last_function.  */
 451
 452 tree
 453 m2statement_GetLastFunction (void)
 454 {
 455   return last_function;
 456 }
 457
 458 /* GetParamList - returns, param_list.  */
 459
 460 tree
 461 m2statement_GetParamList (void)
 462 {
 463   return param_list;
 464 }
 465
 466 /* GetCurrentFunction - returns the current_function.  */
 467
 468 tree
 469 m2statement_GetCurrentFunction (void)
 470 {
 471   return current_function_decl;
 472 }
 473
 474 /* GetParamTree - return parameter, i.  */
 475
 476 tree
 477 m2statement_GetParamTree (tree call, unsigned int i)
 478 {
 479   return CALL_EXPR_ARG (call, i);
 480 }
 481
 482 /* BuildTryFinally - returns a TRY_FINALL_EXPR with the call and
 483    cleanups attached.  */
 484
 485 tree
 486 m2statement_BuildTryFinally (location_t location, tree call, tree cleanups)
 487 {
 488   return build_stmt (location, TRY_FINALLY_EXPR, call, cleanups);
 489 }
 490
 491 /* BuildCleanUp - return a CLEANUP_POINT_EXPR which will clobber,
 492    param.  */
 493
 494 tree
 495 m2statement_BuildCleanUp (tree param)
 496 {
 497   tree clobber = build_constructor (TREE_TYPE (param), NULL);
 498   TREE_THIS_VOLATILE (clobber) = 1;
 499   return build2 (MODIFY_EXPR, TREE_TYPE (param), param, clobber);
 500 }
 501
 502 /* BuildAsm - generates an inline assembler instruction.  */
 503
 504 void
 505 m2statement_BuildAsm (location_t location, tree instr, bool isVolatile,
 506                       bool isSimple, tree inputs, tree outputs, tree trash,
 507                       tree labels)
 508 {
 509   tree string = resolve_asm_operand_names (instr, outputs, inputs, labels);
 510   tree args = build_stmt (location, ASM_EXPR, string, outputs, inputs, trash,
 511                           labels);
 512
 513   m2assert_AssertLocation (location);
 514
 515   /* ASM statements without outputs, including simple ones, are treated
 516      as volatile.  */
 517   ASM_INPUT_P (args) = isSimple;
 518   ASM_VOLATILE_P (args) = isVolatile;
 519
 520   add_stmt (location, args);
 521 }
 522
 523 /* BuildUnaryForeachWordDo - provides the large set operators.  Each
 524    word (or less) of the set can be calculated by unop.  This
 525    procedure runs along each word of the large set invoking the unop.  */
 526
 527 void
 528 m2statement_BuildUnaryForeachWordDo (location_t location, tree type, tree op1,
 529                                      tree op2,
 530                                      tree (*unop) (location_t, tree, bool),
 531                                      bool is_op1lvalue, bool is_op2lvalue,
 532                                      bool is_op1const, bool is_op2const)
 533 {
 534   tree size = m2expr_GetSizeOf (location, type);
 535
 536   m2assert_AssertLocation (location);
 537   ASSERT_BOOL (is_op1lvalue);
 538   ASSERT_BOOL (is_op2lvalue);
 539   ASSERT_BOOL (is_op1const);
 540   ASSERT_BOOL (is_op2const);
 541   if (m2expr_CompareTrees (
 542           size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
 543       <= 0)
 544     /* Small set size <= TSIZE(WORD).  */
 545     m2statement_BuildAssignmentTree (
 546         location, m2treelib_get_rvalue (location, op1, type, is_op1lvalue),
 547         (*unop) (location,
 548                  m2treelib_get_rvalue (location, op2, type, is_op2lvalue),
 549                  false));
 550   else
 551     {
 552       /* Large set size > TSIZE(WORD).  */
 553       unsigned int fieldNo = 0;
 554       tree field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
 555       tree field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
 556
 557       if (is_op1const)
 558         error ("internal error: not expecting operand1 to be a constant set");
 559
 560       while (field1 != NULL && field2 != NULL)
 561         {
 562           m2statement_BuildAssignmentTree (
 563               location, m2treelib_get_set_field_des (location, op1, field1),
 564               (*unop) (location,
 565                        m2treelib_get_set_field_rhs (location, op2, field2),
 566                        false));
 567           fieldNo++;
 568           field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
 569           field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
 570         }
 571     }
 572 }
 573
 574 /* BuildExcludeVarConst - builds the EXCL(op1, 1<<op2) operation for
 575    a small sets.  Large sets call this routine to exclude the bit in
 576    the particular word.  op2 is a constant.  */
 577
 578 void
 579 m2statement_BuildExcludeVarConst (location_t location, tree type, tree op1,
 580                                   tree op2, bool is_lvalue, int fieldno)
 581 {
 582   tree size = m2expr_GetSizeOf (location, type);
 583
 584   m2assert_AssertLocation (location);
 585   ASSERT_BOOL (is_lvalue);
 586   if (m2expr_CompareTrees (
 587           size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
 588       <= 0)
 589     {
 590       /* Small set size <= TSIZE(WORD).  */
 591       m2statement_BuildAssignmentTree (
 592           location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
 593           m2expr_BuildLogicalAnd (
 594               location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
 595               m2expr_BuildSetNegate (
 596                   location,
 597                   m2expr_BuildLSL (location, m2expr_GetWordOne (location), op2,
 598                                    false),
 599                   false),
 600               false));
 601     }
 602   else
 603     {
 604       tree fieldlist = TYPE_FIELDS (type);
 605       tree field;
 606
 607       for (field = fieldlist; (field != NULL) && (fieldno > 0);
 608            field = TREE_CHAIN (field))
 609         fieldno--;
 610
 611       m2statement_BuildAssignmentTree (
 612           location, m2treelib_get_set_field_des (location, op1, field),
 613           m2expr_BuildLogicalAnd (
 614               location, m2treelib_get_set_field_rhs (location, op1, field),
 615               m2expr_BuildSetNegate (
 616                   location,
 617                   m2expr_BuildLSL (location, m2expr_GetWordOne (location), op2,
 618                                    false),
 619                   false),
 620               false));
 621     }
 622 }
 623
 624 /* BuildExcludeVarVar - builds the EXCL(varset, 1<<varel) operation
 625    for a small and large sets.  varel is a variable.  */
 626
 627 void
 628 m2statement_BuildExcludeVarVar (location_t location, tree type, tree varset,
 629                                 tree varel, bool is_lvalue, tree low)
 630 {
 631   tree size = m2expr_GetSizeOf (location, type);
 632
 633   m2assert_AssertLocation (location);
 634   ASSERT_BOOL (is_lvalue);
 635   /* Calculate the index from the first bit, ie bit 0 represents low value.  */
 636   tree index
 637       = m2expr_BuildSub (location, m2convert_ToInteger (location, varel),
 638                          m2convert_ToInteger (location, low), false);
 639
 640   if (m2expr_CompareTrees (
 641           size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
 642       <= 0)
 643     /* Small set size <= TSIZE(WORD).  */
 644     m2statement_BuildAssignmentTree (
 645         location, m2treelib_get_rvalue (location, varset, type, is_lvalue),
 646         m2expr_BuildLogicalAnd (
 647             location, m2treelib_get_rvalue (location, varset, type, is_lvalue),
 648             m2expr_BuildSetNegate (
 649                 location,
 650                 m2expr_BuildLSL (location, m2expr_GetWordOne (location),
 651                                  m2convert_ToWord (location, index), false),
 652                 false),
 653             false));
 654   else
 655     {
 656       tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
 657       /* Calculate the index from the first bit.  */
 658
 659       /* Which word do we need to fetch?  */
 660       tree word_index = m2expr_BuildDivTrunc (
 661           location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE), false);
 662       /* Calculate the bit in this word.  */
 663       tree offset_into_word = m2expr_BuildModTrunc (
 664           location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE), false);
 665
 666       tree v1;
 667
 668       /* Calculate the address of the word we are interested in.  */
 669       p1 = m2expr_BuildAddAddress (
 670           location, m2convert_convertToPtr (location, p1),
 671           m2expr_BuildMult (
 672               location, word_index,
 673               m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT),
 674               false));
 675
 676       v1 = m2expr_BuildLogicalAnd (
 677           location,
 678           m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
 679           m2expr_BuildSetNegate (
 680               location,
 681               m2expr_BuildLSL (location, m2expr_GetWordOne (location),
 682                                m2convert_ToWord (location, offset_into_word),
 683                                false),
 684               false),
 685           false);
 686
 687       /* Set bit offset_into_word within the word pointer at by p1.  */
 688       m2statement_BuildAssignmentTree (
 689           location,
 690           m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
 691           m2convert_ToBitset (location, v1));
 692     }
 693 }
 694
 695 /* BuildIncludeVarConst - builds the INCL(op1, 1<<op2) operation for
 696    a small sets.  Large sets call this routine to include the bit in
 697    the particular word.  op2 is a constant.  */
 698
 699 void
 700 m2statement_BuildIncludeVarConst (location_t location, tree type, tree op1,
 701                                   tree op2, bool is_lvalue, int fieldno)
 702 {
 703   tree size = m2expr_GetSizeOf (location, type);
 704
 705   m2assert_AssertLocation (location);
 706   ASSERT_BOOL (is_lvalue);
 707   if (m2expr_CompareTrees (
 708           size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
 709       <= 0)
 710     {
 711       /* Small set size <= TSIZE(WORD).  */
 712       m2statement_BuildAssignmentTree (
 713           location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
 714           m2expr_BuildLogicalOr (
 715               location, m2treelib_get_rvalue (location, op1, type, is_lvalue),
 716               m2expr_BuildLSL (location, m2expr_GetWordOne (location),
 717                                m2convert_ToWord (location, op2), false),
 718               false));
 719     }
 720   else
 721     {
 722       tree fieldlist = TYPE_FIELDS (type);
 723       tree field;
 724
 725       for (field = fieldlist; (field != NULL) && (fieldno > 0);
 726            field = TREE_CHAIN (field))
 727         fieldno--;
 728
 729       m2statement_BuildAssignmentTree (
 730           location,
 731           /* Would like to use: m2expr_BuildComponentRef (location, p, field)
 732              but strangely we have to take the address of the field and
 733              dereference it to satify the gimplifier.  See
 734              testsuite/gm2/pim/pass/timeio?.mod for testcases.  */
 735           m2treelib_get_set_field_des (location, op1, field),
 736           m2expr_BuildLogicalOr (
 737               location, m2treelib_get_set_field_rhs (location, op1, field),
 738               m2expr_BuildLSL (location, m2expr_GetWordOne (location),
 739                                m2convert_ToWord (location, op2), false),
 740               false));
 741     }
 742 }
 743
 744 /* BuildIncludeVarVar - builds the INCL(varset, 1<<varel) operation
 745    for a small and large sets.  op2 is a variable.  */
 746
 747 void
 748 m2statement_BuildIncludeVarVar (location_t location, tree type, tree varset,
 749                                 tree varel, bool is_lvalue, tree low)
 750 {
 751   tree size = m2expr_GetSizeOf (location, type);
 752
 753   m2assert_AssertLocation (location);
 754   ASSERT_BOOL (is_lvalue);
 755   /* Calculate the index from the first bit, ie bit 0 represents low value.  */
 756   tree index
 757       = m2expr_BuildSub (location, m2convert_ToInteger (location, varel),
 758                          m2convert_ToInteger (location, low), false);
 759   tree indexw = m2convert_ToWord (location, index);
 760
 761   if (m2expr_CompareTrees (
 762           size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
 763       <= 0)
 764     /* Small set size <= TSIZE(WORD).  */
 765     m2statement_BuildAssignmentTree (
 766         location, m2treelib_get_rvalue (location, varset, type, is_lvalue),
 767         m2convert_ToBitset (
 768             location,
 769             m2expr_BuildLogicalOr (
 770                 location,
 771                 m2treelib_get_rvalue (location, varset, type, is_lvalue),
 772                 m2expr_BuildLSL (location, m2expr_GetWordOne (location),
 773                                  indexw, false),
 774                 false)));
 775   else
 776     {
 777       tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
 778       /* Which word do we need to fetch?  */
 779       tree word_index = m2expr_BuildDivTrunc (
 780           location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE), false);
 781       /* Calculate the bit in this word.  */
 782       tree offset_into_word = m2convert_BuildConvert (
 783           location, m2type_GetWordType (),
 784           m2expr_BuildModTrunc (location, index,
 785                                 m2decl_BuildIntegerConstant (SET_WORD_SIZE),
 786                                 false),
 787           false);
 788       tree v1;
 789
 790       /* Calculate the address of the word we are interested in.  */
 791       p1 = m2expr_BuildAddAddress (
 792           location, m2convert_convertToPtr (location, p1),
 793           m2expr_BuildMult (
 794               location, word_index,
 795               m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT),
 796               false));
 797       v1 = m2expr_BuildLogicalOr (
 798           location,
 799           m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
 800           m2convert_ToBitset (location,
 801                               m2expr_BuildLSL (location,
 802                                                m2expr_GetWordOne (location),
 803                                                offset_into_word, false)),
 804           false);
 805
 806       /* Set bit offset_into_word within the word pointer at by p1.  */
 807       m2statement_BuildAssignmentTree (
 808           location,
 809           m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
 810           m2convert_ToBitset (location, v1));
 811     }
 812 }
 813
 814 /* BuildStart - creates a module initialization function.  We make
 815    this function public if it is not an inner module.  The linker
 816    will create a call list for all linked modules which determines
 817    the initialization sequence for all modules.  */
 818
 819 tree
 820 m2statement_BuildStart (location_t location, char *name, bool inner_module)
 821 {
 822   tree fntype;
 823   tree fndecl;
 824
 825   m2assert_AssertLocation (location);
 826   /* The function type depends on the return type and type of args.  */
 827   fntype = build_function_type (integer_type_node, NULL_TREE);
 828   fndecl = build_decl (location, FUNCTION_DECL, get_identifier (name), fntype);
 829
 830   DECL_EXTERNAL (fndecl) = 0;
 831   if (inner_module)
 832     TREE_PUBLIC (fndecl) = 0;
 833   else
 834     TREE_PUBLIC (fndecl) = 1;
 835
 836   TREE_STATIC (fndecl) = 1;
 837   DECL_RESULT (fndecl)
 838       = build_decl (location, RESULT_DECL, NULL_TREE, integer_type_node);
 839   DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
 840
 841   /* Prevent the optimizer from removing it if it is public.  */
 842   if (TREE_PUBLIC (fndecl))
 843     gm2_mark_addressable (fndecl);
 844
 845   m2statement_BuildStartFunctionCode (location, fndecl, !inner_module,
 846                                       inner_module);
 847   return fndecl;
 848 }
 849
 850 /* BuildEnd - complete the initialization function for this module.  */
 851
 852 void
 853 m2statement_BuildEnd (location_t location, tree fndecl, bool nested)
 854 {
 855   m2statement_BuildEndFunctionCode (location, fndecl, nested);
 856   current_function_decl = NULL;
 857   set_cfun (NULL);
 858 }
 859
 860 /* BuildCallInner - call the inner module function.  It has no
 861    parameters and no return value.  */
 862
 863 void
 864 m2statement_BuildCallInner (location_t location, tree fndecl)
 865 {
 866   m2assert_AssertLocation (location);
 867   param_list = NULL_TREE;
 868   add_stmt (location,
 869             m2statement_BuildProcedureCallTree (location, fndecl, NULL_TREE));
 870 }
 871
 872
 873 /* BuildIfThenDoEnd - returns a tree which will only execute
 874    statement, s, if, condition, is true.  */
 875
 876 tree
 877 m2statement_BuildIfThenDoEnd (tree condition, tree then_block)
 878 {
 879   if (then_block == NULL_TREE)
 880     return NULL_TREE;
 881   else
 882     return fold_build3 (COND_EXPR, void_type_node, condition, then_block,
 883                         alloc_stmt_list ());
 884 }
 885
 886 /* BuildIfThenElseEnd - returns a tree which will execute then_block
 887    or else_block depending upon, condition.  */
 888
 889 tree
 890 m2statement_BuildIfThenElseEnd (tree condition, tree then_block,
 891                                 tree else_block)
 892 {
 893   if (then_block == NULL_TREE)
 894     return NULL_TREE;
 895   else
 896     return fold_build3 (COND_EXPR, void_type_node, condition, then_block,
 897                         else_block);
 898 }
 899
 900 /* BuildReturnValueCode - generates the code associated with: RETURN(
 901    value ) */
 902
 903 void
 904 m2statement_BuildReturnValueCode (location_t location, tree fndecl, tree value)
 905 {
 906   tree ret_stmt;
 907   tree t;
 908
 909   m2assert_AssertLocation (location);
 910   t = build2 (
 911       MODIFY_EXPR, TREE_TYPE (DECL_RESULT (fndecl)), DECL_RESULT (fndecl),
 912       m2convert_BuildConvert (
 913           location, m2tree_skip_type_decl (TREE_TYPE (DECL_RESULT (fndecl))),
 914           value, false));
 915
 916   ret_stmt = build_stmt (location, RETURN_EXPR, t);
 917   add_stmt (location, ret_stmt);
 918 }
 919
 920 /* DoJump - jump to the appropriate label depending whether result of
 921    the expression is true or false.  */
 922
 923 void
 924 m2statement_DoJump (location_t location, tree exp, char *falselabel,
 925                     char *truelabel)
 926 {
 927   tree c = NULL_TREE;
 928
 929   m2assert_AssertLocation (location);
 930   if (TREE_CODE (TREE_TYPE (exp)) != BOOLEAN_TYPE)
 931     exp = convert_loc (location, m2type_GetBooleanType (), exp);
 932
 933   if ((falselabel != NULL) && (truelabel == NULL))
 934     {
 935       m2block_push_statement_list (m2block_begin_statement_list ());
 936
 937       m2statement_BuildGoto (location, falselabel);
 938       c = build3 (COND_EXPR, void_type_node, exp,
 939                   m2block_pop_statement_list (),
 940                   alloc_stmt_list ());
 941     }
 942   else if ((falselabel == NULL) && (truelabel != NULL))
 943     {
 944       m2block_push_statement_list (m2block_begin_statement_list ());
 945
 946       m2statement_BuildGoto (location, truelabel);
 947       c = build3 (COND_EXPR, void_type_node, exp,
 948                   m2block_pop_statement_list (),
 949                   alloc_stmt_list ());
 950     }
 951   else
 952     error_at (location, "expecting one and only one label to be declared");
 953   if (c != NULL_TREE)
 954     add_stmt (location, c);
 955 }
 956
 957 #include "gt-m2-m2statement.h"