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