OSDN Git Service

* config/alpha/vms.h (INCLUDE_DEFAULTS): Add /gnu/lib/gcc-lib/include.
[pf3gnuchains/gcc-fork.git] / 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 }