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"
42 #include "m2linemap.h"
45 static void m2expr_checkRealOverflow (location_t location
, enum tree_code code
,
47 static tree
checkWholeNegateOverflow (location_t location
, tree i
, tree lowest
,
49 // static tree m2expr_Build4LogicalAnd (location_t location, tree a, tree b,
51 static tree
m2expr_Build4LogicalOr (location_t location
, tree a
, tree b
,
53 static tree
m2expr_Build4TruthOrIf (location_t location
, tree a
, tree b
,
55 static tree
m2expr_Build4TruthAndIf (location_t location
, tree a
, tree b
,
58 static int label_count
= 0;
59 static GTY (()) tree set_full_complement
;
61 /* Return an integer string using base 10 and no padding. The string returned
62 will have been malloc'd. */
65 m2expr_CSTIntToString (tree t
)
69 snprintf (val
, 100, HOST_WIDE_INT_PRINT_UNSIGNED
, TREE_INT_CST_LOW (t
));
70 return xstrndup (val
, 100);
73 /* Return the char representation of tree t. */
76 m2expr_CSTIntToChar (tree t
)
78 return (char) (TREE_INT_CST_LOW (t
));
81 /* CompareTrees returns -1 if e1 < e2, 0 if e1 == e2, and 1 if e1 > e2. */
84 m2expr_CompareTrees (tree e1
, tree e2
)
86 return tree_int_cst_compare (m2expr_FoldAndStrip (e1
),
87 m2expr_FoldAndStrip (e2
));
90 /* FoldAndStrip return expression, t, after it has been folded (if
94 m2expr_FoldAndStrip (tree t
)
99 if (TREE_CODE (t
) == CONST_DECL
)
100 return m2expr_FoldAndStrip (DECL_INITIAL (t
));
106 /* StringLength returns an unsigned int which is the length of, string. */
109 m2expr_StringLength (tree string
)
111 return TREE_STRING_LENGTH (string
);
114 /* CheckAddressToCardinal if op is a pointer convert it to the ADDRESS type. */
117 CheckAddressToCardinal (location_t location
, tree op
)
119 if (m2type_IsAddress (TREE_TYPE (op
)))
120 return m2convert_BuildConvert (location
, m2type_GetCardinalAddressType (),
125 /* BuildTruthAndIf return true if a && b. Retain order left to right. */
128 m2expr_BuildTruthAndIf (location_t location
, tree a
, tree b
)
130 return m2expr_build_binary_op (location
, TRUTH_ANDIF_EXPR
, a
, b
, false);
133 /* BuildTruthOrIf return true if a || b. Retain order left to right. */
136 m2expr_BuildTruthOrIf (location_t location
, tree a
, tree b
)
138 return m2expr_build_binary_op (location
, TRUTH_ORIF_EXPR
, a
, b
, false);
141 /* BuildTruthNotIf inverts the boolean value of expr and returns the result. */
144 m2expr_BuildTruthNot (location_t location
, tree expr
)
146 return m2expr_build_unary_op (location
, TRUTH_NOT_EXPR
, expr
, false);
149 /* BuildPostInc builds a post increment tree, the second operand is
153 m2expr_BuildPostInc (location_t location
, tree op
)
155 return m2expr_BuildAdd (location
, op
, build_int_cst (TREE_TYPE (op
), 1), false);
158 /* BuildPostDec builds a post decrement tree, the second operand is
162 m2expr_BuildPostDec (location_t location
, tree op
)
164 return m2expr_BuildSub (location
, op
, build_int_cst (TREE_TYPE (op
), 1), false);
167 /* BuildAddCheck builds an addition tree. */
170 m2expr_BuildAddCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
175 m2assert_AssertLocation (location
);
177 op1
= m2expr_FoldAndStrip (op1
);
178 op2
= m2expr_FoldAndStrip (op2
);
180 op1
= CheckAddressToCardinal (location
, op1
);
181 op2
= CheckAddressToCardinal (location
, op2
);
183 t
= m2expr_build_binary_op_check (location
, PLUS_EXPR
, op1
, op2
, false,
185 return m2expr_FoldAndStrip (t
);
188 /* BuildAdd builds an addition tree. */
191 m2expr_BuildAdd (location_t location
, tree op1
, tree op2
, bool needconvert
)
195 m2assert_AssertLocation (location
);
197 op1
= m2expr_FoldAndStrip (op1
);
198 op2
= m2expr_FoldAndStrip (op2
);
200 op1
= CheckAddressToCardinal (location
, op1
);
201 op2
= CheckAddressToCardinal (location
, op2
);
203 t
= m2expr_build_binary_op (location
, PLUS_EXPR
, op1
, op2
, needconvert
);
204 return m2expr_FoldAndStrip (t
);
207 /* BuildSubCheck builds a subtraction tree. */
210 m2expr_BuildSubCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
215 m2assert_AssertLocation (location
);
217 op1
= m2expr_FoldAndStrip (op1
);
218 op2
= m2expr_FoldAndStrip (op2
);
220 op1
= CheckAddressToCardinal (location
, op1
);
221 op2
= CheckAddressToCardinal (location
, op2
);
223 t
= m2expr_build_binary_op_check (location
, MINUS_EXPR
, op1
, op2
, false,
225 return m2expr_FoldAndStrip (t
);
228 /* BuildSub builds a subtraction tree. */
231 m2expr_BuildSub (location_t location
, tree op1
, tree op2
, bool needconvert
)
235 m2assert_AssertLocation (location
);
237 op1
= m2expr_FoldAndStrip (op1
);
238 op2
= m2expr_FoldAndStrip (op2
);
240 op1
= CheckAddressToCardinal (location
, op1
);
241 op2
= CheckAddressToCardinal (location
, op2
);
243 t
= m2expr_build_binary_op (location
, MINUS_EXPR
, op1
, op2
, needconvert
);
244 return m2expr_FoldAndStrip (t
);
247 /* BuildDivTrunc builds a trunc division tree. */
250 m2expr_BuildDivTrunc (location_t location
, tree op1
, tree op2
, bool needconvert
)
254 m2assert_AssertLocation (location
);
256 op1
= m2expr_FoldAndStrip (op1
);
257 op2
= m2expr_FoldAndStrip (op2
);
259 op1
= CheckAddressToCardinal (location
, op1
);
260 op2
= CheckAddressToCardinal (location
, op2
);
262 t
= m2expr_build_binary_op (location
, TRUNC_DIV_EXPR
, op1
, op2
, needconvert
);
263 return m2expr_FoldAndStrip (t
);
266 /* BuildDivTruncCheck builds a trunc division tree. */
269 m2expr_BuildDivTruncCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
274 m2assert_AssertLocation (location
);
276 op1
= m2expr_FoldAndStrip (op1
);
277 op2
= m2expr_FoldAndStrip (op2
);
279 op1
= CheckAddressToCardinal (location
, op1
);
280 op2
= CheckAddressToCardinal (location
, op2
);
282 t
= m2expr_build_binary_op_check (location
, TRUNC_DIV_EXPR
, op1
, op2
, false,
284 return m2expr_FoldAndStrip (t
);
287 /* BuildModTruncCheck builds a trunc modulus tree. */
290 m2expr_BuildModTruncCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
295 m2assert_AssertLocation (location
);
297 op1
= m2expr_FoldAndStrip (op1
);
298 op2
= m2expr_FoldAndStrip (op2
);
300 op1
= CheckAddressToCardinal (location
, op1
);
301 op2
= CheckAddressToCardinal (location
, op2
);
303 t
= m2expr_build_binary_op_check (location
, TRUNC_MOD_EXPR
, op1
, op2
, false,
305 return m2expr_FoldAndStrip (t
);
308 /* BuildModTrunc builds a trunc modulus tree. */
311 m2expr_BuildModTrunc (location_t location
, tree op1
, tree op2
, bool needconvert
)
315 m2assert_AssertLocation (location
);
317 op1
= m2expr_FoldAndStrip (op1
);
318 op2
= m2expr_FoldAndStrip (op2
);
320 op1
= CheckAddressToCardinal (location
, op1
);
321 op2
= CheckAddressToCardinal (location
, op2
);
323 t
= m2expr_build_binary_op (location
, TRUNC_MOD_EXPR
, op1
, op2
, needconvert
);
324 return m2expr_FoldAndStrip (t
);
327 /* BuildModCeilCheck builds a ceil modulus tree. */
330 m2expr_BuildModCeilCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
335 m2assert_AssertLocation (location
);
337 op1
= m2expr_FoldAndStrip (op1
);
338 op2
= m2expr_FoldAndStrip (op2
);
340 op1
= CheckAddressToCardinal (location
, op1
);
341 op2
= CheckAddressToCardinal (location
, op2
);
343 t
= m2expr_build_binary_op_check (location
, CEIL_MOD_EXPR
, op1
, op2
, false,
345 return m2expr_FoldAndStrip (t
);
348 /* BuildModFloorCheck builds a trunc modulus tree. */
351 m2expr_BuildModFloorCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
356 m2assert_AssertLocation (location
);
358 op1
= m2expr_FoldAndStrip (op1
);
359 op2
= m2expr_FoldAndStrip (op2
);
361 op1
= CheckAddressToCardinal (location
, op1
);
362 op2
= CheckAddressToCardinal (location
, op2
);
364 t
= m2expr_build_binary_op_check (location
, FLOOR_MOD_EXPR
, op1
, op2
, false,
366 return m2expr_FoldAndStrip (t
);
369 /* BuildDivCeil builds a ceil division tree. */
372 m2expr_BuildDivCeil (location_t location
, tree op1
, tree op2
, bool needconvert
)
376 m2assert_AssertLocation (location
);
378 op1
= m2expr_FoldAndStrip (op1
);
379 op2
= m2expr_FoldAndStrip (op2
);
381 op1
= CheckAddressToCardinal (location
, op1
);
382 op2
= CheckAddressToCardinal (location
, op2
);
384 t
= m2expr_build_binary_op (location
, CEIL_DIV_EXPR
, op1
, op2
, needconvert
);
385 return m2expr_FoldAndStrip (t
);
388 /* BuildDivCeilCheck builds a check ceil division tree. */
391 m2expr_BuildDivCeilCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
396 m2assert_AssertLocation (location
);
398 op1
= m2expr_FoldAndStrip (op1
);
399 op2
= m2expr_FoldAndStrip (op2
);
401 op1
= CheckAddressToCardinal (location
, op1
);
402 op2
= CheckAddressToCardinal (location
, op2
);
404 t
= m2expr_build_binary_op_check (location
, CEIL_DIV_EXPR
, op1
, op2
, false,
406 return m2expr_FoldAndStrip (t
);
409 /* BuildModCeil builds a ceil modulus tree. */
412 m2expr_BuildModCeil (location_t location
, tree op1
, tree op2
, bool needconvert
)
416 m2assert_AssertLocation (location
);
418 op1
= m2expr_FoldAndStrip (op1
);
419 op2
= m2expr_FoldAndStrip (op2
);
421 op1
= CheckAddressToCardinal (location
, op1
);
422 op2
= CheckAddressToCardinal (location
, op2
);
424 t
= m2expr_build_binary_op (location
, CEIL_MOD_EXPR
, op1
, op2
, needconvert
);
425 return m2expr_FoldAndStrip (t
);
428 /* BuildDivFloor builds a floor division tree. */
431 m2expr_BuildDivFloor (location_t location
, tree op1
, tree op2
, bool needconvert
)
435 m2assert_AssertLocation (location
);
437 op1
= m2expr_FoldAndStrip (op1
);
438 op2
= m2expr_FoldAndStrip (op2
);
440 op1
= CheckAddressToCardinal (location
, op1
);
441 op2
= CheckAddressToCardinal (location
, op2
);
443 t
= m2expr_build_binary_op (location
, FLOOR_DIV_EXPR
, op1
, op2
, needconvert
);
444 return m2expr_FoldAndStrip (t
);
447 /* BuildDivFloorCheck builds a check floor division tree. */
450 m2expr_BuildDivFloorCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
455 m2assert_AssertLocation (location
);
457 op1
= m2expr_FoldAndStrip (op1
);
458 op2
= m2expr_FoldAndStrip (op2
);
460 op1
= CheckAddressToCardinal (location
, op1
);
461 op2
= CheckAddressToCardinal (location
, op2
);
463 t
= m2expr_build_binary_op_check (location
, FLOOR_DIV_EXPR
, op1
, op2
, false,
465 return m2expr_FoldAndStrip (t
);
468 /* BuildRDiv builds a division tree (this should only be used for
469 REAL and COMPLEX types and NEVER for integer based types). */
472 m2expr_BuildRDiv (location_t location
, tree op1
, tree op2
, bool needconvert
)
476 m2assert_AssertLocation (location
);
478 op1
= m2expr_FoldAndStrip (op1
);
479 op2
= m2expr_FoldAndStrip (op2
);
481 t
= m2expr_build_binary_op (location
, RDIV_EXPR
, op1
, op2
, needconvert
);
482 return m2expr_FoldAndStrip (t
);
485 /* BuildModFloor builds a modulus tree. */
488 m2expr_BuildModFloor (location_t location
, tree op1
, tree op2
, bool needconvert
)
492 m2assert_AssertLocation (location
);
494 op1
= m2expr_FoldAndStrip (op1
);
495 op2
= m2expr_FoldAndStrip (op2
);
497 op1
= CheckAddressToCardinal (location
, op1
);
498 op2
= CheckAddressToCardinal (location
, op2
);
500 t
= m2expr_build_binary_op (location
, FLOOR_MOD_EXPR
, op1
, op2
, needconvert
);
501 return m2expr_FoldAndStrip (t
);
504 /* BuildLSL builds and returns tree (op1 << op2). */
507 m2expr_BuildLSL (location_t location
, tree op1
, tree op2
, bool needconvert
)
511 m2assert_AssertLocation (location
);
513 op1
= m2expr_FoldAndStrip (op1
);
514 op2
= m2expr_FoldAndStrip (op2
);
516 t
= m2expr_build_binary_op (location
, LSHIFT_EXPR
, op1
, op2
, needconvert
);
517 return m2expr_FoldAndStrip (t
);
520 /* BuildLSR builds and returns tree (op1 >> op2). */
523 m2expr_BuildLSR (location_t location
, tree op1
, tree op2
, bool needconvert
)
527 m2assert_AssertLocation (location
);
529 op1
= m2expr_FoldAndStrip (op1
);
530 op2
= m2expr_FoldAndStrip (op2
);
532 t
= m2expr_build_binary_op (location
, RSHIFT_EXPR
, op1
, op2
, needconvert
);
533 return m2expr_FoldAndStrip (t
);
536 /* createUniqueLabel returns a unique label which has been alloc'ed. */
539 createUniqueLabel (void)
546 size
= strlen (".LSHIFT") + 2;
552 label
= (char *)ggc_alloc_atomic (size
);
553 sprintf (label
, ".LSHIFT%d", label_count
);
557 /* BuildLogicalShift builds the ISO Modula-2 SHIFT operator for a
558 fundamental data type. */
561 m2expr_BuildLogicalShift (location_t location
, tree op1
, tree op2
, tree op3
,
562 tree nBits ATTRIBUTE_UNUSED
, bool needconvert
)
566 m2assert_AssertLocation (location
);
567 op2
= m2expr_FoldAndStrip (op2
);
568 op3
= m2expr_FoldAndStrip (op3
);
569 if (TREE_CODE (op3
) == INTEGER_CST
)
571 op2
= m2convert_ToWord (location
, op2
);
572 if (tree_int_cst_sgn (op3
) < 0)
573 res
= m2expr_BuildLSR (
575 m2convert_ToWord (location
,
576 m2expr_BuildNegate (location
, op3
, needconvert
)),
579 res
= m2expr_BuildLSL (location
, op2
, m2convert_ToWord (location
, op3
),
581 res
= m2convert_BuildConvert (
582 location
, m2tree_skip_type_decl (TREE_TYPE (op1
)), res
, false);
583 m2statement_BuildAssignmentTree (location
, op1
, res
);
587 char *labelElseName
= createUniqueLabel ();
588 char *labelEndName
= createUniqueLabel ();
589 tree is_less
= m2expr_BuildLessThan (location
,
590 m2convert_ToInteger (location
, op3
),
591 m2expr_GetIntegerZero (location
));
593 m2statement_DoJump (location
, is_less
, NULL
, labelElseName
);
594 op2
= m2convert_ToWord (location
, op2
);
595 op3
= m2convert_ToWord (location
, op3
);
596 res
= m2expr_BuildLSL (location
, op2
, op3
, needconvert
);
597 res
= m2convert_BuildConvert (
598 location
, m2tree_skip_type_decl (TREE_TYPE (op1
)), res
, false);
599 m2statement_BuildAssignmentTree (location
, op1
, res
);
600 m2statement_BuildGoto (location
, labelEndName
);
601 m2statement_DeclareLabel (location
, labelElseName
);
602 res
= m2expr_BuildLSR (location
, op2
,
603 m2expr_BuildNegate (location
, op3
, needconvert
),
605 res
= m2convert_BuildConvert (
606 location
, m2tree_skip_type_decl (TREE_TYPE (op1
)), res
, false);
607 m2statement_BuildAssignmentTree (location
, op1
, res
);
608 m2statement_DeclareLabel (location
, labelEndName
);
612 /* BuildLRL builds and returns tree (op1 rotate left by op2 bits). */
615 m2expr_BuildLRL (location_t location
, tree op1
, tree op2
, bool needconvert
)
619 m2assert_AssertLocation (location
);
621 op1
= m2expr_FoldAndStrip (op1
);
622 op2
= m2expr_FoldAndStrip (op2
);
624 t
= m2expr_build_binary_op (location
, LROTATE_EXPR
, op1
, op2
, needconvert
);
625 return m2expr_FoldAndStrip (t
);
628 /* BuildLRR builds and returns tree (op1 rotate right by op2 bits). */
631 m2expr_BuildLRR (location_t location
, tree op1
, tree op2
, bool needconvert
)
635 m2assert_AssertLocation (location
);
637 op1
= m2expr_FoldAndStrip (op1
);
638 op2
= m2expr_FoldAndStrip (op2
);
640 t
= m2expr_build_binary_op (location
, RROTATE_EXPR
, op1
, op2
, needconvert
);
641 return m2expr_FoldAndStrip (t
);
644 /* m2expr_BuildMask returns a tree for the mask of a set of nBits.
645 It assumes nBits is <= TSIZE (WORD). */
648 m2expr_BuildMask (location_t location
, tree nBits
, bool needconvert
)
650 tree mask
= m2expr_BuildLSL (location
, m2expr_GetIntegerOne (location
),
652 m2assert_AssertLocation (location
);
653 return m2expr_BuildSub (location
, mask
, m2expr_GetIntegerOne (location
),
657 /* m2expr_BuildLRotate returns a tree in which op1 has been left
658 rotated by nBits. It assumes nBits is <= TSIZE (WORD). */
661 m2expr_BuildLRotate (location_t location
, tree op1
, tree nBits
,
666 op1
= m2expr_FoldAndStrip (op1
);
667 nBits
= m2expr_FoldAndStrip (nBits
);
668 t
= m2expr_build_binary_op (location
, LROTATE_EXPR
, op1
, nBits
, needconvert
);
669 return m2expr_FoldAndStrip (t
);
672 /* m2expr_BuildRRotate returns a tree in which op1 has been left
673 rotated by nBits. It assumes nBits is <= TSIZE (WORD). */
676 m2expr_BuildRRotate (location_t location
, tree op1
, tree nBits
,
681 op1
= m2expr_FoldAndStrip (op1
);
682 nBits
= m2expr_FoldAndStrip (nBits
);
683 t
= m2expr_build_binary_op (location
, RROTATE_EXPR
, op1
, nBits
, needconvert
);
684 return m2expr_FoldAndStrip (t
);
687 /* BuildLRLn builds and returns tree (op1 rotate left by op2 bits) it
688 rotates a set of size, nBits. */
691 m2expr_BuildLRLn (location_t location
, tree op1
, tree op2
, tree nBits
,
696 m2assert_AssertLocation (location
);
698 /* Ensure we wrap the rotate. */
700 op2min
= m2expr_BuildModTrunc (
701 location
, m2convert_ToCardinal (location
, op2
),
702 m2convert_ToCardinal (location
, nBits
), needconvert
);
704 /* Optimize if we are we going to rotate a TSIZE(BITSET) set. */
706 if (m2expr_CompareTrees (
707 m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset ()), nBits
)
709 return m2expr_BuildLRotate (location
, op1
, op2min
, needconvert
);
712 tree mask
= m2expr_BuildMask (location
, nBits
, needconvert
);
715 /* Make absolutely sure there are no high order bits lying around. */
717 op1
= m2expr_BuildLogicalAnd (location
, op1
, mask
, needconvert
);
718 left
= m2expr_BuildLSL (location
, op1
, op2min
, needconvert
);
719 left
= m2expr_BuildLogicalAnd (location
, left
, mask
, needconvert
);
720 right
= m2expr_BuildLSR (
722 m2expr_BuildSub (location
, m2convert_ToCardinal (location
, nBits
),
723 op2min
, needconvert
),
725 return m2expr_BuildLogicalOr (location
, left
, right
, needconvert
);
729 /* BuildLRRn builds and returns tree (op1 rotate right by op2 bits).
730 It rotates a set of size, nBits. */
733 m2expr_BuildLRRn (location_t location
, tree op1
, tree op2
, tree nBits
,
738 m2assert_AssertLocation (location
);
740 /* Ensure we wrap the rotate. */
742 op2min
= m2expr_BuildModTrunc (
743 location
, m2convert_ToCardinal (location
, op2
),
744 m2convert_ToCardinal (location
, nBits
), needconvert
);
745 /* Optimize if we are we going to rotate a TSIZE(BITSET) set. */
747 if (m2expr_CompareTrees (
748 m2decl_BuildIntegerConstant (m2decl_GetBitsPerBitset ()), nBits
)
750 return m2expr_BuildRRotate (location
, op1
, op2min
, needconvert
);
753 tree mask
= m2expr_BuildMask (location
, nBits
, needconvert
);
756 /* Make absolutely sure there are no high order bits lying around. */
758 op1
= m2expr_BuildLogicalAnd (location
, op1
, mask
, needconvert
);
759 right
= m2expr_BuildLSR (location
, op1
, op2min
, needconvert
);
760 left
= m2expr_BuildLSL (
762 m2expr_BuildSub (location
, m2convert_ToCardinal (location
, nBits
),
763 op2min
, needconvert
),
765 left
= m2expr_BuildLogicalAnd (location
, left
, mask
, needconvert
);
766 return m2expr_BuildLogicalOr (location
, left
, right
, needconvert
);
770 /* BuildLogicalRotate build the ISO Modula-2 ROTATE operator for a
771 fundamental data type. */
774 m2expr_BuildLogicalRotate (location_t location
, tree op1
, tree op2
, tree op3
,
775 tree nBits
, bool needconvert
)
779 m2assert_AssertLocation (location
);
780 op2
= m2expr_FoldAndStrip (op2
);
781 op3
= m2expr_FoldAndStrip (op3
);
782 if (TREE_CODE (op3
) == INTEGER_CST
)
784 if (tree_int_cst_sgn (op3
) < 0)
785 res
= m2expr_BuildLRRn (
786 location
, op2
, m2expr_BuildNegate (location
, op3
, needconvert
),
789 res
= m2expr_BuildLRLn (location
, op2
, op3
, nBits
, needconvert
);
790 m2statement_BuildAssignmentTree (location
, op1
, res
);
794 char *labelElseName
= createUniqueLabel ();
795 char *labelEndName
= createUniqueLabel ();
796 tree is_less
= m2expr_BuildLessThan (location
,
797 m2convert_ToInteger (location
, op3
),
798 m2expr_GetIntegerZero (location
));
800 m2statement_DoJump (location
, is_less
, NULL
, labelElseName
);
801 res
= m2expr_BuildLRLn (location
, op2
, op3
, nBits
, needconvert
);
802 m2statement_BuildAssignmentTree (location
, op1
, res
);
803 m2statement_BuildGoto (location
, labelEndName
);
804 m2statement_DeclareLabel (location
, labelElseName
);
805 res
= m2expr_BuildLRRn (location
, op2
,
806 m2expr_BuildNegate (location
, op3
, needconvert
),
808 m2statement_BuildAssignmentTree (location
, op1
, res
);
809 m2statement_DeclareLabel (location
, labelEndName
);
813 /* buildUnboundedArrayOf construct an unbounded struct and returns
814 the gcc tree. The two fields of the structure are initialized to
815 contentsPtr and high. */
818 buildUnboundedArrayOf (tree unbounded
, tree contentsPtr
, tree high
)
820 tree fields
= TYPE_FIELDS (unbounded
);
821 tree field_list
= NULL_TREE
;
824 field_list
= tree_cons (fields
, contentsPtr
, field_list
);
825 fields
= TREE_CHAIN (fields
);
827 field_list
= tree_cons (fields
, high
, field_list
);
829 constructor
= build_constructor_from_list (unbounded
, nreverse (field_list
));
830 TREE_CONSTANT (constructor
) = 0;
831 TREE_STATIC (constructor
) = 0;
836 /* BuildBinarySetDo if the size of the set is <= TSIZE(WORD) then op1
837 := binop(op2, op3) else call m2rtsprocedure(op1, op2, op3). */
840 m2expr_BuildBinarySetDo (location_t location
, tree settype
, tree op1
, tree op2
,
841 tree op3
, void (*binop
) (location_t
, tree
, tree
, tree
,
843 bool is_op1lvalue
, bool is_op2lvalue
, bool is_op3lvalue
,
844 tree nBits
, tree unbounded
, tree varproc
,
845 tree leftproc
, tree rightproc
)
847 tree size
= m2expr_GetSizeOf (location
, settype
);
848 bool is_const
= false;
849 bool is_left
= false;
851 m2assert_AssertLocation (location
);
853 ASSERT_BOOL (is_op1lvalue
);
854 ASSERT_BOOL (is_op2lvalue
);
855 ASSERT_BOOL (is_op3lvalue
);
857 if (m2expr_CompareTrees (
858 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
860 /* Small set size <= TSIZE(WORD). */
862 m2treelib_get_rvalue (location
, op1
, settype
, is_op1lvalue
),
863 m2treelib_get_rvalue (location
, op2
, settype
, is_op2lvalue
),
864 m2treelib_get_rvalue (location
, op3
, settype
, is_op3lvalue
),
869 tree high
= m2expr_BuildSub (
871 m2convert_ToCardinal (
873 m2expr_BuildDivTrunc (
875 m2expr_GetSizeOf (location
, m2type_GetBitsetType ()),
877 m2expr_GetCardinalOne (location
), false);
879 /* If op3 is constant then make op3 positive and remember which
880 direction we are shifting. */
882 op3
= m2tree_skip_const_decl (op3
);
883 if (TREE_CODE (op3
) == INTEGER_CST
)
886 if (tree_int_cst_sgn (op3
) < 0)
887 op3
= m2expr_BuildNegate (location
, op3
, false);
890 op3
= m2convert_BuildConvert (location
, m2type_GetM2CardinalType (),
894 /* These parameters must match the prototypes of the procedures:
895 ShiftLeft, ShiftRight, ShiftVal, RotateLeft, RotateRight, RotateVal
896 inside gm2-iso/SYSTEM.mod. */
898 /* Remember we must build the parameters in reverse. */
900 /* Parameter 4 amount. */
901 m2statement_BuildParam (
903 m2convert_BuildConvert (
904 location
, m2type_GetM2IntegerType (),
905 m2treelib_get_rvalue (location
, op3
,
906 m2tree_skip_type_decl (TREE_TYPE (op3
)),
910 /* Parameter 3 nBits. */
911 m2statement_BuildParam (
913 m2convert_BuildConvert (location
, m2type_GetM2CardinalType (),
914 m2expr_FoldAndStrip (nBits
), false));
916 /* Parameter 2 destination set. */
917 m2statement_BuildParam (
919 buildUnboundedArrayOf (
921 m2treelib_get_set_address (location
, op1
, is_op1lvalue
), high
));
923 /* Parameter 1 source set. */
924 m2statement_BuildParam (
926 buildUnboundedArrayOf (
928 m2treelib_get_set_address (location
, op2
, is_op2lvalue
), high
));
930 /* Now call the appropriate procedure inside SYSTEM.mod. */
933 result
= m2statement_BuildProcedureCallTree (location
, leftproc
,
936 result
= m2statement_BuildProcedureCallTree (location
, rightproc
,
939 result
= m2statement_BuildProcedureCallTree (location
, varproc
,
941 add_stmt (location
, result
);
945 /* Print a warning if a constant expression had overflow in folding.
946 Invoke this function on every expression that the language requires
947 to be a constant expression. */
950 m2expr_ConstantExpressionWarning (tree value
)
952 if ((TREE_CODE (value
) == INTEGER_CST
|| TREE_CODE (value
) == REAL_CST
953 || TREE_CODE (value
) == FIXED_CST
|| TREE_CODE (value
) == VECTOR_CST
954 || TREE_CODE (value
) == COMPLEX_CST
)
955 && TREE_OVERFLOW (value
))
956 pedwarn (input_location
, OPT_Woverflow
, "overflow in constant expression");
959 /* TreeOverflow return true if the contant expression, t, has caused
960 an overflow. No error message or warning is emitted and no
961 modification is made to, t. */
964 m2expr_TreeOverflow (tree t
)
966 if ((TREE_CODE (t
) == INTEGER_CST
967 || (TREE_CODE (t
) == COMPLEX_CST
968 && TREE_CODE (TREE_REALPART (t
)) == INTEGER_CST
))
969 && TREE_OVERFLOW (t
))
971 else if ((TREE_CODE (t
) == REAL_CST
972 || (TREE_CODE (t
) == COMPLEX_CST
973 && TREE_CODE (TREE_REALPART (t
)) == REAL_CST
))
974 && TREE_OVERFLOW (t
))
980 /* RemoveOverflow if tree, t, is a constant expression it removes any
981 overflow flag and returns, t. */
984 m2expr_RemoveOverflow (tree t
)
986 if (TREE_CODE (t
) == INTEGER_CST
987 || (TREE_CODE (t
) == COMPLEX_CST
988 && TREE_CODE (TREE_REALPART (t
)) == INTEGER_CST
))
989 TREE_OVERFLOW (t
) = 0;
990 else if (TREE_CODE (t
) == REAL_CST
991 || (TREE_CODE (t
) == COMPLEX_CST
992 && TREE_CODE (TREE_REALPART (t
)) == REAL_CST
))
993 TREE_OVERFLOW (t
) = 0;
997 /* BuildCoerce return a tree containing the expression, expr, after
998 it has been coersed to, type. */
1001 m2expr_BuildCoerce (location_t location
, tree des
, tree type
, tree expr
)
1003 tree copy
= copy_node (expr
);
1004 TREE_TYPE (copy
) = type
;
1006 m2assert_AssertLocation (location
);
1008 return m2treelib_build_modify_expr (location
, des
, NOP_EXPR
, copy
);
1011 /* BuildTrunc return an integer expression from a REAL or LONGREAL op1. */
1014 m2expr_BuildTrunc (tree op1
)
1016 return convert_to_integer (m2type_GetIntegerType (),
1017 m2expr_FoldAndStrip (op1
));
1020 /* checkUnaryWholeOverflow decide if we can check this unary expression. */
1023 m2expr_checkUnaryWholeOverflow (location_t location
, enum tree_code code
,
1024 tree arg
, tree lowest
, tree min
, tree max
)
1026 if (M2Options_GetWholeValueCheck () && (min
!= NULL
))
1028 lowest
= m2tree_skip_type_decl (lowest
);
1029 arg
= fold_convert_loc (location
, lowest
, arg
);
1034 return checkWholeNegateOverflow (location
, arg
, lowest
, min
, max
);
1042 /* build_unary_op return a unary tree node. */
1045 m2expr_build_unary_op_check (location_t location
, enum tree_code code
,
1046 tree arg
, tree lowest
, tree min
, tree max
)
1048 tree argtype
= TREE_TYPE (arg
);
1052 m2assert_AssertLocation (location
);
1054 arg
= m2expr_FoldAndStrip (arg
);
1056 if ((TREE_CODE (argtype
) != REAL_TYPE
) && (min
!= NULL
))
1057 check
= m2expr_checkUnaryWholeOverflow (location
, code
, arg
, lowest
, min
, max
);
1059 result
= build1 (code
, argtype
, arg
);
1060 protected_set_expr_location (result
, location
);
1063 result
= build2 (COMPOUND_EXPR
, argtype
, check
, result
);
1065 if (SCALAR_FLOAT_TYPE_P (argtype
))
1066 m2expr_checkRealOverflow (location
, code
, result
);
1068 return m2expr_FoldAndStrip (result
);
1071 /* build_unary_op return a unary tree node. */
1074 m2expr_build_unary_op (location_t location
, enum tree_code code
, tree arg
,
1075 int flag ATTRIBUTE_UNUSED
)
1077 tree argtype
= TREE_TYPE (arg
);
1080 m2assert_AssertLocation (location
);
1082 arg
= m2expr_FoldAndStrip (arg
);
1083 result
= build1 (code
, argtype
, arg
);
1084 protected_set_expr_location (result
, location
);
1086 return m2expr_FoldAndStrip (result
);
1089 /* build_binary_op is a heavily pruned version of the one found in
1090 c-typeck.cc. The Modula-2 expression rules are much more restricted
1094 build_binary_op (location_t location
, enum tree_code code
, tree op1
, tree op2
,
1095 int convert ATTRIBUTE_UNUSED
)
1097 tree type1
= TREE_TYPE (op1
);
1100 m2assert_AssertLocation (location
);
1102 /* Strip NON_LVALUE_EXPRs, etc., since we aren't using as an lvalue. */
1103 STRIP_TYPE_NOPS (op1
);
1104 STRIP_TYPE_NOPS (op2
);
1106 op1
= m2expr_FoldAndStrip (op1
);
1107 op2
= m2expr_FoldAndStrip (op2
);
1109 result
= build2 (code
, type1
, op1
, op2
);
1110 protected_set_expr_location (result
, location
);
1112 return m2expr_FoldAndStrip (result
);
1115 /* BuildLessThanZero - 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_BuildLessThanZero (location_t location
, tree value
, tree type
, tree min
,
1123 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) >= 0)
1124 /* min is greater than or equal to zero therefore value will always
1126 return m2type_GetBooleanFalse ();
1127 else if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) == -1)
1128 /* max is less than zero therefore value will always be < 0. */
1129 return m2type_GetBooleanTrue ();
1130 /* We now know 0 lies in the range min..max so we can safely cast
1132 return m2expr_BuildLessThan (
1134 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1137 /* BuildGreaterThanZero - 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_BuildGreaterThanZero (location_t location
, tree value
, tree type
,
1145 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) == 1)
1146 /* min is greater than zero therefore value will always be > 0. */
1147 return m2type_GetBooleanTrue ();
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 m2type_GetBooleanFalse ();
1152 /* We now know 0 lies in the range min..max so we can safely cast
1154 return m2expr_BuildGreaterThan (
1156 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1159 /* BuildEqualToZero - 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_BuildEqualToZero (location_t location
, tree value
, tree type
, tree min
,
1167 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) == 1)
1168 /* min is greater than zero therefore value will always be > 0. */
1169 return m2type_GetBooleanFalse ();
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 m2type_GetBooleanFalse ();
1174 /* We now know 0 lies in the range min..max so we can safely cast
1176 return m2expr_BuildEqualTo (
1178 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1181 /* BuildNotEqualToZero - returns a tree containing (# value 0). It
1182 checks the min and max value to ensure that the test can be safely
1183 achieved and will short circuit the result otherwise. */
1186 m2expr_BuildNotEqualToZero (location_t location
, tree value
, tree type
,
1189 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) == 1)
1190 /* min is greater than zero therefore value will always be true. */
1191 return m2type_GetBooleanTrue ();
1192 else if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) < 0)
1193 /* max is less than or equal to zero therefore value will always be
1195 return m2type_GetBooleanTrue ();
1196 /* We now know 0 lies in the range min..max so we can safely cast
1198 return m2expr_BuildNotEqualTo (
1200 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1204 /* BuildGreaterThanOrEqualZero - 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_BuildGreaterThanOrEqualZero (location_t location
, tree value
, tree type
,
1212 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) >= 0)
1213 /* min is greater than or equal to zero therefore value will always be >= 0. */
1214 return m2type_GetBooleanTrue ();
1215 else if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) < 0)
1216 /* max is less than zero therefore value will always be < 0. */
1217 return m2type_GetBooleanFalse ();
1218 /* We now know 0 lies in the range min..max so we can safely cast
1220 return m2expr_BuildGreaterThan (
1222 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1226 /* BuildLessThanOrEqualZero - returns a tree containing (<= value 0). It
1227 checks the min and max value to ensure that the test can be safely
1228 achieved and will short circuit the result otherwise. */
1231 m2expr_BuildLessThanOrEqualZero (location_t location
, tree value
, tree type
,
1234 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) > 0)
1235 /* min is greater than zero therefore value will always be > 0. */
1236 return m2type_GetBooleanFalse ();
1237 else if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) <= 0)
1238 /* max is less than or equal to zero therefore value will always be <= 0. */
1239 return m2type_GetBooleanTrue ();
1240 /* We now know 0 lies in the range min..max so we can safely cast
1242 return m2expr_BuildLessThanOrEqual (
1244 fold_convert_loc (location
, type
, m2expr_GetIntegerZero (location
)));
1248 /* get_current_function_name, return the name of the current function if
1249 it currently exists. NULL is returned if we are not inside a function. */
1252 get_current_function_name (void)
1254 if (current_function_decl
!= NULL
1255 && (DECL_NAME (current_function_decl
) != NULL
)
1256 && (IDENTIFIER_POINTER (DECL_NAME (current_function_decl
)) != NULL
))
1257 return IDENTIFIER_POINTER (DECL_NAME (current_function_decl
));
1261 /* checkWholeNegateOverflow - check to see whether -arg will overflow
1264 PROCEDURE sneg (i: INTEGER) ;
1272 general purpose subrange type, i, is currently legal, min is
1273 MIN(type) and max is MAX(type).
1275 PROCEDURE sneg (i: type) ;
1279 (* cannot overflow if i is 0 *)
1281 (* will overflow if entire range is positive. *)
1283 (* will overflow if entire range is negative. *)
1285 (* c7 and c8 and c9 and c10 -> c17 more units positive. *)
1286 ((min < 0) AND (max > 0) AND ((min + max) > 0) AND (i > -min)) OR
1287 (* c11 and c12 and c13 and c14 -> c18 more units negative. *)
1288 ((min < 0) AND (max > 0) AND ((min + max) < 0) AND (i < -max)))
1295 checkWholeNegateOverflow (location_t location
,
1296 tree i
, tree type
, tree min
,
1300 = m2expr_BuildNotEqualToZero (location
, i
, type
, min
, max
); /* i # 0. */
1301 tree c1
= m2expr_BuildGreaterThanZero (location
, min
, type
, min
,
1302 max
); /* min > 0. */
1303 tree c2
= m2expr_BuildEqualToZero (location
, min
, type
, min
,
1304 max
); /* min == 0. */
1305 tree c4
= m2expr_BuildLessThanZero (location
, max
, type
, min
,
1306 max
); /* max < 0. */
1307 tree c5
= m2expr_BuildEqualToZero (location
, max
, type
, min
,
1308 max
); /* max == 0. */
1309 tree c7
= m2expr_BuildLessThanZero (location
, min
, type
, min
,
1310 max
); /* min < 0. */
1311 tree c8
= m2expr_BuildGreaterThanZero (location
, max
, type
, min
,
1312 max
); /* max > 0. */
1313 tree c9
= m2expr_BuildGreaterThanZero (
1314 location
, m2expr_BuildAdd (location
, min
, max
, false), type
, min
,
1315 max
); /* min + max > 0. */
1316 tree c10
= m2expr_BuildGreaterThan (
1317 location
, i
, m2expr_BuildNegate (location
, min
, false)); /* i > -min. */
1318 tree c11
= m2expr_BuildLessThanZero (
1319 location
, m2expr_BuildAdd (location
, min
, max
, false), type
, min
,
1320 max
); /* min + max < 0. */
1321 tree c12
= m2expr_BuildLessThan (
1322 location
, i
, m2expr_BuildNegate (location
, max
, false)); /* i < -max. */
1324 tree b1
= m2expr_BuildTruthOrIf (location
, c1
, c2
);
1325 tree b2
= m2expr_BuildTruthOrIf (location
, c8
, c5
);
1326 tree o1
= m2expr_BuildTruthAndIf (location
, b1
, b2
);
1328 tree b3
= m2expr_BuildTruthOrIf (location
, c7
, c2
);
1329 tree b4
= m2expr_BuildTruthOrIf (location
, c4
, c5
);
1330 tree o2
= m2expr_BuildTruthAndIf (location
, b3
, b4
);
1332 tree o3
= m2expr_Build4TruthAndIf (location
, c7
, c8
, c9
, c10
);
1333 tree o4
= m2expr_Build4TruthAndIf (location
, c7
, c8
, c11
, c12
);
1335 tree a2
= m2expr_Build4TruthOrIf (location
, o1
, o2
, o3
, o4
);
1337 = m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, a1
, a2
));
1339 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1340 get_current_function_name (),
1341 "whole value unary minus will cause range overflow");
1345 /* checkWholeAddOverflow - check to see whether op1 + op2 will
1346 overflow an integer.
1348 PROCEDURE sadd (i, j: INTEGER) ;
1350 IF ((j>0) AND (i > MAX(INTEGER)-j)) OR ((j<0) AND (i < MIN(INTEGER)-j))
1352 'signed addition overflow'
1357 checkWholeAddOverflow (location_t location
, tree i
, tree j
, tree lowest
,
1360 tree j_gt_zero
= m2expr_BuildGreaterThanZero (location
, j
, lowest
, min
, max
);
1361 tree i_gt_max_sub_j
= m2expr_BuildGreaterThan (
1362 location
, i
, m2expr_BuildSub (location
, max
, j
, false));
1363 tree j_lt_zero
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
1364 tree i_lt_min_sub_j
= m2expr_BuildLessThan (location
, i
,
1365 m2expr_BuildSub (location
, min
, j
, false));
1366 tree lhs_or
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, j_gt_zero
, i_gt_max_sub_j
));
1367 tree rhs_or
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, j_lt_zero
, i_lt_min_sub_j
));
1369 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, lhs_or
, rhs_or
));
1370 tree result
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1371 get_current_function_name (),
1372 "whole value addition will cause a range overflow");
1376 /* checkWholeSubOverflow - check to see whether op1 - op2 will
1377 overflow an integer.
1379 PROCEDURE ssub (i, j: INTEGER) ;
1381 IF ((j>0) AND (i < MIN(INTEGER)+j)) OR ((j<0) AND (i > MAX(INTEGER)+j))
1383 'signed subtraction overflow'
1388 checkWholeSubOverflow (location_t location
, tree i
, tree j
, tree lowest
,
1391 tree c1
= m2expr_BuildGreaterThanZero (location
, j
, lowest
, min
, max
);
1392 tree c2
= m2expr_BuildLessThan (location
, i
,
1393 m2expr_BuildAdd (location
, min
, j
, false));
1394 tree c3
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
1395 tree c4
= m2expr_BuildGreaterThan (location
, i
,
1396 m2expr_BuildAdd (location
, max
, j
, false));
1397 tree c5
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, c1
, c2
));
1398 tree c6
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, c3
, c4
));
1400 = m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, c5
, c6
));
1401 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1402 get_current_function_name (),
1403 "whole value subtraction will cause a range overflow");
1407 /* Build4TruthAndIf - return true if a && b && c && d. Retain order left to
1411 m2expr_Build4TruthAndIf (location_t location
, tree a
, tree b
, tree c
, tree d
)
1413 tree t1
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, a
, b
));
1414 tree t2
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, t1
, c
));
1415 return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, t2
, d
));
1418 /* Build3TruthAndIf - return true if a && b && c. Retain order left to right.
1422 m2expr_Build3TruthAndIf (location_t location
, tree op1
, tree op2
, tree op3
)
1424 tree t
= m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, op1
, op2
));
1425 return m2expr_FoldAndStrip (m2expr_BuildTruthAndIf (location
, t
, op3
));
1428 /* Build3TruthOrIf - return true if a || b || c. Retain order left to right.
1432 m2expr_Build3TruthOrIf (location_t location
, tree op1
, tree op2
, tree op3
)
1434 tree t
= m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, op1
, op2
));
1435 return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, t
, op3
));
1438 /* Build4TruthOrIf - return true if op1 || op2 || op3 || op4. Retain order
1442 m2expr_Build4TruthOrIf (location_t location
, tree op1
, tree op2
, tree op3
,
1445 tree t1
= m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, op1
, op2
));
1446 tree t2
= m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, t1
, op3
));
1447 return m2expr_FoldAndStrip (m2expr_BuildTruthOrIf (location
, t2
, op4
));
1450 /* Build4LogicalOr - return true if op1 || op2 || op3 || op4. */
1453 m2expr_Build4LogicalOr (location_t location
, tree op1
, tree op2
, tree op3
,
1456 tree t1
= m2expr_FoldAndStrip (
1457 m2expr_BuildLogicalOr (location
, op1
, op2
, false));
1459 = m2expr_FoldAndStrip (m2expr_BuildLogicalOr (location
, t1
, op3
, false));
1460 return m2expr_FoldAndStrip (
1461 m2expr_BuildLogicalOr (location
, t2
, op4
, false));
1464 /* checkWholeMultOverflow - check to see whether i * j will overflow
1467 PROCEDURE smult (lhs, rhs: INTEGER) ;
1469 IF ((lhs > 0) AND (rhs > 0) AND (lhs > max DIV rhs)) OR
1470 ((lhs > 0) AND (rhs < 0) AND (rhs < min DIV lhs)) OR
1471 ((lhs < 0) AND (rhs > 0) AND (lhs < min DIV rhs)) OR
1472 ((lhs < 0) AND (rhs < 0) AND (lhs < max DIV rhs))
1474 error ('signed multiplication overflow')
1478 if ((c1 && c3 && c4)
1481 || (c2 && c5 && c8))
1482 error ('signed subtraction overflow'). */
1485 testWholeMultOverflow (location_t location
, tree lhs
, tree rhs
,
1486 tree lowest
, tree min
, tree max
)
1488 tree c1
= m2expr_BuildGreaterThanZero (location
, lhs
, lowest
, min
, max
);
1489 tree c2
= m2expr_BuildLessThanZero (location
, lhs
, lowest
, min
, max
);
1491 tree c3
= m2expr_BuildGreaterThanZero (location
, rhs
, lowest
, min
, max
);
1492 tree c4
= m2expr_BuildGreaterThan (
1493 location
, lhs
, m2expr_BuildDivTrunc (location
, max
, rhs
, false));
1495 tree c5
= m2expr_BuildLessThanZero (location
, rhs
, lowest
, min
, max
);
1496 tree c6
= m2expr_BuildLessThan (
1497 location
, rhs
, m2expr_BuildDivTrunc (location
, min
, lhs
, false));
1498 tree c7
= m2expr_BuildLessThan (
1499 location
, lhs
, m2expr_BuildDivTrunc (location
, min
, rhs
, false));
1500 tree c8
= m2expr_BuildLessThan (
1501 location
, lhs
, m2expr_BuildDivTrunc (location
, max
, rhs
, false));
1503 tree c9
= m2expr_Build3TruthAndIf (location
, c1
, c3
, c4
);
1504 tree c10
= m2expr_Build3TruthAndIf (location
, c1
, c5
, c6
);
1505 tree c11
= m2expr_Build3TruthAndIf (location
, c2
, c3
, c7
);
1506 tree c12
= m2expr_Build3TruthAndIf (location
, c2
, c5
, c8
);
1508 tree condition
= m2expr_Build4LogicalOr (location
, c9
, c10
, c11
, c12
);
1514 checkWholeMultOverflow (location_t location
, tree i
, tree j
, tree lowest
,
1517 tree condition
= testWholeMultOverflow (location
, i
, j
, lowest
, min
, max
);
1518 tree result
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1519 get_current_function_name (),
1520 "whole value multiplication will cause a range overflow");
1526 divMinUnderflow (location_t location
, tree value
, tree lowest
, tree min
, tree max
)
1528 tree min2
= m2expr_BuildMult (location
, min
, min
, false);
1529 tree rhs
= m2expr_BuildGreaterThanOrEqual (location
, value
, min2
);
1530 tree lhs
= testWholeMultOverflow (location
, min
, min
, lowest
, min
, max
);
1531 return m2expr_BuildTruthAndIf (location
, lhs
, rhs
);
1535 divexpr - returns true if a DIV_TRUNC b will overflow.
1538 /* checkWholeDivOverflow - check to see whether i DIV_TRUNC j will overflow
1539 an integer. The Modula-2 implementation of the GCC trees follows:
1541 PROCEDURE divtruncexpr (a, b: INTEGER) : BOOLEAN ;
1543 (* Firstly catch division by 0. *)
1545 (* Case 2 range is always negative. *)
1546 (* In which case a division will be illegal as result will be positive. *)
1548 (* Case 1 both min / max are positive, check for underflow. *)
1549 ((min >= 0) AND (max >= 0) AND (multMinOverflow (b) OR (a < b * min))) OR
1550 (* Case 1 both min / max are positive, check for overflow. *)
1551 ((min >= 0) AND (max >= 0) AND (divMinUnderflow (a) OR (b > a DIV min))) OR
1552 (* Case 3 mixed range, need to check underflow. *)
1553 ((min < 0) AND (max >= 0) AND (a < 0) AND (b < 0) AND (b >= a DIV min)) OR
1554 ((min < 0) AND (max >= 0) AND (a < 0) AND (b > 0) AND (b <= a DIV max)) OR
1555 ((min < 0) AND (max >= 0) AND (a >= 0) AND (b < 0) AND (a DIV b < min)))
1562 b4 -> (min >= 0) AND (max >= 0)
1563 b5 -> (min < 0) AND (max >= 0)
1564 a_lt_b_mult_min -> (a < b * min)
1565 b_mult_min_overflow -> testWholeMultOverflow (location, b, min, lowest, min, max)
1566 b6 -> (b_mult_min_overflow OR a_lt_b_mult_min)
1568 a_div_min_overflow -> divMinUnderflow (location, a, min, lowest, min, max)
1569 b7 -> (a_div_min_overflow OR b_gt_s1)
1582 c5 -> (b5 AND b8 AND b9 AND b11)
1583 c6 -> (b5 AND b8 AND b10 AND b12)
1584 c7 -> (b5 AND b14 AND b9 AND b13)
1586 if (c1 || c2 || c3 || c4 || c5 || c6 || c7)
1587 error ('signed div trunc overflow'). */
1590 checkWholeDivTruncOverflow (location_t location
, tree i
, tree j
, tree lowest
,
1593 tree b4a
= m2expr_BuildGreaterThanOrEqualZero (location
, min
, lowest
, min
, max
);
1594 tree b4b
= m2expr_BuildGreaterThanOrEqualZero (location
, max
, lowest
, min
, max
);
1595 tree b4
= m2expr_BuildTruthAndIf (location
, b4a
, b4b
);
1596 tree b5a
= m2expr_BuildLessThanZero (location
, min
, lowest
, min
, max
);
1597 tree b5
= m2expr_BuildTruthAndIf (location
, b5a
, b4b
);
1598 tree c1
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
1599 tree c2
= m2expr_BuildLessThanZero (location
, max
, lowest
, min
, max
);
1600 tree i_lt_j_mult_min
= m2expr_BuildLessThan (location
, i
, m2expr_BuildMult (location
, j
, min
, false));
1601 tree j_mult_min_overflow
= testWholeMultOverflow (location
, j
, min
, lowest
, min
, max
);
1602 tree b6
= m2expr_BuildTruthOrIf (location
, j_mult_min_overflow
, i_lt_j_mult_min
);
1603 tree c3
= m2expr_BuildTruthAndIf (location
, b4
, b6
);
1604 tree s1
= m2expr_BuildDivTrunc (location
, i
, min
, false);
1605 tree s2
= m2expr_BuildDivTrunc (location
, i
, max
, false);
1606 tree s3
= m2expr_BuildDivTrunc (location
, i
, j
, false);
1608 tree j_gt_s1
= m2expr_BuildGreaterThan (location
, j
, s1
);
1609 tree i_div_min_overflow
= divMinUnderflow (location
, i
, lowest
, min
, max
);
1610 tree b7
= m2expr_BuildTruthOrIf (location
, i_div_min_overflow
, j_gt_s1
);
1611 tree c4
= m2expr_BuildTruthAndIf (location
, b4
, b7
);
1612 tree b8
= m2expr_BuildLessThanZero (location
, i
, lowest
, min
, max
);
1613 tree b9
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
1614 tree b10
= m2expr_BuildGreaterThanZero (location
, j
, lowest
, min
, max
);
1615 tree b11
= m2expr_BuildGreaterThanOrEqual (location
, j
, s1
);
1616 tree b12
= m2expr_BuildLessThanOrEqual (location
, j
, s2
);
1617 tree b13
= m2expr_BuildLessThan (location
, s3
, min
);
1618 tree b14
= m2expr_BuildGreaterThanOrEqualZero (location
, i
, lowest
, min
, max
);
1619 tree c5
= m2expr_Build4TruthAndIf (location
, b5
, b8
, b9
, b11
);
1620 tree c6
= m2expr_Build4TruthAndIf (location
, b5
, b8
, b10
, b12
);
1621 tree c7
= m2expr_Build4TruthAndIf (location
, b5
, b14
, b9
, b13
);
1622 tree c8
= m2expr_Build4TruthOrIf (location
, c1
, c2
, c3
, c4
);
1623 tree condition
= m2expr_Build4TruthOrIf (location
, c5
, c6
, c7
, c8
);
1624 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1625 get_current_function_name (),
1626 "whole value truncated division will cause a range overflow");
1632 divexpr
- returns
true if a DIV_CEIL b will overflow
.
1635 (* checkWholeDivCeilOverflow
- check to see whether i DIV_CEIL j will overflow
1638 PROCEDURE
divceilexpr (i
, j
: INTEGER
) : BOOLEAN
;
1640 RETURN ((j
= 0) OR (* division by zero
. *)
1641 (maxT
< 0) OR (* both inputs are
< 0 and max is
< 0,
1643 ((i
# 0) AND (* first operand is legally zero,
1644 result is also legally zero
. *)
1645 divCeilOverflowCases (i
, j
)))
1650 divCeilOverflowCases
- precondition
: i
, j are in range values
.
1651 postcondition
: true is returned
if i divceil will
1652 result in an overflow
/underflow
.
1655 PROCEDURE
divCeilOverflowCases (i
, j
: INTEGER
) : BOOLEAN
;
1657 RETURN (((i
> 0) AND (j
> 0) AND
divCeilOverflowPosPos (i
, j
)) OR
1658 ((i
< 0) AND (j
< 0) AND
divCeilOverflowNegNeg (i
, j
)) OR
1659 ((i
> 0) AND (j
< 0) AND
divCeilOverflowPosNeg (i
, j
)) OR
1660 ((i
< 0) AND (j
> 0) AND
divCeilOverflowNegPos (i
, j
)))
1661 END divCeilOverflowCases
;
1665 divCeilOverflowPosPos
- precondition
: i
, j are legal
and are both
>= 0.
1666 postcondition
: true is returned
if i divceil will
1667 result in an overflow
/underflow
.
1670 PROCEDURE
divCeilOverflowPosPos (i
, j
: INTEGER
) : BOOLEAN
;
1672 RETURN (((i MOD j
= 0) AND (i
< j
* minT
)) OR
1673 (((i MOD j
# 0) AND (i < j * minT + 1))))
1674 END divCeilOverflowPosPos
;
1678 divCeilOverflowNegNeg
- precondition
: i
, j are in range values
and both
< 0.
1679 postcondition
: true is returned
if i divceil will
1680 result in an overflow
/underflow
.
1683 PROCEDURE
divCeilOverflowNegNeg (i
, j
: INTEGER
) : BOOLEAN
;
1685 RETURN ((maxT
<= 0) OR (* signs will cause overflow
. *)
1686 (* check
for underflow
. *)
1687 ((ABS (i
) MOD
ABS (j
) = 0) AND (i
>= j
* minT
)) OR
1688 ((ABS (i
) MOD
ABS (j
) # 0) AND (i >= j * minT - 1)) OR
1689 (* check
for overflow
. *)
1690 (((ABS (i
) MOD maxT
) = 0) AND (ABS (i
) DIV maxT
> ABS (j
))) OR
1691 (((ABS (i
) MOD maxT
) # 0) AND (ABS (i) DIV maxT > ABS (j) + 1)))
1692 END divCeilOverflowNegNeg
;
1696 divCeilOverflowNegPos
- precondition
: i
, j are in range values
. i
< 0, j
>= 0.
1697 postcondition
: true is returned
if i divceil will
1698 result in an overflow
/underflow
.
1701 PROCEDURE
divCeilOverflowNegPos (i
, j
: INTEGER
) : BOOLEAN
;
1703 (* easier than might be initially expected
. We know minT
< 0 and maxT
> 0.
1704 We know the result will be negative
and therefore we only need to test
1706 RETURN (((ABS (i
) MOD j
= 0) AND (i
< j
* minT
)) OR
1707 ((ABS (i
) MOD j
# 0) AND (i < j * minT - 1)))
1708 END divCeilOverflowNegPos
;
1712 divCeilOverflowPosNeg
- precondition
: i
, j are in range values
. i
>= 0, j
< 0.
1713 postcondition
: true is returned
if i divceil will
1714 result in an overflow
/underflow
.
1717 PROCEDURE
divCeilOverflowPosNeg (i
, j
: INTEGER
) : BOOLEAN
;
1719 (* easier than might be initially expected
. We know minT
< 0 and maxT
> 0.
1720 We know the result will be negative
and therefore we only need to test
1722 RETURN (((i MOD
ABS (j
) = 0) AND (i
> j
* minT
)) OR
1723 ((i MOD
ABS (j
) # 0) AND (i > j * minT - 1)))
1724 END divCeilOverflowPosNeg
;
1727 /* divCeilOverflowPosPos, precondition: lhs, rhs are legal and are both >= 0.
1728 Postcondition: TRUE is returned if lhs divceil rhs will result
1729 in an overflow/underflow.
1731 A handbuilt expression of trees implementing:
1733 RETURN (((lhs MOD rhs = 0) AND (min >= 0) AND (lhs < rhs * min)) OR (* check for underflow, no remainder. *)
1735 (((lhs MOD rhs # 0) AND (lhs < rhs * min + 1)))) (* check for underflow with remainder. *)
1736 ((lhs > min) AND (lhs - 1 > rhs * min))
1739 a -> (lhs MOD rhs = 0) AND (lhs < rhs * min)
1740 b -> (lhs MOD rhs # 0) AND (lhs < rhs * min + 1)
1744 divCeilOverflowPosPos (location_t location
, tree i
, tree j
, tree lowest
,
1747 tree i_mod_j
= m2expr_BuildModTrunc (location
, i
, j
, false);
1748 tree i_mod_j_eq_zero
= m2expr_BuildEqualToZero (location
, i_mod_j
, lowest
, min
, max
);
1749 tree i_mod_j_ne_zero
= m2expr_BuildNotEqualToZero (location
, i_mod_j
, lowest
, min
, max
);
1750 tree j_min
= m2expr_BuildMult (location
, j
, min
, false);
1751 tree j_min_1
= m2expr_BuildAdd (location
, j_min
, m2expr_GetIntegerOne (location
), false);
1752 tree i_lt_j_min
= m2expr_BuildLessThan (location
, i
, j_min
);
1753 tree i_lt_j_min_1
= m2expr_BuildLessThan (location
, i
, j_min_1
);
1754 tree a
= m2expr_BuildTruthAndIf (location
, i_mod_j_eq_zero
, i_lt_j_min
);
1755 tree b
= m2expr_BuildTruthAndIf (location
, i_mod_j_ne_zero
, i_lt_j_min_1
);
1756 return m2expr_BuildTruthOrIf (location
, a
, b
);
1760 /* divCeilOverflowPosNeg precondition: i, j are in range values and i >=0, j < 0.
1761 Postcondition: TRUE is returned if i divceil j will result in an
1764 A handbuilt expression of trees implementing:
1766 RETURN (((i MOD ABS (j) = 0) AND (i > j * min)) OR
1767 ((i MOD ABS (j) # 0) AND (i > j * min - 1)))
1770 i_mod_abs_j -> (i MOD abs_j)
1771 i_mod_abs_j_eq_0 -> (i_mod_abs_j = 0)
1772 i_mod_abs_j_ne_0 -> (i_mod_abs_j # 0)
1773 j_mult_min -> (j * min)
1774 j_mult_min_1 -> (j_mult_min - 1)
1775 i_gt_j_mult_min -> (i > j_mult_min)
1776 i_gt_j_mult_min_1 -> (i > j_mult_min_1)
1777 a -> (i_mod_abs_j_eq_0 AND i_gt_j_mult_min)
1778 b -> (i_mod_abs_j_ne_0 AND i_gt_j_mult_min_1)
1782 divCeilOverflowPosNeg (location_t location
, tree i
, tree j
, tree lowest
, tree min
, tree max
)
1784 tree abs_j
= m2expr_BuildAbs (location
, j
);
1785 tree i_mod_abs_j
= m2expr_BuildModFloor (location
, i
, abs_j
, false);
1786 tree i_mod_abs_j_eq_0
= m2expr_BuildEqualToZero (location
, i_mod_abs_j
, lowest
, min
, max
);
1787 tree i_mod_abs_j_ne_0
= m2expr_BuildNotEqualToZero (location
, i_mod_abs_j
, lowest
, min
, max
);
1788 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, false);
1789 tree j_mult_min_1
= m2expr_BuildPostDec (location
, j_mult_min
);
1790 tree i_gt_j_mult_min
= m2expr_BuildGreaterThan (location
, i
, j_mult_min
);
1791 tree i_gt_j_mult_min_1
= m2expr_BuildGreaterThan (location
, i
, j_mult_min_1
);
1792 tree a
= m2expr_BuildTruthAndIf (location
, i_mod_abs_j_eq_0
, i_gt_j_mult_min
);
1793 tree b
= m2expr_BuildTruthAndIf (location
, i_mod_abs_j_ne_0
, i_gt_j_mult_min_1
);
1794 tree c
= m2expr_BuildTruthOrIf (location
, a
, b
);
1799 /* divCeilOverflowNegPos precondition: i, j are in range values and i < 0, j >= 0.
1800 Postcondition: TRUE is returned if i divceil j will result in an
1803 A handbuilt expression of trees implementing:
1805 RETURN (((ABS (i) MOD j = 0) AND (i < j * min)) OR
1806 ((ABS (i) MOD j # 0) AND (i < j * min - 1)))
1809 abs_i_mod_j -> (abs_i MOD j)
1810 abs_i_mod_j_eq_0 -> (abs_i_mod_j = 0)
1811 abs_i_mod_j_ne_0 -> (abs_i_mod_j # 0)
1812 j_mult_min -> (j * min)
1813 j_mult_min_1 -> (j_mult_min - 1)
1814 i_lt_j_mult_min -> (i < j_mult_min)
1815 i_lt_j_mult_min_1 -> (i < j_mult_min_1)
1816 a = (abs_i_mod_j_eq_0 AND i_lt_j_mult_min)
1817 b = (abs_i_mod_j_ne_0 AND i_lt_j_mult_min_1)
1821 divCeilOverflowNegPos (location_t location
, tree i
, tree j
, tree lowest
, tree min
, tree max
)
1823 tree abs_i
= m2expr_BuildAbs (location
, i
);
1824 tree abs_i_mod_j
= m2expr_BuildModFloor (location
, abs_i
, j
, false);
1825 tree abs_i_mod_j_eq_0
= m2expr_BuildEqualToZero (location
, abs_i_mod_j
, lowest
, min
, max
);
1826 tree abs_i_mod_j_ne_0
= m2expr_BuildNotEqualToZero (location
, abs_i_mod_j
, lowest
, min
, max
);
1827 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, false);
1828 tree j_mult_min_1
= m2expr_BuildPostDec (location
, j_mult_min
);
1829 tree i_lt_j_mult_min
= m2expr_BuildLessThan (location
, i
, j_mult_min
);
1830 tree i_lt_j_mult_min_1
= m2expr_BuildLessThan (location
, i
, j_mult_min_1
);
1831 tree a
= m2expr_BuildTruthAndIf (location
, abs_i_mod_j_eq_0
, i_lt_j_mult_min
);
1832 tree b
= m2expr_BuildTruthAndIf (location
, abs_i_mod_j_ne_0
, i_lt_j_mult_min_1
);
1833 tree c
= m2expr_BuildTruthOrIf (location
, a
, b
);
1838 /* divCeilOverflowNegNeg precondition: i, j are in range values and both < 0.
1839 Postcondition: TRUE is returned if i divceil j will result in an
1842 A handbuilt expression of trees implementing:
1844 RETURN ((max <= 0) OR (* signs will cause overflow. *)
1845 (* check for underflow. *)
1846 ((ABS (i) MOD ABS (j) = 0) AND (i >= j * min)) OR
1847 ((ABS (i) MOD ABS (j) # 0) AND (i >= j * min - 1)) OR
1848 (* check for overflow. *)
1849 (((ABS (i) MOD max) = 0) AND (ABS (i) DIV max > ABS (j))) OR
1850 (((ABS (i) MOD max) # 0) AND (ABS (i) DIV max > ABS (j) + 1)))
1852 max_lte_0 -> (max <= 0)
1855 abs_i_mod_abs_j -> (abs_i MOD abs_j)
1856 abs_i_mod_abs_j_eq_0 -> (abs_i_mod_abs_j = 0)
1857 abs_i_mod_abs_j_ne_0 -> (abs_i_mod_abs_j # 0)
1858 j_mult_min -> (j * min)
1859 j_mult_min_1 -> (j_mult_min - 1)
1860 i_ge_j_mult_min -> (i >= j_mult_min)
1861 i_ge_j_mult_min_1 -> (i >= j_mult_min_1)
1862 abs_i_mod_max -> (abs_i mod max)
1863 abs_i_div_max -> (abs_i DIVfloor max)
1864 abs_j_1 -> (abs_j + 1)
1865 abs_i_mod_max_eq_0 -> (abs_i_mod_max = 0)
1866 abs_i_mod_max_ne_0 -> (abs_i_mod_max # 0)
1867 abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
1868 abs_i_div_max_gt_abs_j_1 -> (abs_i_div_max > abs_j_1)
1870 a -> (abs_i_mod_abs_j_eq_0 AND i_ge_j_mult_min)
1871 b -> (abs_i_mod_abs_j_ne_0 AND i_ge_j_mult_min_1)
1872 c -> (abs_i_mod_max_eq_0 AND abs_i_div_max_gt_abs_j)
1873 d -> (abs_i_mod_max_ne_0 AND abs_i_div_max_gt_abs_j_1)
1874 e -> (a OR b OR c OR d)
1875 return max_lte_0 OR e. */
1878 divCeilOverflowNegNeg (location_t location
, tree i
, tree j
, tree lowest
,
1881 tree max_lte_0
= m2expr_BuildLessThanOrEqualZero (location
, max
, lowest
, min
, max
);
1882 tree abs_i
= m2expr_BuildAbs (location
, i
);
1883 tree abs_j
= m2expr_BuildAbs (location
, j
);
1884 tree abs_i_mod_abs_j
= m2expr_BuildModFloor (location
, abs_i
, abs_j
, false);
1885 tree abs_i_mod_abs_j_eq_0
= m2expr_BuildEqualToZero (location
, abs_i_mod_abs_j
,
1887 tree abs_i_mod_abs_j_ne_0
= m2expr_BuildNotEqualToZero (location
, abs_i_mod_abs_j
,
1889 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, false);
1890 tree j_mult_min_1
= m2expr_BuildPostDec (location
, j_mult_min
);
1891 tree i_ge_j_mult_min
= m2expr_BuildGreaterThanOrEqual (location
, i
, j_mult_min
);
1892 tree i_ge_j_mult_min_1
= m2expr_BuildGreaterThanOrEqual (location
, i
, j_mult_min_1
);
1893 tree abs_i_mod_max
= m2expr_BuildModFloor (location
, abs_i
, max
, false);
1894 tree abs_i_div_max
= m2expr_BuildDivFloor (location
, abs_i
, max
, false);
1895 tree abs_j_1
= m2expr_BuildPostInc (location
, abs_j
);
1896 tree abs_i_mod_max_eq_0
= m2expr_BuildEqualToZero (location
, abs_i_mod_max
, lowest
, min
, max
);
1897 tree abs_i_mod_max_ne_0
= m2expr_BuildNotEqualToZero (location
, abs_i_mod_max
, lowest
, min
, max
);
1898 tree abs_i_div_max_gt_abs_j
= m2expr_BuildGreaterThan (location
, abs_i_div_max
, abs_j
);
1899 tree abs_i_div_max_gt_abs_j_1
= m2expr_BuildGreaterThan (location
, abs_i_div_max
, abs_j_1
);
1901 tree a
= m2expr_BuildTruthAndIf (location
, abs_i_mod_abs_j_eq_0
, i_ge_j_mult_min
);
1902 tree b
= m2expr_BuildTruthAndIf (location
, abs_i_mod_abs_j_ne_0
, i_ge_j_mult_min_1
);
1903 tree c
= m2expr_BuildTruthAndIf (location
, abs_i_mod_max_eq_0
, abs_i_div_max_gt_abs_j
);
1904 tree d
= m2expr_BuildTruthAndIf (location
, abs_i_mod_max_ne_0
, abs_i_div_max_gt_abs_j_1
);
1905 tree e
= m2expr_Build4TruthOrIf (location
, a
, b
, c
, d
);
1906 return m2expr_BuildTruthOrIf (location
, max_lte_0
, e
);
1910 /* divCeilOverflowCases, precondition: i, j are in range values.
1911 Postcondition: TRUE is returned if i divceil will result in an
1914 A handbuilt expression of trees implementing:
1916 RETURN (((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j)) OR
1917 ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j)) OR
1918 ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j)) OR
1919 ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j)))
1921 a -> ((i > 0) AND (j > 0) AND divCeilOverflowPosPos (i, j))
1922 b -> ((i < 0) AND (j < 0) AND divCeilOverflowNegNeg (i, j))
1923 c -> ((i > 0) AND (j < 0) AND divCeilOverflowPosNeg (i, j))
1924 d -> ((i < 0) AND (j > 0) AND divCeilOverflowNegPos (i, j))
1926 RETURN a AND b AND c AND d. */
1929 divCeilOverflowCases (location_t location
, tree i
, tree j
, tree lowest
,
1932 tree i_gt_zero
= m2expr_BuildGreaterThanZero (location
, i
, lowest
, min
, max
);
1933 tree j_gt_zero
= m2expr_BuildGreaterThanZero (location
, j
, lowest
, min
, max
);
1934 tree i_lt_zero
= m2expr_BuildLessThanZero (location
, i
, lowest
, min
, max
);
1935 tree j_lt_zero
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
1936 tree a
= m2expr_Build3TruthAndIf (location
, i_gt_zero
, j_gt_zero
,
1937 divCeilOverflowPosPos (location
, i
, j
, lowest
, min
, max
));
1938 tree b
= m2expr_Build3TruthAndIf (location
, i_lt_zero
, j_lt_zero
,
1939 divCeilOverflowNegNeg (location
, i
, j
, lowest
, min
, max
));
1940 tree c
= m2expr_Build3TruthAndIf (location
, i_gt_zero
, j_lt_zero
,
1941 divCeilOverflowPosNeg (location
, i
, j
, lowest
, min
, max
));
1942 tree d
= m2expr_Build3TruthAndIf (location
, i_lt_zero
, j_gt_zero
,
1943 divCeilOverflowNegPos (location
, i
, j
, lowest
, min
, max
));
1944 return m2expr_Build4TruthOrIf (location
, a
, b
, c
, d
);
1948 /* checkWholeDivCeilOverflow check to see whether i DIV_CEIL j will overflow
1949 an integer. A handbuilt expression of trees implementing:
1951 RETURN ((j = 0) OR (* division by zero. *)
1952 (maxT < 0) OR (* both inputs are < 0 and max is < 0,
1954 ((i # 0) AND (* first operand is legally zero,
1955 result is also legally zero. *)
1956 divCeilOverflowCases (i, j)))
1958 using the following subexpressions:
1960 j_eq_zero -> (j == 0)
1961 max_lt_zero -> (max < 0)
1962 i_ne_zero -> (i # 0). */
1965 checkWholeDivCeilOverflow (location_t location
, tree i
, tree j
, tree lowest
,
1968 tree j_eq_zero
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
1969 tree max_lt_zero
= m2expr_BuildLessThanZero (location
, max
, lowest
, min
, max
);
1970 tree i_ne_zero
= m2expr_BuildNotEqualToZero (location
, i
, lowest
, min
, max
);
1972 tree rhs
= m2expr_BuildTruthAndIf (location
,
1974 divCeilOverflowCases (location
,
1975 i
, j
, lowest
, min
, max
));
1977 if (M2Options_GetISO ())
1978 j_lt_zero
= m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
));
1980 j_lt_zero
= m2expr_GetIntegerZero (location
);
1981 j_eq_zero
= m2expr_FoldAndStrip (j_eq_zero
);
1982 max_lt_zero
= m2expr_FoldAndStrip (max_lt_zero
);
1983 i_ne_zero
= m2expr_FoldAndStrip (i_ne_zero
);
1984 rhs
= m2expr_FoldAndStrip (rhs
);
1986 tree condition
= m2expr_Build4TruthOrIf (location
, j_eq_zero
, max_lt_zero
, rhs
, j_lt_zero
);
1987 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
1988 get_current_function_name (),
1989 "whole value ceil division will cause a range overflow");
1994 /* checkWholeModTruncOverflow, the GCC tree.def defines TRUNC_MOD_EXPR to return
1995 the remainder which has the same sign as the dividend. In ISO Modula-2 the
1996 divisor must never be negative (or zero). The pseudo code for implementing these
1997 checks is given below:
2001 RETURN TRUE (* division by zero. *)
2004 RETURN TRUE (* modulus and division by negative (rhs) not allowed in ISO Modula-2. *)
2007 RETURN FALSE (* must be legal as result is same as operand. *)
2010 (* test for: i MOD j < minT *)
2015 RETURN i - ((i DIV j) * j) < minT
2018 (* the result will always be positive and less than i, given that j is less than zero
2019 we know that minT must be < 0 as well and therefore the result of i MOD j will
2025 which can be converted into a large expression:
2027 RETURN (j = 0) OR ((j < 0) AND ISO) OR
2028 ((i # 0) AND (j <= i) AND (i - ((i DIVtrunc j) * j) < minT)
2033 c2 -> (j < 0) (* only called from ISO or PIM4 or -fpositive-mod-floor *)
2036 c6 -> (i DIVtrunc j)
2037 c7 -> (i - (c6 * j))
2041 (c3 AND c4 AND c5)). */
2044 checkWholeModTruncOverflow (location_t location
, tree i
, tree j
, tree lowest
,
2047 tree c1
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
2048 tree c2
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
2049 tree c3
= m2expr_BuildNotEqualToZero (location
, i
, lowest
, min
, max
);
2050 tree c4
= m2expr_BuildLessThanOrEqual (location
, j
, i
);
2051 tree c6
= m2expr_BuildDivTrunc (location
, i
, j
, false);
2052 tree c7
= m2expr_BuildSub (location
, i
, m2expr_BuildMult (location
, c6
, j
, false), false);
2053 tree c5
= m2expr_BuildLessThan (location
, c7
, min
);
2054 tree c8
= m2expr_Build3TruthAndIf (location
, c3
, c4
, c5
);
2055 tree condition
= m2expr_Build3TruthOrIf (location
, c1
, c2
, c8
);
2056 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
2057 get_current_function_name (),
2058 "whole value trunc modulus will cause a range overflow");
2063 /* checkWholeModCeilOverflow, the GCC tree.def defines CEIL_MOD_EXPR to return
2064 the remainder which has the same opposite of the divisor. In gm2 this is
2065 only called when the divisor is negative. The pseudo code for implementing
2066 these checks is given below:
2070 RETURN TRUE (* division by zero. *)
2072 t := i - j * divceil (i, j) ;
2073 printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
2074 t, i, j, i, j, divceil (i, j));
2075 RETURN NOT ((t >= minT) AND (t <= maxT))
2077 which can be converted into the expression:
2079 t := i - j * divceil (i, j) ;
2080 RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
2096 checkWholeModCeilOverflow (location_t location
,
2097 tree i
, tree j
, tree lowest
,
2100 tree c1
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
2101 tree c2
= m2expr_BuildSub (location
, i
, j
, false);
2102 tree c3
= m2expr_BuildDivCeil (location
, i
, j
, false);
2103 tree t
= m2expr_BuildMult (location
, c2
, c3
, false);
2104 tree c4
= m2expr_BuildGreaterThanOrEqual (location
, t
, min
);
2105 tree c5
= m2expr_BuildLessThanOrEqual (location
, t
, max
);
2106 tree c6
= m2expr_BuildTruthAndIf (location
, c4
, c5
);
2107 tree c7
= m2expr_BuildTruthNot (location
, c6
);
2108 tree condition
= m2expr_BuildTruthOrIf (location
, c1
, c7
);
2109 tree s
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
2110 get_current_function_name (),
2111 "whole value ceil modulus will cause a range overflow");
2116 /* checkWholeModFloorOverflow, the GCC tree.def defines FLOOR_MOD_EXPR to return
2117 the remainder which has the same sign as the divisor. In gm2 this is
2118 only called when the divisor is positive. The pseudo code for implementing
2119 these checks is given below:
2123 RETURN TRUE (* division by zero. *)
2125 t := i - j * divfloor (i, j) ;
2126 printf ("t = %d, i = %d, j = %d, %d / %d = %d\n",
2127 t, i, j, i, j, divfloor (i, j));
2128 RETURN NOT ((t >= minT) AND (t <= maxT))
2130 which can be converted into the expression:
2132 t := i - j * divfloor (i, j) ;
2133 RETURN (j = 0) OR (NOT ((t >= minT) AND (t <= maxT)))
2139 c3 -> (i DIVfloor j)
2149 checkWholeModFloorOverflow (location_t location
,
2150 tree i
, tree j
, tree lowest
,
2153 tree c1
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
2154 tree c2
= m2expr_BuildSub (location
, i
, j
, false);
2155 tree c3
= m2expr_BuildDivFloor (location
, i
, j
, false);
2156 tree t
= m2expr_BuildMult (location
, c2
, c3
, false);
2157 tree c4
= m2expr_BuildGreaterThanOrEqual (location
, t
, min
);
2158 tree c5
= m2expr_BuildLessThanOrEqual (location
, t
, max
);
2159 tree c6
= m2expr_BuildTruthAndIf (location
, c4
, c5
);
2160 tree c7
= m2expr_BuildTruthNot (location
, c6
);
2161 tree condition
= m2expr_BuildTruthOrIf (location
, c1
, c7
);
2162 tree s
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
2163 get_current_function_name (),
2164 "whole value floor modulus will cause a range overflow");
2170 /* The following is a Modula-2 implementation of the C tree node code
2171 this code has been hand translated into GCC trees. */
2174 divFloorOverflow2
- returns
true if an overflow will occur
2175 if i divfloor j is performed
.
2178 PROCEDURE
divFloorOverflow (i
, j
: INTEGER
) : BOOLEAN
;
2180 RETURN ((j
= 0) OR (* division by zero
. *)
2181 (maxT
< 0) OR (* both inputs are
< 0 and max is
< 0,
2183 (* --fixme
-- remember here to also check
2184 if ISO M2 dialect
and j
< 0
2185 which will also generate an error
. *)
2186 ((i
# 0) AND (* first operand is legally zero,
2187 result is also legally zero
. *)
2188 divFloorOverflowCases (i
, j
)))
2189 END divFloorOverflow
;
2193 divFloorOverflowCases
- precondition
: i
, j are in range values
.
2194 postcondition
: true is returned
if i divfloor will
2195 result in an overflow
/underflow
.
2198 PROCEDURE
divFloorOverflowCases (i
, j
: INTEGER
) : BOOLEAN
;
2200 RETURN (((i
> 0) AND (j
> 0) AND
divFloorOverflowPosPos (i
, j
)) OR
2201 ((i
< 0) AND (j
< 0) AND
divFloorOverflowNegNeg (i
, j
)) OR
2202 ((i
> 0) AND (j
< 0) AND
divFloorOverflowPosNeg (i
, j
)) OR
2203 ((i
< 0) AND (j
> 0) AND
divFloorOverflowNegPos (i
, j
)))
2204 END divFloorOverflowCases
;
2208 divFloorOverflowPosPos
- precondition
: lhs
, rhs are legal
and are both
>= 0.
2209 postcondition
: true is returned
if lhs divfloor rhs will
2210 result in an overflow
/underflow
.
2213 PROCEDURE
divFloorOverflowPosPos (lhs
, rhs
: INTEGER
) : BOOLEAN
;
2215 RETURN
multMinOverflow (rhs
) OR (lhs
< rhs
* min
)
2216 END divFloorOverflowPosPos
;
2220 divFloorOverflowNegNeg
- precondition
: i
, j are in range values
and both
< 0.
2221 postcondition
: true is returned
if i divfloor will
2222 result in an overflow
/underflow
.
2225 PROCEDURE
divFloorOverflowNegNeg (i
, j
: INTEGER
) : BOOLEAN
;
2227 RETURN ((maxT
<= 0) OR (* signs will cause overflow
. *)
2228 (* check
for underflow
. *)
2230 (* check
for overflow
. *)
2231 (ABS (i
) DIV maxT
> ABS (j
)))
2232 END divFloorOverflowNegNeg
;
2236 divFloorOverflowNegPos
- precondition
: i
, j are in range values
. i
< 0, j
>= 0.
2237 postcondition
: true is returned
if i divfloor will
2238 result in an overflow
/underflow
.
2241 PROCEDURE
divFloorOverflowNegPos (i
, j
: INTEGER
) : BOOLEAN
;
2243 (* easier than might be initially expected
. We know minT
< 0 and maxT
> 0.
2244 We know the result will be negative
and therefore we only need to test
2247 END divFloorOverflowNegPos
;
2251 divFloorOverflowPosNeg
- precondition
: i
, j are in range values
. i
>= 0, j
< 0.
2252 postcondition
: true is returned
if i divfloor will
2253 result in an overflow
/underflow
.
2256 PROCEDURE
divFloorOverflowPosNeg (i
, j
: INTEGER
) : BOOLEAN
;
2258 (* easier than might be initially expected
. We know minT
< 0 and maxT
> 0.
2259 We know the result will be negative
and therefore we only need to test
2261 RETURN i
>= j
* minT
- j (* is safer than i
> j
* minT
-1 *)
2262 END divFloorOverflowPosNeg
;
2266 /* divFloorOverflowPosPos, precondition: i, j are legal and are both >= 0.
2267 Postcondition: true is returned if i divfloor will result in an overflow/underflow.
2269 A handbuilt expression of trees implementing:
2273 j_mult_min -> (j * min)
2274 RETURN i < j_mult_min. */
2277 divFloorOverflowPosPos (location_t location
, tree i
, tree j
, tree min
)
2279 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, false);
2280 tree i_lt_j_mult_min
= m2expr_BuildLessThan (location
, i
, j_mult_min
);
2281 return i_lt_j_mult_min
;
2285 /* divFloorOverflowNegNeg precondition: i, j are in range values and both < 0.
2286 Postcondition: true is returned if i divfloor j will result in an
2289 A handbuilt expression of trees implementing:
2291 RETURN ((maxT <= 0) OR (* signs will cause overflow. *)
2292 (* check for underflow. *)
2294 (* check for overflow. *)
2295 (ABS (i) DIV max > ABS (j)))
2297 max_lte_0 -> (max <= 0)
2300 j_mult_min -> (j * min)
2301 i_ge_j_mult_min -> (i >= j_mult_min)
2302 abs_i_div_max -> (abs_i divfloor max)
2303 abs_i_div_max_gt_abs_j -> (abs_i_div_max > abs_j)
2307 abs_i_div_max_gt_abs_j. */
2310 divFloorOverflowNegNeg (location_t location
, tree i
, tree j
, tree lowest
,
2313 tree max_lte_0
= m2expr_BuildLessThanOrEqualZero (location
, max
, lowest
, min
, max
);
2314 tree abs_i
= m2expr_BuildAbs (location
, i
);
2315 tree abs_j
= m2expr_BuildAbs (location
, j
);
2316 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, false);
2317 tree i_ge_j_mult_min
= m2expr_BuildGreaterThanOrEqual (location
, i
, j_mult_min
);
2318 tree abs_i_div_max
= m2expr_BuildDivFloor (location
, abs_i
, max
, false);
2319 tree abs_i_div_max_gt_abs_j
= m2expr_BuildGreaterThan (location
, abs_i_div_max
, abs_j
);
2321 return m2expr_Build3TruthOrIf (location
, max_lte_0
, i_ge_j_mult_min
, abs_i_div_max_gt_abs_j
);
2325 /* divFloorOverflowPosNeg precondition: i, j are in range values and i >=0, j < 0.
2326 Postcondition: true is returned if i divfloor j will result in an
2329 A handbuilt expression of trees implementing:
2331 RETURN i >= j * min - j (* is safer than i > j * min -1 *)
2333 j_mult_min -> (j * min)
2334 j_mult_min_sub_j -> (j_mult_min - j)
2335 i_ge_j_mult_min_sub_j -> (i >= j_mult_min_sub_j)
2337 return i_ge_j_mult_min_sub_j. */
2340 divFloorOverflowPosNeg (location_t location
, tree i
, tree j
, tree min
)
2342 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, false);
2343 tree j_mult_min_sub_j
= m2expr_BuildSub (location
, j_mult_min
, j
, false);
2344 tree i_ge_j_mult_min_sub_j
= m2expr_BuildGreaterThanOrEqual (location
, i
, j_mult_min_sub_j
);
2345 return i_ge_j_mult_min_sub_j
;
2349 /* divFloorOverflowNegPos precondition: i, j are in range values and i < 0, j > 0.
2350 Postcondition: true is returned if i divfloor j will result in an
2353 A handbuilt expression of trees implementing:
2357 j_mult_min -> (j * min)
2358 RETURN i < j_mult_min. */
2361 divFloorOverflowNegPos (location_t location
, tree i
, tree j
, tree min
)
2363 tree j_mult_min
= m2expr_BuildMult (location
, j
, min
, false);
2364 tree i_lt_j_mult_min
= m2expr_BuildLessThan (location
, i
, j_mult_min
);
2365 return i_lt_j_mult_min
;
2369 /* divFloorOverflowCases, precondition: i, j are in range values.
2370 Postcondition: true is returned if i divfloor will result in an
2373 A handbuilt expression of trees implementing:
2375 RETURN (((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j)) OR
2376 ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j)) OR
2377 ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j)) OR
2378 ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j)))
2380 a -> ((i > 0) AND (j > 0) AND divFloorOverflowPosPos (i, j))
2381 b -> ((i < 0) AND (j < 0) AND divFloorOverflowNegNeg (i, j))
2382 c -> ((i > 0) AND (j < 0) AND divFloorOverflowPosNeg (i, j))
2383 d -> ((i < 0) AND (j > 0) AND divFloorOverflowNegPos (i, j))
2385 RETURN a AND b AND c AND d. */
2388 divFloorOverflowCases (location_t location
, tree i
, tree j
, tree lowest
,
2391 tree i_gt_zero
= m2expr_BuildGreaterThanZero (location
, i
, lowest
, min
, max
);
2392 tree j_gt_zero
= m2expr_BuildGreaterThanZero (location
, j
, lowest
, min
, max
);
2393 tree i_lt_zero
= m2expr_BuildLessThanZero (location
, i
, lowest
, min
, max
);
2394 tree j_lt_zero
= m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
);
2395 tree a
= m2expr_Build3TruthAndIf (location
, i_gt_zero
, j_gt_zero
,
2396 divFloorOverflowPosPos (location
, i
, j
, min
));
2397 tree b
= m2expr_Build3TruthAndIf (location
, i_lt_zero
, j_lt_zero
,
2398 divFloorOverflowNegNeg (location
, i
, j
, lowest
, min
, max
));
2399 tree c
= m2expr_Build3TruthAndIf (location
, i_gt_zero
, j_lt_zero
,
2400 divFloorOverflowPosNeg (location
, i
, j
, min
));
2401 tree d
= m2expr_Build3TruthAndIf (location
, i_lt_zero
, j_gt_zero
,
2402 divFloorOverflowNegPos (location
, i
, j
, min
));
2403 return m2expr_Build4TruthOrIf (location
, a
, b
, c
, d
);
2407 /* checkWholeDivFloorOverflow check to see whether i DIV_FLOOR j will overflow
2408 an integer. A handbuilt expression of trees implementing:
2410 RETURN ((j = 0) OR (* division by zero. *)
2411 (maxT < 0) OR (* both inputs are < 0 and max is < 0,
2414 if ISO M2 dialect and j < 0
2415 which will also generate an error. *)
2416 ((i # 0) AND (* first operand is legally zero,
2417 result is also legally zero. *)
2418 divFloorOverflowCases (i, j)))
2420 using the following subexpressions:
2422 j_eq_zero -> (j == 0)
2423 max_lt_zero -> (max < 0)
2424 i_ne_zero -> (i # 0). */
2427 checkWholeDivFloorOverflow (location_t location
, tree i
, tree j
, tree lowest
,
2430 tree j_eq_zero
= m2expr_BuildEqualToZero (location
, j
, lowest
, min
, max
);
2431 tree max_lt_zero
= m2expr_BuildLessThanZero (location
, max
, lowest
, min
, max
);
2432 tree i_ne_zero
= m2expr_BuildNotEqualToZero (location
, i
, lowest
, min
, max
);
2434 tree rhs
= m2expr_BuildTruthAndIf (location
,
2436 divFloorOverflowCases (location
,
2437 i
, j
, lowest
, min
, max
));
2439 if (M2Options_GetISO ())
2440 /* ISO Modula-2 raises an exception if the right hand operand is < 0. */
2441 j_lt_zero
= m2expr_FoldAndStrip (m2expr_BuildLessThanZero (location
, j
, lowest
, min
, max
));
2443 j_lt_zero
= m2expr_GetIntegerZero (location
);
2444 j_eq_zero
= m2expr_FoldAndStrip (j_eq_zero
);
2445 max_lt_zero
= m2expr_FoldAndStrip (max_lt_zero
);
2446 i_ne_zero
= m2expr_FoldAndStrip (i_ne_zero
);
2447 rhs
= m2expr_FoldAndStrip (rhs
);
2449 tree condition
= m2expr_Build4TruthOrIf (location
, j_eq_zero
, max_lt_zero
, rhs
, j_lt_zero
);
2450 tree t
= M2Range_BuildIfCallWholeHandlerLoc (location
, condition
,
2451 get_current_function_name (),
2452 "whole value floor division will cause a range overflow");
2456 /* checkWholeOverflow check to see if the binary operators will overflow
2460 m2expr_checkWholeOverflow (location_t location
, enum tree_code code
, tree op1
,
2461 tree op2
, tree lowest
, tree min
, tree max
)
2463 if (M2Options_GetWholeValueCheck () && (min
!= NULL
))
2465 lowest
= m2tree_skip_type_decl (lowest
);
2466 op1
= fold_convert_loc (location
, lowest
, op1
);
2467 op2
= fold_convert_loc (location
, lowest
, op2
);
2472 return checkWholeAddOverflow (location
, op1
, op2
, lowest
, min
, max
);
2474 return checkWholeSubOverflow (location
, op1
, op2
, lowest
, min
, max
);
2476 return checkWholeMultOverflow (location
, op1
, op2
, lowest
, min
, max
);
2477 case TRUNC_DIV_EXPR
:
2478 return checkWholeDivTruncOverflow (location
, op1
, op2
, lowest
, min
, max
);
2480 return checkWholeDivCeilOverflow (location
, op1
, op2
, lowest
, min
, max
);
2481 case FLOOR_DIV_EXPR
:
2482 return checkWholeDivFloorOverflow (location
, op1
, op2
, lowest
, min
, max
);
2483 case TRUNC_MOD_EXPR
:
2484 return checkWholeModTruncOverflow (location
, op1
, op2
, lowest
, min
, max
);
2486 return checkWholeModCeilOverflow (location
, op1
, op2
, lowest
, min
, max
);
2487 case FLOOR_MOD_EXPR
:
2488 return checkWholeModFloorOverflow (location
, op1
, op2
, lowest
, min
, max
);
2496 /* checkRealOverflow if we have enabled real value checking then
2497 generate an overflow check appropriate to the tree code being used. */
2500 m2expr_checkRealOverflow (location_t location
, enum tree_code code
,
2503 if (M2Options_GetFloatValueCheck ())
2505 tree condition
= m2expr_BuildEqualTo (
2506 location
, m2builtins_BuiltInIsfinite (location
, result
),
2507 m2expr_GetIntegerZero (location
));
2511 m2type_AddStatement (location
,
2512 M2Range_BuildIfCallRealHandlerLoc (
2513 location
, condition
,
2514 get_current_function_name (),
2515 "floating point + has caused an overflow"));
2518 m2type_AddStatement (location
,
2519 M2Range_BuildIfCallRealHandlerLoc (
2520 location
, condition
,
2521 get_current_function_name (),
2522 "floating point - has caused an overflow"));
2525 case FLOOR_DIV_EXPR
:
2527 case TRUNC_DIV_EXPR
:
2528 m2type_AddStatement (location
,
2529 M2Range_BuildIfCallRealHandlerLoc (
2530 location
, condition
,
2531 get_current_function_name (),
2532 "floating point / has caused an overflow"));
2535 m2type_AddStatement (location
,
2536 M2Range_BuildIfCallRealHandlerLoc (
2537 location
, condition
,
2538 get_current_function_name (),
2539 "floating point * has caused an overflow"));
2542 m2type_AddStatement (
2543 location
, M2Range_BuildIfCallRealHandlerLoc (
2544 location
, condition
,
2545 get_current_function_name (),
2546 "floating point unary - has caused an overflow"));
2553 /* build_binary_op, a wrapper for the lower level build_binary_op
2557 m2expr_build_binary_op_check (location_t location
, enum tree_code code
,
2558 tree op1
, tree op2
, bool needconvert
, tree lowest
,
2561 tree type1
, type2
, result
;
2564 op1
= m2expr_FoldAndStrip (op1
);
2565 op2
= m2expr_FoldAndStrip (op2
);
2567 type1
= m2tree_skip_type_decl (TREE_TYPE (op1
));
2568 type2
= m2tree_skip_type_decl (TREE_TYPE (op2
));
2570 m2assert_AssertLocation (location
);
2572 if (code
== PLUS_EXPR
)
2574 if (POINTER_TYPE_P (type1
))
2576 op2
= fold_convert_loc (location
, sizetype
, unshare_expr (op2
));
2577 return fold_build2_loc (location
, POINTER_PLUS_EXPR
, TREE_TYPE (op1
),
2580 else if (POINTER_TYPE_P (type2
))
2582 op1
= fold_convert_loc (location
, sizetype
, unshare_expr (op1
));
2583 return fold_build2_loc (location
, POINTER_PLUS_EXPR
, TREE_TYPE (op2
),
2587 if (code
== MINUS_EXPR
)
2589 if (POINTER_TYPE_P (type1
))
2591 op2
= fold_convert_loc (location
, sizetype
, unshare_expr (op2
));
2592 op2
= fold_build1_loc (location
, NEGATE_EXPR
, sizetype
, op2
);
2593 return fold_build2_loc (location
, POINTER_PLUS_EXPR
, TREE_TYPE (op1
),
2596 else if (POINTER_TYPE_P (type2
))
2598 op2
= fold_convert_loc (location
, sizetype
, unshare_expr (op2
));
2599 op2
= fold_build1_loc (location
, NEGATE_EXPR
, sizetype
, op2
);
2600 op1
= fold_convert_loc (location
, sizetype
, unshare_expr (op1
));
2601 return fold_build2_loc (location
, POINTER_PLUS_EXPR
, TREE_TYPE (op2
),
2606 if ((code
!= LSHIFT_EXPR
) && (code
!= RSHIFT_EXPR
) && (code
!= LROTATE_EXPR
)
2607 && (code
== RROTATE_EXPR
))
2609 error_at (location
, "not expecting different types to binary operator");
2611 if ((TREE_CODE (type1
) != REAL_TYPE
) && (min
!= NULL
))
2612 check
= m2expr_checkWholeOverflow (location
, code
, op1
, op2
, lowest
, min
, max
);
2614 result
= build_binary_op (location
, code
, op1
, op2
, needconvert
);
2616 result
= build2 (COMPOUND_EXPR
, TREE_TYPE (result
), check
, result
);
2618 if (SCALAR_FLOAT_TYPE_P (type1
))
2619 m2expr_checkRealOverflow (location
, code
, result
);
2623 /* build_binary_op, a wrapper for the lower level build_binary_op
2627 m2expr_build_binary_op (location_t location
, enum tree_code code
, tree op1
,
2628 tree op2
, int convert
)
2630 return m2expr_build_binary_op_check (location
, code
, op1
, op2
, convert
, NULL
,
2634 /* BuildAddAddress return an expression op1+op2 where op1 is a
2635 pointer type and op2 is not a pointer type. */
2638 m2expr_BuildAddAddress (location_t location
, tree op1
, tree op2
)
2642 op1
= m2expr_FoldAndStrip (op1
);
2643 op2
= m2expr_FoldAndStrip (op2
);
2645 type1
= m2tree_skip_type_decl (TREE_TYPE (op1
));
2646 type2
= m2tree_skip_type_decl (TREE_TYPE (op2
));
2648 m2assert_AssertLocation (location
);
2649 ASSERT_CONDITION (POINTER_TYPE_P (type1
));
2650 ASSERT_CONDITION (!POINTER_TYPE_P (type2
));
2652 op2
= fold_convert_loc (location
, sizetype
, unshare_expr (op2
));
2653 return fold_build2_loc (location
, POINTER_PLUS_EXPR
, TREE_TYPE (op1
),
2654 m2expr_FoldAndStrip (op1
),
2655 m2expr_FoldAndStrip (op2
));
2658 /* BuildNegateCheck builds a negate tree. */
2661 m2expr_BuildNegateCheck (location_t location
, tree arg
, tree lowest
, tree min
,
2666 m2assert_AssertLocation (location
);
2668 arg
= m2expr_FoldAndStrip (arg
);
2669 arg
= CheckAddressToCardinal (location
, arg
);
2671 t
= m2expr_build_unary_op_check (location
, NEGATE_EXPR
, arg
, lowest
, min
,
2673 return m2expr_FoldAndStrip (t
);
2676 /* BuildNegate build a negate expression and returns the tree. */
2679 m2expr_BuildNegate (location_t location
, tree op1
, bool needconvert
)
2681 m2assert_AssertLocation (location
);
2682 op1
= m2expr_FoldAndStrip (op1
);
2683 op1
= CheckAddressToCardinal (location
, op1
);
2685 return m2expr_build_unary_op (location
, NEGATE_EXPR
, op1
, needconvert
);
2688 /* BuildSetNegate build a set negate expression and returns the tree. */
2691 m2expr_BuildSetNegate (location_t location
, tree op1
, bool needconvert
)
2693 m2assert_AssertLocation (location
);
2695 return m2expr_build_binary_op (
2696 location
, BIT_XOR_EXPR
,
2697 m2convert_BuildConvert (location
, m2type_GetWordType (),
2698 m2expr_FoldAndStrip (op1
), false),
2699 set_full_complement
, needconvert
);
2702 /* BuildMult build a multiplication tree. */
2705 m2expr_BuildMult (location_t location
, tree op1
, tree op2
, bool needconvert
)
2707 op1
= m2expr_FoldAndStrip (op1
);
2708 op2
= m2expr_FoldAndStrip (op2
);
2710 m2assert_AssertLocation (location
);
2712 op1
= CheckAddressToCardinal (location
, op1
);
2713 op2
= CheckAddressToCardinal (location
, op2
);
2715 return m2expr_build_binary_op (location
, MULT_EXPR
, op1
, op2
, needconvert
);
2718 /* BuildMultCheck builds a multiplication tree. */
2721 m2expr_BuildMultCheck (location_t location
, tree op1
, tree op2
, tree lowest
,
2726 m2assert_AssertLocation (location
);
2728 op1
= m2expr_FoldAndStrip (op1
);
2729 op2
= m2expr_FoldAndStrip (op2
);
2731 op1
= CheckAddressToCardinal (location
, op1
);
2732 op2
= CheckAddressToCardinal (location
, op2
);
2734 t
= m2expr_build_binary_op_check (location
, MULT_EXPR
, op1
, op2
, false,
2736 return m2expr_FoldAndStrip (t
);
2739 /* testLimits return the number of bits required to represent:
2740 min..max if it matches the, type. Otherwise NULL_TREE is returned. */
2743 testLimits (location_t location
, tree type
, tree min
, tree max
)
2745 m2assert_AssertLocation (location
);
2747 if ((m2expr_CompareTrees (TYPE_MAX_VALUE (type
), max
) == 0)
2748 && (m2expr_CompareTrees (TYPE_MIN_VALUE (type
), min
) == 0))
2749 return m2expr_BuildMult (location
, m2expr_GetSizeOf (location
, type
),
2750 m2decl_BuildIntegerConstant (BITS_PER_UNIT
),
2755 /* noBitsRequired return the number of bits required to contain, values. */
2758 noBitsRequired (tree values
)
2760 int bits
= tree_floor_log2 (values
);
2762 return m2decl_BuildIntegerConstant (bits
+ 1);
2765 /* getMax return the result of max (a, b). */
2768 getMax (tree a
, tree b
)
2770 if (m2expr_CompareTrees (a
, b
) > 0)
2776 /* calcNbits return the smallest number of bits required to
2777 represent: min..max. */
2780 m2expr_calcNbits (location_t location
, tree min
, tree max
)
2782 int negative
= false;
2783 tree t
= testLimits (location
, m2type_GetIntegerType (), min
, max
);
2785 m2assert_AssertLocation (location
);
2788 t
= testLimits (location
, m2type_GetCardinalType (), min
, max
);
2792 if (m2expr_CompareTrees (min
, m2expr_GetIntegerZero (location
)) < 0)
2794 min
= m2expr_BuildAdd (location
, min
,
2795 m2expr_GetIntegerOne (location
), false);
2796 min
= fold (m2expr_BuildNegate (location
, min
, false));
2799 if (m2expr_CompareTrees (max
, m2expr_GetIntegerZero (location
)) < 0)
2801 max
= fold (m2expr_BuildNegate (location
, max
, false));
2804 t
= noBitsRequired (getMax (min
, max
));
2806 t
= m2expr_BuildAdd (location
, t
, m2expr_GetIntegerOne (location
),
2812 /* BuildTBitSize return the minimum number of bits to represent, type. */
2815 m2expr_BuildTBitSize (location_t location
, tree type
)
2817 enum tree_code code
= TREE_CODE (type
);
2820 m2assert_AssertLocation (location
);
2826 return m2expr_BuildTBitSize (location
, TREE_TYPE (type
));
2829 max
= m2convert_BuildConvert (location
, m2type_GetIntegerType (),
2830 TYPE_MAX_VALUE (type
), false);
2831 min
= m2convert_BuildConvert (location
, m2type_GetIntegerType (),
2832 TYPE_MIN_VALUE (type
), false);
2833 return m2expr_calcNbits (location
, min
, max
);
2835 return m2expr_GetIntegerOne (location
);
2837 return m2expr_BuildMult (location
, m2expr_GetSizeOf (location
, type
),
2838 m2decl_BuildIntegerConstant (BITS_PER_UNIT
),
2843 /* BuildSize build a SIZE function expression and returns the tree. */
2846 m2expr_BuildSize (location_t location
, tree op1
,
2847 bool needconvert ATTRIBUTE_UNUSED
)
2849 m2assert_AssertLocation (location
);
2850 return m2expr_GetSizeOf (location
, op1
);
2853 /* BuildAddr return an expression which calculates the address of op1
2854 and returns the tree. If use_generic is true then create a generic
2858 m2expr_BuildAddr (location_t location
, tree op1
, bool use_generic
)
2860 tree type
= m2tree_skip_type_decl (TREE_TYPE (op1
));
2861 tree ptrType
= build_pointer_type (type
);
2864 m2assert_AssertLocation (location
);
2866 if (!gm2_mark_addressable (op1
))
2867 error_at (location
, "cannot take the address of this expression");
2870 result
= build1 (ADDR_EXPR
, m2type_GetPointerType (), op1
);
2872 result
= build1 (ADDR_EXPR
, ptrType
, op1
);
2873 protected_set_expr_location (result
, location
);
2877 /* BuildOffset1 build and return an expression containing the number
2878 of bytes the field is offset from the start of the record structure.
2879 This function is the same as the above, except that it derives the
2880 record from the field and then calls BuildOffset. */
2883 m2expr_BuildOffset1 (location_t location
, tree field
,
2884 bool needconvert ATTRIBUTE_UNUSED
)
2886 m2assert_AssertLocation (location
);
2887 return m2expr_BuildOffset (location
, DECL_CONTEXT (field
), field
,
2891 /* determinePenultimateField return the field associated with the
2892 DECL_CONTEXT (field) within a record or varient. The record, is a
2893 record/varient but it maybe an outer nested record to the field that
2894 we are searching. Ie:
2896 record = RECORD x: CARDINAL ; y: RECORD field: CARDINAL ; END END ;
2898 determinePenultimateField (record, field) returns, y. We are
2899 assurred that the chain of records leading to field will be unique as
2900 they are built on the fly to implement varient records. */
2903 determinePenultimateField (tree record
, tree field
)
2905 tree fieldlist
= TYPE_FIELDS (record
);
2908 for (x
= fieldlist
; x
; x
= TREE_CHAIN (x
))
2910 if (DECL_CONTEXT (field
) == TREE_TYPE (x
))
2912 switch (TREE_CODE (TREE_TYPE (x
)))
2916 r
= determinePenultimateField (TREE_TYPE (x
), field
);
2927 /* BuildOffset builds an expression containing the number of bytes
2928 the field is offset from the start of the record structure. The
2929 expression is returned. */
2932 m2expr_BuildOffset (location_t location
, tree record
, tree field
,
2933 bool needconvert ATTRIBUTE_UNUSED
)
2935 m2assert_AssertLocation (location
);
2937 if (DECL_CONTEXT (field
) == record
)
2938 return m2convert_BuildConvert (
2939 location
, m2type_GetIntegerType (),
2941 location
, DECL_FIELD_OFFSET (field
),
2942 m2expr_BuildDivTrunc (location
, DECL_FIELD_BIT_OFFSET (field
),
2943 m2decl_BuildIntegerConstant (BITS_PER_UNIT
),
2949 tree r1
= DECL_CONTEXT (field
);
2950 tree r2
= determinePenultimateField (record
, field
);
2951 return m2convert_BuildConvert (
2952 location
, m2type_GetIntegerType (),
2954 location
, m2expr_BuildOffset (location
, r1
, field
, needconvert
),
2955 m2expr_BuildOffset (location
, record
, r2
, needconvert
), false),
2960 /* BuildLogicalOrAddress build a logical or expressions and return the tree. */
2963 m2expr_BuildLogicalOrAddress (location_t location
, tree op1
, tree op2
,
2966 m2assert_AssertLocation (location
);
2967 return m2expr_build_binary_op (location
, BIT_IOR_EXPR
, op1
, op2
,
2971 /* BuildLogicalOr build a logical or expressions and return the tree. */
2974 m2expr_BuildLogicalOr (location_t location
, tree op1
, tree op2
,
2977 m2assert_AssertLocation (location
);
2978 return m2expr_build_binary_op (
2979 location
, BIT_IOR_EXPR
,
2980 m2convert_BuildConvert (location
, m2type_GetWordType (), op1
, false),
2981 m2convert_BuildConvert (location
, m2type_GetWordType (), op2
, false),
2985 /* BuildLogicalAnd build a logical and expression and return the tree. */
2988 m2expr_BuildLogicalAnd (location_t location
, tree op1
, tree op2
,
2991 m2assert_AssertLocation (location
);
2992 return m2expr_build_binary_op (
2993 location
, BIT_AND_EXPR
,
2994 m2convert_BuildConvert (location
, m2type_GetWordType (), op1
, false),
2995 m2convert_BuildConvert (location
, m2type_GetWordType (), op2
, false),
2999 /* BuildSymmetricalDifference build a logical xor expression and return the
3003 m2expr_BuildSymmetricDifference (location_t location
, tree op1
, tree op2
,
3006 m2assert_AssertLocation (location
);
3007 return m2expr_build_binary_op (
3008 location
, BIT_XOR_EXPR
,
3009 m2convert_BuildConvert (location
, m2type_GetWordType (), op1
, false),
3010 m2convert_BuildConvert (location
, m2type_GetWordType (), op2
, false),
3014 /* BuildLogicalDifference build a logical difference expression and
3015 return the tree. (op1 and (not op2)). */
3018 m2expr_BuildLogicalDifference (location_t location
, tree op1
, tree op2
,
3021 m2assert_AssertLocation (location
);
3022 return m2expr_build_binary_op (
3023 location
, BIT_AND_EXPR
,
3024 m2convert_BuildConvert (location
, m2type_GetWordType (), op1
, false),
3025 m2expr_BuildSetNegate (location
, op2
, needconvert
), needconvert
);
3028 /* base_type returns the base type of an ordinal subrange, or the
3029 type itself if it is not a subrange. */
3032 base_type (tree type
)
3034 if (type
== error_mark_node
)
3035 return error_mark_node
;
3037 /* Check for ordinal subranges. */
3038 if (m2tree_IsOrdinal (type
) && TREE_TYPE (type
))
3039 type
= TREE_TYPE (type
);
3040 return TYPE_MAIN_VARIANT (type
);
3043 /* boolean_enum_to_unsigned convert a BOOLEAN_TYPE, t, or
3044 ENUMERAL_TYPE to an unsigned type. */
3047 boolean_enum_to_unsigned (location_t location
, tree t
)
3049 tree type
= TREE_TYPE (t
);
3051 if (TREE_CODE (base_type (type
)) == BOOLEAN_TYPE
)
3052 return m2convert_BuildConvert (location
, unsigned_type_node
, t
, false);
3053 else if (TREE_CODE (base_type (type
)) == ENUMERAL_TYPE
)
3054 return m2convert_BuildConvert (location
, unsigned_type_node
, t
, false);
3059 /* check_for_comparison check to see if, op, is of type, badType. If
3060 so then it returns op after it has been cast to, goodType. op will
3061 be an array so we take the address and cast the contents. */
3064 check_for_comparison (location_t location
, tree op
, tree badType
,
3067 m2assert_AssertLocation (location
);
3068 if (m2tree_skip_type_decl (TREE_TYPE (op
)) == badType
)
3069 /* Cannot compare array contents in m2expr_build_binary_op. */
3070 return m2expr_BuildIndirect (
3071 location
, m2expr_BuildAddr (location
, op
, false), goodType
);
3075 /* convert_for_comparison return a tree which can be used as an
3076 argument during a comparison. */
3079 convert_for_comparison (location_t location
, tree op
)
3081 m2assert_AssertLocation (location
);
3082 op
= boolean_enum_to_unsigned (location
, op
);
3084 op
= check_for_comparison (location
, op
, m2type_GetISOWordType (),
3085 m2type_GetWordType ());
3086 op
= check_for_comparison (location
, op
, m2type_GetM2Word16 (),
3087 m2type_GetM2Cardinal16 ());
3088 op
= check_for_comparison (location
, op
, m2type_GetM2Word32 (),
3089 m2type_GetM2Cardinal32 ());
3090 op
= check_for_comparison (location
, op
, m2type_GetM2Word64 (),
3091 m2type_GetM2Cardinal64 ());
3096 /* BuildLessThan return a tree which computes <. */
3099 m2expr_BuildLessThan (location_t location
, tree op1
, tree op2
)
3101 m2assert_AssertLocation (location
);
3102 return m2expr_build_binary_op (
3103 location
, LT_EXPR
, boolean_enum_to_unsigned (location
, op1
),
3104 boolean_enum_to_unsigned (location
, op2
), true);
3107 /* BuildGreaterThan return a tree which computes >. */
3110 m2expr_BuildGreaterThan (location_t location
, tree op1
, tree op2
)
3112 m2assert_AssertLocation (location
);
3113 return m2expr_build_binary_op (
3114 location
, GT_EXPR
, boolean_enum_to_unsigned (location
, op1
),
3115 boolean_enum_to_unsigned (location
, op2
), true);
3118 /* BuildLessThanOrEqual return a tree which computes <. */
3121 m2expr_BuildLessThanOrEqual (location_t location
, tree op1
, tree op2
)
3123 m2assert_AssertLocation (location
);
3124 return m2expr_build_binary_op (
3125 location
, LE_EXPR
, boolean_enum_to_unsigned (location
, op1
),
3126 boolean_enum_to_unsigned (location
, op2
), true);
3129 /* BuildGreaterThanOrEqual return a tree which computes >=. */
3132 m2expr_BuildGreaterThanOrEqual (location_t location
, tree op1
, tree op2
)
3134 m2assert_AssertLocation (location
);
3135 return m2expr_build_binary_op (
3136 location
, GE_EXPR
, boolean_enum_to_unsigned (location
, op1
),
3137 boolean_enum_to_unsigned (location
, op2
), true);
3140 /* BuildEqualTo return a tree which computes =. */
3143 m2expr_BuildEqualTo (location_t location
, tree op1
, tree op2
)
3145 m2assert_AssertLocation (location
);
3146 return m2expr_build_binary_op (location
, EQ_EXPR
,
3147 convert_for_comparison (location
, op1
),
3148 convert_for_comparison (location
, op2
), true);
3151 /* BuildEqualNotTo return a tree which computes #. */
3154 m2expr_BuildNotEqualTo (location_t location
, tree op1
, tree op2
)
3156 m2assert_AssertLocation (location
);
3157 return m2expr_build_binary_op (location
, NE_EXPR
,
3158 convert_for_comparison (location
, op1
),
3159 convert_for_comparison (location
, op2
), true);
3162 /* BuildIsSuperset return a tree which computes: op1 & op2 == op2. */
3165 m2expr_BuildIsSuperset (location_t location
, tree op1
, tree op2
)
3167 m2assert_AssertLocation (location
);
3168 return m2expr_BuildEqualTo (
3169 location
, op2
, m2expr_BuildLogicalAnd (location
, op1
, op2
, false));
3172 /* BuildIsNotSuperset return a tree which computes: op1 & op2 != op2. */
3175 m2expr_BuildIsNotSuperset (location_t location
, tree op1
, tree op2
)
3177 m2assert_AssertLocation (location
);
3178 return m2expr_BuildNotEqualTo (
3179 location
, op2
, m2expr_BuildLogicalAnd (location
, op1
, op2
, false));
3182 /* BuildIsSubset return a tree which computes: op1 & op2 == op1. */
3185 m2expr_BuildIsSubset (location_t location
, tree op1
, tree op2
)
3187 m2assert_AssertLocation (location
);
3188 return m2expr_BuildEqualTo (
3189 location
, op1
, m2expr_BuildLogicalAnd (location
, op1
, op2
, false));
3192 /* BuildIsNotSubset return a tree which computes: op1 & op2 != op1. */
3195 m2expr_BuildIsNotSubset (location_t location
, tree op1
, tree op2
)
3197 m2assert_AssertLocation (location
);
3198 return m2expr_BuildNotEqualTo (
3199 location
, op1
, m2expr_BuildLogicalAnd (location
, op1
, op2
, false));
3202 /* BuildIfConstInVar generates: if constel in varset then goto label. */
3205 m2expr_BuildIfConstInVar (location_t location
, tree type
, tree varset
,
3206 tree constel
, bool is_lvalue
, int fieldno
,
3209 tree size
= m2expr_GetSizeOf (location
, type
);
3210 m2assert_AssertLocation (location
);
3212 ASSERT_BOOL (is_lvalue
);
3213 if (m2expr_CompareTrees (
3214 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
3216 /* Small set size <= TSIZE(WORD). */
3217 m2treelib_do_jump_if_bit (
3219 m2treelib_get_rvalue (location
, varset
, type
, is_lvalue
), constel
,
3223 tree fieldlist
= TYPE_FIELDS (type
);
3226 for (field
= fieldlist
; (field
!= NULL
) && (fieldno
> 0);
3227 field
= TREE_CHAIN (field
))
3230 m2treelib_do_jump_if_bit (
3232 m2treelib_get_set_field_rhs (location
, varset
, field
), constel
,
3237 /* BuildIfConstInVar generates: if not (constel in varset) then goto label. */
3240 m2expr_BuildIfNotConstInVar (location_t location
, tree type
, tree varset
,
3241 tree constel
, bool is_lvalue
, int fieldno
,
3244 tree size
= m2expr_GetSizeOf (location
, type
);
3246 m2assert_AssertLocation (location
);
3248 ASSERT_BOOL (is_lvalue
);
3249 if (m2expr_CompareTrees (
3250 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
3252 /* Small set size <= TSIZE(WORD). */
3253 m2treelib_do_jump_if_bit (
3255 m2treelib_get_rvalue (location
, varset
, type
, is_lvalue
), constel
,
3259 tree fieldlist
= TYPE_FIELDS (type
);
3262 for (field
= fieldlist
; (field
!= NULL
) && (fieldno
> 0);
3263 field
= TREE_CHAIN (field
))
3266 m2treelib_do_jump_if_bit (
3268 m2treelib_get_set_field_rhs (location
, varset
, field
), constel
,
3273 /* BuildIfVarInVar generates: if varel in varset then goto label. */
3276 m2expr_BuildIfVarInVar (location_t location
, tree type
, tree varset
,
3277 tree varel
, bool is_lvalue
, tree low
,
3278 tree high ATTRIBUTE_UNUSED
, char *label
)
3280 tree size
= m2expr_GetSizeOf (location
, type
);
3281 /* Calculate the index from the first bit, ie bit 0 represents low value. */
3282 tree index
= m2expr_BuildSub (
3283 location
, m2convert_BuildConvert (location
, m2type_GetIntegerType (),
3285 m2convert_BuildConvert (location
, m2type_GetIntegerType (), low
, false),
3288 m2assert_AssertLocation (location
);
3290 if (m2expr_CompareTrees (
3291 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
3293 /* Small set size <= TSIZE(WORD). */
3294 m2treelib_do_jump_if_bit (
3296 m2treelib_get_rvalue (location
, varset
, type
, is_lvalue
), index
,
3300 tree p1
= m2treelib_get_set_address (location
, varset
, is_lvalue
);
3301 /* Which word do we need to fetch? */
3302 tree word_index
= m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
3303 location
, index
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
),
3305 /* Calculate the bit in this word. */
3306 tree offset_into_word
= m2expr_FoldAndStrip (m2expr_BuildModTrunc (
3307 location
, index
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
),
3309 tree p2
= m2expr_FoldAndStrip (m2expr_BuildMult (
3310 location
, word_index
,
3311 m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
), false));
3313 /* Calculate the address of the word we are interested in. */
3314 p1
= m2expr_BuildAddAddress (location
,
3315 m2convert_convertToPtr (location
, p1
), p2
);
3317 /* Fetch the word, extract the bit and test for != 0. */
3318 m2treelib_do_jump_if_bit (
3320 m2expr_BuildIndirect (location
, p1
, m2type_GetBitsetType ()),
3321 offset_into_word
, label
);
3325 /* BuildIfNotVarInVar generates: if not (varel in varset) then goto label. */
3328 m2expr_BuildIfNotVarInVar (location_t location
, tree type
, tree varset
,
3329 tree varel
, bool is_lvalue
, tree low
,
3330 tree high ATTRIBUTE_UNUSED
, char *label
)
3332 tree size
= m2expr_GetSizeOf (location
, type
);
3333 /* Calculate the index from the first bit, ie bit 0 represents low value. */
3334 tree index
= m2expr_BuildSub (
3335 location
, m2convert_BuildConvert (location
, m2type_GetIntegerType (),
3336 m2expr_FoldAndStrip (varel
), false),
3337 m2convert_BuildConvert (location
, m2type_GetIntegerType (),
3338 m2expr_FoldAndStrip (low
), false),
3341 index
= m2expr_FoldAndStrip (index
);
3342 m2assert_AssertLocation (location
);
3344 if (m2expr_CompareTrees (
3345 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
3347 /* Small set size <= TSIZE(WORD). */
3348 m2treelib_do_jump_if_bit (
3350 m2treelib_get_rvalue (location
, varset
, type
, is_lvalue
), index
,
3354 tree p1
= m2treelib_get_set_address (location
, varset
, is_lvalue
);
3355 /* Calculate the index from the first bit. */
3357 /* Which word do we need to fetch? */
3358 tree word_index
= m2expr_FoldAndStrip (m2expr_BuildDivTrunc (
3359 location
, index
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
),
3361 /* Calculate the bit in this word. */
3362 tree offset_into_word
= m2expr_FoldAndStrip (m2expr_BuildModTrunc (
3363 location
, index
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
),
3365 tree p2
= m2expr_FoldAndStrip (m2expr_BuildMult (
3366 location
, word_index
,
3367 m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
), false));
3369 /* Calculate the address of the word we are interested in. */
3370 p1
= m2expr_BuildAddAddress (location
, p1
, p2
);
3372 /* Fetch the word, extract the bit and test for == 0. */
3373 m2treelib_do_jump_if_bit (
3375 m2expr_BuildIndirect (location
, p1
, m2type_GetBitsetType ()),
3376 offset_into_word
, label
);
3380 /* BuildForeachWordInSetDoIfExpr foreach word in set, type, compute
3381 the expression, expr, and if true goto label. */
3384 m2expr_BuildForeachWordInSetDoIfExpr (location_t location
, tree type
, tree op1
,
3385 tree op2
, bool is_op1lvalue
,
3386 bool is_op2lvalue
, bool is_op1const
,
3388 tree (*expr
) (location_t
, tree
, tree
),
3391 tree p1
= m2treelib_get_set_address_if_var (location
, op1
, is_op1lvalue
,
3393 tree p2
= m2treelib_get_set_address_if_var (location
, op2
, is_op2lvalue
,
3395 unsigned int fieldNo
= 0;
3396 tree field1
= m2treelib_get_field_no (type
, op1
, is_op1const
, fieldNo
);
3397 tree field2
= m2treelib_get_field_no (type
, op2
, is_op2const
, fieldNo
);
3399 m2assert_AssertLocation (location
);
3400 ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op1
)) == RECORD_TYPE
);
3401 ASSERT_CONDITION (TREE_CODE (TREE_TYPE (op2
)) == RECORD_TYPE
);
3403 while (field1
!= NULL
&& field2
!= NULL
)
3405 m2statement_DoJump (
3408 m2treelib_get_set_value (location
, p1
, field1
, is_op1const
,
3409 is_op1lvalue
, op1
, fieldNo
),
3410 m2treelib_get_set_value (location
, p2
, field2
, is_op2const
,
3411 is_op2lvalue
, op2
, fieldNo
)),
3414 field1
= m2treelib_get_field_no (type
, op1
, is_op1const
, fieldNo
);
3415 field2
= m2treelib_get_field_no (type
, op2
, is_op2const
, fieldNo
);
3419 /* BuildIfInRangeGoto returns a tree containing if var is in the
3420 range low..high then goto label. */
3423 m2expr_BuildIfInRangeGoto (location_t location
, tree var
, tree low
, tree high
,
3426 m2assert_AssertLocation (location
);
3428 if (m2expr_CompareTrees (low
, high
) == 0)
3429 m2statement_DoJump (location
, m2expr_BuildEqualTo (location
, var
, low
),
3432 m2statement_DoJump (
3434 m2expr_build_binary_op (
3435 location
, TRUTH_ANDIF_EXPR
,
3436 m2expr_BuildGreaterThanOrEqual (location
, var
, low
),
3437 m2expr_BuildLessThanOrEqual (location
, var
, high
), false),
3441 /* BuildIfNotInRangeGoto returns a tree containing if var is not in
3442 the range low..high then goto label. */
3445 m2expr_BuildIfNotInRangeGoto (location_t location
, tree var
, tree low
,
3446 tree high
, char *label
)
3448 m2assert_AssertLocation (location
);
3450 if (m2expr_CompareTrees (low
, high
) == 0)
3451 m2statement_DoJump (location
, m2expr_BuildNotEqualTo (location
, var
, low
),
3454 m2statement_DoJump (
3455 location
, m2expr_build_binary_op (
3456 location
, TRUTH_ORIF_EXPR
,
3457 m2expr_BuildLessThan (location
, var
, low
),
3458 m2expr_BuildGreaterThan (location
, var
, high
), false),
3462 /* BuildArray - returns a tree which accesses array[index] given,
3466 m2expr_BuildArray (location_t location
, tree type
, tree array
, tree index
,
3469 tree array_type
= m2tree_skip_type_decl (TREE_TYPE (array
));
3470 tree index_type
= TYPE_DOMAIN (array_type
);
3471 type
= m2tree_skip_type_decl (type
);
3472 // ASSERT_CONDITION (low_indice == TYPE_MIN_VALUE (index_type));
3475 = m2convert_BuildConvert (location
, index_type
, low_indice
, false);
3476 return build4_loc (location
, ARRAY_REF
, type
, array
, index
, low_indice
,
3480 /* BuildComponentRef - build a component reference tree which
3481 accesses record.field. If field does not belong to record it
3482 calls BuildComponentRef on the penultimate field. */
3485 m2expr_BuildComponentRef (location_t location
, tree record
, tree field
)
3487 tree recordType
= m2tree_skip_reference_type (
3488 m2tree_skip_type_decl (TREE_TYPE (record
)));
3490 if (DECL_CONTEXT (field
) == recordType
)
3491 return build3 (COMPONENT_REF
, TREE_TYPE (field
), record
, field
, NULL_TREE
);
3494 tree f
= determinePenultimateField (recordType
, field
);
3495 return m2expr_BuildComponentRef (
3496 location
, m2expr_BuildComponentRef (location
, record
, f
), field
);
3500 /* BuildIndirect - build: (*target) given that the object to be
3501 copied is of, type. */
3504 m2expr_BuildIndirect (location_t location ATTRIBUTE_UNUSED
, tree target
,
3507 /* Note that the second argument to build1 is:
3509 TYPE_QUALS is a list of modifiers such as const or volatile to apply
3510 to the pointer type, represented as identifiers.
3512 it also determines the type of arithmetic and size of the object to
3513 be indirectly moved. */
3515 tree t1
= m2tree_skip_type_decl (type
);
3516 tree t2
= build_pointer_type (t1
);
3518 m2assert_AssertLocation (location
);
3520 return build1 (INDIRECT_REF
, t1
,
3521 m2convert_BuildConvert (location
, t2
, target
, false));
3524 /* IsTrue - returns true if, t, is known to be true. */
3527 m2expr_IsTrue (tree t
)
3529 return (m2expr_FoldAndStrip (t
) == m2type_GetBooleanTrue ());
3532 /* IsFalse - returns false if, t, is known to be false. */
3535 m2expr_IsFalse (tree t
)
3537 return (m2expr_FoldAndStrip (t
) == m2type_GetBooleanFalse ());
3540 /* AreConstantsEqual - maps onto tree.cc (tree_int_cst_equal). It
3541 returns true if the value of e1 is the same as e2. */
3544 m2expr_AreConstantsEqual (tree e1
, tree e2
)
3546 return tree_int_cst_equal (e1
, e2
) != 0;
3549 /* AreRealOrComplexConstantsEqual - returns true if constants, e1 and
3550 e2 are equal according to IEEE rules. This does not perform bit
3551 equivalence for example IEEE states that -0 == 0 and NaN != NaN. */
3554 m2expr_AreRealOrComplexConstantsEqual (tree e1
, tree e2
)
3556 if (TREE_CODE (e1
) == COMPLEX_CST
)
3557 return (m2expr_AreRealOrComplexConstantsEqual (TREE_REALPART (e1
),
3559 && m2expr_AreRealOrComplexConstantsEqual (TREE_IMAGPART (e1
),
3560 TREE_IMAGPART (e2
)));
3562 return real_compare (EQ_EXPR
, &TREE_REAL_CST (e1
), &TREE_REAL_CST (e2
));
3565 /* DetermineSign, returns -1 if e<0 0 if e==0 1 if e>0
3566 an unsigned constant will never return -1. */
3569 m2expr_DetermineSign (tree e
)
3571 return tree_int_cst_sgn (e
);
3574 /* Similar to build_int_2 () but allows you to specify the type of
3575 the integer constant that you are creating. */
3578 build_int_2_type (HOST_WIDE_INT low
, HOST_WIDE_INT hi
, tree type
)
3581 HOST_WIDE_INT ival
[3];
3587 widest_int wval
= widest_int::from_array (ival
, 3);
3588 value
= wide_int_to_tree (type
, wval
);
3593 /* BuildCap - builds the Modula-2 function CAP(t) and returns the
3594 result in a gcc Tree. */
3597 m2expr_BuildCap (location_t location
, tree t
)
3600 tree out_of_range
, less_than
, greater_than
, translated
;
3602 m2assert_AssertLocation (location
);
3605 if (t
== error_mark_node
)
3606 return error_mark_node
;
3610 t
= fold (convert (m2type_GetM2CharType (), t
));
3612 if (TREE_CODE (tt
) == INTEGER_TYPE
)
3614 less_than
= fold (m2expr_build_binary_op (
3615 location
, LT_EXPR
, t
,
3616 build_int_2_type ('a', 0, m2type_GetM2CharType ()), 0));
3617 greater_than
= fold (m2expr_build_binary_op (
3618 location
, GT_EXPR
, t
,
3619 build_int_2_type ('z', 0, m2type_GetM2CharType ()), 0));
3620 out_of_range
= fold (m2expr_build_binary_op (
3621 location
, TRUTH_ORIF_EXPR
, less_than
, greater_than
, 0));
3623 translated
= fold (convert (
3624 m2type_GetM2CharType (),
3625 m2expr_build_binary_op (
3626 location
, MINUS_EXPR
, t
,
3627 build_int_2_type ('a' - 'A', 0, m2type_GetM2CharType ()), 0)));
3629 return fold_build3 (COND_EXPR
, m2type_GetM2CharType (), out_of_range
, t
,
3634 "argument to CAP is not a constant or variable of type CHAR");
3635 return error_mark_node
;
3638 /* BuildDivM2 if iso or pim4 then all modulus results are positive
3639 and the results from the division are rounded to the floor otherwise
3640 use BuildDivTrunc. */
3643 m2expr_BuildDivM2 (location_t location
, tree op1
, tree op2
,
3646 op1
= m2expr_FoldAndStrip (op1
);
3647 op2
= m2expr_FoldAndStrip (op2
);
3648 ASSERT_CONDITION (TREE_TYPE (op1
) == TREE_TYPE (op2
));
3649 /* If iso or pim4 then build and return ((op2 < 0) ? (op1
3650 divceil op2) : (op1 divfloor op2)) otherwise use divtrunc. */
3651 if (M2Options_GetPIM4 () || M2Options_GetISO ()
3652 || M2Options_GetPositiveModFloor ())
3653 return fold_build3 (
3654 COND_EXPR
, TREE_TYPE (op1
),
3655 m2expr_BuildLessThan (
3657 m2convert_BuildConvert (location
, TREE_TYPE (op2
),
3658 m2expr_GetIntegerZero (location
), false)),
3659 m2expr_BuildDivCeil (location
, op1
, op2
, needsconvert
),
3660 m2expr_BuildDivFloor (location
, op1
, op2
, needsconvert
));
3662 return m2expr_BuildDivTrunc (location
, op1
, op2
, needsconvert
);
3665 /* BuildDivM2Check - build and
3666 return ((op2 < 0) ? (op1 divtrunc op2) : (op1 divfloor op2))
3667 when -fiso, -fpim4 or -fpositive-mod-floor-div is present else
3668 return op1 div trunc op2. Use the checking div equivalents. */
3671 m2expr_BuildDivM2Check (location_t location
, tree op1
, tree op2
,
3672 tree lowest
, tree min
, tree max
)
3674 op1
= m2expr_FoldAndStrip (op1
);
3675 op2
= m2expr_FoldAndStrip (op2
);
3676 ASSERT_CONDITION (TREE_TYPE (op1
) == TREE_TYPE (op2
));
3677 if (M2Options_GetISO ()
3678 || M2Options_GetPIM4 () || M2Options_GetPositiveModFloor ())
3679 return fold_build3 (
3680 COND_EXPR
, TREE_TYPE (op1
),
3681 m2expr_BuildLessThan (
3683 m2convert_BuildConvert (location
, TREE_TYPE (op2
),
3684 m2expr_GetIntegerZero (location
), false)),
3685 m2expr_BuildDivCeilCheck (location
, op1
, op2
, lowest
, min
, max
),
3686 m2expr_BuildDivFloorCheck (location
, op1
, op2
, lowest
, min
, max
));
3688 return m2expr_BuildDivTruncCheck (location
, op1
, op2
, lowest
, min
, max
);
3693 m2expr_BuildISOModM2Check (location_t location
,
3694 tree op1
, tree op2
, tree lowest
, tree min
, tree max
)
3696 tree cond
= m2expr_BuildLessThan (location
, op2
,
3697 m2convert_BuildConvert (location
, TREE_TYPE (op2
),
3698 m2expr_GetIntegerZero (location
), false));
3700 /* Return the result of the modulus. */
3701 return fold_build3 (COND_EXPR
, TREE_TYPE (op1
), cond
,
3703 m2expr_BuildModCeilCheck (location
, op1
, op2
, lowest
, min
, max
),
3705 m2expr_BuildModFloorCheck (location
, op1
, op2
, lowest
, min
, max
));
3709 /* BuildModM2Check if iso or pim4 then build and return ((op2 < 0) ? (op1
3710 modceil op2) : (op1 modfloor op2)) otherwise use modtrunc.
3711 Use the checking mod equivalents. */
3714 m2expr_BuildModM2Check (location_t location
, tree op1
, tree op2
,
3715 tree lowest
, tree min
, tree max
)
3717 op1
= m2expr_FoldAndStrip (op1
);
3718 op2
= m2expr_FoldAndStrip (op2
);
3719 ASSERT_CONDITION (TREE_TYPE (op1
) == TREE_TYPE (op2
));
3720 if (M2Options_GetPIM4 () || M2Options_GetISO ()
3721 || M2Options_GetPositiveModFloor ())
3722 return m2expr_BuildISOModM2Check (location
, op1
, op2
, lowest
, min
, max
);
3724 return m2expr_BuildModTruncCheck (location
, op1
, op2
, lowest
, min
, max
);
3727 /* BuildModM2 if iso or pim4 then build and return ((op2 < 0) ? (op1
3728 modceil op2) : (op1 modfloor op2)) otherwise use modtrunc. */
3731 m2expr_BuildModM2 (location_t location
, tree op1
, tree op2
,
3734 op1
= m2expr_FoldAndStrip (op1
);
3735 op2
= m2expr_FoldAndStrip (op2
);
3736 ASSERT_CONDITION (TREE_TYPE (op1
) == TREE_TYPE (op2
));
3737 if (M2Options_GetPIM4 () || M2Options_GetISO ()
3738 || M2Options_GetPositiveModFloor ())
3739 return fold_build3 (
3740 COND_EXPR
, TREE_TYPE (op1
),
3741 m2expr_BuildLessThan (
3743 m2convert_BuildConvert (location
, TREE_TYPE (op2
),
3744 m2expr_GetIntegerZero (location
), false)),
3745 m2expr_BuildModCeil (location
, op1
, op2
, needsconvert
),
3746 m2expr_BuildModFloor (location
, op1
, op2
, needsconvert
));
3748 return m2expr_BuildModTrunc (location
, op1
, op2
, needsconvert
);
3751 /* BuildAbs build the Modula-2 function ABS(t) and return the result
3755 m2expr_BuildAbs (location_t location
, tree t
)
3757 m2assert_AssertLocation (location
);
3759 return m2expr_build_unary_op (location
, ABS_EXPR
, t
, 0);
3762 /* BuildRe build an expression for the function RE. */
3765 m2expr_BuildRe (tree op1
)
3767 op1
= m2expr_FoldAndStrip (op1
);
3768 if (TREE_CODE (op1
) == COMPLEX_CST
)
3769 return fold_build1 (REALPART_EXPR
, TREE_TYPE (TREE_TYPE (op1
)), op1
);
3771 return build1 (REALPART_EXPR
, TREE_TYPE (TREE_TYPE (op1
)), op1
);
3774 /* BuildIm build an expression for the function IM. */
3777 m2expr_BuildIm (tree op1
)
3779 op1
= m2expr_FoldAndStrip (op1
);
3780 if (TREE_CODE (op1
) == COMPLEX_CST
)
3781 return fold_build1 (IMAGPART_EXPR
, TREE_TYPE (TREE_TYPE (op1
)), op1
);
3783 return build1 (IMAGPART_EXPR
, TREE_TYPE (TREE_TYPE (op1
)), op1
);
3786 /* BuildCmplx build an expression for the function CMPLX. */
3789 m2expr_BuildCmplx (location_t location
, tree type
, tree real
, tree imag
)
3792 real
= m2expr_FoldAndStrip (real
);
3793 imag
= m2expr_FoldAndStrip (imag
);
3794 type
= m2tree_skip_type_decl (type
);
3795 scalor
= TREE_TYPE (type
);
3797 if (scalor
!= TREE_TYPE (real
))
3798 real
= m2convert_BuildConvert (location
, scalor
, real
, false);
3799 if (scalor
!= TREE_TYPE (imag
))
3800 imag
= m2convert_BuildConvert (location
, scalor
, imag
, false);
3802 if ((TREE_CODE (real
) == REAL_CST
) && (TREE_CODE (imag
) == REAL_CST
))
3803 return build_complex (type
, real
, imag
);
3805 return build2 (COMPLEX_EXPR
, type
, real
, imag
);
3808 /* BuildBinaryForeachWordDo implements the large set operators. Each
3809 word of the set can be calculated by binop. This function runs along
3810 each word of the large set invoking the binop. */
3813 m2expr_BuildBinaryForeachWordDo (location_t location
, tree type
, tree op1
,
3815 tree (*binop
) (location_t
, tree
, tree
, bool),
3816 bool is_op1lvalue
, bool is_op2lvalue
,
3817 bool is_op3lvalue
, bool is_op1const
,
3818 bool is_op2const
, bool is_op3const
)
3820 tree size
= m2expr_GetSizeOf (location
, type
);
3822 m2assert_AssertLocation (location
);
3824 ASSERT_BOOL (is_op1lvalue
);
3825 ASSERT_BOOL (is_op2lvalue
);
3826 ASSERT_BOOL (is_op3lvalue
);
3827 ASSERT_BOOL (is_op1const
);
3828 ASSERT_BOOL (is_op2const
);
3829 ASSERT_BOOL (is_op3const
);
3830 if (m2expr_CompareTrees (
3831 size
, m2decl_BuildIntegerConstant (SET_WORD_SIZE
/ BITS_PER_UNIT
))
3833 /* Small set size <= TSIZE(WORD). */
3834 m2statement_BuildAssignmentTree (
3835 location
, m2treelib_get_rvalue (location
, op1
, type
, is_op1lvalue
),
3837 location
, m2treelib_get_rvalue (location
, op2
, type
, is_op2lvalue
),
3838 m2treelib_get_rvalue (location
, op3
, type
, is_op3lvalue
), false));
3841 /* Large set size > TSIZE(WORD). */
3843 tree p2
= m2treelib_get_set_address_if_var (location
, op2
, is_op2lvalue
,
3845 tree p3
= m2treelib_get_set_address_if_var (location
, op3
, is_op3lvalue
,
3847 unsigned int fieldNo
= 0;
3848 tree field1
= m2treelib_get_field_no (type
, op1
, is_op1const
, fieldNo
);
3849 tree field2
= m2treelib_get_field_no (type
, op2
, is_op2const
, fieldNo
);
3850 tree field3
= m2treelib_get_field_no (type
, op3
, is_op3const
, fieldNo
);
3853 m2linemap_internal_error_at (
3855 "not expecting operand1 to be a constant set");
3857 while (field1
!= NULL
&& field2
!= NULL
&& field3
!= NULL
)
3859 m2statement_BuildAssignmentTree (
3860 location
, m2treelib_get_set_field_des (location
, op1
, field1
),
3863 m2treelib_get_set_value (location
, p2
, field2
, is_op2const
,
3864 is_op2lvalue
, op2
, fieldNo
),
3865 m2treelib_get_set_value (location
, p3
, field3
, is_op3const
,
3866 is_op3lvalue
, op3
, fieldNo
),
3869 field1
= m2treelib_get_field_no (type
, op1
, is_op1const
, fieldNo
);
3870 field2
= m2treelib_get_field_no (type
, op2
, is_op2const
, fieldNo
);
3871 field3
= m2treelib_get_field_no (type
, op3
, is_op3const
, fieldNo
);
3877 /* OverflowZType returns true if the ZTYPE str will exceed the
3878 internal representation. This routine is much faster (at
3879 least 2 orders of magnitude faster) than the char at a time overflow
3880 detection used in ToWideInt and so it should be
3881 used to filter out erroneously large constants before calling ToWideInt
3882 allowing a quick fail. */
3885 m2expr_OverflowZType (location_t location
, const char *str
, unsigned int base
,
3888 int length
= strlen (str
);
3889 bool overflow
= false;
3894 overflow
= ((length
-1) > WIDE_INT_MAX_PRECISION
);
3897 overflow
= (((length
-1) * 3) > WIDE_INT_MAX_PRECISION
);
3901 int str_log10
= length
;
3902 int bits_str
= (int) (((float) (str_log10
)) / log10f (2.0)) + 1;
3903 overflow
= (bits_str
> WIDE_INT_MAX_PRECISION
);
3907 overflow
= (((length
-1) * 4) > WIDE_INT_MAX_PRECISION
);
3912 if (issueError
&& overflow
)
3914 "constant literal %qs exceeds internal ZTYPE range", str
);
3919 /* ToWideInt converts a ZTYPE str value into result. */
3923 ToWideInt (location_t location
, const char *str
, unsigned int base
,
3924 widest_int
&result
, bool issueError
)
3926 tree type
= m2type_GetM2ZType ();
3928 wi::overflow_type overflow
= wi::OVF_NONE
;
3929 widest_int wbase
= wi::to_widest (m2decl_BuildIntegerConstant (base
));
3930 unsigned int digit
= 0;
3931 result
= wi::to_widest (m2decl_BuildIntegerConstant (0));
3932 bool base_specifier
= false;
3934 while (((str
[i
] != (char)0) && (overflow
== wi::OVF_NONE
))
3935 && (! base_specifier
))
3941 /* GNU m2 extension allows 'A' to represent binary literals. */
3944 base_specifier
= true;
3945 else if ((ch
< '0') || (ch
> '1'))
3949 "constant literal %qs contains %qc, expected 0 or 1",
3954 digit
= (unsigned int) (ch
- '0');
3957 /* An extension of 'B' indicates octal ZTYPE and 'C' octal character. */
3958 if ((ch
== 'B') || (ch
== 'C'))
3959 base_specifier
= true;
3960 else if ((ch
< '0') || (ch
> '7'))
3964 "constant literal %qs contains %qc, expected %qs",
3969 digit
= (unsigned int) (ch
- '0');
3972 if ((ch
< '0') || (ch
> '9'))
3976 "constant literal %qs contains %qc, expected %qs",
3981 digit
= (unsigned int) (ch
- '0');
3984 /* An extension of 'H' indicates hexidecimal ZTYPE. */
3986 base_specifier
= true;
3987 else if ((ch
>= '0') && (ch
<= '9'))
3988 digit
= (unsigned int) (ch
- '0');
3989 else if ((ch
>= 'A') && (ch
<= 'F'))
3990 digit
= ((unsigned int) (ch
- 'A')) + 10;
3995 "constant literal %qs contains %qc, expected %qs or %qs",
3996 str
, ch
, "0..9", "A..F");
4004 if (! base_specifier
)
4006 widest_int wdigit
= wi::to_widest (m2decl_BuildIntegerConstant (digit
));
4007 result
= wi::umul (result
, wbase
, &overflow
);
4008 if (overflow
== wi::OVF_NONE
)
4009 result
= wi::add (result
, wdigit
, UNSIGNED
, &overflow
);
4013 if (overflow
== wi::OVF_NONE
)
4015 tree value
= wide_int_to_tree (type
, result
);
4016 if (m2expr_TreeOverflow (value
))
4020 "constant literal %qs exceeds internal ZTYPE range", str
);
4029 "constant literal %qs exceeds internal ZTYPE range", str
);
4035 /* StrToWideInt return true if an overflow occurs when attempting to convert
4036 str to an unsigned ZTYPE the value is contained in the widest_int result.
4037 The value result is undefined if true is returned. */
4040 m2expr_StrToWideInt (location_t location
, const char *str
, unsigned int base
,
4041 widest_int
&result
, bool issueError
)
4043 if (m2expr_OverflowZType (location
, str
, base
, issueError
))
4045 return ToWideInt (location
, str
, base
, result
, issueError
);
4049 /* GetSizeOfInBits return the number of bits used to contain, type. */
4052 m2expr_GetSizeOfInBits (tree type
)
4054 enum tree_code code
= TREE_CODE (type
);
4056 if (code
== FUNCTION_TYPE
)
4057 return m2expr_GetSizeOfInBits (ptr_type_node
);
4059 if (code
== VOID_TYPE
)
4061 error ("%qs applied to a void type", "sizeof");
4062 return size_one_node
;
4065 if (code
== VAR_DECL
)
4066 return m2expr_GetSizeOfInBits (TREE_TYPE (type
));
4068 if (code
== PARM_DECL
)
4069 return m2expr_GetSizeOfInBits (TREE_TYPE (type
));
4071 if (code
== TYPE_DECL
)
4072 return m2expr_GetSizeOfInBits (TREE_TYPE (type
));
4074 if (code
== COMPONENT_REF
)
4075 return m2expr_GetSizeOfInBits (TREE_TYPE (type
));
4077 if (code
== ERROR_MARK
)
4078 return size_one_node
;
4080 if (!COMPLETE_TYPE_P (type
))
4082 error ("%qs applied to an incomplete type", "sizeof");
4083 return size_zero_node
;
4086 return m2decl_BuildIntegerConstant (TYPE_PRECISION (type
));
4089 /* GetSizeOf taken from c-typeck.cc (c_sizeof). */
4092 m2expr_GetSizeOf (location_t location
, tree type
)
4094 enum tree_code code
= TREE_CODE (type
);
4095 m2assert_AssertLocation (location
);
4097 if (code
== FUNCTION_TYPE
)
4098 return m2expr_GetSizeOf (location
, m2type_GetPointerType ());
4100 if (code
== VOID_TYPE
)
4101 return size_one_node
;
4103 if (code
== VAR_DECL
)
4104 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4106 if (code
== PARM_DECL
)
4107 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4109 if (code
== TYPE_DECL
)
4110 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4112 if (code
== ERROR_MARK
)
4113 return size_one_node
;
4115 if (code
== CONSTRUCTOR
)
4116 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4118 if (code
== FIELD_DECL
)
4119 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4121 if (code
== COMPONENT_REF
)
4122 return m2expr_GetSizeOf (location
, TREE_TYPE (type
));
4124 if (!COMPLETE_TYPE_P (type
))
4126 error_at (location
, "%qs applied to an incomplete type", "SIZE");
4127 return size_zero_node
;
4130 /* Convert in case a char is more than one unit. */
4131 return size_binop_loc (
4132 location
, CEIL_DIV_EXPR
, TYPE_SIZE_UNIT (type
),
4133 size_int (TYPE_PRECISION (char_type_node
) / BITS_PER_UNIT
));
4137 m2expr_GetIntegerZero (location_t location ATTRIBUTE_UNUSED
)
4139 return integer_zero_node
;
4143 m2expr_GetIntegerOne (location_t location ATTRIBUTE_UNUSED
)
4145 return integer_one_node
;
4149 m2expr_GetCardinalOne (location_t location
)
4151 return m2convert_ToCardinal (location
, integer_one_node
);
4155 m2expr_GetCardinalZero (location_t location
)
4157 return m2convert_ToCardinal (location
, integer_zero_node
);
4161 m2expr_GetWordZero (location_t location
)
4163 return m2convert_ToWord (location
, integer_zero_node
);
4167 m2expr_GetWordOne (location_t location
)
4169 return m2convert_ToWord (location
, integer_one_node
);
4173 m2expr_GetPointerZero (location_t location
)
4175 return m2convert_convertToPtr (location
, integer_zero_node
);
4179 m2expr_GetPointerOne (location_t location
)
4181 return m2convert_convertToPtr (location
, integer_one_node
);
4184 /* build_set_full_complement return a word size value with all bits
4188 build_set_full_complement (location_t location
)
4190 tree value
= integer_zero_node
;
4193 m2assert_AssertLocation (location
);
4195 for (i
= 0; i
< SET_WORD_SIZE
; i
++)
4197 value
= m2expr_BuildLogicalOr (
4200 location
, m2expr_GetWordOne (location
),
4201 m2convert_BuildConvert (location
, m2type_GetWordType (),
4202 m2decl_BuildIntegerConstant (i
), false),
4210 /* GetCstInteger return the integer value of the cst tree. */
4213 m2expr_GetCstInteger (tree cst
)
4215 return TREE_INT_CST_LOW (cst
);
4219 /* init initialise this module. */
4222 m2expr_init (location_t location
)
4224 m2assert_AssertLocation (location
);
4226 set_full_complement
= build_set_full_complement (location
);
4229 #include "gt-m2-m2expr.h"