1 /* m2expr.cc provides an interface to GCC expression trees.
3 Copyright (C) 2012-2023 Free Software Foundation, Inc.
4 Contributed by Gaius Mulley <gaius@glam.ac.uk>.
6 This file is part of GNU Modula-2.
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)
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.
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/>. */
22 #include "gcc-consolidation.h"
24 #include "../gm2-lang.h"
25 #include "../m2-tree.h"
26 #include "m2convert.h"
32 #include "m2builtins.h"
33 #include "m2convert.h"
36 #include "m2options.h"
38 #include "m2statement.h"
40 #include "m2treelib.h"
43 static void m2expr_checkRealOverflow (location_t location
, enum tree_code code
,
45 static tree
checkWholeNegateOverflow (location_t location
, tree i
, tree lowest
,
47 // static tree m2expr_Build4LogicalAnd (location_t location, tree a, tree b,
49 static tree
m2expr_Build4LogicalOr (location_t location
, tree a
, tree b
,
51 static tree
m2expr_Build4TruthOrIf (location_t location
, tree a
, tree b
,
53 static tree
m2expr_Build4TruthAndIf (location_t location
, tree a
, tree b
,
56 static int label_count
= 0;
57 static GTY (()) tree set_full_complement
;
59 /* CompareTrees returns -1 if e1 < e2, 0 if e1 == e2, and 1 if e1 > e2. */
62 m2expr_CompareTrees (tree e1
, tree e2
)
64 return tree_int_cst_compare (m2expr_FoldAndStrip (e1
),
65 m2expr_FoldAndStrip (e2
));
68 /* FoldAndStrip return expression, t, after it has been folded (if
72 m2expr_FoldAndStrip (tree t
)
77 if (TREE_CODE (t
) == CONST_DECL
)
78 return m2expr_FoldAndStrip (DECL_INITIAL (t
));
84 /* StringLength returns an unsigned int which is the length of, string. */
87 m2expr_StringLength (tree string
)
89 return TREE_STRING_LENGTH (string
);
92 /* CheckAddressToCardinal if op is a pointer convert it to the ADDRESS type. */
95 CheckAddressToCardinal (location_t location
, tree op
)
97 if (m2type_IsAddress (TREE_TYPE (op
)))
98 return m2convert_BuildConvert (location
, m2type_GetCardinalAddressType (),
103 /* BuildTruthAndIf return TRUE if a && b. Retain order left to right. */
106 m2expr_BuildTruthAndIf (location_t location
, tree a
, tree b
)
108 return m2expr_build_binary_op (location
, TRUTH_ANDIF_EXPR
, a
, b
, FALSE
);
111 /* BuildTruthOrIf return TRUE if a || b. Retain order left to right. */
114 m2expr_BuildTruthOrIf (location_t location
, tree a
, tree b
)
116 return m2expr_build_binary_op (location
, TRUTH_ORIF_EXPR
, a
, b
, FALSE
);
119 /* BuildTruthNotIf inverts the boolean value of expr and returns the result. */
122 m2expr_BuildTruthNot (location_t location
, tree expr
)
124 return m2expr_build_unary_op (location
, TRUTH_NOT_EXPR
, expr
, FALSE
);
127 /* BuildPostInc builds a post increment tree, the second operand is
131 m2expr_BuildPostInc (location_t location
, tree op
)
133 return m2expr_BuildAdd (location
, op
, build_int_cst (TREE_TYPE (op
), 1), FALSE
);
136 /* BuildPostDec builds a post decrement tree, the second operand is
140 m2expr_BuildPostDec (location_t location
, tree op
)
142 return m2expr_BuildSub (location
, op
, build_int_cst (TREE_TYPE (op
), 1), FALSE
);
145 /* BuildAddCheck builds an addition tree. */
148 m2expr_BuildAddCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
153 m2assert_AssertLocation (location
);
155 op1
= m2expr_FoldAndStrip (op1
);
156 op2
= m2expr_FoldAndStrip (op2
);
158 op1
= CheckAddressToCardinal (location
, op1
);
159 op2
= CheckAddressToCardinal (location
, op2
);
161 t
= m2expr_build_binary_op_check (location
, PLUS_EXPR
, op1
, op2
, FALSE
,
163 return m2expr_FoldAndStrip (t
);
166 /* BuildAdd builds an addition tree. */
169 m2expr_BuildAdd (location_t location
, tree op1
, tree op2
, int needconvert
)
173 m2assert_AssertLocation (location
);
175 op1
= m2expr_FoldAndStrip (op1
);
176 op2
= m2expr_FoldAndStrip (op2
);
178 op1
= CheckAddressToCardinal (location
, op1
);
179 op2
= CheckAddressToCardinal (location
, op2
);
181 t
= m2expr_build_binary_op (location
, PLUS_EXPR
, op1
, op2
, needconvert
);
182 return m2expr_FoldAndStrip (t
);
185 /* BuildSubCheck builds a subtraction tree. */
188 m2expr_BuildSubCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
193 m2assert_AssertLocation (location
);
195 op1
= m2expr_FoldAndStrip (op1
);
196 op2
= m2expr_FoldAndStrip (op2
);
198 op1
= CheckAddressToCardinal (location
, op1
);
199 op2
= CheckAddressToCardinal (location
, op2
);
201 t
= m2expr_build_binary_op_check (location
, MINUS_EXPR
, op1
, op2
, FALSE
,
203 return m2expr_FoldAndStrip (t
);
206 /* BuildSub builds a subtraction tree. */
209 m2expr_BuildSub (location_t location
, tree op1
, tree op2
, int needconvert
)
213 m2assert_AssertLocation (location
);
215 op1
= m2expr_FoldAndStrip (op1
);
216 op2
= m2expr_FoldAndStrip (op2
);
218 op1
= CheckAddressToCardinal (location
, op1
);
219 op2
= CheckAddressToCardinal (location
, op2
);
221 t
= m2expr_build_binary_op (location
, MINUS_EXPR
, op1
, op2
, needconvert
);
222 return m2expr_FoldAndStrip (t
);
225 /* BuildDivTrunc builds a trunc division tree. */
228 m2expr_BuildDivTrunc (location_t location
, tree op1
, tree op2
, int needconvert
)
232 m2assert_AssertLocation (location
);
234 op1
= m2expr_FoldAndStrip (op1
);
235 op2
= m2expr_FoldAndStrip (op2
);
237 op1
= CheckAddressToCardinal (location
, op1
);
238 op2
= CheckAddressToCardinal (location
, op2
);
240 t
= m2expr_build_binary_op (location
, TRUNC_DIV_EXPR
, op1
, op2
, needconvert
);
241 return m2expr_FoldAndStrip (t
);
244 /* BuildDivTruncCheck builds a trunc division tree. */
247 m2expr_BuildDivTruncCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
252 m2assert_AssertLocation (location
);
254 op1
= m2expr_FoldAndStrip (op1
);
255 op2
= m2expr_FoldAndStrip (op2
);
257 op1
= CheckAddressToCardinal (location
, op1
);
258 op2
= CheckAddressToCardinal (location
, op2
);
260 t
= m2expr_build_binary_op_check (location
, TRUNC_DIV_EXPR
, op1
, op2
, FALSE
,
262 return m2expr_FoldAndStrip (t
);
265 /* BuildModTruncCheck builds a trunc modulus tree. */
268 m2expr_BuildModTruncCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
273 m2assert_AssertLocation (location
);
275 op1
= m2expr_FoldAndStrip (op1
);
276 op2
= m2expr_FoldAndStrip (op2
);
278 op1
= CheckAddressToCardinal (location
, op1
);
279 op2
= CheckAddressToCardinal (location
, op2
);
281 t
= m2expr_build_binary_op_check (location
, TRUNC_MOD_EXPR
, op1
, op2
, FALSE
,
283 return m2expr_FoldAndStrip (t
);
286 /* BuildModTrunc builds a trunc modulus tree. */
289 m2expr_BuildModTrunc (location_t location
, tree op1
, tree op2
, int needconvert
)
293 m2assert_AssertLocation (location
);
295 op1
= m2expr_FoldAndStrip (op1
);
296 op2
= m2expr_FoldAndStrip (op2
);
298 op1
= CheckAddressToCardinal (location
, op1
);
299 op2
= CheckAddressToCardinal (location
, op2
);
301 t
= m2expr_build_binary_op (location
, TRUNC_MOD_EXPR
, op1
, op2
, needconvert
);
302 return m2expr_FoldAndStrip (t
);
305 /* BuildModCeilCheck builds a ceil modulus tree. */
308 m2expr_BuildModCeilCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
313 m2assert_AssertLocation (location
);
315 op1
= m2expr_FoldAndStrip (op1
);
316 op2
= m2expr_FoldAndStrip (op2
);
318 op1
= CheckAddressToCardinal (location
, op1
);
319 op2
= CheckAddressToCardinal (location
, op2
);
321 t
= m2expr_build_binary_op_check (location
, CEIL_MOD_EXPR
, op1
, op2
, FALSE
,
323 return m2expr_FoldAndStrip (t
);
326 /* BuildModFloorCheck builds a trunc modulus tree. */
329 m2expr_BuildModFloorCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
334 m2assert_AssertLocation (location
);
336 op1
= m2expr_FoldAndStrip (op1
);
337 op2
= m2expr_FoldAndStrip (op2
);
339 op1
= CheckAddressToCardinal (location
, op1
);
340 op2
= CheckAddressToCardinal (location
, op2
);
342 t
= m2expr_build_binary_op_check (location
, FLOOR_MOD_EXPR
, op1
, op2
, FALSE
,
344 return m2expr_FoldAndStrip (t
);
347 /* BuildDivCeil builds a ceil division tree. */
350 m2expr_BuildDivCeil (location_t location
, tree op1
, tree op2
, int needconvert
)
354 m2assert_AssertLocation (location
);
356 op1
= m2expr_FoldAndStrip (op1
);
357 op2
= m2expr_FoldAndStrip (op2
);
359 op1
= CheckAddressToCardinal (location
, op1
);
360 op2
= CheckAddressToCardinal (location
, op2
);
362 t
= m2expr_build_binary_op (location
, CEIL_DIV_EXPR
, op1
, op2
, needconvert
);
363 return m2expr_FoldAndStrip (t
);
366 /* BuildDivCeilCheck builds a check ceil division tree. */
369 m2expr_BuildDivCeilCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
374 m2assert_AssertLocation (location
);
376 op1
= m2expr_FoldAndStrip (op1
);
377 op2
= m2expr_FoldAndStrip (op2
);
379 op1
= CheckAddressToCardinal (location
, op1
);
380 op2
= CheckAddressToCardinal (location
, op2
);
382 t
= m2expr_build_binary_op_check (location
, CEIL_DIV_EXPR
, op1
, op2
, FALSE
,
384 return m2expr_FoldAndStrip (t
);
387 /* BuildModCeil builds a ceil modulus tree. */
390 m2expr_BuildModCeil (location_t location
, tree op1
, tree op2
, int needconvert
)
394 m2assert_AssertLocation (location
);
396 op1
= m2expr_FoldAndStrip (op1
);
397 op2
= m2expr_FoldAndStrip (op2
);
399 op1
= CheckAddressToCardinal (location
, op1
);
400 op2
= CheckAddressToCardinal (location
, op2
);
402 t
= m2expr_build_binary_op (location
, CEIL_MOD_EXPR
, op1
, op2
, needconvert
);
403 return m2expr_FoldAndStrip (t
);
406 /* BuildDivFloor builds a floor division tree. */
409 m2expr_BuildDivFloor (location_t location
, tree op1
, tree op2
, int needconvert
)
413 m2assert_AssertLocation (location
);
415 op1
= m2expr_FoldAndStrip (op1
);
416 op2
= m2expr_FoldAndStrip (op2
);
418 op1
= CheckAddressToCardinal (location
, op1
);
419 op2
= CheckAddressToCardinal (location
, op2
);
421 t
= m2expr_build_binary_op (location
, FLOOR_DIV_EXPR
, op1
, op2
, needconvert
);
422 return m2expr_FoldAndStrip (t
);
425 /* BuildDivFloorCheck builds a check floor division tree. */
428 m2expr_BuildDivFloorCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
433 m2assert_AssertLocation (location
);
435 op1
= m2expr_FoldAndStrip (op1
);
436 op2
= m2expr_FoldAndStrip (op2
);
438 op1
= CheckAddressToCardinal (location
, op1
);
439 op2
= CheckAddressToCardinal (location
, op2
);
441 t
= m2expr_build_binary_op_check (location
, FLOOR_DIV_EXPR
, op1
, op2
, FALSE
,
443 return m2expr_FoldAndStrip (t
);
446 /* BuildRDiv builds a division tree (this should only be used for
447 REAL and COMPLEX types and NEVER for integer based types). */
450 m2expr_BuildRDiv (location_t location
, tree op1
, tree op2
, int needconvert
)
454 m2assert_AssertLocation (location
);
456 op1
= m2expr_FoldAndStrip (op1
);
457 op2
= m2expr_FoldAndStrip (op2
);
459 t
= m2expr_build_binary_op (location
, RDIV_EXPR
, op1
, op2
, needconvert
);
460 return m2expr_FoldAndStrip (t
);
463 /* BuildModFloor builds a modulus tree. */
466 m2expr_BuildModFloor (location_t location
, tree op1
, tree op2
, int needconvert
)
470 m2assert_AssertLocation (location
);
472 op1
= m2expr_FoldAndStrip (op1
);
473 op2
= m2expr_FoldAndStrip (op2
);
475 op1
= CheckAddressToCardinal (location
, op1
);
476 op2
= CheckAddressToCardinal (location
, op2
);
478 t
= m2expr_build_binary_op (location
, FLOOR_MOD_EXPR
, op1
, op2
, needconvert
);
479 return m2expr_FoldAndStrip (t
);
482 /* BuildLSL builds and returns tree (op1 << op2). */
485 m2expr_BuildLSL (location_t location
, tree op1
, tree op2
, int needconvert
)
489 m2assert_AssertLocation (location
);
491 op1
= m2expr_FoldAndStrip (op1
);
492 op2
= m2expr_FoldAndStrip (op2
);
494 t
= m2expr_build_binary_op (location
, LSHIFT_EXPR
, op1
, op2
, needconvert
);
495 return m2expr_FoldAndStrip (t
);
498 /* BuildLSR builds and returns tree (op1 >> op2). */
501 m2expr_BuildLSR (location_t location
, tree op1
, tree op2
, int needconvert
)
505 m2assert_AssertLocation (location
);
507 op1
= m2expr_FoldAndStrip (op1
);
508 op2
= m2expr_FoldAndStrip (op2
);
510 t
= m2expr_build_binary_op (location
, RSHIFT_EXPR
, op1
, op2
, needconvert
);
511 return m2expr_FoldAndStrip (t
);
514 /* createUniqueLabel returns a unique label which has been alloc'ed. */
517 createUniqueLabel (void)
524 size
= strlen (".LSHIFT") + 2;
530 label
= (char *)ggc_alloc_atomic (size
);
531 sprintf (label
, ".LSHIFT%d", label_count
);
535 /* BuildLogicalShift builds the ISO Modula-2 SHIFT operator for a
536 fundamental data type. */
539 m2expr_BuildLogicalShift (location_t location
, tree op1
, tree op2
, tree op3
,
540 tree nBits ATTRIBUTE_UNUSED
, int needconvert
)
544 m2assert_AssertLocation (location
);
545 op2
= m2expr_FoldAndStrip (op2
);
546 op3
= m2expr_FoldAndStrip (op3
);
547 if (TREE_CODE (op3
) == INTEGER_CST
)
549 op2
= m2convert_ToWord (location
, op2
);
550 if (tree_int_cst_sgn (op3
) < 0)
551 res
= m2expr_BuildLSR (
553 m2convert_ToWord (location
,
554 m2expr_BuildNegate (location
, op3
, needconvert
)),
557 res
= m2expr_BuildLSL (location
, op2
, m2convert_ToWord (location
, op3
),
559 res
= m2convert_BuildConvert (
560 location
, m2tree_skip_type_decl (TREE_TYPE (op1
)), res
, FALSE
);
561 m2statement_BuildAssignmentTree (location
, op1
, res
);
565 char *labelElseName
= createUniqueLabel ();
566 char *labelEndName
= createUniqueLabel ();
567 tree is_less
= m2expr_BuildLessThan (location
,
568 m2convert_ToInteger (location
, op3
),
569 m2expr_GetIntegerZero (location
));
571 m2statement_DoJump (location
, is_less
, NULL
, labelElseName
);
572 op2
= m2convert_ToWord (location
, op2
);
573 op3
= m2convert_ToWord (location
, op3
);
574 res
= m2expr_BuildLSL (location
, op2
, op3
, needconvert
);
575 res
= m2convert_BuildConvert (
576 location
, m2tree_skip_type_decl (TREE_TYPE (op1
)), res
, FALSE
);
577 m2statement_BuildAssignmentTree (location
, op1
, res
);
578 m2statement_BuildGoto (location
, labelEndName
);
579 m2statement_DeclareLabel (location
, labelElseName
);
580 res
= m2expr_BuildLSR (location
, op2
,
581 m2expr_BuildNegate (location
, op3
, needconvert
),
583 res
= m2convert_BuildConvert (
584 location
, m2tree_skip_type_decl (TREE_TYPE (op1
)), res
, FALSE
);
585 m2statement_BuildAssignmentTree (location
, op1
, res
);
586 m2statement_DeclareLabel (location
, labelEndName
);
590 /* BuildLRL builds and returns tree (op1 rotate left by op2 bits). */
593 m2expr_BuildLRL (location_t location
, tree op1
, tree op2
, int needconvert
)
597 m2assert_AssertLocation (location
);
599 op1
= m2expr_FoldAndStrip (op1
);
600 op2
= m2expr_FoldAndStrip (op2
);
602 t
= m2expr_build_binary_op (location
, LROTATE_EXPR
, op1
, op2
, needconvert
);
603 return m2expr_FoldAndStrip (t
);
606 /* BuildLRR builds and returns tree (op1 rotate right by op2 bits). */
609 m2expr_BuildLRR (location_t location
, tree op1
, tree op2
, int needconvert
)
613 m2assert_AssertLocation (location
);
615 op1
= m2expr_FoldAndStrip (op1
);
616 op2
= m2expr_FoldAndStrip (op2
);
618 t
= m2expr_build_binary_op (location
, RROTATE_EXPR
, op1
, op2
, needconvert
);
619 return m2expr_FoldAndStrip (t
);
622 /* m2expr_BuildMask returns a tree for the mask of a set of nBits.
623 It assumes nBits is <= TSIZE (WORD). */
626 m2expr_BuildMask (location_t location
, tree nBits
, int needconvert
)
628 tree mask
= m2expr_BuildLSL (location
, m2expr_GetIntegerOne (location
),
630 m2assert_AssertLocation (location
);
631 return m2expr_BuildSub (location
, mask
, m2expr_GetIntegerOne (location
),
635 /* m2expr_BuildLRotate returns a tree in which op1 has been left
636 rotated by nBits. It assumes nBits is <= TSIZE (WORD). */
639 m2expr_BuildLRotate (location_t location
, tree op1
, tree nBits
,
644 op1
= m2expr_FoldAndStrip (op1
);
645 nBits
= m2expr_FoldAndStrip (nBits
);
646 t
= m2expr_build_binary_op (location
, LROTATE_EXPR
, op1
, nBits
, needconvert
);
647 return m2expr_FoldAndStrip (t
);
650 /* m2expr_BuildRRotate returns a tree in which op1 has been left
651 rotated by nBits. It assumes nBits is <= TSIZE (WORD). */
654 m2expr_BuildRRotate (location_t location
, tree op1
, tree nBits
,
659 op1
= m2expr_FoldAndStrip (op1
);
660 nBits
= m2expr_FoldAndStrip (nBits
);
661 t
= m2expr_build_binary_op (location
, RROTATE_EXPR
, op1
, nBits
, needconvert
);
662 return m2expr_FoldAndStrip (t
);
665 /* BuildLRLn builds and returns tree (op1 rotate left by op2 bits) it
666 rotates a set of size, nBits. */
669 m2expr_BuildLRLn (location_t location
, tree op1
, tree op2
, tree nBits
,
674 m2assert_AssertLocation (location
);
676 /* Ensure we wrap the rotate. */
678 op2min
= m2expr_BuildModTrunc (
679 location
, m2convert_ToCardinal (location
, op2
),
680 m2convert_ToCardinal (location
, nBits
), needconvert
);
682 /* Optimize if we are we going to rotate a TSIZE(BITSET) set. */
684 if (m2expr_CompareTrees (
685 m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset ()), nBits
)
687 return m2expr_BuildLRotate (location
, op1
, op2min
, needconvert
);
690 tree mask
= m2expr_BuildMask (location
, nBits
, needconvert
);
693 /* Make absolutely sure there are no high order bits lying around. */
695 op1
= m2expr_BuildLogicalAnd (location
, op1
, mask
, needconvert
);
696 left
= m2expr_BuildLSL (location
, op1
, op2min
, needconvert
);
697 left
= m2expr_BuildLogicalAnd (location
, left
, mask
, needconvert
);
698 right
= m2expr_BuildLSR (
700 m2expr_BuildSub (location
, m2convert_ToCardinal (location
, nBits
),
701 op2min
, needconvert
),
703 return m2expr_BuildLogicalOr (location
, left
, right
, needconvert
);
707 /* BuildLRRn builds and returns tree (op1 rotate right by op2 bits).
708 It rotates a set of size, nBits. */
711 m2expr_BuildLRRn (location_t location
, tree op1
, tree op2
, tree nBits
,
716 m2assert_AssertLocation (location
);
718 /* Ensure we wrap the rotate. */
720 op2min
= m2expr_BuildModTrunc (
721 location
, m2convert_ToCardinal (location
, op2
),
722 m2convert_ToCardinal (location
, nBits
), needconvert
);
723 /* Optimize if we are we going to rotate a TSIZE(BITSET) set. */
725 if (m2expr_CompareTrees (
726 m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset ()), nBits
)
728 return m2expr_BuildRRotate (location
, op1
, op2min
, needconvert
);
731 tree mask
= m2expr_BuildMask (location
, nBits
, needconvert
);
734 /* Make absolutely sure there are no high order bits lying around. */
736 op1
= m2expr_BuildLogicalAnd (location
, op1
, mask
, needconvert
);
737 right
= m2expr_BuildLSR (location
, op1
, op2min
, needconvert
);
738 left
= m2expr_BuildLSL (
740 m2expr_BuildSub (location
, m2convert_ToCardinal (location
, nBits
),
741 op2min
, needconvert
),
743 left
= m2expr_BuildLogicalAnd (location
, left
, mask
, needconvert
);
744 return m2expr_BuildLogicalOr (location
, left
, right
, needconvert
);
748 /* BuildLogicalRotate build the ISO Modula-2 ROTATE operator for a
749 fundamental data type. */
752 m2expr_BuildLogicalRotate (location_t location
, tree op1
, tree op2
, tree op3
,
753 tree nBits
, int needconvert
)
757 m2assert_AssertLocation (location
);
758 op2
= m2expr_FoldAndStrip (op2
);
759 op3
= m2expr_FoldAndStrip (op3
);
760 if (TREE_CODE (op3
) == INTEGER_CST
)
762 if (tree_int_cst_sgn (op3
) < 0)
763 res
= m2expr_BuildLRRn (
764 location
, op2
, m2expr_BuildNegate (location
, op3
, needconvert
),
767 res
= m2expr_BuildLRLn (location
, op2
, op3
, nBits
, needconvert
);
768 m2statement_BuildAssignmentTree (location
, op1
, res
);
772 char *labelElseName
= createUniqueLabel ();
773 char *labelEndName
= createUniqueLabel ();
774 tree is_less
= m2expr_BuildLessThan (location
,
775 m2convert_ToInteger (location
, op3
),
776 m2expr_GetIntegerZero (location
));
778 m2statement_DoJump (location
, is_less
, NULL
, labelElseName
);
779 res
= m2expr_BuildLRLn (location
, op2
, op3
, nBits
, needconvert
);
780 m2statement_BuildAssignmentTree (location
, op1
, res
);
781 m2statement_BuildGoto (location
, labelEndName
);
782 m2statement_DeclareLabel (location
, labelElseName
);
783 res
= m2expr_BuildLRRn (location
, op2
,
784 m2expr_BuildNegate (location
, op3
, needconvert
),
786 m2statement_BuildAssignmentTree (location
, op1
, res
);
787 m2statement_DeclareLabel (location
, labelEndName
);
791 /* buildUnboundedArrayOf construct an unbounded struct and returns
792 the gcc tree. The two fields of the structure are initialized to
793 contentsPtr and high. */
796 buildUnboundedArrayOf (tree unbounded
, tree contentsPtr
, tree high
)
798 tree fields
= TYPE_FIELDS (unbounded
);
799 tree field_list
= NULL_TREE
;
802 field_list
= tree_cons (fields
, contentsPtr
, field_list
);
803 fields
= TREE_CHAIN (fields
);
805 field_list
= tree_cons (fields
, high
, field_list
);
807 constructor
= build_constructor_from_list (unbounded
, nreverse (field_list
));
808 TREE_CONSTANT (constructor
) = 0;
809 TREE_STATIC (constructor
) = 0;
814 /* BuildBinarySetDo if the size of the set is <= TSIZE(WORD) then op1
815 := binop(op2, op3) else call m2rtsprocedure(op1, op2, op3). */
818 m2expr_BuildBinarySetDo (location_t location
, tree settype
, tree op1
, tree op2
,
819 tree op3
, void (*binop
) (location_t
, tree
, tree
, tree
,
821 int is_op1lvalue
, int is_op2lvalue
, int is_op3lvalue
,
822 tree nBits
, tree unbounded
, tree varproc
,
823 tree leftproc
, tree rightproc
)
825 tree size
= m2expr_GetSizeOf (location
, settype
);
826 int is_const
= FALSE
;
829 m2assert_AssertLocation (location
);
831 ASSERT_BOOL (is_op1lvalue
);
832 ASSERT_BOOL (is_op2lvalue
);
833 ASSERT_BOOL (is_op3lvalue
);
835 if (m2expr_CompareTrees (
836 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
838 /* Small set size <= TSIZE(WORD). */
840 m2treelib_get_rvalue (location
, op1
, settype
, is_op1lvalue
),
841 m2treelib_get_rvalue (location
, op2
, settype
, is_op2lvalue
),
842 m2treelib_get_rvalue (location
, op3
, settype
, is_op3lvalue
),
847 tree high
= m2expr_BuildSub (
849 m2convert_ToCardinal (
851 m2expr_BuildDivTrunc (
853 m2expr_GetSizeOf (location
, m2type_GetBitsetType ()),
855 m2expr_GetCardinalOne (location
), FALSE
);
857 /* If op3 is constant then make op3 positive and remember which
858 direction we are shifting. */
860 op3
= m2tree_skip_const_decl (op3
);
861 if (TREE_CODE (op3
) == INTEGER_CST
)
864 if (tree_int_cst_sgn (op3
) < 0)
865 op3
= m2expr_BuildNegate (location
, op3
, FALSE
);
868 op3
= m2convert_BuildConvert (location
, m2type_GetM2CardinalType (),
872 /* These parameters must match the prototypes of the procedures:
873 ShiftLeft, ShiftRight, ShiftVal, RotateLeft, RotateRight, RotateVal
874 inside gm2-iso/SYSTEM.mod. */
876 /* Remember we must build the parameters in reverse. */
878 /* Parameter 4 amount. */
879 m2statement_BuildParam (
881 m2convert_BuildConvert (
882 location
, m2type_GetM2IntegerType (),
883 m2treelib_get_rvalue (location
, op3
,
884 m2tree_skip_type_decl (TREE_TYPE (op3
)),
888 /* Parameter 3 nBits. */
889 m2statement_BuildParam (
891 m2convert_BuildConvert (location
, m2type_GetM2CardinalType (),
892 m2expr_FoldAndStrip (nBits
), FALSE
));
894 /* Parameter 2 destination set. */
895 m2statement_BuildParam (
897 buildUnboundedArrayOf (
899 m2treelib_get_set_address (location
, op1
, is_op1lvalue
), high
));
901 /* Parameter 1 source set. */
902 m2statement_BuildParam (
904 buildUnboundedArrayOf (
906 m2treelib_get_set_address (location
, op2
, is_op2lvalue
), high
));
908 /* Now call the appropriate procedure inside SYSTEM.mod. */
911 result
= m2statement_BuildProcedureCallTree (location
, leftproc
,
914 result
= m2statement_BuildProcedureCallTree (location
, rightproc
,
917 result
= m2statement_BuildProcedureCallTree (location
, varproc
,
919 add_stmt (location
, result
);
923 /* Print a warning if a constant expression had overflow in folding.
924 Invoke this function on every expression that the language requires
925 to be a constant expression. */
928 m2expr_ConstantExpressionWarning (tree value
)
930 if ((TREE_CODE (value
) == INTEGER_CST
|| TREE_CODE (value
) == REAL_CST
931 || TREE_CODE (value
) == FIXED_CST
|| TREE_CODE (value
) == VECTOR_CST
932 || TREE_CODE (value
) == COMPLEX_CST
)
933 && TREE_OVERFLOW (value
))
934 pedwarn (input_location
, OPT_Woverflow
, "overflow in constant expression");
937 /* TreeOverflow return TRUE if the contant expression, t, has caused
938 an overflow. No error message or warning is emitted and no
939 modification is made to, t. */
942 m2expr_TreeOverflow (tree t
)
944 if ((TREE_CODE (t
) == INTEGER_CST
945 || (TREE_CODE (t
) == COMPLEX_CST
946 && TREE_CODE (TREE_REALPART (t
)) == INTEGER_CST
))
947 && TREE_OVERFLOW (t
))
949 else if ((TREE_CODE (t
) == REAL_CST
950 || (TREE_CODE (t
) == COMPLEX_CST
951 && TREE_CODE (TREE_REALPART (t
)) == REAL_CST
))
952 && TREE_OVERFLOW (t
))
958 /* RemoveOverflow if tree, t, is a constant expression it removes any
959 overflow flag and returns, t. */
962 m2expr_RemoveOverflow (tree t
)
964 if (TREE_CODE (t
) == INTEGER_CST
965 || (TREE_CODE (t
) == COMPLEX_CST
966 && TREE_CODE (TREE_REALPART (t
)) == INTEGER_CST
))
967 TREE_OVERFLOW (t
) = 0;
968 else if (TREE_CODE (t
) == REAL_CST
969 || (TREE_CODE (t
) == COMPLEX_CST
970 && TREE_CODE (TREE_REALPART (t
)) == REAL_CST
))
971 TREE_OVERFLOW (t
) = 0;
975 /* BuildCoerce return a tree containing the expression, expr, after
976 it has been coersed to, type. */
979 m2expr_BuildCoerce (location_t location
, tree des
, tree type
, tree expr
)
981 tree copy
= copy_node (expr
);
982 TREE_TYPE (copy
) = type
;
984 m2assert_AssertLocation (location
);
986 return m2treelib_build_modify_expr (location
, des
, NOP_EXPR
, copy
);
989 /* BuildTrunc return an integer expression from a REAL or LONGREAL op1. */
992 m2expr_BuildTrunc (tree op1
)
994 return convert_to_integer (m2type_GetIntegerType (),
995 m2expr_FoldAndStrip (op1
));
998 /* checkUnaryWholeOverflow decide if we can check this unary expression. */
1001 m2expr_checkUnaryWholeOverflow (location_t location
, enum tree_code code
,
1002 tree arg
, tree lowest
, tree min
, tree max
)
1004 if (M2Options_GetWholeValueCheck () && (min
!= NULL
))
1006 lowest
= m2tree_skip_type_decl (lowest
);
1007 arg
= fold_convert_loc (location
, lowest
, arg
);
1012 return checkWholeNegateOverflow (location
, arg
, lowest
, min
, max
);
1020 /* build_unary_op return a unary tree node. */
1023 m2expr_build_unary_op_check (location_t location
, enum tree_code code
,
1024 tree arg
, tree lowest
, tree min
, tree max
)
1026 tree argtype
= TREE_TYPE (arg
);
1030 m2assert_AssertLocation (location
);
1032 arg
= m2expr_FoldAndStrip (arg
);
1034 if ((TREE_CODE (argtype
) != REAL_TYPE
) && (min
!= NULL
))
1035 check
= m2expr_checkUnaryWholeOverflow (location
, code
, arg
, lowest
, min
, max
);
1037 result
= build1 (code
, argtype
, arg
);
1038 protected_set_expr_location (result
, location
);
1041 result
= build2 (COMPOUND_EXPR
, argtype
, check
, result
);
1043 if (TREE_CODE (argtype
) == REAL_TYPE
)
1044 m2expr_checkRealOverflow (location
, code
, result
);
1046 return m2expr_FoldAndStrip (result
);
1049 /* build_unary_op return a unary tree node. */
1052 m2expr_build_unary_op (location_t location
, enum tree_code code
, tree arg
,
1053 int flag ATTRIBUTE_UNUSED
)
1055 tree argtype
= TREE_TYPE (arg
);
1058 m2assert_AssertLocation (location
);
1060 arg
= m2expr_FoldAndStrip (arg
);
1061 result
= build1 (code
, argtype
, arg
);
1062 protected_set_expr_location (result
, location
);
1064 return m2expr_FoldAndStrip (result
);
1067 /* build_binary_op is a heavily pruned version of the one found in
1068 c-typeck.cc. The Modula-2 expression rules are much more restricted
1072 build_binary_op (location_t location
, enum tree_code code
, tree op1
, tree op2
,
1073 int convert ATTRIBUTE_UNUSED
)
1075 tree type1
= TREE_TYPE (op1
);
1078 m2assert_AssertLocation (location
);
1080 /* Strip NON_LVALUE_EXPRs, etc., since we aren't using as an lvalue. */
1081 STRIP_TYPE_NOPS (op1
);
1082 STRIP_TYPE_NOPS (op2
);
1084 op1
= m2expr_FoldAndStrip (op1
);
1085 op2
= m2expr_FoldAndStrip (op2
);
1087 result
= build2 (code
, type1
, op1
, op2
);
1088 protected_set_expr_location (result
, location
);
1090 return m2expr_FoldAndStrip (result
);
1093 /* BuildLessThanZero - returns a tree containing (< value 0). It
1094 checks the min and max value to ensure that the test can be safely
1095 achieved and will short circuit the result otherwise. */
1098 m2expr_BuildLessThanZero (location_t location
, tree value
, tree type
, tree min
,
1101 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) >= 0)
1102 /* min is greater than or equal to zero therefore value will always
1104 return m2expr_GetIntegerZero (location
);
1105 else if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) == -1)
1106 /* max is less than zero therefore value will always be < 0. */
1107 return m2expr_GetIntegerOne (location
);
1108 /* We now know 0 lies in the range min..max so we can safely cast
1110 return m2expr_BuildLessThan (
1112 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1115 /* BuildGreaterThanZero - returns a tree containing (> value 0). It
1116 checks the min and max value to ensure that the test can be safely
1117 achieved and will short circuit the result otherwise. */
1120 m2expr_BuildGreaterThanZero (location_t location
, tree value
, tree type
,
1123 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) == 1)
1124 /* min is greater than zero therefore value will always be > 0. */
1125 return m2expr_GetIntegerOne (location
);
1126 else if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) <= 0)
1127 /* max is less than or equal to zero therefore value will always be
1129 return m2expr_GetIntegerZero (location
);
1130 /* We now know 0 lies in the range min..max so we can safely cast
1132 return m2expr_BuildGreaterThan (
1134 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1137 /* BuildEqualToZero - returns a tree containing (= value 0). It
1138 checks the min and max value to ensure that the test can be safely
1139 achieved and will short circuit the result otherwise. */
1142 m2expr_BuildEqualToZero (location_t location
, tree value
, tree type
, tree min
,
1145 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) == 1)
1146 /* min is greater than zero therefore value will always be > 0. */
1147 return m2expr_GetIntegerZero (location
);
1148 else if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) < 0)
1149 /* max is less than or equal to zero therefore value will always be <
1151 return m2expr_GetIntegerZero (location
);
1152 /* We now know 0 lies in the range min..max so we can safely cast
1154 return m2expr_BuildEqualTo (
1156 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1159 /* BuildNotEqualToZero - returns a tree containing (# value 0). It
1160 checks the min and max value to ensure that the test can be safely
1161 achieved and will short circuit the result otherwise. */
1164 m2expr_BuildNotEqualToZero (location_t location
, tree value
, tree type
,
1167 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) == 1)
1168 /* min is greater than zero therefore value will always be true. */
1169 return m2expr_GetIntegerOne (location
);
1170 else if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) < 0)
1171 /* max is less than or equal to zero therefore value will always be
1173 return m2expr_GetIntegerOne (location
);
1174 /* We now know 0 lies in the range min..max so we can safely cast
1176 return m2expr_BuildNotEqualTo (
1178 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1182 /* BuildGreaterThanOrEqualZero - returns a tree containing (>= value 0). It
1183 checks the min and max value to ensure that the test can be safely
1184 achieved and will short circuit the result otherwise. */
1187 m2expr_BuildGreaterThanOrEqualZero (location_t location
, tree value
, tree type
,
1190 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) >= 0)
1191 /* min is greater than or equal to zero therefore value will always be >= 0. */
1192 return m2expr_GetIntegerOne (location
);
1193 else if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) < 0)
1194 /* max is less than zero therefore value will always be < 0. */
1195 return m2expr_GetIntegerZero (location
);
1196 /* We now know 0 lies in the range min..max so we can safely cast
1198 return m2expr_BuildGreaterThan (
1200 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1204 /* BuildLessThanOrEqualZero - returns a tree containing (<= value 0). It
1205 checks the min and max value to ensure that the test can be safely
1206 achieved and will short circuit the result otherwise. */
1209 m2expr_BuildLessThanOrEqualZero (location_t location
, tree value
, tree type
,
1212 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) > 0)
1213 /* min is greater than zero therefore value will always be > 0. */
1214 return m2expr_GetIntegerZero (location
);
1215 else if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) <= 0)
1216 /* max is less than or equal to zero therefore value will always be <= 0. */
1217 return m2expr_GetIntegerOne (location
);
1218 /* We now know 0 lies in the range min..max so we can safely cast
1220 return m2expr_BuildLessThanOrEqual (
1222 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1226 /* get_current_function_name, return the name of the current function if
1227 it currently exists. NULL is returned if we are not inside a function. */
1230 get_current_function_name (void)
1232 if (current_function_decl
!= NULL
1233 && (DECL_NAME (current_function_decl
) != NULL
)
1234 && (IDENTIFIER_POINTER (DECL_NAME (current_function_decl
)) != NULL
))
1235 return IDENTIFIER_POINTER (DECL_NAME (current_function_decl
));
1239 /* checkWholeNegateOverflow - check to see whether -arg will overflow
1242 PROCEDURE sneg (i: INTEGER) ;
1250 general purpose subrange type, i, is currently legal, min is
1251 MIN(type) and max is MAX(type).
1253 PROCEDURE sneg (i: type) ;
1257 (* cannot overflow if i is 0 *)
1259 (* will overflow if entire range is positive. *)
1261 (* will overflow if entire range is negative. *)
1263 (* c7 and c8 and c9 and c10 -> c17 more units positive. *)
1264 ((min < 0) AND (max > 0) AND ((min + max) > 0) AND (i > -min)) OR
1265 (* c11 and c12 and c13 and c14 -> c18 more units negative. *)
1266 ((min < 0) AND (max > 0) AND ((min + max) < 0) AND (i < -max)))
1273 checkWholeNegateOverflow (location_t location
,
1274 tree i
, tree type
, tree min
,
1278 = m2expr_BuildNotEqualToZero (location
, i
, type
, min
, max
); /* i # 0. */
1279 tree c1
= m2expr_BuildGreaterThanZero (location
, min
, type
, min
,
1280 max
); /* min > 0. */
1281 tree c2
= m2expr_BuildEqualToZero (location
, min
, type
, min
,
1282 max
); /* min == 0. */
1283 tree c4
= m2expr_BuildLessThanZero (location
, max
, type
, min
,
1284 max
); /* max < 0. */
1285 tree c5
= m2expr_BuildEqualToZero (location
, max
, type
, min
,
1286 max
); /* max == 0. */
1287 tree c7
= m2expr_BuildLessThanZero (location
, min
, type
, min
,
1288 max
); /* min < 0. */
1289 tree c8
= m2expr_BuildGreaterThanZero (location
, max
, type
, min
,
1290 max
); /* max > 0. */
1291 tree c9
= m2expr_BuildGreaterThanZero (
1292 location
, m2expr_BuildAdd (location
, min
, max
, FALSE
), type
, min
,
1293 max
); /* min + max > 0. */
1294 tree c10
= m2expr_BuildGreaterThan (
1295 location
, i
, m2expr_BuildNegate (location
, min
, FALSE
)); /* i > -min. */
1296 tree c11
= m2expr_BuildLessThanZero (
1297 location
, m2expr_BuildAdd (location
, min
, max
, FALSE
), type
, min
,
1298 max
); /* min + max < 0. */
1299 tree c12
= m2expr_BuildLessThan (
1300 location
, i
, m2expr_BuildNegate (location
, max
, FALSE
)); /* i < -max. */
1302 tree b1
= m2expr_BuildTruthOrIf (location
, c1
, c2
);
1303 tree b2
= m2expr_BuildTruthOrIf (location
, c8
, c5
);
1304 tree o1
= m2expr_BuildTruthAndIf (location
, b1
, b2
);
1306 tree b3
= m2expr_BuildTruthOrIf (location
, c7
, c2
);
1307 tree b4
= m2expr_BuildTruthOrIf (location
, c4
, c5
);
1308 tree o2
= m2expr_BuildTruthAndIf (location
, b3
, b4
);
1310 tree o3
= m2expr_Build4TruthAndIf (location
, c7
, c8
, c9
, c10
);
1311 tree o4
= m2expr_Build4TruthAndIf (location
, c7
, c8
, c11
, c12
);
1313 tree a2
= m2expr_Build4TruthOrIf (location
, o1
, o2
, o3
, o4
);
1315 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, a1
, a2
));
1317 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1318 get_current_function_name (),
1319 "whole value unary minus will cause range overflow");
1323 /* checkWholeAddOverflow - check to see whether op1 + op2 will
1324 overflow an integer.
1326 PROCEDURE sadd (i, j: INTEGER) ;
1328 IF ((j>0) AND (i > MAX(INTEGER)-j)) OR ((j<0) AND (i < MIN(INTEGER)-j))
1330 'signed addition overflow'
1335 checkWholeAddOverflow (location_t location
, tree i
, tree j
, tree lowest
,
1338 tree j_gt_zero
= m2expr_BuildGreaterThanZero (location
, j
, lowest
, min
, max
);
1339 tree i_gt_max_sub_j
= m2expr_BuildGreaterThan (
1340 location
, i
, m2expr_BuildSub (location
, max
, j
, FALSE
));
1341 tree j_lt_zero
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
1342 tree i_lt_min_sub_j
= m2expr_BuildLessThan (location
, i
,
1343 m2expr_BuildSub (location
, min
, j
, FALSE
));
1344 tree lhs_or
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, j_gt_zero
, i_gt_max_sub_j
));
1345 tree rhs_or
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, j_lt_zero
, i_lt_min_sub_j
));
1347 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, lhs_or
, rhs_or
));
1348 tree result
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1349 get_current_function_name (),
1350 "whole value addition will cause a range overflow");
1354 /* checkWholeSubOverflow - check to see whether op1 - op2 will
1355 overflow an integer.
1357 PROCEDURE ssub (i, j: INTEGER) ;
1359 IF ((j>0) AND (i < MIN(INTEGER)+j)) OR ((j<0) AND (i > MAX(INTEGER)+j))
1361 'signed subtraction overflow'
1366 checkWholeSubOverflow (location_t location
, tree i
, tree j
, tree lowest
,
1369 tree c1
= m2expr_BuildGreaterThanZero (location
, j
, lowest
, min
, max
);
1370 tree c2
= m2expr_BuildLessThan (location
, i
,
1371 m2expr_BuildAdd (location
, min
, j
, FALSE
));
1372 tree c3
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
1373 tree c4
= m2expr_BuildGreaterThan (location
, i
,
1374 m2expr_BuildAdd (location
, max
, j
, FALSE
));
1375 tree c5
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, c1
, c2
));
1376 tree c6
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, c3
, c4
));
1378 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, c5
, c6
));
1379 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1380 get_current_function_name (),
1381 "whole value subtraction will cause a range overflow");
1385 /* Build4TruthAndIf - return TRUE if a && b && c && d. Retain order left to
1389 m2expr_Build4TruthAndIf (location_t location
, tree a
, tree b
, tree c
, tree d
)
1391 tree t1
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, a
, b
));
1392 tree t2
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, t1
, c
));
1393 return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, t2
, d
));
1396 /* Build3TruthAndIf - return TRUE if a && b && c. Retain order left to right.
1400 m2expr_Build3TruthAndIf (location_t location
, tree op1
, tree op2
, tree op3
)
1402 tree t
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, op1
, op2
));
1403 return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, t
, op3
));
1406 /* Build3TruthOrIf - return TRUE if a || b || c. Retain order left to right.
1410 m2expr_Build3TruthOrIf (location_t location
, tree op1
, tree op2
, tree op3
)
1412 tree t
= m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, op1
, op2
));
1413 return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, t
, op3
));
1416 /* Build4TruthOrIf - return TRUE if op1 || op2 || op3 || op4. Retain order
1420 m2expr_Build4TruthOrIf (location_t location
, tree op1
, tree op2
, tree op3
,
1423 tree t1
= m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, op1
, op2
));
1424 tree t2
= m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, t1
, op3
));
1425 return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, t2
, op4
));
1428 /* Build4LogicalOr - return TRUE if op1 || op2 || op3 || op4. */
1431 m2expr_Build4LogicalOr (location_t location
, tree op1
, tree op2
, tree op3
,
1434 tree t1
= m2expr_FoldAndStrip (
1435 m2expr_BuildLogicalOr (location
, op1
, op2
, FALSE
));
1437 = m2expr_FoldAndStrip (m2expr_BuildLogicalOr (location
, t1
, op3
, FALSE
));
1438 return m2expr_FoldAndStrip (
1439 m2expr_BuildLogicalOr (location
, t2
, op4
, FALSE
));
1442 /* checkWholeMultOverflow - check to see whether i * j will overflow
1445 PROCEDURE smult (lhs, rhs: INTEGER) ;
1447 IF ((lhs > 0) AND (rhs > 0) AND (lhs > max DIV rhs)) OR
1448 ((lhs > 0) AND (rhs < 0) AND (rhs < min DIV lhs)) OR
1449 ((lhs < 0) AND (rhs > 0) AND (lhs < min DIV rhs)) OR
1450 ((lhs < 0) AND (rhs < 0) AND (lhs < max DIV rhs))
1452 error ('signed multiplication overflow')
1456 if ((c1 && c3 && c4)
1459 || (c2 && c5 && c8))
1460 error ('signed subtraction overflow'). */
1463 testWholeMultOverflow (location_t location
, tree lhs
, tree rhs
,
1464 tree lowest
, tree min
, tree max
)
1466 tree c1
= m2expr_BuildGreaterThanZero (location
, lhs
, lowest
, min
, max
);
1467 tree c2
= m2expr_BuildLessThanZero (location
, lhs
, lowest
, min
, max
);
1469 tree c3
= m2expr_BuildGreaterThanZero (location
, rhs
, lowest
, min
, max
);
1470 tree c4
= m2expr_BuildGreaterThan (
1471 location
, lhs
, m2expr_BuildDivTrunc (location
, max
, rhs
, FALSE
));
1473 tree c5
= m2expr_BuildLessThanZero (location
, rhs
, lowest
, min
, max
);
1474 tree c6
= m2expr_BuildLessThan (
1475 location
, rhs
, m2expr_BuildDivTrunc (location
, min
, lhs
, FALSE
));
1476 tree c7
= m2expr_BuildLessThan (
1477 location
, lhs
, m2expr_BuildDivTrunc (location
, min
, rhs
, FALSE
));
1478 tree c8
= m2expr_BuildLessThan (
1479 location
, lhs
, m2expr_BuildDivTrunc (location
, max
, rhs
, FALSE
));
1481 tree c9
= m2expr_Build3TruthAndIf (location
, c1
, c3
, c4
);
1482 tree c10
= m2expr_Build3TruthAndIf (location
, c1
, c5
, c6
);
1483 tree c11
= m2expr_Build3TruthAndIf (location
, c2
, c3
, c7
);
1484 tree c12
= m2expr_Build3TruthAndIf (location
, c2
, c5
, c8
);
1486 tree condition
= m2expr_Build4LogicalOr (location
, c9
, c10
, c11
, c12
);
1492 checkWholeMultOverflow (location_t location
, tree i
, tree j
, tree lowest
,
1495 tree condition
= testWholeMultOverflow (location
, i
, j
, lowest
, min
, max
);
1496 tree result
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1497 get_current_function_name (),
1498 "whole value multiplication will cause a range overflow");
1504 divMinUnderflow (location_t location
, tree value
, tree lowest
, tree min
, tree max
)
1506 tree min2
= m2expr_BuildMult (location
, min
, min
, FALSE
);
1507 tree rhs
= m2expr_BuildGreaterThanOrEqual (location
, value
, min2
);
1508 tree lhs
= testWholeMultOverflow (location
, min
, min
, lowest
, min
, max
);
1509 return m2expr_BuildTruthAndIf (location
, lhs
, rhs
);
1513 divexpr - returns true if a DIV_TRUNC b will overflow.
1516 /* checkWholeDivOverflow - check to see whether i DIV_TRUNC j will overflow
1517 an integer. The Modula-2 implementation of the GCC trees follows:
1519 PROCEDURE divtruncexpr (a, b: INTEGER) : BOOLEAN ;
1521 (* Firstly catch division by 0. *)
1523 (* Case 2 range is always negative. *)
1524 (* In which case a division will be illegal as result will be positive. *)
1526 (* Case 1 both min / max are positive, check for underflow. *)
1527 ((min >= 0) AND (max >= 0) AND (multMinOverflow (b) OR (a < b * min))) OR
1528 (* Case 1 both min / max are positive, check for overflow. *)
1529 ((min >= 0) AND (max >= 0) AND (divMinUnderflow (a) OR (b > a DIV min))) OR
1530 (* Case 3 mixed range, need to check underflow. *)
1531 ((min < 0) AND (max >= 0) AND (a < 0) AND (b < 0) AND (b >= a DIV min)) OR
1532 ((min < 0) AND (max >= 0) AND (a < 0) AND (b > 0) AND (b <= a DIV max)) OR
1533 ((min < 0) AND (max >= 0) AND (a >= 0) AND (b < 0) AND (a DIV b < min)))
1540 b4 -> (min >= 0) AND (max >= 0)
1541 b5 -> (min < 0) AND (max >= 0)
1542 a_lt_b_mult_min -> (a < b * min)
1543 b_mult_min_overflow -> testWholeMultOverflow (location, b, min, lowest, min, max)
1544 b6 -> (b_mult_min_overflow OR a_lt_b_mult_min)
1546 a_div_min_overflow -> divMinUnderflow (location, a, min, lowest, min, max)
1547 b7 -> (a_div_min_overflow OR b_gt_s1)
1560 c5 -> (b5 AND b8 AND b9 AND b11)
1561 c6 -> (b5 AND b8 AND b10 AND b12)
1562 c7 -> (b5 AND b14 AND b9 AND b13)
1564 if (c1 || c2 || c3 || c4 || c5 || c6 || c7)
1565 error ('signed div trunc overflow'). */
1568 checkWholeDivTruncOverflow (location_t location
, tree i
, tree j
, tree lowest
,
1571 tree b4a
= m2expr_BuildGreaterThanOrEqualZero (location
, min
, lowest
, min
, max
);
1572 tree b4b
= m2expr_BuildGreaterThanOrEqualZero (location
, max
, lowest
, min
, max
);
1573 tree b4
= m2expr_BuildTruthAndIf (location
, b4a
, b4b
);
1574 tree b5a
= m2expr_BuildLessThanZero (location
, min
, lowest
, min
, max
);
1575 tree b5
= m2expr_BuildTruthAndIf (location
, b5a
, b4b
);
1576 tree c1
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
1577 tree c2
= m2expr_BuildLessThanZero (location
, max
, lowest
, min
, max
);
1578 tree i_lt_j_mult_min
= m2expr_BuildLessThan (location
, i
, m2expr_BuildMult (location
, j
, min
, FALSE
));
1579 tree j_mult_min_overflow
= testWholeMultOverflow (location
, j
, min
, lowest
, min
, max
);
1580 tree b6
= m2expr_BuildTruthOrIf (location
, j_mult_min_overflow
, i_lt_j_mult_min
);
1581 tree c3
= m2expr_BuildTruthAndIf (location
, b4
, b6
);
1582 tree s1
= m2expr_BuildDivTrunc (location
, i
, min
, FALSE
);
1583 tree s2
= m2expr_BuildDivTrunc (location
, i
, max
, FALSE
);
1584 tree s3
= m2expr_BuildDivTrunc (location
, i
, j
, FALSE
);
1586 tree j_gt_s1
= m2expr_BuildGreaterThan (location
, j
, s1
);
1587 tree i_div_min_overflow
= divMinUnderflow (location
, i
, lowest
, min
, max
);
1588 tree b7
= m2expr_BuildTruthOrIf (location
, i_div_min_overflow
, j_gt_s1
);
1589 tree c4
= m2expr_BuildTruthAndIf (location
, b4
, b7
);
1590 tree b8
= m2expr_BuildLessThanZero (location
, i
, lowest
, min
, max
);
1591 tree b9
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
1592 tree b10
= m2expr_BuildGreaterThanZero (location
, j
, lowest
, min
, max
);
1593 tree b11
= m2expr_BuildGreaterThanOrEqual (location
, j
, s1
);
1594 tree b12
= m2expr_BuildLessThanOrEqual (location
, j
, s2
);
1595 tree b13
= m2expr_BuildLessThan (location
, s3
, min
);
1596 tree b14
= m2expr_BuildGreaterThanOrEqualZero (location
, i
, lowest
, min
, max
);
1597 tree c5
= m2expr_Build4TruthAndIf (location
, b5
, b8
, b9
, b11
);
1598 tree c6
= m2expr_Build4TruthAndIf (location
, b5
, b8
, b10
, b12
);
1599 tree c7
= m2expr_Build4TruthAndIf (location
, b5
, b14
, b9
, b13
);
1600 tree c8
= m2expr_Build4TruthOrIf (location
, c1
, c2
, c3
, c4
);
1601 tree condition
= m2expr_Build4TruthOrIf (location
, c5
, c6
, c7
, c8
);
1602 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1603 get_current_function_name (),
1604 "whole value truncated division will cause a range overflow");
1610 divexpr
- returns
true if a DIV_CEIL b will overflow
.
1613 (* checkWholeDivCeilOverflow
- check to see whether i DIV_CEIL j will overflow
1616 PROCEDURE
divceilexpr (i
, j
: INTEGER
) : BOOLEAN
;
1618 RETURN ((j
= 0) OR (* division by zero
. *)
1619 (maxT
< 0) OR (* both inputs are
< 0 and max is
< 0,
1621 ((i
# 0) AND (* first operand is legally zero,
1622 result is also legally zero
. *)
1623 divCeilOverflowCases (i
, j
)))
1628 divCeilOverflowCases
- precondition
: i
, j are in range values
.
1629 postcondition
: TRUE is returned
if i divceil will
1630 result in an overflow
/underflow
.
1633 PROCEDURE
divCeilOverflowCases (i
, j
: INTEGER
) : BOOLEAN
;
1635 RETURN (((i
> 0) AND (j
> 0) AND
divCeilOverflowPosPos (i
, j
)) OR
1636 ((i
< 0) AND (j
< 0) AND
divCeilOverflowNegNeg (i
, j
)) OR
1637 ((i
> 0) AND (j
< 0) AND
divCeilOverflowPosNeg (i
, j
)) OR
1638 ((i
< 0) AND (j
> 0) AND
divCeilOverflowNegPos (i
, j
)))
1639 END divCeilOverflowCases
;
1643 divCeilOverflowPosPos
- precondition
: i
, j are legal
and are both
>= 0.
1644 postcondition
: TRUE is returned
if i divceil will
1645 result in an overflow
/underflow
.
1648 PROCEDURE
divCeilOverflowPosPos (i
, j
: INTEGER
) : BOOLEAN
;
1650 RETURN (((i MOD j
= 0) AND (i
< j
* minT
)) OR
1651 (((i MOD j
# 0) AND (i < j * minT + 1))))
1652 END divCeilOverflowPosPos
;
1656 divCeilOverflowNegNeg
- precondition
: i
, j are in range values
and both
< 0.
1657 postcondition
: TRUE is returned
if i divceil will
1658 result in an overflow
/underflow
.
1661 PROCEDURE
divCeilOverflowNegNeg (i
, j
: INTEGER
) : BOOLEAN
;
1663 RETURN ((maxT
<= 0) OR (* signs will cause overflow
. *)
1664 (* check
for underflow
. *)
1665 ((ABS (i
) MOD
ABS (j
) = 0) AND (i
>= j
* minT
)) OR
1666 ((ABS (i
) MOD
ABS (j
) # 0) AND (i >= j * minT - 1)) OR
1667 (* check
for overflow
. *)
1668 (((ABS (i
) MOD maxT
) = 0) AND (ABS (i
) DIV maxT
> ABS (j
))) OR
1669 (((ABS (i
) MOD maxT
) # 0) AND (ABS (i) DIV maxT > ABS (j) + 1)))
1670 END divCeilOverflowNegNeg
;
1674 divCeilOverflowNegPos
- precondition
: i
, j are in range values
. i
< 0, j
>= 0.
1675 postcondition
: TRUE is returned
if i divceil will
1676 result in an overflow
/underflow
.
1679 PROCEDURE
divCeilOverflowNegPos (i
, j
: INTEGER
) : BOOLEAN
;
1681 (* easier than might be initially expected
. We know minT
< 0 and maxT
> 0.
1682 We know the result will be negative
and therefore we only need to test
1684 RETURN (((ABS (i
) MOD j
= 0) AND (i
< j
* minT
)) OR
1685 ((ABS (i
) MOD j
# 0) AND (i < j * minT - 1)))
1686 END divCeilOverflowNegPos
;
1690 divCeilOverflowPosNeg
- precondition
: i
, j are in range values
. i
>= 0, j
< 0.
1691 postcondition
: TRUE is returned
if i divceil will
1692 result in an overflow
/underflow
.
1695 PROCEDURE
divCeilOverflowPosNeg (i
, j
: INTEGER
) : BOOLEAN
;
1697 (* easier than might be initially expected
. We know minT
< 0 and maxT
> 0.
1698 We know the result will be negative
and therefore we only need to test
1700 RETURN (((i MOD
ABS (j
) = 0) AND (i
> j
* minT
)) OR
1701 ((i MOD
ABS (j
) # 0) AND (i > j * minT - 1)))
1702 END divCeilOverflowPosNeg
;
1705 /* divCeilOverflowPosPos, precondition: lhs, rhs are legal and are both >= 0.
1706 Postcondition: TRUE is returned if lhs divceil rhs will result
1707 in an overflow/underflow.
1709 A handbuilt expression of trees implementing:
1711 RETURN (((lhs MOD rhs = 0) AND (min >= 0) AND (lhs < rhs * min)) OR (* check for underflow, no remainder. *)
1713 (((lhs MOD rhs # 0) AND (lhs < rhs * min + 1)))) (* check for underflow with remainder. *)
1714 ((lhs > min) AND (lhs - 1 > rhs * min))
1717 a -> (lhs MOD rhs = 0) AND (lhs < rhs * min)
1718 b -> (lhs MOD rhs # 0) AND (lhs < rhs * min + 1)
1722 divCeilOverflowPosPos (location_t location
, tree i
, tree j
, tree lowest
,
1725 tree i_mod_j
= m2expr_BuildModTrunc (location
, i
, j
, FALSE
);
1726 tree i_mod_j_eq_zero
= m2expr_BuildEqualToZero (location
, i_mod_j
, lowest
, min
, max
);
1727 tree i_mod_j_ne_zero
= m2expr_BuildNotEqualToZero (location
, i_mod_j
, lowest
, min
, max
);
1728 tree j_min
= m2expr_BuildMult (location
, j
, min
, FALSE
);
1729 tree j_min_1
= m2expr_BuildAdd (location
, j_min
, m2expr_GetIntegerOne (location
), FALSE
);
1730 tree i_lt_j_min
= m2expr_BuildLessThan (location
, i
, j_min
);
1731 tree i_lt_j_min_1
= m2expr_BuildLessThan (location
, i
, j_min_1
);
1732 tree a
= m2expr_BuildTruthAndIf (location
, i_mod_j_eq_zero
, i_lt_j_min
);
1733 tree b
= m2expr_BuildTruthAndIf (location
, i_mod_j_ne_zero
, i_lt_j_min_1
);
1734 return m2expr_BuildTruthOrIf (location
, a
, b
);
1738 /* divCeilOverflowPosNeg precondition: i, j are in range values and i >=0, j < 0.
1739 Postcondition: TRUE is returned if i divceil j will result in an
1742 A handbuilt expression of trees implementing:
1744 RETURN (((i MOD ABS (j) = 0) AND (i > j * min)) OR
1745 ((i MOD ABS (j) # 0) AND (i > j * min - 1)))
1748 i_mod_abs_j -> (i MOD abs_j)
1749 i_mod_abs_j_eq_0 -> (i_mod_abs_j = 0)
1750 i_mod_abs_j_ne_0 -> (i_mod_abs_j # 0)
1751 j_mult_min -> (j * min)
1752 j_mult_min_1 -> (j_mult_min - 1)
1753 i_gt_j_mult_min -> (i > j_mult_min)
1754 i_gt_j_mult_min_1 -> (i > j_mult_min_1)
1755 a -> (i_mod_abs_j_eq_0 AND i_gt_j_mult_min)
1756 b -> (i_mod_abs_j_ne_0 AND i_gt_j_mult_min_1)
1760 divCeilOverflowPosNeg (location_t location
, tree i
, tree j
, tree lowest
, tree min
, tree max
)
1762 tree abs_j
= m2expr_BuildAbs (location
, j
);
1763 tree i_mod_abs_j
= m2expr_BuildModFloor (location
, i
, abs_j
, FALSE
);
1764 tree i_mod_abs_j_eq_0
= m2expr_BuildEqualToZero (location
, i_mod_abs_j
, lowest
, min
, max
);
1765 tree i_mod_abs_j_ne_0
= m2expr_BuildNotEqualToZero (location
, i_mod_abs_j
, lowest
, min
, max
);
1766 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, FALSE
);
1767 tree j_mult_min_1
= m2expr_BuildPostDec (location
, j_mult_min
);
1768 tree i_gt_j_mult_min
= m2expr_BuildGreaterThan (location
, i
, j_mult_min
);
1769 tree i_gt_j_mult_min_1
= m2expr_BuildGreaterThan (location
, i
, j_mult_min_1
);
1770 tree a
= m2expr_BuildTruthAndIf (location
, i_mod_abs_j_eq_0
, i_gt_j_mult_min
);
1771 tree b
= m2expr_BuildTruthAndIf (location
, i_mod_abs_j_ne_0
, i_gt_j_mult_min_1
);
1772 tree c
= m2expr_BuildTruthOrIf (location
, a
, b
);
1777 /* divCeilOverflowNegPos precondition: i, j are in range values and i < 0, j >= 0.
1778 Postcondition: TRUE is returned if i divceil j will result in an
1781 A handbuilt expression of trees implementing:
1783 RETURN (((ABS (i) MOD j = 0) AND (i < j * min)) OR
1784 ((ABS (i) MOD j # 0) AND (i < j * min - 1)))
1787 abs_i_mod_j -> (abs_i MOD j)
1788 abs_i_mod_j_eq_0 -> (abs_i_mod_j = 0)
1789 abs_i_mod_j_ne_0 -> (abs_i_mod_j # 0)
1790 j_mult_min -> (j * min)
1791 j_mult_min_1 -> (j_mult_min - 1)
1792 i_lt_j_mult_min -> (i < j_mult_min)
1793 i_lt_j_mult_min_1 -> (i < j_mult_min_1)
1794 a = (abs_i_mod_j_eq_0 AND i_lt_j_mult_min)
1795 b = (abs_i_mod_j_ne_0 AND i_lt_j_mult_min_1)
1799 divCeilOverflowNegPos (location_t location
, tree i
, tree j
, tree lowest
, tree min
, tree max
)
1801 tree abs_i
= m2expr_BuildAbs (location
, i
);
1802 tree abs_i_mod_j
= m2expr_BuildModFloor (location
, abs_i
, j
, FALSE
);
1803 tree abs_i_mod_j_eq_0
= m2expr_BuildEqualToZero (location
, abs_i_mod_j
, lowest
, min
, max
);
1804 tree abs_i_mod_j_ne_0
= m2expr_BuildNotEqualToZero (location
, abs_i_mod_j
, lowest
, min
, max
);
1805 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, FALSE
);
1806 tree j_mult_min_1
= m2expr_BuildPostDec (location
, j_mult_min
);
1807 tree i_lt_j_mult_min
= m2expr_BuildLessThan (location
, i
, j_mult_min
);
1808 tree i_lt_j_mult_min_1
= m2expr_BuildLessThan (location
, i
, j_mult_min_1
);
1809 tree a
= m2expr_BuildTruthAndIf (location
, abs_i_mod_j_eq_0
, i_lt_j_mult_min
);
1810 tree b
= m2expr_BuildTruthAndIf (location
, abs_i_mod_j_ne_0
, i_lt_j_mult_min_1
);
1811 tree c
= m2expr_BuildTruthOrIf (location
, a
, b
);
1816 /* divCeilOverflowNegNeg precondition: i, j are in range values and both < 0.
1817 Postcondition: TRUE is returned if i divceil j will result in an
1820 A handbuilt expression of trees implementing:
1822 RETURN ((max <= 0) OR (* signs will cause overflow. *)
1823 (* check for underflow. *)
1824 ((ABS (i) MOD ABS (j) = 0) AND (i >= j * min)) OR
1825 ((ABS (i) MOD ABS (j) # 0) AND (i >= j * min - 1)) OR
1826 (* check for overflow. *)
1827 (((ABS (i) MOD max) = 0) AND (ABS (i) DIV max > ABS (j))) OR
1828 (((ABS (i) MOD max) # 0) AND (ABS (i) DIV max > ABS (j) + 1)))
1830 max_lte_0 -> (max <= 0)
1833 abs_i_mod_abs_j -> (abs_i MOD abs_j)
1834 abs_i_mod_abs_j_eq_0 -> (abs_i_mod_abs_j = 0)
1835 abs_i_mod_abs_j_ne_0 -> (abs_i_mod_abs_j # 0)
1836 j_mult_min -> (j * min)
1837 j_mult_min_1 -> (j_mult_min - 1)
1838 i_ge_j_mult_min -> (i >= j_mult_min)
1839 i_ge_j_mult_min_1 -> (i >= j_mult_min_1)
1840 abs_i_mod_max -> (abs_i mod max)
1841 abs_i_div_max -> (abs_i DIVfloor max)
1842 abs_j_1 -> (abs_j + 1)
1843 abs_i_mod_max_eq_0 -> (abs_i_mod_max = 0)
1844 abs_i_mod_max_ne_0 -> (abs_i_mod_max # 0)
1845 abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
1846 abs_i_div_max_gt_abs_j_1 -> (abs_i_div_max > abs_j_1)
1848 a -> (abs_i_mod_abs_j_eq_0 AND i_ge_j_mult_min)
1849 b -> (abs_i_mod_abs_j_ne_0 AND i_ge_j_mult_min_1)
1850 c -> (abs_i_mod_max_eq_0 AND abs_i_div_max_gt_abs_j)
1851 d -> (abs_i_mod_max_ne_0 AND abs_i_div_max_gt_abs_j_1)
1852 e -> (a OR b OR c OR d)
1853 return max_lte_0 OR e. */
1856 divCeilOverflowNegNeg (location_t location
, tree i
, tree j
, tree lowest
,
1859 tree max_lte_0
= m2expr_BuildLessThanOrEqualZero (location
, max
, lowest
, min
, max
);
1860 tree abs_i
= m2expr_BuildAbs (location
, i
);
1861 tree abs_j
= m2expr_BuildAbs (location
, j
);
1862 tree abs_i_mod_abs_j
= m2expr_BuildModFloor (location
, abs_i
, abs_j
, FALSE
);
1863 tree abs_i_mod_abs_j_eq_0
= m2expr_BuildEqualToZero (location
, abs_i_mod_abs_j
,
1865 tree abs_i_mod_abs_j_ne_0
= m2expr_BuildNotEqualToZero (location
, abs_i_mod_abs_j
,
1867 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, FALSE
);
1868 tree j_mult_min_1
= m2expr_BuildPostDec (location
, j_mult_min
);
1869 tree i_ge_j_mult_min
= m2expr_BuildGreaterThanOrEqual (location
, i
, j_mult_min
);
1870 tree i_ge_j_mult_min_1
= m2expr_BuildGreaterThanOrEqual (location
, i
, j_mult_min_1
);
1871 tree abs_i_mod_max
= m2expr_BuildModFloor (location
, abs_i
, max
, FALSE
);
1872 tree abs_i_div_max
= m2expr_BuildDivFloor (location
, abs_i
, max
, FALSE
);
1873 tree abs_j_1
= m2expr_BuildPostInc (location
, abs_j
);
1874 tree abs_i_mod_max_eq_0
= m2expr_BuildEqualToZero (location
, abs_i_mod_max
, lowest
, min
, max
);
1875 tree abs_i_mod_max_ne_0
= m2expr_BuildNotEqualToZero (location
, abs_i_mod_max
, lowest
, min
, max
);
1876 tree abs_i_div_max_gt_abs_j
= m2expr_BuildGreaterThan (location
, abs_i_div_max
, abs_j
);
1877 tree abs_i_div_max_gt_abs_j_1
= m2expr_BuildGreaterThan (location
, abs_i_div_max
, abs_j_1
);
1879 tree a
= m2expr_BuildTruthAndIf (location
, abs_i_mod_abs_j_eq_0
, i_ge_j_mult_min
);
1880 tree b
= m2expr_BuildTruthAndIf (location
, abs_i_mod_abs_j_ne_0
, i_ge_j_mult_min_1
);
1881 tree c
= m2expr_BuildTruthAndIf (location
, abs_i_mod_max_eq_0
, abs_i_div_max_gt_abs_j
);
1882 tree d
= m2expr_BuildTruthAndIf (location
, abs_i_mod_max_ne_0
, abs_i_div_max_gt_abs_j_1
);
1883 tree e
= m2expr_Build4TruthOrIf (location
, a
, b
, c
, d
);
1884 return m2expr_BuildTruthOrIf (location
, max_lte_0
, e
);
1888 /* divCeilOverflowCases, precondition: i, j are in range values.
1889 Postcondition: TRUE is returned if i divceil will result in an
1892 A handbuilt expression of trees implementing:
1894 RETURN (((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j)) OR
1895 ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j)) OR
1896 ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j)) OR
1897 ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j)))
1899 a -> ((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j))
1900 b -> ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j))
1901 c -> ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j))
1902 d -> ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j))
1904 RETURN a AND b AND c AND d. */
1907 divCeilOverflowCases (location_t location
, tree i
, tree j
, tree lowest
,
1910 tree i_gt_zero
= m2expr_BuildGreaterThanZero (location
, i
, lowest
, min
, max
);
1911 tree j_gt_zero
= m2expr_BuildGreaterThanZero (location
, j
, lowest
, min
, max
);
1912 tree i_lt_zero
= m2expr_BuildLessThanZero (location
, i
, lowest
, min
, max
);
1913 tree j_lt_zero
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
1914 tree a
= m2expr_Build3TruthAndIf (location
, i_gt_zero
, j_gt_zero
,
1915 divCeilOverflowPosPos (location
, i
, j
, lowest
, min
, max
));
1916 tree b
= m2expr_Build3TruthAndIf (location
, i_lt_zero
, j_lt_zero
,
1917 divCeilOverflowNegNeg (location
, i
, j
, lowest
, min
, max
));
1918 tree c
= m2expr_Build3TruthAndIf (location
, i_gt_zero
, j_lt_zero
,
1919 divCeilOverflowPosNeg (location
, i
, j
, lowest
, min
, max
));
1920 tree d
= m2expr_Build3TruthAndIf (location
, i_lt_zero
, j_gt_zero
,
1921 divCeilOverflowNegPos (location
, i
, j
, lowest
, min
, max
));
1922 return m2expr_Build4TruthOrIf (location
, a
, b
, c
, d
);
1926 /* checkWholeDivCeilOverflow check to see whether i DIV_CEIL j will overflow
1927 an integer. A handbuilt expression of trees implementing:
1929 RETURN ((j = 0) OR (* division by zero. *)
1930 (maxT < 0) OR (* both inputs are < 0 and max is < 0,
1932 ((i # 0) AND (* first operand is legally zero,
1933 result is also legally zero. *)
1934 divCeilOverflowCases (i, j)))
1936 using the following subexpressions:
1938 j_eq_zero -> (j == 0)
1939 max_lt_zero -> (max < 0)
1940 i_ne_zero -> (i # 0). */
1943 checkWholeDivCeilOverflow (location_t location
, tree i
, tree j
, tree lowest
,
1946 tree j_eq_zero
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
1947 tree max_lt_zero
= m2expr_BuildLessThanZero (location
, max
, lowest
, min
, max
);
1948 tree i_ne_zero
= m2expr_BuildNotEqualToZero (location
, i
, lowest
, min
, max
);
1950 tree rhs
= m2expr_BuildTruthAndIf (location
,
1952 divCeilOverflowCases (location
,
1953 i
, j
, lowest
, min
, max
));
1955 if (M2Options_GetISO ())
1956 j_lt_zero
= m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
));
1958 j_lt_zero
= m2expr_GetIntegerZero (location
);
1959 j_eq_zero
= m2expr_FoldAndStrip (j_eq_zero
);
1960 max_lt_zero
= m2expr_FoldAndStrip (max_lt_zero
);
1961 i_ne_zero
= m2expr_FoldAndStrip (i_ne_zero
);
1962 rhs
= m2expr_FoldAndStrip (rhs
);
1964 tree condition
= m2expr_Build4TruthOrIf (location
, j_eq_zero
, max_lt_zero
, rhs
, j_lt_zero
);
1965 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1966 get_current_function_name (),
1967 "whole value ceil division will cause a range overflow");
1972 /* checkWholeModTruncOverflow, the GCC tree.def defines TRUNC_MOD_EXPR to return
1973 the remainder which has the same sign as the dividend. In ISO Modula-2 the
1974 divisor must never be negative (or zero). The pseudo code for implementing these
1975 checks is given below:
1979 RETURN TRUE (* division by zero. *)
1982 RETURN TRUE (* modulus and division by negative (rhs) not allowed in ISO Modula-2. *)
1985 RETURN FALSE (* must be legal as result is same as operand. *)
1988 (* test for: i MOD j < minT *)
1993 RETURN i - ((i DIV j) * j) < minT
1996 (* the result will always be positive and less than i, given that j is less than zero
1997 we know that minT must be < 0 as well and therefore the result of i MOD j will
2003 which can be converted into a large expression:
2005 RETURN (j = 0) OR ((j < 0) AND ISO) OR
2006 ((i # 0) AND (j <= i) AND (i - ((i DIVtrunc j) * j) < minT)
2011 c2 -> (j < 0) (* only called from ISO or PIM4 or -fpositive-mod-floor *)
2014 c6 -> (i DIVtrunc j)
2015 c7 -> (i - (c6 * j))
2019 (c3 AND c4 AND c5)). */
2022 checkWholeModTruncOverflow (location_t location
, tree i
, tree j
, tree lowest
,
2025 tree c1
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
2026 tree c2
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
2027 tree c3
= m2expr_BuildNotEqualToZero (location
, i
, lowest
, min
, max
);
2028 tree c4
= m2expr_BuildLessThanOrEqual (location
, j
, i
);
2029 tree c6
= m2expr_BuildDivTrunc (location
, i
, j
, FALSE
);
2030 tree c7
= m2expr_BuildSub (location
, i
, m2expr_BuildMult (location
, c6
, j
, FALSE
), FALSE
);
2031 tree c5
= m2expr_BuildLessThan (location
, c7
, min
);
2032 tree c8
= m2expr_Build3TruthAndIf (location
, c3
, c4
, c5
);
2033 tree condition
= m2expr_Build3TruthOrIf (location
, c1
, c2
, c8
);
2034 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
2035 get_current_function_name (),
2036 "whole value trunc modulus will cause a range overflow");
2041 /* checkWholeModCeilOverflow, the GCC tree.def defines CEIL_MOD_EXPR to return
2042 the remainder which has the same opposite of the divisor. In gm2 this is
2043 only called when the divisor is negative. The pseudo code for implementing
2044 these checks is given below:
2048 RETURN TRUE (* division by zero. *)
2050 t := i - j * divceil (i, j) ;
2051 printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
2052 t, i, j, i, j, divceil (i, j));
2053 RETURN NOT ((t >= minT) AND (t <= maxT))
2055 which can be converted into the expression:
2057 t := i - j * divceil (i, j) ;
2058 RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
2074 checkWholeModCeilOverflow (location_t location
,
2075 tree i
, tree j
, tree lowest
,
2078 tree c1
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
2079 tree c2
= m2expr_BuildSub (location
, i
, j
, FALSE
);
2080 tree c3
= m2expr_BuildDivCeil (location
, i
, j
, FALSE
);
2081 tree t
= m2expr_BuildMult (location
, c2
, c3
, FALSE
);
2082 tree c4
= m2expr_BuildGreaterThanOrEqual (location
, t
, min
);
2083 tree c5
= m2expr_BuildLessThanOrEqual (location
, t
, max
);
2084 tree c6
= m2expr_BuildTruthAndIf (location
, c4
, c5
);
2085 tree c7
= m2expr_BuildTruthNot (location
, c6
);
2086 tree condition
= m2expr_BuildTruthOrIf (location
, c1
, c7
);
2087 tree s
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
2088 get_current_function_name (),
2089 "whole value ceil modulus will cause a range overflow");
2094 /* checkWholeModFloorOverflow, the GCC tree.def defines FLOOR_MOD_EXPR to return
2095 the remainder which has the same sign as the divisor. In gm2 this is
2096 only called when the divisor is positive. The pseudo code for implementing
2097 these checks is given below:
2101 RETURN TRUE (* division by zero. *)
2103 t := i - j * divfloor (i, j) ;
2104 printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
2105 t, i, j, i, j, divfloor (i, j));
2106 RETURN NOT ((t >= minT) AND (t <= maxT))
2108 which can be converted into the expression:
2110 t := i - j * divfloor (i, j) ;
2111 RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
2117 c3 -> (i DIVfloor j)
2127 checkWholeModFloorOverflow (location_t location
,
2128 tree i
, tree j
, tree lowest
,
2131 tree c1
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
2132 tree c2
= m2expr_BuildSub (location
, i
, j
, FALSE
);
2133 tree c3
= m2expr_BuildDivFloor (location
, i
, j
, FALSE
);
2134 tree t
= m2expr_BuildMult (location
, c2
, c3
, FALSE
);
2135 tree c4
= m2expr_BuildGreaterThanOrEqual (location
, t
, min
);
2136 tree c5
= m2expr_BuildLessThanOrEqual (location
, t
, max
);
2137 tree c6
= m2expr_BuildTruthAndIf (location
, c4
, c5
);
2138 tree c7
= m2expr_BuildTruthNot (location
, c6
);
2139 tree condition
= m2expr_BuildTruthOrIf (location
, c1
, c7
);
2140 tree s
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
2141 get_current_function_name (),
2142 "whole value floor modulus will cause a range overflow");
2148 /* The following is a Modula-2 implementation of the C tree node code
2149 this code has been hand translated into GCC trees. */
2152 divFloorOverflow2
- returns TRUE
if an overflow will occur
2153 if i divfloor j is performed
.
2156 PROCEDURE
divFloorOverflow (i
, j
: INTEGER
) : BOOLEAN
;
2158 RETURN ((j
= 0) OR (* division by zero
. *)
2159 (maxT
< 0) OR (* both inputs are
< 0 and max is
< 0,
2161 (* --fixme
-- remember here to also check
2162 if ISO M2 dialect
and j
< 0
2163 which will also generate an error
. *)
2164 ((i
# 0) AND (* first operand is legally zero,
2165 result is also legally zero
. *)
2166 divFloorOverflowCases (i
, j
)))
2167 END divFloorOverflow
;
2171 divFloorOverflowCases
- precondition
: i
, j are in range values
.
2172 postcondition
: TRUE is returned
if i divfloor will
2173 result in an overflow
/underflow
.
2176 PROCEDURE
divFloorOverflowCases (i
, j
: INTEGER
) : BOOLEAN
;
2178 RETURN (((i
> 0) AND (j
> 0) AND
divFloorOverflowPosPos (i
, j
)) OR
2179 ((i
< 0) AND (j
< 0) AND
divFloorOverflowNegNeg (i
, j
)) OR
2180 ((i
> 0) AND (j
< 0) AND
divFloorOverflowPosNeg (i
, j
)) OR
2181 ((i
< 0) AND (j
> 0) AND
divFloorOverflowNegPos (i
, j
)))
2182 END divFloorOverflowCases
;
2186 divFloorOverflowPosPos
- precondition
: lhs
, rhs are legal
and are both
>= 0.
2187 postcondition
: TRUE is returned
if lhs divfloor rhs will
2188 result in an overflow
/underflow
.
2191 PROCEDURE
divFloorOverflowPosPos (lhs
, rhs
: INTEGER
) : BOOLEAN
;
2193 RETURN
multMinOverflow (rhs
) OR (lhs
< rhs
* min
)
2194 END divFloorOverflowPosPos
;
2198 divFloorOverflowNegNeg
- precondition
: i
, j are in range values
and both
< 0.
2199 postcondition
: TRUE is returned
if i divfloor will
2200 result in an overflow
/underflow
.
2203 PROCEDURE
divFloorOverflowNegNeg (i
, j
: INTEGER
) : BOOLEAN
;
2205 RETURN ((maxT
<= 0) OR (* signs will cause overflow
. *)
2206 (* check
for underflow
. *)
2208 (* check
for overflow
. *)
2209 (ABS (i
) DIV maxT
> ABS (j
)))
2210 END divFloorOverflowNegNeg
;
2214 divFloorOverflowNegPos
- precondition
: i
, j are in range values
. i
< 0, j
>= 0.
2215 postcondition
: TRUE is returned
if i divfloor will
2216 result in an overflow
/underflow
.
2219 PROCEDURE
divFloorOverflowNegPos (i
, j
: INTEGER
) : BOOLEAN
;
2221 (* easier than might be initially expected
. We know minT
< 0 and maxT
> 0.
2222 We know the result will be negative
and therefore we only need to test
2225 END divFloorOverflowNegPos
;
2229 divFloorOverflowPosNeg
- precondition
: i
, j are in range values
. i
>= 0, j
< 0.
2230 postcondition
: TRUE is returned
if i divfloor will
2231 result in an overflow
/underflow
.
2234 PROCEDURE
divFloorOverflowPosNeg (i
, j
: INTEGER
) : BOOLEAN
;
2236 (* easier than might be initially expected
. We know minT
< 0 and maxT
> 0.
2237 We know the result will be negative
and therefore we only need to test
2239 RETURN i
>= j
* minT
- j (* is safer than i
> j
* minT
-1 *)
2240 END divFloorOverflowPosNeg
;
2244 /* divFloorOverflowPosPos, precondition: i, j are legal and are both >= 0.
2245 Postcondition: TRUE is returned if i divfloor will result in an overflow/underflow.
2247 A handbuilt expression of trees implementing:
2251 j_mult_min -> (j * min)
2252 RETURN i < j_mult_min. */
2255 divFloorOverflowPosPos (location_t location
, tree i
, tree j
, tree min
)
2257 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, FALSE
);
2258 tree i_lt_j_mult_min
= m2expr_BuildLessThan (location
, i
, j_mult_min
);
2259 return i_lt_j_mult_min
;
2263 /* divFloorOverflowNegNeg precondition: i, j are in range values and both < 0.
2264 Postcondition: TRUE is returned if i divfloor j will result in an
2267 A handbuilt expression of trees implementing:
2269 RETURN ((maxT <= 0) OR (* signs will cause overflow. *)
2270 (* check for underflow. *)
2272 (* check for overflow. *)
2273 (ABS (i) DIV max > ABS (j)))
2275 max_lte_0 -> (max <= 0)
2278 j_mult_min -> (j * min)
2279 i_ge_j_mult_min -> (i >= j_mult_min)
2280 abs_i_div_max -> (abs_i divfloor max)
2281 abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
2285 abs_i_div_max_gt_abs_j. */
2288 divFloorOverflowNegNeg (location_t location
, tree i
, tree j
, tree lowest
,
2291 tree max_lte_0
= m2expr_BuildLessThanOrEqualZero (location
, max
, lowest
, min
, max
);
2292 tree abs_i
= m2expr_BuildAbs (location
, i
);
2293 tree abs_j
= m2expr_BuildAbs (location
, j
);
2294 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, FALSE
);
2295 tree i_ge_j_mult_min
= m2expr_BuildGreaterThanOrEqual (location
, i
, j_mult_min
);
2296 tree abs_i_div_max
= m2expr_BuildDivFloor (location
, abs_i
, max
, FALSE
);
2297 tree abs_i_div_max_gt_abs_j
= m2expr_BuildGreaterThan (location
, abs_i_div_max
, abs_j
);
2299 return m2expr_Build3TruthOrIf (location
, max_lte_0
, i_ge_j_mult_min
, abs_i_div_max_gt_abs_j
);
2303 /* divFloorOverflowPosNeg precondition: i, j are in range values and i >=0, j < 0.
2304 Postcondition: TRUE is returned if i divfloor j will result in an
2307 A handbuilt expression of trees implementing:
2309 RETURN i >= j * min - j (* is safer than i > j * min -1 *)
2311 j_mult_min -> (j * min)
2312 j_mult_min_sub_j -> (j_mult_min - j)
2313 i_ge_j_mult_min_sub_j -> (i >= j_mult_min_sub_j)
2315 return i_ge_j_mult_min_sub_j. */
2318 divFloorOverflowPosNeg (location_t location
, tree i
, tree j
, tree min
)
2320 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, FALSE
);
2321 tree j_mult_min_sub_j
= m2expr_BuildSub (location
, j_mult_min
, j
, FALSE
);
2322 tree i_ge_j_mult_min_sub_j
= m2expr_BuildGreaterThanOrEqual (location
, i
, j_mult_min_sub_j
);
2323 return i_ge_j_mult_min_sub_j
;
2327 /* divFloorOverflowNegPos precondition: i, j are in range values and i < 0, j > 0.
2328 Postcondition: TRUE is returned if i divfloor j will result in an
2331 A handbuilt expression of trees implementing:
2335 j_mult_min -> (j * min)
2336 RETURN i < j_mult_min. */
2339 divFloorOverflowNegPos (location_t location
, tree i
, tree j
, tree min
)
2341 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, FALSE
);
2342 tree i_lt_j_mult_min
= m2expr_BuildLessThan (location
, i
, j_mult_min
);
2343 return i_lt_j_mult_min
;
2347 /* divFloorOverflowCases, precondition: i, j are in range values.
2348 Postcondition: TRUE is returned if i divfloor will result in an
2351 A handbuilt expression of trees implementing:
2353 RETURN (((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j)) OR
2354 ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j)) OR
2355 ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j)) OR
2356 ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j)))
2358 a -> ((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j))
2359 b -> ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j))
2360 c -> ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j))
2361 d -> ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j))
2363 RETURN a AND b AND c AND d. */
2366 divFloorOverflowCases (location_t location
, tree i
, tree j
, tree lowest
,
2369 tree i_gt_zero
= m2expr_BuildGreaterThanZero (location
, i
, lowest
, min
, max
);
2370 tree j_gt_zero
= m2expr_BuildGreaterThanZero (location
, j
, lowest
, min
, max
);
2371 tree i_lt_zero
= m2expr_BuildLessThanZero (location
, i
, lowest
, min
, max
);
2372 tree j_lt_zero
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
2373 tree a
= m2expr_Build3TruthAndIf (location
, i_gt_zero
, j_gt_zero
,
2374 divFloorOverflowPosPos (location
, i
, j
, min
));
2375 tree b
= m2expr_Build3TruthAndIf (location
, i_lt_zero
, j_lt_zero
,
2376 divFloorOverflowNegNeg (location
, i
, j
, lowest
, min
, max
));
2377 tree c
= m2expr_Build3TruthAndIf (location
, i_gt_zero
, j_lt_zero
,
2378 divFloorOverflowPosNeg (location
, i
, j
, min
));
2379 tree d
= m2expr_Build3TruthAndIf (location
, i_lt_zero
, j_gt_zero
,
2380 divFloorOverflowNegPos (location
, i
, j
, min
));
2381 return m2expr_Build4TruthOrIf (location
, a
, b
, c
, d
);
2385 /* checkWholeDivFloorOverflow check to see whether i DIV_FLOOR j will overflow
2386 an integer. A handbuilt expression of trees implementing:
2388 RETURN ((j = 0) OR (* division by zero. *)
2389 (maxT < 0) OR (* both inputs are < 0 and max is < 0,
2392 if ISO M2 dialect and j < 0
2393 which will also generate an error. *)
2394 ((i # 0) AND (* first operand is legally zero,
2395 result is also legally zero. *)
2396 divFloorOverflowCases (i, j)))
2398 using the following subexpressions:
2400 j_eq_zero -> (j == 0)
2401 max_lt_zero -> (max < 0)
2402 i_ne_zero -> (i # 0). */
2405 checkWholeDivFloorOverflow (location_t location
, tree i
, tree j
, tree lowest
,
2408 tree j_eq_zero
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
2409 tree max_lt_zero
= m2expr_BuildLessThanZero (location
, max
, lowest
, min
, max
);
2410 tree i_ne_zero
= m2expr_BuildNotEqualToZero (location
, i
, lowest
, min
, max
);
2412 tree rhs
= m2expr_BuildTruthAndIf (location
,
2414 divFloorOverflowCases (location
,
2415 i
, j
, lowest
, min
, max
));
2417 if (M2Options_GetISO ())
2418 /* ISO Modula-2 raises an exception if the right hand operand is < 0. */
2419 j_lt_zero
= m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
));
2421 j_lt_zero
= m2expr_GetIntegerZero (location
);
2422 j_eq_zero
= m2expr_FoldAndStrip (j_eq_zero
);
2423 max_lt_zero
= m2expr_FoldAndStrip (max_lt_zero
);
2424 i_ne_zero
= m2expr_FoldAndStrip (i_ne_zero
);
2425 rhs
= m2expr_FoldAndStrip (rhs
);
2427 tree condition
= m2expr_Build4TruthOrIf (location
, j_eq_zero
, max_lt_zero
, rhs
, j_lt_zero
);
2428 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
2429 get_current_function_name (),
2430 "whole value floor division will cause a range overflow");
2434 /* checkWholeOverflow check to see if the binary operators will overflow
2438 m2expr_checkWholeOverflow (location_t location
, enum tree_code code
, tree op1
,
2439 tree op2
, tree lowest
, tree min
, tree max
)
2441 if (M2Options_GetWholeValueCheck () && (min
!= NULL
))
2443 lowest
= m2tree_skip_type_decl (lowest
);
2444 op1
= fold_convert_loc (location
, lowest
, op1
);
2445 op2
= fold_convert_loc (location
, lowest
, op2
);
2450 return checkWholeAddOverflow (location
, op1
, op2
, lowest
, min
, max
);
2452 return checkWholeSubOverflow (location
, op1
, op2
, lowest
, min
, max
);
2454 return checkWholeMultOverflow (location
, op1
, op2
, lowest
, min
, max
);
2455 case TRUNC_DIV_EXPR
:
2456 return checkWholeDivTruncOverflow (location
, op1
, op2
, lowest
, min
, max
);
2458 return checkWholeDivCeilOverflow (location
, op1
, op2
, lowest
, min
, max
);
2459 case FLOOR_DIV_EXPR
:
2460 return checkWholeDivFloorOverflow (location
, op1
, op2
, lowest
, min
, max
);
2461 case TRUNC_MOD_EXPR
:
2462 return checkWholeModTruncOverflow (location
, op1
, op2
, lowest
, min
, max
);
2464 return checkWholeModCeilOverflow (location
, op1
, op2
, lowest
, min
, max
);
2465 case FLOOR_MOD_EXPR
:
2466 return checkWholeModFloorOverflow (location
, op1
, op2
, lowest
, min
, max
);
2474 /* checkRealOverflow if we have enabled real value checking then
2475 generate an overflow check appropriate to the tree code being used. */
2478 m2expr_checkRealOverflow (location_t location
, enum tree_code code
,
2481 if (M2Options_GetFloatValueCheck ())
2483 tree condition
= m2expr_BuildEqualTo (
2484 location
, m2builtins_BuiltInIsfinite (location
, result
),
2485 m2expr_GetIntegerZero (location
));
2489 m2type_AddStatement (location
,
2490 M2Range_BuildIfCallRealHandlerLoc (
2491 location
, condition
,
2492 get_current_function_name (),
2493 "floating point + has caused an overflow"));
2496 m2type_AddStatement (location
,
2497 M2Range_BuildIfCallRealHandlerLoc (
2498 location
, condition
,
2499 get_current_function_name (),
2500 "floating point - has caused an overflow"));
2503 case FLOOR_DIV_EXPR
:
2505 case TRUNC_DIV_EXPR
:
2506 m2type_AddStatement (location
,
2507 M2Range_BuildIfCallRealHandlerLoc (
2508 location
, condition
,
2509 get_current_function_name (),
2510 "floating point / has caused an overflow"));
2513 m2type_AddStatement (location
,
2514 M2Range_BuildIfCallRealHandlerLoc (
2515 location
, condition
,
2516 get_current_function_name (),
2517 "floating point * has caused an overflow"));
2520 m2type_AddStatement (
2521 location
, M2Range_BuildIfCallRealHandlerLoc (
2522 location
, condition
,
2523 get_current_function_name (),
2524 "floating point unary - has caused an overflow"));
2531 /* build_binary_op, a wrapper for the lower level build_binary_op
2535 m2expr_build_binary_op_check (location_t location
, enum tree_code code
,
2536 tree op1
, tree op2
, int needconvert
, tree lowest
,
2539 tree type1
, type2
, result
;
2542 op1
= m2expr_FoldAndStrip (op1
);
2543 op2
= m2expr_FoldAndStrip (op2
);
2545 type1
= m2tree_skip_type_decl (TREE_TYPE (op1
));
2546 type2
= m2tree_skip_type_decl (TREE_TYPE (op2
));
2548 m2assert_AssertLocation (location
);
2550 if (code
== PLUS_EXPR
)
2552 if (POINTER_TYPE_P (type1
))
2554 op2
= fold_convert_loc (location
, sizetype
, unshare_expr (op2
));
2555 return fold_build2_loc (location
, POINTER_PLUS_EXPR
, TREE_TYPE (op1
),
2558 else if (POINTER_TYPE_P (type2
))
2560 op1
= fold_convert_loc (location
, sizetype
, unshare_expr (op1
));
2561 return fold_build2_loc (location
, POINTER_PLUS_EXPR
, TREE_TYPE (op2
),
2565 if (code
== MINUS_EXPR
)
2567 if (POINTER_TYPE_P (type1
))
2569 op2
= fold_convert_loc (location
, sizetype
, unshare_expr (op2
));
2570 op2
= fold_build1_loc (location
, NEGATE_EXPR
, sizetype
, op2
);
2571 return fold_build2_loc (location
, POINTER_PLUS_EXPR
, TREE_TYPE (op1
),
2574 else if (POINTER_TYPE_P (type2
))
2576 op2
= fold_convert_loc (location
, sizetype
, unshare_expr (op2
));
2577 op2
= fold_build1_loc (location
, NEGATE_EXPR
, sizetype
, op2
);
2578 op1
= fold_convert_loc (location
, sizetype
, unshare_expr (op1
));
2579 return fold_build2_loc (location
, POINTER_PLUS_EXPR
, TREE_TYPE (op2
),
2584 if ((code
!= LSHIFT_EXPR
) && (code
!= RSHIFT_EXPR
) && (code
!= LROTATE_EXPR
)
2585 && (code
== RROTATE_EXPR
))
2587 error_at (location
, "not expecting different types to binary operator");
2589 if ((TREE_CODE (type1
) != REAL_TYPE
) && (min
!= NULL
))
2590 check
= m2expr_checkWholeOverflow (location
, code
, op1
, op2
, lowest
, min
, max
);
2592 result
= build_binary_op (location
, code
, op1
, op2
, needconvert
);
2594 result
= build2 (COMPOUND_EXPR
, TREE_TYPE (result
), check
, result
);
2596 if (TREE_CODE (type1
) == REAL_TYPE
)
2597 m2expr_checkRealOverflow (location
, code
, result
);
2601 /* build_binary_op, a wrapper for the lower level build_binary_op
2605 m2expr_build_binary_op (location_t location
, enum tree_code code
, tree op1
,
2606 tree op2
, int convert
)
2608 return m2expr_build_binary_op_check (location
, code
, op1
, op2
, convert
, NULL
,
2612 /* BuildAddAddress return an expression op1+op2 where op1 is a
2613 pointer type and op2 is not a pointer type. */
2616 m2expr_BuildAddAddress (location_t location
, tree op1
, tree op2
)
2620 op1
= m2expr_FoldAndStrip (op1
);
2621 op2
= m2expr_FoldAndStrip (op2
);
2623 type1
= m2tree_skip_type_decl (TREE_TYPE (op1
));
2624 type2
= m2tree_skip_type_decl (TREE_TYPE (op2
));
2626 m2assert_AssertLocation (location
);
2627 ASSERT_CONDITION (POINTER_TYPE_P (type1
));
2628 ASSERT_CONDITION (!POINTER_TYPE_P (type2
));
2630 op2
= fold_convert_loc (location
, sizetype
, unshare_expr (op2
));
2631 return fold_build2_loc (location
, POINTER_PLUS_EXPR
, TREE_TYPE (op1
),
2632 m2expr_FoldAndStrip (op1
),
2633 m2expr_FoldAndStrip (op2
));
2636 /* BuildNegateCheck builds a negate tree. */
2639 m2expr_BuildNegateCheck (location_t location
, tree arg
, tree lowest
, tree min
,
2644 m2assert_AssertLocation (location
);
2646 arg
= m2expr_FoldAndStrip (arg
);
2647 arg
= CheckAddressToCardinal (location
, arg
);
2649 t
= m2expr_build_unary_op_check (location
, NEGATE_EXPR
, arg
, lowest
, min
,
2651 return m2expr_FoldAndStrip (t
);
2654 /* BuildNegate build a negate expression and returns the tree. */
2657 m2expr_BuildNegate (location_t location
, tree op1
, int needconvert
)
2659 m2assert_AssertLocation (location
);
2660 op1
= m2expr_FoldAndStrip (op1
);
2661 op1
= CheckAddressToCardinal (location
, op1
);
2663 return m2expr_build_unary_op (location
, NEGATE_EXPR
, op1
, needconvert
);
2666 /* BuildSetNegate build a set negate expression and returns the tree. */
2669 m2expr_BuildSetNegate (location_t location
, tree op1
, int needconvert
)
2671 m2assert_AssertLocation (location
);
2673 return m2expr_build_binary_op (
2674 location
, BIT_XOR_EXPR
,
2675 m2convert_BuildConvert (location
, m2type_GetWordType (),
2676 m2expr_FoldAndStrip (op1
), FALSE
),
2677 set_full_complement
, needconvert
);
2680 /* BuildMult build a multiplication tree. */
2683 m2expr_BuildMult (location_t location
, tree op1
, tree op2
, int needconvert
)
2685 op1
= m2expr_FoldAndStrip (op1
);
2686 op2
= m2expr_FoldAndStrip (op2
);
2688 m2assert_AssertLocation (location
);
2690 op1
= CheckAddressToCardinal (location
, op1
);
2691 op2
= CheckAddressToCardinal (location
, op2
);
2693 return m2expr_build_binary_op (location
, MULT_EXPR
, op1
, op2
, needconvert
);
2696 /* BuildMultCheck builds a multiplication tree. */
2699 m2expr_BuildMultCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
2704 m2assert_AssertLocation (location
);
2706 op1
= m2expr_FoldAndStrip (op1
);
2707 op2
= m2expr_FoldAndStrip (op2
);
2709 op1
= CheckAddressToCardinal (location
, op1
);
2710 op2
= CheckAddressToCardinal (location
, op2
);
2712 t
= m2expr_build_binary_op_check (location
, MULT_EXPR
, op1
, op2
, FALSE
,
2714 return m2expr_FoldAndStrip (t
);
2717 /* testLimits return the number of bits required to represent:
2718 min..max if it matches the, type. Otherwise NULL_TREE is returned. */
2721 testLimits (location_t location
, tree type
, tree min
, tree max
)
2723 m2assert_AssertLocation (location
);
2725 if ((m2expr_CompareTrees (TYPE_MAX_VALUE (type
), max
) == 0)
2726 && (m2expr_CompareTrees (TYPE_MIN_VALUE (type
), min
) == 0))
2727 return m2expr_BuildMult (location
, m2expr_GetSizeOf (location
, type
),
2728 m2decl_BuildIntegerConstant (BITS_PER_UNIT
),
2733 /* noBitsRequired return the number of bits required to contain, values. */
2736 noBitsRequired (tree values
)
2738 int bits
= tree_floor_log2 (values
);
2740 if (integer_pow2p (values
))
2741 return m2decl_BuildIntegerConstant (bits
+ 1);
2743 return m2decl_BuildIntegerConstant (bits
+ 1);
2746 /* getMax return the result of max(a, b). */
2749 getMax (tree a
, tree b
)
2751 if (m2expr_CompareTrees (a
, b
) > 0)
2757 /* calcNbits return the smallest number of bits required to
2758 represent: min..max. */
2761 calcNbits (location_t location
, tree min
, tree max
)
2763 int negative
= FALSE
;
2764 tree t
= testLimits (location
, m2type_GetIntegerType (), min
, max
);
2766 m2assert_AssertLocation (location
);
2769 t
= testLimits (location
, m2type_GetCardinalType (), min
, max
);
2773 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) < 0)
2775 min
= m2expr_BuildAdd (location
, min
,
2776 m2expr_GetIntegerOne (location
), FALSE
);
2777 min
= fold (m2expr_BuildNegate (location
, min
, FALSE
));
2780 if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) < 0)
2782 max
= fold (m2expr_BuildNegate (location
, max
, FALSE
));
2785 t
= noBitsRequired (getMax (min
, max
));
2787 t
= m2expr_BuildAdd (location
, t
, m2expr_GetIntegerOne (location
),
2793 /* BuildTBitSize return the minimum number of bits to represent, type. */
2796 m2expr_BuildTBitSize (location_t location
, tree type
)
2798 enum tree_code code
= TREE_CODE (type
);
2801 m2assert_AssertLocation (location
);
2807 return m2expr_BuildTBitSize (location
, TREE_TYPE (type
));
2810 max
= m2convert_BuildConvert (location
, m2type_GetIntegerType (),
2811 TYPE_MAX_VALUE (type
), FALSE
);
2812 min
= m2convert_BuildConvert (location
, m2type_GetIntegerType (),
2813 TYPE_MIN_VALUE (type
), FALSE
);
2814 return calcNbits (location
, min
, max
);
2816 return m2expr_GetIntegerOne (location
);
2818 return m2expr_BuildMult (location
, m2expr_GetSizeOf (location
, type
),
2819 m2decl_BuildIntegerConstant (BITS_PER_UNIT
),
2824 /* BuildSize build a SIZE function expression and returns the tree. */
2827 m2expr_BuildSize (location_t location
, tree op1
,
2828 int needconvert ATTRIBUTE_UNUSED
)
2830 m2assert_AssertLocation (location
);
2831 return m2expr_GetSizeOf (location
, op1
);
2834 /* BuildAddr return an expression which calculates the address of op1
2835 and returns the tree. If use_generic is TRUE then create a generic
2839 m2expr_BuildAddr (location_t location
, tree op1
, int use_generic
)
2841 tree type
= m2tree_skip_type_decl (TREE_TYPE (op1
));
2842 tree ptrType
= build_pointer_type (type
);
2845 m2assert_AssertLocation (location
);
2847 if (!gm2_mark_addressable (op1
))
2848 error_at (location
, "cannot take the address of this expression");
2851 result
= build1 (ADDR_EXPR
, m2type_GetPointerType (), op1
);
2853 result
= build1 (ADDR_EXPR
, ptrType
, op1
);
2854 protected_set_expr_location (result
, location
);
2858 /* BuildOffset1 build and return an expression containing the number
2859 of bytes the field is offset from the start of the record structure.
2860 This function is the same as the above, except that it derives the
2861 record from the field and then calls BuildOffset. */
2864 m2expr_BuildOffset1 (location_t location
, tree field
,
2865 int needconvert ATTRIBUTE_UNUSED
)
2867 m2assert_AssertLocation (location
);
2868 return m2expr_BuildOffset (location
, DECL_CONTEXT (field
), field
,
2872 /* determinePenultimateField return the field associated with the
2873 DECL_CONTEXT (field) within a record or varient. The record, is a
2874 record/varient but it maybe an outer nested record to the field that
2875 we are searching. Ie:
2877 record = RECORD x: CARDINAL ; y: RECORD field: CARDINAL ; END END ;
2879 determinePenultimateField (record, field) returns, y. We are
2880 assurred that the chain of records leading to field will be unique as
2881 they are built on the fly to implement varient records. */
2884 determinePenultimateField (tree record
, tree field
)
2886 tree fieldlist
= TYPE_FIELDS (record
);
2889 for (x
= fieldlist
; x
; x
= TREE_CHAIN (x
))
2891 if (DECL_CONTEXT (field
) == TREE_TYPE (x
))
2893 switch (TREE_CODE (TREE_TYPE (x
)))
2897 r
= determinePenultimateField (TREE_TYPE (x
), field
);
2908 /* BuildOffset builds an expression containing the number of bytes
2909 the field is offset from the start of the record structure. The
2910 expression is returned. */
2913 m2expr_BuildOffset (location_t location
, tree record
, tree field
,
2914 int needconvert ATTRIBUTE_UNUSED
)
2916 m2assert_AssertLocation (location
);
2918 if (DECL_CONTEXT (field
) == record
)
2919 return m2convert_BuildConvert (
2920 location
, m2type_GetIntegerType (),
2922 location
, DECL_FIELD_OFFSET (field
),
2923 m2expr_BuildDivTrunc (location
, DECL_FIELD_BIT_OFFSET (field
),
2924 m2decl_BuildIntegerConstant (BITS_PER_UNIT
),
2930 tree r1
= DECL_CONTEXT (field
);
2931 tree r2
= determinePenultimateField (record
, field
);
2932 return m2convert_BuildConvert (
2933 location
, m2type_GetIntegerType (),
2935 location
, m2expr_BuildOffset (location
, r1
, field
, needconvert
),
2936 m2expr_BuildOffset (location
, record
, r2
, needconvert
), FALSE
),
2941 /* BuildLogicalOrAddress build a logical or expressions and return the tree. */
2944 m2expr_BuildLogicalOrAddress (location_t location
, tree op1
, tree op2
,
2947 m2assert_AssertLocation (location
);
2948 return m2expr_build_binary_op (location
, BIT_IOR_EXPR
, op1
, op2
,
2952 /* BuildLogicalOr build a logical or expressions and return the tree. */
2955 m2expr_BuildLogicalOr (location_t location
, tree op1
, tree op2
,
2958 m2assert_AssertLocation (location
);
2959 return m2expr_build_binary_op (
2960 location
, BIT_IOR_EXPR
,
2961 m2convert_BuildConvert (location
, m2type_GetWordType (), op1
, FALSE
),
2962 m2convert_BuildConvert (location
, m2type_GetWordType (), op2
, FALSE
),
2966 /* BuildLogicalAnd build a logical and expression and return the tree. */
2969 m2expr_BuildLogicalAnd (location_t location
, tree op1
, tree op2
,
2972 m2assert_AssertLocation (location
);
2973 return m2expr_build_binary_op (
2974 location
, BIT_AND_EXPR
,
2975 m2convert_BuildConvert (location
, m2type_GetWordType (), op1
, FALSE
),
2976 m2convert_BuildConvert (location
, m2type_GetWordType (), op2
, FALSE
),
2980 /* BuildSymmetricalDifference build a logical xor expression and return the
2984 m2expr_BuildSymmetricDifference (location_t location
, tree op1
, tree op2
,
2987 m2assert_AssertLocation (location
);
2988 return m2expr_build_binary_op (
2989 location
, BIT_XOR_EXPR
,
2990 m2convert_BuildConvert (location
, m2type_GetWordType (), op1
, FALSE
),
2991 m2convert_BuildConvert (location
, m2type_GetWordType (), op2
, FALSE
),
2995 /* BuildLogicalDifference build a logical difference expression and
2996 return the tree. (op1 and (not op2)). */
2999 m2expr_BuildLogicalDifference (location_t location
, tree op1
, tree op2
,
3002 m2assert_AssertLocation (location
);
3003 return m2expr_build_binary_op (
3004 location
, BIT_AND_EXPR
,
3005 m2convert_BuildConvert (location
, m2type_GetWordType (), op1
, FALSE
),
3006 m2expr_BuildSetNegate (location
, op2
, needconvert
), needconvert
);
3009 /* base_type returns the base type of an ordinal subrange, or the
3010 type itself if it is not a subrange. */
3013 base_type (tree type
)
3015 if (type
== error_mark_node
)
3016 return error_mark_node
;
3018 /* Check for ordinal subranges. */
3019 if (m2tree_IsOrdinal (type
) && TREE_TYPE (type
))
3020 type
= TREE_TYPE (type
);
3021 return TYPE_MAIN_VARIANT (type
);
3024 /* boolean_enum_to_unsigned convert a BOOLEAN_TYPE, t, or
3025 ENUMERAL_TYPE to an unsigned type. */
3028 boolean_enum_to_unsigned (location_t location
, tree t
)
3030 tree type
= TREE_TYPE (t
);
3032 if (TREE_CODE (base_type (type
)) == BOOLEAN_TYPE
)
3033 return m2convert_BuildConvert (location
, unsigned_type_node
, t
, FALSE
);
3034 else if (TREE_CODE (base_type (type
)) == ENUMERAL_TYPE
)
3035 return m2convert_BuildConvert (location
, unsigned_type_node
, t
, FALSE
);
3040 /* check_for_comparison check to see if, op, is of type, badType. If
3041 so then it returns op after it has been cast to, goodType. op will
3042 be an array so we take the address and cast the contents. */
3045 check_for_comparison (location_t location
, tree op
, tree badType
,
3048 m2assert_AssertLocation (location
);
3049 if (m2tree_skip_type_decl (TREE_TYPE (op
)) == badType
)
3050 /* Cannot compare array contents in m2expr_build_binary_op. */
3051 return m2expr_BuildIndirect (
3052 location
, m2expr_BuildAddr (location
, op
, FALSE
), goodType
);
3056 /* convert_for_comparison return a tree which can be used as an
3057 argument during a comparison. */
3060 convert_for_comparison (location_t location
, tree op
)
3062 m2assert_AssertLocation (location
);
3063 op
= boolean_enum_to_unsigned (location
, op
);
3065 op
= check_for_comparison (location
, op
, m2type_GetISOWordType (),
3066 m2type_GetWordType ());
3067 op
= check_for_comparison (location
, op
, m2type_GetM2Word16 (),
3068 m2type_GetM2Cardinal16 ());
3069 op
= check_for_comparison (location
, op
, m2type_GetM2Word32 (),
3070 m2type_GetM2Cardinal32 ());
3071 op
= check_for_comparison (location
, op
, m2type_GetM2Word64 (),
3072 m2type_GetM2Cardinal64 ());
3077 /* BuildLessThan return a tree which computes <. */
3080 m2expr_BuildLessThan (location_t location
, tree op1
, tree op2
)
3082 m2assert_AssertLocation (location
);
3083 return m2expr_build_binary_op (
3084 location
, LT_EXPR
, boolean_enum_to_unsigned (location
, op1
),
3085 boolean_enum_to_unsigned (location
, op2
), TRUE
);
3088 /* BuildGreaterThan return a tree which computes >. */
3091 m2expr_BuildGreaterThan (location_t location
, tree op1
, tree op2
)
3093 m2assert_AssertLocation (location
);
3094 return m2expr_build_binary_op (
3095 location
, GT_EXPR
, boolean_enum_to_unsigned (location
, op1
),
3096 boolean_enum_to_unsigned (location
, op2
), TRUE
);
3099 /* BuildLessThanOrEqual return a tree which computes <. */
3102 m2expr_BuildLessThanOrEqual (location_t location
, tree op1
, tree op2
)
3104 m2assert_AssertLocation (location
);
3105 return m2expr_build_binary_op (
3106 location
, LE_EXPR
, boolean_enum_to_unsigned (location
, op1
),
3107 boolean_enum_to_unsigned (location
, op2
), TRUE
);
3110 /* BuildGreaterThanOrEqual return a tree which computes >=. */
3113 m2expr_BuildGreaterThanOrEqual (location_t location
, tree op1
, tree op2
)
3115 m2assert_AssertLocation (location
);
3116 return m2expr_build_binary_op (
3117 location
, GE_EXPR
, boolean_enum_to_unsigned (location
, op1
),
3118 boolean_enum_to_unsigned (location
, op2
), TRUE
);
3121 /* BuildEqualTo return a tree which computes =. */
3124 m2expr_BuildEqualTo (location_t location
, tree op1
, tree op2
)
3126 m2assert_AssertLocation (location
);
3127 return m2expr_build_binary_op (location
, EQ_EXPR
,
3128 convert_for_comparison (location
, op1
),
3129 convert_for_comparison (location
, op2
), TRUE
);
3132 /* BuildEqualNotTo return a tree which computes #. */
3135 m2expr_BuildNotEqualTo (location_t location
, tree op1
, tree op2
)
3137 m2assert_AssertLocation (location
);
3138 return m2expr_build_binary_op (location
, NE_EXPR
,
3139 convert_for_comparison (location
, op1
),
3140 convert_for_comparison (location
, op2
), TRUE
);
3143 /* BuildIsSuperset return a tree which computes: op1 & op2 == op2. */
3146 m2expr_BuildIsSuperset (location_t location
, tree op1
, tree op2
)
3148 m2assert_AssertLocation (location
);
3149 return m2expr_BuildEqualTo (
3150 location
, op2
, m2expr_BuildLogicalAnd (location
, op1
, op2
, FALSE
));
3153 /* BuildIsNotSuperset return a tree which computes: op1 & op2 != op2. */
3156 m2expr_BuildIsNotSuperset (location_t location
, tree op1
, tree op2
)
3158 m2assert_AssertLocation (location
);
3159 return m2expr_BuildNotEqualTo (
3160 location
, op2
, m2expr_BuildLogicalAnd (location
, op1
, op2
, FALSE
));
3163 /* BuildIsSubset return a tree which computes: op1 & op2 == op1. */
3166 m2expr_BuildIsSubset (location_t location
, tree op1
, tree op2
)
3168 m2assert_AssertLocation (location
);
3169 return m2expr_BuildEqualTo (
3170 location
, op1
, m2expr_BuildLogicalAnd (location
, op1
, op2
, FALSE
));
3173 /* BuildIsNotSubset return a tree which computes: op1 & op2 != op1. */
3176 m2expr_BuildIsNotSubset (location_t location
, tree op1
, tree op2
)
3178 m2assert_AssertLocation (location
);
3179 return m2expr_BuildNotEqualTo (
3180 location
, op1
, m2expr_BuildLogicalAnd (location
, op1
, op2
, FALSE
));
3183 /* BuildIfConstInVar generates: if constel in varset then goto label. */
3186 m2expr_BuildIfConstInVar (location_t location
, tree type
, tree varset
,
3187 tree constel
, int is_lvalue
, int fieldno
,
3190 tree size
= m2expr_GetSizeOf (location
, type
);
3191 m2assert_AssertLocation (location
);
3193 ASSERT_BOOL (is_lvalue
);
3194 if (m2expr_CompareTrees (
3195 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
3197 /* Small set size <= TSIZE(WORD). */
3198 m2treelib_do_jump_if_bit (
3200 m2treelib_get_rvalue (location
, varset
, type
, is_lvalue
), constel
,
3204 tree fieldlist
= TYPE_FIELDS (type
);
3207 for (field
= fieldlist
; (field
!= NULL
) && (fieldno
> 0);
3208 field
= TREE_CHAIN (field
))
3211 m2treelib_do_jump_if_bit (
3213 m2treelib_get_set_field_rhs (location
, varset
, field
), constel
,
3218 /* BuildIfConstInVar generates: if not (constel in varset) then goto label. */
3221 m2expr_BuildIfNotConstInVar (location_t location
, tree type
, tree varset
,
3222 tree constel
, int is_lvalue
, int fieldno
,
3225 tree size
= m2expr_GetSizeOf (location
, type
);
3227 m2assert_AssertLocation (location
);
3229 ASSERT_BOOL (is_lvalue
);
3230 if (m2expr_CompareTrees (
3231 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
3233 /* Small set size <= TSIZE(WORD). */
3234 m2treelib_do_jump_if_bit (
3236 m2treelib_get_rvalue (location
, varset
, type
, is_lvalue
), constel
,
3240 tree fieldlist
= TYPE_FIELDS (type
);
3243 for (field
= fieldlist
; (field
!= NULL
) && (fieldno
> 0);
3244 field
= TREE_CHAIN (field
))
3247 m2treelib_do_jump_if_bit (
3249 m2treelib_get_set_field_rhs (location
, varset
, field
), constel
,
3254 /* BuildIfVarInVar generates: if varel in varset then goto label. */
3257 m2expr_BuildIfVarInVar (location_t location
, tree type
, tree varset
,
3258 tree varel
, int is_lvalue
, tree low
,
3259 tree high ATTRIBUTE_UNUSED
, char *label
)
3261 tree size
= m2expr_GetSizeOf (location
, type
);
3262 /* Calculate the index from the first bit, ie bit 0 represents low value. */
3263 tree index
= m2expr_BuildSub (
3264 location
, m2convert_BuildConvert (location
, m2type_GetIntegerType (),
3266 m2convert_BuildConvert (location
, m2type_GetIntegerType (), low
, FALSE
),
3269 m2assert_AssertLocation (location
);
3271 if (m2expr_CompareTrees (
3272 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
3274 /* Small set size <= TSIZE(WORD). */
3275 m2treelib_do_jump_if_bit (
3277 m2treelib_get_rvalue (location
, varset
, type
, is_lvalue
), index
,
3281 tree p1
= m2treelib_get_set_address (location
, varset
, is_lvalue
);
3282 /* Which word do we need to fetch? */
3283 tree word_index
= m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
3284 location
, index
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
),
3286 /* Calculate the bit in this word. */
3287 tree offset_into_word
= m2expr_FoldAndStrip (m2expr_BuildModTrunc (
3288 location
, index
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
),
3290 tree p2
= m2expr_FoldAndStrip (m2expr_BuildMult (
3291 location
, word_index
,
3292 m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
), FALSE
));
3294 /* Calculate the address of the word we are interested in. */
3295 p1
= m2expr_BuildAddAddress (location
,
3296 m2convert_convertToPtr (location
, p1
), p2
);
3298 /* Fetch the word, extract the bit and test for != 0. */
3299 m2treelib_do_jump_if_bit (
3301 m2expr_BuildIndirect (location
, p1
, m2type_GetBitsetType ()),
3302 offset_into_word
, label
);
3306 /* BuildIfNotVarInVar generates: if not (varel in varset) then goto label. */
3309 m2expr_BuildIfNotVarInVar (location_t location
, tree type
, tree varset
,
3310 tree varel
, int is_lvalue
, tree low
,
3311 tree high ATTRIBUTE_UNUSED
, char *label
)
3313 tree size
= m2expr_GetSizeOf (location
, type
);
3314 /* Calculate the index from the first bit, ie bit 0 represents low value. */
3315 tree index
= m2expr_BuildSub (
3316 location
, m2convert_BuildConvert (location
, m2type_GetIntegerType (),
3317 m2expr_FoldAndStrip (varel
), FALSE
),
3318 m2convert_BuildConvert (location
, m2type_GetIntegerType (),
3319 m2expr_FoldAndStrip (low
), FALSE
),
3322 index
= m2expr_FoldAndStrip (index
);
3323 m2assert_AssertLocation (location
);
3325 if (m2expr_CompareTrees (
3326 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
3328 /* Small set size <= TSIZE(WORD). */
3329 m2treelib_do_jump_if_bit (
3331 m2treelib_get_rvalue (location
, varset
, type
, is_lvalue
), index
,
3335 tree p1
= m2treelib_get_set_address (location
, varset
, is_lvalue
);
3336 /* Calculate the index from the first bit. */
3338 /* Which word do we need to fetch? */
3339 tree word_index
= m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
3340 location
, index
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
),
3342 /* Calculate the bit in this word. */
3343 tree offset_into_word
= m2expr_FoldAndStrip (m2expr_BuildModTrunc (
3344 location
, index
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
),
3346 tree p2
= m2expr_FoldAndStrip (m2expr_BuildMult (
3347 location
, word_index
,
3348 m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
), FALSE
));
3350 /* Calculate the address of the word we are interested in. */
3351 p1
= m2expr_BuildAddAddress (location
, p1
, p2
);
3353 /* Fetch the word, extract the bit and test for == 0. */
3354 m2treelib_do_jump_if_bit (
3356 m2expr_BuildIndirect (location
, p1
, m2type_GetBitsetType ()),
3357 offset_into_word
, label
);
3361 /* BuildForeachWordInSetDoIfExpr foreach word in set, type, compute
3362 the expression, expr, and if true goto label. */
3365 m2expr_BuildForeachWordInSetDoIfExpr (location_t location
, tree type
, tree op1
,
3366 tree op2
, int is_op1lvalue
,
3367 int is_op2lvalue
, int is_op1const
,
3369 tree (*expr
) (location_t
, tree
, tree
),
3372 tree p1
= m2treelib_get_set_address_if_var (location
, op1
, is_op1lvalue
,
3374 tree p2
= m2treelib_get_set_address_if_var (location
, op2
, is_op2lvalue
,
3376 unsigned int fieldNo
= 0;
3377 tree field1
= m2treelib_get_field_no (type
, op1
, is_op1const
, fieldNo
);
3378 tree field2
= m2treelib_get_field_no (type
, op2
, is_op2const
, fieldNo
);
3380 m2assert_AssertLocation (location
);
3381 ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op1
)) == RECORD_TYPE
);
3382 ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op2
)) == RECORD_TYPE
);
3384 while (field1
!= NULL
&& field2
!= NULL
)
3386 m2statement_DoJump (
3389 m2treelib_get_set_value (location
, p1
, field1
, is_op1const
,
3390 is_op1lvalue
, op1
, fieldNo
),
3391 m2treelib_get_set_value (location
, p2
, field2
, is_op2const
,
3392 is_op2lvalue
, op2
, fieldNo
)),
3395 field1
= m2treelib_get_field_no (type
, op1
, is_op1const
, fieldNo
);
3396 field2
= m2treelib_get_field_no (type
, op2
, is_op2const
, fieldNo
);
3400 /* BuildIfInRangeGoto returns a tree containing if var is in the
3401 range low..high then goto label. */
3404 m2expr_BuildIfInRangeGoto (location_t location
, tree var
, tree low
, tree high
,
3407 m2assert_AssertLocation (location
);
3409 if (m2expr_CompareTrees (low
, high
) == 0)
3410 m2statement_DoJump (location
, m2expr_BuildEqualTo (location
, var
, low
),
3413 m2statement_DoJump (
3415 m2expr_build_binary_op (
3416 location
, TRUTH_ANDIF_EXPR
,
3417 m2expr_BuildGreaterThanOrEqual (location
, var
, low
),
3418 m2expr_BuildLessThanOrEqual (location
, var
, high
), FALSE
),
3422 /* BuildIfNotInRangeGoto returns a tree containing if var is not in
3423 the range low..high then goto label. */
3426 m2expr_BuildIfNotInRangeGoto (location_t location
, tree var
, tree low
,
3427 tree high
, char *label
)
3429 m2assert_AssertLocation (location
);
3431 if (m2expr_CompareTrees (low
, high
) == 0)
3432 m2statement_DoJump (location
, m2expr_BuildNotEqualTo (location
, var
, low
),
3435 m2statement_DoJump (
3436 location
, m2expr_build_binary_op (
3437 location
, TRUTH_ORIF_EXPR
,
3438 m2expr_BuildLessThan (location
, var
, low
),
3439 m2expr_BuildGreaterThan (location
, var
, high
), FALSE
),
3443 /* BuildArray - returns a tree which accesses array[index] given,
3447 m2expr_BuildArray (location_t location
, tree type
, tree array
, tree index
,
3450 tree array_type
= m2tree_skip_type_decl (TREE_TYPE (array
));
3451 tree index_type
= TYPE_DOMAIN (array_type
);
3452 type
= m2tree_skip_type_decl (type
);
3453 // ASSERT_CONDITION (low_indice == TYPE_MIN_VALUE (index_type));
3456 = m2convert_BuildConvert (location
, index_type
, low_indice
, FALSE
);
3457 return build4_loc (location
, ARRAY_REF
, type
, array
, index
, low_indice
,
3461 /* BuildComponentRef - build a component reference tree which
3462 accesses record.field. If field does not belong to record it
3463 calls BuildComponentRef on the penultimate field. */
3466 m2expr_BuildComponentRef (location_t location
, tree record
, tree field
)
3468 tree recordType
= m2tree_skip_reference_type (
3469 m2tree_skip_type_decl (TREE_TYPE (record
)));
3471 if (DECL_CONTEXT (field
) == recordType
)
3472 return build3 (COMPONENT_REF
, TREE_TYPE (field
), record
, field
, NULL_TREE
);
3475 tree f
= determinePenultimateField (recordType
, field
);
3476 return m2expr_BuildComponentRef (
3477 location
, m2expr_BuildComponentRef (location
, record
, f
), field
);
3481 /* BuildIndirect - build: (*target) given that the object to be
3482 copied is of, type. */
3485 m2expr_BuildIndirect (location_t location ATTRIBUTE_UNUSED
, tree target
,
3488 /* Note that the second argument to build1 is:
3490 TYPE_QUALS is a list of modifiers such as const or volatile to apply
3491 to the pointer type, represented as identifiers.
3493 it also determines the type of arithmetic and size of the object to
3494 be indirectly moved. */
3496 tree t1
= m2tree_skip_type_decl (type
);
3497 tree t2
= build_pointer_type (t1
);
3499 m2assert_AssertLocation (location
);
3501 return build1 (INDIRECT_REF
, t1
,
3502 m2convert_BuildConvert (location
, t2
, target
, FALSE
));
3505 /* IsTrue - returns TRUE if, t, is known to be TRUE. */
3508 m2expr_IsTrue (tree t
)
3510 return (m2expr_FoldAndStrip (t
) == m2type_GetBooleanTrue ());
3513 /* IsFalse - returns FALSE if, t, is known to be FALSE. */
3516 m2expr_IsFalse (tree t
)
3518 return (m2expr_FoldAndStrip (t
) == m2type_GetBooleanFalse ());
3521 /* AreConstantsEqual - maps onto tree.cc (tree_int_cst_equal). It
3522 returns TRUE if the value of e1 is the same as e2. */
3525 m2expr_AreConstantsEqual (tree e1
, tree e2
)
3527 return tree_int_cst_equal (e1
, e2
) != 0;
3530 /* AreRealOrComplexConstantsEqual - returns TRUE if constants, e1 and
3531 e2 are equal according to IEEE rules. This does not perform bit
3532 equivalence for example IEEE states that -0 == 0 and NaN != NaN. */
3535 m2expr_AreRealOrComplexConstantsEqual (tree e1
, tree e2
)
3537 if (TREE_CODE (e1
) == COMPLEX_CST
)
3538 return (m2expr_AreRealOrComplexConstantsEqual (TREE_REALPART (e1
),
3540 && m2expr_AreRealOrComplexConstantsEqual (TREE_IMAGPART (e1
),
3541 TREE_IMAGPART (e2
)));
3543 return real_compare (EQ_EXPR
, &TREE_REAL_CST (e1
), &TREE_REAL_CST (e2
));
3546 /* DetermineSign, returns -1 if e<0 0 if e==0 1 if e>0
3547 an unsigned constant will never return -1. */
3550 m2expr_DetermineSign (tree e
)
3552 return tree_int_cst_sgn (e
);
3555 /* Similar to build_int_2 () but allows you to specify the type of
3556 the integer constant that you are creating. */
3559 build_int_2_type (HOST_WIDE_INT low
, HOST_WIDE_INT hi
, tree type
)
3562 HOST_WIDE_INT ival
[3];
3568 widest_int wval
= widest_int::from_array (ival
, 3);
3569 value
= wide_int_to_tree (type
, wval
);
3574 /* BuildCap - builds the Modula-2 function CAP(t) and returns the
3575 result in a gcc Tree. */
3578 m2expr_BuildCap (location_t location
, tree t
)
3581 tree out_of_range
, less_than
, greater_than
, translated
;
3583 m2assert_AssertLocation (location
);
3586 if (t
== error_mark_node
)
3587 return error_mark_node
;
3591 t
= fold (convert (m2type_GetM2CharType (), t
));
3593 if (TREE_CODE (tt
) == INTEGER_TYPE
)
3595 less_than
= fold (m2expr_build_binary_op (
3596 location
, LT_EXPR
, t
,
3597 build_int_2_type ('a', 0, m2type_GetM2CharType ()), 0));
3598 greater_than
= fold (m2expr_build_binary_op (
3599 location
, GT_EXPR
, t
,
3600 build_int_2_type ('z', 0, m2type_GetM2CharType ()), 0));
3601 out_of_range
= fold (m2expr_build_binary_op (
3602 location
, TRUTH_ORIF_EXPR
, less_than
, greater_than
, 0));
3604 translated
= fold (convert (
3605 m2type_GetM2CharType (),
3606 m2expr_build_binary_op (
3607 location
, MINUS_EXPR
, t
,
3608 build_int_2_type ('a' - 'A', 0, m2type_GetM2CharType ()), 0)));
3610 return fold_build3 (COND_EXPR
, m2type_GetM2CharType (), out_of_range
, t
,
3615 "argument to CAP is not a constant or variable of type CHAR");
3616 return error_mark_node
;
3619 /* BuildDivM2 if iso or pim4 then build and return ((op2 < 0) : (op1
3620 divceil op2) ? (op1 divfloor op2)) otherwise use divtrunc. */
3623 m2expr_BuildDivM2 (location_t location
, tree op1
, tree op2
,
3624 unsigned int needsconvert
)
3626 op1
= m2expr_FoldAndStrip (op1
);
3627 op2
= m2expr_FoldAndStrip (op2
);
3628 ASSERT_CONDITION (TREE_TYPE (op1
) == TREE_TYPE (op2
));
3629 if (M2Options_GetPIM4 () || M2Options_GetISO ()
3630 || M2Options_GetPositiveModFloor ())
3631 return fold_build3 (
3632 COND_EXPR
, TREE_TYPE (op1
),
3633 m2expr_BuildLessThan (
3635 m2convert_BuildConvert (location
, TREE_TYPE (op2
),
3636 m2expr_GetIntegerZero (location
), FALSE
)),
3637 m2expr_BuildDivCeil (location
, op1
, op2
, needsconvert
),
3638 m2expr_BuildDivFloor (location
, op1
, op2
, needsconvert
));
3640 return m2expr_BuildDivTrunc (location
, op1
, op2
, needsconvert
);
3643 /* BuildDivM2Check - build and
3644 return ((op2 < 0) : (op1 divtrunc op2) ? (op1 divfloor op2))
3645 when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
3646 return op1 div trunc op2. Use the checking div equivalents. */
3649 m2expr_BuildDivM2Check (location_t location
, tree op1
, tree op2
,
3650 tree lowest
, tree min
, tree max
)
3652 op1
= m2expr_FoldAndStrip (op1
);
3653 op2
= m2expr_FoldAndStrip (op2
);
3654 ASSERT_CONDITION (TREE_TYPE (op1
) == TREE_TYPE (op2
));
3655 if (M2Options_GetISO ()
3656 || M2Options_GetPIM4 () || M2Options_GetPositiveModFloor ())
3657 return fold_build3 (
3658 COND_EXPR
, TREE_TYPE (op1
),
3659 m2expr_BuildLessThan (
3661 m2convert_BuildConvert (location
, TREE_TYPE (op2
),
3662 m2expr_GetIntegerZero (location
), FALSE
)),
3663 m2expr_BuildDivCeilCheck (location
, op1
, op2
, lowest
, min
, max
),
3664 m2expr_BuildDivFloorCheck (location
, op1
, op2
, lowest
, min
, max
));
3666 return m2expr_BuildDivTruncCheck (location
, op1
, op2
, lowest
, min
, max
);
3671 m2expr_BuildISOModM2Check (location_t location
,
3672 tree op1
, tree op2
, tree lowest
, tree min
, tree max
)
3674 tree cond
= m2expr_BuildLessThan (location
, op2
,
3675 m2convert_BuildConvert (location
, TREE_TYPE (op2
),
3676 m2expr_GetIntegerZero (location
), FALSE
));
3678 /* Return the result of the modulus. */
3679 return fold_build3 (COND_EXPR
, TREE_TYPE (op1
), cond
,
3681 m2expr_BuildModCeilCheck (location
, op1
, op2
, lowest
, min
, max
),
3683 m2expr_BuildModFloorCheck (location
, op1
, op2
, lowest
, min
, max
));
3687 /* BuildModM2Check if iso or pim4 then build and return ((op2 < 0) : (op1
3688 modceil op2) ? (op1 modfloor op2)) otherwise use modtrunc.
3689 Use the checking mod equivalents. */
3692 m2expr_BuildModM2Check (location_t location
, tree op1
, tree op2
,
3693 tree lowest
, tree min
, tree max
)
3695 op1
= m2expr_FoldAndStrip (op1
);
3696 op2
= m2expr_FoldAndStrip (op2
);
3697 ASSERT_CONDITION (TREE_TYPE (op1
) == TREE_TYPE (op2
));
3698 if (M2Options_GetPIM4 () || M2Options_GetISO ()
3699 || M2Options_GetPositiveModFloor ())
3700 return m2expr_BuildISOModM2Check (location
, op1
, op2
, lowest
, min
, max
);
3702 return m2expr_BuildModTruncCheck (location
, op1
, op2
, lowest
, min
, max
);
3705 /* BuildModM2 if iso or pim4 then build and return ((op2 < 0) : (op1
3706 modceil op2) ? (op1 modfloor op2)) otherwise use modtrunc. */
3709 m2expr_BuildModM2 (location_t location
, tree op1
, tree op2
,
3710 unsigned int needsconvert
)
3712 op1
= m2expr_FoldAndStrip (op1
);
3713 op2
= m2expr_FoldAndStrip (op2
);
3714 ASSERT_CONDITION (TREE_TYPE (op1
) == TREE_TYPE (op2
));
3715 if (M2Options_GetPIM4 () || M2Options_GetISO ()
3716 || M2Options_GetPositiveModFloor ())
3717 return fold_build3 (
3718 COND_EXPR
, TREE_TYPE (op1
),
3719 m2expr_BuildLessThan (
3721 m2convert_BuildConvert (location
, TREE_TYPE (op2
),
3722 m2expr_GetIntegerZero (location
), FALSE
)),
3723 m2expr_BuildModCeil (location
, op1
, op2
, needsconvert
),
3724 m2expr_BuildModFloor (location
, op1
, op2
, needsconvert
));
3726 return m2expr_BuildModTrunc (location
, op1
, op2
, needsconvert
);
3729 /* BuildAbs build the Modula-2 function ABS(t) and return the result
3733 m2expr_BuildAbs (location_t location
, tree t
)
3735 m2assert_AssertLocation (location
);
3737 return m2expr_build_unary_op (location
, ABS_EXPR
, t
, 0);
3740 /* BuildRe build an expression for the function RE. */
3743 m2expr_BuildRe (tree op1
)
3745 op1
= m2expr_FoldAndStrip (op1
);
3746 if (TREE_CODE (op1
) == COMPLEX_CST
)
3747 return fold_build1 (REALPART_EXPR
, TREE_TYPE (TREE_TYPE (op1
)), op1
);
3749 return build1 (REALPART_EXPR
, TREE_TYPE (TREE_TYPE (op1
)), op1
);
3752 /* BuildIm build an expression for the function IM. */
3755 m2expr_BuildIm (tree op1
)
3757 op1
= m2expr_FoldAndStrip (op1
);
3758 if (TREE_CODE (op1
) == COMPLEX_CST
)
3759 return fold_build1 (IMAGPART_EXPR
, TREE_TYPE (TREE_TYPE (op1
)), op1
);
3761 return build1 (IMAGPART_EXPR
, TREE_TYPE (TREE_TYPE (op1
)), op1
);
3764 /* BuildCmplx build an expression for the function CMPLX. */
3767 m2expr_BuildCmplx (location_t location
, tree type
, tree real
, tree imag
)
3770 real
= m2expr_FoldAndStrip (real
);
3771 imag
= m2expr_FoldAndStrip (imag
);
3772 type
= m2tree_skip_type_decl (type
);
3773 scalor
= TREE_TYPE (type
);
3775 if (scalor
!= TREE_TYPE (real
))
3776 real
= m2convert_BuildConvert (location
, scalor
, real
, FALSE
);
3777 if (scalor
!= TREE_TYPE (imag
))
3778 imag
= m2convert_BuildConvert (location
, scalor
, imag
, FALSE
);
3780 if ((TREE_CODE (real
) == REAL_CST
) && (TREE_CODE (imag
) == REAL_CST
))
3781 return build_complex (type
, real
, imag
);
3783 return build2 (COMPLEX_EXPR
, type
, real
, imag
);
3786 /* BuildBinaryForeachWordDo implements the large set operators. Each
3787 word of the set can be calculated by binop. This function runs along
3788 each word of the large set invoking the binop. */
3791 m2expr_BuildBinaryForeachWordDo (location_t location
, tree type
, tree op1
,
3793 tree (*binop
) (location_t
, tree
, tree
, int),
3794 int is_op1lvalue
, int is_op2lvalue
,
3795 int is_op3lvalue
, int is_op1const
,
3796 int is_op2const
, int is_op3const
)
3798 tree size
= m2expr_GetSizeOf (location
, type
);
3800 m2assert_AssertLocation (location
);
3802 ASSERT_BOOL (is_op1lvalue
);
3803 ASSERT_BOOL (is_op2lvalue
);
3804 ASSERT_BOOL (is_op3lvalue
);
3805 ASSERT_BOOL (is_op1const
);
3806 ASSERT_BOOL (is_op2const
);
3807 ASSERT_BOOL (is_op3const
);
3808 if (m2expr_CompareTrees (
3809 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
3811 /* Small set size <= TSIZE(WORD). */
3812 m2statement_BuildAssignmentTree (
3813 location
, m2treelib_get_rvalue (location
, op1
, type
, is_op1lvalue
),
3815 location
, m2treelib_get_rvalue (location
, op2
, type
, is_op2lvalue
),
3816 m2treelib_get_rvalue (location
, op3
, type
, is_op3lvalue
), FALSE
));
3819 /* Large set size > TSIZE(WORD). */
3821 tree p2
= m2treelib_get_set_address_if_var (location
, op2
, is_op2lvalue
,
3823 tree p3
= m2treelib_get_set_address_if_var (location
, op3
, is_op3lvalue
,
3825 unsigned int fieldNo
= 0;
3826 tree field1
= m2treelib_get_field_no (type
, op1
, is_op1const
, fieldNo
);
3827 tree field2
= m2treelib_get_field_no (type
, op2
, is_op2const
, fieldNo
);
3828 tree field3
= m2treelib_get_field_no (type
, op3
, is_op3const
, fieldNo
);
3833 "internal error: not expecting operand1 to be a constant set");
3835 while (field1
!= NULL
&& field2
!= NULL
&& field3
!= NULL
)
3837 m2statement_BuildAssignmentTree (
3838 location
, m2treelib_get_set_field_des (location
, op1
, field1
),
3841 m2treelib_get_set_value (location
, p2
, field2
, is_op2const
,
3842 is_op2lvalue
, op2
, fieldNo
),
3843 m2treelib_get_set_value (location
, p3
, field3
, is_op3const
,
3844 is_op3lvalue
, op3
, fieldNo
),
3847 field1
= m2treelib_get_field_no (type
, op1
, is_op1const
, fieldNo
);
3848 field2
= m2treelib_get_field_no (type
, op2
, is_op2const
, fieldNo
);
3849 field3
= m2treelib_get_field_no (type
, op3
, is_op3const
, fieldNo
);
3854 /* Append DIGIT to NUM, a number of PRECISION bits being read in base
3858 append_digit (unsigned HOST_WIDE_INT
*low
, HOST_WIDE_INT
*high
,
3859 unsigned int digit
, unsigned int base
)
3863 HOST_WIDE_INT add_high
, res_high
, test_high
;
3864 unsigned HOST_WIDE_INT add_low
, res_low
, test_low
;
3884 error ("internal error: not expecting this base value for a constant");
3887 /* Multiply by 2, 8 or 16. Catching this overflow here means we
3888 don't need to worry about add_high overflowing. */
3889 if (((*high
) >> (INT_TYPE_SIZE
- shift
)) == 0)
3894 res_high
= *high
<< shift
;
3895 res_low
= *low
<< shift
;
3896 res_high
|= (*low
) >> (INT_TYPE_SIZE
- shift
);
3900 add_low
= (*low
) << 1;
3901 add_high
= ((*high
) << 1) + ((*low
) >> (INT_TYPE_SIZE
- 1));
3904 add_high
= add_low
= 0;
3906 test_low
= add_low
+ digit
;
3907 if (test_low
< add_low
)
3911 test_low
= res_low
+ add_low
;
3912 if (test_low
< res_low
)
3914 test_high
= res_high
+ add_high
;
3915 if (test_high
< res_high
)
3918 *low
= res_low
+ add_low
;
3919 *high
= res_high
+ add_high
;
3924 /* interpret_integer convert an integer constant into two integer
3925 constants. Heavily borrowed from gcc/cppexp.cc. */
3928 m2expr_interpret_integer (const char *str
, unsigned int base
,
3929 unsigned HOST_WIDE_INT
*low
, HOST_WIDE_INT
*high
)
3931 unsigned const char *p
, *end
;
3932 int overflow
= FALSE
;
3937 p
= (unsigned const char *)str
;
3941 /* Common case of a single digit. */
3948 /* We can add a digit to numbers strictly less than this without
3949 needing the precision and slowness of double integers. */
3951 unsigned HOST_WIDE_INT max
= ~(unsigned HOST_WIDE_INT
)0;
3952 max
= (max
- base
+ 1) / base
+ 1;
3954 for (; p
< end
; p
++)
3958 if (ISDIGIT (c
) || (base
== 16 && ISXDIGIT (c
)))
3963 /* Strict inequality for when max is set to zero. */
3965 *low
= (*low
) * base
+ c
;
3968 overflow
= append_digit (low
, high
, c
, base
);
3969 max
= 0; /* From now on we always use append_digit. */
3976 /* Append DIGIT to NUM, a number of PRECISION bits being read in base
3980 append_m2_digit (unsigned int *low
, int *high
, unsigned int digit
,
3981 unsigned int base
, int *needsUnsigned
)
3985 int add_high
, res_high
, test_high
;
3986 unsigned int add_low
, res_low
, test_low
;
3987 unsigned int add_uhigh
, res_uhigh
, test_uhigh
;
4007 error ("internal error: not expecting this base value for a constant");
4010 /* Multiply by 2, 8 or 16. Catching this overflow here means we
4011 don't need to worry about add_high overflowing. */
4012 if (((*high
) >> (INT_TYPE_SIZE
- shift
)) == 0)
4017 res_high
= *high
<< shift
;
4018 res_low
= *low
<< shift
;
4019 res_high
|= (*low
) >> (INT_TYPE_SIZE
- shift
);
4023 add_low
= (*low
) << 1;
4024 add_high
= ((*high
) << 1) + ((*low
) >> (INT_TYPE_SIZE
- 1));
4027 add_high
= add_low
= 0;
4029 test_low
= add_low
+ digit
;
4030 if (test_low
< add_low
)
4034 test_low
= res_low
+ add_low
;
4035 if (test_low
< res_low
)
4037 test_high
= res_high
+ add_high
;
4038 if (test_high
< res_high
)
4040 res_uhigh
= res_high
;
4041 add_uhigh
= add_high
;
4042 test_uhigh
= res_uhigh
+ add_uhigh
;
4043 if (test_uhigh
< res_uhigh
)
4046 *needsUnsigned
= TRUE
;
4049 *low
= res_low
+ add_low
;
4050 *high
= res_high
+ add_high
;
4055 /* interpret_m2_integer convert an integer constant into two integer
4056 constants. Heavily borrowed from gcc/cppexp.cc. Note that this is a
4057 copy of the above code except that it uses `int' rather than
4058 HOST_WIDE_INT to allow gm2 to determine what Modula-2 base type to
4059 use for this constant and it also sets needsLong and needsUnsigned
4060 if an overflow can be avoided by using these techniques. */
4063 m2expr_interpret_m2_integer (const char *str
, unsigned int base
,
4064 unsigned int *low
, int *high
,
4065 int *needsLong
, int *needsUnsigned
)
4067 const unsigned char *p
, *end
;
4070 *needsUnsigned
= FALSE
;
4074 p
= (unsigned const char *)str
;
4078 /* Common case of a single digit. */
4085 /* We can add a digit to numbers strictly less than this without
4086 needing the precision and slowness of double integers. */
4088 unsigned int max
= ~(unsigned int)0;
4089 max
= (max
- base
+ 1) / base
+ 1;
4091 for (; p
< end
; p
++)
4095 if (ISDIGIT (c
) || (base
== 16 && ISXDIGIT (c
)))
4098 return FALSE
; /* End of string and no overflow found. */
4100 /* Strict inequality for when max is set to zero. */
4102 *low
= (*low
) * base
+ c
;
4106 if (append_m2_digit (low
, high
, c
, base
,
4108 return TRUE
; /* We have overflowed so bail out. */
4109 max
= 0; /* From now on we always use append_digit. */
4116 /* GetSizeOfInBits return the number of bits used to contain, type. */
4119 m2expr_GetSizeOfInBits (tree type
)
4121 enum tree_code code
= TREE_CODE (type
);
4123 if (code
== FUNCTION_TYPE
)
4124 return m2expr_GetSizeOfInBits (ptr_type_node
);
4126 if (code
== VOID_TYPE
)
4128 error ("%qs applied to a void type", "sizeof");
4129 return size_one_node
;
4132 if (code
== VAR_DECL
)
4133 return m2expr_GetSizeOfInBits (TREE_TYPE (type
));
4135 if (code
== PARM_DECL
)
4136 return m2expr_GetSizeOfInBits (TREE_TYPE (type
));
4138 if (code
== TYPE_DECL
)
4139 return m2expr_GetSizeOfInBits (TREE_TYPE (type
));
4141 if (code
== COMPONENT_REF
)
4142 return m2expr_GetSizeOfInBits (TREE_TYPE (type
));
4144 if (code
== ERROR_MARK
)
4145 return size_one_node
;
4147 if (!COMPLETE_TYPE_P (type
))
4149 error ("%qs applied to an incomplete type", "sizeof");
4150 return size_zero_node
;
4153 return m2decl_BuildIntegerConstant (TYPE_PRECISION (type
));
4156 /* GetSizeOf taken from c-typeck.cc (c_sizeof). */
4159 m2expr_GetSizeOf (location_t location
, tree type
)
4161 enum tree_code code
= TREE_CODE (type
);
4162 m2assert_AssertLocation (location
);
4164 if (code
== FUNCTION_TYPE
)
4165 return m2expr_GetSizeOf (location
, m2type_GetPointerType ());
4167 if (code
== VOID_TYPE
)
4168 return size_one_node
;
4170 if (code
== VAR_DECL
)
4171 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4173 if (code
== PARM_DECL
)
4174 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4176 if (code
== TYPE_DECL
)
4177 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4179 if (code
== ERROR_MARK
)
4180 return size_one_node
;
4182 if (code
== CONSTRUCTOR
)
4183 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4185 if (code
== FIELD_DECL
)
4186 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4188 if (code
== COMPONENT_REF
)
4189 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4191 if (!COMPLETE_TYPE_P (type
))
4193 error_at (location
, "%qs applied to an incomplete type", "sizeof");
4194 return size_zero_node
;
4197 /* Convert in case a char is more than one unit. */
4198 return size_binop_loc (
4199 location
, CEIL_DIV_EXPR
, TYPE_SIZE_UNIT (type
),
4200 size_int (TYPE_PRECISION (char_type_node
) / BITS_PER_UNIT
));
4204 m2expr_GetIntegerZero (location_t location ATTRIBUTE_UNUSED
)
4206 return integer_zero_node
;
4210 m2expr_GetIntegerOne (location_t location ATTRIBUTE_UNUSED
)
4212 return integer_one_node
;
4216 m2expr_GetCardinalOne (location_t location
)
4218 return m2convert_ToCardinal (location
, integer_one_node
);
4222 m2expr_GetCardinalZero (location_t location
)
4224 return m2convert_ToCardinal (location
, integer_zero_node
);
4228 m2expr_GetWordZero (location_t location
)
4230 return m2convert_ToWord (location
, integer_zero_node
);
4234 m2expr_GetWordOne (location_t location
)
4236 return m2convert_ToWord (location
, integer_one_node
);
4240 m2expr_GetPointerZero (location_t location
)
4242 return m2convert_convertToPtr (location
, integer_zero_node
);
4246 m2expr_GetPointerOne (location_t location
)
4248 return m2convert_convertToPtr (location
, integer_one_node
);
4251 /* build_set_full_complement return a word size value with all bits
4255 build_set_full_complement (location_t location
)
4257 tree value
= integer_zero_node
;
4260 m2assert_AssertLocation (location
);
4262 for (i
= 0; i
< SET_WORD_SIZE
; i
++)
4264 value
= m2expr_BuildLogicalOr (
4267 location
, m2expr_GetWordOne (location
),
4268 m2convert_BuildConvert (location
, m2type_GetWordType (),
4269 m2decl_BuildIntegerConstant (i
), FALSE
),
4276 /* init initialise this module. */
4279 m2expr_init (location_t location
)
4281 m2assert_AssertLocation (location
);
4283 set_full_complement
= build_set_full_complement (location
);
4286 #include "gt-m2-m2expr.h"