+2008-05-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ * trans-expr.c (gfc_conv_concat_op): Take care of nondefault
+ character kinds.
+ (gfc_build_compare_string): Add kind argument and use it.
+ (gfc_conv_statement_function): Fix indentation.
+ * gfortran.h (gfc_character_info): New structure.
+ (gfc_character_kinds): New array.
+ * trans-types.c (gfc_character_kinds, gfc_character_types,
+ gfc_pcharacter_types): New array.
+ (gfc_init_kinds): Fill character kinds array.
+ (validate_character): Take care of nondefault character kinds.
+ (gfc_build_uint_type): New function.
+ (gfc_init_types): Take care of nondefault character kinds.
+ (gfc_get_char_type, gfc_get_pchar_type): New functions.
+ (gfc_get_character_type_len): Use gfc_get_char_type.
+ * trans.h (gfc_build_compare_string): Adjust prototype.
+ (gfor_fndecl_compare_string_char4, gfor_fndecl_concat_string_char4,
+ gfor_fndecl_string_len_trim_char4, gfor_fndecl_string_index_char4,
+ gfor_fndecl_string_scan_char4, gfor_fndecl_string_verify_char4,
+ gfor_fndecl_string_trim_char4, gfor_fndecl_string_minmax_char4,
+ gfor_fndecl_adjustl_char4, gfor_fndecl_adjustr_char4): New
+ prototypes.
+ * trans-types.h (gfc_get_char_type, gfc_get_pchar_type): New
+ prototypes.
+ * trans-decl.c (gfor_fndecl_compare_string_char4,
+ gfor_fndecl_string_len_trim_char4, gfor_fndecl_string_index_char4,
+ gfor_fndecl_string_scan_char4, gfor_fndecl_string_verify_char4,
+ gfor_fndecl_string_trim_char4, gfor_fndecl_string_minmax_char4,
+ gfor_fndecl_adjustl_char4, gfor_fndecl_adjustr_char4,
+ gfor_fndecl_concat_string_char4): New function decls.
+ (gfc_build_intrinsic_function_decls): Define new *_char4 function
+ decls.
+ * trans-intrinsic.c (gfc_conv_intrinsic_minmax_char,
+ gfc_conv_intrinsic_len_trim, gfc_conv_intrinsic_ichar,
+ gfc_conv_intrinsic_strcmp, gfc_conv_intrinsic_trim,
+ gfc_conv_intrinsic_function): Deal with nondefault character kinds.
+
2008-05-15 Sa Liu <saliu@de.ibm.com>
* iso-c-binding.def: Add standard parameter to macro NAMED_INTCST.
extern gfc_real_info gfc_real_kinds[];
+typedef struct
+{
+ int kind, bit_size;
+ const char *name;
+}
+gfc_character_info;
+
+extern gfc_character_info gfc_character_kinds[];
+
/* Equivalence structures. Equivalent lvalues are linked along the
*eq pointer, equivalence sets are strung along the *next node. */
tree gfor_fndecl_string_minmax;
tree gfor_fndecl_adjustl;
tree gfor_fndecl_adjustr;
+tree gfor_fndecl_compare_string_char4;
+tree gfor_fndecl_concat_string_char4;
+tree gfor_fndecl_string_len_trim_char4;
+tree gfor_fndecl_string_index_char4;
+tree gfor_fndecl_string_scan_char4;
+tree gfor_fndecl_string_verify_char4;
+tree gfor_fndecl_string_trim_char4;
+tree gfor_fndecl_string_minmax_char4;
+tree gfor_fndecl_adjustl_char4;
+tree gfor_fndecl_adjustr_char4;
/* Other misc. runtime library functions. */
tree gfc_int8_type_node = gfc_get_int_type (8);
tree gfc_int16_type_node = gfc_get_int_type (16);
tree gfc_logical4_type_node = gfc_get_logical_type (4);
+ tree pchar1_type_node = gfc_get_pchar_type (1);
+ tree pchar4_type_node = gfc_get_pchar_type (4);
/* String functions. */
gfor_fndecl_compare_string =
gfc_build_library_function_decl (get_identifier (PREFIX("compare_string")),
integer_type_node, 4,
- gfc_charlen_type_node, pchar_type_node,
- gfc_charlen_type_node, pchar_type_node);
+ gfc_charlen_type_node, pchar1_type_node,
+ gfc_charlen_type_node, pchar1_type_node);
gfor_fndecl_concat_string =
gfc_build_library_function_decl (get_identifier (PREFIX("concat_string")),
- void_type_node,
- 6,
- gfc_charlen_type_node, pchar_type_node,
- gfc_charlen_type_node, pchar_type_node,
- gfc_charlen_type_node, pchar_type_node);
+ void_type_node, 6,
+ gfc_charlen_type_node, pchar1_type_node,
+ gfc_charlen_type_node, pchar1_type_node,
+ gfc_charlen_type_node, pchar1_type_node);
gfor_fndecl_string_len_trim =
gfc_build_library_function_decl (get_identifier (PREFIX("string_len_trim")),
- gfc_int4_type_node,
- 2, gfc_charlen_type_node,
- pchar_type_node);
+ gfc_int4_type_node, 2,
+ gfc_charlen_type_node, pchar1_type_node);
gfor_fndecl_string_index =
gfc_build_library_function_decl (get_identifier (PREFIX("string_index")),
- gfc_int4_type_node,
- 5, gfc_charlen_type_node, pchar_type_node,
- gfc_charlen_type_node, pchar_type_node,
- gfc_logical4_type_node);
+ gfc_int4_type_node, 5,
+ gfc_charlen_type_node, pchar1_type_node,
+ gfc_charlen_type_node, pchar1_type_node,
+ gfc_logical4_type_node);
gfor_fndecl_string_scan =
gfc_build_library_function_decl (get_identifier (PREFIX("string_scan")),
- gfc_int4_type_node,
- 5, gfc_charlen_type_node, pchar_type_node,
- gfc_charlen_type_node, pchar_type_node,
- gfc_logical4_type_node);
+ gfc_int4_type_node, 5,
+ gfc_charlen_type_node, pchar1_type_node,
+ gfc_charlen_type_node, pchar1_type_node,
+ gfc_logical4_type_node);
gfor_fndecl_string_verify =
gfc_build_library_function_decl (get_identifier (PREFIX("string_verify")),
- gfc_int4_type_node,
- 5, gfc_charlen_type_node, pchar_type_node,
- gfc_charlen_type_node, pchar_type_node,
- gfc_logical4_type_node);
+ gfc_int4_type_node, 5,
+ gfc_charlen_type_node, pchar1_type_node,
+ gfc_charlen_type_node, pchar1_type_node,
+ gfc_logical4_type_node);
gfor_fndecl_string_trim =
gfc_build_library_function_decl (get_identifier (PREFIX("string_trim")),
- void_type_node,
- 4,
- build_pointer_type (gfc_charlen_type_node),
- ppvoid_type_node,
- gfc_charlen_type_node,
- pchar_type_node);
+ void_type_node, 4,
+ build_pointer_type (gfc_charlen_type_node),
+ build_pointer_type (pchar1_type_node),
+ gfc_charlen_type_node, pchar1_type_node);
gfor_fndecl_string_minmax =
gfc_build_library_function_decl (get_identifier (PREFIX("string_minmax")),
- void_type_node, -4,
- build_pointer_type (gfc_charlen_type_node),
- ppvoid_type_node, integer_type_node,
- integer_type_node);
+ void_type_node, -4,
+ build_pointer_type (gfc_charlen_type_node),
+ build_pointer_type (pchar1_type_node),
+ integer_type_node, integer_type_node);
+
+ gfor_fndecl_adjustl =
+ gfc_build_library_function_decl (get_identifier (PREFIX("adjustl")),
+ void_type_node, 3, pchar1_type_node,
+ gfc_charlen_type_node, pchar1_type_node);
+
+ gfor_fndecl_adjustr =
+ gfc_build_library_function_decl (get_identifier (PREFIX("adjustr")),
+ void_type_node, 3, pchar1_type_node,
+ gfc_charlen_type_node, pchar1_type_node);
+
+ gfor_fndecl_compare_string_char4 =
+ gfc_build_library_function_decl (get_identifier
+ (PREFIX("compare_string_char4")),
+ integer_type_node, 4,
+ gfc_charlen_type_node, pchar4_type_node,
+ gfc_charlen_type_node, pchar4_type_node);
+
+ gfor_fndecl_concat_string_char4 =
+ gfc_build_library_function_decl (get_identifier
+ (PREFIX("concat_string_char4")),
+ void_type_node, 6,
+ gfc_charlen_type_node, pchar4_type_node,
+ gfc_charlen_type_node, pchar4_type_node,
+ gfc_charlen_type_node, pchar4_type_node);
+
+ gfor_fndecl_string_len_trim_char4 =
+ gfc_build_library_function_decl (get_identifier
+ (PREFIX("string_len_trim_char4")),
+ gfc_charlen_type_node, 2,
+ gfc_charlen_type_node, pchar4_type_node);
+
+ gfor_fndecl_string_index_char4 =
+ gfc_build_library_function_decl (get_identifier
+ (PREFIX("string_index_char4")),
+ gfc_charlen_type_node, 5,
+ gfc_charlen_type_node, pchar4_type_node,
+ gfc_charlen_type_node, pchar4_type_node,
+ gfc_logical4_type_node);
+
+ gfor_fndecl_string_scan_char4 =
+ gfc_build_library_function_decl (get_identifier
+ (PREFIX("string_scan_char4")),
+ gfc_charlen_type_node, 5,
+ gfc_charlen_type_node, pchar4_type_node,
+ gfc_charlen_type_node, pchar4_type_node,
+ gfc_logical4_type_node);
+
+ gfor_fndecl_string_verify_char4 =
+ gfc_build_library_function_decl (get_identifier
+ (PREFIX("string_verify_char4")),
+ gfc_charlen_type_node, 5,
+ gfc_charlen_type_node, pchar4_type_node,
+ gfc_charlen_type_node, pchar4_type_node,
+ gfc_logical4_type_node);
+
+ gfor_fndecl_string_trim_char4 =
+ gfc_build_library_function_decl (get_identifier
+ (PREFIX("string_trim_char4")),
+ void_type_node, 4,
+ build_pointer_type (gfc_charlen_type_node),
+ build_pointer_type (pchar4_type_node),
+ gfc_charlen_type_node, pchar4_type_node);
+
+ gfor_fndecl_string_minmax_char4 =
+ gfc_build_library_function_decl (get_identifier
+ (PREFIX("string_minmax_char4")),
+ void_type_node, -4,
+ build_pointer_type (gfc_charlen_type_node),
+ build_pointer_type (pchar4_type_node),
+ integer_type_node, integer_type_node);
+
+ gfor_fndecl_adjustl_char4 =
+ gfc_build_library_function_decl (get_identifier (PREFIX("adjustl_char4")),
+ void_type_node, 3, pchar4_type_node,
+ gfc_charlen_type_node, pchar4_type_node);
+
+ gfor_fndecl_adjustr_char4 =
+ gfc_build_library_function_decl (get_identifier (PREFIX("adjustr_char4")),
+ void_type_node, 3, pchar4_type_node,
+ gfc_charlen_type_node, pchar4_type_node);
+
+ /* Misc. functions. */
gfor_fndecl_ttynam =
gfc_build_library_function_decl (get_identifier (PREFIX("ttynam")),
gfc_charlen_type_node,
gfc_int8_type_node);
- gfor_fndecl_adjustl =
- gfc_build_library_function_decl (get_identifier (PREFIX("adjustl")),
- void_type_node,
- 3,
- pchar_type_node,
- gfc_charlen_type_node, pchar_type_node);
-
- gfor_fndecl_adjustr =
- gfc_build_library_function_decl (get_identifier (PREFIX("adjustr")),
- void_type_node,
- 3,
- pchar_type_node,
- gfc_charlen_type_node, pchar_type_node);
-
gfor_fndecl_sc_kind =
gfc_build_library_function_decl (get_identifier
(PREFIX("selected_char_kind")),
static void
gfc_conv_concat_op (gfc_se * se, gfc_expr * expr)
{
- gfc_se lse;
- gfc_se rse;
- tree len;
- tree type;
- tree var;
- tree tmp;
+ gfc_se lse, rse;
+ tree len, type, var, tmp, fndecl;
gcc_assert (expr->value.op.op1->ts.type == BT_CHARACTER
- && expr->value.op.op2->ts.type == BT_CHARACTER);
+ && expr->value.op.op2->ts.type == BT_CHARACTER);
gfc_init_se (&lse, se);
gfc_conv_expr (&lse, expr->value.op.op1);
var = gfc_conv_string_tmp (se, type, len);
/* Do the actual concatenation. */
- tmp = build_call_expr (gfor_fndecl_concat_string, 6,
- len, var,
- lse.string_length, lse.expr,
+ if (expr->ts.kind == 1)
+ fndecl = gfor_fndecl_concat_string;
+ else if (expr->ts.kind == 4)
+ fndecl = gfor_fndecl_concat_string_char4;
+ else
+ gcc_unreachable ();
+
+ tmp = build_call_expr (fndecl, 6, len, var, lse.string_length, lse.expr,
rse.string_length, rse.expr);
gfc_add_expr_to_block (&se->pre, tmp);
gfc_conv_string_parameter (&rse);
lse.expr = gfc_build_compare_string (lse.string_length, lse.expr,
- rse.string_length, rse.expr);
+ rse.string_length, rse.expr,
+ expr->value.op.op1->ts.kind);
rse.expr = build_int_cst (TREE_TYPE (lse.expr), 0);
gfc_add_block_to_block (&lse.post, &rse.post);
}
subtraction of them. Otherwise, we build a library call. */
tree
-gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2)
+gfc_build_compare_string (tree len1, tree str1, tree len2, tree str2, int kind)
{
tree sc1;
tree sc2;
sc1 = gfc_to_single_character (len1, str1);
sc2 = gfc_to_single_character (len2, str2);
- /* Deal with single character specially. */
if (sc1 != NULL_TREE && sc2 != NULL_TREE)
{
+ /* Deal with single character specially. */
sc1 = fold_convert (integer_type_node, sc1);
sc2 = fold_convert (integer_type_node, sc2);
tmp = fold_build2 (MINUS_EXPR, integer_type_node, sc1, sc2);
}
- else
- /* Build a call for the comparison. */
- tmp = build_call_expr (gfor_fndecl_compare_string, 4,
- len1, str1, len2, str2);
+ else
+ {
+ /* Build a call for the comparison. */
+ tree fndecl;
+
+ if (kind == 1)
+ fndecl = gfor_fndecl_compare_string;
+ else if (kind == 4)
+ fndecl = gfor_fndecl_compare_string_char4;
+ else
+ gcc_unreachable ();
+
+ tmp = build_call_expr (fndecl, 4, len1, str1, len2, str2);
+ }
+
return tmp;
}
tree arglen;
gcc_assert (fsym->ts.cl && fsym->ts.cl->length
- && fsym->ts.cl->length->expr_type == EXPR_CONSTANT);
+ && fsym->ts.cl->length->expr_type == EXPR_CONSTANT);
arglen = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
tmp = gfc_build_addr_expr (build_pointer_type (type),
gfc_conv_intrinsic_minmax_char (gfc_se * se, gfc_expr * expr, int op)
{
tree *args;
- tree var, len, fndecl, tmp, cond;
+ tree var, len, fndecl, tmp, cond, function;
unsigned int nargs;
nargs = gfc_intrinsic_argument_list_length (expr);
args[2] = build_int_cst (NULL_TREE, op);
args[3] = build_int_cst (NULL_TREE, nargs / 2);
+ if (expr->ts.kind == 1)
+ function = gfor_fndecl_string_minmax;
+ else if (expr->ts.kind == 4)
+ function = gfor_fndecl_string_minmax_char4;
+ else
+ gcc_unreachable ();
+
/* Make the function call. */
- fndecl = build_addr (gfor_fndecl_string_minmax, current_function_decl);
- tmp = build_call_array (TREE_TYPE (TREE_TYPE (gfor_fndecl_string_minmax)),
- fndecl, nargs + 4, args);
+ fndecl = build_addr (function, current_function_decl);
+ tmp = build_call_array (TREE_TYPE (TREE_TYPE (function)), fndecl,
+ nargs + 4, args);
gfc_add_expr_to_block (&se->pre, tmp);
/* Free the temporary afterwards, if necessary. */
static void
gfc_conv_intrinsic_len_trim (gfc_se * se, gfc_expr * expr)
{
- tree args[2];
- tree type;
+ int kind = expr->value.function.actual->expr->ts.kind;
+ tree args[2], type, fndecl;
gfc_conv_intrinsic_function_args (se, expr, args, 2);
type = gfc_typenode_for_spec (&expr->ts);
- se->expr = build_call_expr (gfor_fndecl_string_len_trim, 2, args[0], args[1]);
+
+ if (kind == 1)
+ fndecl = gfor_fndecl_string_len_trim;
+ else if (kind == 4)
+ fndecl = gfor_fndecl_string_len_trim_char4;
+ else
+ gcc_unreachable ();
+
+ se->expr = build_call_expr (fndecl, 2, args[0], args[1]);
se->expr = convert (type, se->expr);
}
static void
gfc_conv_intrinsic_ichar (gfc_se * se, gfc_expr * expr)
{
- tree args[2];
- tree type;
+ tree args[2], type, pchartype;
gfc_conv_intrinsic_function_args (se, expr, args, 2);
gcc_assert (POINTER_TYPE_P (TREE_TYPE (args[1])));
- args[1] = fold_build1 (NOP_EXPR, pchar_type_node, args[1]);
+ pchartype = gfc_get_pchar_type (expr->value.function.actual->expr->ts.kind);
+ args[1] = fold_build1 (NOP_EXPR, pchartype, args[1]);
type = gfc_typenode_for_spec (&expr->ts);
se->expr = build_fold_indirect_ref (args[1]);
gfc_conv_intrinsic_function_args (se, expr, args, 4);
- se->expr = gfc_build_compare_string (args[0], args[1], args[2], args[3]);
+ se->expr
+ = gfc_build_compare_string (args[0], args[1], args[2], args[3],
+ expr->value.function.actual->expr->ts.kind);
se->expr = fold_build2 (op, gfc_typenode_for_spec (&expr->ts), se->expr,
build_int_cst (TREE_TYPE (se->expr), 0));
}
tree type;
tree cond;
tree fndecl;
+ tree function;
tree *args;
unsigned int num_args;
args[0] = build_fold_addr_expr (len);
args[1] = addr;
- fndecl = build_addr (gfor_fndecl_string_trim, current_function_decl);
- tmp = build_call_array (TREE_TYPE (TREE_TYPE (gfor_fndecl_string_trim)),
- fndecl, num_args, args);
+ if (expr->ts.kind == 1)
+ function = gfor_fndecl_string_trim;
+ else if (expr->ts.kind == 4)
+ function = gfor_fndecl_string_trim_char4;
+ else
+ gcc_unreachable ();
+
+ fndecl = build_addr (function, current_function_decl);
+ tmp = build_call_array (TREE_TYPE (TREE_TYPE (function)), fndecl,
+ num_args, args);
gfc_add_expr_to_block (&se->pre, tmp);
/* Free the temporary afterwards, if necessary. */
{
gfc_intrinsic_sym *isym;
const char *name;
- int lib;
+ int lib, kind;
+ tree fndecl;
isym = expr->value.function.isym;
break;
case GFC_ISYM_SCAN:
- gfc_conv_intrinsic_index_scan_verify (se, expr, gfor_fndecl_string_scan);
+ kind = expr->value.function.actual->expr->ts.kind;
+ if (kind == 1)
+ fndecl = gfor_fndecl_string_scan;
+ else if (kind == 4)
+ fndecl = gfor_fndecl_string_scan_char4;
+ else
+ gcc_unreachable ();
+
+ gfc_conv_intrinsic_index_scan_verify (se, expr, fndecl);
break;
case GFC_ISYM_VERIFY:
- gfc_conv_intrinsic_index_scan_verify (se, expr, gfor_fndecl_string_verify);
+ kind = expr->value.function.actual->expr->ts.kind;
+ if (kind == 1)
+ fndecl = gfor_fndecl_string_verify;
+ else if (kind == 4)
+ fndecl = gfor_fndecl_string_verify_char4;
+ else
+ gcc_unreachable ();
+
+ gfc_conv_intrinsic_index_scan_verify (se, expr, fndecl);
break;
case GFC_ISYM_ALLOCATED:
break;
case GFC_ISYM_ADJUSTL:
- gfc_conv_intrinsic_adjust (se, expr, gfor_fndecl_adjustl);
+ if (expr->ts.kind == 1)
+ fndecl = gfor_fndecl_adjustl;
+ else if (expr->ts.kind == 4)
+ fndecl = gfor_fndecl_adjustl_char4;
+ else
+ gcc_unreachable ();
+
+ gfc_conv_intrinsic_adjust (se, expr, fndecl);
break;
case GFC_ISYM_ADJUSTR:
- gfc_conv_intrinsic_adjust (se, expr, gfor_fndecl_adjustr);
+ if (expr->ts.kind == 1)
+ fndecl = gfor_fndecl_adjustr;
+ else if (expr->ts.kind == 4)
+ fndecl = gfor_fndecl_adjustr_char4;
+ else
+ gcc_unreachable ();
+
+ gfc_conv_intrinsic_adjust (se, expr, fndecl);
break;
case GFC_ISYM_AIMAG:
break;
case GFC_ISYM_INDEX:
- gfc_conv_intrinsic_index_scan_verify (se, expr, gfor_fndecl_string_index);
+ kind = expr->value.function.actual->expr->ts.kind;
+ if (kind == 1)
+ fndecl = gfor_fndecl_string_index;
+ else if (kind == 4)
+ fndecl = gfor_fndecl_string_index_char4;
+ else
+ gcc_unreachable ();
+
+ gfc_conv_intrinsic_index_scan_verify (se, expr, fndecl);
break;
case GFC_ISYM_IOR:
static GTY(()) tree gfc_real_types[MAX_REAL_KINDS + 1];
static GTY(()) tree gfc_complex_types[MAX_REAL_KINDS + 1];
+#define MAX_CHARACTER_KINDS 2
+gfc_character_info gfc_character_kinds[MAX_CHARACTER_KINDS + 1];
+static GTY(()) tree gfc_character_types[MAX_CHARACTER_KINDS + 1];
+static GTY(()) tree gfc_pcharacter_types[MAX_CHARACTER_KINDS + 1];
+
/* The integer kind to use for array indices. This will be set to the
proper value based on target information from the backend. */
gfc_init_kinds (void)
{
enum machine_mode mode;
- int i_index, r_index;
+ int i_index, r_index, kind;
bool saw_i4 = false, saw_i8 = false;
bool saw_r4 = false, saw_r8 = false, saw_r16 = false;
gfc_default_logical_kind = gfc_default_integer_kind;
gfc_default_complex_kind = gfc_default_real_kind;
+ /* We only have two character kinds: ASCII and UCS-4.
+ ASCII corresponds to a 8-bit integer type, if one is available.
+ UCS-4 corresponds to a 32-bit integer type, if one is available. */
+ i_index = 0;
+ if ((kind = get_int_kind_from_width (8)) > 0)
+ {
+ gfc_character_kinds[i_index].kind = kind;
+ gfc_character_kinds[i_index].bit_size = 8;
+ gfc_character_kinds[i_index].name = "ascii";
+ i_index++;
+ }
+ if ((kind = get_int_kind_from_width (32)) > 0)
+ {
+ gfc_character_kinds[i_index].kind = kind;
+ gfc_character_kinds[i_index].bit_size = 32;
+ gfc_character_kinds[i_index].name = "iso_10646";
+ i_index++;
+ }
+
/* Choose the smallest integer kind for our default character. */
- gfc_default_character_kind = gfc_integer_kinds[0].kind;
+ gfc_default_character_kind = gfc_character_kinds[0].kind;
gfc_character_storage_size = gfc_default_character_kind * 8;
/* Choose the integer kind the same size as "void*" for our index kind. */
static int
validate_character (int kind)
{
- return kind == gfc_default_character_kind ? 0 : -1;
+ int i;
+
+ for (i = 0; gfc_character_kinds[i].kind; i++)
+ if (gfc_character_kinds[i].kind == kind)
+ return i;
+
+ return -1;
}
/* Validate a kind given a basic type. The return value is the same
return make_signed_type (mode_precision);
}
+static tree
+gfc_build_uint_type (int size)
+{
+ if (size == CHAR_TYPE_SIZE)
+ return unsigned_char_type_node;
+ if (size == SHORT_TYPE_SIZE)
+ return short_unsigned_type_node;
+ if (size == INT_TYPE_SIZE)
+ return unsigned_type_node;
+ if (size == LONG_TYPE_SIZE)
+ return long_unsigned_type_node;
+ if (size == LONG_LONG_TYPE_SIZE)
+ return long_long_unsigned_type_node;
+
+ return make_unsigned_type (size);
+}
+
+
static tree
gfc_build_real_type (gfc_real_info *info)
{
PUSH_TYPE (name_buf, type);
}
- gfc_character1_type_node = build_qualified_type (unsigned_char_type_node,
- TYPE_UNQUALIFIED);
- PUSH_TYPE ("character(kind=1)", gfc_character1_type_node);
+ for (index = 0; gfc_character_kinds[index].kind != 0; ++index)
+ {
+ type = gfc_build_uint_type (gfc_character_kinds[index].bit_size);
+ type = build_qualified_type (type, TYPE_UNQUALIFIED);
+ snprintf (name_buf, sizeof(name_buf), "character(kind=%d)",
+ gfc_character_kinds[index].kind);
+ PUSH_TYPE (name_buf, type);
+ gfc_character_types[index] = type;
+ gfc_pcharacter_types[index] = build_pointer_type (type);
+ }
+ gfc_character1_type_node = gfc_character_types[0];
PUSH_TYPE ("byte", unsigned_char_type_node);
PUSH_TYPE ("void", void_type_node);
int index = gfc_validate_kind (BT_LOGICAL, kind, true);
return index < 0 ? 0 : gfc_logical_types[index];
}
+
+tree
+gfc_get_char_type (int kind)
+{
+ int index = gfc_validate_kind (BT_CHARACTER, kind, true);
+ return index < 0 ? 0 : gfc_character_types[index];
+}
+
+tree
+gfc_get_pchar_type (int kind)
+{
+ int index = gfc_validate_kind (BT_CHARACTER, kind, true);
+ return index < 0 ? 0 : gfc_pcharacter_types[index];
+}
+
\f
/* Create a character type with the given kind and length. */
gfc_validate_kind (BT_CHARACTER, kind, false);
bounds = build_range_type (gfc_charlen_type_node, gfc_index_one_node, len);
- type = build_array_type (gfc_character1_type_node, bounds);
+ type = build_array_type (gfc_get_char_type (kind), bounds);
TYPE_STRING_FLAG (type) = 1;
return type;
tree gfc_get_real_type (int);
tree gfc_get_complex_type (int);
tree gfc_get_logical_type (int);
+tree gfc_get_char_type (int);
+tree gfc_get_pchar_type (int);
tree gfc_get_character_type (int, gfc_charlen *);
tree gfc_get_character_type_len (int, tree);
void gfc_conv_string_parameter (gfc_se * se);
/* Compare two strings. */
-tree gfc_build_compare_string (tree, tree, tree, tree);
+tree gfc_build_compare_string (tree, tree, tree, tree, int);
/* Add an item to the end of TREE_LIST. */
tree gfc_chainon_list (tree, tree);
extern GTY(()) tree gfor_fndecl_string_minmax;
extern GTY(()) tree gfor_fndecl_adjustl;
extern GTY(()) tree gfor_fndecl_adjustr;
+extern GTY(()) tree gfor_fndecl_compare_string_char4;
+extern GTY(()) tree gfor_fndecl_concat_string_char4;
+extern GTY(()) tree gfor_fndecl_string_len_trim_char4;
+extern GTY(()) tree gfor_fndecl_string_index_char4;
+extern GTY(()) tree gfor_fndecl_string_scan_char4;
+extern GTY(()) tree gfor_fndecl_string_verify_char4;
+extern GTY(()) tree gfor_fndecl_string_trim_char4;
+extern GTY(()) tree gfor_fndecl_string_minmax_char4;
+extern GTY(()) tree gfor_fndecl_adjustl_char4;
+extern GTY(()) tree gfor_fndecl_adjustr_char4;
/* Other misc. runtime library functions. */
extern GTY(()) tree gfor_fndecl_size0;
projects / gcc.git / commitdiff