gcc/ada/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-2007, 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 #include "ada.h"
  35 #include "types.h"
  36 #include "uintp.h"
  37 #include "atree.h"
  38 #include "elists.h"
  39 #include "nlists.h"
  40 #include "stringt.h"
  41 #include "fe.h"
  42 #include "gigi.h"
  43 #include "ada-tree.h"
  44
  45 /* Universal integers are represented by the Uint type which is an index into
  46    the Uints_Ptr table containing Uint_Entry values.  A Uint_Entry contains an
  47    index and length for getting the "digits" of the universal integer from the
  48    Udigits_Ptr table.
  49
  50    For efficiency, this method is used only for integer values larger than the
  51    constant Uint_Bias.  If a Uint is less than this constant, then it contains
  52    the integer value itself.  The origin of the Uints_Ptr table is adjusted so
  53    that a Uint value of Uint_Bias indexes the first element.
  54
  55    First define a utility function that operates like build_int_cst for
  56    integral types and does a conversion to floating-point for real types.  */
  57
  58 static tree
  59 build_cst_from_int (tree type, HOST_WIDE_INT low)
  60 {
  61   if (TREE_CODE (type) == REAL_TYPE)
  62     return convert (type, build_int_cst (NULL_TREE, low));
  63   else
  64     return build_int_cst_type (type, low);
  65 }
  66
  67 /* Similar to UI_To_Int, but return a GCC INTEGER_CST or REAL_CST node,
  68    depending on whether TYPE is an integral or real type.  Overflow is tested
  69    by the constant-folding used to build the node.  TYPE is the GCC type of
  70    the resulting node.  */
  71
  72 tree
  73 UI_To_gnu (Uint Input, tree type)
  74 {
  75   tree gnu_ret;
  76
  77   /* We might have a TYPE with biased representation and be passed an
  78      unbiased value that doesn't fit.  We always use an unbiased type able
  79      to hold any such possible value for intermediate computations, and
  80      then rely on a conversion back to TYPE to perform the bias adjustment
  81      when need be.  */
  82
  83   int biased_type_p
  84     = (TREE_CODE (type) == INTEGER_TYPE
  85        && TYPE_BIASED_REPRESENTATION_P (type));
  86
  87   tree comp_type = biased_type_p ? get_base_type (type) : type;
  88
  89   if (Input <= Uint_Direct_Last)
  90     gnu_ret = build_cst_from_int (comp_type, Input - Uint_Direct_Bias);
  91   else
  92     {
  93       Int Idx = Uints_Ptr[Input].Loc;
  94       Pos Length = Uints_Ptr[Input].Length;
  95       Int First = Udigits_Ptr[Idx];
  96       tree gnu_base;
  97
  98       gcc_assert (Length > 0);
  99
 100       /* The computations we perform below always require a type at least as
 101          large as an integer not to overflow.  REAL types are always fine, but
 102          INTEGER or ENUMERAL types we are handed may be too short.  We use a
 103          base integer type node for the computations in this case and will
 104          convert the final result back to the incoming type later on.  */
 105
 106       if (TREE_CODE (comp_type) != REAL_TYPE
 107           && TYPE_PRECISION (comp_type) < TYPE_PRECISION (integer_type_node))
 108         comp_type = integer_type_node;
 109
 110       gnu_base = build_cst_from_int (comp_type, Base);
 111
 112       gnu_ret = build_cst_from_int (comp_type, First);
 113       if (First < 0)
 114         for (Idx++, Length--; Length; Idx++, Length--)
 115           gnu_ret = fold_build2 (MINUS_EXPR, comp_type,
 116                                  fold_build2 (MULT_EXPR, comp_type,
 117                                               gnu_ret, gnu_base),
 118                                  build_cst_from_int (comp_type,
 119                                                      Udigits_Ptr[Idx]));
 120       else
 121         for (Idx++, Length--; Length; Idx++, Length--)
 122           gnu_ret = fold_build2 (PLUS_EXPR, comp_type,
 123                                  fold_build2 (MULT_EXPR, comp_type,
 124                                               gnu_ret, gnu_base),
 125                                  build_cst_from_int (comp_type,
 126                                                      Udigits_Ptr[Idx]));
 127     }
 128
 129   gnu_ret = convert (type, gnu_ret);
 130
 131   /* We don't need any NOP_EXPR or NON_LVALUE_EXPR on GNU_RET.  */
 132   while ((TREE_CODE (gnu_ret) == NOP_EXPR
 133           || TREE_CODE (gnu_ret) == NON_LVALUE_EXPR)
 134          && TREE_TYPE (TREE_OPERAND (gnu_ret, 0)) == TREE_TYPE (gnu_ret))
 135     gnu_ret = TREE_OPERAND (gnu_ret, 0);
 136
 137   return gnu_ret;
 138 }