transfer of the record length for io from internal files
Paul Thomas
paulthomas2@wanadoo.fr
Fri Jul 15 04:28:00 GMT 2005
Tobi,
> etc.
>
> Um, could you redo this as a context diff or uni-diff?
>
> Thanks,
> - Tobi
>
>
>
>
Sure. The intention was to keep the file short. I had not taken on
board that the calls to set_string were close enough together that diff
would only output a few blocks.
It's duly attached...
Paul T
------------------------------------------------------------------------
Index: gcc/gcc/fortran/trans-io.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-io.c,v
retrieving revision 1.38
diff -c -3 -p -r1.38 trans-io.c
*** gcc/gcc/fortran/trans-io.c 7 Jul 2005 07:54:43 -0000 1.38
--- gcc/gcc/fortran/trans-io.c 15 Jul 2005 03:58:45 -0000
*************** gfc_convert_array_to_string (gfc_se * se
*** 428,450 ****
}
/* Generate code to store a string and its length into the
! ioparm structure. */
static void
set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
! tree var_len, gfc_expr * e)
{
gfc_se se;
tree tmp;
tree msg;
tree io;
tree len;
gfc_init_se (&se, NULL);
io = build3 (COMPONENT_REF, TREE_TYPE (var), ioparm_var, var, NULL_TREE);
len = build3 (COMPONENT_REF, TREE_TYPE (var_len), ioparm_var, var_len,
NULL_TREE);
/* Integer variable assigned a format label. */
if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1)
--- 428,456 ----
}
/* Generate code to store a string and its length into the
! ioparm structure. In the case that the string is an array,
! it is sometimes necessary that that the character length be
! available too. This is the function of the last argument. */
static void
set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
! tree var_len, gfc_expr * e, tree recl)
{
gfc_se se;
tree tmp;
tree msg;
tree io;
tree len;
+ tree char_len = NULL_TREE;
gfc_init_se (&se, NULL);
io = build3 (COMPONENT_REF, TREE_TYPE (var), ioparm_var, var, NULL_TREE);
len = build3 (COMPONENT_REF, TREE_TYPE (var_len), ioparm_var, var_len,
NULL_TREE);
+ if (recl != NULL_TREE)
+ char_len = build3 (COMPONENT_REF, TREE_TYPE (recl), ioparm_var,
+ recl, NULL_TREE);
/* Integer variable assigned a format label. */
if (e->ts.type == BT_INTEGER && e->symtree->n.sym->attr.assign == 1)
*************** set_string (stmtblock_t * block, stmtblo
*** 474,479 ****
--- 480,493 ----
gfc_conv_string_parameter (&se);
gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr));
gfc_add_modify_expr (&se.pre, len, se.string_length);
+ if (recl != NULL_TREE)
+ {
+ if (e->ts.cl)
+ tmp = e->ts.cl->backend_decl;
+ else
+ tmp = e->symtree->n.sym->ts.cl->backend_decl;
+ gfc_add_modify_expr (&se.pre, char_len, tmp);
+ }
}
gfc_add_block_to_block (block, &se.pre);
*************** gfc_trans_open (gfc_code * code)
*** 601,640 ****
set_parameter_value (&block, ioparm_unit, p->unit);
if (p->file)
! set_string (&block, &post_block, ioparm_file, ioparm_file_len, p->file);
if (p->status)
set_string (&block, &post_block, ioparm_status,
! ioparm_status_len, p->status);
if (p->access)
set_string (&block, &post_block, ioparm_access,
! ioparm_access_len, p->access);
if (p->form)
! set_string (&block, &post_block, ioparm_form, ioparm_form_len, p->form);
if (p->recl)
set_parameter_value (&block, ioparm_recl_in, p->recl);
if (p->blank)
set_string (&block, &post_block, ioparm_blank, ioparm_blank_len,
! p->blank);
if (p->position)
set_string (&block, &post_block, ioparm_position,
! ioparm_position_len, p->position);
if (p->action)
set_string (&block, &post_block, ioparm_action,
! ioparm_action_len, p->action);
if (p->delim)
set_string (&block, &post_block, ioparm_delim, ioparm_delim_len,
! p->delim);
if (p->pad)
! set_string (&block, &post_block, ioparm_pad, ioparm_pad_len, p->pad);
if (p->iostat)
set_parameter_ref (&block, ioparm_iostat, p->iostat);
--- 615,657 ----
set_parameter_value (&block, ioparm_unit, p->unit);
if (p->file)
! set_string (&block, &post_block, ioparm_file,
! ioparm_file_len, p->file, NULL_TREE);
if (p->status)
set_string (&block, &post_block, ioparm_status,
! ioparm_status_len, p->status, NULL_TREE);
if (p->access)
set_string (&block, &post_block, ioparm_access,
! ioparm_access_len, p->access, NULL_TREE);
if (p->form)
! set_string (&block, &post_block, ioparm_form,
! ioparm_form_len, p->form, NULL_TREE);
if (p->recl)
set_parameter_value (&block, ioparm_recl_in, p->recl);
if (p->blank)
set_string (&block, &post_block, ioparm_blank, ioparm_blank_len,
! p->blank, NULL_TREE);
if (p->position)
set_string (&block, &post_block, ioparm_position,
! ioparm_position_len, p->position, NULL_TREE);
if (p->action)
set_string (&block, &post_block, ioparm_action,
! ioparm_action_len, p->action, NULL_TREE);
if (p->delim)
set_string (&block, &post_block, ioparm_delim, ioparm_delim_len,
! p->delim, NULL_TREE);
if (p->pad)
! set_string (&block, &post_block, ioparm_pad,
! ioparm_pad_len, p->pad, NULL_TREE);
if (p->iostat)
set_parameter_ref (&block, ioparm_iostat, p->iostat);
*************** gfc_trans_close (gfc_code * code)
*** 673,679 ****
if (p->status)
set_string (&block, &post_block, ioparm_status,
! ioparm_status_len, p->status);
if (p->iostat)
set_parameter_ref (&block, ioparm_iostat, p->iostat);
--- 690,696 ----
if (p->status)
set_string (&block, &post_block, ioparm_status,
! ioparm_status_len, p->status, NULL_TREE);
if (p->iostat)
set_parameter_ref (&block, ioparm_iostat, p->iostat);
*************** gfc_trans_inquire (gfc_code * code)
*** 774,780 ****
set_parameter_value (&block, ioparm_unit, p->unit);
if (p->file)
! set_string (&block, &post_block, ioparm_file, ioparm_file_len, p->file);
if (p->iostat)
set_parameter_ref (&block, ioparm_iostat, p->iostat);
--- 791,798 ----
set_parameter_value (&block, ioparm_unit, p->unit);
if (p->file)
! set_string (&block, &post_block, ioparm_file,
! ioparm_file_len, p->file, NULL_TREE);
if (p->iostat)
set_parameter_ref (&block, ioparm_iostat, p->iostat);
*************** gfc_trans_inquire (gfc_code * code)
*** 792,821 ****
set_parameter_ref (&block, ioparm_named, p->named);
if (p->name)
! set_string (&block, &post_block, ioparm_name, ioparm_name_len, p->name);
if (p->access)
set_string (&block, &post_block, ioparm_access,
! ioparm_access_len, p->access);
if (p->sequential)
set_string (&block, &post_block, ioparm_sequential,
! ioparm_sequential_len, p->sequential);
if (p->direct)
set_string (&block, &post_block, ioparm_direct,
! ioparm_direct_len, p->direct);
if (p->form)
! set_string (&block, &post_block, ioparm_form, ioparm_form_len, p->form);
if (p->formatted)
set_string (&block, &post_block, ioparm_formatted,
! ioparm_formatted_len, p->formatted);
if (p->unformatted)
set_string (&block, &post_block, ioparm_unformatted,
! ioparm_unformatted_len, p->unformatted);
if (p->recl)
set_parameter_ref (&block, ioparm_recl_out, p->recl);
--- 810,841 ----
set_parameter_ref (&block, ioparm_named, p->named);
if (p->name)
! set_string (&block, &post_block, ioparm_name,
! ioparm_name_len, p->name, NULL_TREE);
if (p->access)
set_string (&block, &post_block, ioparm_access,
! ioparm_access_len, p->access, NULL_TREE);
if (p->sequential)
set_string (&block, &post_block, ioparm_sequential,
! ioparm_sequential_len, p->sequential, NULL_TREE);
if (p->direct)
set_string (&block, &post_block, ioparm_direct,
! ioparm_direct_len, p->direct, NULL_TREE);
if (p->form)
! set_string (&block, &post_block, ioparm_form,
! ioparm_form_len, p->form, NULL_TREE);
if (p->formatted)
set_string (&block, &post_block, ioparm_formatted,
! ioparm_formatted_len, p->formatted, NULL_TREE);
if (p->unformatted)
set_string (&block, &post_block, ioparm_unformatted,
! ioparm_unformatted_len, p->unformatted, NULL_TREE);
if (p->recl)
set_parameter_ref (&block, ioparm_recl_out, p->recl);
*************** gfc_trans_inquire (gfc_code * code)
*** 825,858 ****
if (p->blank)
set_string (&block, &post_block, ioparm_blank, ioparm_blank_len,
! p->blank);
if (p->position)
set_string (&block, &post_block, ioparm_position,
! ioparm_position_len, p->position);
if (p->action)
set_string (&block, &post_block, ioparm_action,
! ioparm_action_len, p->action);
if (p->read)
! set_string (&block, &post_block, ioparm_read, ioparm_read_len, p->read);
if (p->write)
set_string (&block, &post_block, ioparm_write,
! ioparm_write_len, p->write);
if (p->readwrite)
set_string (&block, &post_block, ioparm_readwrite,
! ioparm_readwrite_len, p->readwrite);
if (p->delim)
! set_string (&block, &post_block, ioparm_delim, ioparm_delim_len,
! p->delim);
if (p->pad)
! set_string (&block, &post_block, ioparm_pad, ioparm_pad_len,
! p->pad);
if (p->err)
set_flag (&block, ioparm_err);
--- 845,879 ----
if (p->blank)
set_string (&block, &post_block, ioparm_blank, ioparm_blank_len,
! p->blank, NULL_TREE);
if (p->position)
set_string (&block, &post_block, ioparm_position,
! ioparm_position_len, p->position, NULL_TREE);
if (p->action)
set_string (&block, &post_block, ioparm_action,
! ioparm_action_len, p->action, NULL_TREE);
if (p->read)
! set_string (&block, &post_block, ioparm_read,
! ioparm_read_len, p->read, NULL_TREE);
if (p->write)
set_string (&block, &post_block, ioparm_write,
! ioparm_write_len, p->write, NULL_TREE);
if (p->readwrite)
set_string (&block, &post_block, ioparm_readwrite,
! ioparm_readwrite_len, p->readwrite, NULL_TREE);
if (p->delim)
! set_string (&block, &post_block, ioparm_delim,
! ioparm_delim_len, p->delim, NULL_TREE);
if (p->pad)
! set_string (&block, &post_block, ioparm_pad,
! ioparm_pad_len, p->pad, NULL_TREE);
if (p->err)
set_flag (&block, ioparm_err);
*************** build_dt (tree * function, gfc_code * co
*** 1133,1139 ****
if (dt->io_unit->ts.type == BT_CHARACTER)
{
set_string (&block, &post_block, ioparm_internal_unit,
! ioparm_internal_unit_len, dt->io_unit);
}
else
set_parameter_value (&block, ioparm_unit, dt->io_unit);
--- 1154,1160 ----
if (dt->io_unit->ts.type == BT_CHARACTER)
{
set_string (&block, &post_block, ioparm_internal_unit,
! ioparm_internal_unit_len, dt->io_unit, ioparm_recl_in);
}
else
set_parameter_value (&block, ioparm_unit, dt->io_unit);
*************** build_dt (tree * function, gfc_code * co
*** 1144,1162 ****
if (dt->advance)
set_string (&block, &post_block, ioparm_advance, ioparm_advance_len,
! dt->advance);
if (dt->format_expr)
set_string (&block, &post_block, ioparm_format, ioparm_format_len,
! dt->format_expr);
if (dt->format_label)
{
if (dt->format_label == &format_asterisk)
set_flag (&block, ioparm_list_format);
else
! set_string (&block, &post_block, ioparm_format,
! ioparm_format_len, dt->format_label->format);
}
if (dt->iostat)
--- 1165,1183 ----
if (dt->advance)
set_string (&block, &post_block, ioparm_advance, ioparm_advance_len,
! dt->advance, NULL_TREE);
if (dt->format_expr)
set_string (&block, &post_block, ioparm_format, ioparm_format_len,
! dt->format_expr, NULL_TREE);
if (dt->format_label)
{
if (dt->format_label == &format_asterisk)
set_flag (&block, ioparm_list_format);
else
! set_string (&block, &post_block, ioparm_format, ioparm_format_len,
! dt->format_label->format, NULL_TREE);
}
if (dt->iostat)
*************** build_dt (tree * function, gfc_code * co
*** 1182,1188 ****
nmlname = gfc_new_nml_name_expr(dt->namelist->name);
set_string (&block, &post_block, ioparm_namelist_name,
! ioparm_namelist_name_len, nmlname);
if (last_dt == READ)
set_flag (&block, ioparm_namelist_read_mode);
--- 1203,1209 ----
nmlname = gfc_new_nml_name_expr(dt->namelist->name);
set_string (&block, &post_block, ioparm_namelist_name,
! ioparm_namelist_name_len, nmlname, NULL_TREE);
if (last_dt == READ)
set_flag (&block, ioparm_namelist_read_mode);
More information about the Fortran
mailing list