LCOV - code coverage report
Current view: top level - gcc/m2/gm2-gcc - m2convert.cc (source / functions) Coverage Total Hit
Test: gcc.info Lines: 65.7 % 254 167
Test Date: 2024-07-13 14:16:58 Functions: 90.5 % 21 19
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: - 0 0

             Branch data     Line data    Source code
       1                 :             : /* m2convert.cc provides GCC tree conversion for the Modula-2 language.
       2                 :             : 
       3                 :             : Copyright (C) 2012-2024 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                 :        3294 : m2convert_ConvertString (tree type, tree expr)
      62                 :             : {
      63                 :        3294 :   const char *str = TREE_STRING_POINTER (expr);
      64                 :        3294 :   int len = TREE_STRING_LENGTH (expr);
      65                 :        3294 :   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                 :      781688 : conversion_warning (location_t loc, tree type, tree expr)
     164                 :             : {
     165                 :      781688 :   tree expr_type = TREE_TYPE (expr);
     166                 :      781688 :   enum conversion_safety conversion_kind;
     167                 :             : 
     168                 :      781688 :   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                 :      781688 : warnings_for_convert_and_check (location_t loc, tree type, tree expr,
     241                 :             :                                 tree result)
     242                 :             : {
     243                 :      781688 :   if (TREE_CODE (expr) == INTEGER_CST && (TREE_CODE (type) == INTEGER_TYPE
     244                 :        7658 :                                           || TREE_CODE (type) == ENUMERAL_TYPE)
     245                 :      736958 :       && !int_fits_type_p (expr, type))
     246                 :             :     {
     247                 :             : 
     248                 :             :       /* Do not diagnose overflow in a constant expression merely because a
     249                 :             :          conversion overflowed.  */
     250                 :          56 :       if (TREE_OVERFLOW (result))
     251                 :           0 :         TREE_OVERFLOW (result) = TREE_OVERFLOW (expr);
     252                 :             : 
     253                 :          56 :       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                 :           6 :       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                 :           6 :       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                 :           6 :         conversion_warning (loc, type, expr);
     276                 :             :     }
     277                 :      781632 :   else if ((TREE_CODE (result) == INTEGER_CST
     278                 :       41550 :             || TREE_CODE (result) == FIXED_CST)
     279                 :      781632 :            && TREE_OVERFLOW (result))
     280                 :           0 :     warning_at (loc, OPT_Woverflow,
     281                 :             :                 "overflow in implicit constant conversion");
     282                 :             :   else
     283                 :      781632 :     conversion_warning (loc, type, expr);
     284                 :      781688 : }
     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                 :     1031162 : convert_and_check (location_t loc, tree type, tree expr)
     295                 :             : {
     296                 :     1031162 :   tree result;
     297                 :     1031162 :   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                 :     1031162 :   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                 :     1031162 :   if (TREE_TYPE (expr) == type)
     314                 :             :     return expr;
     315                 :             : 
     316                 :      781694 :   result = convert_loc (loc, type, expr);
     317                 :             : 
     318                 :      781694 :   if (!TREE_OVERFLOW_P (expr) && result != error_mark_node)
     319                 :      781688 :     warnings_for_convert_and_check (loc, type, expr_for_warning, result);
     320                 :             : 
     321                 :             :   return result;
     322                 :             : }
     323                 :             : 
     324                 :             : 
     325                 :             : static tree
     326                 :           6 : doOrdinal (tree value)
     327                 :             : {
     328                 :           6 :   if (TREE_CODE (value) == STRING_CST && (m2expr_StringLength (value) <= 1))
     329                 :             :     {
     330                 :           6 :       const char *p = TREE_STRING_POINTER (value);
     331                 :           6 :       int i = p[0];
     332                 :             : 
     333                 :           6 :       return m2decl_BuildIntegerConstant (i);
     334                 :             :     }
     335                 :             :   return value;
     336                 :             : }
     337                 :             : 
     338                 :             : static int
     339                 :    19137337 : same_size_types (location_t location, tree t1, tree t2)
     340                 :             : {
     341                 :    19137337 :   tree n1 = m2expr_GetSizeOf (location, t1);
     342                 :    19137337 :   tree n2 = m2expr_GetSizeOf (location, t2);
     343                 :             : 
     344                 :    19137337 :   return m2expr_CompareTrees (n1, n2) == 0;
     345                 :             : }
     346                 :             : 
     347                 :             : static int
     348                 :    44184741 : converting_ISO_generic (location_t location, tree type, tree value,
     349                 :             :                         tree generic_type, tree *result)
     350                 :             : {
     351                 :    44184741 :   tree value_type = m2tree_skip_type_decl (TREE_TYPE (value));
     352                 :             : 
     353                 :    44184741 :   if (value_type == type)
     354                 :             :     /* We let the caller deal with this.  */
     355                 :             :     return false;
     356                 :             : 
     357                 :    19137481 :   if ((TREE_CODE (value) == INTEGER_CST) && (type == generic_type))
     358                 :             :     {
     359                 :         144 :       *result = const_to_ISO_type (location, value, generic_type);
     360                 :         144 :       return true;
     361                 :             :     }
     362                 :             : 
     363                 :    19137337 :   if (same_size_types (location, type, value_type))
     364                 :             :     {
     365                 :    13197017 :       if (value_type == generic_type)
     366                 :             :         {
     367                 :         168 :           tree pt = build_pointer_type (type);
     368                 :         168 :           tree a = build1 (ADDR_EXPR, pt, value);
     369                 :         168 :           tree t = build1 (INDIRECT_REF, type, a);
     370                 :         168 :           *result = build1 (NOP_EXPR, type, t);
     371                 :         168 :           return true;
     372                 :             :         }
     373                 :    13196849 :       else if (type == generic_type)
     374                 :             :         {
     375                 :         168 :           tree pt = build_pointer_type (type);
     376                 :         168 :           tree a = build1 (ADDR_EXPR, pt, value);
     377                 :         168 :           tree t = build1 (INDIRECT_REF, type, a);
     378                 :         168 :           *result = build1 (NOP_EXPR, type, t);
     379                 :         168 :           return true;
     380                 :             :         }
     381                 :             :     }
     382                 :             :   return false;
     383                 :             : }
     384                 :             : 
     385                 :             : /* convert_char_to_array - convert a single char, value, into an
     386                 :             :    type.  The type will be array [..] of char.  The array type
     387                 :             :    returned will have nuls appended to pad the single char to the
     388                 :             :    correct array length.  */
     389                 :             : 
     390                 :             : static tree
     391                 :          24 : convert_char_to_array (location_t location, tree type, tree value)
     392                 :             : {
     393                 :          24 :   tree i = m2decl_BuildIntegerConstant (0);
     394                 :          24 :   struct struct_constructor *c
     395                 :          24 :       = (struct struct_constructor *)m2type_BuildStartArrayConstructor (type);
     396                 :          24 :   tree n = m2type_GetArrayNoOfElements (location, type);
     397                 :          24 :   char nul[1];
     398                 :             : 
     399                 :          24 :   nul[0] = (char)0;
     400                 :             : 
     401                 :             :   /* Store the initial char.  */
     402                 :          24 :   m2type_BuildArrayConstructorElement (c, value, i);
     403                 :          24 :   i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1), false);
     404                 :             : 
     405                 :             :   /* Now pad out the remaining elements with nul chars.  */
     406                 :         480 :   while (m2expr_CompareTrees (i, n) < 0)
     407                 :             :     {
     408                 :         432 :       m2type_BuildArrayConstructorElement (
     409                 :             :           c, m2type_BuildCharConstant (location, &nul[0]), i);
     410                 :         432 :       i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
     411                 :             :                            false);
     412                 :             :     }
     413                 :          24 :   return m2type_BuildEndArrayConstructor (c);
     414                 :             : }
     415                 :             : 
     416                 :             : /* convert_string_to_array - convert a STRING_CST into an array type.
     417                 :             :    array [..] of char.  The array constant returned will have nuls
     418                 :             :    appended to pad the contents to the correct length.  */
     419                 :             : 
     420                 :             : static tree
     421                 :           0 : convert_string_to_array (location_t location, tree type, tree value)
     422                 :             : {
     423                 :           0 :   tree n = m2type_GetArrayNoOfElements (location, type);
     424                 :             : 
     425                 :           0 :   return m2type_BuildArrayStringConstructor (location, type, value, n);
     426                 :             : }
     427                 :             : 
     428                 :             : /* BuildConvert - build and return tree VAL (type, value).
     429                 :             :    checkOverflow determines whether we should suppress overflow
     430                 :             :    checking.  */
     431                 :             : 
     432                 :             : tree
     433                 :     6312505 : m2convert_BuildConvert (location_t location, tree type, tree value,
     434                 :             :                         bool checkOverflow)
     435                 :             : {
     436                 :     6312505 :   type = m2tree_skip_type_decl (type);
     437                 :     6312505 :   tree t;
     438                 :             : 
     439                 :     6312505 :   value = fold (value);
     440                 :     6312505 :   STRIP_NOPS (value);
     441                 :     6312505 :   value = m2expr_FoldAndStrip (value);
     442                 :             : 
     443                 :           6 :   if (TREE_CODE (value) == STRING_CST && (m2expr_StringLength (value) <= 1)
     444                 :     6312511 :       && (m2tree_IsOrdinal (type)))
     445                 :           6 :     value = doOrdinal (value);
     446                 :     6312499 :   else if (TREE_CODE (value) == FUNCTION_DECL && TREE_TYPE (value) != type)
     447                 :          30 :     value = m2expr_BuildAddr (0, value, false);
     448                 :             : 
     449                 :     6312505 :   if (converting_ISO_generic (location, type, value, m2type_GetByteType (), &t)
     450                 :     6312111 :       || converting_ISO_generic (location, type, value,
     451                 :             :                                  m2type_GetISOLocType (), &t)
     452                 :     6312025 :       || converting_ISO_generic (location, type, value,
     453                 :             :                                  m2type_GetISOByteType (), &t)
     454                 :     6312025 :       || converting_ISO_generic (location, type, value,
     455                 :             :                                  m2type_GetISOWordType (), &t)
     456                 :     6312025 :       || converting_ISO_generic (location, type, value, m2type_GetM2Word16 (),
     457                 :             :                                  &t)
     458                 :     6312025 :       || converting_ISO_generic (location, type, value, m2type_GetM2Word32 (),
     459                 :             :                                  &t)
     460                 :    12624530 :       || converting_ISO_generic (location, type, value, m2type_GetM2Word64 (),
     461                 :             :                                  &t))
     462                 :         480 :     return t;
     463                 :             : 
     464                 :     6312025 :   if (TREE_CODE (type) == ARRAY_TYPE
     465                 :     6312025 :       && TREE_TYPE (type) == m2type_GetM2CharType ())
     466                 :             :     {
     467                 :          66 :       if (TREE_TYPE (value) == m2type_GetM2CharType ())
     468                 :             : 
     469                 :             :         /* Passing a const char to an array [..] of char.  So we convert
     470                 :             :            const char into the correct length string.  */
     471                 :          24 :         return convert_char_to_array (location, type, value);
     472                 :          42 :       if (TREE_CODE (value) == STRING_CST)
     473                 :             :         /* Convert a string into an array constant, padding with zeros if
     474                 :             :            necessary.  */
     475                 :           0 :         return convert_string_to_array (location, type, value);
     476                 :             :     }
     477                 :             : 
     478                 :     6312001 :   if (checkOverflow)
     479                 :      526255 :     return convert_and_check (location, type, value);
     480                 :             :   else
     481                 :     5785746 :     return convert_loc (location, type, value);
     482                 :             : }
     483                 :             : 
     484                 :             : /* const_to_ISO_type - perform VAL (iso_type, expr).  */
     485                 :             : 
     486                 :             : static tree
     487                 :         172 : const_to_ISO_type (location_t location, tree expr, tree iso_type)
     488                 :             : {
     489                 :         172 :   tree n = m2expr_GetSizeOf (location, iso_type);
     490                 :             : 
     491                 :         172 :   if ((m2expr_CompareTrees (n, m2decl_BuildIntegerConstant (1)) == 0)
     492                 :         172 :       && (iso_type == m2type_GetByteType ()
     493                 :          78 :           || iso_type == m2type_GetISOLocType ()
     494                 :           0 :           || iso_type == m2type_GetISOByteType ()))
     495                 :         154 :     return build1 (NOP_EXPR, iso_type, expr);
     496                 :          18 :   return const_to_ISO_aggregate_type (location, expr, iso_type);
     497                 :             : }
     498                 :             : 
     499                 :             : /* const_to_ISO_aggregate_type - perform VAL (iso_type, expr).  The
     500                 :             :    iso_type will be declared by the SYSTEM module as: TYPE iso_type =
     501                 :             :    ARRAY [0..n] OF LOC
     502                 :             : 
     503                 :             :    this function will store a constant into the iso_type in the correct
     504                 :             :    endian order.  It converts the expr into a unsigned int or signed
     505                 :             :    int and then strips it a byte at a time.  */
     506                 :             : 
     507                 :             : static tree
     508                 :          18 : const_to_ISO_aggregate_type (location_t location, tree expr, tree iso_type)
     509                 :             : {
     510                 :          18 :   tree byte;
     511                 :          18 :   m2type_Constructor c;
     512                 :          18 :   tree i = m2decl_BuildIntegerConstant (0);
     513                 :          18 :   tree n = m2expr_GetSizeOf (location, iso_type);
     514                 :          18 :   tree max_uint = m2decl_BuildIntegerConstant (256);
     515                 :             : 
     516                 :         108 :   while (m2expr_CompareTrees (i, n) < 0)
     517                 :             :     {
     518                 :          72 :       max_uint = m2expr_BuildMult (location, max_uint,
     519                 :             :                                    m2decl_BuildIntegerConstant (256), false);
     520                 :          72 :       i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
     521                 :             :                            false);
     522                 :             :     }
     523                 :          18 :   max_uint = m2expr_BuildDivFloor (location, max_uint,
     524                 :             :                                    m2decl_BuildIntegerConstant (2), false);
     525                 :             : 
     526                 :          18 :   if (m2expr_CompareTrees (expr, m2decl_BuildIntegerConstant (0)) < 0)
     527                 :           0 :     expr = m2expr_BuildAdd (location, expr, max_uint, false);
     528                 :             : 
     529                 :          18 :   i = m2decl_BuildIntegerConstant (0);
     530                 :          18 :   c = m2type_BuildStartArrayConstructor (iso_type);
     531                 :         108 :   while (m2expr_CompareTrees (i, n) < 0)
     532                 :             :     {
     533                 :          72 :       byte = m2expr_BuildModTrunc (location, expr,
     534                 :             :                                    m2decl_BuildIntegerConstant (256), false);
     535                 :          72 :       if (BYTES_BIG_ENDIAN)
     536                 :             :         m2type_BuildArrayConstructorElement (
     537                 :             :             c, m2convert_ToLoc (location, byte),
     538                 :             :             m2expr_BuildSub (location, m2expr_BuildSub (location, n, i, false),
     539                 :             :                              m2decl_BuildIntegerConstant (1), false));
     540                 :             :       else
     541                 :          72 :         m2type_BuildArrayConstructorElement (
     542                 :             :             c, m2convert_ToLoc (location, byte), i);
     543                 :             : 
     544                 :          72 :       i = m2expr_BuildAdd (location, i, m2decl_BuildIntegerConstant (1),
     545                 :             :                            false);
     546                 :          72 :       expr = m2expr_BuildDivFloor (location, expr,
     547                 :             :                                    m2decl_BuildIntegerConstant (256), false);
     548                 :             :     }
     549                 :             : 
     550                 :          18 :   return m2type_BuildEndArrayConstructor (c);
     551                 :             : }
     552                 :             : 
     553                 :             : /* ConvertConstantAndCheck - in Modula-2 sementics: RETURN( VAL(type,
     554                 :             :    expr) ).  Only to be used for a constant expr, overflow checking
     555                 :             :    is performed.  */
     556                 :             : 
     557                 :             : tree
     558                 :     1091015 : m2convert_ConvertConstantAndCheck (location_t location, tree type, tree expr)
     559                 :             : {
     560                 :     1091015 :   tree etype;
     561                 :     1091015 :   expr = fold (expr);
     562                 :     1091015 :   STRIP_NOPS (expr);
     563                 :     1091015 :   expr = m2expr_FoldAndStrip (expr);
     564                 :     1091015 :   etype = TREE_TYPE (expr);
     565                 :             : 
     566                 :     1091015 :   m2assert_AssertLocation (location);
     567                 :     1091015 :   if (etype == type)
     568                 :             :     return expr;
     569                 :             : 
     570                 :      504935 :   if (TREE_CODE (expr) == FUNCTION_DECL)
     571                 :           0 :     expr = m2expr_BuildAddr (location, expr, false);
     572                 :             : 
     573                 :      504935 :   type = m2tree_skip_type_decl (type);
     574                 :     1009860 :   if (type == m2type_GetByteType () || type == m2type_GetISOLocType ()
     575                 :      504925 :       || type == m2type_GetISOByteType () || type == m2type_GetISOWordType ()
     576                 :      504907 :       || type == m2type_GetM2Word16 () || type == m2type_GetM2Word32 ()
     577                 :     1009842 :       || type == m2type_GetM2Word64 ())
     578                 :          28 :     return const_to_ISO_type (location, expr, type);
     579                 :             : 
     580                 :      504907 :   return convert_and_check (location, type, m2expr_FoldAndStrip (expr));
     581                 :             : }
     582                 :             : 
     583                 :             : /* ToWord - converts an expression (Integer or Ordinal type) into a
     584                 :             :    WORD.  */
     585                 :             : 
     586                 :             : tree
     587                 :      533974 : m2convert_ToWord (location_t location, tree expr)
     588                 :             : {
     589                 :      533974 :   return m2convert_BuildConvert (location, m2type_GetWordType (), expr, false);
     590                 :             : }
     591                 :             : 
     592                 :             : /* ToCardinal - convert an expression, expr, to a CARDINAL.  */
     593                 :             : 
     594                 :             : tree
     595                 :      100410 : m2convert_ToCardinal (location_t location, tree expr)
     596                 :             : {
     597                 :      100410 :   return m2convert_BuildConvert (location, m2type_GetCardinalType (), expr,
     598                 :      100410 :                                  false);
     599                 :             : }
     600                 :             : 
     601                 :             : /* convertToPtr - if the type of tree, t, is not a ptr_type_node then
     602                 :             :    convert it.  */
     603                 :             : 
     604                 :             : tree
     605                 :       79539 : m2convert_convertToPtr (location_t location, tree type)
     606                 :             : {
     607                 :       79539 :   if (TREE_CODE (TREE_TYPE (type)) == POINTER_TYPE)
     608                 :             :     return type;
     609                 :             :   else
     610                 :       79065 :     return m2convert_BuildConvert (location, m2type_GetPointerType (), type,
     611                 :       79065 :                                    false);
     612                 :             : }
     613                 :             : 
     614                 :             : /* ToInteger - convert an expression, expr, to an INTEGER.  */
     615                 :             : 
     616                 :             : tree
     617                 :      128240 : m2convert_ToInteger (location_t location, tree expr)
     618                 :             : {
     619                 :      128240 :   return m2convert_BuildConvert (location, m2type_GetIntegerType (), expr,
     620                 :      128240 :                                  false);
     621                 :             : }
     622                 :             : 
     623                 :             : /* ToBitset - convert an expression, expr, to a BITSET type.  */
     624                 :             : 
     625                 :             : tree
     626                 :       40876 : m2convert_ToBitset (location_t location, tree expr)
     627                 :             : {
     628                 :       40876 :   return m2convert_BuildConvert (location, m2type_GetBitsetType (), expr,
     629                 :       40876 :                                  false);
     630                 :             : }
     631                 :             : 
     632                 :             : /* ToLoc - convert an expression, expr, to a LOC.  */
     633                 :             : 
     634                 :             : tree
     635                 :          72 : m2convert_ToLoc (location_t location, tree expr)
     636                 :             : {
     637                 :          72 :   return m2convert_BuildConvert (location, m2type_GetISOByteType (), expr,
     638                 :          72 :                                  false);
     639                 :             : }
     640                 :             : 
     641                 :             : /* GenericToType - converts, expr, into, type, providing that expr is
     642                 :             :    a generic system type (byte, word etc).  Otherwise expr is
     643                 :             :    returned unaltered.  */
     644                 :             : 
     645                 :             : tree
     646                 :     3329987 : m2convert_GenericToType (location_t location, tree type, tree expr)
     647                 :             : {
     648                 :     3329987 :   tree etype = TREE_TYPE (expr);
     649                 :             : 
     650                 :     3329987 :   type = m2tree_skip_type_decl (type);
     651                 :     3329987 :   if (type == etype)
     652                 :             :     return expr;
     653                 :             : 
     654                 :     6659974 :   if (type == m2type_GetISOWordType () || type == m2type_GetM2Word16 ()
     655                 :     6659974 :       || type == m2type_GetM2Word32 () || type == m2type_GetM2Word64 ())
     656                 :           0 :     return const_to_ISO_type (location, expr, type);
     657                 :             : 
     658                 :             :   return expr;
     659                 :             : }
        

Generated by: LCOV version 2.1-beta

LCOV profile is generated on x86_64 machine using following configure options: configure --disable-bootstrap --enable-coverage=opt --enable-languages=c,c++,fortran,go,jit,lto,rust,m2 --enable-host-shared. GCC test suite is run with the built compiler.