Ejemplo n.º 1
0
int
gfc_encode_character (int kind, int length, const gfc_char_t *string,
		      unsigned char *buffer, size_t buffer_size)
{
  size_t elsize = size_character (1, kind);
  tree type = gfc_get_char_type (kind);
  int i;

  gcc_assert (buffer_size >= size_character (length, kind));

  for (i = 0; i < length; i++)
    native_encode_expr (build_int_cst (type, string[i]), &buffer[i*elsize],
			elsize);

  return length;
}
static int
encode_character (int length, char *string, unsigned char *buffer,
		  size_t buffer_size)
{
  gcc_assert (buffer_size >= size_character (length));
  memcpy (buffer, string, length);
  return length;
}
Ejemplo n.º 3
0
size_t
gfc_target_expr_size (gfc_expr *e)
{
  tree type;

  gcc_assert (e != NULL);

  if (e->expr_type == EXPR_ARRAY)
    return size_array (e);

  switch (e->ts.type)
    {
    case BT_INTEGER:
      return size_integer (e->ts.kind);
    case BT_REAL:
      return size_float (e->ts.kind);
    case BT_COMPLEX:
      return size_complex (e->ts.kind);
    case BT_LOGICAL:
      return size_logical (e->ts.kind);
    case BT_CHARACTER:
      if (e->expr_type == EXPR_SUBSTRING && e->ref)
        {
          int start, end;

          gfc_extract_int (e->ref->u.ss.start, &start);
          gfc_extract_int (e->ref->u.ss.end, &end);
          return size_character (MAX(end - start + 1, 0), e->ts.kind);
        }
      else
        return size_character (e->value.character.length, e->ts.kind);
    case BT_HOLLERITH:
      return e->representation.length;
    case BT_DERIVED:
      type = gfc_typenode_for_spec (&e->ts);
      return int_size_in_bytes (type);
    default:
      gfc_internal_error ("Invalid expression in gfc_target_expr_size.");
      return 0;
    }
}
Ejemplo n.º 4
0
int
gfc_interpret_character (unsigned char *buffer, size_t buffer_size,
			 gfc_expr *result)
{
  int i;

  if (result->ts.cl && result->ts.cl->length)
    result->value.character.length =
      (int) mpz_get_ui (result->ts.cl->length->value.integer);

  gcc_assert (buffer_size >= size_character (result->value.character.length,
					     result->ts.kind));
  result->value.character.string =
    gfc_get_wide_string (result->value.character.length + 1);

  if (result->ts.kind == gfc_default_character_kind)
    for (i = 0; i < result->value.character.length; i++)
      result->value.character.string[i] = (gfc_char_t) buffer[i];
  else
    {
      mpz_t integer;
      unsigned bytes = size_character (1, result->ts.kind);
      mpz_init (integer);
      gcc_assert (bytes <= sizeof (unsigned long));

      for (i = 0; i < result->value.character.length; i++)
	{
	  gfc_conv_tree_to_mpz (integer,
	    native_interpret_expr (gfc_get_char_type (result->ts.kind),
				   &buffer[bytes*i], buffer_size-bytes*i));
	  result->value.character.string[i]
	    = (gfc_char_t) mpz_get_ui (integer);
	}

      mpz_clear (integer);
    }

  result->value.character.string[result->value.character.length] = '\0';

  return result->value.character.length;
}
int
gfc_interpret_character (unsigned char *buffer, size_t buffer_size, gfc_expr *result)
{
  if (result->ts.cl && result->ts.cl->length)
    result->value.character.length =
      (int)mpz_get_ui (result->ts.cl->length->value.integer);

  gcc_assert (buffer_size >= size_character (result->value.character.length));
  result->value.character.string =
    gfc_getmem (result->value.character.length + 1);
  memcpy (result->value.character.string, buffer,
	  result->value.character.length);
  result->value.character.string [result->value.character.length] = '\0';

  return result->value.character.length;
}