gcc/ch/lang.c

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