#include "trans-types.h"
#include "trans-const.h"
-
/* Members of the ioparm structure. */
enum ioparam_type
enum iofield_type
{
IOPARM_type_int4,
+ IOPARM_type_intio,
IOPARM_type_pint4,
+ IOPARM_type_pintio,
IOPARM_type_pchar,
IOPARM_type_parray,
IOPARM_type_pad,
gcc_assert (len <= sizeof (name) - sizeof ("__st_parameter_"));
memcpy (name, "__st_parameter_", sizeof ("__st_parameter_"));
memcpy (name + sizeof ("__st_parameter_") - 1, st_parameter[ptype].name,
- len);
+ len + 1);
TYPE_NAME (t) = get_identifier (name);
for (type = 0, p = st_parameter_field; type < IOPARM_field_num; type++, p++)
switch (p->type)
{
case IOPARM_type_int4:
+ case IOPARM_type_intio:
case IOPARM_type_pint4:
+ case IOPARM_type_pintio:
case IOPARM_type_parray:
case IOPARM_type_pchar:
case IOPARM_type_pad:
gfc_build_io_library_fndecls (void)
{
tree types[IOPARM_type_num], pad_idx, gfc_int4_type_node;
+ tree gfc_intio_type_node;
tree parm_type, dt_parm_type;
tree gfc_c_int_type_node;
HOST_WIDE_INT pad_size;
enum ioparam_type ptype;
types[IOPARM_type_int4] = gfc_int4_type_node = gfc_get_int_type (4);
+ types[IOPARM_type_intio] = gfc_intio_type_node
+ = gfc_get_int_type (gfc_intio_kind);
types[IOPARM_type_pint4] = build_pointer_type (gfc_int4_type_node);
+ types[IOPARM_type_pintio]
+ = build_pointer_type (gfc_intio_type_node);
types[IOPARM_type_parray] = pchar_type_node;
types[IOPARM_type_pchar] = pchar_type_node;
pad_size = 16 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node));
pad_size += 32 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (integer_type_node));
pad_idx = build_index_type (build_int_cst (NULL_TREE, pad_size));
types[IOPARM_type_pad] = build_array_type (char_type_node, pad_idx);
+
+ /* pad actually contains pointers and integers so it needs to have an
+ alignment that is at least as large as the needed alignment for those
+ types. See the st_parameter_dt structure in libgfortran/io/io.h for
+ what really goes into this space. */
+ TYPE_ALIGN (types[IOPARM_type_pad]) = MAX (TYPE_ALIGN (pchar_type_node),
+ TYPE_ALIGN (gfc_get_int_type (gfc_max_integer_kind)));
+
gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++)
{
gfc_se se;
tree tmp;
- tree msg;
tree io;
tree len;
gfc_st_parameter_field *p = &st_parameter_field[type];
/* Integer variable assigned a format label. */
if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1)
{
+ char * msg;
+
gfc_conv_label_variable (&se, e);
- msg =
- gfc_build_cstring_const ("Assigned label is not a format label");
tmp = GFC_DECL_STRING_LEN (se.expr);
- tmp = build2 (LE_EXPR, boolean_type_node,
- tmp, convert (TREE_TYPE (tmp), integer_minus_one_node));
- gfc_trans_runtime_check (tmp, msg, &se.pre);
+ tmp = fold_build2 (LT_EXPR, boolean_type_node,
+ tmp, build_int_cst (TREE_TYPE (tmp), 0));
+
+ asprintf(&msg, "Label assigned to variable '%s' is not a format label",
+ e->symtree->name);
+ gfc_trans_runtime_check (tmp, msg, &se.pre, &e->where);
+ gfc_free (msg);
+
gfc_add_modify_expr (&se.pre, io,
fold_convert (TREE_TYPE (io), GFC_DECL_ASSIGN_ADDR (se.expr)));
gfc_add_modify_expr (&se.pre, len, GFC_DECL_STRING_LEN (se.expr));
gfc_conv_expr (&se, e);
gfc_conv_string_parameter (&se);
tmp = se.expr;
- se.expr = fold_convert (pchar_type_node, integer_zero_node);
+ se.expr = build_int_cst (pchar_type_node, 0);
}
/* Character array. */
- else if (e->symtree && (e->symtree->n.sym->as->rank > 0))
+ else if (e->rank > 0)
{
se.ss = gfc_walk_expr (e);
tmp = build_fold_addr_expr (var);
tmp = gfc_chainon_list (NULL_TREE, tmp);
- tmp = gfc_build_function_call (iocall[IOCALL_OPEN], tmp);
+ tmp = build_function_call_expr (iocall[IOCALL_OPEN], tmp);
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &post_block);
tmp = build_fold_addr_expr (var);
tmp = gfc_chainon_list (NULL_TREE, tmp);
- tmp = gfc_build_function_call (iocall[IOCALL_CLOSE], tmp);
+ tmp = build_function_call_expr (iocall[IOCALL_CLOSE], tmp);
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &post_block);
tmp = build_fold_addr_expr (var);
tmp = gfc_chainon_list (NULL_TREE, tmp);
- tmp = gfc_build_function_call (function, tmp);
+ tmp = build_function_call_expr (function, tmp);
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &post_block);
mask |= set_string (&block, &post_block, var, IOPARM_inquire_convert,
p->convert);
+ if (p->strm_pos)
+ mask |= set_parameter_ref (&block, &post_block, var,
+ IOPARM_inquire_strm_pos_out, p->strm_pos);
+
set_parameter_const (&block, var, IOPARM_common_flags, mask);
tmp = build_fold_addr_expr (var);
tmp = gfc_chainon_list (NULL_TREE, tmp);
- tmp = gfc_build_function_call (iocall[IOCALL_INQUIRE], tmp);
+ tmp = build_function_call_expr (iocall[IOCALL_INQUIRE], tmp);
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &post_block);
if (ts->type == BT_CHARACTER)
NML_ADD_ARG (ts->cl->backend_decl);
else
- NML_ADD_ARG (convert (gfc_charlen_type_node, integer_zero_node));
+ NML_ADD_ARG (build_int_cst (gfc_charlen_type_node, 0));
NML_ADD_ARG (dtype);
- tmp = gfc_build_function_call (iocall[IOCALL_SET_NML_VAL], args);
+ tmp = build_function_call_expr (iocall[IOCALL_SET_NML_VAL], args);
gfc_add_expr_to_block (block, tmp);
/* If the object is an array, transfer rank times:
NML_ADD_ARG (GFC_TYPE_ARRAY_STRIDE (dt, n_dim));
NML_ADD_ARG (GFC_TYPE_ARRAY_LBOUND (dt, n_dim));
NML_ADD_ARG (GFC_TYPE_ARRAY_UBOUND (dt, n_dim));
- tmp = gfc_build_function_call (iocall[IOCALL_SET_NML_VAL_DIM], args);
+ tmp = build_function_call_expr (iocall[IOCALL_SET_NML_VAL_DIM], args);
gfc_add_expr_to_block (block, tmp);
}
tmp = build_fold_addr_expr (var);
tmp = gfc_chainon_list (NULL_TREE, tmp);
- tmp = gfc_build_function_call (function, tmp);
+ tmp = build_function_call_expr (function, tmp);
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &post_block);
tmp = build_fold_addr_expr (dt_parm);
tmp = gfc_chainon_list (NULL_TREE, tmp);
- tmp = gfc_build_function_call (function, tmp);
+ tmp = build_function_call_expr (function, tmp);
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, dt_post_end_block);
gfc_init_block (dt_post_end_block);
break;
case BT_CHARACTER:
+ case BT_HOLLERITH:
if (se->string_length)
arg2 = se->string_length;
else
args = gfc_chainon_list (args, addr_expr);
args = gfc_chainon_list (args, arg2);
- tmp = gfc_build_function_call (function, args);
+ tmp = build_function_call_expr (function, args);
gfc_add_expr_to_block (&se->pre, tmp);
gfc_add_block_to_block (&se->pre, &se->post);
args = gfc_chainon_list (args, addr_expr);
args = gfc_chainon_list (args, kind_arg);
args = gfc_chainon_list (args, charlen_arg);
- tmp = gfc_build_function_call (iocall[IOCALL_X_ARRAY], args);
+ tmp = build_function_call_expr (iocall[IOCALL_X_ARRAY], args);
gfc_add_expr_to_block (&se->pre, tmp);
gfc_add_block_to_block (&se->pre, &se->post);
}
OSDN Git Service
