gcc/ada/gcc-interface/cuintp.c

   1 /****************************************************************************
   2  *                                                                          *
   3  *                        GNAT COMPILER COMPONENTS                          *
   4  *                                                                          *
   5  *                               C U I N T P                                *
   6  *                                                                          *
   7  *                          C Implementation File                           *
   8  *                                                                          *
   9  *          Copyright (C) 1992-2012, Free Software Foundation, Inc.         *
  10  *                                                                          *
  11  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  12  * terms of the  GNU General Public License as published  by the Free Soft- *
  13  * ware  Foundation;  either version 3,  or (at your option) any later ver- *
  14  * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
  15  * OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY *
  16  * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License *
  17  * for  more details.  You should have received a copy of the GNU General   *
  18  * Public License along with GCC; see the file COPYING3.  If not see        *
  19  * <http://www.gnu.org/licenses/>.                                          *
  20  *                                                                          *
  21  * GNAT was originally developed  by the GNAT team at  New York University. *
  22  * Extensive contributions were provided by Ada Core Technologies Inc.      *
  23  *                                                                          *
  24  ****************************************************************************/
  25
  26 /* This file corresponds to the Ada package body Uintp. It was created
  27    manually from the files uintp.ads and uintp.adb. */
  28
  29 #include "config.h"
  30 #include "system.h"
  31 #include "coretypes.h"
  32 #include "tm.h"
  33 #include "tree.h"
  34
  35 #include "ada.h"
  36 #include "types.h"
  37 #include "uintp.h"
  38 #include "atree.h"
  39 #include "elists.h"
  40 #include "nlists.h"
  41 #include "stringt.h"
  42 #include "fe.h"
  43 #include "ada-tree.h"
  44 #include "gigi.h"
  45
  46 /* Universal integers are represented by the Uint type which is an index into
  47    the Uints_Ptr table containing Uint_Entry values.  A Uint_Entry contains an
  48    index and length for getting the "digits" of the universal integer from the
  49    Udigits_Ptr table.
  50
  51    For efficiency, this method is used only for integer values larger than the
  52    constant Uint_Bias.  If a Uint is less than this constant, then it contains
  53    the integer value itself.  The origin of the Uints_Ptr table is adjusted so
  54    that a Uint value of Uint_Bias indexes the first element.
  55
  56    First define a utility function that operates like build_int_cst for
  57    integral types and does a conversion to floating-point for real types.  */
  58
  59 static tree
  60 build_cst_from_int (tree type, HOST_WIDE_INT low)
  61 {
  62   if (TREE_CODE (type) == REAL_TYPE)
  63     return convert (type, build_int_cst (NULL_TREE, low));
  64   else
  65     return build_int_cst_type (type, low);
  66 }
  67
  68 /* Similar to UI_To_Int, but return a GCC INTEGER_CST or REAL_CST node,
  69    depending on whether TYPE is an integral or real type.  Overflow is tested
  70    by the constant-folding used to build the node.  TYPE is the GCC type of
  71    the resulting node.  */
  72
  73 tree
  74 UI_To_gnu (Uint Input, tree type)
  75 {
  76   tree gnu_ret;
  77
  78   /* We might have a TYPE with biased representation and be passed an
  79      unbiased value that doesn't fit.  We always use an unbiased type able
  80      to hold any such possible value for intermediate computations, and
  81      then rely on a conversion back to TYPE to perform the bias adjustment
  82      when need be.  */
  83
  84   int biased_type_p
  85     = (TREE_CODE (type) == INTEGER_TYPE
  86        && TYPE_BIASED_REPRESENTATION_P (type));
  87
  88   tree comp_type = biased_type_p ? get_base_type (type) : type;
  89
  90   if (Input <= Uint_Direct_Last)
  91     gnu_ret = build_cst_from_int (comp_type, Input - Uint_Direct_Bias);
  92   else
  93     {
  94       Int Idx = Uints_Ptr[Input].Loc;
  95       Pos Length = Uints_Ptr[Input].Length;
  96       Int First = Udigits_Ptr[Idx];
  97       tree gnu_base;
  98
  99       gcc_assert (Length > 0);
 100
 101       /* The computations we perform below always require a type at least as
 102          large as an integer not to overflow.  REAL types are always fine, but
 103          INTEGER or ENUMERAL types we are handed may be too short.  We use a
 104          base integer type node for the computations in this case and will
 105          convert the final result back to the incoming type later on.
 106          The base integer precision must be superior than 16.  */
 107
 108       if (TREE_CODE (comp_type) != REAL_TYPE
 109           && TYPE_PRECISION (comp_type)
 110              < TYPE_PRECISION (long_integer_type_node))
 111         {
 112           comp_type = long_integer_type_node;
 113           gcc_assert (TYPE_PRECISION (comp_type) > 16);
 114         }
 115
 116       gnu_base = build_cst_from_int (comp_type, Base);
 117
 118       gnu_ret = build_cst_from_int (comp_type, First);
 119       if (First < 0)
 120         for (Idx++, Length--; Length; Idx++, Length--)
 121           gnu_ret = fold_build2 (MINUS_EXPR, comp_type,
 122                                  fold_build2 (MULT_EXPR, comp_type,
 123                                               gnu_ret, gnu_base),
 124                                  build_cst_from_int (comp_type,
 125                                                      Udigits_Ptr[Idx]));
 126       else
 127         for (Idx++, Length--; Length; Idx++, Length--)
 128           gnu_ret = fold_build2 (PLUS_EXPR, comp_type,
 129                                  fold_build2 (MULT_EXPR, comp_type,
 130                                               gnu_ret, gnu_base),
 131                                  build_cst_from_int (comp_type,
 132                                                      Udigits_Ptr[Idx]));
 133     }
 134
 135   gnu_ret = convert (type, gnu_ret);
 136
 137   /* We don't need any NOP_EXPR or NON_LVALUE_EXPR on GNU_RET.  */
 138   while ((TREE_CODE (gnu_ret) == NOP_EXPR
 139           || TREE_CODE (gnu_ret) == NON_LVALUE_EXPR)
 140          && TREE_TYPE (TREE_OPERAND (gnu_ret, 0)) == TREE_TYPE (gnu_ret))
 141     gnu_ret = TREE_OPERAND (gnu_ret, 0);
 142
 143   return gnu_ret;
 144 }
 145
 146 /* Similar to UI_From_Int, but take a GCC INTEGER_CST.  We use UI_From_Int
 147    when possible, i.e. for a 32-bit signed value, to take advantage of its
 148    built-in caching mechanism.  For values of larger magnitude, we compute
 149    digits into a vector and call Vector_To_Uint.  */
 150
 151 Uint
 152 UI_From_gnu (tree Input)
 153 {
 154   tree gnu_type = TREE_TYPE (Input), gnu_base, gnu_temp;
 155   /* UI_Base is defined so that 5 Uint digits is sufficient to hold the
 156      largest possible signed 64-bit value.  */
 157   const int Max_For_Dint = 5;
 158   int v[Max_For_Dint], i;
 159   Vector_Template temp;
 160   Int_Vector vec;
 161
 162 #if HOST_BITS_PER_WIDE_INT == 64
 163   /* On 64-bit hosts, host_integerp tells whether the input fits in a
 164      signed 64-bit integer.  Then a truncation tells whether it fits
 165      in a signed 32-bit integer.  */
 166   if (host_integerp (Input, 0))
 167     {
 168       HOST_WIDE_INT hw_input = TREE_INT_CST_LOW (Input);
 169       if (hw_input == (int) hw_input)
 170         return UI_From_Int (hw_input);
 171     }
 172   else
 173     return No_Uint;
 174 #else
 175   /* On 32-bit hosts, host_integerp tells whether the input fits in a
 176      signed 32-bit integer.  Then a sign test tells whether it fits
 177      in a signed 64-bit integer.  */
 178   if (host_integerp (Input, 0))
 179     return UI_From_Int (TREE_INT_CST_LOW (Input));
 180   else if (TREE_INT_CST_HIGH (Input) < 0 && TYPE_UNSIGNED (gnu_type))
 181     return No_Uint;
 182 #endif
 183
 184   gnu_base = build_int_cst (gnu_type, UI_Base);
 185   gnu_temp = Input;
 186
 187   for (i = Max_For_Dint - 1; i >= 0; i--)
 188     {
 189       v[i] = tree_low_cst (fold_build1 (ABS_EXPR, gnu_type,
 190                                         fold_build2 (TRUNC_MOD_EXPR, gnu_type,
 191                                                      gnu_temp, gnu_base)),
 192                            0);
 193       gnu_temp = fold_build2 (TRUNC_DIV_EXPR, gnu_type, gnu_temp, gnu_base);
 194     }
 195
 196   temp.Low_Bound = 1, temp.High_Bound = Max_For_Dint;
 197   vec.Array = v, vec.Bounds = &temp;
 198   return Vector_To_Uint (vec, tree_int_cst_sgn (Input) < 0);
 199 }