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