inout.c

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

  builtin_function ("__disconnect", void_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__dissociate", void_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__eoln", bool_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__existing", bool_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__getassociation", ptr_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__gettextaccess", ptr_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__gettextindex", luns_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__gettextrecord", ptr_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__getusage", int_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__indexable", bool_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__isassociated", bool_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__modify", void_ftype_ptr_ptr_int_ptr_int_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__outoffile", bool_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__readable", bool_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__readrecord", ptr_ftype_ptr_int_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__readtext_f", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__readtext_s", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__sequencible", bool_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__settextaccess", void_ftype_ptr_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__settextindex", void_ftype_ptr_int_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__settextrecord", void_ftype_ptr_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__variable", bool_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__writeable", bool_ftype_ptr_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__writerecord", void_ftype_ptr_int_ptr_luns_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__writetext_f", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);
  builtin_function ("__writetext_s", void_ftype_ptr_int_ptr_int_ptr_int_ptr_int,
		    NOT_BUILT_IN, NULL_PTR);

  /* declare ASSOCIATION, ACCESS, and TEXT modes */
  build_io_types ();

  /* declare the predefined text locations */
  declare_predefined_file ((ignore_case || ! special_UC) ?  "stdin" : "STDIN",
			   "chill_stdin");
  declare_predefined_file ((ignore_case || ! special_UC) ?  "stdout" : "STDOUT",
			   "chill_stdout");
  declare_predefined_file ((ignore_case || ! special_UC) ?  "stderr" : "STDERR",
			   "chill_stderr");

  /* last, but not least, build the chill IO-list type */
  build_chill_io_list_type ();

  maximum_field_alignment = save_maximum_field_alignment;
}

/* function returns the recordmode of an ACCESS */
tree
access_recordmode (access)
     tree access;
{
  tree field;

  if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
    return NULL_TREE;
  if (! CH_IS_ACCESS_MODE (access))
    return NULL_TREE;

  field = TYPE_FIELDS (access);
  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
    {
      if (TREE_CODE (field) == TYPE_DECL &&
	  DECL_NAME (field) == get_identifier ("__recordmode"))
	return TREE_TYPE (field);
    }
  return void_type_node;
}

/* function invalidates the recordmode of an ACCESS */
void
invalidate_access_recordmode (access)
     tree access;
{
  tree field;

  if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
    return;
  if (! CH_IS_ACCESS_MODE (access))
    return;

  field = TYPE_FIELDS (access);
  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
    {
      if (TREE_CODE (field) == TYPE_DECL &&
	  DECL_NAME (field) == get_identifier ("__recordmode"))
	{
	  TREE_TYPE (field) = error_mark_node;
	  return;
	}
    }
}

/* function returns the index mode of an ACCESS if there is one,
   otherwise NULL_TREE */
tree
access_indexmode (access)
     tree access;
{
  tree field;

  if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
    return NULL_TREE;
  if (! CH_IS_ACCESS_MODE (access))
    return NULL_TREE;

  field = TYPE_FIELDS (access);
  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
    {
      if (TREE_CODE (field) == TYPE_DECL &&
	  DECL_NAME (field) == get_identifier ("__indexmode"))
	return TREE_TYPE (field);
    }
  return void_type_node;
}

/* function returns one if an ACCESS was specified DYNAMIC, otherwise zero */
tree
access_dynamic (access)
     tree access;
{
  tree field;

  if (access == NULL_TREE || TREE_CODE (access) == ERROR_MARK)
    return NULL_TREE;
  if (! CH_IS_ACCESS_MODE (access))
    return NULL_TREE;

  field = TYPE_FIELDS (access);
  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
    {
      if (TREE_CODE (field) == CONST_DECL)
	return DECL_INITIAL (field);
    }
  return integer_zero_node;
}

#if 0
   returns a structure like
   STRUCT (data STRUCT (flags ULONG,
                        reclength ULONG,
                        lowindex LONG,
                        highindex LONG,
                        association PTR,
                        base ULONG,
                        store_loc PTR,
                        rectype LONG),
   this is followed by a
   TYPE_DECL __recordmode recordmode ? recordmode : void_type_node
   TYPE_DECL __indexmode  indexmode  ? indexmode  : void_type_node
   CONST_DECL __dynamic   dynamic ? integer_one_node : integer_zero_node
#endif

static tree
build_access_part ()
{
  tree listbase, decl;

  listbase = build_decl (FIELD_DECL, get_identifier ("flags"),
			 long_unsigned_type_node);
  decl = build_decl (FIELD_DECL, get_identifier ("reclength"),
		     long_unsigned_type_node);
  listbase = chainon (listbase, decl);
  decl = build_decl (FIELD_DECL, get_identifier ("lowindex"),
		     long_unsigned_type_node);
  listbase = chainon (listbase, decl);
  decl = build_decl (FIELD_DECL, get_identifier ("highindex"),
		     long_integer_type_node);
  listbase = chainon (listbase, decl);
  decl = build_decl (FIELD_DECL, get_identifier ("association"),
		     ptr_type_node);
  listbase = chainon (listbase, decl);
  decl = build_decl (FIELD_DECL, get_identifier ("base"),
		     long_unsigned_type_node);
  listbase = chainon (listbase, decl);
  decl = build_decl (FIELD_DECL, get_identifier ("storelocptr"),
		     ptr_type_node);
  listbase = chainon (listbase, decl);
  decl = build_decl (FIELD_DECL, get_identifier ("rectype"),
		     long_integer_type_node);
  listbase = chainon (listbase, decl);
  return build_chill_struct_type (listbase);
}

tree
build_access_mode (indexmode, recordmode, dynamic)
     tree indexmode;
     tree recordmode;
     int dynamic;
{
  tree type, listbase, decl, datamode;

  if (indexmode != NULL_TREE && TREE_CODE (indexmode) == ERROR_MARK)
    return error_mark_node;
  if (recordmode != NULL_TREE && TREE_CODE (recordmode) == ERROR_MARK)
    return error_mark_node;

  datamode = build_access_part ();
  
  type = make_node (RECORD_TYPE);
  listbase = build_decl (FIELD_DECL, get_identifier ("data"),
			 datamode);
  TYPE_FIELDS (type) = listbase;
  decl = build_lang_decl (TYPE_DECL, get_identifier ("__recordmode"),
			  recordmode == NULL_TREE ? void_type_node : recordmode);
  chainon (listbase, decl);
  decl = build_lang_decl (TYPE_DECL, get_identifier ("__indexmode"),
			  indexmode == NULL_TREE ? void_type_node : indexmode);
  chainon (listbase, decl);
  decl = build_decl (CONST_DECL, get_identifier ("__dynamic"),
		     integer_type_node);
  DECL_INITIAL (decl) = dynamic ? integer_one_node : integer_zero_node;
  chainon (listbase, decl);
  CH_IS_ACCESS_MODE (type) = 1;
  CH_TYPE_NONVALUE_P (type) = 1;
  return type;
}

#if 0
  returns a structure like:
  STRUCT (txt STRUCT (flags ULONG,
                      text_record PTR,
                      access_sub PTR,
                      actual_index LONG),
          acc STRUCT (flags ULONG,
                      reclength ULONG,
                      lowindex LONG,
                      highindex LONG,
                      association PTR,
                      base ULONG,
                      store_loc PTR,
                      rectype LONG),
          tloc CHARS(textlength) VARYING;
          )
  followed by
  TYPE_DECL __indexmode indexmode ? indexmode : void_type_node
  CONST_DECL __text_length
  CONST_DECL __dynamic  dynamic ? integer_one_node : integer_zero_node
#endif
tree
build_text_mode (textlength, indexmode, dynamic)
     tree textlength;
     tree indexmode;
     int dynamic;
{
  tree txt, acc, listbase, decl, type, tltype;
  tree savedlength = textlength;

  if (indexmode != NULL_TREE && TREE_CODE (indexmode) == ERROR_MARK)
    return error_mark_node;
  if (textlength == NULL_TREE || TREE_CODE (textlength) == ERROR_MARK)
    return error_mark_node;

  /* build the structure */
  listbase = build_decl (FIELD_DECL, get_identifier ("flags"),
			 long_unsigned_type_node);
  decl = build_decl (FIELD_DECL, get_identifier ("text_record"),
		     ptr_type_node);
  listbase = chainon (listbase, decl);
  decl = build_decl (FIELD_DECL, get_identifier ("access_sub"),
		     ptr_type_node);
  listbase = chainon (listbase, decl);
  decl = build_decl (FIELD_DECL, get_identifier ("actual_index"),
		     long_integer_type_node);
  listbase = chainon (listbase, decl);
  txt = build_chill_struct_type (listbase);

  acc = build_access_part ();

  type = make_node (RECORD_TYPE);
  listbase = build_decl (FIELD_DECL, get_identifier ("txt"), txt);
  TYPE_FIELDS (type) = listbase;
  decl = build_decl (FIELD_DECL, get_identifier ("acc"), acc);
  chainon (listbase, decl);
  /* the text location */
  tltype = build_string_type (char_type_node, textlength);
  tltype = build_varying_struct (tltype);
  decl = build_decl (FIELD_DECL, get_identifier ("tloc"),
		     tltype);
  chainon (listbase, decl);
  /* the index mode */
  decl = build_lang_decl (TYPE_DECL, get_identifier ("__indexmode"),
			  indexmode == NULL_TREE ? void_type_node : indexmode);
  chainon (listbase, decl);
  /* save dynamic */
  decl = build_decl (CONST_DECL, get_identifier ("__textlength"),
		     integer_type_node);
  if (TREE_CODE (textlength) == COMPONENT_REF)
    /* FIXME: we cannot use one and the same COMPONENT_REF twice, so build
       another one */
    savedlength = build_component_ref (TREE_OPERAND (textlength, 0),
				       TREE_OPERAND (textlength, 1));
  DECL_INITIAL (decl) = savedlength;
  chainon (listbase, decl);
  /* save dynamic */
  decl = build_decl (CONST_DECL, get_identifier ("__dynamic"),
		     integer_type_node);
  DECL_INITIAL (decl) = dynamic ? integer_one_node : integer_zero_node;
  chainon (listbase, decl);
  CH_IS_TEXT_MODE (type) = 1;
  CH_TYPE_NONVALUE_P (type) = 1;
  return type;
}

tree
check_text_length (length)
     tree length;
{
  if (length == NULL_TREE || TREE_CODE (length) == ERROR_MARK)
    return length;
  if (TREE_TYPE (length) == NULL_TREE
      || !CH_SIMILAR (TREE_TYPE (length), integer_type_node))
    {
      error ("non-integral text length");
      return integer_one_node;
    }
  if (TREE_CODE (length) != INTEGER_CST)
    {
      error ("non-constant text length");
      return integer_one_node;
    }
  if (compare_int_csts (LE_EXPR, length, integer_zero_node))
    {
      error ("text length must be greater then 0");
      return integer_one_node;
    }
  return length;
}

tree
text_indexmode (text)
     tree text;
{
  tree field;

  if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
    return NULL_TREE;
  if (! CH_IS_TEXT_MODE (text))
    return NULL_TREE;

  field = TYPE_FIELDS (text);
  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
    {
      if (TREE_CODE (field) == TYPE_DECL)
	return TREE_TYPE (field);
    }
  return void_type_node;
}

tree
text_dynamic (text)
     tree text;
{
  tree field;

  if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
    return NULL_TREE;
  if (! CH_IS_TEXT_MODE (text))
    return NULL_TREE;

  field = TYPE_FIELDS (text);
  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
    {
      if (TREE_CODE (field) == CONST_DECL &&
	  DECL_NAME (field) == get_identifier ("__dynamic"))
	return DECL_INITIAL (field);
    }
  return integer_zero_node;
}

tree
text_length (text)
     tree text;
{
  tree field;

  if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
    return NULL_TREE;
  if (! CH_IS_TEXT_MODE (text))
    return NULL_TREE;

  field = TYPE_FIELDS (text);
  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
    {
      if (TREE_CODE (field) == CONST_DECL &&
	  DECL_NAME (field) == get_identifier ("__textlength"))
	return DECL_INITIAL (field);
    }
  return integer_zero_node;
}

static tree
textlocation_mode (text)
     tree text;
{
  tree field;

  if (text == NULL_TREE || TREE_CODE (text) == ERROR_MARK)
    return NULL_TREE;
  if (! CH_IS_TEXT_MODE (text))
    return NULL_TREE;

  field = TYPE_FIELDS (text);
  for ( ; field != NULL_TREE; field = TREE_CHAIN (field))
    {
      if (TREE_CODE (field) == FIELD_DECL &&
	  DECL_NAME (field) == get_identifier ("tloc"))