tree gfc_build_wide_string_const (int kind, int length, const gfc_char_t *string) { int i; tree str, len; size_t size; char *s; i = gfc_validate_kind (BT_CHARACTER, kind, false); size = length * gfc_character_kinds[i].bit_size / 8; s = XCNEWVAR (char, size); gfc_encode_character (kind, length, string, (unsigned char *) s, size); str = build_string (size, s); gfc_free (s); len = build_int_cst (NULL_TREE, length); TREE_TYPE (str) = build_array_type (gfc_get_char_type (kind), build_range_type (gfc_charlen_type_node, integer_one_node, len)); return str; }
/* Write a constant expression in binary form to a buffer. */ int gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer, size_t buffer_size) { if (source == NULL) return 0; if (source->expr_type == EXPR_ARRAY) return encode_array (source, buffer, buffer_size); gcc_assert (source->expr_type == EXPR_CONSTANT || source->expr_type == EXPR_STRUCTURE || source->expr_type == EXPR_SUBSTRING); /* If we already have a target-memory representation, we use that rather than recreating one. */ if (source->representation.string) { memcpy (buffer, source->representation.string, source->representation.length); return source->representation.length; } switch (source->ts.type) { case BT_INTEGER: return encode_integer (source->ts.kind, source->value.integer, buffer, buffer_size); case BT_REAL: return encode_float (source->ts.kind, source->value.real, buffer, buffer_size); case BT_COMPLEX: return encode_complex (source->ts.kind, #ifdef HAVE_mpc source->value.complex, #else source->value.complex.r, source->value.complex.i, #endif buffer, buffer_size); case BT_LOGICAL: return encode_logical (source->ts.kind, source->value.logical, buffer, buffer_size); case BT_CHARACTER: if (source->expr_type == EXPR_CONSTANT || source->ref == NULL) return gfc_encode_character (source->ts.kind, source->value.character.length, source->value.character.string, buffer, buffer_size); else { int start, end; gcc_assert (source->expr_type == EXPR_SUBSTRING); gfc_extract_int (source->ref->u.ss.start, &start); gfc_extract_int (source->ref->u.ss.end, &end); return gfc_encode_character (source->ts.kind, MAX(end - start + 1, 0), &source->value.character.string[start-1], buffer, buffer_size); } case BT_DERIVED: return encode_derived (source, buffer, buffer_size); default: gfc_internal_error ("Invalid expression in gfc_target_encode_expr."); return 0; } }