+ if (TYPE_MODE (TREE_TYPE (se.expr))
+ == TYPE_MODE (TREE_TYPE (TREE_TYPE (p->field))))
+ {
+ addr = convert (TREE_TYPE (p->field), build_fold_addr_expr (se.expr));
+
+ /* If this is for the iostat variable initialize the
+ user variable to IOERROR_OK which is zero. */
+ if (type == IOPARM_common_iostat)
+ {
+ ioerror_codes ok;
+ ok = IOERROR_OK;
+ gfc_add_modify_expr (block, se.expr,
+ build_int_cst (TREE_TYPE (se.expr), ok));
+ }
+ }
+ else
+ {
+ /* The type used by the library has different size
+ from the type of the variable supplied by the user.
+ Need to use a temporary. */
+ tree tmpvar = gfc_create_var (TREE_TYPE (TREE_TYPE (p->field)),
+ st_parameter_field[type].name);
+
+ /* If this is for the iostat variable, initialize the
+ user variable to IOERROR_OK which is zero. */
+ if (type == IOPARM_common_iostat)
+ {
+ ioerror_codes ok;
+ ok = IOERROR_OK;
+ gfc_add_modify_expr (block, tmpvar,
+ build_int_cst (TREE_TYPE (tmpvar), ok));
+ }
+
+ addr = build_fold_addr_expr (tmpvar);
+ /* After the I/O operation, we set the variable from the temporary. */
+ tmp = convert (TREE_TYPE (se.expr), tmpvar);
+ gfc_add_modify_expr (postblock, se.expr, tmp);
+ }
+
+ if (p->param_type == IOPARM_ptype_common)
+ var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
+ var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+ tmp = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field,
+ NULL_TREE);
+ gfc_add_modify_expr (block, tmp, addr);
+ return p->mask;
+}
+
+/* Given an array expr, find its address and length to get a string. If the
+ array is full, the string's address is the address of array's first element
+ and the length is the size of the whole array. If it is an element, the
+ string's address is the element's address and the length is the rest size of
+ the array.
+*/
+
+static void
+gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
+{
+ tree tmp;
+ tree array;
+ tree type;
+ tree size;
+ int rank;
+ gfc_symbol *sym;
+
+ sym = e->symtree->n.sym;
+ rank = sym->as->rank - 1;
+
+ if (e->ref->u.ar.type == AR_FULL)
+ {
+ se->expr = gfc_get_symbol_decl (sym);
+ se->expr = gfc_conv_array_data (se->expr);
+ }
+ else
+ {
+ gfc_conv_expr (se, e);
+ }
+
+ array = sym->backend_decl;
+ type = TREE_TYPE (array);
+
+ if (GFC_ARRAY_TYPE_P (type))
+ size = GFC_TYPE_ARRAY_SIZE (type);
+ else
+ {
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+ size = gfc_conv_array_stride (array, rank);
+ tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+ gfc_conv_array_ubound (array, rank),
+ gfc_conv_array_lbound (array, rank));
+ tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type, tmp,
+ gfc_index_one_node);
+ size = fold_build2 (MULT_EXPR, gfc_array_index_type, tmp, size);
+ }
+
+ gcc_assert (size);
+
+ /* If it is an element, we need the its address and size of the rest. */
+ if (e->ref->u.ar.type == AR_ELEMENT)
+ {
+ size = fold_build2 (MINUS_EXPR, gfc_array_index_type, size,
+ TREE_OPERAND (se->expr, 1));
+ se->expr = build_fold_addr_expr (se->expr);
+ }
+
+ tmp = TYPE_SIZE_UNIT (gfc_get_element_type (type));
+ size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
+ fold_convert (gfc_array_index_type, tmp));
+
+ se->string_length = fold_convert (gfc_charlen_type_node, size);
projects / gcc.git / blobdiff