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