gcc/ch/lang.c

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