예제 #1
0
int
gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
#ifdef HAVE_mpc
		       mpc_t complex
#else
		       mpfr_t real, mpfr_t imaginary
#endif
		       )
{
  int size;
  size = gfc_interpret_float (kind, &buffer[0], buffer_size,
#ifdef HAVE_mpc
			      mpc_realref (complex)
#else
			      real
#endif
			      );
  size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
#ifdef HAVE_mpc
			       mpc_imagref (complex)
#else
			       imaginary
#endif
			       );
  return size;
}
int
gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
		   mpfr_t real, mpfr_t imaginary)
{
  int size;
  size = gfc_interpret_float (kind, &buffer[0], buffer_size, real);
  size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
			       imaginary);
  return size;
}
int
gfc_interpret_complex (int kind, unsigned char *buffer, size_t buffer_size,
		       mpc_t complex)
{
  int size;
  size = gfc_interpret_float (kind, &buffer[0], buffer_size,
			      mpc_realref (complex));
  size += gfc_interpret_float (kind, &buffer[size], buffer_size - size,
			       mpc_imagref (complex));
  return size;
}
예제 #4
0
bool
gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts)
{
  size_t buffer_size, boz_bit_size, ts_bit_size;
  int index;
  unsigned char *buffer;

  if (!expr->is_boz)
    return true;

  gcc_assert (expr->expr_type == EXPR_CONSTANT
	      && expr->ts.type == BT_INTEGER);

  /* Don't convert BOZ to logical, character, derived etc.  */
  if (ts->type == BT_REAL)
    {
      buffer_size = size_float (ts->kind);
      ts_bit_size = buffer_size * 8;
    }
  else if (ts->type == BT_COMPLEX)
    {
      buffer_size = size_complex (ts->kind);
      ts_bit_size = buffer_size * 8 / 2;
    }
  else
    return true;

  /* Convert BOZ to the smallest possible integer kind.  */
  boz_bit_size = mpz_sizeinbase (expr->value.integer, 2);

  if (boz_bit_size > ts_bit_size)
    {
      gfc_error_now ("BOZ constant at %L is too large (%ld vs %ld bits)",
		     &expr->where, (long) boz_bit_size, (long) ts_bit_size);
      return false;
    }

  for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
    if ((unsigned) gfc_integer_kinds[index].bit_size >= ts_bit_size)
      break;

  expr->ts.kind = gfc_integer_kinds[index].kind;
  buffer_size = MAX (buffer_size, size_integer (expr->ts.kind));

  buffer = (unsigned char*)alloca (buffer_size);
  encode_integer (expr->ts.kind, expr->value.integer, buffer, buffer_size);
  mpz_clear (expr->value.integer);

  if (ts->type == BT_REAL)
    {
      mpfr_init (expr->value.real);
      gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real);
    }
  else
    {
#ifdef HAVE_mpc
      mpc_init2 (expr->value.complex, mpfr_get_default_prec());
#else
      mpfr_init (expr->value.complex.r);
      mpfr_init (expr->value.complex.i);
#endif
      gfc_interpret_complex (ts->kind, buffer, buffer_size,
#ifdef HAVE_mpc
			     expr->value.complex
#else
			     expr->value.complex.r, expr->value.complex.i
#endif
			     );
    }
  expr->is_boz = 0;  
  expr->ts.type = ts->type;
  expr->ts.kind = ts->kind;

  return true;
}
예제 #5
0
/* Read a binary buffer to a constant expression.  */
int
gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size,
			   gfc_expr *result)
{
  if (result->expr_type == EXPR_ARRAY)
    return interpret_array (buffer, buffer_size, result);

  switch (result->ts.type)
    {
    case BT_INTEGER:
      result->representation.length = 
        gfc_interpret_integer (result->ts.kind, buffer, buffer_size,
			       result->value.integer);
      break;

    case BT_REAL:
      result->representation.length = 
        gfc_interpret_float (result->ts.kind, buffer, buffer_size,
    			     result->value.real);
      break;

    case BT_COMPLEX:
      result->representation.length = 
        gfc_interpret_complex (result->ts.kind, buffer, buffer_size,
#ifdef HAVE_mpc
			       result->value.complex
#else
			       result->value.complex.r,
			       result->value.complex.i
#endif
			       );
      break;

    case BT_LOGICAL:
      result->representation.length = 
        gfc_interpret_logical (result->ts.kind, buffer, buffer_size,
			       &result->value.logical);
      break;

    case BT_CHARACTER:
      result->representation.length = 
        gfc_interpret_character (buffer, buffer_size, result);
      break;

    case BT_DERIVED:
      result->representation.length = 
        gfc_interpret_derived (buffer, buffer_size, result);
      break;

    default:
      gfc_internal_error ("Invalid expression in gfc_target_interpret_expr.");
      break;
    }

  if (result->ts.type == BT_CHARACTER)
    result->representation.string
      = gfc_widechar_to_char (result->value.character.string,
			      result->value.character.length);
  else
    {
      result->representation.string =
        (char *) gfc_getmem (result->representation.length + 1);
      memcpy (result->representation.string, buffer,
	      result->representation.length);
      result->representation.string[result->representation.length] = '\0';
    }

  return result->representation.length;
}