+++ /dev/null
-/* Language-specific hook definitions for CHILL front end.
- Copyright (C) 1992, 1993, 1994, 1998, 1999, 2000, 2001
- Free Software Foundation, Inc.
-
-This file is part of GNU CC.
-
-GNU CC is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
-
-GNU CC is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with GNU CC; see the file COPYING. If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
-
-
-#include "config.h"
-#include "system.h"
-#include "tree.h"
-#include "ch-tree.h"
-#include "lex.h"
-#include "input.h"
-#include "toplev.h"
-#include "rtl.h"
-#include "expr.h"
-#include "diagnostic.h"
-
-/* Type node for boolean types. */
-
-tree boolean_type_node;
-
-/* True if STRING(INDEX) yields a CHARS(1) (or BOOLS(1)) rather than
- a CHAR (or BOOL). Also, makes CHARS(1) similar for CHAR,
- and BOOLS(1) similar to BOOL. This is for compatibility
- for the 1984 version of Z.200.*/
-int flag_old_strings = 0;
-
-/* This is set non-zero to force user input tokens to lower case.
- This is non-standard. See Z.200, page 8. */
-int ignore_case = 1;
-
-/* True if reserved and predefined words ('special' words in the Z.200
- terminology) are in uppercase. Obviously, this had better not be
- true if we're ignoring input case. */
-int special_UC = 0;
-
-/* The actual name of the input file, regardless of any #line directives */
-const char* chill_real_input_filename;
-extern FILE* finput;
-
-static int deep_const_expr PARAMS ((tree));
-static void chill_print_error_function PARAMS ((diagnostic_context *,
- const char *));
-\f
-/* Return 1 if the expression tree given has all
- constant nodes as its leaves,otherwise. */
-
-static int
-deep_const_expr (exp)
- tree exp;
-{
- enum chill_tree_code code;
- int length;
- int i;
-
- if (exp == NULL_TREE)
- return 0;
-
- code = TREE_CODE (exp);
- length = first_rtl_op (TREE_CODE (exp));
-
- /* constant leaf? return TRUE */
- if (TREE_CODE_CLASS (code) == 'c')
- return 1;
-
- /* Recursively check next level down. */
- for (i = 0; i < length; i++)
- if (! deep_const_expr (TREE_OPERAND (exp, i)))
- return 0;
- return 1;
-}
-
-
-tree
-const_expr (exp)
- tree exp;
-{
- if (TREE_CODE (exp) == INTEGER_CST)
- return exp;
- if (TREE_CODE (exp) == CONST_DECL)
- return const_expr (DECL_INITIAL (exp));
- if (TREE_CODE_CLASS (TREE_CODE (exp)) == 'd'
- && DECL_INITIAL (exp) != NULL_TREE
- && TREE_READONLY (exp))
- return DECL_INITIAL (exp);
- if (deep_const_expr (exp))
- return exp;
- if (TREE_CODE (exp) != ERROR_MARK)
- error ("non-constant expression");
- return error_mark_node;
-}
-
-/* Each of the functions defined here
- is an alternative to a function in objc-actions.c. */
-
-/* Used by c-lex.c, but only for objc. */
-tree
-lookup_interface (arg)
- tree arg ATTRIBUTE_UNUSED;
-{
- return 0;
-}
-
-int
-maybe_objc_comptypes (lhs, rhs)
- tree lhs ATTRIBUTE_UNUSED, rhs ATTRIBUTE_UNUSED;
-{
- return -1;
-}
-
-tree
-maybe_building_objc_message_expr ()
-{
- return 0;
-}
-
-int
-recognize_objc_keyword ()
-{
- return 0;
-}
-
-void
-lang_init_options ()
-{
-}
-
-/* used by print-tree.c */
-
-void
-lang_print_xnode (file, node, indent)
- FILE *file ATTRIBUTE_UNUSED;
- tree node ATTRIBUTE_UNUSED;
- int indent ATTRIBUTE_UNUSED;
-{
-}
-\f
-/*
- * process chill-specific compiler command-line options
- * do not complain if the option is not recognised
- */
-int
-lang_decode_option (argc, argv)
- int argc;
- char **argv;
-{
- char *p = argv[0];
- static int explicit_ignore_case = 0;
- if (!strcmp(p, "-lang-chill"))
- ; /* do nothing */
- else if (!strcmp (p, "-fruntime-checking"))
- {
- range_checking = 1;
- empty_checking = 1;
- }
- else if (!strcmp (p, "-fno-runtime-checking"))
- {
- range_checking = 0;
- empty_checking = 0;
- runtime_checking_flag = 0;
- }
- else if (!strcmp (p, "-flocal-loop-counter"))
- flag_local_loop_counter = 1;
- else if (!strcmp (p, "-fno-local-loop-counter"))
- flag_local_loop_counter = 0;
- else if (!strcmp (p, "-fold-strings"))
- flag_old_strings = 1;
- else if (!strcmp (p, "-fno-old-strings"))
- flag_old_strings = 0;
- else if (!strcmp (p, "-fignore-case"))
- {
- explicit_ignore_case = 1;
- if (special_UC)
- {
- error ("ignoring case upon input and");
- error ("making special words uppercase wouldn't work");
- }
- else
- ignore_case = 1;
- }
- else if (!strcmp (p, "-fno-ignore-case"))
- ignore_case = 0;
- else if (!strcmp (p, "-fspecial_UC"))
- {
- if (explicit_ignore_case)
- {
- error ("making special words uppercase and");
- error (" ignoring case upon input wouldn't work");
- }
- else
- special_UC = 1, ignore_case = 0;
- }
- else if (!strcmp (p, "-fspecial_LC"))
- special_UC = 0;
- else if (!strcmp (p, "-fpack"))
- maximum_field_alignment = BITS_PER_UNIT;
- else if (!strcmp (p, "-fno-pack"))
- maximum_field_alignment = 0;
- else if (!strcmp (p, "-fchill-grant-only"))
- grant_only_flag = 1;
- else if (!strcmp (p, "-fgrant-only"))
- grant_only_flag = 1;
- /* user has specified a seize-file path */
- else if (p[0] == '-' && p[1] == 'I')
- register_seize_path (&p[2]);
- if (!strcmp(p, "-itu")) /* Force Z.200 semantics */
- {
- pedantic = 1; /* FIXME: new flag name? */
- flag_local_loop_counter = 1;
- }
- else
- return c_decode_option (argc, argv);
-
- return 1;
-}
-
-static void
-chill_print_error_function (context, file)
- diagnostic_context *buffer __attribute__((__unused__));
- const char *file;
-{
- static tree last_error_function = NULL_TREE;
- static struct module *last_error_module = NULL;
-
- if (last_error_function == current_function_decl
- && last_error_module == current_module)
- return;
-
- last_error_function = current_function_decl;
- last_error_module = current_module;
-
- if (file)
- fprintf (stderr, "%s: ", file);
-
- if (current_function_decl == global_function_decl
- || current_function_decl == NULL_TREE)
- {
- if (current_module == NULL)
- fprintf (stderr, "At top level:\n");
- else
- fprintf (stderr, "In module %s:\n",
- IDENTIFIER_POINTER (current_module->name));
- }
- else
- {
- const char *kind = "function";
- const char *name = (*decl_printable_name) (current_function_decl, 2);
- fprintf (stderr, "In %s `%s':\n", kind, name);
- }
-}
-
-/* Print an error message for invalid use of an incomplete type.
- VALUE is the expression that was used (or 0 if that isn't known)
- and TYPE is the type that was invalid. */
-
-void
-incomplete_type_error (value, type)
- tree value ATTRIBUTE_UNUSED;
- tree type ATTRIBUTE_UNUSED;
-{
- error ("internal error - use of undefined type");
-}
-
-/* Return the typed-based alias set for T, which may be an expression
- or a type. Return -1 if we don't do anything special. */
-
-HOST_WIDE_INT
-lang_get_alias_set (t)
- tree t ATTRIBUTE_UNUSED;
-{
- /* ??? Need to figure out what the rules are. Certainly we'd need
- to handle union-like things, and probably variant records.
- Until then, turn off type-based aliasing completely. */
- return 0;
-}
-
-void
-lang_init ()
-{
- chill_real_input_filename = input_filename;
-
- /* the beginning of the file is a new line; check for # */
- /* With luck, we discover the real source file's name from that
- and put it in input_filename. */
-
- ungetc (check_newline (), finput);
-
- /* set default grant file */
- set_default_grant_file ();
-
- print_error_function = chill_print_error_function;
-}
OSDN Git Service
