Line data Source code
1 : /* m2convert.cc provides GCC tree conversion for the Modula-2 language.
2 :
3 : Copyright (C) 2012-2026 Free Software Foundation, Inc.
4 : Contributed by Gaius Mulley <gaius@glam.ac.uk>.
5 :
6 : This file is part of GNU Modula-2.
7 :
8 : GNU Modula-2 is free software; you can redistribute it and/or modify
9 : it under the terms of the GNU General Public License as published by
10 : the Free Software Foundation; either version 3, or (at your option)
11 : any later version.
12 :
13 : GNU Modula-2 is distributed in the hope that it will be useful, but
14 : WITHOUT ANY WARRANTY; without even the implied warranty of
15 : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 : General Public License for more details.
17 :
18 : You should have received a copy of the GNU General Public License
19 : along with GNU Modula-2; see the file COPYING3. If not see
20 : <http://www.gnu.org/licenses/>. */
21 :
22 : #include "gcc-consolidation.h"
23 :
24 : #include "../gm2-lang.h"
25 : #include "../m2-tree.h"
26 :
27 : #define m2convert_c
28 : #include "m2assert.h"
29 : #include "m2block.h"
30 : #include "m2convert.h"
31 : #include "m2decl.h"
32 : #include "m2expr.h"
33 : #include "m2expr.h"
34 : #include "m2statement.h"
35 : #include "m2tree.h"
36 : #include "m2treelib.h"
37 : #include "m2type.h"
38 :
39 : static tree const_to_ISO_type (location_t location, tree expr, tree iso_type);
40 : static tree const_to_ISO_aggregate_type (location_t location, tree expr,
41 : tree iso_type);
42 :
43 : /* These enumerators are possible types of unsafe conversions.
44 : SAFE_CONVERSION The conversion is safe UNSAFE_OTHER Another type of
45 : conversion with problems UNSAFE_SIGN Conversion between signed and
46 : unsigned integers which are all warned about immediately, so this is
47 : unused UNSAFE_REAL Conversions that reduce the precision of reals
48 : including conversions from reals to integers. */
49 : enum conversion_safety
50 : {
51 : SAFE_CONVERSION = 0,
52 : UNSAFE_OTHER,
53 : UNSAFE_SIGN,
54 : UNSAFE_REAL
55 : };
56 :
57 : /* ConvertString - converts string, expr, into a string of type,
58 : type. */
59 :
60 : tree
61 3312 : m2convert_ConvertString (tree type, tree expr)
62 : {
63 3312 : const char *str = TREE_STRING_POINTER (expr);
64 3312 : int len = TREE_STRING_LENGTH (expr);
65 3312 : return m2decl_BuildStringConstantType (len, str, type);
66 : }
67 :
68 :
69 : /* (Taken from c-common.cc and trimmed for Modula-2)
70 :
71 : Checks if expression EXPR of real/integer type cannot be converted to
72 : the real/integer type TYPE. Function returns non-zero when:
73 : EXPR is a constant which cannot be exactly converted to TYPE.
74 : EXPR is not a constant and size of EXPR's type > than size of
75 : TYPE, for EXPR type and TYPE being both integers or both real.
76 : EXPR is not a constant of real type and TYPE is an integer.
77 : EXPR is not a constant of integer type which cannot be exactly
78 : converted to real type. Function allows conversions between types
79 : of different signedness and can return SAFE_CONVERSION (zero) in
80 : that case. Function can produce signedness warnings if
81 : PRODUCE_WARNS is true. */
82 :
83 : enum conversion_safety
84 0 : unsafe_conversion_p (location_t loc, tree type, tree expr, bool produce_warns)
85 : {
86 0 : enum conversion_safety give_warning = SAFE_CONVERSION; /* Is 0 or false. */
87 0 : tree expr_type = TREE_TYPE (expr);
88 :
89 0 : if (TREE_CODE (expr) == REAL_CST || TREE_CODE (expr) == INTEGER_CST)
90 : {
91 :
92 : /* Warn for real constant that is not an exact integer converted to
93 : integer type. */
94 0 : if (SCALAR_FLOAT_TYPE_P (expr_type)
95 0 : && TREE_CODE (type) == INTEGER_TYPE)
96 : {
97 0 : if (!real_isinteger (TREE_REAL_CST_PTR (expr),
98 0 : TYPE_MODE (expr_type)))
99 0 : give_warning = UNSAFE_REAL;
100 : }
101 : /* Warn for an integer constant that does not fit into integer type. */
102 0 : else if (TREE_CODE (expr_type) == INTEGER_TYPE
103 0 : && TREE_CODE (type) == INTEGER_TYPE
104 0 : && !int_fits_type_p (expr, type))
105 : {
106 0 : if (TYPE_UNSIGNED (type) && !TYPE_UNSIGNED (expr_type)
107 0 : && tree_int_cst_sgn (expr) < 0)
108 : {
109 0 : if (produce_warns)
110 0 : warning_at (loc, OPT_Wsign_conversion,
111 : "negative integer"
112 : " implicitly converted to unsigned type");
113 : }
114 0 : else if (!TYPE_UNSIGNED (type) && TYPE_UNSIGNED (expr_type))
115 : {
116 0 : if (produce_warns)
117 0 : warning_at (loc, OPT_Wsign_conversion,
118 : "conversion of unsigned"
119 : " constant value to negative integer");
120 : }
121 : else
122 : give_warning = UNSAFE_OTHER;
123 : }
124 0 : else if (SCALAR_FLOAT_TYPE_P (type))
125 : {
126 : /* Warn for an integer constant that does not fit into real type. */
127 0 : if (TREE_CODE (expr_type) == INTEGER_TYPE)
128 : {
129 0 : REAL_VALUE_TYPE a = real_value_from_int_cst (0, expr);
130 0 : if (!exact_real_truncate (TYPE_MODE (type), &a))
131 0 : give_warning = UNSAFE_REAL;
132 : }
133 :
134 : /* Warn for a real constant that does not fit into a smaller real
135 : type. */
136 0 : else if (SCALAR_FLOAT_TYPE_P (expr_type)
137 0 : && TYPE_PRECISION (type) < TYPE_PRECISION (expr_type))
138 : {
139 0 : REAL_VALUE_TYPE a = TREE_REAL_CST (expr);
140 0 : if (!exact_real_truncate (TYPE_MODE (type), &a))
141 0 : give_warning = UNSAFE_REAL;
142 : }
143 : }
144 : }
145 : else
146 : {
147 : /* Warn for real types converted to integer types. */
148 0 : if (SCALAR_FLOAT_TYPE_P (expr_type)
149 0 : && TREE_CODE (type) == INTEGER_TYPE)
150 0 : give_warning = UNSAFE_REAL;
151 :
152 : }
153 :
154 0 : return give_warning;
155 : }
156 :
157 : /* (Taken from c-common.cc and trimmed for Modula-2)
158 :
159 : Warns if the conversion of EXPR to TYPE may alter a value. This is
160 : a helper function for warnings_for_convert_and_check. */
161 :
162 : static void
163 1021699 : conversion_warning (location_t loc, tree type, tree expr)
164 : {
165 1021699 : tree expr_type = TREE_TYPE (expr);
166 1021699 : enum conversion_safety conversion_kind;
167 :
168 1021699 : if (!warn_conversion && !warn_sign_conversion && !warn_float_conversion)
169 : return;
170 :
171 0 : switch (TREE_CODE (expr))
172 : {
173 0 : case EQ_EXPR:
174 0 : case NE_EXPR:
175 0 : case LE_EXPR:
176 0 : case GE_EXPR:
177 0 : case LT_EXPR:
178 0 : case GT_EXPR:
179 0 : case TRUTH_ANDIF_EXPR:
180 0 : case TRUTH_ORIF_EXPR:
181 0 : case TRUTH_AND_EXPR:
182 0 : case TRUTH_OR_EXPR:
183 0 : case TRUTH_XOR_EXPR:
184 0 : case TRUTH_NOT_EXPR:
185 :
186 : /* Conversion from boolean to a signed:1 bit-field (which only can
187 : hold the values 0 and -1) doesn't lose information - but it does
188 : change the value. */
189 0 : if (TYPE_PRECISION (type) == 1 && !TYPE_UNSIGNED (type))
190 0 : warning_at (loc, OPT_Wconversion,
191 : "conversion to %qT from boolean expression", type);
192 : return;
193 :
194 0 : case REAL_CST:
195 0 : case INTEGER_CST:
196 0 : conversion_kind = unsafe_conversion_p (loc, type, expr, true);
197 0 : if (conversion_kind == UNSAFE_REAL)
198 0 : warning_at (loc, OPT_Wfloat_conversion,
199 : "conversion to %qT alters %qT constant value", type,
200 : expr_type);
201 0 : else if (conversion_kind)
202 0 : warning_at (loc, OPT_Wconversion,
203 : "conversion to %qT alters %qT constant value", type,
204 : expr_type);
205 : return;
206 :
207 0 : case COND_EXPR:
208 0 : {
209 :
210 : /* In case of COND_EXPR, we do not care about the type of COND_EXPR,
211 : only about the conversion of each operand. */
212 0 : tree op1 = TREE_OPERAND (expr, 1);
213 0 : tree op2 = TREE_OPERAND (expr, 2);
214 :
215 0 : conversion_warning (loc, type, op1);
216 0 : conversion_warning (loc, type, op2);
217 0 : return;
218 : }
219 :
220 0 : default: /* 'expr' is not a constant. */
221 0 : conversion_kind = unsafe_conversion_p (loc, type, expr, true);
222 0 : if (conversion_kind == UNSAFE_REAL)
223 0 : warning_at (loc, OPT_Wfloat_conversion,
224 : "conversion to %qT from %qT may alter its value", type,
225 : expr_type);
226 0 : else if (conversion_kind)
227 0 : warning_at (loc, OPT_Wconversion,
228 : "conversion to %qT from %qT may alter its value", type,
229 : expr_type);
230 : }
231 : }
232 :
233 : /* (Taken from c-common.cc and trimmed for Modula-2)
234 :
235 : Produce warnings after a conversion. RESULT is the result of
236 : converting EXPR to TYPE. This is a helper function for
237 : convert_and_check and cp_convert_and_check. */
238 :
239 : void
240 1021699 : warnings_for_convert_and_check (location_t loc, tree type, tree expr,
241 : tree result)
242 : {
243 1021699 : if (TREE_CODE (expr) == INTEGER_CST && (TREE_CODE (type) == INTEGER_TYPE
244 7148 : || TREE_CODE (type) == ENUMERAL_TYPE)
245 966983 : && !int_fits_type_p (expr, type))
246 : {
247 :
248 : /* Do not diagnose overflow in a constant expression merely because a
249 : conversion overflowed. */
250 104 : if (TREE_OVERFLOW (result))
251 0 : TREE_OVERFLOW (result) = TREE_OVERFLOW (expr);
252 :
253 104 : if (TYPE_UNSIGNED (type))
254 : {
255 :
256 : /* This detects cases like converting -129 or 256 to unsigned
257 : char. */
258 50 : if (!int_fits_type_p (expr, m2type_gm2_signed_type (type)))
259 0 : warning_at (loc, OPT_Woverflow,
260 : "large integer implicitly truncated to unsigned type");
261 : else
262 50 : conversion_warning (loc, type, expr);
263 : }
264 54 : else if (!int_fits_type_p (expr, m2type_gm2_unsigned_type (type)))
265 0 : warning_at (loc, OPT_Woverflow,
266 : "overflow in implicit constant conversion");
267 : /* No warning for converting 0x80000000 to int. */
268 54 : else if (pedantic && (TREE_CODE (TREE_TYPE (expr)) != INTEGER_TYPE
269 0 : || TYPE_PRECISION (TREE_TYPE (expr))
270 0 : != TYPE_PRECISION (type)))
271 0 : warning_at (loc, OPT_Woverflow,
272 : "overflow in implicit constant conversion");
273 :
274 : else
275 54 : conversion_warning (loc, type, expr);
276 : }
277 1021595 : else if ((TREE_CODE (result) == INTEGER_CST
278 51668 : || TREE_CODE (result) == FIXED_CST)
279 1021595 : && TREE_OVERFLOW (result))
280 0 : warning_at (loc, OPT_Woverflow,
281 : "overflow in implicit constant conversion");
282 : else
283 1021595 : conversion_warning (loc, type, expr);
284 1021699 : }
285 :
286 : /* (Taken from c-common.cc and trimmed for Modula-2)
287 :
288 : Convert EXPR to TYPE, warning about conversion problems with
289 : constants. Invoke this function on every expression that is
290 : converted implicitly, i.e. because of language rules and not
291 : because of an explicit cast. */
292 :
293 : static tree
294 1404219 : convert_and_check (location_t loc, tree type, tree expr)
295 : {
296 1404219 : tree result;
297 1404219 : tree expr_for_warning;
298 :
299 : /* Convert from a value with possible excess precision rather than
300 : via the semantic type, but do not warn about values not fitting
301 : exactly in the semantic type. */
302 1404219 : if (TREE_CODE (expr) == EXCESS_PRECISION_EXPR)
303 : {
304 0 : tree orig_type = TREE_TYPE (expr);
305 0 : expr = TREE_OPERAND (expr, 0);
306 0 : expr_for_warning = convert (orig_type, expr);
307 0 : if (orig_type == type)
308 : return expr_for_warning;
309 : }
310 : else
311 : expr_for_warning = expr;
312 :
313 1404219 : if (TREE_TYPE (expr) == type)
314 : return expr;
315 :
316 1021705 : result = convert_loc (loc, type, expr);
317 :
318 1021705 : if (!TREE_OVERFLOW_P (expr) && result != error_mark_node)
319 1021699 : warnings_for_convert_and_check (loc, type, expr_for_warning, result);
320 :
321 : return result;
322 : }
323 :
324 :
325 : static tree
326 12 : doOrdinal (tree value)
327 : {
328 12 : if (TREE_CODE (value) == STRING_CST && (m2expr_StringLength (value) <= 1))
329 : {
330 12 : const char *p = TREE_STRING_POINTER (value);
331 12 : int i = p[0];
332 :
333 12 : return m2decl_BuildIntegerConstant (i);
334 : }
335 : return value;
336 : }
337 :
338 : static int
339 3765497 : same_size_types (location_t location, tree t1, tree t2)
340 : {
341 3765497 : tree n1 = m2expr_GetSizeOf (location, t1);
342 3765497 : tree n2 = m2expr_GetSizeOf (location, t2);
343 :
344 3765497 : return m2expr_CompareTrees (n1, n2) == 0;
345 : }
346 :
347 : /* converting_ISO_generic attempts to convert value to type and returns true
348 : if successful. This is a helper function to BuildConvert which will try
349 : each generic data type in turn.
350 :
351 : generic_type will be set to any of ISO BYTE, PIM BYTE WORD, etc.
352 : If type == generic_type then specific conversion procedures
353 : are applied. A constant will be converted via const_to_ISO_type
354 : whereas non constants are converted by *(type *) &value.
355 :
356 : Remember that in ISO M2 BYTE is an ARRAY [0..0] OF LOC. */
357 :
358 : static int
359 53635581 : converting_ISO_generic (location_t location, tree type, tree value,
360 : tree generic_type, tree *result)
361 : {
362 53635581 : tree value_type = m2tree_skip_type_decl (TREE_TYPE (value));
363 :
364 53635581 : if (value_type == type)
365 : /* We let the caller deal with this. */
366 : return false;
367 :
368 24080664 : if (TREE_CODE (value) == INTEGER_CST)
369 : {
370 20315167 : if (type == generic_type)
371 : {
372 153778 : *result = const_to_ISO_type (location, value, generic_type);
373 153778 : return true;
374 : }
375 : /* We must not attempt to convert a constant by taking its
376 : address below, so we bail out here. */
377 : return false;
378 : }
379 :
380 3765497 : if (same_size_types (location, type, value_type))
381 : {
382 3443105 : if (value_type == generic_type)
383 : {
384 532 : tree pt = build_pointer_type (type);
385 532 : tree a = build1 (ADDR_EXPR, pt, value);
386 532 : tree t = build1 (INDIRECT_REF, type, a);
387 532 : *result = build1 (NOP_EXPR, type, t);
388 532 : return true;
389 : }
390 3442573 : else if (type == generic_type)
391 : {
392 812 : tree pt = build_pointer_type (type);
393 812 : tree a = build1 (ADDR_EXPR, pt, value);
394 812 : tree t = build1 (INDIRECT_REF, type, a);
395 812 : *result = build1 (NOP_EXPR, type, t);
396 812 : return true;
397 : }
398 : }
399 : return false;
400 : }
401 :
402 : /* convert_char_to_array convert a single char value into a type.
403 : The type will be array [..] of char. The array type
404 : returned will have nuls appended to pad the single char to the
405 : correct array length. */
406 :
407 : static tree
408 24 : convert_char_to_array (location_t location, tree type, tree value)
409 : {
410 24 : tree i = m2decl_BuildIntegerConstant (0);
411 24 : struct struct_constructor *c
412 24 : = (struct struct_constructor *)m2type_BuildStartArrayConstructor (type);
413 24 : tree n = m2type_GetArrayNoOfElements (location, type);
414 24 : char nul[1];
415 :
416 24 : nul[0] = (char)0;
417 :
418 : /* Store the initial char. */
419 24 : m2type_BuildArrayConstructorElement (c, value, i);
420 24 : i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1), false);
421 :
422 : /* Now pad out the remaining elements with nul chars. */
423 480 : while (m2expr_CompareTrees (i, n) < 0)
424 : {
425 432 : m2type_BuildArrayConstructorElement (
426 : c, m2type_BuildCharConstant (location, &nul[0]), i);
427 432 : i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
428 : false);
429 : }
430 24 : return m2type_BuildEndArrayConstructor (c);
431 : }
432 :
433 : /* convert_string_to_array - convert a STRING_CST into an array type.
434 : array [..] of char. The array constant returned will have nuls
435 : appended to pad the contents to the correct length. */
436 :
437 : static tree
438 0 : convert_string_to_array (location_t location, tree type, tree value)
439 : {
440 0 : tree n = m2type_GetArrayNoOfElements (location, type);
441 :
442 0 : return m2type_BuildArrayStringConstructor (location, type, value, n);
443 : }
444 :
445 : /* BuildConvert - build and return tree VAL (type, value).
446 : checkOverflow determines whether we should suppress overflow
447 : checking. */
448 :
449 : tree
450 7785133 : m2convert_BuildConvert (location_t location, tree type, tree value,
451 : bool checkOverflow)
452 : {
453 7785133 : type = m2tree_skip_type_decl (type);
454 7785133 : tree t;
455 :
456 7785133 : value = fold (value);
457 7785133 : STRIP_NOPS (value);
458 7785133 : value = m2expr_FoldAndStrip (value);
459 :
460 12 : if (TREE_CODE (value) == STRING_CST && (m2expr_StringLength (value) <= 1)
461 7785145 : && (m2tree_IsOrdinal (type)))
462 12 : value = doOrdinal (value);
463 7785121 : else if (TREE_CODE (value) == FUNCTION_DECL && TREE_TYPE (value) != type)
464 30 : value = m2expr_BuildAddr (0, value, false);
465 :
466 7785133 : if (converting_ISO_generic (location, type, value, m2type_GetByteType (), &t)
467 7700393 : || converting_ISO_generic (location, type, value,
468 : m2type_GetISOLocType (), &t)
469 7630011 : || converting_ISO_generic (location, type, value,
470 : m2type_GetISOByteType (), &t)
471 7630011 : || converting_ISO_generic (location, type, value,
472 : m2type_GetISOWordType (), &t)
473 7630011 : || converting_ISO_generic (location, type, value, m2type_GetM2Word16 (),
474 : &t)
475 7630011 : || converting_ISO_generic (location, type, value, m2type_GetM2Word32 (),
476 : &t)
477 15415144 : || converting_ISO_generic (location, type, value, m2type_GetM2Word64 (),
478 : &t))
479 155122 : return t;
480 :
481 7630011 : if (TREE_CODE (type) == ARRAY_TYPE
482 7630011 : && TREE_TYPE (type) == m2type_GetM2CharType ())
483 : {
484 66 : if (TREE_TYPE (value) == m2type_GetM2CharType ())
485 :
486 : /* Passing a const char to an array [..] of char. So we convert
487 : const char into the correct length string. */
488 24 : return convert_char_to_array (location, type, value);
489 42 : if (TREE_CODE (value) == STRING_CST)
490 : /* Convert a string into an array constant, padding with zeros if
491 : necessary. */
492 0 : return convert_string_to_array (location, type, value);
493 : }
494 :
495 7629987 : if (checkOverflow)
496 680602 : return convert_and_check (location, type, value);
497 : else
498 6949385 : return convert_loc (location, type, value);
499 : }
500 :
501 : /* const_to_ISO_type - perform VAL (iso_type, expr). */
502 :
503 : static tree
504 153812 : const_to_ISO_type (location_t location, tree expr, tree iso_type)
505 : {
506 153812 : tree n = m2expr_GetSizeOf (location, iso_type);
507 :
508 153812 : if ((m2expr_CompareTrees (n, m2decl_BuildIntegerConstant (1)) == 0)
509 153812 : && (iso_type == m2type_GetByteType ()
510 70374 : || iso_type == m2type_GetISOLocType ()
511 0 : || iso_type == m2type_GetISOByteType ()))
512 153788 : return build1 (NOP_EXPR, iso_type, expr);
513 24 : return const_to_ISO_aggregate_type (location, expr, iso_type);
514 : }
515 :
516 : /* const_to_ISO_aggregate_type - perform VAL (iso_type, expr). The
517 : iso_type will be declared by the SYSTEM module as: TYPE iso_type =
518 : ARRAY [0..n] OF LOC
519 :
520 : this function will store a constant into the iso_type in the correct
521 : endian order. It converts the expr into a unsigned int or signed
522 : int and then strips it a byte at a time. */
523 :
524 : static tree
525 24 : const_to_ISO_aggregate_type (location_t location, tree expr, tree iso_type)
526 : {
527 24 : tree byte;
528 24 : m2type_Constructor c;
529 24 : tree i = m2decl_BuildIntegerConstant (0);
530 24 : tree n = m2expr_GetSizeOf (location, iso_type);
531 24 : tree max_uint = m2decl_BuildIntegerConstant (256);
532 :
533 144 : while (m2expr_CompareTrees (i, n) < 0)
534 : {
535 96 : max_uint = m2expr_BuildMult (location, max_uint,
536 : m2decl_BuildIntegerConstant (256), false);
537 96 : i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
538 : false);
539 : }
540 24 : max_uint = m2expr_BuildDivFloor (location, max_uint,
541 : m2decl_BuildIntegerConstant (2), false);
542 :
543 24 : if (m2expr_CompareTrees (expr, m2decl_BuildIntegerConstant (0)) < 0)
544 0 : expr = m2expr_BuildAdd (location, expr, max_uint, false);
545 :
546 24 : i = m2decl_BuildIntegerConstant (0);
547 24 : c = m2type_BuildStartArrayConstructor (iso_type);
548 144 : while (m2expr_CompareTrees (i, n) < 0)
549 : {
550 96 : byte = m2expr_BuildModTrunc (location, expr,
551 : m2decl_BuildIntegerConstant (256), false);
552 96 : if (BYTES_BIG_ENDIAN)
553 : m2type_BuildArrayConstructorElement (
554 : c, m2convert_ToLoc (location, byte),
555 : m2expr_BuildSub (location, m2expr_BuildSub (location, n, i, false),
556 : m2decl_BuildIntegerConstant (1), false));
557 : else
558 96 : m2type_BuildArrayConstructorElement (
559 : c, m2convert_ToLoc (location, byte), i);
560 :
561 96 : i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
562 : false);
563 96 : expr = m2expr_BuildDivFloor (location, expr,
564 : m2decl_BuildIntegerConstant (256), false);
565 : }
566 :
567 24 : return m2type_BuildEndArrayConstructor (c);
568 : }
569 :
570 : /* ConvertConstantAndCheck - in Modula-2 sementics: RETURN( VAL(type,
571 : expr) ). Only to be used for a constant expr, overflow checking
572 : is performed. */
573 :
574 : tree
575 1782783 : m2convert_ConvertConstantAndCheck (location_t location, tree type, tree expr)
576 : {
577 1782783 : tree etype;
578 1782783 : expr = fold (expr);
579 1782783 : STRIP_NOPS (expr);
580 1782783 : expr = m2expr_FoldAndStrip (expr);
581 1782783 : etype = TREE_TYPE (expr);
582 :
583 1782783 : m2assert_AssertLocation (location);
584 1782783 : if (etype == type)
585 : return expr;
586 :
587 723651 : if (TREE_CODE (expr) == FUNCTION_DECL)
588 0 : expr = m2expr_BuildAddr (location, expr, false);
589 :
590 723651 : type = m2tree_skip_type_decl (type);
591 1447292 : if (type == m2type_GetByteType () || type == m2type_GetISOLocType ()
592 723641 : || type == m2type_GetISOByteType () || type == m2type_GetISOWordType ()
593 723617 : || type == m2type_GetM2Word16 () || type == m2type_GetM2Word32 ()
594 1447268 : || type == m2type_GetM2Word64 ())
595 34 : return const_to_ISO_type (location, expr, type);
596 :
597 723617 : return convert_and_check (location, type, m2expr_FoldAndStrip (expr));
598 : }
599 :
600 : /* ToWord - converts an expression (Integer or Ordinal type) into a
601 : WORD. */
602 :
603 : tree
604 532654 : m2convert_ToWord (location_t location, tree expr)
605 : {
606 532654 : return m2convert_BuildConvert (location, m2type_GetWordType (), expr, false);
607 : }
608 :
609 : /* ToCardinal - convert an expression, expr, to a CARDINAL. */
610 :
611 : tree
612 196950 : m2convert_ToCardinal (location_t location, tree expr)
613 : {
614 196950 : return m2convert_BuildConvert (location, m2type_GetCardinalType (), expr,
615 196950 : false);
616 : }
617 :
618 : /* convertToPtr - if the type of tree, t, is not a ptr_type_node then
619 : convert it. */
620 :
621 : tree
622 81492 : m2convert_convertToPtr (location_t location, tree type)
623 : {
624 81492 : if (TREE_CODE (TREE_TYPE (type)) == POINTER_TYPE)
625 : return type;
626 : else
627 81492 : return m2convert_BuildConvert (location, m2type_GetPointerType (), type,
628 81492 : false);
629 : }
630 :
631 : /* ToInteger - convert an expression, expr, to an INTEGER. */
632 :
633 : tree
634 500298 : m2convert_ToInteger (location_t location, tree expr)
635 : {
636 500298 : return m2convert_BuildConvert (location, m2type_GetIntegerType (), expr,
637 500298 : false);
638 : }
639 :
640 : /* ToBitset - convert an expression, expr, to a BITSET type. */
641 :
642 : tree
643 14706 : m2convert_ToBitset (location_t location, tree expr)
644 : {
645 14706 : return m2convert_BuildConvert (location, m2type_GetBitsetType (), expr,
646 14706 : false);
647 : }
648 :
649 : /* ToLoc - convert an expression, expr, to a LOC. */
650 :
651 : tree
652 96 : m2convert_ToLoc (location_t location, tree expr)
653 : {
654 96 : return m2convert_BuildConvert (location, m2type_GetISOByteType (), expr,
655 96 : false);
656 : }
657 :
658 : /* ToPIMByte - convert an expression expr to a PIM BYTE. */
659 :
660 : tree
661 83338 : m2convert_ToPIMByte (location_t location, tree expr)
662 : {
663 83338 : return m2convert_BuildConvert (location, m2type_GetByteType (), expr,
664 83338 : false);
665 : }
666 :
667 : /* GenericToType - converts, expr, into, type, providing that expr is
668 : a generic system type (byte, word etc). Otherwise expr is
669 : returned unaltered. */
670 :
671 : tree
672 4223231 : m2convert_GenericToType (location_t location, tree type, tree expr)
673 : {
674 4223231 : tree etype = TREE_TYPE (expr);
675 :
676 4223231 : type = m2tree_skip_type_decl (type);
677 4223231 : if (type == etype)
678 : return expr;
679 :
680 8446462 : if (type == m2type_GetISOWordType () || type == m2type_GetM2Word16 ()
681 8446462 : || type == m2type_GetM2Word32 () || type == m2type_GetM2Word64 ())
682 0 : return const_to_ISO_type (location, expr, type);
683 :
684 : return expr;
685 : }
|
