decl.c

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

	  pop_obstacks ();
	}
      make_function_rtl (fndecl);
    }
  else
    {
      fndecl = get_next_decl (); 
      finish_decl (fndecl);
    }
#if 0
  
  if (granting)
    push_granted (name, decl);
  else
    pushdecl(decl);
#endif
  return fndecl;
}



void
push_extern_process (name, argtypes, exceptions, granting)
     tree name, argtypes, exceptions;
     int  granting;
{
  tree decl, func, arglist;
  
  push_obstacks_nochange ();
  end_temporary_allocation ();
  
  if (pass < 2)
    {
      tree proc_struct = make_process_struct (name, argtypes);
      arglist = (argtypes == NULL_TREE) ? NULL_TREE :
	tree_cons (NULL_TREE,
		   build_chill_pointer_type (proc_struct), NULL_TREE);
    }
  else
    arglist = NULL_TREE;

  func = push_extern_function (name, NULL_TREE, arglist,
			       exceptions, granting);

  /* declare the code variable */
  decl = generate_tasking_code_variable (name, &process_type, 1);
  CH_DECL_PROCESS (func) = 1;
  /* remember the code variable in the function decl */
  DECL_TASKING_CODE_DECL (func) = (struct lang_decl *)decl;

  add_taskstuff_to_list (decl, "_TT_Process", NULL_TREE, func, NULL_TREE);
}

void
push_extern_signal (signame, sigmodelist, optsigdest)
     tree signame, sigmodelist, optsigdest;
{
  tree decl, sigtype;

  push_obstacks_nochange ();
  end_temporary_allocation ();
  
  sigtype = 
    build_signal_struct_type (signame, sigmodelist, optsigdest);
  
  /* declare the code variable outside the process */
  decl = generate_tasking_code_variable (signame, &signal_code, 1);
  add_taskstuff_to_list (decl, "_TT_Signal", NULL_TREE, sigtype, NULL_TREE);
}

void
print_mode (mode)
     tree mode;
{
  while (mode != NULL_TREE)
    {
      switch (TREE_CODE (mode))
	{
	case POINTER_TYPE:
	  printf (" REF ");
	  mode = TREE_TYPE (mode);
	  break;
	case INTEGER_TYPE:
	case REAL_TYPE:
	  printf (" %s ", IDENTIFIER_POINTER (DECL_NAME (TYPE_NAME (mode))));
	  mode = NULL_TREE;
	  break;
	case ARRAY_TYPE:
	  {
	    tree itype = TYPE_DOMAIN (mode);
	    if (CH_STRING_TYPE_P (mode))
	      {
		fputs (" STRING (", stdout);
		printf (HOST_WIDE_INT_PRINT_DEC,
			TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype)));
		fputs (") OF ", stdout);
	      }
	    else
	      {
		fputs (" ARRAY (", stdout);
		printf (HOST_WIDE_INT_PRINT_DEC,
			TREE_INT_CST_LOW (TYPE_MIN_VALUE (itype)));
		fputs (":", stdout);
		printf (HOST_WIDE_INT_PRINT_DEC,
			TREE_INT_CST_LOW (TYPE_MAX_VALUE (itype)));
		fputs (") OF ", stdout);
	      }
	    mode = TREE_TYPE (mode);
	    break;
	  }
	case RECORD_TYPE:
	  {
	    tree fields = TYPE_FIELDS (mode);
	    printf (" RECORD (");
	    while (fields != NULL_TREE)
	      {
		printf (" %s:", IDENTIFIER_POINTER (DECL_NAME (fields)));
		print_mode (TREE_TYPE (fields));
		if (TREE_CHAIN (fields))
		  printf (",");
		fields = TREE_CHAIN (fields);
	      }
	    printf (")");
	    mode = NULL_TREE;
	    break;
	  }
	default:
	  abort ();
	}
    }
}

tree
chill_munge_params (nodes, type, attr)
     tree nodes, type, attr;
{
  tree node;
  if (pass == 1)
    {
      /* Convert the list of identifiers to a list of types. */
      for (node = nodes; node != NULL_TREE; node = TREE_CHAIN (node))
	{
	  TREE_VALUE (node) = type;  /* this was the identifier node */
	  TREE_PURPOSE (node) = attr;
	}
    }
  return nodes;
}

/* Push the declarations described by SYN_DEFS into the current scope.  */
void
push_syndecl (name, mode, value)
     tree name, mode, value;
{
  if (pass == 1)
    {
      tree decl = make_node (CONST_DECL);
      DECL_NAME (decl) = name;
      DECL_ASSEMBLER_NAME (decl) = name;
      TREE_TYPE (decl) = mode;
      DECL_INITIAL (decl) = value;
      TREE_READONLY (decl) = 1;
      save_decl (decl);
      if (in_pseudo_module)
	push_granted (DECL_NAME (decl), decl);
    }
  else /* pass == 2 */
    get_next_decl ();
}



/* Push the declarations described by (MODENAME,MODE) into the current scope.
   MAKE_NEWMODE is 1 for NEWMODE, 0 for SYNMODE, and
   -1 for internal use (in which case the mode does not need to be copied). */

tree
push_modedef (modename, mode, make_newmode)
     tree modename;
     tree mode;  /* ignored if pass==2. */
     int make_newmode;
{
  tree newdecl, newmode;
  
  if (pass == 1)
    {
      /* FIXME: need to check here for SYNMODE fred fred; */
      push_obstacks (&permanent_obstack, &permanent_obstack);

      newdecl = build_lang_decl (TYPE_DECL, modename, mode);

      if (make_newmode >= 0)
	{
	  newmode = make_node (LANG_TYPE);
	  TREE_TYPE (newmode) = mode;
	  TREE_TYPE (newdecl) = newmode;
	  TYPE_NAME (newmode) = newdecl;
	  if (make_newmode > 0)
	    CH_NOVELTY (newmode) = newdecl;
	}

      save_decl (newdecl);
      pop_obstacks ();
	  
    }
  else /* pass == 2 */
    {
      /* FIXME: need to check here for SYNMODE fred fred; */
      newdecl = get_next_decl ();
      if (DECL_NAME (newdecl) != modename)
	abort ();
      if (TREE_CODE (TREE_TYPE (newdecl)) != ERROR_MARK)
	{
	  /* ASSOCIATION, ACCESS, TEXT, BUFFER, and EVENT must not be READOnly */
	  if (TREE_READONLY (TREE_TYPE (newdecl)) &&
	      (CH_IS_ASSOCIATION_MODE (TREE_TYPE (newdecl)) ||
	       CH_IS_ACCESS_MODE (TREE_TYPE (newdecl)) ||
	       CH_IS_TEXT_MODE (TREE_TYPE (newdecl)) ||
	       CH_IS_BUFFER_MODE (TREE_TYPE (newdecl)) ||
	       CH_IS_EVENT_MODE (TREE_TYPE (newdecl))))
	    error_with_decl (newdecl, "`%s' must not be READonly");
	  rest_of_decl_compilation (newdecl, NULL_PTR,
				    global_bindings_p (), 0);
	}
    }
  return newdecl;
}

/* Return a chain of FIELD_DECLs for the names in NAMELIST.  All of
   of type TYPE.  When NAMELIST is passed in from the parser, it is
   in reverse order.
   LAYOUT is (NULL_TREE, integer_one_node, integer_zero_node, tree_list),
   meaning (default, pack, nopack, POS (...) ).  */

tree
grok_chill_fixedfields (namelist, type, layout)
     tree namelist, type;
     tree layout;
{
  tree decls = NULL_TREE;
  
  if (layout != NULL_TREE && TREE_CHAIN (namelist) != NULL_TREE)
    {
      if (layout != integer_one_node && layout != integer_zero_node)
	{
	  layout = NULL_TREE;
	  error ("POS may not be specified for a list of field declarations");
	}
    }

  /* we build the chain of FIELD_DECLs backwards, effectively
     unreversing the reversed names in NAMELIST.  */
  for (; namelist; namelist = TREE_CHAIN (namelist))
    {
      tree decl = build_decl (FIELD_DECL, 
			      TREE_VALUE (namelist), type);
      DECL_INITIAL (decl) = layout;
      TREE_CHAIN (decl) = decls;
      decls = decl;
    }
  
  return decls;
}

struct tree_pair
{
  tree value;
  tree decl;
};


/* Function to help qsort sort variant labels by value order.  */
static int
label_value_cmp (x, y)
     struct tree_pair *x, *y;
{
  return TREE_INT_CST_LOW (x->value) - TREE_INT_CST_LOW (y->value);
}

tree
make_chill_variants (tagfields, body, variantelse)
     tree tagfields;
     tree body;
     tree variantelse;
{
  tree utype;
  tree first = NULL_TREE;
  for (; body; body = TREE_CHAIN (body))
    {
      tree decls = TREE_VALUE (body);
      tree labellist = TREE_PURPOSE (body);

      if (labellist != NULL_TREE
	  && TREE_CODE (TREE_VALUE (labellist)) == TREE_LIST
	  && TREE_VALUE (TREE_VALUE (labellist)) == case_else_node
	  && TREE_CHAIN (labellist) == NULL_TREE)
	{
	  if (variantelse)
	    error ("(ELSE) case label as well as ELSE variant");
	  variantelse = decls;
	}
      else
	{
	  tree rtype = start_struct (RECORD_TYPE, NULL_TREE);
	  rtype = finish_struct (rtype, decls);

	  first = chainon (first, build_decl (FIELD_DECL, NULL_TREE, rtype));
      
	  TYPE_TAG_VALUES (rtype) = labellist;
	}
    }
  
  if (variantelse != NULL_TREE)
    {
      tree rtype = start_struct (RECORD_TYPE, NULL_TREE);
      rtype = finish_struct (rtype, variantelse);
      first = chainon (first,
		       build_decl (FIELD_DECL,
				   ELSE_VARIANT_NAME, rtype));
    }
  
  utype = start_struct (UNION_TYPE, NULL_TREE);
  utype = finish_struct (utype, first);
  TYPE_TAGFIELDS (utype) = tagfields;
  return utype;
}

tree
layout_chill_variants (utype)
     tree utype;
{
  tree first = TYPE_FIELDS (utype);
  int nlabels, label_index = 0;
  struct tree_pair *label_value_array;
  tree decl;
  extern int errorcount;
  
  if (TYPE_SIZE (utype))
    return utype;
  
  for (decl = first; decl; decl = TREE_CHAIN (decl))
    {
      tree tagfields = TYPE_TAGFIELDS (utype);
      tree t = TREE_TYPE (decl);
      tree taglist = TYPE_TAG_VALUES (t);
      if (DECL_NAME (decl) == ELSE_VARIANT_NAME)
	continue;
      if (tagfields == NULL_TREE)
	continue;
      for ( ; tagfields != NULL_TREE && taglist != NULL_TREE;
	   tagfields = TREE_CHAIN (tagfields), taglist = TREE_CHAIN (taglist))
	{
	  tree labellist = TREE_VALUE (taglist);
	  for (; labellist; labellist = TREE_CHAIN (labellist))
	    {
	      int compat_error = 0;
	      tree label_value = TREE_VALUE (labellist);
	      if (TREE_CODE (label_value) == RANGE_EXPR)
		{
		  if (TREE_OPERAND (label_value, 0) != NULL_TREE)
		    {
		      if (!CH_COMPATIBLE (TREE_OPERAND (label_value, 0),
					  TREE_TYPE (TREE_VALUE (tagfields)))
			  || !CH_COMPATIBLE (TREE_OPERAND (label_value, 1),
					     TREE_TYPE (TREE_VALUE (tagfields))))
			compat_error = 1;
		    }
		}
	      else if (TREE_CODE (label_value) == TYPE_DECL)
		{
		  if (!CH_COMPATIBLE (label_value,
				      TREE_TYPE (TREE_VALUE (tagfields))))
		    compat_error = 1;
		}
	      else if (TREE_CODE (label_value) == INTEGER_CST)
		{
		  if (!CH_COMPATIBLE (label_value,
				      TREE_TYPE (TREE_VALUE (tagfields))))
		    compat_error = 1;
		}
	      if (compat_error)
		{
		  if (TYPE_FIELDS (t) == NULL_TREE)
		    error ("inconsistent modes between labels and tag field");
		  else 
		    error_with_decl (TYPE_FIELDS (t),
				     "inconsistent modes between labels and tag field");
		}
	    }
	}
      if (tagfields != NULL_TREE)
	error ("too few tag labels");
      if (taglist != NULL_TREE)
	error ("too many tag labels");
    }

  /* Compute the number of labels to be checked for duplicates.  */
  nlabels = 0;
  for (decl = first; decl; decl = TREE_CHAIN (decl))
    {
      tree t = TREE_TYPE (decl);
       /* Only one tag (first case_label_list) supported, for now. */
      tree labellist = TYPE_TAG_VALUES (t);
      if (labellist)
	labellist = TREE_VALUE (labellist);
      
      for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist))
	if (TREE_CODE (TREE_VALUE (labellist)) == INTEGER_CST)
	  nlabels++;
    }

  /* Check for duplicate label values.  */
  label_value_array = (struct tree_pair *)alloca (nlabels * sizeof (struct tree_pair));
  for (decl = first; decl; decl = TREE_CHAIN (decl))
    {
      tree t = TREE_TYPE (decl);
       /* Only one tag (first case_label_list) supported, for now. */
      tree labellist = TYPE_TAG_VALUES (t);
      if (labellist)
	labellist = TREE_VALUE (labellist);
      
      for (; labellist != NULL_TREE; labellist = TREE_CHAIN (labellist))
	{
	  struct tree_pair p;
	  
	  tree x = TREE_VALUE (labellist);
	  if (TREE_CODE (x) == RANGE_EXPR)
	    {
	      if (TREE_OPERAND (x, 0) != NULL_TREE)
		{
		  if (TREE_CODE (TREE_OPERAND (x, 0)) != INTEGER_CST)
		    error ("case label lower limit is not a discrete constant expression");
		  if (TREE_CODE (TREE_OPERAND (x, 1)) != INTEGER_CST)
		    error ("case label upper limit is not a discrete constant expression");
		}
	      continue;
	    }
	  else if (TREE_CODE (x) == TYPE_DECL)
	    continue;
	  else if (TREE_CODE (x) == ERROR_MARK)
	    continue;
	  else if (TREE_CODE (x) != INTEGER_CST) /* <-- FIXME: what about CONST_DECLs? */
	    {
	      error ("case label must be a discrete constant expression");
	      continue;
	    }
	  
	  if (TREE_CODE (x) == CONST_DECL)
	    x = DECL_INITIAL (x);