inout.c

gcc-2.95.3 Linux下最常用的C编译器

/* Implement I/O-related actions for CHILL.
   Copyright (C) 1992, 93, 1994, 1998, 1999 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 "rtl.h"
#include "lex.h"
#include "flags.h"
#include "input.h"
#include "assert.h"
#include "toplev.h"

/* set non-zero if input text is forced to lowercase */
extern int ignore_case;

/* set non-zero if special words are to be entered in uppercase */
extern int special_UC;

static int intsize_of_charsexpr PROTO((tree));

/* association mode */
tree association_type_node;
/* initialzier for association mode */
tree association_init_value;

/* NOTE: should be same as in runtime/chillrt0.c */
#define STDIO_TEXT_LENGTH    1024
/* mode of stdout, stdin, stderr*/
static tree stdio_type_node;

/* usage- and where modes */
tree usage_type_node;
tree where_type_node;

/* we have to distinguish between io-list-type for WRITETEXT
   and for READTEXT. WRITETEXT does not process ranges and
   READTEXT must get pointers to the variables.
   */
/* variable to hold the type of the io_list */
static tree chill_io_list_type = NULL_TREE;

/* the type for the enum tables */
static tree enum_table_type = NULL_TREE;

/* structure to save enums for later use in compilation */
typedef struct save_enum_names
{
  struct save_enum_names  *forward;
  tree			  name;
  tree			  decl;
} SAVE_ENUM_NAMES;

static SAVE_ENUM_NAMES *used_enum_names = (SAVE_ENUM_NAMES *)0;

typedef struct save_enum_values
{
  long		 	  val;
  struct save_enum_names  *name;
} SAVE_ENUM_VALUES;

typedef struct save_enums
{
  struct save_enums       *forward;
  tree		          context;
  tree		          type;
  tree		          ptrdecl;
  long		          num_vals;
  struct save_enum_values *vals;
} SAVE_ENUMS;

static SAVE_ENUMS	*used_enums = (SAVE_ENUMS *)0;


/* Function collects all enums are necessary to collect, makes a copy of
   the value and returns a VAR_DECL external to current function describing
   the pointer to a name table, which will be generated at the end of
   compilation
   */

static tree add_enum_to_list (type, context)
     tree  type;
     tree  context;
{
  tree		tmp;
  SAVE_ENUMS		*wrk = used_enums;
  SAVE_ENUM_VALUES	*vals;
  SAVE_ENUM_NAMES	*names;
    
  while (wrk != (SAVE_ENUMS *)0)
    {
      /* search for this enum already in use */
      if (wrk->context == context && wrk->type == type)
	{
	  /* yes, found. look if the ptrdecl is valid in this scope */
	  char  *name = IDENTIFIER_POINTER (DECL_NAME (wrk->ptrdecl));
	  tree   var  = get_identifier (name);
	  tree   decl = lookup_name (var);
	    
	  if (decl == NULL_TREE)
	    {
	      /* no, not valid in this context, declare it */
	      decl = decl_temp1 (var, build_pointer_type (TREE_TYPE (enum_table_type)),
				 0, NULL_TREE, 1, 0);
	    }
	  return decl;
	}
	
      /* next one */
      wrk = wrk->forward;
    }
    
  /* not yet found -- generate an entry */
  wrk = (SAVE_ENUMS *)xmalloc (sizeof (SAVE_ENUMS));
  wrk->forward = used_enums;
  used_enums = wrk;
    
  /* generate the pointer decl */
  wrk->ptrdecl = get_unique_identifier ("ENUMTABPTR");
  wrk->ptrdecl = decl_temp1 (wrk->ptrdecl, build_pointer_type (TREE_TYPE (enum_table_type)),
			     0, NULL_TREE, 1, 0);

  /* save information for later use */
  wrk->context = context;
  wrk->type = type;

  /* insert the names and values */
  tmp = TYPE_FIELDS (type);
  wrk->num_vals = list_length (tmp);
  vals = (SAVE_ENUM_VALUES *)xmalloc (sizeof (SAVE_ENUM_VALUES) * wrk->num_vals);
  wrk->vals = vals;
    
  while (tmp != NULL_TREE)
    {
      /* search if name is already in use */
      names = used_enum_names;
      while (names != (SAVE_ENUM_NAMES *)0)
	{
	  if (names->name == TREE_PURPOSE (tmp))
	    break;
	  names = names->forward;
	}
      if (names == (SAVE_ENUM_NAMES *)0)
	{
	  /* we have to insert one */
	  names = (SAVE_ENUM_NAMES *)xmalloc (sizeof (SAVE_ENUM_NAMES));
	  names->forward = used_enum_names;
	  used_enum_names = names;
	  names->decl = NULL_TREE;
	  names->name = TREE_PURPOSE (tmp);
	}
      vals->name = names;
      vals->val = TREE_INT_CST_LOW (TREE_VALUE (tmp));
	
      /* next entry in enum */
      vals++;
      tmp = TREE_CHAIN (tmp);
    }
    
  /* return the generated decl */
  return wrk->ptrdecl;
}


static void
build_chill_io_list_type ()
{
  tree list = NULL_TREE;
  tree result, enum1, listbase;
  tree io_descriptor;
  tree decl1, decl2;
  tree forcharstring, forset_W, forset_R, forboolrange;

  tree forintrange, intunion, forsetrange, forcharrange;
  tree long_type, ulong_type, union_type;
    
  long_type = long_integer_type_node;
  ulong_type = long_unsigned_type_node;

  if (chill_io_list_type != NULL_TREE)
    /* already done */
    return;

  /* first build the enum for the desriptor */
  enum1 = start_enum (NULL_TREE);
  result = build_enumerator (get_identifier ("__IO_UNUSED"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_ByteVal"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_UByteVal"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_IntVal"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_UIntVal"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_LongVal"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_ULongVal"),
			     NULL_TREE);
  list = chainon (result, list);

  result = build_enumerator (get_identifier ("__IO_ByteLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_UByteLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_IntLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_UIntLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_LongLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_ULongLoc"),
			     NULL_TREE);
  list = chainon (result, list);

  result = build_enumerator (get_identifier ("__IO_ByteRangeLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_UByteRangeLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_IntRangeLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_UIntRangeLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_LongRangeLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_ULongRangeLoc"),
			     NULL_TREE);
  list = chainon (result, list);

  result = build_enumerator (get_identifier ("__IO_BoolVal"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_BoolLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_BoolRangeLoc"),
			     NULL_TREE);
  list = chainon (result, list);

  result = build_enumerator (get_identifier ("__IO_SetVal"),
			     NULL_TREE);
  list = chainon (result, list);

  result = build_enumerator (get_identifier ("__IO_SetLoc"),
			     NULL_TREE);
  list = chainon (result, list);

  result = build_enumerator (get_identifier ("__IO_SetRangeLoc"),
			     NULL_TREE);
  list = chainon (result, list);

  result = build_enumerator (get_identifier ("__IO_CharVal"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_CharLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_CharRangeLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_CharStrLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_CharVaryingLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_BitStrLoc"),
			     NULL_TREE);
  list = chainon (result, list);

  result = build_enumerator (get_identifier ("__IO_RealVal"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_RealLoc"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_LongRealVal"),
			     NULL_TREE);
  list = chainon (result, list);
    
  result = build_enumerator (get_identifier ("__IO_LongRealLoc"),
			     NULL_TREE);
  list = chainon (result, list);
#if 0    
  result = build_enumerator (get_identifier ("_IO_Pointer"),
			     NULL_TREE);
  list = chainon (result, list);
#endif    

  result = finish_enum (enum1, list);
  pushdecl (io_descriptor = build_decl (TYPE_DECL,
					get_identifier ("__tmp_IO_enum"),
					result));
  /* prevent seizing/granting of the decl */
  DECL_SOURCE_LINE (io_descriptor) = 0;
  satisfy_decl (io_descriptor, 0);

  /* build type for enum_tables */
  decl1 = build_decl (FIELD_DECL, get_identifier ("value"),
		      long_type);
  DECL_INITIAL (decl1) = NULL_TREE;
  decl2 = build_decl (FIELD_DECL, get_identifier ("name"),
		      build_pointer_type (char_type_node));
  DECL_INITIAL (decl2) = NULL_TREE;
  TREE_CHAIN (decl1) = decl2;
  TREE_CHAIN (decl2) = NULL_TREE;
  result = build_chill_struct_type (decl1);
  pushdecl (enum_table_type = build_decl (TYPE_DECL,
					  get_identifier ("__tmp_IO_enum_table_type"),
					  result));
  DECL_SOURCE_LINE (enum_table_type) = 0;
  satisfy_decl (enum_table_type, 0);

  /* build type for writing a set mode */
  decl1 = build_decl (FIELD_DECL, get_identifier ("value"),
		      long_type);
  DECL_INITIAL (decl1) = NULL_TREE;
  listbase = decl1;
    
  decl2 = build_decl (FIELD_DECL, get_identifier ("name_table"),
		      build_pointer_type (TREE_TYPE (enum_table_type)));
  DECL_INITIAL (decl2) = NULL_TREE;
  TREE_CHAIN (decl1) = decl2;
  decl1 = decl2;
  TREE_CHAIN (decl2) = NULL_TREE;
    
  result = build_chill_struct_type (listbase);
  pushdecl (forset_W = build_decl (TYPE_DECL,
				   get_identifier ("__tmp_WIO_set"),
				   result));
  DECL_SOURCE_LINE (forset_W) = 0;
  satisfy_decl (forset_W, 0);

  /* build type for charrange */
  decl1 = build_decl (FIELD_DECL, get_identifier ("ptr"),
		      build_pointer_type (char_type_node));
  DECL_INITIAL (decl1) = NULL_TREE;
  listbase = decl1;
    
  decl2 = build_decl (FIELD_DECL, get_identifier ("lower"),
		      long_type);
  DECL_INITIAL (decl2) = NULL_TREE;
  TREE_CHAIN (decl1) = decl2;
  decl1 = decl2;
    
  decl2 = build_decl (FIELD_DECL, get_identifier ("upper"),
		      long_type);
  DECL_INITIAL (decl2) = NULL_TREE;
  TREE_CHAIN (decl1) = decl2;
  TREE_CHAIN (decl2) = NULL_TREE;
    
  result = build_chill_struct_type (listbase);
  pushdecl (forcharrange = build_decl (TYPE_DECL,
				       get_identifier ("__tmp_IO_charrange"),
				       result));
  DECL_SOURCE_LINE (forcharrange) = 0;
  satisfy_decl (forcharrange, 0);
    
  /* type for integer range */
  decl1 = build_tree_list (NULL_TREE,
			   build_decl (FIELD_DECL,
				       get_identifier ("_slong"),
				       long_type));
  listbase = decl1;

  decl2 = build_tree_list (NULL_TREE,
			   build_decl (FIELD_DECL,
				       get_identifier ("_ulong"),
				       ulong_type));
  TREE_CHAIN (decl1) = decl2;
  TREE_CHAIN (decl2) = NULL_TREE;