Esempio n. 1
0
int
gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
  gfc_component *cmp;
  gfc_constructor *head = NULL, *tail = NULL;
  int ptr;
  tree type;

  /* The attributes of the derived type need to be bolted to the floor.  */
  result->expr_type = EXPR_STRUCTURE;

  type = gfc_typenode_for_spec (&result->ts);
  cmp = result->ts.derived->components;

  /* Run through the derived type components.  */
  for (;cmp; cmp = cmp->next)
    {
      if (head == NULL)
	head = tail = gfc_get_constructor ();
      else
	{
	  tail->next = gfc_get_constructor ();
	  tail = tail->next;
	}

      /* The constructor points to the component.  */
      tail->n.component = cmp;

      tail->expr = gfc_constant_result (cmp->ts.type, cmp->ts.kind,
					&result->where);
      tail->expr->ts = cmp->ts;

      /* Copy shape, if needed.  */
      if (cmp->as && cmp->as->rank)
	{
	  int n;

	  tail->expr->expr_type = EXPR_ARRAY;
	  tail->expr->rank = cmp->as->rank;

	  tail->expr->shape = gfc_get_shape (tail->expr->rank);
	  for (n = 0; n < tail->expr->rank; n++)
	     {
	       mpz_init_set_ui (tail->expr->shape[n], 1);
	       mpz_add (tail->expr->shape[n], tail->expr->shape[n],
			cmp->as->upper[n]->value.integer);
	       mpz_sub (tail->expr->shape[n], tail->expr->shape[n],
			cmp->as->lower[n]->value.integer);
	     }
	}

      ptr = TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl));
      gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr,
				 tail->expr);

      result->value.constructor = head;
    }
    
  return int_size_in_bytes (type);
}
Esempio n. 2
0
static int
interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
  gfc_constructor_base base = NULL;
  int array_size = 1;
  int i;
  int ptr = 0;

  /* Calculate array size from its shape and rank.  */
  gcc_assert (result->rank > 0 && result->shape);

  for (i = 0; i < result->rank; i++)
    array_size *= (int)mpz_get_ui (result->shape[i]);

  /* Iterate over array elements, producing constructors.  */
  for (i = 0; i < array_size; i++)
    {
      gfc_expr *e = gfc_get_constant_expr (result->ts.type, result->ts.kind,
					   &result->where);
      e->ts = result->ts;

      if (e->ts.type == BT_CHARACTER)
	e->value.character.length = result->value.character.length;

      gfc_constructor_append_expr (&base, e, &result->where);

      ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e);
    }

  result->value.constructor = base;
  return ptr;
}
Esempio n. 3
0
static int
interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
  int array_size = 1;
  int i;
  int ptr = 0;
  gfc_constructor *head = NULL, *tail = NULL;

  /* Calculate array size from its shape and rank.  */
  gcc_assert (result->rank > 0 && result->shape);

  for (i = 0; i < result->rank; i++)
    array_size *= (int)mpz_get_ui (result->shape[i]);

  /* Iterate over array elements, producing constructors.  */
  for (i = 0; i < array_size; i++)
    {
      if (head == NULL)
	head = tail = gfc_get_constructor ();
      else
	{
	  tail->next = gfc_get_constructor ();
	  tail = tail->next;
	}

      tail->where = result->where;
      tail->expr = gfc_constant_result (result->ts.type,
					  result->ts.kind, &result->where);
      tail->expr->ts = result->ts;

      if (tail->expr->ts.type == BT_CHARACTER)
	tail->expr->value.character.length = result->value.character.length;

      ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr,
					tail->expr);
    }
  result->value.constructor = head;

  return ptr;
}
int
gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
  gfc_component *cmp;
  gfc_constructor *head = NULL, *tail = NULL;
  int ptr;
  tree type;

  /* The attributes of the derived type need to be bolted to the floor.  */
  result->expr_type = EXPR_STRUCTURE;

  type = gfc_typenode_for_spec (&result->ts);
  cmp = result->ts.u.derived->components;

  /* Run through the derived type components.  */
  for (;cmp; cmp = cmp->next)
    {
      if (head == NULL)
	head = tail = gfc_get_constructor ();
      else
	{
	  tail->next = gfc_get_constructor ();
	  tail = tail->next;
	}

      /* The constructor points to the component.  */
      tail->n.component = cmp;

      tail->expr = gfc_constant_result (cmp->ts.type, cmp->ts.kind,
					&result->where);
      tail->expr->ts = cmp->ts;

      /* Copy shape, if needed.  */
      if (cmp->as && cmp->as->rank)
	{
	  int n;

	  tail->expr->expr_type = EXPR_ARRAY;
	  tail->expr->rank = cmp->as->rank;

	  tail->expr->shape = gfc_get_shape (tail->expr->rank);
	  for (n = 0; n < tail->expr->rank; n++)
	     {
	       mpz_init_set_ui (tail->expr->shape[n], 1);
	       mpz_add (tail->expr->shape[n], tail->expr->shape[n],
			cmp->as->upper[n]->value.integer);
	       mpz_sub (tail->expr->shape[n], tail->expr->shape[n],
			cmp->as->lower[n]->value.integer);
	     }
	}

      /* Calculate the offset, which consists of the the FIELD_OFFSET in
	 bytes, which appears in multiples of DECL_OFFSET_ALIGN-bit-sized,
	 and additional bits of FIELD_BIT_OFFSET. The code assumes that all
	 sizes of the components are multiples of BITS_PER_UNIT,
	 i.e. there are, e.g., no bit fields.  */

      ptr = TREE_INT_CST_LOW (DECL_FIELD_BIT_OFFSET (cmp->backend_decl));
      gcc_assert (ptr % 8 == 0);
      ptr = ptr/8 + TREE_INT_CST_LOW (DECL_FIELD_OFFSET (cmp->backend_decl));

      gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr,
				 tail->expr);

      result->value.constructor = head;
    }
    
  return int_size_in_bytes (type);
}