Branch data Line data Source code
1 : : /* m2expr.cc provides an interface to GCC expression 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 : : #include "m2convert.h"
27 : :
28 : : /* Prototypes. */
29 : :
30 : : #define m2expr_c
31 : : #include "m2assert.h"
32 : : #include "m2builtins.h"
33 : : #include "m2convert.h"
34 : : #include "m2decl.h"
35 : : #include "m2expr.h"
36 : : #include "m2options.h"
37 : : #include "m2range.h"
38 : : #include "m2statement.h"
39 : : #include "m2tree.h"
40 : : #include "m2treelib.h"
41 : : #include "m2type.h"
42 : : #include "m2linemap.h"
43 : :
44 : : static void m2expr_checkRealOverflow (location_t location, enum tree_code code,
45 : : tree result);
46 : : static tree checkWholeNegateOverflow (location_t location, tree i, tree lowest,
47 : : tree min, tree max);
48 : : // static tree m2expr_Build4LogicalAnd (location_t location, tree a, tree b,
49 : : // tree c, tree d);
50 : : static tree m2expr_Build4LogicalOr (location_t location, tree a, tree b,
51 : : tree c, tree d);
52 : : static tree m2expr_Build4TruthOrIf (location_t location, tree a, tree b,
53 : : tree c, tree d);
54 : : static tree m2expr_Build4TruthAndIf (location_t location, tree a, tree b,
55 : : tree c, tree d);
56 : :
57 : : static int label_count = 0;
58 : : static GTY (()) tree set_full_complement;
59 : :
60 : : /* CompareTrees returns -1 if e1 < e2, 0 if e1 == e2, and 1 if e1 > e2. */
61 : :
62 : : int
63 : 21710804 : m2expr_CompareTrees (tree e1, tree e2)
64 : : {
65 : 21710804 : return tree_int_cst_compare (m2expr_FoldAndStrip (e1),
66 : 21710804 : m2expr_FoldAndStrip (e2));
67 : : }
68 : :
69 : : /* FoldAndStrip return expression, t, after it has been folded (if
70 : : possible). */
71 : :
72 : : tree
73 : 65129401 : m2expr_FoldAndStrip (tree t)
74 : : {
75 : 65129401 : if (t != NULL)
76 : : {
77 : 65129401 : t = fold (t);
78 : 65129401 : if (TREE_CODE (t) == CONST_DECL)
79 : 0 : return m2expr_FoldAndStrip (DECL_INITIAL (t));
80 : : }
81 : :
82 : : return t;
83 : : }
84 : :
85 : : /* StringLength returns an unsigned int which is the length of, string. */
86 : :
87 : : unsigned int
88 : 355552 : m2expr_StringLength (tree string)
89 : : {
90 : 355552 : return TREE_STRING_LENGTH (string);
91 : : }
92 : :
93 : : /* CheckAddressToCardinal if op is a pointer convert it to the ADDRESS type. */
94 : :
95 : : static tree
96 : 1527988 : CheckAddressToCardinal (location_t location, tree op)
97 : : {
98 : 1527988 : if (m2type_IsAddress (TREE_TYPE (op)))
99 : 24772 : return m2convert_BuildConvert (location, m2type_GetCardinalAddressType (),
100 : 24772 : op, false);
101 : : return op;
102 : : }
103 : :
104 : : /* BuildTruthAndIf return true if a && b. Retain order left to right. */
105 : :
106 : : static tree
107 : 16136 : m2expr_BuildTruthAndIf (location_t location, tree a, tree b)
108 : : {
109 : 0 : return m2expr_build_binary_op (location, TRUTH_ANDIF_EXPR, a, b, false);
110 : : }
111 : :
112 : : /* BuildTruthOrIf return true if a || b. Retain order left to right. */
113 : :
114 : : static tree
115 : 6416 : m2expr_BuildTruthOrIf (location_t location, tree a, tree b)
116 : : {
117 : 0 : return m2expr_build_binary_op (location, TRUTH_ORIF_EXPR, a, b, false);
118 : : }
119 : :
120 : : /* BuildTruthNotIf inverts the boolean value of expr and returns the result. */
121 : :
122 : : static tree
123 : 128 : m2expr_BuildTruthNot (location_t location, tree expr)
124 : : {
125 : 0 : return m2expr_build_unary_op (location, TRUTH_NOT_EXPR, expr, false);
126 : : }
127 : :
128 : : /* BuildPostInc builds a post increment tree, the second operand is
129 : : always one. */
130 : :
131 : : static tree
132 : 136 : m2expr_BuildPostInc (location_t location, tree op)
133 : : {
134 : 136 : return m2expr_BuildAdd (location, op, build_int_cst (TREE_TYPE (op), 1), false);
135 : : }
136 : :
137 : : /* BuildPostDec builds a post decrement tree, the second operand is
138 : : always one. */
139 : :
140 : : static tree
141 : 408 : m2expr_BuildPostDec (location_t location, tree op)
142 : : {
143 : 408 : return m2expr_BuildSub (location, op, build_int_cst (TREE_TYPE (op), 1), false);
144 : : }
145 : :
146 : : /* BuildAddCheck builds an addition tree. */
147 : :
148 : : tree
149 : 25592 : m2expr_BuildAddCheck (location_t location, tree op1, tree op2, tree lowest,
150 : : tree min, tree max)
151 : : {
152 : 25592 : tree t;
153 : :
154 : 25592 : m2assert_AssertLocation (location);
155 : :
156 : 25592 : op1 = m2expr_FoldAndStrip (op1);
157 : 25592 : op2 = m2expr_FoldAndStrip (op2);
158 : :
159 : 25592 : op1 = CheckAddressToCardinal (location, op1);
160 : 25592 : op2 = CheckAddressToCardinal (location, op2);
161 : :
162 : 25592 : t = m2expr_build_binary_op_check (location, PLUS_EXPR, op1, op2, false,
163 : : lowest, min, max);
164 : 25592 : return m2expr_FoldAndStrip (t);
165 : : }
166 : :
167 : : /* BuildAdd builds an addition tree. */
168 : :
169 : : tree
170 : 154298 : m2expr_BuildAdd (location_t location, tree op1, tree op2, bool needconvert)
171 : : {
172 : 154298 : tree t;
173 : :
174 : 154298 : m2assert_AssertLocation (location);
175 : :
176 : 154298 : op1 = m2expr_FoldAndStrip (op1);
177 : 154298 : op2 = m2expr_FoldAndStrip (op2);
178 : :
179 : 154298 : op1 = CheckAddressToCardinal (location, op1);
180 : 154298 : op2 = CheckAddressToCardinal (location, op2);
181 : :
182 : 154298 : t = m2expr_build_binary_op (location, PLUS_EXPR, op1, op2, needconvert);
183 : 154298 : return m2expr_FoldAndStrip (t);
184 : : }
185 : :
186 : : /* BuildSubCheck builds a subtraction tree. */
187 : :
188 : : tree
189 : 7809 : m2expr_BuildSubCheck (location_t location, tree op1, tree op2, tree lowest,
190 : : tree min, tree max)
191 : : {
192 : 7809 : tree t;
193 : :
194 : 7809 : m2assert_AssertLocation (location);
195 : :
196 : 7809 : op1 = m2expr_FoldAndStrip (op1);
197 : 7809 : op2 = m2expr_FoldAndStrip (op2);
198 : :
199 : 7809 : op1 = CheckAddressToCardinal (location, op1);
200 : 7809 : op2 = CheckAddressToCardinal (location, op2);
201 : :
202 : 7809 : t = m2expr_build_binary_op_check (location, MINUS_EXPR, op1, op2, false,
203 : : lowest, min, max);
204 : 7809 : return m2expr_FoldAndStrip (t);
205 : : }
206 : :
207 : : /* BuildSub builds a subtraction tree. */
208 : :
209 : : tree
210 : 515085 : m2expr_BuildSub (location_t location, tree op1, tree op2, bool needconvert)
211 : : {
212 : 515085 : tree t;
213 : :
214 : 515085 : m2assert_AssertLocation (location);
215 : :
216 : 515085 : op1 = m2expr_FoldAndStrip (op1);
217 : 515085 : op2 = m2expr_FoldAndStrip (op2);
218 : :
219 : 515085 : op1 = CheckAddressToCardinal (location, op1);
220 : 515085 : op2 = CheckAddressToCardinal (location, op2);
221 : :
222 : 515085 : t = m2expr_build_binary_op (location, MINUS_EXPR, op1, op2, needconvert);
223 : 515085 : return m2expr_FoldAndStrip (t);
224 : : }
225 : :
226 : : /* BuildDivTrunc builds a trunc division tree. */
227 : :
228 : : tree
229 : 7042 : m2expr_BuildDivTrunc (location_t location, tree op1, tree op2, bool needconvert)
230 : : {
231 : 7042 : tree t;
232 : :
233 : 7042 : m2assert_AssertLocation (location);
234 : :
235 : 7042 : op1 = m2expr_FoldAndStrip (op1);
236 : 7042 : op2 = m2expr_FoldAndStrip (op2);
237 : :
238 : 7042 : op1 = CheckAddressToCardinal (location, op1);
239 : 7042 : op2 = CheckAddressToCardinal (location, op2);
240 : :
241 : 7042 : t = m2expr_build_binary_op (location, TRUNC_DIV_EXPR, op1, op2, needconvert);
242 : 7042 : return m2expr_FoldAndStrip (t);
243 : : }
244 : :
245 : : /* BuildDivTruncCheck builds a trunc division tree. */
246 : :
247 : : tree
248 : 32 : m2expr_BuildDivTruncCheck (location_t location, tree op1, tree op2, tree lowest,
249 : : tree min, tree max)
250 : : {
251 : 32 : tree t;
252 : :
253 : 32 : m2assert_AssertLocation (location);
254 : :
255 : 32 : op1 = m2expr_FoldAndStrip (op1);
256 : 32 : op2 = m2expr_FoldAndStrip (op2);
257 : :
258 : 32 : op1 = CheckAddressToCardinal (location, op1);
259 : 32 : op2 = CheckAddressToCardinal (location, op2);
260 : :
261 : 32 : t = m2expr_build_binary_op_check (location, TRUNC_DIV_EXPR, op1, op2, false,
262 : : lowest, min, max);
263 : 32 : return m2expr_FoldAndStrip (t);
264 : : }
265 : :
266 : : /* BuildModTruncCheck builds a trunc modulus tree. */
267 : :
268 : : tree
269 : 4 : m2expr_BuildModTruncCheck (location_t location, tree op1, tree op2, tree lowest,
270 : : tree min, tree max)
271 : : {
272 : 4 : tree t;
273 : :
274 : 4 : m2assert_AssertLocation (location);
275 : :
276 : 4 : op1 = m2expr_FoldAndStrip (op1);
277 : 4 : op2 = m2expr_FoldAndStrip (op2);
278 : :
279 : 4 : op1 = CheckAddressToCardinal (location, op1);
280 : 4 : op2 = CheckAddressToCardinal (location, op2);
281 : :
282 : 4 : t = m2expr_build_binary_op_check (location, TRUNC_MOD_EXPR, op1, op2, false,
283 : : lowest, min, max);
284 : 4 : return m2expr_FoldAndStrip (t);
285 : : }
286 : :
287 : : /* BuildModTrunc builds a trunc modulus tree. */
288 : :
289 : : tree
290 : 1264 : m2expr_BuildModTrunc (location_t location, tree op1, tree op2, bool needconvert)
291 : : {
292 : 1264 : tree t;
293 : :
294 : 1264 : m2assert_AssertLocation (location);
295 : :
296 : 1264 : op1 = m2expr_FoldAndStrip (op1);
297 : 1264 : op2 = m2expr_FoldAndStrip (op2);
298 : :
299 : 1264 : op1 = CheckAddressToCardinal (location, op1);
300 : 1264 : op2 = CheckAddressToCardinal (location, op2);
301 : :
302 : 1264 : t = m2expr_build_binary_op (location, TRUNC_MOD_EXPR, op1, op2, needconvert);
303 : 1264 : return m2expr_FoldAndStrip (t);
304 : : }
305 : :
306 : : /* BuildModCeilCheck builds a ceil modulus tree. */
307 : :
308 : : tree
309 : 1786 : m2expr_BuildModCeilCheck (location_t location, tree op1, tree op2, tree lowest,
310 : : tree min, tree max)
311 : : {
312 : 1786 : tree t;
313 : :
314 : 1786 : m2assert_AssertLocation (location);
315 : :
316 : 1786 : op1 = m2expr_FoldAndStrip (op1);
317 : 1786 : op2 = m2expr_FoldAndStrip (op2);
318 : :
319 : 1786 : op1 = CheckAddressToCardinal (location, op1);
320 : 1786 : op2 = CheckAddressToCardinal (location, op2);
321 : :
322 : 1786 : t = m2expr_build_binary_op_check (location, CEIL_MOD_EXPR, op1, op2, false,
323 : : lowest, min, max);
324 : 1786 : return m2expr_FoldAndStrip (t);
325 : : }
326 : :
327 : : /* BuildModFloorCheck builds a trunc modulus tree. */
328 : :
329 : : tree
330 : 1786 : m2expr_BuildModFloorCheck (location_t location, tree op1, tree op2, tree lowest,
331 : : tree min, tree max)
332 : : {
333 : 1786 : tree t;
334 : :
335 : 1786 : m2assert_AssertLocation (location);
336 : :
337 : 1786 : op1 = m2expr_FoldAndStrip (op1);
338 : 1786 : op2 = m2expr_FoldAndStrip (op2);
339 : :
340 : 1786 : op1 = CheckAddressToCardinal (location, op1);
341 : 1786 : op2 = CheckAddressToCardinal (location, op2);
342 : :
343 : 1786 : t = m2expr_build_binary_op_check (location, FLOOR_MOD_EXPR, op1, op2, false,
344 : : lowest, min, max);
345 : 1786 : return m2expr_FoldAndStrip (t);
346 : : }
347 : :
348 : : /* BuildDivCeil builds a ceil division tree. */
349 : :
350 : : tree
351 : 3445 : m2expr_BuildDivCeil (location_t location, tree op1, tree op2, bool needconvert)
352 : : {
353 : 3445 : tree t;
354 : :
355 : 3445 : m2assert_AssertLocation (location);
356 : :
357 : 3445 : op1 = m2expr_FoldAndStrip (op1);
358 : 3445 : op2 = m2expr_FoldAndStrip (op2);
359 : :
360 : 3445 : op1 = CheckAddressToCardinal (location, op1);
361 : 3445 : op2 = CheckAddressToCardinal (location, op2);
362 : :
363 : 3445 : t = m2expr_build_binary_op (location, CEIL_DIV_EXPR, op1, op2, needconvert);
364 : 3445 : return m2expr_FoldAndStrip (t);
365 : : }
366 : :
367 : : /* BuildDivCeilCheck builds a check ceil division tree. */
368 : :
369 : : tree
370 : 1611 : m2expr_BuildDivCeilCheck (location_t location, tree op1, tree op2, tree lowest,
371 : : tree min, tree max)
372 : : {
373 : 1611 : tree t;
374 : :
375 : 1611 : m2assert_AssertLocation (location);
376 : :
377 : 1611 : op1 = m2expr_FoldAndStrip (op1);
378 : 1611 : op2 = m2expr_FoldAndStrip (op2);
379 : :
380 : 1611 : op1 = CheckAddressToCardinal (location, op1);
381 : 1611 : op2 = CheckAddressToCardinal (location, op2);
382 : :
383 : 1611 : t = m2expr_build_binary_op_check (location, CEIL_DIV_EXPR, op1, op2, false,
384 : : lowest, min, max);
385 : 1611 : return m2expr_FoldAndStrip (t);
386 : : }
387 : :
388 : : /* BuildModCeil builds a ceil modulus tree. */
389 : :
390 : : tree
391 : 172 : m2expr_BuildModCeil (location_t location, tree op1, tree op2, bool needconvert)
392 : : {
393 : 172 : tree t;
394 : :
395 : 172 : m2assert_AssertLocation (location);
396 : :
397 : 172 : op1 = m2expr_FoldAndStrip (op1);
398 : 172 : op2 = m2expr_FoldAndStrip (op2);
399 : :
400 : 172 : op1 = CheckAddressToCardinal (location, op1);
401 : 172 : op2 = CheckAddressToCardinal (location, op2);
402 : :
403 : 172 : t = m2expr_build_binary_op (location, CEIL_MOD_EXPR, op1, op2, needconvert);
404 : 172 : return m2expr_FoldAndStrip (t);
405 : : }
406 : :
407 : : /* BuildDivFloor builds a floor division tree. */
408 : :
409 : : tree
410 : 3807 : m2expr_BuildDivFloor (location_t location, tree op1, tree op2, bool needconvert)
411 : : {
412 : 3807 : tree t;
413 : :
414 : 3807 : m2assert_AssertLocation (location);
415 : :
416 : 3807 : op1 = m2expr_FoldAndStrip (op1);
417 : 3807 : op2 = m2expr_FoldAndStrip (op2);
418 : :
419 : 3807 : op1 = CheckAddressToCardinal (location, op1);
420 : 3807 : op2 = CheckAddressToCardinal (location, op2);
421 : :
422 : 3807 : t = m2expr_build_binary_op (location, FLOOR_DIV_EXPR, op1, op2, needconvert);
423 : 3807 : return m2expr_FoldAndStrip (t);
424 : : }
425 : :
426 : : /* BuildDivFloorCheck builds a check floor division tree. */
427 : :
428 : : tree
429 : 1611 : m2expr_BuildDivFloorCheck (location_t location, tree op1, tree op2, tree lowest,
430 : : tree min, tree max)
431 : : {
432 : 1611 : tree t;
433 : :
434 : 1611 : m2assert_AssertLocation (location);
435 : :
436 : 1611 : op1 = m2expr_FoldAndStrip (op1);
437 : 1611 : op2 = m2expr_FoldAndStrip (op2);
438 : :
439 : 1611 : op1 = CheckAddressToCardinal (location, op1);
440 : 1611 : op2 = CheckAddressToCardinal (location, op2);
441 : :
442 : 1611 : t = m2expr_build_binary_op_check (location, FLOOR_DIV_EXPR, op1, op2, false,
443 : : lowest, min, max);
444 : 1611 : return m2expr_FoldAndStrip (t);
445 : : }
446 : :
447 : : /* BuildRDiv builds a division tree (this should only be used for
448 : : REAL and COMPLEX types and NEVER for integer based types). */
449 : :
450 : : tree
451 : 220 : m2expr_BuildRDiv (location_t location, tree op1, tree op2, bool needconvert)
452 : : {
453 : 220 : tree t;
454 : :
455 : 220 : m2assert_AssertLocation (location);
456 : :
457 : 220 : op1 = m2expr_FoldAndStrip (op1);
458 : 220 : op2 = m2expr_FoldAndStrip (op2);
459 : :
460 : 220 : t = m2expr_build_binary_op (location, RDIV_EXPR, op1, op2, needconvert);
461 : 220 : return m2expr_FoldAndStrip (t);
462 : : }
463 : :
464 : : /* BuildModFloor builds a modulus tree. */
465 : :
466 : : tree
467 : 716 : m2expr_BuildModFloor (location_t location, tree op1, tree op2, bool needconvert)
468 : : {
469 : 716 : tree t;
470 : :
471 : 716 : m2assert_AssertLocation (location);
472 : :
473 : 716 : op1 = m2expr_FoldAndStrip (op1);
474 : 716 : op2 = m2expr_FoldAndStrip (op2);
475 : :
476 : 716 : op1 = CheckAddressToCardinal (location, op1);
477 : 716 : op2 = CheckAddressToCardinal (location, op2);
478 : :
479 : 716 : t = m2expr_build_binary_op (location, FLOOR_MOD_EXPR, op1, op2, needconvert);
480 : 716 : return m2expr_FoldAndStrip (t);
481 : : }
482 : :
483 : : /* BuildLSL builds and returns tree (op1 << op2). */
484 : :
485 : : tree
486 : 390642 : m2expr_BuildLSL (location_t location, tree op1, tree op2, bool needconvert)
487 : : {
488 : 390642 : tree t;
489 : :
490 : 390642 : m2assert_AssertLocation (location);
491 : :
492 : 390642 : op1 = m2expr_FoldAndStrip (op1);
493 : 390642 : op2 = m2expr_FoldAndStrip (op2);
494 : :
495 : 390642 : t = m2expr_build_binary_op (location, LSHIFT_EXPR, op1, op2, needconvert);
496 : 390642 : return m2expr_FoldAndStrip (t);
497 : : }
498 : :
499 : : /* BuildLSR builds and returns tree (op1 >> op2). */
500 : :
501 : : tree
502 : 502 : m2expr_BuildLSR (location_t location, tree op1, tree op2, bool needconvert)
503 : : {
504 : 502 : tree t;
505 : :
506 : 502 : m2assert_AssertLocation (location);
507 : :
508 : 502 : op1 = m2expr_FoldAndStrip (op1);
509 : 502 : op2 = m2expr_FoldAndStrip (op2);
510 : :
511 : 502 : t = m2expr_build_binary_op (location, RSHIFT_EXPR, op1, op2, needconvert);
512 : 502 : return m2expr_FoldAndStrip (t);
513 : : }
514 : :
515 : : /* createUniqueLabel returns a unique label which has been alloc'ed. */
516 : :
517 : : static char *
518 : 896 : createUniqueLabel (void)
519 : : {
520 : 896 : int size, i;
521 : 896 : char *label;
522 : :
523 : 896 : label_count++;
524 : 896 : i = label_count;
525 : 896 : size = strlen (".LSHIFT") + 2;
526 : 1978 : while (i > 0)
527 : : {
528 : 1082 : i /= 10;
529 : 1082 : size++;
530 : : }
531 : 896 : label = (char *)ggc_alloc_atomic (size);
532 : 896 : sprintf (label, ".LSHIFT%d", label_count);
533 : 896 : return label;
534 : : }
535 : :
536 : : /* BuildLogicalShift builds the ISO Modula-2 SHIFT operator for a
537 : : fundamental data type. */
538 : :
539 : : void
540 : 516 : m2expr_BuildLogicalShift (location_t location, tree op1, tree op2, tree op3,
541 : : tree nBits ATTRIBUTE_UNUSED, bool needconvert)
542 : : {
543 : 516 : tree res;
544 : :
545 : 516 : m2assert_AssertLocation (location);
546 : 516 : op2 = m2expr_FoldAndStrip (op2);
547 : 516 : op3 = m2expr_FoldAndStrip (op3);
548 : 516 : if (TREE_CODE (op3) == INTEGER_CST)
549 : : {
550 : 132 : op2 = m2convert_ToWord (location, op2);
551 : 132 : if (tree_int_cst_sgn (op3) < 0)
552 : 66 : res = m2expr_BuildLSR (
553 : : location, op2,
554 : : m2convert_ToWord (location,
555 : : m2expr_BuildNegate (location, op3, needconvert)),
556 : : needconvert);
557 : : else
558 : 66 : res = m2expr_BuildLSL (location, op2, m2convert_ToWord (location, op3),
559 : : needconvert);
560 : 132 : res = m2convert_BuildConvert (
561 : 132 : location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, false);
562 : 132 : m2statement_BuildAssignmentTree (location, op1, res);
563 : : }
564 : : else
565 : : {
566 : 384 : char *labelElseName = createUniqueLabel ();
567 : 384 : char *labelEndName = createUniqueLabel ();
568 : 384 : tree is_less = m2expr_BuildLessThan (location,
569 : : m2convert_ToInteger (location, op3),
570 : : m2expr_GetIntegerZero (location));
571 : :
572 : 384 : m2statement_DoJump (location, is_less, NULL, labelElseName);
573 : 384 : op2 = m2convert_ToWord (location, op2);
574 : 384 : op3 = m2convert_ToWord (location, op3);
575 : 384 : res = m2expr_BuildLSL (location, op2, op3, needconvert);
576 : 384 : res = m2convert_BuildConvert (
577 : 384 : location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, false);
578 : 384 : m2statement_BuildAssignmentTree (location, op1, res);
579 : 384 : m2statement_BuildGoto (location, labelEndName);
580 : 384 : m2statement_DeclareLabel (location, labelElseName);
581 : 384 : res = m2expr_BuildLSR (location, op2,
582 : : m2expr_BuildNegate (location, op3, needconvert),
583 : : needconvert);
584 : 384 : res = m2convert_BuildConvert (
585 : 384 : location, m2tree_skip_type_decl (TREE_TYPE (op1)), res, false);
586 : 384 : m2statement_BuildAssignmentTree (location, op1, res);
587 : 384 : m2statement_DeclareLabel (location, labelEndName);
588 : : }
589 : 516 : }
590 : :
591 : : /* BuildLRL builds and returns tree (op1 rotate left by op2 bits). */
592 : :
593 : : tree
594 : 0 : m2expr_BuildLRL (location_t location, tree op1, tree op2, bool needconvert)
595 : : {
596 : 0 : tree t;
597 : :
598 : 0 : m2assert_AssertLocation (location);
599 : :
600 : 0 : op1 = m2expr_FoldAndStrip (op1);
601 : 0 : op2 = m2expr_FoldAndStrip (op2);
602 : :
603 : 0 : t = m2expr_build_binary_op (location, LROTATE_EXPR, op1, op2, needconvert);
604 : 0 : return m2expr_FoldAndStrip (t);
605 : : }
606 : :
607 : : /* BuildLRR builds and returns tree (op1 rotate right by op2 bits). */
608 : :
609 : : tree
610 : 0 : m2expr_BuildLRR (location_t location, tree op1, tree op2, bool needconvert)
611 : : {
612 : 0 : tree t;
613 : :
614 : 0 : m2assert_AssertLocation (location);
615 : :
616 : 0 : op1 = m2expr_FoldAndStrip (op1);
617 : 0 : op2 = m2expr_FoldAndStrip (op2);
618 : :
619 : 0 : t = m2expr_build_binary_op (location, RROTATE_EXPR, op1, op2, needconvert);
620 : 0 : return m2expr_FoldAndStrip (t);
621 : : }
622 : :
623 : : /* m2expr_BuildMask returns a tree for the mask of a set of nBits.
624 : : It assumes nBits is <= TSIZE (WORD). */
625 : :
626 : : tree
627 : 52 : m2expr_BuildMask (location_t location, tree nBits, bool needconvert)
628 : : {
629 : 52 : tree mask = m2expr_BuildLSL (location, m2expr_GetIntegerOne (location),
630 : : nBits, needconvert);
631 : 52 : m2assert_AssertLocation (location);
632 : 52 : return m2expr_BuildSub (location, mask, m2expr_GetIntegerOne (location),
633 : 52 : needconvert);
634 : : }
635 : :
636 : : /* m2expr_BuildLRotate returns a tree in which op1 has been left
637 : : rotated by nBits. It assumes nBits is <= TSIZE (WORD). */
638 : :
639 : : tree
640 : 68 : m2expr_BuildLRotate (location_t location, tree op1, tree nBits,
641 : : bool needconvert)
642 : : {
643 : 68 : tree t;
644 : :
645 : 68 : op1 = m2expr_FoldAndStrip (op1);
646 : 68 : nBits = m2expr_FoldAndStrip (nBits);
647 : 68 : t = m2expr_build_binary_op (location, LROTATE_EXPR, op1, nBits, needconvert);
648 : 68 : return m2expr_FoldAndStrip (t);
649 : : }
650 : :
651 : : /* m2expr_BuildRRotate returns a tree in which op1 has been left
652 : : rotated by nBits. It assumes nBits is <= TSIZE (WORD). */
653 : :
654 : : tree
655 : 68 : m2expr_BuildRRotate (location_t location, tree op1, tree nBits,
656 : : bool needconvert)
657 : : {
658 : 68 : tree t;
659 : :
660 : 68 : op1 = m2expr_FoldAndStrip (op1);
661 : 68 : nBits = m2expr_FoldAndStrip (nBits);
662 : 68 : t = m2expr_build_binary_op (location, RROTATE_EXPR, op1, nBits, needconvert);
663 : 68 : return m2expr_FoldAndStrip (t);
664 : : }
665 : :
666 : : /* BuildLRLn builds and returns tree (op1 rotate left by op2 bits) it
667 : : rotates a set of size, nBits. */
668 : :
669 : : tree
670 : 94 : m2expr_BuildLRLn (location_t location, tree op1, tree op2, tree nBits,
671 : : bool needconvert)
672 : : {
673 : 94 : tree op2min;
674 : :
675 : 94 : m2assert_AssertLocation (location);
676 : :
677 : : /* Ensure we wrap the rotate. */
678 : :
679 : 94 : op2min = m2expr_BuildModTrunc (
680 : : location, m2convert_ToCardinal (location, op2),
681 : : m2convert_ToCardinal (location, nBits), needconvert);
682 : :
683 : : /* Optimize if we are we going to rotate a TSIZE(BITSET) set. */
684 : :
685 : 94 : if (m2expr_CompareTrees (
686 : : m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset ()), nBits)
687 : : == 0)
688 : 68 : return m2expr_BuildLRotate (location, op1, op2min, needconvert);
689 : : else
690 : : {
691 : 26 : tree mask = m2expr_BuildMask (location, nBits, needconvert);
692 : 26 : tree left, right;
693 : :
694 : : /* Make absolutely sure there are no high order bits lying around. */
695 : :
696 : 26 : op1 = m2expr_BuildLogicalAnd (location, op1, mask, needconvert);
697 : 26 : left = m2expr_BuildLSL (location, op1, op2min, needconvert);
698 : 26 : left = m2expr_BuildLogicalAnd (location, left, mask, needconvert);
699 : 26 : right = m2expr_BuildLSR (
700 : : location, op1,
701 : : m2expr_BuildSub (location, m2convert_ToCardinal (location, nBits),
702 : : op2min, needconvert),
703 : : needconvert);
704 : 26 : return m2expr_BuildLogicalOr (location, left, right, needconvert);
705 : : }
706 : : }
707 : :
708 : : /* BuildLRRn builds and returns tree (op1 rotate right by op2 bits).
709 : : It rotates a set of size, nBits. */
710 : :
711 : : tree
712 : 94 : m2expr_BuildLRRn (location_t location, tree op1, tree op2, tree nBits,
713 : : bool needconvert)
714 : : {
715 : 94 : tree op2min;
716 : :
717 : 94 : m2assert_AssertLocation (location);
718 : :
719 : : /* Ensure we wrap the rotate. */
720 : :
721 : 94 : op2min = m2expr_BuildModTrunc (
722 : : location, m2convert_ToCardinal (location, op2),
723 : : m2convert_ToCardinal (location, nBits), needconvert);
724 : : /* Optimize if we are we going to rotate a TSIZE(BITSET) set. */
725 : :
726 : 94 : if (m2expr_CompareTrees (
727 : : m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset ()), nBits)
728 : : == 0)
729 : 68 : return m2expr_BuildRRotate (location, op1, op2min, needconvert);
730 : : else
731 : : {
732 : 26 : tree mask = m2expr_BuildMask (location, nBits, needconvert);
733 : 26 : tree left, right;
734 : :
735 : : /* Make absolutely sure there are no high order bits lying around. */
736 : :
737 : 26 : op1 = m2expr_BuildLogicalAnd (location, op1, mask, needconvert);
738 : 26 : right = m2expr_BuildLSR (location, op1, op2min, needconvert);
739 : 26 : left = m2expr_BuildLSL (
740 : : location, op1,
741 : : m2expr_BuildSub (location, m2convert_ToCardinal (location, nBits),
742 : : op2min, needconvert),
743 : : needconvert);
744 : 26 : left = m2expr_BuildLogicalAnd (location, left, mask, needconvert);
745 : 26 : return m2expr_BuildLogicalOr (location, left, right, needconvert);
746 : : }
747 : : }
748 : :
749 : : /* BuildLogicalRotate build the ISO Modula-2 ROTATE operator for a
750 : : fundamental data type. */
751 : :
752 : : void
753 : 124 : m2expr_BuildLogicalRotate (location_t location, tree op1, tree op2, tree op3,
754 : : tree nBits, bool needconvert)
755 : : {
756 : 124 : tree res;
757 : :
758 : 124 : m2assert_AssertLocation (location);
759 : 124 : op2 = m2expr_FoldAndStrip (op2);
760 : 124 : op3 = m2expr_FoldAndStrip (op3);
761 : 124 : if (TREE_CODE (op3) == INTEGER_CST)
762 : : {
763 : 60 : if (tree_int_cst_sgn (op3) < 0)
764 : 30 : res = m2expr_BuildLRRn (
765 : : location, op2, m2expr_BuildNegate (location, op3, needconvert),
766 : : nBits, needconvert);
767 : : else
768 : 30 : res = m2expr_BuildLRLn (location, op2, op3, nBits, needconvert);
769 : 60 : m2statement_BuildAssignmentTree (location, op1, res);
770 : : }
771 : : else
772 : : {
773 : 64 : char *labelElseName = createUniqueLabel ();
774 : 64 : char *labelEndName = createUniqueLabel ();
775 : 64 : tree is_less = m2expr_BuildLessThan (location,
776 : : m2convert_ToInteger (location, op3),
777 : : m2expr_GetIntegerZero (location));
778 : :
779 : 64 : m2statement_DoJump (location, is_less, NULL, labelElseName);
780 : 64 : res = m2expr_BuildLRLn (location, op2, op3, nBits, needconvert);
781 : 64 : m2statement_BuildAssignmentTree (location, op1, res);
782 : 64 : m2statement_BuildGoto (location, labelEndName);
783 : 64 : m2statement_DeclareLabel (location, labelElseName);
784 : 64 : res = m2expr_BuildLRRn (location, op2,
785 : : m2expr_BuildNegate (location, op3, needconvert),
786 : : nBits, needconvert);
787 : 64 : m2statement_BuildAssignmentTree (location, op1, res);
788 : 64 : m2statement_DeclareLabel (location, labelEndName);
789 : : }
790 : 124 : }
791 : :
792 : : /* buildUnboundedArrayOf construct an unbounded struct and returns
793 : : the gcc tree. The two fields of the structure are initialized to
794 : : contentsPtr and high. */
795 : :
796 : : static tree
797 : 576 : buildUnboundedArrayOf (tree unbounded, tree contentsPtr, tree high)
798 : : {
799 : 576 : tree fields = TYPE_FIELDS (unbounded);
800 : 576 : tree field_list = NULL_TREE;
801 : 576 : tree constructor;
802 : :
803 : 576 : field_list = tree_cons (fields, contentsPtr, field_list);
804 : 576 : fields = TREE_CHAIN (fields);
805 : :
806 : 576 : field_list = tree_cons (fields, high, field_list);
807 : :
808 : 576 : constructor = build_constructor_from_list (unbounded, nreverse (field_list));
809 : 576 : TREE_CONSTANT (constructor) = 0;
810 : 576 : TREE_STATIC (constructor) = 0;
811 : :
812 : 576 : return constructor;
813 : : }
814 : :
815 : : /* BuildBinarySetDo if the size of the set is <= TSIZE(WORD) then op1
816 : : := binop(op2, op3) else call m2rtsprocedure(op1, op2, op3). */
817 : :
818 : : void
819 : 928 : m2expr_BuildBinarySetDo (location_t location, tree settype, tree op1, tree op2,
820 : : tree op3, void (*binop) (location_t, tree, tree, tree,
821 : : tree, bool),
822 : : bool is_op1lvalue, bool is_op2lvalue, bool is_op3lvalue,
823 : : tree nBits, tree unbounded, tree varproc,
824 : : tree leftproc, tree rightproc)
825 : : {
826 : 928 : tree size = m2expr_GetSizeOf (location, settype);
827 : 928 : bool is_const = false;
828 : 928 : bool is_left = false;
829 : :
830 : 928 : m2assert_AssertLocation (location);
831 : :
832 : 928 : ASSERT_BOOL (is_op1lvalue);
833 : 928 : ASSERT_BOOL (is_op2lvalue);
834 : 928 : ASSERT_BOOL (is_op3lvalue);
835 : :
836 : 928 : if (m2expr_CompareTrees (
837 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
838 : : <= 0)
839 : : /* Small set size <= TSIZE(WORD). */
840 : 640 : (*binop) (location,
841 : : m2treelib_get_rvalue (location, op1, settype, is_op1lvalue),
842 : : m2treelib_get_rvalue (location, op2, settype, is_op2lvalue),
843 : : m2treelib_get_rvalue (location, op3, settype, is_op3lvalue),
844 : : nBits, false);
845 : : else
846 : : {
847 : 288 : tree result;
848 : 288 : tree high = m2expr_BuildSub (
849 : : location,
850 : : m2convert_ToCardinal (
851 : : location,
852 : : m2expr_BuildDivTrunc (
853 : : location, size,
854 : : m2expr_GetSizeOf (location, m2type_GetBitsetType ()),
855 : : false)),
856 : : m2expr_GetCardinalOne (location), false);
857 : :
858 : : /* If op3 is constant then make op3 positive and remember which
859 : : direction we are shifting. */
860 : :
861 : 288 : op3 = m2tree_skip_const_decl (op3);
862 : 288 : if (TREE_CODE (op3) == INTEGER_CST)
863 : : {
864 : 192 : is_const = true;
865 : 192 : if (tree_int_cst_sgn (op3) < 0)
866 : 108 : op3 = m2expr_BuildNegate (location, op3, false);
867 : : else
868 : : is_left = true;
869 : 192 : op3 = m2convert_BuildConvert (location, m2type_GetM2CardinalType (),
870 : : op3, false);
871 : : }
872 : :
873 : : /* These parameters must match the prototypes of the procedures:
874 : : ShiftLeft, ShiftRight, ShiftVal, RotateLeft, RotateRight, RotateVal
875 : : inside gm2-iso/SYSTEM.mod. */
876 : :
877 : : /* Remember we must build the parameters in reverse. */
878 : :
879 : : /* Parameter 4 amount. */
880 : 288 : m2statement_BuildParam (
881 : : location,
882 : : m2convert_BuildConvert (
883 : : location, m2type_GetM2IntegerType (),
884 : : m2treelib_get_rvalue (location, op3,
885 : 288 : m2tree_skip_type_decl (TREE_TYPE (op3)),
886 : : is_op3lvalue),
887 : : false));
888 : :
889 : : /* Parameter 3 nBits. */
890 : 288 : m2statement_BuildParam (
891 : : location,
892 : : m2convert_BuildConvert (location, m2type_GetM2CardinalType (),
893 : : m2expr_FoldAndStrip (nBits), false));
894 : :
895 : : /* Parameter 2 destination set. */
896 : 288 : m2statement_BuildParam (
897 : : location,
898 : : buildUnboundedArrayOf (
899 : : unbounded,
900 : : m2treelib_get_set_address (location, op1, is_op1lvalue), high));
901 : :
902 : : /* Parameter 1 source set. */
903 : 288 : m2statement_BuildParam (
904 : : location,
905 : : buildUnboundedArrayOf (
906 : : unbounded,
907 : : m2treelib_get_set_address (location, op2, is_op2lvalue), high));
908 : :
909 : : /* Now call the appropriate procedure inside SYSTEM.mod. */
910 : 288 : if (is_const)
911 : 192 : if (is_left)
912 : 84 : result = m2statement_BuildProcedureCallTree (location, leftproc,
913 : : NULL_TREE);
914 : : else
915 : 108 : result = m2statement_BuildProcedureCallTree (location, rightproc,
916 : : NULL_TREE);
917 : : else
918 : 96 : result = m2statement_BuildProcedureCallTree (location, varproc,
919 : : NULL_TREE);
920 : 288 : add_stmt (location, result);
921 : : }
922 : 928 : }
923 : :
924 : : /* Print a warning if a constant expression had overflow in folding.
925 : : Invoke this function on every expression that the language requires
926 : : to be a constant expression. */
927 : :
928 : : void
929 : 47223 : m2expr_ConstantExpressionWarning (tree value)
930 : : {
931 : 1248 : if ((TREE_CODE (value) == INTEGER_CST || TREE_CODE (value) == REAL_CST
932 : 858 : || TREE_CODE (value) == FIXED_CST || TREE_CODE (value) == VECTOR_CST
933 : 858 : || TREE_CODE (value) == COMPLEX_CST)
934 : 47907 : && TREE_OVERFLOW (value))
935 : 0 : pedwarn (input_location, OPT_Woverflow, "overflow in constant expression");
936 : 47223 : }
937 : :
938 : : /* TreeOverflow return true if the contant expression, t, has caused
939 : : an overflow. No error message or warning is emitted and no
940 : : modification is made to, t. */
941 : :
942 : : bool
943 : 3898801 : m2expr_TreeOverflow (tree t)
944 : : {
945 : 3898801 : if ((TREE_CODE (t) == INTEGER_CST
946 : 49222 : || (TREE_CODE (t) == COMPLEX_CST
947 : 624 : && TREE_CODE (TREE_REALPART (t)) == INTEGER_CST))
948 : 3898801 : && TREE_OVERFLOW (t))
949 : : return true;
950 : 3898783 : else if ((TREE_CODE (t) == REAL_CST
951 : 3898041 : || (TREE_CODE (t) == COMPLEX_CST
952 : 624 : && TREE_CODE (TREE_REALPART (t)) == REAL_CST))
953 : 3899407 : && TREE_OVERFLOW (t))
954 : : return true;
955 : : else
956 : : return false;
957 : : }
958 : :
959 : : /* RemoveOverflow if tree, t, is a constant expression it removes any
960 : : overflow flag and returns, t. */
961 : :
962 : : tree
963 : 8982 : m2expr_RemoveOverflow (tree t)
964 : : {
965 : 8982 : if (TREE_CODE (t) == INTEGER_CST
966 : 8982 : || (TREE_CODE (t) == COMPLEX_CST
967 : 0 : && TREE_CODE (TREE_REALPART (t)) == INTEGER_CST))
968 : 5320 : TREE_OVERFLOW (t) = 0;
969 : 3662 : else if (TREE_CODE (t) == REAL_CST
970 : 3662 : || (TREE_CODE (t) == COMPLEX_CST
971 : 0 : && TREE_CODE (TREE_REALPART (t)) == REAL_CST))
972 : 0 : TREE_OVERFLOW (t) = 0;
973 : 8982 : return t;
974 : : }
975 : :
976 : : /* BuildCoerce return a tree containing the expression, expr, after
977 : : it has been coersed to, type. */
978 : :
979 : : tree
980 : 0 : m2expr_BuildCoerce (location_t location, tree des, tree type, tree expr)
981 : : {
982 : 0 : tree copy = copy_node (expr);
983 : 0 : TREE_TYPE (copy) = type;
984 : :
985 : 0 : m2assert_AssertLocation (location);
986 : :
987 : 0 : return m2treelib_build_modify_expr (location, des, NOP_EXPR, copy);
988 : : }
989 : :
990 : : /* BuildTrunc return an integer expression from a REAL or LONGREAL op1. */
991 : :
992 : : tree
993 : 0 : m2expr_BuildTrunc (tree op1)
994 : : {
995 : 0 : return convert_to_integer (m2type_GetIntegerType (),
996 : 0 : m2expr_FoldAndStrip (op1));
997 : : }
998 : :
999 : : /* checkUnaryWholeOverflow decide if we can check this unary expression. */
1000 : :
1001 : : tree
1002 : 740 : m2expr_checkUnaryWholeOverflow (location_t location, enum tree_code code,
1003 : : tree arg, tree lowest, tree min, tree max)
1004 : : {
1005 : 740 : if (M2Options_GetWholeValueCheck () && (min != NULL))
1006 : : {
1007 : 96 : lowest = m2tree_skip_type_decl (lowest);
1008 : 96 : arg = fold_convert_loc (location, lowest, arg);
1009 : :
1010 : 96 : switch (code)
1011 : : {
1012 : 96 : case NEGATE_EXPR:
1013 : 96 : return checkWholeNegateOverflow (location, arg, lowest, min, max);
1014 : : default:
1015 : : return NULL;
1016 : : }
1017 : : }
1018 : : return NULL;
1019 : : }
1020 : :
1021 : : /* build_unary_op return a unary tree node. */
1022 : :
1023 : : tree
1024 : 756 : m2expr_build_unary_op_check (location_t location, enum tree_code code,
1025 : : tree arg, tree lowest, tree min, tree max)
1026 : : {
1027 : 756 : tree argtype = TREE_TYPE (arg);
1028 : 756 : tree result;
1029 : 756 : tree check = NULL;
1030 : :
1031 : 756 : m2assert_AssertLocation (location);
1032 : :
1033 : 756 : arg = m2expr_FoldAndStrip (arg);
1034 : :
1035 : 756 : if ((TREE_CODE (argtype) != REAL_TYPE) && (min != NULL))
1036 : 740 : check = m2expr_checkUnaryWholeOverflow (location, code, arg, lowest, min, max);
1037 : :
1038 : 756 : result = build1 (code, argtype, arg);
1039 : 756 : protected_set_expr_location (result, location);
1040 : :
1041 : 756 : if (check != NULL)
1042 : 96 : result = build2 (COMPOUND_EXPR, argtype, check, result);
1043 : :
1044 : 756 : if (SCALAR_FLOAT_TYPE_P (argtype))
1045 : 16 : m2expr_checkRealOverflow (location, code, result);
1046 : :
1047 : 756 : return m2expr_FoldAndStrip (result);
1048 : : }
1049 : :
1050 : : /* build_unary_op return a unary tree node. */
1051 : :
1052 : : tree
1053 : 19618 : m2expr_build_unary_op (location_t location, enum tree_code code, tree arg,
1054 : : int flag ATTRIBUTE_UNUSED)
1055 : : {
1056 : 19618 : tree argtype = TREE_TYPE (arg);
1057 : 19618 : tree result;
1058 : :
1059 : 19618 : m2assert_AssertLocation (location);
1060 : :
1061 : 19618 : arg = m2expr_FoldAndStrip (arg);
1062 : 19618 : result = build1 (code, argtype, arg);
1063 : 19618 : protected_set_expr_location (result, location);
1064 : :
1065 : 19618 : return m2expr_FoldAndStrip (result);
1066 : : }
1067 : :
1068 : : /* build_binary_op is a heavily pruned version of the one found in
1069 : : c-typeck.cc. The Modula-2 expression rules are much more restricted
1070 : : than C. */
1071 : :
1072 : : tree
1073 : 1746426 : build_binary_op (location_t location, enum tree_code code, tree op1, tree op2,
1074 : : int convert ATTRIBUTE_UNUSED)
1075 : : {
1076 : 1746426 : tree type1 = TREE_TYPE (op1);
1077 : 1746426 : tree result;
1078 : :
1079 : 1746426 : m2assert_AssertLocation (location);
1080 : :
1081 : : /* Strip NON_LVALUE_EXPRs, etc., since we aren't using as an lvalue. */
1082 : 3496702 : STRIP_TYPE_NOPS (op1);
1083 : 1746522 : STRIP_TYPE_NOPS (op2);
1084 : :
1085 : 1746426 : op1 = m2expr_FoldAndStrip (op1);
1086 : 1746426 : op2 = m2expr_FoldAndStrip (op2);
1087 : :
1088 : 1746426 : result = build2 (code, type1, op1, op2);
1089 : 1746426 : protected_set_expr_location (result, location);
1090 : :
1091 : 1746426 : return m2expr_FoldAndStrip (result);
1092 : : }
1093 : :
1094 : : /* BuildLessThanZero - returns a tree containing (< value 0). It
1095 : : checks the min and max value to ensure that the test can be safely
1096 : : achieved and will short circuit the result otherwise. */
1097 : :
1098 : : tree
1099 : 5476 : m2expr_BuildLessThanZero (location_t location, tree value, tree type, tree min,
1100 : : tree max)
1101 : : {
1102 : 5476 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) >= 0)
1103 : : /* min is greater than or equal to zero therefore value will always
1104 : : be >= 0. */
1105 : 3200 : return m2type_GetBooleanFalse ();
1106 : 2276 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) == -1)
1107 : : /* max is less than zero therefore value will always be < 0. */
1108 : 0 : return m2type_GetBooleanTrue ();
1109 : : /* We now know 0 lies in the range min..max so we can safely cast
1110 : : zero to type. */
1111 : 2276 : return m2expr_BuildLessThan (
1112 : : location, value,
1113 : 2276 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1114 : : }
1115 : :
1116 : : /* BuildGreaterThanZero - returns a tree containing (> value 0). It
1117 : : checks the min and max value to ensure that the test can be safely
1118 : : achieved and will short circuit the result otherwise. */
1119 : :
1120 : : tree
1121 : 4832 : m2expr_BuildGreaterThanZero (location_t location, tree value, tree type,
1122 : : tree min, tree max)
1123 : : {
1124 : 4832 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
1125 : : /* min is greater than zero therefore value will always be > 0. */
1126 : 40 : return m2type_GetBooleanTrue ();
1127 : 4792 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) <= 0)
1128 : : /* max is less than or equal to zero therefore value will always be
1129 : : <= 0. */
1130 : 36 : return m2type_GetBooleanFalse ();
1131 : : /* We now know 0 lies in the range min..max so we can safely cast
1132 : : zero to type. */
1133 : 4756 : return m2expr_BuildGreaterThan (
1134 : : location, value,
1135 : 4756 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1136 : : }
1137 : :
1138 : : /* BuildEqualToZero - returns a tree containing (= value 0). It
1139 : : checks the min and max value to ensure that the test can be safely
1140 : : achieved and will short circuit the result otherwise. */
1141 : :
1142 : : tree
1143 : 1308 : m2expr_BuildEqualToZero (location_t location, tree value, tree type, tree min,
1144 : : tree max)
1145 : : {
1146 : 1308 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
1147 : : /* min is greater than zero therefore value will always be > 0. */
1148 : 44 : return m2type_GetBooleanFalse ();
1149 : 1264 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
1150 : : /* max is less than or equal to zero therefore value will always be <
1151 : : 0. */
1152 : 0 : return m2type_GetBooleanFalse ();
1153 : : /* We now know 0 lies in the range min..max so we can safely cast
1154 : : zero to type. */
1155 : 1264 : return m2expr_BuildEqualTo (
1156 : : location, value,
1157 : 1264 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1158 : : }
1159 : :
1160 : : /* BuildNotEqualToZero - returns a tree containing (# value 0). It
1161 : : checks the min and max value to ensure that the test can be safely
1162 : : achieved and will short circuit the result otherwise. */
1163 : :
1164 : : tree
1165 : 1052 : m2expr_BuildNotEqualToZero (location_t location, tree value, tree type,
1166 : : tree min, tree max)
1167 : : {
1168 : 1052 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) == 1)
1169 : : /* min is greater than zero therefore value will always be true. */
1170 : 32 : return m2type_GetBooleanTrue ();
1171 : 1020 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
1172 : : /* max is less than or equal to zero therefore value will always be
1173 : : true. */
1174 : 0 : return m2type_GetBooleanTrue ();
1175 : : /* We now know 0 lies in the range min..max so we can safely cast
1176 : : zero to type. */
1177 : 1020 : return m2expr_BuildNotEqualTo (
1178 : : location, value,
1179 : 1020 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1180 : : }
1181 : :
1182 : :
1183 : : /* BuildGreaterThanOrEqualZero - returns a tree containing (>= value 0). It
1184 : : checks the min and max value to ensure that the test can be safely
1185 : : achieved and will short circuit the result otherwise. */
1186 : :
1187 : : tree
1188 : 96 : m2expr_BuildGreaterThanOrEqualZero (location_t location, tree value, tree type,
1189 : : tree min, tree max)
1190 : : {
1191 : 96 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) >= 0)
1192 : : /* min is greater than or equal to zero therefore value will always be >= 0. */
1193 : 48 : return m2type_GetBooleanTrue ();
1194 : 48 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
1195 : : /* max is less than zero therefore value will always be < 0. */
1196 : 0 : return m2type_GetBooleanFalse ();
1197 : : /* We now know 0 lies in the range min..max so we can safely cast
1198 : : zero to type. */
1199 : 48 : return m2expr_BuildGreaterThan (
1200 : : location, value,
1201 : 48 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1202 : : }
1203 : :
1204 : :
1205 : : /* BuildLessThanOrEqualZero - returns a tree containing (<= value 0). It
1206 : : checks the min and max value to ensure that the test can be safely
1207 : : achieved and will short circuit the result otherwise. */
1208 : :
1209 : : tree
1210 : 272 : m2expr_BuildLessThanOrEqualZero (location_t location, tree value, tree type,
1211 : : tree min, tree max)
1212 : : {
1213 : 272 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) > 0)
1214 : : /* min is greater than zero therefore value will always be > 0. */
1215 : 8 : return m2type_GetBooleanFalse ();
1216 : 264 : else if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) <= 0)
1217 : : /* max is less than or equal to zero therefore value will always be <= 0. */
1218 : 0 : return m2type_GetBooleanTrue ();
1219 : : /* We now know 0 lies in the range min..max so we can safely cast
1220 : : zero to type. */
1221 : 264 : return m2expr_BuildLessThanOrEqual (
1222 : : location, value,
1223 : 264 : fold_convert_loc (location, type, m2expr_GetIntegerZero (location)));
1224 : : }
1225 : :
1226 : :
1227 : : /* get_current_function_name, return the name of the current function if
1228 : : it currently exists. NULL is returned if we are not inside a function. */
1229 : :
1230 : : static const char *
1231 : 3724 : get_current_function_name (void)
1232 : : {
1233 : 3724 : if (current_function_decl != NULL
1234 : 3724 : && (DECL_NAME (current_function_decl) != NULL)
1235 : 7448 : && (IDENTIFIER_POINTER (DECL_NAME (current_function_decl)) != NULL))
1236 : 3724 : return IDENTIFIER_POINTER (DECL_NAME (current_function_decl));
1237 : : return NULL;
1238 : : }
1239 : :
1240 : : /* checkWholeNegateOverflow - check to see whether -arg will overflow
1241 : : an integer.
1242 : :
1243 : : PROCEDURE sneg (i: INTEGER) ;
1244 : : BEGIN
1245 : : IF i = MIN(INTEGER)
1246 : : THEN
1247 : : 'integer overflow'
1248 : : END
1249 : : END sneg ;
1250 : :
1251 : : general purpose subrange type, i, is currently legal, min is
1252 : : MIN(type) and max is MAX(type).
1253 : :
1254 : : PROCEDURE sneg (i: type) ;
1255 : : BEGIN
1256 : : max := MAX (type) ;
1257 : : min := MIN (type) ;
1258 : : (* cannot overflow if i is 0 *)
1259 : : IF (i#0) AND
1260 : : (* will overflow if entire range is positive. *)
1261 : : ((min >= 0) OR
1262 : : (* will overflow if entire range is negative. *)
1263 : : (max <= 0) OR
1264 : : (* c7 and c8 and c9 and c10 -> c17 more units positive. *)
1265 : : ((min < 0) AND (max > 0) AND ((min + max) > 0) AND (i > -min)) OR
1266 : : (* c11 and c12 and c13 and c14 -> c18 more units negative. *)
1267 : : ((min < 0) AND (max > 0) AND ((min + max) < 0) AND (i < -max)))
1268 : : THEN
1269 : : 'type overflow'
1270 : : END
1271 : : END sneg ; */
1272 : :
1273 : : static tree
1274 : 96 : checkWholeNegateOverflow (location_t location,
1275 : : tree i, tree type, tree min,
1276 : : tree max)
1277 : : {
1278 : 96 : tree a1
1279 : 96 : = m2expr_BuildNotEqualToZero (location, i, type, min, max); /* i # 0. */
1280 : 96 : tree c1 = m2expr_BuildGreaterThanZero (location, min, type, min,
1281 : : max); /* min > 0. */
1282 : 96 : tree c2 = m2expr_BuildEqualToZero (location, min, type, min,
1283 : : max); /* min == 0. */
1284 : 96 : tree c4 = m2expr_BuildLessThanZero (location, max, type, min,
1285 : : max); /* max < 0. */
1286 : 96 : tree c5 = m2expr_BuildEqualToZero (location, max, type, min,
1287 : : max); /* max == 0. */
1288 : 96 : tree c7 = m2expr_BuildLessThanZero (location, min, type, min,
1289 : : max); /* min < 0. */
1290 : 96 : tree c8 = m2expr_BuildGreaterThanZero (location, max, type, min,
1291 : : max); /* max > 0. */
1292 : 96 : tree c9 = m2expr_BuildGreaterThanZero (
1293 : : location, m2expr_BuildAdd (location, min, max, false), type, min,
1294 : : max); /* min + max > 0. */
1295 : 96 : tree c10 = m2expr_BuildGreaterThan (
1296 : : location, i, m2expr_BuildNegate (location, min, false)); /* i > -min. */
1297 : 96 : tree c11 = m2expr_BuildLessThanZero (
1298 : : location, m2expr_BuildAdd (location, min, max, false), type, min,
1299 : : max); /* min + max < 0. */
1300 : 96 : tree c12 = m2expr_BuildLessThan (
1301 : : location, i, m2expr_BuildNegate (location, max, false)); /* i < -max. */
1302 : :
1303 : 96 : tree b1 = m2expr_BuildTruthOrIf (location, c1, c2);
1304 : 96 : tree b2 = m2expr_BuildTruthOrIf (location, c8, c5);
1305 : 96 : tree o1 = m2expr_BuildTruthAndIf (location, b1, b2);
1306 : :
1307 : 96 : tree b3 = m2expr_BuildTruthOrIf (location, c7, c2);
1308 : 96 : tree b4 = m2expr_BuildTruthOrIf (location, c4, c5);
1309 : 96 : tree o2 = m2expr_BuildTruthAndIf (location, b3, b4);
1310 : :
1311 : 96 : tree o3 = m2expr_Build4TruthAndIf (location, c7, c8, c9, c10);
1312 : 96 : tree o4 = m2expr_Build4TruthAndIf (location, c7, c8, c11, c12);
1313 : :
1314 : 96 : tree a2 = m2expr_Build4TruthOrIf (location, o1, o2, o3, o4);
1315 : 96 : tree condition
1316 : 96 : = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, a1, a2));
1317 : :
1318 : 96 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1319 : : get_current_function_name (),
1320 : : "whole value unary minus will cause range overflow");
1321 : 96 : return t;
1322 : : }
1323 : :
1324 : : /* checkWholeAddOverflow - check to see whether op1 + op2 will
1325 : : overflow an integer.
1326 : :
1327 : : PROCEDURE sadd (i, j: INTEGER) ;
1328 : : BEGIN
1329 : : IF ((j>0) AND (i > MAX(INTEGER)-j)) OR ((j<0) AND (i < MIN(INTEGER)-j))
1330 : : THEN
1331 : : 'signed addition overflow'
1332 : : END
1333 : : END sadd. */
1334 : :
1335 : : static tree
1336 : 1552 : checkWholeAddOverflow (location_t location, tree i, tree j, tree lowest,
1337 : : tree min, tree max)
1338 : : {
1339 : 1552 : tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1340 : 1552 : tree i_gt_max_sub_j = m2expr_BuildGreaterThan (
1341 : : location, i, m2expr_BuildSub (location, max, j, false));
1342 : 1552 : tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1343 : 1552 : tree i_lt_min_sub_j = m2expr_BuildLessThan (location, i,
1344 : : m2expr_BuildSub (location, min, j, false));
1345 : 1552 : tree lhs_or = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, j_gt_zero, i_gt_max_sub_j));
1346 : 1552 : tree rhs_or = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, j_lt_zero, i_lt_min_sub_j));
1347 : 1552 : tree condition
1348 : 1552 : = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, lhs_or, rhs_or));
1349 : 1552 : tree result = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1350 : : get_current_function_name (),
1351 : : "whole value addition will cause a range overflow");
1352 : 1552 : return result;
1353 : : }
1354 : :
1355 : : /* checkWholeSubOverflow - check to see whether op1 - op2 will
1356 : : overflow an integer.
1357 : :
1358 : : PROCEDURE ssub (i, j: INTEGER) ;
1359 : : BEGIN
1360 : : IF ((j>0) AND (i < MIN(INTEGER)+j)) OR ((j<0) AND (i > MAX(INTEGER)+j))
1361 : : THEN
1362 : : 'signed subtraction overflow'
1363 : : END
1364 : : END ssub. */
1365 : :
1366 : : static tree
1367 : 944 : checkWholeSubOverflow (location_t location, tree i, tree j, tree lowest,
1368 : : tree min, tree max)
1369 : : {
1370 : 944 : tree c1 = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1371 : 944 : tree c2 = m2expr_BuildLessThan (location, i,
1372 : : m2expr_BuildAdd (location, min, j, false));
1373 : 944 : tree c3 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1374 : 944 : tree c4 = m2expr_BuildGreaterThan (location, i,
1375 : : m2expr_BuildAdd (location, max, j, false));
1376 : 944 : tree c5 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, c1, c2));
1377 : 944 : tree c6 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, c3, c4));
1378 : 944 : tree condition
1379 : 944 : = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, c5, c6));
1380 : 944 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1381 : : get_current_function_name (),
1382 : : "whole value subtraction will cause a range overflow");
1383 : 944 : return t;
1384 : : }
1385 : :
1386 : : /* Build4TruthAndIf - return true if a && b && c && d. Retain order left to
1387 : : * right. */
1388 : :
1389 : : static tree
1390 : 288 : m2expr_Build4TruthAndIf (location_t location, tree a, tree b, tree c, tree d)
1391 : : {
1392 : 288 : tree t1 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, a, b));
1393 : 288 : tree t2 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t1, c));
1394 : 288 : return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t2, d));
1395 : : }
1396 : :
1397 : : /* Build3TruthAndIf - return true if a && b && c. Retain order left to right.
1398 : : */
1399 : :
1400 : : static tree
1401 : 4036 : m2expr_Build3TruthAndIf (location_t location, tree op1, tree op2, tree op3)
1402 : : {
1403 : 4036 : tree t = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, op1, op2));
1404 : 4036 : return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location, t, op3));
1405 : : }
1406 : :
1407 : : /* Build3TruthOrIf - return true if a || b || c. Retain order left to right.
1408 : : */
1409 : :
1410 : : static tree
1411 : 140 : m2expr_Build3TruthOrIf (location_t location, tree op1, tree op2, tree op3)
1412 : : {
1413 : 140 : tree t = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, op1, op2));
1414 : 140 : return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t, op3));
1415 : : }
1416 : :
1417 : : /* Build4TruthOrIf - return true if op1 || op2 || op3 || op4. Retain order
1418 : : left to right. */
1419 : :
1420 : : static tree
1421 : 840 : m2expr_Build4TruthOrIf (location_t location, tree op1, tree op2, tree op3,
1422 : : tree op4)
1423 : : {
1424 : 840 : tree t1 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, op1, op2));
1425 : 840 : tree t2 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t1, op3));
1426 : 840 : return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location, t2, op4));
1427 : : }
1428 : :
1429 : : /* Build4LogicalOr - return true if op1 || op2 || op3 || op4. */
1430 : :
1431 : : static tree
1432 : 736 : m2expr_Build4LogicalOr (location_t location, tree op1, tree op2, tree op3,
1433 : : tree op4)
1434 : : {
1435 : 736 : tree t1 = m2expr_FoldAndStrip (
1436 : : m2expr_BuildLogicalOr (location, op1, op2, false));
1437 : 736 : tree t2
1438 : 736 : = m2expr_FoldAndStrip (m2expr_BuildLogicalOr (location, t1, op3, false));
1439 : 736 : return m2expr_FoldAndStrip (
1440 : 736 : m2expr_BuildLogicalOr (location, t2, op4, false));
1441 : : }
1442 : :
1443 : : /* checkWholeMultOverflow - check to see whether i * j will overflow
1444 : : an integer.
1445 : :
1446 : : PROCEDURE smult (lhs, rhs: INTEGER) ;
1447 : : BEGIN
1448 : : IF ((lhs > 0) AND (rhs > 0) AND (lhs > max DIV rhs)) OR
1449 : : ((lhs > 0) AND (rhs < 0) AND (rhs < min DIV lhs)) OR
1450 : : ((lhs < 0) AND (rhs > 0) AND (lhs < min DIV rhs)) OR
1451 : : ((lhs < 0) AND (rhs < 0) AND (lhs < max DIV rhs))
1452 : : THEN
1453 : : error ('signed multiplication overflow')
1454 : : END
1455 : : END smult ;
1456 : :
1457 : : if ((c1 && c3 && c4)
1458 : : || (c1 && c5 && c6)
1459 : : || (c2 && c3 && c7)
1460 : : || (c2 && c5 && c8))
1461 : : error ('signed subtraction overflow'). */
1462 : :
1463 : : static tree
1464 : 736 : testWholeMultOverflow (location_t location, tree lhs, tree rhs,
1465 : : tree lowest, tree min, tree max)
1466 : : {
1467 : 736 : tree c1 = m2expr_BuildGreaterThanZero (location, lhs, lowest, min, max);
1468 : 736 : tree c2 = m2expr_BuildLessThanZero (location, lhs, lowest, min, max);
1469 : :
1470 : 736 : tree c3 = m2expr_BuildGreaterThanZero (location, rhs, lowest, min, max);
1471 : 736 : tree c4 = m2expr_BuildGreaterThan (
1472 : : location, lhs, m2expr_BuildDivTrunc (location, max, rhs, false));
1473 : :
1474 : 736 : tree c5 = m2expr_BuildLessThanZero (location, rhs, lowest, min, max);
1475 : 736 : tree c6 = m2expr_BuildLessThan (
1476 : : location, rhs, m2expr_BuildDivTrunc (location, min, lhs, false));
1477 : 736 : tree c7 = m2expr_BuildLessThan (
1478 : : location, lhs, m2expr_BuildDivTrunc (location, min, rhs, false));
1479 : 736 : tree c8 = m2expr_BuildLessThan (
1480 : : location, lhs, m2expr_BuildDivTrunc (location, max, rhs, false));
1481 : :
1482 : 736 : tree c9 = m2expr_Build3TruthAndIf (location, c1, c3, c4);
1483 : 736 : tree c10 = m2expr_Build3TruthAndIf (location, c1, c5, c6);
1484 : 736 : tree c11 = m2expr_Build3TruthAndIf (location, c2, c3, c7);
1485 : 736 : tree c12 = m2expr_Build3TruthAndIf (location, c2, c5, c8);
1486 : :
1487 : 736 : tree condition = m2expr_Build4LogicalOr (location, c9, c10, c11, c12);
1488 : 736 : return condition;
1489 : : }
1490 : :
1491 : :
1492 : : static tree
1493 : 672 : checkWholeMultOverflow (location_t location, tree i, tree j, tree lowest,
1494 : : tree min, tree max)
1495 : : {
1496 : 672 : tree condition = testWholeMultOverflow (location, i, j, lowest, min, max);
1497 : 672 : tree result = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1498 : : get_current_function_name (),
1499 : : "whole value multiplication will cause a range overflow");
1500 : 672 : return result;
1501 : : }
1502 : :
1503 : :
1504 : : static tree
1505 : 32 : divMinUnderflow (location_t location, tree value, tree lowest, tree min, tree max)
1506 : : {
1507 : 32 : tree min2 = m2expr_BuildMult (location, min, min, false);
1508 : 32 : tree rhs = m2expr_BuildGreaterThanOrEqual (location, value, min2);
1509 : 32 : tree lhs = testWholeMultOverflow (location, min, min, lowest, min, max);
1510 : 32 : return m2expr_BuildTruthAndIf (location, lhs, rhs);
1511 : : }
1512 : :
1513 : : /*
1514 : : divexpr - returns true if a DIV_TRUNC b will overflow.
1515 : : */
1516 : :
1517 : : /* checkWholeDivOverflow - check to see whether i DIV_TRUNC j will overflow
1518 : : an integer. The Modula-2 implementation of the GCC trees follows:
1519 : :
1520 : : PROCEDURE divtruncexpr (a, b: INTEGER) : BOOLEAN ;
1521 : : BEGIN
1522 : : (* Firstly catch division by 0. *)
1523 : : RETURN ((b = 0) OR
1524 : : (* Case 2 range is always negative. *)
1525 : : (* In which case a division will be illegal as result will be positive. *)
1526 : : (max < 0) OR
1527 : : (* Case 1 both min / max are positive, check for underflow. *)
1528 : : ((min >= 0) AND (max >= 0) AND (multMinOverflow (b) OR (a < b * min))) OR
1529 : : (* Case 1 both min / max are positive, check for overflow. *)
1530 : : ((min >= 0) AND (max >= 0) AND (divMinUnderflow (a) OR (b > a DIV min))) OR
1531 : : (* Case 3 mixed range, need to check underflow. *)
1532 : : ((min < 0) AND (max >= 0) AND (a < 0) AND (b < 0) AND (b >= a DIV min)) OR
1533 : : ((min < 0) AND (max >= 0) AND (a < 0) AND (b > 0) AND (b <= a DIV max)) OR
1534 : : ((min < 0) AND (max >= 0) AND (a >= 0) AND (b < 0) AND (a DIV b < min)))
1535 : : END divtruncexpr ;
1536 : :
1537 : : s1 -> a DIV min
1538 : : s2 -> a DIV max
1539 : : s3 -> a DIV b
1540 : :
1541 : : b4 -> (min >= 0) AND (max >= 0)
1542 : : b5 -> (min < 0) AND (max >= 0)
1543 : : a_lt_b_mult_min -> (a < b * min)
1544 : : b_mult_min_overflow -> testWholeMultOverflow (location, b, min, lowest, min, max)
1545 : : b6 -> (b_mult_min_overflow OR a_lt_b_mult_min)
1546 : : b_gt_s1 -> (b > s1)
1547 : : a_div_min_overflow -> divMinUnderflow (location, a, min, lowest, min, max)
1548 : : b7 -> (a_div_min_overflow OR b_gt_s1)
1549 : : b8 -> (a < 0)
1550 : : b9 -> (b < 0)
1551 : : b10 -> (b > 0)
1552 : : b11 -> (b >= s1)
1553 : : b12 -> (b <= s2)
1554 : : b13 -> (s3 < min)
1555 : : b14 -> a >= 0
1556 : :
1557 : : c1 -> (b = 0)
1558 : : c2 -> (max < 0)
1559 : : c3 -> (b4 AND b6)
1560 : : c4 -> (b4 AND b7)
1561 : : c5 -> (b5 AND b8 AND b9 AND b11)
1562 : : c6 -> (b5 AND b8 AND b10 AND b12)
1563 : : c7 -> (b5 AND b14 AND b9 AND b13)
1564 : :
1565 : : if (c1 || c2 || c3 || c4 || c5 || c6 || c7)
1566 : : error ('signed div trunc overflow'). */
1567 : :
1568 : : static tree
1569 : 32 : checkWholeDivTruncOverflow (location_t location, tree i, tree j, tree lowest,
1570 : : tree min, tree max)
1571 : : {
1572 : 32 : tree b4a = m2expr_BuildGreaterThanOrEqualZero (location, min, lowest, min, max);
1573 : 32 : tree b4b = m2expr_BuildGreaterThanOrEqualZero (location, max, lowest, min, max);
1574 : 32 : tree b4 = m2expr_BuildTruthAndIf (location, b4a, b4b);
1575 : 32 : tree b5a = m2expr_BuildLessThanZero (location, min, lowest, min, max);
1576 : 32 : tree b5 = m2expr_BuildTruthAndIf (location, b5a, b4b);
1577 : 32 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
1578 : 32 : tree c2 = m2expr_BuildLessThanZero (location, max, lowest, min, max);
1579 : 32 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, m2expr_BuildMult (location, j, min, false));
1580 : 32 : tree j_mult_min_overflow = testWholeMultOverflow (location, j, min, lowest, min, max);
1581 : 32 : tree b6 = m2expr_BuildTruthOrIf (location, j_mult_min_overflow, i_lt_j_mult_min);
1582 : 32 : tree c3 = m2expr_BuildTruthAndIf (location, b4, b6);
1583 : 32 : tree s1 = m2expr_BuildDivTrunc (location, i, min, false);
1584 : 32 : tree s2 = m2expr_BuildDivTrunc (location, i, max, false);
1585 : 32 : tree s3 = m2expr_BuildDivTrunc (location, i, j, false);
1586 : :
1587 : 32 : tree j_gt_s1 = m2expr_BuildGreaterThan (location, j, s1);
1588 : 32 : tree i_div_min_overflow = divMinUnderflow (location, i, lowest, min, max);
1589 : 32 : tree b7 = m2expr_BuildTruthOrIf (location, i_div_min_overflow, j_gt_s1);
1590 : 32 : tree c4 = m2expr_BuildTruthAndIf (location, b4, b7);
1591 : 32 : tree b8 = m2expr_BuildLessThanZero (location, i, lowest, min, max);
1592 : 32 : tree b9 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1593 : 32 : tree b10 = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1594 : 32 : tree b11 = m2expr_BuildGreaterThanOrEqual (location, j, s1);
1595 : 32 : tree b12 = m2expr_BuildLessThanOrEqual (location, j, s2);
1596 : 32 : tree b13 = m2expr_BuildLessThan (location, s3, min);
1597 : 32 : tree b14 = m2expr_BuildGreaterThanOrEqualZero (location, i, lowest, min, max);
1598 : 32 : tree c5 = m2expr_Build4TruthAndIf (location, b5, b8, b9, b11);
1599 : 32 : tree c6 = m2expr_Build4TruthAndIf (location, b5, b8, b10, b12);
1600 : 32 : tree c7 = m2expr_Build4TruthAndIf (location, b5, b14, b9, b13);
1601 : 32 : tree c8 = m2expr_Build4TruthOrIf (location, c1, c2, c3, c4);
1602 : 32 : tree condition = m2expr_Build4TruthOrIf (location, c5, c6, c7, c8);
1603 : 32 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1604 : : get_current_function_name (),
1605 : : "whole value truncated division will cause a range overflow");
1606 : 32 : return t;
1607 : : }
1608 : :
1609 : : #if 0
1610 : : (*
1611 : : divexpr - returns true if a DIV_CEIL b will overflow.
1612 : : *)
1613 : :
1614 : : (* checkWholeDivCeilOverflow - check to see whether i DIV_CEIL j will overflow
1615 : : an integer. *)
1616 : :
1617 : : PROCEDURE divceilexpr (i, j: INTEGER) : BOOLEAN ;
1618 : : BEGIN
1619 : : RETURN ((j = 0) OR (* division by zero. *)
1620 : : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
1621 : : therefore error. *)
1622 : : ((i # 0) AND (* first operand is legally zero,
1623 : : result is also legally zero. *)
1624 : : divCeilOverflowCases (i, j)))
1625 : : END divceilexpr ;
1626 : :
1627 : :
1628 : : (*
1629 : : divCeilOverflowCases - precondition: i, j are in range values.
1630 : : postcondition: true is returned if i divceil will
1631 : : result in an overflow/underflow.
1632 : : *)
1633 : :
1634 : : PROCEDURE divCeilOverflowCases (i, j: INTEGER) : BOOLEAN ;
1635 : : BEGIN
1636 : : RETURN (((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j)) OR
1637 : : ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j)) OR
1638 : : ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j)) OR
1639 : : ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j)))
1640 : : END divCeilOverflowCases ;
1641 : :
1642 : :
1643 : : (*
1644 : : divCeilOverflowPosPos - precondition: i, j are legal and are both >= 0.
1645 : : postcondition: true is returned if i divceil will
1646 : : result in an overflow/underflow.
1647 : : *)
1648 : :
1649 : : PROCEDURE divCeilOverflowPosPos (i, j: INTEGER) : BOOLEAN ;
1650 : : BEGIN
1651 : : RETURN (((i MOD j = 0) AND (i < j * minT)) OR
1652 : : (((i MOD j # 0) AND (i < j * minT + 1))))
1653 : : END divCeilOverflowPosPos ;
1654 : :
1655 : :
1656 : : (*
1657 : : divCeilOverflowNegNeg - precondition: i, j are in range values and both < 0.
1658 : : postcondition: true is returned if i divceil will
1659 : : result in an overflow/underflow.
1660 : : *)
1661 : :
1662 : : PROCEDURE divCeilOverflowNegNeg (i, j: INTEGER) : BOOLEAN ;
1663 : : BEGIN
1664 : : RETURN ((maxT <= 0) OR (* signs will cause overflow. *)
1665 : : (* check for underflow. *)
1666 : : ((ABS (i) MOD ABS (j) = 0) AND (i >= j * minT)) OR
1667 : : ((ABS (i) MOD ABS (j) # 0) AND (i >= j * minT - 1)) OR
1668 : : (* check for overflow. *)
1669 : : (((ABS (i) MOD maxT) = 0) AND (ABS (i) DIV maxT > ABS (j))) OR
1670 : : (((ABS (i) MOD maxT) # 0) AND (ABS (i) DIV maxT > ABS (j) + 1)))
1671 : : END divCeilOverflowNegNeg ;
1672 : :
1673 : :
1674 : : (*
1675 : : divCeilOverflowNegPos - precondition: i, j are in range values. i < 0, j >= 0.
1676 : : postcondition: true is returned if i divceil will
1677 : : result in an overflow/underflow.
1678 : : *)
1679 : :
1680 : : PROCEDURE divCeilOverflowNegPos (i, j: INTEGER) : BOOLEAN ;
1681 : : BEGIN
1682 : : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
1683 : : We know the result will be negative and therefore we only need to test
1684 : : against minT. *)
1685 : : RETURN (((ABS (i) MOD j = 0) AND (i < j * minT)) OR
1686 : : ((ABS (i) MOD j # 0) AND (i < j * minT - 1)))
1687 : : END divCeilOverflowNegPos ;
1688 : :
1689 : :
1690 : : (*
1691 : : divCeilOverflowPosNeg - precondition: i, j are in range values. i >= 0, j < 0.
1692 : : postcondition: true is returned if i divceil will
1693 : : result in an overflow/underflow.
1694 : : *)
1695 : :
1696 : : PROCEDURE divCeilOverflowPosNeg (i, j: INTEGER) : BOOLEAN ;
1697 : : BEGIN
1698 : : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
1699 : : We know the result will be negative and therefore we only need to test
1700 : : against minT. *)
1701 : : RETURN (((i MOD ABS (j) = 0) AND (i > j * minT)) OR
1702 : : ((i MOD ABS (j) # 0) AND (i > j * minT - 1)))
1703 : : END divCeilOverflowPosNeg ;
1704 : : #endif
1705 : :
1706 : : /* divCeilOverflowPosPos, precondition: lhs, rhs are legal and are both >= 0.
1707 : : Postcondition: TRUE is returned if lhs divceil rhs will result
1708 : : in an overflow/underflow.
1709 : :
1710 : : A handbuilt expression of trees implementing:
1711 : :
1712 : : RETURN (((lhs MOD rhs = 0) AND (min >= 0) AND (lhs < rhs * min)) OR (* check for underflow, no remainder. *)
1713 : : lhs_lt_rhs_mult_min
1714 : : (((lhs MOD rhs # 0) AND (lhs < rhs * min + 1)))) (* check for underflow with remainder. *)
1715 : : ((lhs > min) AND (lhs - 1 > rhs * min))
1716 : : lhs_gt_rhs_mult_min
1717 : :
1718 : : a -> (lhs MOD rhs = 0) AND (lhs < rhs * min)
1719 : : b -> (lhs MOD rhs # 0) AND (lhs < rhs * min + 1)
1720 : : RETURN a OR b. */
1721 : :
1722 : : static tree
1723 : 136 : divCeilOverflowPosPos (location_t location, tree i, tree j, tree lowest,
1724 : : tree min, tree max)
1725 : : {
1726 : 136 : tree i_mod_j = m2expr_BuildModTrunc (location, i, j, false);
1727 : 136 : tree i_mod_j_eq_zero = m2expr_BuildEqualToZero (location, i_mod_j, lowest, min, max);
1728 : 136 : tree i_mod_j_ne_zero = m2expr_BuildNotEqualToZero (location, i_mod_j, lowest, min, max);
1729 : 136 : tree j_min = m2expr_BuildMult (location, j, min, false);
1730 : 136 : tree j_min_1 = m2expr_BuildAdd (location, j_min, m2expr_GetIntegerOne (location), false);
1731 : 136 : tree i_lt_j_min = m2expr_BuildLessThan (location, i, j_min);
1732 : 136 : tree i_lt_j_min_1 = m2expr_BuildLessThan (location, i, j_min_1);
1733 : 136 : tree a = m2expr_BuildTruthAndIf (location, i_mod_j_eq_zero, i_lt_j_min);
1734 : 136 : tree b = m2expr_BuildTruthAndIf (location, i_mod_j_ne_zero, i_lt_j_min_1);
1735 : 136 : return m2expr_BuildTruthOrIf (location, a, b);
1736 : : }
1737 : :
1738 : :
1739 : : /* divCeilOverflowPosNeg precondition: i, j are in range values and i >=0, j < 0.
1740 : : Postcondition: TRUE is returned if i divceil j will result in an
1741 : : overflow/underflow.
1742 : :
1743 : : A handbuilt expression of trees implementing:
1744 : :
1745 : : RETURN (((i MOD ABS (j) = 0) AND (i > j * min)) OR
1746 : : ((i MOD ABS (j) # 0) AND (i > j * min - 1)))
1747 : :
1748 : : abs_j -> (ABS (j))
1749 : : i_mod_abs_j -> (i MOD abs_j)
1750 : : i_mod_abs_j_eq_0 -> (i_mod_abs_j = 0)
1751 : : i_mod_abs_j_ne_0 -> (i_mod_abs_j # 0)
1752 : : j_mult_min -> (j * min)
1753 : : j_mult_min_1 -> (j_mult_min - 1)
1754 : : i_gt_j_mult_min -> (i > j_mult_min)
1755 : : i_gt_j_mult_min_1 -> (i > j_mult_min_1)
1756 : : a -> (i_mod_abs_j_eq_0 AND i_gt_j_mult_min)
1757 : : b -> (i_mod_abs_j_ne_0 AND i_gt_j_mult_min_1)
1758 : : c -> (a OR b). */
1759 : :
1760 : : static tree
1761 : 136 : divCeilOverflowPosNeg (location_t location, tree i, tree j, tree lowest, tree min, tree max)
1762 : : {
1763 : 136 : tree abs_j = m2expr_BuildAbs (location, j);
1764 : 136 : tree i_mod_abs_j = m2expr_BuildModFloor (location, i, abs_j, false);
1765 : 136 : tree i_mod_abs_j_eq_0 = m2expr_BuildEqualToZero (location, i_mod_abs_j, lowest, min, max);
1766 : 136 : tree i_mod_abs_j_ne_0 = m2expr_BuildNotEqualToZero (location, i_mod_abs_j, lowest, min, max);
1767 : 136 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
1768 : 136 : tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
1769 : 136 : tree i_gt_j_mult_min = m2expr_BuildGreaterThan (location, i, j_mult_min);
1770 : 136 : tree i_gt_j_mult_min_1 = m2expr_BuildGreaterThan (location, i, j_mult_min_1);
1771 : 136 : tree a = m2expr_BuildTruthAndIf (location, i_mod_abs_j_eq_0, i_gt_j_mult_min);
1772 : 136 : tree b = m2expr_BuildTruthAndIf (location, i_mod_abs_j_ne_0, i_gt_j_mult_min_1);
1773 : 136 : tree c = m2expr_BuildTruthOrIf (location, a, b);
1774 : 136 : return c;
1775 : : }
1776 : :
1777 : :
1778 : : /* divCeilOverflowNegPos precondition: i, j are in range values and i < 0, j >= 0.
1779 : : Postcondition: TRUE is returned if i divceil j will result in an
1780 : : overflow/underflow.
1781 : :
1782 : : A handbuilt expression of trees implementing:
1783 : :
1784 : : RETURN (((ABS (i) MOD j = 0) AND (i < j * min)) OR
1785 : : ((ABS (i) MOD j # 0) AND (i < j * min - 1)))
1786 : :
1787 : : abs_i -> (ABS (i))
1788 : : abs_i_mod_j -> (abs_i MOD j)
1789 : : abs_i_mod_j_eq_0 -> (abs_i_mod_j = 0)
1790 : : abs_i_mod_j_ne_0 -> (abs_i_mod_j # 0)
1791 : : j_mult_min -> (j * min)
1792 : : j_mult_min_1 -> (j_mult_min - 1)
1793 : : i_lt_j_mult_min -> (i < j_mult_min)
1794 : : i_lt_j_mult_min_1 -> (i < j_mult_min_1)
1795 : : a = (abs_i_mod_j_eq_0 AND i_lt_j_mult_min)
1796 : : b = (abs_i_mod_j_ne_0 AND i_lt_j_mult_min_1)
1797 : : c -> (a OR b). */
1798 : :
1799 : : static tree
1800 : 136 : divCeilOverflowNegPos (location_t location, tree i, tree j, tree lowest, tree min, tree max)
1801 : : {
1802 : 136 : tree abs_i = m2expr_BuildAbs (location, i);
1803 : 136 : tree abs_i_mod_j = m2expr_BuildModFloor (location, abs_i, j, false);
1804 : 136 : tree abs_i_mod_j_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_j, lowest, min, max);
1805 : 136 : tree abs_i_mod_j_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_j, lowest, min, max);
1806 : 136 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
1807 : 136 : tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
1808 : 136 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
1809 : 136 : tree i_lt_j_mult_min_1 = m2expr_BuildLessThan (location, i, j_mult_min_1);
1810 : 136 : tree a = m2expr_BuildTruthAndIf (location, abs_i_mod_j_eq_0, i_lt_j_mult_min);
1811 : 136 : tree b = m2expr_BuildTruthAndIf (location, abs_i_mod_j_ne_0, i_lt_j_mult_min_1);
1812 : 136 : tree c = m2expr_BuildTruthOrIf (location, a, b);
1813 : 136 : return c;
1814 : : }
1815 : :
1816 : :
1817 : : /* divCeilOverflowNegNeg precondition: i, j are in range values and both < 0.
1818 : : Postcondition: TRUE is returned if i divceil j will result in an
1819 : : overflow/underflow.
1820 : :
1821 : : A handbuilt expression of trees implementing:
1822 : :
1823 : : RETURN ((max <= 0) OR (* signs will cause overflow. *)
1824 : : (* check for underflow. *)
1825 : : ((ABS (i) MOD ABS (j) = 0) AND (i >= j * min)) OR
1826 : : ((ABS (i) MOD ABS (j) # 0) AND (i >= j * min - 1)) OR
1827 : : (* check for overflow. *)
1828 : : (((ABS (i) MOD max) = 0) AND (ABS (i) DIV max > ABS (j))) OR
1829 : : (((ABS (i) MOD max) # 0) AND (ABS (i) DIV max > ABS (j) + 1)))
1830 : :
1831 : : max_lte_0 -> (max <= 0)
1832 : : abs_i -> (ABS (i))
1833 : : abs_j -> (ABS (j))
1834 : : abs_i_mod_abs_j -> (abs_i MOD abs_j)
1835 : : abs_i_mod_abs_j_eq_0 -> (abs_i_mod_abs_j = 0)
1836 : : abs_i_mod_abs_j_ne_0 -> (abs_i_mod_abs_j # 0)
1837 : : j_mult_min -> (j * min)
1838 : : j_mult_min_1 -> (j_mult_min - 1)
1839 : : i_ge_j_mult_min -> (i >= j_mult_min)
1840 : : i_ge_j_mult_min_1 -> (i >= j_mult_min_1)
1841 : : abs_i_mod_max -> (abs_i mod max)
1842 : : abs_i_div_max -> (abs_i DIVfloor max)
1843 : : abs_j_1 -> (abs_j + 1)
1844 : : abs_i_mod_max_eq_0 -> (abs_i_mod_max = 0)
1845 : : abs_i_mod_max_ne_0 -> (abs_i_mod_max # 0)
1846 : : abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
1847 : : abs_i_div_max_gt_abs_j_1 -> (abs_i_div_max > abs_j_1)
1848 : :
1849 : : a -> (abs_i_mod_abs_j_eq_0 AND i_ge_j_mult_min)
1850 : : b -> (abs_i_mod_abs_j_ne_0 AND i_ge_j_mult_min_1)
1851 : : c -> (abs_i_mod_max_eq_0 AND abs_i_div_max_gt_abs_j)
1852 : : d -> (abs_i_mod_max_ne_0 AND abs_i_div_max_gt_abs_j_1)
1853 : : e -> (a OR b OR c OR d)
1854 : : return max_lte_0 OR e. */
1855 : :
1856 : : static tree
1857 : 136 : divCeilOverflowNegNeg (location_t location, tree i, tree j, tree lowest,
1858 : : tree min, tree max)
1859 : : {
1860 : 136 : tree max_lte_0 = m2expr_BuildLessThanOrEqualZero (location, max, lowest, min, max);
1861 : 136 : tree abs_i = m2expr_BuildAbs (location, i);
1862 : 136 : tree abs_j = m2expr_BuildAbs (location, j);
1863 : 136 : tree abs_i_mod_abs_j = m2expr_BuildModFloor (location, abs_i, abs_j, false);
1864 : 136 : tree abs_i_mod_abs_j_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_abs_j,
1865 : : lowest, min, max);
1866 : 136 : tree abs_i_mod_abs_j_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_abs_j,
1867 : : lowest, min, max);
1868 : 136 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
1869 : 136 : tree j_mult_min_1 = m2expr_BuildPostDec (location, j_mult_min);
1870 : 136 : tree i_ge_j_mult_min = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min);
1871 : 136 : tree i_ge_j_mult_min_1 = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min_1);
1872 : 136 : tree abs_i_mod_max = m2expr_BuildModFloor (location, abs_i, max, false);
1873 : 136 : tree abs_i_div_max = m2expr_BuildDivFloor (location, abs_i, max, false);
1874 : 136 : tree abs_j_1 = m2expr_BuildPostInc (location, abs_j);
1875 : 136 : tree abs_i_mod_max_eq_0 = m2expr_BuildEqualToZero (location, abs_i_mod_max, lowest, min, max);
1876 : 136 : tree abs_i_mod_max_ne_0 = m2expr_BuildNotEqualToZero (location, abs_i_mod_max, lowest, min, max);
1877 : 136 : tree abs_i_div_max_gt_abs_j = m2expr_BuildGreaterThan (location, abs_i_div_max, abs_j);
1878 : 136 : tree abs_i_div_max_gt_abs_j_1 = m2expr_BuildGreaterThan (location, abs_i_div_max, abs_j_1);
1879 : :
1880 : 136 : tree a = m2expr_BuildTruthAndIf (location, abs_i_mod_abs_j_eq_0, i_ge_j_mult_min);
1881 : 136 : tree b = m2expr_BuildTruthAndIf (location, abs_i_mod_abs_j_ne_0, i_ge_j_mult_min_1);
1882 : 136 : tree c = m2expr_BuildTruthAndIf (location, abs_i_mod_max_eq_0, abs_i_div_max_gt_abs_j);
1883 : 136 : tree d = m2expr_BuildTruthAndIf (location, abs_i_mod_max_ne_0, abs_i_div_max_gt_abs_j_1);
1884 : 136 : tree e = m2expr_Build4TruthOrIf (location, a, b, c, d);
1885 : 136 : return m2expr_BuildTruthOrIf (location, max_lte_0, e);
1886 : : }
1887 : :
1888 : :
1889 : : /* divCeilOverflowCases, precondition: i, j are in range values.
1890 : : Postcondition: TRUE is returned if i divceil will result in an
1891 : : overflow/underflow.
1892 : :
1893 : : A handbuilt expression of trees implementing:
1894 : :
1895 : : RETURN (((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j)) OR
1896 : : ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j)) OR
1897 : : ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j)) OR
1898 : : ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j)))
1899 : :
1900 : : a -> ((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j))
1901 : : b -> ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j))
1902 : : c -> ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j))
1903 : : d -> ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j))
1904 : :
1905 : : RETURN a AND b AND c AND d. */
1906 : :
1907 : : static tree
1908 : 136 : divCeilOverflowCases (location_t location, tree i, tree j, tree lowest,
1909 : : tree min, tree max)
1910 : : {
1911 : 136 : tree i_gt_zero = m2expr_BuildGreaterThanZero (location, i, lowest, min, max);
1912 : 136 : tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
1913 : 136 : tree i_lt_zero = m2expr_BuildLessThanZero (location, i, lowest, min, max);
1914 : 136 : tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
1915 : 136 : tree a = m2expr_Build3TruthAndIf (location, i_gt_zero, j_gt_zero,
1916 : : divCeilOverflowPosPos (location, i, j, lowest, min, max));
1917 : 136 : tree b = m2expr_Build3TruthAndIf (location, i_lt_zero, j_lt_zero,
1918 : : divCeilOverflowNegNeg (location, i, j, lowest, min, max));
1919 : 136 : tree c = m2expr_Build3TruthAndIf (location, i_gt_zero, j_lt_zero,
1920 : : divCeilOverflowPosNeg (location, i, j, lowest, min, max));
1921 : 136 : tree d = m2expr_Build3TruthAndIf (location, i_lt_zero, j_gt_zero,
1922 : : divCeilOverflowNegPos (location, i, j, lowest, min, max));
1923 : 136 : return m2expr_Build4TruthOrIf (location, a, b, c, d);
1924 : : }
1925 : :
1926 : :
1927 : : /* checkWholeDivCeilOverflow check to see whether i DIV_CEIL j will overflow
1928 : : an integer. A handbuilt expression of trees implementing:
1929 : :
1930 : : RETURN ((j = 0) OR (* division by zero. *)
1931 : : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
1932 : : therefore error. *)
1933 : : ((i # 0) AND (* first operand is legally zero,
1934 : : result is also legally zero. *)
1935 : : divCeilOverflowCases (i, j)))
1936 : :
1937 : : using the following subexpressions:
1938 : :
1939 : : j_eq_zero -> (j == 0)
1940 : : max_lt_zero -> (max < 0)
1941 : : i_ne_zero -> (i # 0). */
1942 : :
1943 : : static tree
1944 : 136 : checkWholeDivCeilOverflow (location_t location, tree i, tree j, tree lowest,
1945 : : tree min, tree max)
1946 : : {
1947 : 136 : tree j_eq_zero = m2expr_BuildEqualToZero (location, j, lowest, min, max);
1948 : 136 : tree max_lt_zero = m2expr_BuildLessThanZero (location, max, lowest, min, max);
1949 : 136 : tree i_ne_zero = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
1950 : 136 : tree j_lt_zero;
1951 : 136 : tree rhs = m2expr_BuildTruthAndIf (location,
1952 : : i_ne_zero,
1953 : : divCeilOverflowCases (location,
1954 : : i, j, lowest, min, max));
1955 : :
1956 : 136 : if (M2Options_GetISO ())
1957 : 136 : j_lt_zero = m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location, j, lowest, min, max));
1958 : : else
1959 : 0 : j_lt_zero = m2expr_GetIntegerZero (location);
1960 : 136 : j_eq_zero = m2expr_FoldAndStrip (j_eq_zero);
1961 : 136 : max_lt_zero = m2expr_FoldAndStrip (max_lt_zero);
1962 : 136 : i_ne_zero = m2expr_FoldAndStrip (i_ne_zero);
1963 : 136 : rhs = m2expr_FoldAndStrip (rhs);
1964 : :
1965 : 136 : tree condition = m2expr_Build4TruthOrIf (location, j_eq_zero, max_lt_zero, rhs, j_lt_zero);
1966 : 136 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
1967 : : get_current_function_name (),
1968 : : "whole value ceil division will cause a range overflow");
1969 : 136 : return t;
1970 : : }
1971 : :
1972 : :
1973 : : /* checkWholeModTruncOverflow, the GCC tree.def defines TRUNC_MOD_EXPR to return
1974 : : the remainder which has the same sign as the dividend. In ISO Modula-2 the
1975 : : divisor must never be negative (or zero). The pseudo code for implementing these
1976 : : checks is given below:
1977 : :
1978 : : IF j = 0
1979 : : THEN
1980 : : RETURN TRUE (* division by zero. *)
1981 : : ELSIF j < 0
1982 : : THEN
1983 : : RETURN TRUE (* modulus and division by negative (rhs) not allowed in ISO Modula-2. *)
1984 : : ELSIF i = 0
1985 : : THEN
1986 : : RETURN FALSE (* must be legal as result is same as operand. *)
1987 : : ELSIF i > 0
1988 : : THEN
1989 : : (* test for: i MOD j < minT *)
1990 : : IF j > i
1991 : : THEN
1992 : : RETURN FALSE
1993 : : END ;
1994 : : RETURN i - ((i DIV j) * j) < minT
1995 : : ELSIF i < 0
1996 : : THEN
1997 : : (* the result will always be positive and less than i, given that j is less than zero
1998 : : we know that minT must be < 0 as well and therefore the result of i MOD j will
1999 : : never underflow. *)
2000 : : RETURN FALSE
2001 : : END ;
2002 : : RETURN FALSE
2003 : :
2004 : : which can be converted into a large expression:
2005 : :
2006 : : RETURN (j = 0) OR ((j < 0) AND ISO) OR
2007 : : ((i # 0) AND (j <= i) AND (i - ((i DIVtrunc j) * j) < minT)
2008 : :
2009 : : and into GCC trees:
2010 : :
2011 : : c1 -> (j = 0)
2012 : : c2 -> (j < 0) (* only called from ISO or PIM4 or -fpositive-mod-floor *)
2013 : : c3 -> (i # 0)
2014 : : c4 -> (j <= i)
2015 : : c6 -> (i DIVtrunc j)
2016 : : c7 -> (i - (c6 * j))
2017 : : c5 -> c7 < minT
2018 : :
2019 : : t -> (c1 OR c2 OR
2020 : : (c3 AND c4 AND c5)). */
2021 : :
2022 : : static tree
2023 : 4 : checkWholeModTruncOverflow (location_t location, tree i, tree j, tree lowest,
2024 : : tree min, tree max)
2025 : : {
2026 : 4 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
2027 : 4 : tree c2 = m2expr_BuildLessThanZero (location, j, lowest, min, max);
2028 : 4 : tree c3 = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
2029 : 4 : tree c4 = m2expr_BuildLessThanOrEqual (location, j, i);
2030 : 4 : tree c6 = m2expr_BuildDivTrunc (location, i, j, false);
2031 : 4 : tree c7 = m2expr_BuildSub (location, i, m2expr_BuildMult (location, c6, j, false), false);
2032 : 4 : tree c5 = m2expr_BuildLessThan (location, c7, min);
2033 : 4 : tree c8 = m2expr_Build3TruthAndIf (location, c3, c4, c5);
2034 : 4 : tree condition = m2expr_Build3TruthOrIf (location, c1, c2, c8);
2035 : 4 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
2036 : : get_current_function_name (),
2037 : : "whole value trunc modulus will cause a range overflow");
2038 : 4 : return t;
2039 : : }
2040 : :
2041 : :
2042 : : /* checkWholeModCeilOverflow, the GCC tree.def defines CEIL_MOD_EXPR to return
2043 : : the remainder which has the same opposite of the divisor. In gm2 this is
2044 : : only called when the divisor is negative. The pseudo code for implementing
2045 : : these checks is given below:
2046 : :
2047 : : IF j = 0
2048 : : THEN
2049 : : RETURN TRUE (* division by zero. *)
2050 : : END ;
2051 : : t := i - j * divceil (i, j) ;
2052 : : printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
2053 : : t, i, j, i, j, divceil (i, j));
2054 : : RETURN NOT ((t >= minT) AND (t <= maxT))
2055 : :
2056 : : which can be converted into the expression:
2057 : :
2058 : : t := i - j * divceil (i, j) ;
2059 : : RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
2060 : :
2061 : : and into GCC trees:
2062 : :
2063 : : c1 -> (j = 0)
2064 : : c2 -> (i - j)
2065 : : c3 -> (i DIVceil j)
2066 : : t -> (c2 * c3)
2067 : : c4 -> (t >= minT)
2068 : : c5 -> (t <= maxT)
2069 : : c6 -> (c4 AND c5)
2070 : : c7 -> (NOT c6)
2071 : : c8 -> (c1 OR c7)
2072 : : return c8. */
2073 : :
2074 : : static tree
2075 : 64 : checkWholeModCeilOverflow (location_t location,
2076 : : tree i, tree j, tree lowest,
2077 : : tree min, tree max)
2078 : : {
2079 : 64 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
2080 : 64 : tree c2 = m2expr_BuildSub (location, i, j, false);
2081 : 64 : tree c3 = m2expr_BuildDivCeil (location, i, j, false);
2082 : 64 : tree t = m2expr_BuildMult (location, c2, c3, false);
2083 : 64 : tree c4 = m2expr_BuildGreaterThanOrEqual (location, t, min);
2084 : 64 : tree c5 = m2expr_BuildLessThanOrEqual (location, t, max);
2085 : 64 : tree c6 = m2expr_BuildTruthAndIf (location, c4, c5);
2086 : 64 : tree c7 = m2expr_BuildTruthNot (location, c6);
2087 : 64 : tree condition = m2expr_BuildTruthOrIf (location, c1, c7);
2088 : 64 : tree s = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
2089 : : get_current_function_name (),
2090 : : "whole value ceil modulus will cause a range overflow");
2091 : 64 : return s;
2092 : : }
2093 : :
2094 : :
2095 : : /* checkWholeModFloorOverflow, the GCC tree.def defines FLOOR_MOD_EXPR to return
2096 : : the remainder which has the same sign as the divisor. In gm2 this is
2097 : : only called when the divisor is positive. The pseudo code for implementing
2098 : : these checks is given below:
2099 : :
2100 : : IF j = 0
2101 : : THEN
2102 : : RETURN TRUE (* division by zero. *)
2103 : : END ;
2104 : : t := i - j * divfloor (i, j) ;
2105 : : printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
2106 : : t, i, j, i, j, divfloor (i, j));
2107 : : RETURN NOT ((t >= minT) AND (t <= maxT))
2108 : :
2109 : : which can be converted into the expression:
2110 : :
2111 : : t := i - j * divfloor (i, j) ;
2112 : : RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
2113 : :
2114 : : and into GCC trees:
2115 : :
2116 : : c1 -> (j = 0)
2117 : : c2 -> (i - j)
2118 : : c3 -> (i DIVfloor j)
2119 : : t -> (c2 * c3)
2120 : : c4 -> (t >= minT)
2121 : : c5 -> (t <= maxT)
2122 : : c6 -> (c4 AND c5)
2123 : : c7 -> (NOT c6)
2124 : : c8 -> (c1 OR c7)
2125 : : return c8. */
2126 : :
2127 : : static tree
2128 : 64 : checkWholeModFloorOverflow (location_t location,
2129 : : tree i, tree j, tree lowest,
2130 : : tree min, tree max)
2131 : : {
2132 : 64 : tree c1 = m2expr_BuildEqualToZero (location, j, lowest, min, max);
2133 : 64 : tree c2 = m2expr_BuildSub (location, i, j, false);
2134 : 64 : tree c3 = m2expr_BuildDivFloor (location, i, j, false);
2135 : 64 : tree t = m2expr_BuildMult (location, c2, c3, false);
2136 : 64 : tree c4 = m2expr_BuildGreaterThanOrEqual (location, t, min);
2137 : 64 : tree c5 = m2expr_BuildLessThanOrEqual (location, t, max);
2138 : 64 : tree c6 = m2expr_BuildTruthAndIf (location, c4, c5);
2139 : 64 : tree c7 = m2expr_BuildTruthNot (location, c6);
2140 : 64 : tree condition = m2expr_BuildTruthOrIf (location, c1, c7);
2141 : 64 : tree s = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
2142 : : get_current_function_name (),
2143 : : "whole value floor modulus will cause a range overflow");
2144 : 64 : return s;
2145 : : }
2146 : :
2147 : :
2148 : : #if 0
2149 : : /* The following is a Modula-2 implementation of the C tree node code
2150 : : this code has been hand translated into GCC trees. */
2151 : :
2152 : : (*
2153 : : divFloorOverflow2 - returns true if an overflow will occur
2154 : : if i divfloor j is performed.
2155 : : *)
2156 : :
2157 : : PROCEDURE divFloorOverflow (i, j: INTEGER) : BOOLEAN ;
2158 : : BEGIN
2159 : : RETURN ((j = 0) OR (* division by zero. *)
2160 : : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
2161 : : therefore error. *)
2162 : : (* --fixme-- remember here to also check
2163 : : if ISO M2 dialect and j < 0
2164 : : which will also generate an error. *)
2165 : : ((i # 0) AND (* first operand is legally zero,
2166 : : result is also legally zero. *)
2167 : : divFloorOverflowCases (i, j)))
2168 : : END divFloorOverflow ;
2169 : :
2170 : :
2171 : : (*
2172 : : divFloorOverflowCases - precondition: i, j are in range values.
2173 : : postcondition: true is returned if i divfloor will
2174 : : result in an overflow/underflow.
2175 : : *)
2176 : :
2177 : : PROCEDURE divFloorOverflowCases (i, j: INTEGER) : BOOLEAN ;
2178 : : BEGIN
2179 : : RETURN (((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j)) OR
2180 : : ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j)) OR
2181 : : ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j)) OR
2182 : : ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j)))
2183 : : END divFloorOverflowCases ;
2184 : :
2185 : :
2186 : : (*
2187 : : divFloorOverflowPosPos - precondition: lhs, rhs are legal and are both >= 0.
2188 : : postcondition: true is returned if lhs divfloor rhs will
2189 : : result in an overflow/underflow.
2190 : : *)
2191 : :
2192 : : PROCEDURE divFloorOverflowPosPos (lhs, rhs: INTEGER) : BOOLEAN ;
2193 : : BEGIN
2194 : : RETURN multMinOverflow (rhs) OR (lhs < rhs * min)
2195 : : END divFloorOverflowPosPos ;
2196 : :
2197 : :
2198 : : (*
2199 : : divFloorOverflowNegNeg - precondition: i, j are in range values and both < 0.
2200 : : postcondition: true is returned if i divfloor will
2201 : : result in an overflow/underflow.
2202 : : *)
2203 : :
2204 : : PROCEDURE divFloorOverflowNegNeg (i, j: INTEGER) : BOOLEAN ;
2205 : : BEGIN
2206 : : RETURN ((maxT <= 0) OR (* signs will cause overflow. *)
2207 : : (* check for underflow. *)
2208 : : (i >= j * minT) OR
2209 : : (* check for overflow. *)
2210 : : (ABS (i) DIV maxT > ABS (j)))
2211 : : END divFloorOverflowNegNeg ;
2212 : :
2213 : :
2214 : : (*
2215 : : divFloorOverflowNegPos - precondition: i, j are in range values. i < 0, j >= 0.
2216 : : postcondition: true is returned if i divfloor will
2217 : : result in an overflow/underflow.
2218 : : *)
2219 : :
2220 : : PROCEDURE divFloorOverflowNegPos (i, j: INTEGER) : BOOLEAN ;
2221 : : BEGIN
2222 : : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
2223 : : We know the result will be negative and therefore we only need to test
2224 : : against minT. *)
2225 : : RETURN i < j * minT
2226 : : END divFloorOverflowNegPos ;
2227 : :
2228 : :
2229 : : (*
2230 : : divFloorOverflowPosNeg - precondition: i, j are in range values. i >= 0, j < 0.
2231 : : postcondition: true is returned if i divfloor will
2232 : : result in an overflow/underflow.
2233 : : *)
2234 : :
2235 : : PROCEDURE divFloorOverflowPosNeg (i, j: INTEGER) : BOOLEAN ;
2236 : : BEGIN
2237 : : (* easier than might be initially expected. We know minT < 0 and maxT > 0.
2238 : : We know the result will be negative and therefore we only need to test
2239 : : against minT. *)
2240 : : RETURN i >= j * minT - j (* is safer than i > j * minT -1 *)
2241 : : END divFloorOverflowPosNeg ;
2242 : : #endif
2243 : :
2244 : :
2245 : : /* divFloorOverflowPosPos, precondition: i, j are legal and are both >= 0.
2246 : : Postcondition: true is returned if i divfloor will result in an overflow/underflow.
2247 : :
2248 : : A handbuilt expression of trees implementing:
2249 : :
2250 : : RETURN i < j * min
2251 : :
2252 : : j_mult_min -> (j * min)
2253 : : RETURN i < j_mult_min. */
2254 : :
2255 : : static tree
2256 : 136 : divFloorOverflowPosPos (location_t location, tree i, tree j, tree min)
2257 : : {
2258 : 136 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2259 : 136 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
2260 : 136 : return i_lt_j_mult_min;
2261 : : }
2262 : :
2263 : :
2264 : : /* divFloorOverflowNegNeg precondition: i, j are in range values and both < 0.
2265 : : Postcondition: true is returned if i divfloor j will result in an
2266 : : overflow/underflow.
2267 : :
2268 : : A handbuilt expression of trees implementing:
2269 : :
2270 : : RETURN ((maxT <= 0) OR (* signs will cause overflow. *)
2271 : : (* check for underflow. *)
2272 : : (i >= j * min) OR
2273 : : (* check for overflow. *)
2274 : : (ABS (i) DIV max > ABS (j)))
2275 : :
2276 : : max_lte_0 -> (max <= 0)
2277 : : abs_i -> (ABS (i))
2278 : : abs_j -> (ABS (j))
2279 : : j_mult_min -> (j * min)
2280 : : i_ge_j_mult_min -> (i >= j_mult_min)
2281 : : abs_i_div_max -> (abs_i divfloor max)
2282 : : abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
2283 : :
2284 : : return max_lte_0 OR
2285 : : i_ge_j_mult_min OR
2286 : : abs_i_div_max_gt_abs_j. */
2287 : :
2288 : : static tree
2289 : 136 : divFloorOverflowNegNeg (location_t location, tree i, tree j, tree lowest,
2290 : : tree min, tree max)
2291 : : {
2292 : 136 : tree max_lte_0 = m2expr_BuildLessThanOrEqualZero (location, max, lowest, min, max);
2293 : 136 : tree abs_i = m2expr_BuildAbs (location, i);
2294 : 136 : tree abs_j = m2expr_BuildAbs (location, j);
2295 : 136 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2296 : 136 : tree i_ge_j_mult_min = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min);
2297 : 136 : tree abs_i_div_max = m2expr_BuildDivFloor (location, abs_i, max, false);
2298 : 136 : tree abs_i_div_max_gt_abs_j = m2expr_BuildGreaterThan (location, abs_i_div_max, abs_j);
2299 : :
2300 : 136 : return m2expr_Build3TruthOrIf (location, max_lte_0, i_ge_j_mult_min, abs_i_div_max_gt_abs_j);
2301 : : }
2302 : :
2303 : :
2304 : : /* divFloorOverflowPosNeg precondition: i, j are in range values and i >=0, j < 0.
2305 : : Postcondition: true is returned if i divfloor j will result in an
2306 : : overflow/underflow.
2307 : :
2308 : : A handbuilt expression of trees implementing:
2309 : :
2310 : : RETURN i >= j * min - j (* is safer than i > j * min -1 *)
2311 : :
2312 : : j_mult_min -> (j * min)
2313 : : j_mult_min_sub_j -> (j_mult_min - j)
2314 : : i_ge_j_mult_min_sub_j -> (i >= j_mult_min_sub_j)
2315 : :
2316 : : return i_ge_j_mult_min_sub_j. */
2317 : :
2318 : : static tree
2319 : 136 : divFloorOverflowPosNeg (location_t location, tree i, tree j, tree min)
2320 : : {
2321 : 136 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2322 : 136 : tree j_mult_min_sub_j = m2expr_BuildSub (location, j_mult_min, j, false);
2323 : 136 : tree i_ge_j_mult_min_sub_j = m2expr_BuildGreaterThanOrEqual (location, i, j_mult_min_sub_j);
2324 : 136 : return i_ge_j_mult_min_sub_j;
2325 : : }
2326 : :
2327 : :
2328 : : /* divFloorOverflowNegPos precondition: i, j are in range values and i < 0, j > 0.
2329 : : Postcondition: true is returned if i divfloor j will result in an
2330 : : overflow/underflow.
2331 : :
2332 : : A handbuilt expression of trees implementing:
2333 : :
2334 : : RETURN i < j * min
2335 : :
2336 : : j_mult_min -> (j * min)
2337 : : RETURN i < j_mult_min. */
2338 : :
2339 : : static tree
2340 : 136 : divFloorOverflowNegPos (location_t location, tree i, tree j, tree min)
2341 : : {
2342 : 136 : tree j_mult_min = m2expr_BuildMult (location, j, min, false);
2343 : 136 : tree i_lt_j_mult_min = m2expr_BuildLessThan (location, i, j_mult_min);
2344 : 136 : return i_lt_j_mult_min;
2345 : : }
2346 : :
2347 : :
2348 : : /* divFloorOverflowCases, precondition: i, j are in range values.
2349 : : Postcondition: true is returned if i divfloor will result in an
2350 : : overflow/underflow.
2351 : :
2352 : : A handbuilt expression of trees implementing:
2353 : :
2354 : : RETURN (((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j)) OR
2355 : : ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j)) OR
2356 : : ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j)) OR
2357 : : ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j)))
2358 : :
2359 : : a -> ((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j))
2360 : : b -> ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j))
2361 : : c -> ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j))
2362 : : d -> ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j))
2363 : :
2364 : : RETURN a AND b AND c AND d. */
2365 : :
2366 : : static tree
2367 : 136 : divFloorOverflowCases (location_t location, tree i, tree j, tree lowest,
2368 : : tree min, tree max)
2369 : : {
2370 : 136 : tree i_gt_zero = m2expr_BuildGreaterThanZero (location, i, lowest, min, max);
2371 : 136 : tree j_gt_zero = m2expr_BuildGreaterThanZero (location, j, lowest, min, max);
2372 : 136 : tree i_lt_zero = m2expr_BuildLessThanZero (location, i, lowest, min, max);
2373 : 136 : tree j_lt_zero = m2expr_BuildLessThanZero (location, j, lowest, min, max);
2374 : 136 : tree a = m2expr_Build3TruthAndIf (location, i_gt_zero, j_gt_zero,
2375 : : divFloorOverflowPosPos (location, i, j, min));
2376 : 136 : tree b = m2expr_Build3TruthAndIf (location, i_lt_zero, j_lt_zero,
2377 : : divFloorOverflowNegNeg (location, i, j, lowest, min, max));
2378 : 136 : tree c = m2expr_Build3TruthAndIf (location, i_gt_zero, j_lt_zero,
2379 : : divFloorOverflowPosNeg (location, i, j, min));
2380 : 136 : tree d = m2expr_Build3TruthAndIf (location, i_lt_zero, j_gt_zero,
2381 : : divFloorOverflowNegPos (location, i, j, min));
2382 : 136 : return m2expr_Build4TruthOrIf (location, a, b, c, d);
2383 : : }
2384 : :
2385 : :
2386 : : /* checkWholeDivFloorOverflow check to see whether i DIV_FLOOR j will overflow
2387 : : an integer. A handbuilt expression of trees implementing:
2388 : :
2389 : : RETURN ((j = 0) OR (* division by zero. *)
2390 : : (maxT < 0) OR (* both inputs are < 0 and max is < 0,
2391 : : therefore error. *)
2392 : : (* we also check
2393 : : if ISO M2 dialect and j < 0
2394 : : which will also generate an error. *)
2395 : : ((i # 0) AND (* first operand is legally zero,
2396 : : result is also legally zero. *)
2397 : : divFloorOverflowCases (i, j)))
2398 : :
2399 : : using the following subexpressions:
2400 : :
2401 : : j_eq_zero -> (j == 0)
2402 : : max_lt_zero -> (max < 0)
2403 : : i_ne_zero -> (i # 0). */
2404 : :
2405 : : static tree
2406 : 136 : checkWholeDivFloorOverflow (location_t location, tree i, tree j, tree lowest,
2407 : : tree min, tree max)
2408 : : {
2409 : 136 : tree j_eq_zero = m2expr_BuildEqualToZero (location, j, lowest, min, max);
2410 : 136 : tree max_lt_zero = m2expr_BuildLessThanZero (location, max, lowest, min, max);
2411 : 136 : tree i_ne_zero = m2expr_BuildNotEqualToZero (location, i, lowest, min, max);
2412 : 136 : tree j_lt_zero;
2413 : 136 : tree rhs = m2expr_BuildTruthAndIf (location,
2414 : : i_ne_zero,
2415 : : divFloorOverflowCases (location,
2416 : : i, j, lowest, min, max));
2417 : :
2418 : 136 : if (M2Options_GetISO ())
2419 : : /* ISO Modula-2 raises an exception if the right hand operand is < 0. */
2420 : 136 : j_lt_zero = m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location, j, lowest, min, max));
2421 : : else
2422 : 0 : j_lt_zero = m2expr_GetIntegerZero (location);
2423 : 136 : j_eq_zero = m2expr_FoldAndStrip (j_eq_zero);
2424 : 136 : max_lt_zero = m2expr_FoldAndStrip (max_lt_zero);
2425 : 136 : i_ne_zero = m2expr_FoldAndStrip (i_ne_zero);
2426 : 136 : rhs = m2expr_FoldAndStrip (rhs);
2427 : :
2428 : 136 : tree condition = m2expr_Build4TruthOrIf (location, j_eq_zero, max_lt_zero, rhs, j_lt_zero);
2429 : 136 : tree t = M2Range_BuildIfCallWholeHandlerLoc (location, condition,
2430 : : get_current_function_name (),
2431 : : "whole value floor division will cause a range overflow");
2432 : 136 : return t;
2433 : : }
2434 : :
2435 : : /* checkWholeOverflow check to see if the binary operators will overflow
2436 : : ordinal types. */
2437 : :
2438 : : static tree
2439 : 39448 : m2expr_checkWholeOverflow (location_t location, enum tree_code code, tree op1,
2440 : : tree op2, tree lowest, tree min, tree max)
2441 : : {
2442 : 39448 : if (M2Options_GetWholeValueCheck () && (min != NULL))
2443 : : {
2444 : 3604 : lowest = m2tree_skip_type_decl (lowest);
2445 : 3604 : op1 = fold_convert_loc (location, lowest, op1);
2446 : 3604 : op2 = fold_convert_loc (location, lowest, op2);
2447 : :
2448 : 3604 : switch (code)
2449 : : {
2450 : 1552 : case PLUS_EXPR:
2451 : 1552 : return checkWholeAddOverflow (location, op1, op2, lowest, min, max);
2452 : 944 : case MINUS_EXPR:
2453 : 944 : return checkWholeSubOverflow (location, op1, op2, lowest, min, max);
2454 : 672 : case MULT_EXPR:
2455 : 672 : return checkWholeMultOverflow (location, op1, op2, lowest, min, max);
2456 : 32 : case TRUNC_DIV_EXPR:
2457 : 32 : return checkWholeDivTruncOverflow (location, op1, op2, lowest, min, max);
2458 : 136 : case CEIL_DIV_EXPR:
2459 : 136 : return checkWholeDivCeilOverflow (location, op1, op2, lowest, min, max);
2460 : 136 : case FLOOR_DIV_EXPR:
2461 : 136 : return checkWholeDivFloorOverflow (location, op1, op2, lowest, min, max);
2462 : 4 : case TRUNC_MOD_EXPR:
2463 : 4 : return checkWholeModTruncOverflow (location, op1, op2, lowest, min, max);
2464 : 64 : case CEIL_MOD_EXPR:
2465 : 64 : return checkWholeModCeilOverflow (location, op1, op2, lowest, min, max);
2466 : 64 : case FLOOR_MOD_EXPR:
2467 : 64 : return checkWholeModFloorOverflow (location, op1, op2, lowest, min, max);
2468 : : default:
2469 : : return NULL;
2470 : : }
2471 : : }
2472 : : return NULL;
2473 : : }
2474 : :
2475 : : /* checkRealOverflow if we have enabled real value checking then
2476 : : generate an overflow check appropriate to the tree code being used. */
2477 : :
2478 : : static void
2479 : 1158 : m2expr_checkRealOverflow (location_t location, enum tree_code code,
2480 : : tree result)
2481 : : {
2482 : 1158 : if (M2Options_GetFloatValueCheck ())
2483 : : {
2484 : 72 : tree condition = m2expr_BuildEqualTo (
2485 : : location, m2builtins_BuiltInIsfinite (location, result),
2486 : : m2expr_GetIntegerZero (location));
2487 : 72 : switch (code)
2488 : : {
2489 : 0 : case PLUS_EXPR:
2490 : 0 : m2type_AddStatement (location,
2491 : : M2Range_BuildIfCallRealHandlerLoc (
2492 : : location, condition,
2493 : : get_current_function_name (),
2494 : : "floating point + has caused an overflow"));
2495 : 0 : break;
2496 : 0 : case MINUS_EXPR:
2497 : 0 : m2type_AddStatement (location,
2498 : : M2Range_BuildIfCallRealHandlerLoc (
2499 : : location, condition,
2500 : : get_current_function_name (),
2501 : : "floating point - has caused an overflow"));
2502 : 0 : break;
2503 : 12 : case RDIV_EXPR:
2504 : 12 : case FLOOR_DIV_EXPR:
2505 : 12 : case CEIL_DIV_EXPR:
2506 : 12 : case TRUNC_DIV_EXPR:
2507 : 12 : m2type_AddStatement (location,
2508 : : M2Range_BuildIfCallRealHandlerLoc (
2509 : : location, condition,
2510 : : get_current_function_name (),
2511 : : "floating point / has caused an overflow"));
2512 : 12 : break;
2513 : 12 : case MULT_EXPR:
2514 : 12 : m2type_AddStatement (location,
2515 : : M2Range_BuildIfCallRealHandlerLoc (
2516 : : location, condition,
2517 : : get_current_function_name (),
2518 : : "floating point * has caused an overflow"));
2519 : 12 : break;
2520 : 0 : case NEGATE_EXPR:
2521 : 0 : m2type_AddStatement (
2522 : : location, M2Range_BuildIfCallRealHandlerLoc (
2523 : : location, condition,
2524 : : get_current_function_name (),
2525 : : "floating point unary - has caused an overflow"));
2526 : : default:
2527 : : break;
2528 : : }
2529 : : }
2530 : 1158 : }
2531 : :
2532 : : /* build_binary_op, a wrapper for the lower level build_binary_op
2533 : : above. */
2534 : :
2535 : : tree
2536 : 1755732 : m2expr_build_binary_op_check (location_t location, enum tree_code code,
2537 : : tree op1, tree op2, bool needconvert, tree lowest,
2538 : : tree min, tree max)
2539 : : {
2540 : 1755732 : tree type1, type2, result;
2541 : 1755732 : tree check = NULL;
2542 : :
2543 : 1755732 : op1 = m2expr_FoldAndStrip (op1);
2544 : 1755732 : op2 = m2expr_FoldAndStrip (op2);
2545 : :
2546 : 1755732 : type1 = m2tree_skip_type_decl (TREE_TYPE (op1));
2547 : 1755732 : type2 = m2tree_skip_type_decl (TREE_TYPE (op2));
2548 : :
2549 : 1755732 : m2assert_AssertLocation (location);
2550 : :
2551 : 1755732 : if (code == PLUS_EXPR)
2552 : : {
2553 : 179890 : if (POINTER_TYPE_P (type1))
2554 : : {
2555 : 9294 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2556 : 9294 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
2557 : 9294 : op1, op2);
2558 : : }
2559 : 170596 : else if (POINTER_TYPE_P (type2))
2560 : : {
2561 : 0 : op1 = fold_convert_loc (location, sizetype, unshare_expr (op1));
2562 : 0 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op2),
2563 : 0 : op2, op1);
2564 : : }
2565 : : }
2566 : 1746438 : if (code == MINUS_EXPR)
2567 : : {
2568 : 522988 : if (POINTER_TYPE_P (type1))
2569 : : {
2570 : 12 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2571 : 12 : op2 = fold_build1_loc (location, NEGATE_EXPR, sizetype, op2);
2572 : 12 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
2573 : 12 : op1, op2);
2574 : : }
2575 : 522976 : else if (POINTER_TYPE_P (type2))
2576 : : {
2577 : 0 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2578 : 0 : op2 = fold_build1_loc (location, NEGATE_EXPR, sizetype, op2);
2579 : 0 : op1 = fold_convert_loc (location, sizetype, unshare_expr (op1));
2580 : 0 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op2),
2581 : 0 : op2, op1);
2582 : : }
2583 : : }
2584 : :
2585 : 1746426 : if ((code != LSHIFT_EXPR) && (code != RSHIFT_EXPR) && (code != LROTATE_EXPR)
2586 : : && (code == RROTATE_EXPR))
2587 : 68 : if (type1 != type2)
2588 : 0 : error_at (location, "not expecting different types to binary operator");
2589 : :
2590 : 1746426 : if ((TREE_CODE (type1) != REAL_TYPE) && (min != NULL))
2591 : 39448 : check = m2expr_checkWholeOverflow (location, code, op1, op2, lowest, min, max);
2592 : :
2593 : 1746426 : result = build_binary_op (location, code, op1, op2, needconvert);
2594 : 1746426 : if (check != NULL)
2595 : 3604 : result = build2 (COMPOUND_EXPR, TREE_TYPE (result), check, result);
2596 : :
2597 : 1746426 : if (SCALAR_FLOAT_TYPE_P (type1))
2598 : 1142 : m2expr_checkRealOverflow (location, code, result);
2599 : : return result;
2600 : : }
2601 : :
2602 : : /* build_binary_op, a wrapper for the lower level build_binary_op
2603 : : above. */
2604 : :
2605 : : tree
2606 : 1705754 : m2expr_build_binary_op (location_t location, enum tree_code code, tree op1,
2607 : : tree op2, int convert)
2608 : : {
2609 : 1705754 : return m2expr_build_binary_op_check (location, code, op1, op2, convert, NULL,
2610 : 1705754 : NULL, NULL);
2611 : : }
2612 : :
2613 : : /* BuildAddAddress return an expression op1+op2 where op1 is a
2614 : : pointer type and op2 is not a pointer type. */
2615 : :
2616 : : tree
2617 : 700 : m2expr_BuildAddAddress (location_t location, tree op1, tree op2)
2618 : : {
2619 : 700 : tree type1, type2;
2620 : :
2621 : 700 : op1 = m2expr_FoldAndStrip (op1);
2622 : 700 : op2 = m2expr_FoldAndStrip (op2);
2623 : :
2624 : 700 : type1 = m2tree_skip_type_decl (TREE_TYPE (op1));
2625 : 700 : type2 = m2tree_skip_type_decl (TREE_TYPE (op2));
2626 : :
2627 : 700 : m2assert_AssertLocation (location);
2628 : 700 : ASSERT_CONDITION (POINTER_TYPE_P (type1));
2629 : 700 : ASSERT_CONDITION (!POINTER_TYPE_P (type2));
2630 : :
2631 : 700 : op2 = fold_convert_loc (location, sizetype, unshare_expr (op2));
2632 : 700 : return fold_build2_loc (location, POINTER_PLUS_EXPR, TREE_TYPE (op1),
2633 : : m2expr_FoldAndStrip (op1),
2634 : 700 : m2expr_FoldAndStrip (op2));
2635 : : }
2636 : :
2637 : : /* BuildNegateCheck builds a negate tree. */
2638 : :
2639 : : tree
2640 : 756 : m2expr_BuildNegateCheck (location_t location, tree arg, tree lowest, tree min,
2641 : : tree max)
2642 : : {
2643 : 756 : tree t;
2644 : :
2645 : 756 : m2assert_AssertLocation (location);
2646 : :
2647 : 756 : arg = m2expr_FoldAndStrip (arg);
2648 : 756 : arg = CheckAddressToCardinal (location, arg);
2649 : :
2650 : 756 : t = m2expr_build_unary_op_check (location, NEGATE_EXPR, arg, lowest, min,
2651 : : max);
2652 : 756 : return m2expr_FoldAndStrip (t);
2653 : : }
2654 : :
2655 : : /* BuildNegate build a negate expression and returns the tree. */
2656 : :
2657 : : tree
2658 : 18570 : m2expr_BuildNegate (location_t location, tree op1, bool needconvert)
2659 : : {
2660 : 18570 : m2assert_AssertLocation (location);
2661 : 18570 : op1 = m2expr_FoldAndStrip (op1);
2662 : 18570 : op1 = CheckAddressToCardinal (location, op1);
2663 : :
2664 : 18570 : return m2expr_build_unary_op (location, NEGATE_EXPR, op1, needconvert);
2665 : : }
2666 : :
2667 : : /* BuildSetNegate build a set negate expression and returns the tree. */
2668 : :
2669 : : tree
2670 : 551 : m2expr_BuildSetNegate (location_t location, tree op1, bool needconvert)
2671 : : {
2672 : 551 : m2assert_AssertLocation (location);
2673 : :
2674 : 551 : return m2expr_build_binary_op (
2675 : : location, BIT_XOR_EXPR,
2676 : : m2convert_BuildConvert (location, m2type_GetWordType (),
2677 : : m2expr_FoldAndStrip (op1), false),
2678 : 551 : set_full_complement, needconvert);
2679 : : }
2680 : :
2681 : : /* BuildMult build a multiplication tree. */
2682 : :
2683 : : tree
2684 : 18524 : m2expr_BuildMult (location_t location, tree op1, tree op2, bool needconvert)
2685 : : {
2686 : 18524 : op1 = m2expr_FoldAndStrip (op1);
2687 : 18524 : op2 = m2expr_FoldAndStrip (op2);
2688 : :
2689 : 18524 : m2assert_AssertLocation (location);
2690 : :
2691 : 18524 : op1 = CheckAddressToCardinal (location, op1);
2692 : 18524 : op2 = CheckAddressToCardinal (location, op2);
2693 : :
2694 : 18524 : return m2expr_build_binary_op (location, MULT_EXPR, op1, op2, needconvert);
2695 : : }
2696 : :
2697 : : /* BuildMultCheck builds a multiplication tree. */
2698 : :
2699 : : tree
2700 : 9747 : m2expr_BuildMultCheck (location_t location, tree op1, tree op2, tree lowest,
2701 : : tree min, tree max)
2702 : : {
2703 : 9747 : tree t;
2704 : :
2705 : 9747 : m2assert_AssertLocation (location);
2706 : :
2707 : 9747 : op1 = m2expr_FoldAndStrip (op1);
2708 : 9747 : op2 = m2expr_FoldAndStrip (op2);
2709 : :
2710 : 9747 : op1 = CheckAddressToCardinal (location, op1);
2711 : 9747 : op2 = CheckAddressToCardinal (location, op2);
2712 : :
2713 : 9747 : t = m2expr_build_binary_op_check (location, MULT_EXPR, op1, op2, false,
2714 : : lowest, min, max);
2715 : 9747 : return m2expr_FoldAndStrip (t);
2716 : : }
2717 : :
2718 : : /* testLimits return the number of bits required to represent:
2719 : : min..max if it matches the, type. Otherwise NULL_TREE is returned. */
2720 : :
2721 : : static tree
2722 : 144 : testLimits (location_t location, tree type, tree min, tree max)
2723 : : {
2724 : 144 : m2assert_AssertLocation (location);
2725 : :
2726 : 144 : if ((m2expr_CompareTrees (TYPE_MAX_VALUE (type), max) == 0)
2727 : 144 : && (m2expr_CompareTrees (TYPE_MIN_VALUE (type), min) == 0))
2728 : 0 : return m2expr_BuildMult (location, m2expr_GetSizeOf (location, type),
2729 : : m2decl_BuildIntegerConstant (BITS_PER_UNIT),
2730 : 0 : false);
2731 : : return NULL_TREE;
2732 : : }
2733 : :
2734 : : /* noBitsRequired return the number of bits required to contain, values. */
2735 : :
2736 : : static tree
2737 : 72 : noBitsRequired (tree values)
2738 : : {
2739 : 72 : int bits = tree_floor_log2 (values);
2740 : :
2741 : 72 : if (integer_pow2p (values))
2742 : 24 : return m2decl_BuildIntegerConstant (bits + 1);
2743 : : else
2744 : 48 : return m2decl_BuildIntegerConstant (bits + 1);
2745 : : }
2746 : :
2747 : : /* getMax return the result of max(a, b). */
2748 : :
2749 : : static tree
2750 : 72 : getMax (tree a, tree b)
2751 : : {
2752 : 72 : if (m2expr_CompareTrees (a, b) > 0)
2753 : : return a;
2754 : : else
2755 : 72 : return b;
2756 : : }
2757 : :
2758 : : /* calcNbits return the smallest number of bits required to
2759 : : represent: min..max. */
2760 : :
2761 : : static tree
2762 : 72 : calcNbits (location_t location, tree min, tree max)
2763 : : {
2764 : 72 : int negative = false;
2765 : 72 : tree t = testLimits (location, m2type_GetIntegerType (), min, max);
2766 : :
2767 : 72 : m2assert_AssertLocation (location);
2768 : :
2769 : 72 : if (t == NULL)
2770 : 72 : t = testLimits (location, m2type_GetCardinalType (), min, max);
2771 : :
2772 : 72 : if (t == NULL)
2773 : : {
2774 : 72 : if (m2expr_CompareTrees (min, m2expr_GetIntegerZero (location)) < 0)
2775 : : {
2776 : 0 : min = m2expr_BuildAdd (location, min,
2777 : : m2expr_GetIntegerOne (location), false);
2778 : 0 : min = fold (m2expr_BuildNegate (location, min, false));
2779 : 0 : negative = true;
2780 : : }
2781 : 72 : if (m2expr_CompareTrees (max, m2expr_GetIntegerZero (location)) < 0)
2782 : : {
2783 : 0 : max = fold (m2expr_BuildNegate (location, max, false));
2784 : 0 : negative = true;
2785 : : }
2786 : 144 : t = noBitsRequired (getMax (min, max));
2787 : 72 : if (negative)
2788 : 0 : t = m2expr_BuildAdd (location, t, m2expr_GetIntegerOne (location),
2789 : : false);
2790 : : }
2791 : 72 : return t;
2792 : : }
2793 : :
2794 : : /* BuildTBitSize return the minimum number of bits to represent, type. */
2795 : :
2796 : : tree
2797 : 84 : m2expr_BuildTBitSize (location_t location, tree type)
2798 : : {
2799 : 108 : enum tree_code code = TREE_CODE (type);
2800 : 108 : tree min;
2801 : 108 : tree max;
2802 : 108 : m2assert_AssertLocation (location);
2803 : :
2804 : 108 : switch (code)
2805 : : {
2806 : :
2807 : 24 : case TYPE_DECL:
2808 : 24 : return m2expr_BuildTBitSize (location, TREE_TYPE (type));
2809 : 72 : case INTEGER_TYPE:
2810 : 72 : case ENUMERAL_TYPE:
2811 : 72 : max = m2convert_BuildConvert (location, m2type_GetIntegerType (),
2812 : 72 : TYPE_MAX_VALUE (type), false);
2813 : 72 : min = m2convert_BuildConvert (location, m2type_GetIntegerType (),
2814 : 72 : TYPE_MIN_VALUE (type), false);
2815 : 72 : return calcNbits (location, min, max);
2816 : 0 : case BOOLEAN_TYPE:
2817 : 0 : return m2expr_GetIntegerOne (location);
2818 : 12 : default:
2819 : 12 : return m2expr_BuildMult (location, m2expr_GetSizeOf (location, type),
2820 : : m2decl_BuildIntegerConstant (BITS_PER_UNIT),
2821 : 12 : false);
2822 : : }
2823 : : }
2824 : :
2825 : : /* BuildSize build a SIZE function expression and returns the tree. */
2826 : :
2827 : : tree
2828 : 332710 : m2expr_BuildSize (location_t location, tree op1,
2829 : : bool needconvert ATTRIBUTE_UNUSED)
2830 : : {
2831 : 332710 : m2assert_AssertLocation (location);
2832 : 332710 : return m2expr_GetSizeOf (location, op1);
2833 : : }
2834 : :
2835 : : /* BuildAddr return an expression which calculates the address of op1
2836 : : and returns the tree. If use_generic is true then create a generic
2837 : : pointer type. */
2838 : :
2839 : : tree
2840 : 326187 : m2expr_BuildAddr (location_t location, tree op1, bool use_generic)
2841 : : {
2842 : 326187 : tree type = m2tree_skip_type_decl (TREE_TYPE (op1));
2843 : 326187 : tree ptrType = build_pointer_type (type);
2844 : 326187 : tree result;
2845 : :
2846 : 326187 : m2assert_AssertLocation (location);
2847 : :
2848 : 326187 : if (!gm2_mark_addressable (op1))
2849 : 0 : error_at (location, "cannot take the address of this expression");
2850 : :
2851 : 326187 : if (use_generic)
2852 : 12 : result = build1 (ADDR_EXPR, m2type_GetPointerType (), op1);
2853 : : else
2854 : 326175 : result = build1 (ADDR_EXPR, ptrType, op1);
2855 : 326187 : protected_set_expr_location (result, location);
2856 : 326187 : return result;
2857 : : }
2858 : :
2859 : : /* BuildOffset1 build and return an expression containing the number
2860 : : of bytes the field is offset from the start of the record structure.
2861 : : This function is the same as the above, except that it derives the
2862 : : record from the field and then calls BuildOffset. */
2863 : :
2864 : : tree
2865 : 0 : m2expr_BuildOffset1 (location_t location, tree field,
2866 : : bool needconvert ATTRIBUTE_UNUSED)
2867 : : {
2868 : 0 : m2assert_AssertLocation (location);
2869 : 0 : return m2expr_BuildOffset (location, DECL_CONTEXT (field), field,
2870 : 0 : needconvert);
2871 : : }
2872 : :
2873 : : /* determinePenultimateField return the field associated with the
2874 : : DECL_CONTEXT (field) within a record or varient. The record, is a
2875 : : record/varient but it maybe an outer nested record to the field that
2876 : : we are searching. Ie:
2877 : :
2878 : : record = RECORD x: CARDINAL ; y: RECORD field: CARDINAL ; END END ;
2879 : :
2880 : : determinePenultimateField (record, field) returns, y. We are
2881 : : assurred that the chain of records leading to field will be unique as
2882 : : they are built on the fly to implement varient records. */
2883 : :
2884 : : static tree
2885 : 1380 : determinePenultimateField (tree record, tree field)
2886 : : {
2887 : 1380 : tree fieldlist = TYPE_FIELDS (record);
2888 : 1380 : tree x, r;
2889 : :
2890 : 2520 : for (x = fieldlist; x; x = TREE_CHAIN (x))
2891 : : {
2892 : 2370 : if (DECL_CONTEXT (field) == TREE_TYPE (x))
2893 : 708 : return x;
2894 : 1662 : switch (TREE_CODE (TREE_TYPE (x)))
2895 : : {
2896 : 672 : case RECORD_TYPE:
2897 : 672 : case UNION_TYPE:
2898 : 672 : r = determinePenultimateField (TREE_TYPE (x), field);
2899 : 672 : if (r != NULL)
2900 : 522 : return r;
2901 : : break;
2902 : : default:
2903 : : break;
2904 : : }
2905 : : }
2906 : : return NULL_TREE;
2907 : : }
2908 : :
2909 : : /* BuildOffset builds an expression containing the number of bytes
2910 : : the field is offset from the start of the record structure. The
2911 : : expression is returned. */
2912 : :
2913 : : tree
2914 : 0 : m2expr_BuildOffset (location_t location, tree record, tree field,
2915 : : bool needconvert ATTRIBUTE_UNUSED)
2916 : : {
2917 : 0 : m2assert_AssertLocation (location);
2918 : :
2919 : 0 : if (DECL_CONTEXT (field) == record)
2920 : 0 : return m2convert_BuildConvert (
2921 : : location, m2type_GetIntegerType (),
2922 : : m2expr_BuildAdd (
2923 : 0 : location, DECL_FIELD_OFFSET (field),
2924 : 0 : m2expr_BuildDivTrunc (location, DECL_FIELD_BIT_OFFSET (field),
2925 : : m2decl_BuildIntegerConstant (BITS_PER_UNIT),
2926 : : false),
2927 : : false),
2928 : 0 : false);
2929 : : else
2930 : : {
2931 : 0 : tree r1 = DECL_CONTEXT (field);
2932 : 0 : tree r2 = determinePenultimateField (record, field);
2933 : 0 : return m2convert_BuildConvert (
2934 : : location, m2type_GetIntegerType (),
2935 : : m2expr_BuildAdd (
2936 : : location, m2expr_BuildOffset (location, r1, field, needconvert),
2937 : : m2expr_BuildOffset (location, record, r2, needconvert), false),
2938 : 0 : false);
2939 : : }
2940 : : }
2941 : :
2942 : : /* BuildLogicalOrAddress build a logical or expressions and return the tree. */
2943 : :
2944 : : tree
2945 : 12 : m2expr_BuildLogicalOrAddress (location_t location, tree op1, tree op2,
2946 : : bool needconvert)
2947 : : {
2948 : 12 : m2assert_AssertLocation (location);
2949 : 12 : return m2expr_build_binary_op (location, BIT_IOR_EXPR, op1, op2,
2950 : 12 : needconvert);
2951 : : }
2952 : :
2953 : : /* BuildLogicalOr build a logical or expressions and return the tree. */
2954 : :
2955 : : tree
2956 : 391825 : m2expr_BuildLogicalOr (location_t location, tree op1, tree op2,
2957 : : bool needconvert)
2958 : : {
2959 : 391825 : m2assert_AssertLocation (location);
2960 : 391825 : return m2expr_build_binary_op (
2961 : : location, BIT_IOR_EXPR,
2962 : : m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
2963 : : m2convert_BuildConvert (location, m2type_GetWordType (), op2, false),
2964 : 391825 : needconvert);
2965 : : }
2966 : :
2967 : : /* BuildLogicalAnd build a logical and expression and return the tree. */
2968 : :
2969 : : tree
2970 : 675 : m2expr_BuildLogicalAnd (location_t location, tree op1, tree op2,
2971 : : bool needconvert)
2972 : : {
2973 : 675 : m2assert_AssertLocation (location);
2974 : 675 : return m2expr_build_binary_op (
2975 : : location, BIT_AND_EXPR,
2976 : : m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
2977 : : m2convert_BuildConvert (location, m2type_GetWordType (), op2, false),
2978 : 675 : needconvert);
2979 : : }
2980 : :
2981 : : /* BuildSymmetricalDifference build a logical xor expression and return the
2982 : : * tree. */
2983 : :
2984 : : tree
2985 : 12 : m2expr_BuildSymmetricDifference (location_t location, tree op1, tree op2,
2986 : : bool needconvert)
2987 : : {
2988 : 12 : m2assert_AssertLocation (location);
2989 : 12 : return m2expr_build_binary_op (
2990 : : location, BIT_XOR_EXPR,
2991 : : m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
2992 : : m2convert_BuildConvert (location, m2type_GetWordType (), op2, false),
2993 : 12 : needconvert);
2994 : : }
2995 : :
2996 : : /* BuildLogicalDifference build a logical difference expression and
2997 : : return the tree. (op1 and (not op2)). */
2998 : :
2999 : : tree
3000 : 84 : m2expr_BuildLogicalDifference (location_t location, tree op1, tree op2,
3001 : : bool needconvert)
3002 : : {
3003 : 84 : m2assert_AssertLocation (location);
3004 : 84 : return m2expr_build_binary_op (
3005 : : location, BIT_AND_EXPR,
3006 : : m2convert_BuildConvert (location, m2type_GetWordType (), op1, false),
3007 : 84 : m2expr_BuildSetNegate (location, op2, needconvert), needconvert);
3008 : : }
3009 : :
3010 : : /* base_type returns the base type of an ordinal subrange, or the
3011 : : type itself if it is not a subrange. */
3012 : :
3013 : : static tree
3014 : 741012 : base_type (tree type)
3015 : : {
3016 : 741012 : if (type == error_mark_node)
3017 : : return error_mark_node;
3018 : :
3019 : : /* Check for ordinal subranges. */
3020 : 741012 : if (m2tree_IsOrdinal (type) && TREE_TYPE (type))
3021 : 99052 : type = TREE_TYPE (type);
3022 : 741012 : return TYPE_MAIN_VARIANT (type);
3023 : : }
3024 : :
3025 : : /* boolean_enum_to_unsigned convert a BOOLEAN_TYPE, t, or
3026 : : ENUMERAL_TYPE to an unsigned type. */
3027 : :
3028 : : static tree
3029 : 382072 : boolean_enum_to_unsigned (location_t location, tree t)
3030 : : {
3031 : 382072 : tree type = TREE_TYPE (t);
3032 : :
3033 : 382072 : if (TREE_CODE (base_type (type)) == BOOLEAN_TYPE)
3034 : 23132 : return m2convert_BuildConvert (location, unsigned_type_node, t, false);
3035 : 358940 : else if (TREE_CODE (base_type (type)) == ENUMERAL_TYPE)
3036 : 1500 : return m2convert_BuildConvert (location, unsigned_type_node, t, false);
3037 : : else
3038 : : return t;
3039 : : }
3040 : :
3041 : : /* check_for_comparison check to see if, op, is of type, badType. If
3042 : : so then it returns op after it has been cast to, goodType. op will
3043 : : be an array so we take the address and cast the contents. */
3044 : :
3045 : : static tree
3046 : 655456 : check_for_comparison (location_t location, tree op, tree badType,
3047 : : tree goodType)
3048 : : {
3049 : 655456 : m2assert_AssertLocation (location);
3050 : 655456 : if (m2tree_skip_type_decl (TREE_TYPE (op)) == badType)
3051 : : /* Cannot compare array contents in m2expr_build_binary_op. */
3052 : 0 : return m2expr_BuildIndirect (
3053 : 0 : location, m2expr_BuildAddr (location, op, false), goodType);
3054 : : return op;
3055 : : }
3056 : :
3057 : : /* convert_for_comparison return a tree which can be used as an
3058 : : argument during a comparison. */
3059 : :
3060 : : static tree
3061 : 163864 : convert_for_comparison (location_t location, tree op)
3062 : : {
3063 : 163864 : m2assert_AssertLocation (location);
3064 : 163864 : op = boolean_enum_to_unsigned (location, op);
3065 : :
3066 : 163864 : op = check_for_comparison (location, op, m2type_GetISOWordType (),
3067 : : m2type_GetWordType ());
3068 : 163864 : op = check_for_comparison (location, op, m2type_GetM2Word16 (),
3069 : : m2type_GetM2Cardinal16 ());
3070 : 163864 : op = check_for_comparison (location, op, m2type_GetM2Word32 (),
3071 : : m2type_GetM2Cardinal32 ());
3072 : 163864 : op = check_for_comparison (location, op, m2type_GetM2Word64 (),
3073 : : m2type_GetM2Cardinal64 ());
3074 : :
3075 : 163864 : return op;
3076 : : }
3077 : :
3078 : : /* BuildLessThan return a tree which computes <. */
3079 : :
3080 : : tree
3081 : 49334 : m2expr_BuildLessThan (location_t location, tree op1, tree op2)
3082 : : {
3083 : 49334 : m2assert_AssertLocation (location);
3084 : 49334 : return m2expr_build_binary_op (
3085 : : location, LT_EXPR, boolean_enum_to_unsigned (location, op1),
3086 : 49334 : boolean_enum_to_unsigned (location, op2), true);
3087 : : }
3088 : :
3089 : : /* BuildGreaterThan return a tree which computes >. */
3090 : :
3091 : : tree
3092 : 45516 : m2expr_BuildGreaterThan (location_t location, tree op1, tree op2)
3093 : : {
3094 : 45516 : m2assert_AssertLocation (location);
3095 : 45516 : return m2expr_build_binary_op (
3096 : : location, GT_EXPR, boolean_enum_to_unsigned (location, op1),
3097 : 45516 : boolean_enum_to_unsigned (location, op2), true);
3098 : : }
3099 : :
3100 : : /* BuildLessThanOrEqual return a tree which computes <. */
3101 : :
3102 : : tree
3103 : 6190 : m2expr_BuildLessThanOrEqual (location_t location, tree op1, tree op2)
3104 : : {
3105 : 6190 : m2assert_AssertLocation (location);
3106 : 6190 : return m2expr_build_binary_op (
3107 : : location, LE_EXPR, boolean_enum_to_unsigned (location, op1),
3108 : 6190 : boolean_enum_to_unsigned (location, op2), true);
3109 : : }
3110 : :
3111 : : /* BuildGreaterThanOrEqual return a tree which computes >=. */
3112 : :
3113 : : tree
3114 : 8064 : m2expr_BuildGreaterThanOrEqual (location_t location, tree op1, tree op2)
3115 : : {
3116 : 8064 : m2assert_AssertLocation (location);
3117 : 8064 : return m2expr_build_binary_op (
3118 : : location, GE_EXPR, boolean_enum_to_unsigned (location, op1),
3119 : 8064 : boolean_enum_to_unsigned (location, op2), true);
3120 : : }
3121 : :
3122 : : /* BuildEqualTo return a tree which computes =. */
3123 : :
3124 : : tree
3125 : 47541 : m2expr_BuildEqualTo (location_t location, tree op1, tree op2)
3126 : : {
3127 : 47541 : m2assert_AssertLocation (location);
3128 : 47541 : return m2expr_build_binary_op (location, EQ_EXPR,
3129 : : convert_for_comparison (location, op1),
3130 : 47541 : convert_for_comparison (location, op2), true);
3131 : : }
3132 : :
3133 : : /* BuildEqualNotTo return a tree which computes #. */
3134 : :
3135 : : tree
3136 : 34391 : m2expr_BuildNotEqualTo (location_t location, tree op1, tree op2)
3137 : : {
3138 : 34391 : m2assert_AssertLocation (location);
3139 : 34391 : return m2expr_build_binary_op (location, NE_EXPR,
3140 : : convert_for_comparison (location, op1),
3141 : 34391 : convert_for_comparison (location, op2), true);
3142 : : }
3143 : :
3144 : : /* BuildIsSuperset return a tree which computes: op1 & op2 == op2. */
3145 : :
3146 : : tree
3147 : 24 : m2expr_BuildIsSuperset (location_t location, tree op1, tree op2)
3148 : : {
3149 : 24 : m2assert_AssertLocation (location);
3150 : 24 : return m2expr_BuildEqualTo (
3151 : 24 : location, op2, m2expr_BuildLogicalAnd (location, op1, op2, false));
3152 : : }
3153 : :
3154 : : /* BuildIsNotSuperset return a tree which computes: op1 & op2 != op2. */
3155 : :
3156 : : tree
3157 : 24 : m2expr_BuildIsNotSuperset (location_t location, tree op1, tree op2)
3158 : : {
3159 : 24 : m2assert_AssertLocation (location);
3160 : 24 : return m2expr_BuildNotEqualTo (
3161 : 24 : location, op2, m2expr_BuildLogicalAnd (location, op1, op2, false));
3162 : : }
3163 : :
3164 : : /* BuildIsSubset return a tree which computes: op1 & op2 == op1. */
3165 : :
3166 : : tree
3167 : 0 : m2expr_BuildIsSubset (location_t location, tree op1, tree op2)
3168 : : {
3169 : 0 : m2assert_AssertLocation (location);
3170 : 0 : return m2expr_BuildEqualTo (
3171 : 0 : location, op1, m2expr_BuildLogicalAnd (location, op1, op2, false));
3172 : : }
3173 : :
3174 : : /* BuildIsNotSubset return a tree which computes: op1 & op2 != op1. */
3175 : :
3176 : : tree
3177 : 24 : m2expr_BuildIsNotSubset (location_t location, tree op1, tree op2)
3178 : : {
3179 : 24 : m2assert_AssertLocation (location);
3180 : 24 : return m2expr_BuildNotEqualTo (
3181 : 24 : location, op1, m2expr_BuildLogicalAnd (location, op1, op2, false));
3182 : : }
3183 : :
3184 : : /* BuildIfConstInVar generates: if constel in varset then goto label. */
3185 : :
3186 : : void
3187 : 168 : m2expr_BuildIfConstInVar (location_t location, tree type, tree varset,
3188 : : tree constel, bool is_lvalue, int fieldno,
3189 : : char *label)
3190 : : {
3191 : 168 : tree size = m2expr_GetSizeOf (location, type);
3192 : 168 : m2assert_AssertLocation (location);
3193 : :
3194 : 168 : ASSERT_BOOL (is_lvalue);
3195 : 168 : if (m2expr_CompareTrees (
3196 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
3197 : : <= 0)
3198 : : /* Small set size <= TSIZE(WORD). */
3199 : 114 : m2treelib_do_jump_if_bit (
3200 : : location, NE_EXPR,
3201 : : m2treelib_get_rvalue (location, varset, type, is_lvalue), constel,
3202 : : label);
3203 : : else
3204 : : {
3205 : 54 : tree fieldlist = TYPE_FIELDS (type);
3206 : 54 : tree field;
3207 : :
3208 : 84 : for (field = fieldlist; (field != NULL) && (fieldno > 0);
3209 : 30 : field = TREE_CHAIN (field))
3210 : 30 : fieldno--;
3211 : :
3212 : 54 : m2treelib_do_jump_if_bit (
3213 : : location, NE_EXPR,
3214 : : m2treelib_get_set_field_rhs (location, varset, field), constel,
3215 : : label);
3216 : : }
3217 : 168 : }
3218 : :
3219 : : /* BuildIfConstInVar generates: if not (constel in varset) then goto label. */
3220 : :
3221 : : void
3222 : 582 : m2expr_BuildIfNotConstInVar (location_t location, tree type, tree varset,
3223 : : tree constel, bool is_lvalue, int fieldno,
3224 : : char *label)
3225 : : {
3226 : 582 : tree size = m2expr_GetSizeOf (location, type);
3227 : :
3228 : 582 : m2assert_AssertLocation (location);
3229 : :
3230 : 582 : ASSERT_BOOL (is_lvalue);
3231 : 582 : if (m2expr_CompareTrees (
3232 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
3233 : : <= 0)
3234 : : /* Small set size <= TSIZE(WORD). */
3235 : 426 : m2treelib_do_jump_if_bit (
3236 : : location, EQ_EXPR,
3237 : : m2treelib_get_rvalue (location, varset, type, is_lvalue), constel,
3238 : : label);
3239 : : else
3240 : : {
3241 : 156 : tree fieldlist = TYPE_FIELDS (type);
3242 : 156 : tree field;
3243 : :
3244 : 186 : for (field = fieldlist; (field != NULL) && (fieldno > 0);
3245 : 30 : field = TREE_CHAIN (field))
3246 : 30 : fieldno--;
3247 : :
3248 : 156 : m2treelib_do_jump_if_bit (
3249 : : location, EQ_EXPR,
3250 : : m2treelib_get_set_field_rhs (location, varset, field), constel,
3251 : : label);
3252 : : }
3253 : 582 : }
3254 : :
3255 : : /* BuildIfVarInVar generates: if varel in varset then goto label. */
3256 : :
3257 : : void
3258 : 178 : m2expr_BuildIfVarInVar (location_t location, tree type, tree varset,
3259 : : tree varel, bool is_lvalue, tree low,
3260 : : tree high ATTRIBUTE_UNUSED, char *label)
3261 : : {
3262 : 178 : tree size = m2expr_GetSizeOf (location, type);
3263 : : /* Calculate the index from the first bit, ie bit 0 represents low value. */
3264 : 178 : tree index = m2expr_BuildSub (
3265 : : location, m2convert_BuildConvert (location, m2type_GetIntegerType (),
3266 : : varel, false),
3267 : : m2convert_BuildConvert (location, m2type_GetIntegerType (), low, false),
3268 : : false);
3269 : :
3270 : 178 : m2assert_AssertLocation (location);
3271 : :
3272 : 178 : if (m2expr_CompareTrees (
3273 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
3274 : : <= 0)
3275 : : /* Small set size <= TSIZE(WORD). */
3276 : 52 : m2treelib_do_jump_if_bit (
3277 : : location, NE_EXPR,
3278 : : m2treelib_get_rvalue (location, varset, type, is_lvalue), index,
3279 : : label);
3280 : : else
3281 : : {
3282 : 126 : tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
3283 : : /* Which word do we need to fetch? */
3284 : 126 : tree word_index = m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
3285 : : location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
3286 : : false));
3287 : : /* Calculate the bit in this word. */
3288 : 126 : tree offset_into_word = m2expr_FoldAndStrip (m2expr_BuildModTrunc (
3289 : : location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
3290 : : false));
3291 : 126 : tree p2 = m2expr_FoldAndStrip (m2expr_BuildMult (
3292 : : location, word_index,
3293 : : m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT), false));
3294 : :
3295 : : /* Calculate the address of the word we are interested in. */
3296 : 126 : p1 = m2expr_BuildAddAddress (location,
3297 : : m2convert_convertToPtr (location, p1), p2);
3298 : :
3299 : : /* Fetch the word, extract the bit and test for != 0. */
3300 : 126 : m2treelib_do_jump_if_bit (
3301 : : location, NE_EXPR,
3302 : : m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
3303 : : offset_into_word, label);
3304 : : }
3305 : 178 : }
3306 : :
3307 : : /* BuildIfNotVarInVar generates: if not (varel in varset) then goto label. */
3308 : :
3309 : : void
3310 : 438 : m2expr_BuildIfNotVarInVar (location_t location, tree type, tree varset,
3311 : : tree varel, bool is_lvalue, tree low,
3312 : : tree high ATTRIBUTE_UNUSED, char *label)
3313 : : {
3314 : 438 : tree size = m2expr_GetSizeOf (location, type);
3315 : : /* Calculate the index from the first bit, ie bit 0 represents low value. */
3316 : 438 : tree index = m2expr_BuildSub (
3317 : : location, m2convert_BuildConvert (location, m2type_GetIntegerType (),
3318 : : m2expr_FoldAndStrip (varel), false),
3319 : : m2convert_BuildConvert (location, m2type_GetIntegerType (),
3320 : : m2expr_FoldAndStrip (low), false),
3321 : : false);
3322 : :
3323 : 438 : index = m2expr_FoldAndStrip (index);
3324 : 438 : m2assert_AssertLocation (location);
3325 : :
3326 : 438 : if (m2expr_CompareTrees (
3327 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
3328 : : <= 0)
3329 : : /* Small set size <= TSIZE(WORD). */
3330 : 178 : m2treelib_do_jump_if_bit (
3331 : : location, EQ_EXPR,
3332 : : m2treelib_get_rvalue (location, varset, type, is_lvalue), index,
3333 : : label);
3334 : : else
3335 : : {
3336 : 260 : tree p1 = m2treelib_get_set_address (location, varset, is_lvalue);
3337 : : /* Calculate the index from the first bit. */
3338 : :
3339 : : /* Which word do we need to fetch? */
3340 : 260 : tree word_index = m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
3341 : : location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
3342 : : false));
3343 : : /* Calculate the bit in this word. */
3344 : 260 : tree offset_into_word = m2expr_FoldAndStrip (m2expr_BuildModTrunc (
3345 : : location, index, m2decl_BuildIntegerConstant (SET_WORD_SIZE),
3346 : : false));
3347 : 260 : tree p2 = m2expr_FoldAndStrip (m2expr_BuildMult (
3348 : : location, word_index,
3349 : : m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT), false));
3350 : :
3351 : : /* Calculate the address of the word we are interested in. */
3352 : 260 : p1 = m2expr_BuildAddAddress (location, p1, p2);
3353 : :
3354 : : /* Fetch the word, extract the bit and test for == 0. */
3355 : 260 : m2treelib_do_jump_if_bit (
3356 : : location, EQ_EXPR,
3357 : : m2expr_BuildIndirect (location, p1, m2type_GetBitsetType ()),
3358 : : offset_into_word, label);
3359 : : }
3360 : 438 : }
3361 : :
3362 : : /* BuildForeachWordInSetDoIfExpr foreach word in set, type, compute
3363 : : the expression, expr, and if true goto label. */
3364 : :
3365 : : void
3366 : 504 : m2expr_BuildForeachWordInSetDoIfExpr (location_t location, tree type, tree op1,
3367 : : tree op2, bool is_op1lvalue,
3368 : : bool is_op2lvalue, bool is_op1const,
3369 : : bool is_op2const,
3370 : : tree (*expr) (location_t, tree, tree),
3371 : : char *label)
3372 : : {
3373 : 504 : tree p1 = m2treelib_get_set_address_if_var (location, op1, is_op1lvalue,
3374 : : is_op1const);
3375 : 504 : tree p2 = m2treelib_get_set_address_if_var (location, op2, is_op2lvalue,
3376 : : is_op2const);
3377 : 504 : unsigned int fieldNo = 0;
3378 : 504 : tree field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
3379 : 504 : tree field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
3380 : :
3381 : 504 : m2assert_AssertLocation (location);
3382 : 504 : ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op1)) == RECORD_TYPE);
3383 : 504 : ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op2)) == RECORD_TYPE);
3384 : :
3385 : 7248 : while (field1 != NULL && field2 != NULL)
3386 : : {
3387 : 6744 : m2statement_DoJump (
3388 : : location,
3389 : : (*expr) (location,
3390 : : m2treelib_get_set_value (location, p1, field1, is_op1const,
3391 : : is_op1lvalue, op1, fieldNo),
3392 : : m2treelib_get_set_value (location, p2, field2, is_op2const,
3393 : : is_op2lvalue, op2, fieldNo)),
3394 : : NULL, label);
3395 : 6744 : fieldNo++;
3396 : 6744 : field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
3397 : 6744 : field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
3398 : : }
3399 : 504 : }
3400 : :
3401 : : /* BuildIfInRangeGoto returns a tree containing if var is in the
3402 : : range low..high then goto label. */
3403 : :
3404 : : void
3405 : 80 : m2expr_BuildIfInRangeGoto (location_t location, tree var, tree low, tree high,
3406 : : char *label)
3407 : : {
3408 : 80 : m2assert_AssertLocation (location);
3409 : :
3410 : 80 : if (m2expr_CompareTrees (low, high) == 0)
3411 : 60 : m2statement_DoJump (location, m2expr_BuildEqualTo (location, var, low),
3412 : : NULL, label);
3413 : : else
3414 : 20 : m2statement_DoJump (
3415 : : location,
3416 : : m2expr_build_binary_op (
3417 : : location, TRUTH_ANDIF_EXPR,
3418 : : m2expr_BuildGreaterThanOrEqual (location, var, low),
3419 : : m2expr_BuildLessThanOrEqual (location, var, high), false),
3420 : : NULL, label);
3421 : 80 : }
3422 : :
3423 : : /* BuildIfNotInRangeGoto returns a tree containing if var is not in
3424 : : the range low..high then goto label. */
3425 : :
3426 : : void
3427 : 26 : m2expr_BuildIfNotInRangeGoto (location_t location, tree var, tree low,
3428 : : tree high, char *label)
3429 : : {
3430 : 26 : m2assert_AssertLocation (location);
3431 : :
3432 : 26 : if (m2expr_CompareTrees (low, high) == 0)
3433 : 0 : m2statement_DoJump (location, m2expr_BuildNotEqualTo (location, var, low),
3434 : : NULL, label);
3435 : : else
3436 : 26 : m2statement_DoJump (
3437 : : location, m2expr_build_binary_op (
3438 : : location, TRUTH_ORIF_EXPR,
3439 : : m2expr_BuildLessThan (location, var, low),
3440 : : m2expr_BuildGreaterThan (location, var, high), false),
3441 : : NULL, label);
3442 : 26 : }
3443 : :
3444 : : /* BuildArray - returns a tree which accesses array[index] given,
3445 : : lowIndice. */
3446 : :
3447 : : tree
3448 : 35706 : m2expr_BuildArray (location_t location, tree type, tree array, tree index,
3449 : : tree low_indice)
3450 : : {
3451 : 35706 : tree array_type = m2tree_skip_type_decl (TREE_TYPE (array));
3452 : 35706 : tree index_type = TYPE_DOMAIN (array_type);
3453 : 35706 : type = m2tree_skip_type_decl (type);
3454 : : // ASSERT_CONDITION (low_indice == TYPE_MIN_VALUE (index_type));
3455 : :
3456 : 35706 : low_indice
3457 : 35706 : = m2convert_BuildConvert (location, index_type, low_indice, false);
3458 : 35706 : return build4_loc (location, ARRAY_REF, type, array, index, low_indice,
3459 : 35706 : NULL_TREE);
3460 : : }
3461 : :
3462 : : /* BuildComponentRef - build a component reference tree which
3463 : : accesses record.field. If field does not belong to record it
3464 : : calls BuildComponentRef on the penultimate field. */
3465 : :
3466 : : tree
3467 : 210353 : m2expr_BuildComponentRef (location_t location, tree record, tree field)
3468 : : {
3469 : 211061 : tree recordType = m2tree_skip_reference_type (
3470 : 211061 : m2tree_skip_type_decl (TREE_TYPE (record)));
3471 : :
3472 : 211061 : if (DECL_CONTEXT (field) == recordType)
3473 : 210353 : return build3 (COMPONENT_REF, TREE_TYPE (field), record, field, NULL_TREE);
3474 : : else
3475 : : {
3476 : 708 : tree f = determinePenultimateField (recordType, field);
3477 : 708 : return m2expr_BuildComponentRef (
3478 : 708 : location, m2expr_BuildComponentRef (location, record, f), field);
3479 : : }
3480 : : }
3481 : :
3482 : : /* BuildIndirect - build: (*target) given that the object to be
3483 : : copied is of, type. */
3484 : :
3485 : : tree
3486 : 90508 : m2expr_BuildIndirect (location_t location ATTRIBUTE_UNUSED, tree target,
3487 : : tree type)
3488 : : {
3489 : : /* Note that the second argument to build1 is:
3490 : :
3491 : : TYPE_QUALS is a list of modifiers such as const or volatile to apply
3492 : : to the pointer type, represented as identifiers.
3493 : :
3494 : : it also determines the type of arithmetic and size of the object to
3495 : : be indirectly moved. */
3496 : :
3497 : 90508 : tree t1 = m2tree_skip_type_decl (type);
3498 : 90508 : tree t2 = build_pointer_type (t1);
3499 : :
3500 : 90508 : m2assert_AssertLocation (location);
3501 : :
3502 : 90508 : return build1 (INDIRECT_REF, t1,
3503 : 90508 : m2convert_BuildConvert (location, t2, target, false));
3504 : : }
3505 : :
3506 : : /* IsTrue - returns true if, t, is known to be true. */
3507 : :
3508 : : bool
3509 : 43968 : m2expr_IsTrue (tree t)
3510 : : {
3511 : 43968 : return (m2expr_FoldAndStrip (t) == m2type_GetBooleanTrue ());
3512 : : }
3513 : :
3514 : : /* IsFalse - returns false if, t, is known to be false. */
3515 : :
3516 : : bool
3517 : 0 : m2expr_IsFalse (tree t)
3518 : : {
3519 : 0 : return (m2expr_FoldAndStrip (t) == m2type_GetBooleanFalse ());
3520 : : }
3521 : :
3522 : : /* AreConstantsEqual - maps onto tree.cc (tree_int_cst_equal). It
3523 : : returns true if the value of e1 is the same as e2. */
3524 : :
3525 : : bool
3526 : 920553 : m2expr_AreConstantsEqual (tree e1, tree e2)
3527 : : {
3528 : 920553 : return tree_int_cst_equal (e1, e2) != 0;
3529 : : }
3530 : :
3531 : : /* AreRealOrComplexConstantsEqual - returns true if constants, e1 and
3532 : : e2 are equal according to IEEE rules. This does not perform bit
3533 : : equivalence for example IEEE states that -0 == 0 and NaN != NaN. */
3534 : :
3535 : : bool
3536 : 162 : m2expr_AreRealOrComplexConstantsEqual (tree e1, tree e2)
3537 : : {
3538 : 162 : if (TREE_CODE (e1) == COMPLEX_CST)
3539 : 54 : return (m2expr_AreRealOrComplexConstantsEqual (TREE_REALPART (e1),
3540 : 54 : TREE_REALPART (e2))
3541 : 108 : && m2expr_AreRealOrComplexConstantsEqual (TREE_IMAGPART (e1),
3542 : 54 : TREE_IMAGPART (e2)));
3543 : : else
3544 : 108 : return real_compare (EQ_EXPR, &TREE_REAL_CST (e1), &TREE_REAL_CST (e2));
3545 : : }
3546 : :
3547 : : /* DetermineSign, returns -1 if e<0 0 if e==0 1 if e>0
3548 : : an unsigned constant will never return -1. */
3549 : :
3550 : : int
3551 : 0 : m2expr_DetermineSign (tree e)
3552 : : {
3553 : 0 : return tree_int_cst_sgn (e);
3554 : : }
3555 : :
3556 : : /* Similar to build_int_2 () but allows you to specify the type of
3557 : : the integer constant that you are creating. */
3558 : :
3559 : : static tree
3560 : 282 : build_int_2_type (HOST_WIDE_INT low, HOST_WIDE_INT hi, tree type)
3561 : : {
3562 : 282 : tree value;
3563 : 282 : HOST_WIDE_INT ival[3];
3564 : :
3565 : 282 : ival[0] = low;
3566 : 282 : ival[1] = hi;
3567 : 282 : ival[2] = 0;
3568 : :
3569 : 282 : widest_int wval = widest_int::from_array (ival, 3);
3570 : 282 : value = wide_int_to_tree (type, wval);
3571 : :
3572 : 282 : return value;
3573 : : }
3574 : :
3575 : : /* BuildCap - builds the Modula-2 function CAP(t) and returns the
3576 : : result in a gcc Tree. */
3577 : :
3578 : : tree
3579 : 94 : m2expr_BuildCap (location_t location, tree t)
3580 : : {
3581 : 94 : tree tt;
3582 : 94 : tree out_of_range, less_than, greater_than, translated;
3583 : :
3584 : 94 : m2assert_AssertLocation (location);
3585 : :
3586 : 94 : t = fold (t);
3587 : 94 : if (t == error_mark_node)
3588 : : return error_mark_node;
3589 : :
3590 : 94 : tt = TREE_TYPE (t);
3591 : :
3592 : 94 : t = fold (convert (m2type_GetM2CharType (), t));
3593 : :
3594 : 94 : if (TREE_CODE (tt) == INTEGER_TYPE)
3595 : : {
3596 : 94 : less_than = fold (m2expr_build_binary_op (
3597 : : location, LT_EXPR, t,
3598 : : build_int_2_type ('a', 0, m2type_GetM2CharType ()), 0));
3599 : 94 : greater_than = fold (m2expr_build_binary_op (
3600 : : location, GT_EXPR, t,
3601 : : build_int_2_type ('z', 0, m2type_GetM2CharType ()), 0));
3602 : 94 : out_of_range = fold (m2expr_build_binary_op (
3603 : : location, TRUTH_ORIF_EXPR, less_than, greater_than, 0));
3604 : :
3605 : 94 : translated = fold (convert (
3606 : : m2type_GetM2CharType (),
3607 : : m2expr_build_binary_op (
3608 : : location, MINUS_EXPR, t,
3609 : : build_int_2_type ('a' - 'A', 0, m2type_GetM2CharType ()), 0)));
3610 : :
3611 : 94 : return fold_build3 (COND_EXPR, m2type_GetM2CharType (), out_of_range, t,
3612 : : translated);
3613 : : }
3614 : :
3615 : 0 : error_at (location,
3616 : : "argument to CAP is not a constant or variable of type CHAR");
3617 : 0 : return error_mark_node;
3618 : : }
3619 : :
3620 : : /* BuildDivM2 if iso or pim4 then all modulus results are positive
3621 : : and the results from the division are rounded to the floor otherwise
3622 : : use BuildDivTrunc. */
3623 : :
3624 : : tree
3625 : 3409 : m2expr_BuildDivM2 (location_t location, tree op1, tree op2,
3626 : : bool needsconvert)
3627 : : {
3628 : 3409 : op1 = m2expr_FoldAndStrip (op1);
3629 : 3409 : op2 = m2expr_FoldAndStrip (op2);
3630 : 3409 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3631 : : /* If iso or pim4 then build and return ((op2 < 0) ? (op1
3632 : : divceil op2) : (op1 divfloor op2)) otherwise use divtrunc. */
3633 : 3437 : if (M2Options_GetPIM4 () || M2Options_GetISO ()
3634 : 3437 : || M2Options_GetPositiveModFloor ())
3635 : 3381 : return fold_build3 (
3636 : : COND_EXPR, TREE_TYPE (op1),
3637 : : m2expr_BuildLessThan (
3638 : : location, op2,
3639 : : m2convert_BuildConvert (location, TREE_TYPE (op2),
3640 : : m2expr_GetIntegerZero (location), false)),
3641 : : m2expr_BuildDivCeil (location, op1, op2, needsconvert),
3642 : : m2expr_BuildDivFloor (location, op1, op2, needsconvert));
3643 : : else
3644 : 28 : return m2expr_BuildDivTrunc (location, op1, op2, needsconvert);
3645 : : }
3646 : :
3647 : : /* BuildDivM2Check - build and
3648 : : return ((op2 < 0) ? (op1 divtrunc op2) : (op1 divfloor op2))
3649 : : when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
3650 : : return op1 div trunc op2. Use the checking div equivalents. */
3651 : :
3652 : : tree
3653 : 1643 : m2expr_BuildDivM2Check (location_t location, tree op1, tree op2,
3654 : : tree lowest, tree min, tree max)
3655 : : {
3656 : 1643 : op1 = m2expr_FoldAndStrip (op1);
3657 : 1643 : op2 = m2expr_FoldAndStrip (op2);
3658 : 1643 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3659 : 1643 : if (M2Options_GetISO ()
3660 : 1643 : || M2Options_GetPIM4 () || M2Options_GetPositiveModFloor ())
3661 : 1611 : return fold_build3 (
3662 : : COND_EXPR, TREE_TYPE (op1),
3663 : : m2expr_BuildLessThan (
3664 : : location, op2,
3665 : : m2convert_BuildConvert (location, TREE_TYPE (op2),
3666 : : m2expr_GetIntegerZero (location), false)),
3667 : : m2expr_BuildDivCeilCheck (location, op1, op2, lowest, min, max),
3668 : : m2expr_BuildDivFloorCheck (location, op1, op2, lowest, min, max));
3669 : : else
3670 : 32 : return m2expr_BuildDivTruncCheck (location, op1, op2, lowest, min, max);
3671 : : }
3672 : :
3673 : : static
3674 : : tree
3675 : 1786 : m2expr_BuildISOModM2Check (location_t location,
3676 : : tree op1, tree op2, tree lowest, tree min, tree max)
3677 : : {
3678 : 3572 : tree cond = m2expr_BuildLessThan (location, op2,
3679 : 1786 : m2convert_BuildConvert (location, TREE_TYPE (op2),
3680 : : m2expr_GetIntegerZero (location), false));
3681 : :
3682 : : /* Return the result of the modulus. */
3683 : 1786 : return fold_build3 (COND_EXPR, TREE_TYPE (op1), cond,
3684 : : /* op2 < 0. */
3685 : : m2expr_BuildModCeilCheck (location, op1, op2, lowest, min, max),
3686 : : /* op2 >= 0. */
3687 : : m2expr_BuildModFloorCheck (location, op1, op2, lowest, min, max));
3688 : : }
3689 : :
3690 : :
3691 : : /* BuildModM2Check if iso or pim4 then build and return ((op2 < 0) ? (op1
3692 : : modceil op2) : (op1 modfloor op2)) otherwise use modtrunc.
3693 : : Use the checking mod equivalents. */
3694 : :
3695 : : tree
3696 : 1790 : m2expr_BuildModM2Check (location_t location, tree op1, tree op2,
3697 : : tree lowest, tree min, tree max)
3698 : : {
3699 : 1790 : op1 = m2expr_FoldAndStrip (op1);
3700 : 1790 : op2 = m2expr_FoldAndStrip (op2);
3701 : 1790 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3702 : 1794 : if (M2Options_GetPIM4 () || M2Options_GetISO ()
3703 : 1794 : || M2Options_GetPositiveModFloor ())
3704 : 1786 : return m2expr_BuildISOModM2Check (location, op1, op2, lowest, min, max);
3705 : : else
3706 : 4 : return m2expr_BuildModTruncCheck (location, op1, op2, lowest, min, max);
3707 : : }
3708 : :
3709 : : /* BuildModM2 if iso or pim4 then build and return ((op2 < 0) ? (op1
3710 : : modceil op2) : (op1 modfloor op2)) otherwise use modtrunc. */
3711 : :
3712 : : tree
3713 : 244 : m2expr_BuildModM2 (location_t location, tree op1, tree op2,
3714 : : bool needsconvert)
3715 : : {
3716 : 244 : op1 = m2expr_FoldAndStrip (op1);
3717 : 244 : op2 = m2expr_FoldAndStrip (op2);
3718 : 244 : ASSERT_CONDITION (TREE_TYPE (op1) == TREE_TYPE (op2));
3719 : 316 : if (M2Options_GetPIM4 () || M2Options_GetISO ()
3720 : 316 : || M2Options_GetPositiveModFloor ())
3721 : 172 : return fold_build3 (
3722 : : COND_EXPR, TREE_TYPE (op1),
3723 : : m2expr_BuildLessThan (
3724 : : location, op2,
3725 : : m2convert_BuildConvert (location, TREE_TYPE (op2),
3726 : : m2expr_GetIntegerZero (location), false)),
3727 : : m2expr_BuildModCeil (location, op1, op2, needsconvert),
3728 : : m2expr_BuildModFloor (location, op1, op2, needsconvert));
3729 : : else
3730 : 72 : return m2expr_BuildModTrunc (location, op1, op2, needsconvert);
3731 : : }
3732 : :
3733 : : /* BuildAbs build the Modula-2 function ABS(t) and return the result
3734 : : in a gcc Tree. */
3735 : :
3736 : : tree
3737 : 920 : m2expr_BuildAbs (location_t location, tree t)
3738 : : {
3739 : 920 : m2assert_AssertLocation (location);
3740 : :
3741 : 920 : return m2expr_build_unary_op (location, ABS_EXPR, t, 0);
3742 : : }
3743 : :
3744 : : /* BuildRe build an expression for the function RE. */
3745 : :
3746 : : tree
3747 : 54 : m2expr_BuildRe (tree op1)
3748 : : {
3749 : 54 : op1 = m2expr_FoldAndStrip (op1);
3750 : 54 : if (TREE_CODE (op1) == COMPLEX_CST)
3751 : 36 : return fold_build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3752 : : else
3753 : 18 : return build1 (REALPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3754 : : }
3755 : :
3756 : : /* BuildIm build an expression for the function IM. */
3757 : :
3758 : : tree
3759 : 54 : m2expr_BuildIm (tree op1)
3760 : : {
3761 : 54 : op1 = m2expr_FoldAndStrip (op1);
3762 : 54 : if (TREE_CODE (op1) == COMPLEX_CST)
3763 : 36 : return fold_build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3764 : : else
3765 : 18 : return build1 (IMAGPART_EXPR, TREE_TYPE (TREE_TYPE (op1)), op1);
3766 : : }
3767 : :
3768 : : /* BuildCmplx build an expression for the function CMPLX. */
3769 : :
3770 : : tree
3771 : 486 : m2expr_BuildCmplx (location_t location, tree type, tree real, tree imag)
3772 : : {
3773 : 486 : tree scalor;
3774 : 486 : real = m2expr_FoldAndStrip (real);
3775 : 486 : imag = m2expr_FoldAndStrip (imag);
3776 : 486 : type = m2tree_skip_type_decl (type);
3777 : 486 : scalor = TREE_TYPE (type);
3778 : :
3779 : 486 : if (scalor != TREE_TYPE (real))
3780 : 414 : real = m2convert_BuildConvert (location, scalor, real, false);
3781 : 486 : if (scalor != TREE_TYPE (imag))
3782 : 432 : imag = m2convert_BuildConvert (location, scalor, imag, false);
3783 : :
3784 : 486 : if ((TREE_CODE (real) == REAL_CST) && (TREE_CODE (imag) == REAL_CST))
3785 : 414 : return build_complex (type, real, imag);
3786 : : else
3787 : 72 : return build2 (COMPLEX_EXPR, type, real, imag);
3788 : : }
3789 : :
3790 : : /* BuildBinaryForeachWordDo implements the large set operators. Each
3791 : : word of the set can be calculated by binop. This function runs along
3792 : : each word of the large set invoking the binop. */
3793 : :
3794 : : void
3795 : 916 : m2expr_BuildBinaryForeachWordDo (location_t location, tree type, tree op1,
3796 : : tree op2, tree op3,
3797 : : tree (*binop) (location_t, tree, tree, bool),
3798 : : bool is_op1lvalue, bool is_op2lvalue,
3799 : : bool is_op3lvalue, bool is_op1const,
3800 : : bool is_op2const, bool is_op3const)
3801 : : {
3802 : 916 : tree size = m2expr_GetSizeOf (location, type);
3803 : :
3804 : 916 : m2assert_AssertLocation (location);
3805 : :
3806 : 916 : ASSERT_BOOL (is_op1lvalue);
3807 : 916 : ASSERT_BOOL (is_op2lvalue);
3808 : 916 : ASSERT_BOOL (is_op3lvalue);
3809 : 916 : ASSERT_BOOL (is_op1const);
3810 : 916 : ASSERT_BOOL (is_op2const);
3811 : 916 : ASSERT_BOOL (is_op3const);
3812 : 916 : if (m2expr_CompareTrees (
3813 : : size, m2decl_BuildIntegerConstant (SET_WORD_SIZE / BITS_PER_UNIT))
3814 : : <= 0)
3815 : : /* Small set size <= TSIZE(WORD). */
3816 : 778 : m2statement_BuildAssignmentTree (
3817 : : location, m2treelib_get_rvalue (location, op1, type, is_op1lvalue),
3818 : : (*binop) (
3819 : : location, m2treelib_get_rvalue (location, op2, type, is_op2lvalue),
3820 : : m2treelib_get_rvalue (location, op3, type, is_op3lvalue), false));
3821 : : else
3822 : : {
3823 : : /* Large set size > TSIZE(WORD). */
3824 : :
3825 : 138 : tree p2 = m2treelib_get_set_address_if_var (location, op2, is_op2lvalue,
3826 : : is_op2const);
3827 : 138 : tree p3 = m2treelib_get_set_address_if_var (location, op3, is_op3lvalue,
3828 : : is_op3const);
3829 : 138 : unsigned int fieldNo = 0;
3830 : 138 : tree field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
3831 : 138 : tree field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
3832 : 138 : tree field3 = m2treelib_get_field_no (type, op3, is_op3const, fieldNo);
3833 : :
3834 : 138 : if (is_op1const)
3835 : 0 : m2linemap_internal_error_at (
3836 : : location,
3837 : : "not expecting operand1 to be a constant set");
3838 : :
3839 : 882 : while (field1 != NULL && field2 != NULL && field3 != NULL)
3840 : : {
3841 : 744 : m2statement_BuildAssignmentTree (
3842 : : location, m2treelib_get_set_field_des (location, op1, field1),
3843 : : (*binop) (
3844 : : location,
3845 : : m2treelib_get_set_value (location, p2, field2, is_op2const,
3846 : : is_op2lvalue, op2, fieldNo),
3847 : : m2treelib_get_set_value (location, p3, field3, is_op3const,
3848 : : is_op3lvalue, op3, fieldNo),
3849 : : false));
3850 : 744 : fieldNo++;
3851 : 744 : field1 = m2treelib_get_field_no (type, op1, is_op1const, fieldNo);
3852 : 744 : field2 = m2treelib_get_field_no (type, op2, is_op2const, fieldNo);
3853 : 744 : field3 = m2treelib_get_field_no (type, op3, is_op3const, fieldNo);
3854 : : }
3855 : : }
3856 : 916 : }
3857 : :
3858 : :
3859 : : /* StrToWideInt return true if an overflow occurs when attempting to convert
3860 : : str to an unsigned ZTYPE the value is contained in the widest_int result.
3861 : : The value result is undefined if true is returned. */
3862 : :
3863 : : bool
3864 : 707794 : m2expr_StrToWideInt (location_t location, const char *str, unsigned int base,
3865 : : widest_int &result, bool issueError)
3866 : : {
3867 : 707794 : tree type = m2type_GetM2ZType ();
3868 : 707794 : unsigned int i = 0;
3869 : 707794 : wi::overflow_type overflow = wi::OVF_NONE;
3870 : 707794 : widest_int wbase = wi::to_widest (m2decl_BuildIntegerConstant (base));
3871 : 707794 : unsigned int digit = 0;
3872 : 707794 : result = wi::to_widest (m2decl_BuildIntegerConstant (0));
3873 : 707794 : bool base_specifier = false;
3874 : :
3875 : 1886662 : while (((str[i] != (char)0) && (overflow == wi::OVF_NONE))
3876 : 3065482 : && (! base_specifier))
3877 : : {
3878 : 1178844 : char ch = str[i];
3879 : :
3880 : 1178844 : switch (base)
3881 : : {
3882 : : /* GNU m2 extension allows 'A' to represent binary literals. */
3883 : 336 : case 2:
3884 : 336 : if (ch == 'A')
3885 : : base_specifier = true;
3886 : 312 : else if ((ch < '0') || (ch > '1'))
3887 : : {
3888 : 0 : if (issueError)
3889 : 0 : error_at (location,
3890 : : "constant literal %qs contains %qc, expected 0 or 1",
3891 : : str, ch);
3892 : 0 : return true;
3893 : : }
3894 : : else
3895 : 312 : digit = (unsigned int) (ch - '0');
3896 : : break;
3897 : 316838 : case 8:
3898 : : /* An extension of 'B' indicates octal ZTYPE and 'C' octal character. */
3899 : 316838 : if ((ch == 'B') || (ch == 'C'))
3900 : : base_specifier = true;
3901 : 314614 : else if ((ch < '0') || (ch > '7'))
3902 : : {
3903 : 0 : if (issueError)
3904 : 0 : error_at (location,
3905 : : "constant literal %qs contains %qc, expected %qs",
3906 : : str, ch, "0..7");
3907 : 0 : return true;
3908 : : }
3909 : : else
3910 : 314614 : digit = (unsigned int) (ch - '0');
3911 : : break;
3912 : 855704 : case 10:
3913 : 855704 : if ((ch < '0') || (ch > '9'))
3914 : : {
3915 : 0 : if (issueError)
3916 : 0 : error_at (location,
3917 : : "constant literal %qs contains %qc, expected %qs",
3918 : : str, ch, "0..9");
3919 : 0 : return true;
3920 : : }
3921 : : else
3922 : 855704 : digit = (unsigned int) (ch - '0');
3923 : 855704 : break;
3924 : 5966 : case 16:
3925 : : /* An extension of 'H' indicates hexidecimal ZTYPE. */
3926 : 5966 : if (ch == 'H')
3927 : : base_specifier = true;
3928 : 5332 : else if ((ch >= '0') && (ch <= '9'))
3929 : 3752 : digit = (unsigned int) (ch - '0');
3930 : 1580 : else if ((ch >= 'A') && (ch <= 'F'))
3931 : 1580 : digit = ((unsigned int) (ch - 'A')) + 10;
3932 : : else
3933 : : {
3934 : 0 : if (issueError)
3935 : 0 : error_at (location,
3936 : : "constant literal %qs contains %qc, expected %qs or %qs",
3937 : : str, ch, "0..9", "A..F");
3938 : 0 : return true;
3939 : : }
3940 : : break;
3941 : 0 : default:
3942 : 0 : gcc_unreachable ();
3943 : : }
3944 : :
3945 : 1178844 : if (! base_specifier)
3946 : : {
3947 : 1175962 : widest_int wdigit = wi::to_widest (m2decl_BuildIntegerConstant (digit));
3948 : 1175962 : result = wi::umul (result, wbase, &overflow);
3949 : 1175962 : if (overflow == wi::OVF_NONE)
3950 : 1175938 : result = wi::add (result, wdigit, UNSIGNED, &overflow);
3951 : : }
3952 : 1178844 : i++;
3953 : : }
3954 : 707794 : if (overflow == wi::OVF_NONE)
3955 : : {
3956 : 707770 : tree value = wide_int_to_tree (type, result);
3957 : 707770 : if (m2expr_TreeOverflow (value))
3958 : : {
3959 : 0 : if (issueError)
3960 : 0 : error_at (location,
3961 : : "constant literal %qs exceeds internal ZTYPE range", str);
3962 : 0 : return true;
3963 : : }
3964 : : return false;
3965 : : }
3966 : : else
3967 : : {
3968 : 24 : if (issueError)
3969 : 12 : error_at (location,
3970 : : "constant literal %qs exceeds internal ZTYPE range", str);
3971 : 24 : return true;
3972 : : }
3973 : : }
3974 : :
3975 : :
3976 : : /* GetSizeOfInBits return the number of bits used to contain, type. */
3977 : :
3978 : : tree
3979 : 48 : m2expr_GetSizeOfInBits (tree type)
3980 : : {
3981 : 72 : enum tree_code code = TREE_CODE (type);
3982 : :
3983 : 72 : if (code == FUNCTION_TYPE)
3984 : 0 : return m2expr_GetSizeOfInBits (ptr_type_node);
3985 : :
3986 : : if (code == VOID_TYPE)
3987 : : {
3988 : 0 : error ("%qs applied to a void type", "sizeof");
3989 : 0 : return size_one_node;
3990 : : }
3991 : :
3992 : : if (code == VAR_DECL)
3993 : 0 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
3994 : :
3995 : : if (code == PARM_DECL)
3996 : 0 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
3997 : :
3998 : : if (code == TYPE_DECL)
3999 : 24 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
4000 : :
4001 : : if (code == COMPONENT_REF)
4002 : 0 : return m2expr_GetSizeOfInBits (TREE_TYPE (type));
4003 : :
4004 : : if (code == ERROR_MARK)
4005 : 0 : return size_one_node;
4006 : :
4007 : 48 : if (!COMPLETE_TYPE_P (type))
4008 : : {
4009 : 0 : error ("%qs applied to an incomplete type", "sizeof");
4010 : 0 : return size_zero_node;
4011 : : }
4012 : :
4013 : 48 : return m2decl_BuildIntegerConstant (TYPE_PRECISION (type));
4014 : : }
4015 : :
4016 : : /* GetSizeOf taken from c-typeck.cc (c_sizeof). */
4017 : :
4018 : : tree
4019 : 32770013 : m2expr_GetSizeOf (location_t location, tree type)
4020 : : {
4021 : 32788198 : enum tree_code code = TREE_CODE (type);
4022 : 32788198 : m2assert_AssertLocation (location);
4023 : :
4024 : 32788198 : if (code == FUNCTION_TYPE)
4025 : 0 : return m2expr_GetSizeOf (location, m2type_GetPointerType ());
4026 : :
4027 : : if (code == VOID_TYPE)
4028 : 0 : return size_one_node;
4029 : :
4030 : : if (code == VAR_DECL)
4031 : 1204 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4032 : :
4033 : : if (code == PARM_DECL)
4034 : 86 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4035 : :
4036 : : if (code == TYPE_DECL)
4037 : 16867 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4038 : :
4039 : : if (code == ERROR_MARK)
4040 : 42 : return size_one_node;
4041 : :
4042 : : if (code == CONSTRUCTOR)
4043 : 0 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4044 : :
4045 : : if (code == FIELD_DECL)
4046 : 0 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4047 : :
4048 : : if (code == COMPONENT_REF)
4049 : 28 : return m2expr_GetSizeOf (location, TREE_TYPE (type));
4050 : :
4051 : 32769971 : if (!COMPLETE_TYPE_P (type))
4052 : : {
4053 : 0 : error_at (location, "%qs applied to an incomplete type", "SIZE");
4054 : 0 : return size_zero_node;
4055 : : }
4056 : :
4057 : : /* Convert in case a char is more than one unit. */
4058 : 65539942 : return size_binop_loc (
4059 : 32769971 : location, CEIL_DIV_EXPR, TYPE_SIZE_UNIT (type),
4060 : 32769971 : size_int (TYPE_PRECISION (char_type_node) / BITS_PER_UNIT));
4061 : : }
4062 : :
4063 : : tree
4064 : 252578 : m2expr_GetIntegerZero (location_t location ATTRIBUTE_UNUSED)
4065 : : {
4066 : 252578 : return integer_zero_node;
4067 : : }
4068 : :
4069 : : tree
4070 : 43186 : m2expr_GetIntegerOne (location_t location ATTRIBUTE_UNUSED)
4071 : : {
4072 : 43186 : return integer_one_node;
4073 : : }
4074 : :
4075 : : tree
4076 : 22890 : m2expr_GetCardinalOne (location_t location)
4077 : : {
4078 : 22890 : return m2convert_ToCardinal (location, integer_one_node);
4079 : : }
4080 : :
4081 : : tree
4082 : 23701 : m2expr_GetCardinalZero (location_t location)
4083 : : {
4084 : 23701 : return m2convert_ToCardinal (location, integer_zero_node);
4085 : : }
4086 : :
4087 : : tree
4088 : 1366 : m2expr_GetWordZero (location_t location)
4089 : : {
4090 : 1366 : return m2convert_ToWord (location, integer_zero_node);
4091 : : }
4092 : :
4093 : : tree
4094 : 390088 : m2expr_GetWordOne (location_t location)
4095 : : {
4096 : 390088 : return m2convert_ToWord (location, integer_one_node);
4097 : : }
4098 : :
4099 : : tree
4100 : 50981 : m2expr_GetPointerZero (location_t location)
4101 : : {
4102 : 50981 : return m2convert_convertToPtr (location, integer_zero_node);
4103 : : }
4104 : :
4105 : : tree
4106 : 11652 : m2expr_GetPointerOne (location_t location)
4107 : : {
4108 : 11652 : return m2convert_convertToPtr (location, integer_one_node);
4109 : : }
4110 : :
4111 : : /* build_set_full_complement return a word size value with all bits
4112 : : set to one. */
4113 : :
4114 : : static tree
4115 : 11652 : build_set_full_complement (location_t location)
4116 : : {
4117 : 11652 : tree value = integer_zero_node;
4118 : 11652 : int i;
4119 : :
4120 : 11652 : m2assert_AssertLocation (location);
4121 : :
4122 : 396168 : for (i = 0; i < SET_WORD_SIZE; i++)
4123 : : {
4124 : 372864 : value = m2expr_BuildLogicalOr (
4125 : : location, value,
4126 : : m2expr_BuildLSL (
4127 : : location, m2expr_GetWordOne (location),
4128 : : m2convert_BuildConvert (location, m2type_GetWordType (),
4129 : : m2decl_BuildIntegerConstant (i), false),
4130 : : false),
4131 : : false);
4132 : : }
4133 : 11652 : return value;
4134 : : }
4135 : :
4136 : :
4137 : : /* GetCstInteger return the integer value of the cst tree. */
4138 : :
4139 : : int
4140 : 1562 : m2expr_GetCstInteger (tree cst)
4141 : : {
4142 : 1562 : return TREE_INT_CST_LOW (cst);
4143 : : }
4144 : :
4145 : :
4146 : : /* init initialise this module. */
4147 : :
4148 : : void
4149 : 11652 : m2expr_init (location_t location)
4150 : : {
4151 : 11652 : m2assert_AssertLocation (location);
4152 : :
4153 : 11652 : set_full_complement = build_set_full_complement (location);
4154 : 11652 : }
4155 : :
4156 : : #include "gt-m2-m2expr.h"
|
