OSDN Git Service

* config/alpha/vms.h (INCLUDE_DEFAULTS): Add /gnu/lib/gcc-lib/include.
[pf3gnuchains/gcc-fork.git] / gcc / ch / convert.c
index d865336..3a4a8be 100644 (file)
@@ -1,5 +1,6 @@
 /* Language-level data type conversion for GNU CHILL.
-   Copyright (C) 1992, 93, 1994 Free Software Foundation, Inc.
+   Copyright (C) 1992, 1993, 1994, 1998, 1999, 2000, 2001
+   Free Software Foundation, Inc.
 
 This file is part of GNU CC.
 
@@ -15,7 +16,8 @@ GNU General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with GNU CC; see the file COPYING.  If not, write to
-the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
+the Free Software Foundation, 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
 
 
 /* This file contains the functions for converting CHILL expressions
@@ -24,17 +26,31 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
    but what kind of conversions it does will depend on the language.  */
 
 #include "config.h"
+#include "system.h"
 #include "tree.h"
 #include "ch-tree.h"
 #include "flags.h"
 #include "convert.h"
 #include "lex.h"
+#include "toplev.h"
+#include "output.h"
 
-extern void error                              PROTO((char *, ...));
-extern tree initializer_constant_valid_p       PROTO((tree, tree));
 extern tree bit_one_node, bit_zero_node;
 extern tree string_one_type_node;
 extern tree bitstring_one_type_node;
+
+static tree convert_to_reference       PARAMS ((tree, tree));
+static tree convert_to_boolean         PARAMS ((tree, tree));
+static tree convert_to_char            PARAMS ((tree, tree));
+#if 0
+static tree base_type_size_in_bytes    PARAMS ((tree));
+#endif
+static tree remove_tree_element                PARAMS ((tree, tree *));
+static tree check_ps_range             PARAMS ((tree, tree, tree));
+static tree digest_powerset_tuple      PARAMS ((tree, tree));
+static tree digest_structure_tuple     PARAMS ((tree, tree));
+static tree digest_array_tuple         PARAMS ((tree, tree, int));
+static tree convert1                   PARAMS ((tree, tree));
 \f
 static tree
 convert_to_reference (reftype, expr)
@@ -142,7 +158,8 @@ convert_to_char (type, expr)
   }
 }
 \f
-tree
+#if 0
+static tree
 base_type_size_in_bytes (type)
      tree type;
 {
@@ -152,6 +169,7 @@ base_type_size_in_bytes (type)
     return error_mark_node;
   return size_in_bytes (TREE_TYPE (type));
 }
+#endif
 
 /*
  * build a singleton array type, of TYPE objects.
@@ -563,7 +581,7 @@ digest_structure_tuple (type, inits)
 /* Return a Chill representation of the INTEGER_CST VAL.
    The result may be in a static buffer, */
 
-char *
+const char *
 display_int_cst (val)
      tree val;
 {
@@ -589,9 +607,9 @@ display_int_cst (val)
       else if (x == '\n')
        strcpy (buffer, "'^J'");
       else if (x < ' ' || x > '~')
-       sprintf (buffer, "'^(%u)'", x);
+       sprintf (buffer, "'^(%u)'", (unsigned int) x);
       else
-       sprintf (buffer, "'%c'", x);
+       sprintf (buffer, "'%c'", (char) x);
       return buffer;
     case ENUMERAL_TYPE:
       for (fields = TYPE_VALUES (TREE_TYPE (val)); fields != NULL_TREE;
@@ -736,7 +754,8 @@ digest_array_tuple (type, init, allow_missing_elements)
 
       if (! CH_COMPATIBLE (value, element_type))
        {
-         char *err_val_name = first ? display_int_cst (first) : "(default)";
+         const char *err_val_name =
+           first ? display_int_cst (first) : "(default)";
          error ("incompatible array tuple element %s", err_val_name);
          value = error_mark_node;
        }
@@ -778,7 +797,7 @@ digest_array_tuple (type, init, allow_missing_elements)
        ptr = &TREE_CHAIN (*ptr);
       if (*ptr && ! tree_int_cst_lt (CONSTRUCTOR_ELT_HI (*ptr), first))
        {
-         char *err_val_name = display_int_cst (first);
+         const char *err_val_name = display_int_cst (first);
          error ("array tuple has duplicate index %s", err_val_name);
          errors++;
          continue;
@@ -840,14 +859,12 @@ digest_array_tuple (type, init, allow_missing_elements)
            }
          /* Calculate the last element of the gap. */
          if (*ptr)
-           {
-             /* Actually end up with correct type. */
-             last = size_binop (MINUS_EXPR,
-                                CONSTRUCTOR_ELT_LO (*ptr),
-                                integer_one_node);
-           }
+           last = fold (build (MINUS_EXPR, integer_type_node,
+                               CONSTRUCTOR_ELT_LO (*ptr),
+                               integer_one_node));
          else
            last = domain_max;
+
          if (TREE_CODE (last) == INTEGER_CST && tree_int_cst_lt (last, first))
            ; /* Empty "gap" - no missing elements. */
          else if (default_value)
@@ -861,7 +878,7 @@ digest_array_tuple (type, init, allow_missing_elements)
            }
          else
            {
-             char *err_val_name = display_int_cst (first);
+             const char *err_val_name = display_int_cst (first);
              if (TREE_CODE (last) != INTEGER_CST)
                error ("dynamic array tuple without (*) or (ELSE)");
              else if (tree_int_cst_equal (first, last))
@@ -932,7 +949,6 @@ convert (type, expr)
 {
   register tree e = expr;
   register enum chill_tree_code code;
-  char *errstr;
   int type_varying;
 
   if (e == NULL_TREE || TREE_CODE (e) == ERROR_MARK)
@@ -1041,16 +1057,17 @@ convert (type, expr)
        {
          /* Note that array_type_nelts returns 1 less than the size. */
          nentries = array_type_nelts (TREE_TYPE (e));
-         needed_padding = size_binop (MINUS_EXPR,
-                                      array_type_nelts (target_array_type),
-                                      nentries);
+         needed_padding = fold (build (MINUS_EXPR, integer_type_node,
+                                       array_type_nelts (target_array_type),
+                                       nentries));
          if (TREE_CODE (needed_padding) != INTEGER_CST)
            {
              padding_max_size = size_in_bytes (TREE_TYPE (e));
              if (TREE_CODE (padding_max_size) != INTEGER_CST)
                padding_max_size = TYPE_ARRAY_MAX_SIZE (TREE_TYPE (e));
            }
-         nentries = size_binop (PLUS_EXPR, nentries, integer_one_node);
+         nentries = fold (build (PLUS_EXPR, integer_type_node,
+                                 nentries, integer_one_node));
        }
       else if (TREE_CODE (e) == CONSTRUCTOR)
        {
@@ -1069,9 +1086,7 @@ convert (type, expr)
          error ("initializer is not an array or string mode");
          return error_mark_node;
        }
-#if 0
-      FIXME check that nentries will fit in type;
-#endif
+      /* FIXME check that nentries will fit in type; */
       if (!integer_zerop (needed_padding))
        {
          tree padding, padding_type, padding_range;
@@ -1118,11 +1133,12 @@ convert (type, expr)
        {
          if (TREE_CODE (type) == SET_TYPE)
            return digest_powerset_tuple (type, e);
-         if (TREE_CODE (type) == RECORD_TYPE)
+         else if (TREE_CODE (type) == RECORD_TYPE)
            return digest_structure_tuple (type, e);
-         if (TREE_CODE (type) == ARRAY_TYPE)
+         else if (TREE_CODE (type) == ARRAY_TYPE)
            return digest_array_tuple (type, e, 0);
-         fatal ("internal error - bad CONSTRUCTOR passed to convert");
+         else
+           abort ();
        }
       else if (TREE_CODE (e) == COND_EXPR)
        e = build (COND_EXPR, type,