com.c

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

  if (ffe_is_emulate_complex ())
    {
      type = make_node (RECORD_TYPE);
      realfield = ffecom_decl_field (type, NULL_TREE, "r", subtype);
      imagfield = ffecom_decl_field (type, realfield, "i", subtype);
      TYPE_FIELDS (type) = realfield;
      layout_type (type);
    }
  else
    {
      type = make_node (COMPLEX_TYPE);
      TREE_TYPE (type) = subtype;
      layout_type (type);
    }

  return type;
}
#endif

/* Chooses either the gbe or the f2c way to build a
   complex constant.  */

#if FFECOM_targetCURRENT == FFECOM_targetGCC
static tree
ffecom_build_complex_constant_ (tree type, tree realpart, tree imagpart)
{
  tree bothparts;

  if (ffe_is_emulate_complex ())
    {
      bothparts = build_tree_list (TYPE_FIELDS (type), realpart);
      TREE_CHAIN (bothparts) = build_tree_list (TREE_CHAIN (TYPE_FIELDS (type)), imagpart);
      bothparts = build (CONSTRUCTOR, type, NULL_TREE, bothparts);
    }
  else
    {
      bothparts = build_complex (type, realpart, imagpart);
    }

  return bothparts;
}
#endif

#if FFECOM_targetCURRENT == FFECOM_targetGCC
static tree
ffecom_arglist_expr_ (const char *c, ffebld expr)
{
  tree list;
  tree *plist = &list;
  tree trail = NULL_TREE;	/* Append char length args here. */
  tree *ptrail = &trail;
  tree length;
  ffebld exprh;
  tree item;
  bool ptr = FALSE;
  tree wanted = NULL_TREE;
  static char zed[] = "0";

  if (c == NULL)
    c = &zed[0];

  while (expr != NULL)
    {
      if (*c != '\0')
	{
	  ptr = FALSE;
	  if (*c == '&')
	    {
	      ptr = TRUE;
	      ++c;
	    }
	  switch (*(c++))
	    {
	    case '\0':
	      ptr = TRUE;
	      wanted = NULL_TREE;
	      break;

	    case 'a':
	      assert (ptr);
	      wanted = NULL_TREE;
	      break;

	    case 'c':
	      wanted = ffecom_f2c_complex_type_node;
	      break;

	    case 'd':
	      wanted = ffecom_f2c_doublereal_type_node;
	      break;

	    case 'e':
	      wanted = ffecom_f2c_doublecomplex_type_node;
	      break;

	    case 'f':
	      wanted = ffecom_f2c_real_type_node;
	      break;

	    case 'i':
	      wanted = ffecom_f2c_integer_type_node;
	      break;

	    case 'j':
	      wanted = ffecom_f2c_longint_type_node;
	      break;

	    default:
	      assert ("bad argstring code" == NULL);
	      wanted = NULL_TREE;
	      break;
	    }
	}

      exprh = ffebld_head (expr);
      if (exprh == NULL)
	wanted = NULL_TREE;

      if ((wanted == NULL_TREE)
	  || (ptr
	      && (TYPE_MODE
		  (ffecom_tree_type[ffeinfo_basictype (ffebld_info (exprh))]
		   [ffeinfo_kindtype (ffebld_info (exprh))])
		   == TYPE_MODE (wanted))))
	*plist
	  = build_tree_list (NULL_TREE,
			     ffecom_arg_ptr_to_expr (exprh,
						     &length));
      else
	{
	  item = ffecom_arg_expr (exprh, &length);
	  item = ffecom_convert_widen_ (wanted, item);
	  if (ptr)
	    {
	      item = ffecom_1 (ADDR_EXPR,
			       build_pointer_type (TREE_TYPE (item)),
			       item);
	    }
	  *plist
	    = build_tree_list (NULL_TREE,
			       item);
	}

      plist = &TREE_CHAIN (*plist);
      expr = ffebld_trail (expr);
      if (length != NULL_TREE)
	{
	  *ptrail = build_tree_list (NULL_TREE, length);
	  ptrail = &TREE_CHAIN (*ptrail);
	}
    }

  /* We've run out of args in the call; if the implementation expects
     more, supply null pointers for them, which the implementation can
     check to see if an arg was omitted. */

  while (*c != '\0' && *c != '0')
    {
      if (*c == '&')
	++c;
      else
	assert ("missing arg to run-time routine!" == NULL);

      switch (*(c++))
	{
	case '\0':
	case 'a':
	case 'c':
	case 'd':
	case 'e':
	case 'f':
	case 'i':
	case 'j':
	  break;

	default:
	  assert ("bad arg string code" == NULL);
	  break;
	}
      *plist
	= build_tree_list (NULL_TREE,
			   null_pointer_node);
      plist = &TREE_CHAIN (*plist);
    }

  *plist = trail;

  return list;
}
#endif

#if FFECOM_targetCURRENT == FFECOM_targetGCC
static tree
ffecom_widest_expr_type_ (ffebld list)
{
  ffebld item;
  ffebld widest = NULL;
  ffetype type;
  ffetype widest_type = NULL;
  tree t;

  for (; list != NULL; list = ffebld_trail (list))
    {
      item = ffebld_head (list);
      if (item == NULL)
	continue;
      if ((widest != NULL)
	  && (ffeinfo_basictype (ffebld_info (item))
	      != ffeinfo_basictype (ffebld_info (widest))))
	continue;
      type = ffeinfo_type (ffeinfo_basictype (ffebld_info (item)),
			   ffeinfo_kindtype (ffebld_info (item)));
      if ((widest == FFEINFO_kindtypeNONE)
	  || (ffetype_size (type)
	      > ffetype_size (widest_type)))
	{
	  widest = item;
	  widest_type = type;
	}
    }

  assert (widest != NULL);
  t = ffecom_tree_type[ffeinfo_basictype (ffebld_info (widest))]
    [ffeinfo_kindtype (ffebld_info (widest))];
  assert (t != NULL_TREE);
  return t;
}
#endif

/* Check whether a partial overlap between two expressions is possible.

   Can *starting* to write a portion of expr1 change the value
   computed (perhaps already, *partially*) by expr2?

   Currently, this is a concern only for a COMPLEX expr1.  But if it
   isn't in COMMON or local EQUIVALENCE, since we don't support
   aliasing of arguments, it isn't a concern.  */

static bool
ffecom_possible_partial_overlap_ (ffebld expr1, ffebld expr2)
{
  ffesymbol sym;
  ffestorag st;

  switch (ffebld_op (expr1))
    {
    case FFEBLD_opSYMTER:
      sym = ffebld_symter (expr1);
      break;

    case FFEBLD_opARRAYREF:
      if (ffebld_op (ffebld_left (expr1)) != FFEBLD_opSYMTER)
	return FALSE;
      sym = ffebld_symter (ffebld_left (expr1));
      break;

    default:
      return FALSE;
    }

  if (ffesymbol_where (sym) != FFEINFO_whereCOMMON
      && (ffesymbol_where (sym) != FFEINFO_whereLOCAL
	  || ! (st = ffesymbol_storage (sym))
	  || ! ffestorag_parent (st)))
    return FALSE;

  /* It's in COMMON or local EQUIVALENCE.  */

  return TRUE;
}

/* Check whether dest and source might overlap.  ffebld versions of these
   might or might not be passed, will be NULL if not.

   The test is really whether source_tree is modifiable and, if modified,
   might overlap destination such that the value(s) in the destination might
   change before it is finally modified.  dest_* are the canonized
   destination itself.  */

#if FFECOM_targetCURRENT == FFECOM_targetGCC
static bool
ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size,
		 tree source_tree, ffebld source UNUSED,
		 bool scalar_arg)
{
  tree source_decl;
  tree source_offset;
  tree source_size;
  tree t;

  if (source_tree == NULL_TREE)
    return FALSE;

  switch (TREE_CODE (source_tree))
    {
    case ERROR_MARK:
    case IDENTIFIER_NODE:
    case INTEGER_CST:
    case REAL_CST:
    case COMPLEX_CST:
    case STRING_CST:
    case CONST_DECL:
    case VAR_DECL:
    case RESULT_DECL:
    case FIELD_DECL:
    case MINUS_EXPR:
    case MULT_EXPR:
    case TRUNC_DIV_EXPR:
    case CEIL_DIV_EXPR:
    case FLOOR_DIV_EXPR:
    case ROUND_DIV_EXPR:
    case TRUNC_MOD_EXPR:
    case CEIL_MOD_EXPR:
    case FLOOR_MOD_EXPR:
    case ROUND_MOD_EXPR:
    case RDIV_EXPR:
    case EXACT_DIV_EXPR:
    case FIX_TRUNC_EXPR:
    case FIX_CEIL_EXPR:
    case FIX_FLOOR_EXPR:
    case FIX_ROUND_EXPR:
    case FLOAT_EXPR:
    case EXPON_EXPR:
    case NEGATE_EXPR:
    case MIN_EXPR:
    case MAX_EXPR:
    case ABS_EXPR:
    case FFS_EXPR:
    case LSHIFT_EXPR:
    case RSHIFT_EXPR:
    case LROTATE_EXPR:
    case RROTATE_EXPR:
    case BIT_IOR_EXPR:
    case BIT_XOR_EXPR:
    case BIT_AND_EXPR:
    case BIT_ANDTC_EXPR:
    case BIT_NOT_EXPR:
    case TRUTH_ANDIF_EXPR:
    case TRUTH_ORIF_EXPR:
    case TRUTH_AND_EXPR:
    case TRUTH_OR_EXPR:
    case TRUTH_XOR_EXPR:
    case TRUTH_NOT_EXPR:
    case LT_EXPR:
    case LE_EXPR:
    case GT_EXPR:
    case GE_EXPR:
    case EQ_EXPR:
    case NE_EXPR:
    case COMPLEX_EXPR:
    case CONJ_EXPR:
    case REALPART_EXPR:
    case IMAGPART_EXPR:
    case LABEL_EXPR:
    case COMPONENT_REF:
      return FALSE;

    case COMPOUND_EXPR:
      return ffecom_overlap_ (dest_decl, dest_offset, dest_size,
			      TREE_OPERAND (source_tree, 1), NULL,
			      scalar_arg);

    case MODIFY_EXPR:
      return ffecom_overlap_ (dest_decl, dest_offset, dest_size,
			      TREE_OPERAND (source_tree, 0), NULL,
			      scalar_arg);

    case CONVERT_EXPR:
    case NOP_EXPR:
    case NON_LVALUE_EXPR:
    case PLUS_EXPR:
      if (TREE_CODE (TREE_TYPE (source_tree)) != POINTER_TYPE)
	return TRUE;

      ffecom_tree_canonize_ptr_ (&source_decl, &source_offset,
				 source_tree);
      source_size = TYPE_SIZE (TREE_TYPE (TREE_TYPE (source_tree)));
      break;

    case COND_EXPR:
      return
	ffecom_overlap_ (dest_decl, dest_offset, dest_size,
			 TREE_OPERAND (source_tree, 1), NULL,
			 scalar_arg)
	  || ffecom_overlap_ (dest_decl, dest_offset, dest_size,
			      TREE_OPERAND (source_tree, 2), NULL,
			      scalar_arg);


    case ADDR_EXPR:
      ffecom_tree_canonize_ref_ (&source_decl, &source_offset,
				 &source_size,
				 TREE_OPERAND (source_tree, 0));
      break;

    case PARM_DECL:
      if (TREE_CODE (TREE_TYPE (source_tree)) != POINTER_TYPE)
	return TRUE;

      source_decl = source_tree;
      source_offset = size_zero_node;
      source_size = TYPE_SIZE (TREE_TYPE (TREE_TYPE (source_tree)));
      break;

    case SAVE_EXPR:
    case REFERENCE_EXPR:
    case PREDECREMENT_EXPR:
    case PREINCREMENT_EXPR:
    case POSTDECREMENT_EXPR:
    case POSTINCREMENT_EXPR:
    case INDIRECT_REF:
    case ARRAY_REF:
    case CALL_EXPR:
    default:
      return TRUE;
    }

  /* Come here when source_decl, source_offset, and source_size filled
     in appropriately.  */

  if (source_decl == NULL_TREE)
    return FALSE;		/* No decl involved, so no overlap. */

  if (source_decl != dest_decl)
    return FALSE;		/* Different decl, no overlap. */

  if (TREE_CODE (dest_size) == ERROR_MARK)
    return TRUE;		/* Assignment into entire assumed-size
				   array?  Shouldn't happen.... */

  t = ffecom_2 (LE_EXPR, integer_type_node,
		ffecom_2 (PLUS_EXPR, TREE_TYPE (dest_offset),
			  dest_offset,
			  convert (TREE_TYPE (dest_offset),
				   dest_size)),
		convert (TREE_TYPE (dest_offset),
			 source_offset));

  if (integer_onep (t))
    return FALSE;		/* Destination precedes source. */

  if (!scalar_arg
      || (source_size == NULL_TREE)
      || (TREE_CODE (source_size) == ERROR_MARK)
      || integer_zerop (source_size))
    return TRUE;		/* No way to tell if dest follows source. */

  t = ffecom_2 (LE_EXPR, integer_type_node,
		ffecom_2 (PLUS_EXPR, TREE_TYPE (source_offset),
			  source_offset,
			  convert (TREE_TYPE (source_offset),
				   source_size)),
		convert (TREE_TYPE (source_offset),