gcc/ch/lang.c

   1 /* Language-specific hook definitions for CHILL front end.
   2    Copyright (C) 1992, 1993, 1994, 1998, 1999, 2000, 2001
   3    Free Software Foundation, Inc.
   4
   5 This file is part of GNU CC.
   6
   7 GNU CC is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU CC is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU CC; see the file COPYING.  If not, write to
  19 the Free Software Foundation, 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22
  23 #include "config.h"
  24 #include "system.h"
  25 #include "tree.h"
  26 #include "ch-tree.h"
  27 #include "lex.h"
  28 #include "input.h"
  29 #include "toplev.h"
  30 #include "rtl.h"
  31 #include "expr.h"
  32 #include "diagnostic.h"
  33
  34 /* Type node for boolean types.  */
  35
  36 tree boolean_type_node;
  37
  38 /* True if STRING(INDEX) yields a CHARS(1) (or BOOLS(1)) rather than
  39    a CHAR (or BOOL).  Also, makes CHARS(1) similar for CHAR,
  40    and BOOLS(1) similar to BOOL.  This is for compatibility
  41    for the 1984 version of Z.200.*/
  42 int flag_old_strings = 0;
  43
  44 /* This is set non-zero to force user input tokens to lower case.
  45    This is non-standard.  See Z.200, page 8. */
  46 int ignore_case = 1;
  47
  48 /* True if reserved and predefined words ('special' words in the Z.200
  49    terminology) are in uppercase.  Obviously, this had better not be
  50    true if we're ignoring input case. */
  51 int special_UC = 0;
  52
  53 /* The actual name of the input file, regardless of any #line directives */
  54 const char* chill_real_input_filename;
  55 extern FILE* finput;
  56
  57 static int deep_const_expr                      PARAMS ((tree));
  58 static void chill_print_error_function          PARAMS ((diagnostic_context *,
  59                                                          const char *));
  60 \f
  61 /* Return 1 if the expression tree given has all
  62    constant nodes as its leaves,otherwise. */
  63
  64 static int
  65 deep_const_expr (exp)
  66      tree exp;
  67 {
  68   enum chill_tree_code code;
  69   int length;
  70   int i;
  71
  72   if (exp == NULL_TREE)
  73     return 0;
  74
  75   code = TREE_CODE (exp);
  76   length = first_rtl_op (TREE_CODE (exp));
  77
  78   /* constant leaf?  return TRUE */
  79   if (TREE_CODE_CLASS (code) == 'c')
  80     return 1;
  81
  82   /* Recursively check next level down.  */
  83   for (i = 0; i < length; i++)
  84     if (! deep_const_expr (TREE_OPERAND (exp, i)))
  85       return 0;
  86   return 1;
  87 }
  88
  89
  90 tree
  91 const_expr (exp)
  92      tree exp;
  93 {
  94   if (TREE_CODE (exp) == INTEGER_CST)
  95     return exp;
  96   if (TREE_CODE (exp) == CONST_DECL)
  97     return const_expr (DECL_INITIAL (exp));
  98   if (TREE_CODE_CLASS (TREE_CODE (exp)) == 'd'
  99       && DECL_INITIAL (exp) != NULL_TREE
 100       && TREE_READONLY (exp))
 101     return DECL_INITIAL (exp);
 102   if (deep_const_expr (exp))
 103     return exp;
 104   if (TREE_CODE (exp) != ERROR_MARK)
 105     error ("non-constant expression");
 106   return error_mark_node;
 107 }
 108
 109 /* Each of the functions defined here
 110    is an alternative to a function in objc-actions.c.  */
 111
 112 /* Used by c-lex.c, but only for objc.  */
 113 tree
 114 lookup_interface (arg)
 115      tree arg ATTRIBUTE_UNUSED;
 116 {
 117   return 0;
 118 }
 119
 120 int
 121 maybe_objc_comptypes (lhs, rhs)
 122      tree lhs ATTRIBUTE_UNUSED, rhs ATTRIBUTE_UNUSED;
 123 {
 124   return -1;
 125 }
 126
 127 tree
 128 maybe_building_objc_message_expr ()
 129 {
 130   return 0;
 131 }
 132
 133 int
 134 recognize_objc_keyword ()
 135 {
 136   return 0;
 137 }
 138
 139 void
 140 lang_init_options ()
 141 {
 142 }
 143
 144 /* used by print-tree.c */
 145
 146 void
 147 lang_print_xnode (file, node, indent)
 148      FILE *file ATTRIBUTE_UNUSED;
 149      tree node ATTRIBUTE_UNUSED;
 150      int indent ATTRIBUTE_UNUSED;
 151 {
 152 }
 153 \f
 154 /*
 155  * process chill-specific compiler command-line options
 156  * do not complain if the option is not recognised
 157  */
 158 int
 159 lang_decode_option (argc, argv)
 160      int argc;
 161      char **argv;
 162 {
 163   char *p = argv[0];
 164   static int explicit_ignore_case = 0;
 165   if (!strcmp(p, "-lang-chill"))
 166     ; /* do nothing */
 167   else if (!strcmp (p, "-fruntime-checking"))
 168     {
 169       range_checking = 1;
 170       empty_checking = 1;
 171     }
 172   else if (!strcmp (p, "-fno-runtime-checking"))
 173     {
 174       range_checking = 0;
 175       empty_checking = 0;
 176       runtime_checking_flag = 0;
 177     }
 178   else if (!strcmp (p, "-flocal-loop-counter"))
 179     flag_local_loop_counter = 1;
 180   else if (!strcmp (p, "-fno-local-loop-counter"))
 181     flag_local_loop_counter = 0;
 182   else if (!strcmp (p, "-fold-strings"))
 183     flag_old_strings = 1;
 184   else if (!strcmp (p, "-fno-old-strings"))
 185     flag_old_strings = 0;
 186   else if (!strcmp (p, "-fignore-case"))
 187     {
 188       explicit_ignore_case = 1;
 189       if (special_UC)
 190         {
 191           error ("ignoring case upon input and");
 192           error ("making special words uppercase wouldn't work");
 193         }
 194       else
 195         ignore_case = 1;
 196     }
 197   else if (!strcmp (p, "-fno-ignore-case"))
 198     ignore_case = 0;
 199   else if (!strcmp (p, "-fspecial_UC"))
 200     {
 201       if (explicit_ignore_case)
 202         {
 203           error ("making special words uppercase and");
 204           error (" ignoring case upon input wouldn't work");
 205         }
 206       else
 207         special_UC = 1, ignore_case = 0;
 208     }
 209   else if (!strcmp (p, "-fspecial_LC"))
 210     special_UC = 0;
 211   else if (!strcmp (p, "-fpack"))
 212     maximum_field_alignment = BITS_PER_UNIT;
 213   else if (!strcmp (p, "-fno-pack"))
 214     maximum_field_alignment = 0;
 215   else if (!strcmp (p, "-fchill-grant-only"))
 216     grant_only_flag = 1;
 217   else if (!strcmp (p, "-fgrant-only"))
 218     grant_only_flag = 1;
 219   /* user has specified a seize-file path */
 220   else if (p[0] == '-' && p[1] == 'I')
 221     register_seize_path (&p[2]);
 222   if (!strcmp(p, "-itu"))        /* Force Z.200 semantics */
 223     {
 224       pedantic = 1;   /* FIXME: new flag name? */
 225       flag_local_loop_counter = 1;
 226     }
 227   else
 228     return c_decode_option (argc, argv);
 229
 230   return 1;
 231 }
 232
 233 static void
 234 chill_print_error_function (context, file)
 235      diagnostic_context *buffer __attribute__((__unused__));
 236      const char *file;
 237 {
 238   static tree last_error_function = NULL_TREE;
 239   static struct module *last_error_module = NULL;
 240
 241   if (last_error_function == current_function_decl
 242       && last_error_module == current_module)
 243     return;
 244
 245   last_error_function = current_function_decl;
 246   last_error_module = current_module;
 247
 248   if (file)
 249     fprintf (stderr, "%s: ", file);
 250
 251   if (current_function_decl == global_function_decl
 252       || current_function_decl == NULL_TREE)
 253     {
 254       if (current_module == NULL)
 255         fprintf (stderr, "At top level:\n");
 256       else
 257         fprintf (stderr, "In module %s:\n",
 258                  IDENTIFIER_POINTER (current_module->name));
 259     }
 260   else
 261     {
 262       const char *kind = "function";
 263       const char *name = (*decl_printable_name) (current_function_decl, 2);
 264       fprintf (stderr, "In %s `%s':\n", kind, name);
 265     }
 266 }
 267
 268 /* Print an error message for invalid use of an incomplete type.
 269    VALUE is the expression that was used (or 0 if that isn't known)
 270    and TYPE is the type that was invalid.  */
 271
 272 void
 273 incomplete_type_error (value, type)
 274      tree value ATTRIBUTE_UNUSED;
 275      tree type ATTRIBUTE_UNUSED;
 276 {
 277   error ("internal error - use of undefined type");
 278 }
 279
 280 /* Return the typed-based alias set for T, which may be an expression
 281    or a type.  Return -1 if we don't do anything special.  */
 282
 283 HOST_WIDE_INT
 284 lang_get_alias_set (t)
 285      tree t ATTRIBUTE_UNUSED;
 286 {
 287   /* ??? Need to figure out what the rules are.  Certainly we'd need
 288      to handle union-like things, and probably variant records.
 289      Until then, turn off type-based aliasing completely.  */
 290   return 0;
 291 }
 292
 293 void
 294 lang_init ()
 295 {
 296   chill_real_input_filename = input_filename;
 297
 298   /* the beginning of the file is a new line; check for # */
 299   /* With luck, we discover the real source file's name from that
 300      and put it in input_filename.  */
 301
 302   ungetc (check_newline (), finput);
 303
 304   /* set default grant file */
 305   set_default_grant_file ();
 306
 307   print_error_function = chill_print_error_function;
 308 }