gcc/ch/lang.c

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