gcc/fortran/

	PR fortran/14943
	PR fortran/21647
	* Make-lang.in (fortran/trans-io.o): Depend on fortran/ioparm.def.
	* dump-parse-tree.c (gfc_show_code_node): Dump c->block for
	EXEC_{READ,WRITE,IOLENGTH} nodes.
	* io.c (terminate_io, match_io, gfc_match_inquire): Put data
	transfer commands into EXEC_{READ,WRITE,IOLENGTH}'s code->block.
	* resolve.c (resolve_blocks): Handle EXEC_{READ,WRITE,IOLENGTH}.
	* trans-io.c (ioparm_unit, ioparm_err, ioparm_end, ioparm_eor,
	ioparm_list_format, ioparm_library_return, ioparm_iostat,
	ioparm_exist, ioparm_opened, ioparm_number, ioparm_named,
	ioparm_rec, ioparm_nextrec, ioparm_size, ioparm_recl_in,
	ioparm_recl_out, ioparm_iolength, ioparm_file, ioparm_file_len,
	ioparm_status, ioparm_status_len, ioparm_access, ioparm_access_len,
	ioparm_form, ioparm_form_len, ioparm_blank, ioparm_blank_len,
	ioparm_position, ioparm_position_len, ioparm_action,
	ioparm_action_len, ioparm_delim, ioparm_delim_len, ioparm_pad,
	ioparm_pad_len, ioparm_format, ioparm_format_len, ioparm_advance,
	ioparm_advance_len, ioparm_name, ioparm_name_len,
	ioparm_internal_unit, ioparm_internal_unit_len,
	ioparm_internal_unit_desc, ioparm_sequential, ioparm_sequential_len,
	ioparm_direct, ioparm_direct_len, ioparm_formatted,
	ioparm_formatted_len, ioparm_unformatted, ioparm_unformatted_len,
	ioparm_read, ioparm_read_len, ioparm_write, ioparm_write_len,
	ioparm_readwrite, ioparm_readwrite_len, ioparm_namelist_name,
	ioparm_namelist_name_len, ioparm_namelist_read_mode, ioparm_iomsg,
	ioparm_iomsg_len, ioparm_var): Remove.
	(enum ioparam_type, enum iofield_type, enum iofield,
	enum iocall): New enums.
	(gfc_st_parameter_field, gfc_st_parameter): New typedefs.
	(st_parameter, st_parameter_field, iocall): New variables.
	(ADD_FIELD, ADD_STRING): Remove.
	(dt_parm, dt_post_end_block): New variables.
	(gfc_build_st_parameter): New function.
	(gfc_build_io_library_fndecls): Use it.  Initialize iocall
	array rather than ioparm_*, add extra first arguments to
	the function types.
	(set_parameter_const): New function.
	(set_parameter_value): Add type argument, return a bitmask.
	Changed to set a field in automatic structure variable rather
	than set a field in a global _gfortran_ioparm variable.
	(set_parameter_ref): Likewise.  If requested var has different
	size than what field should point to, call with a temporary and
	then copy into the user variable.  Add postblock argument.
	(set_string): Remove var_len argument, add type argument, return
	a bitmask.  Changed to set fields in automatic structure variable
	rather than set a field in a global _gfortran_ioparm variable.
	(set_internal_unit): Remove iunit, iunit_len, iunit_desc arguments,
	add var argument.  Return a bitmask.  Changed to set fields in
	automatic structure variable rather than set a field in a global
	_gfortran_ioparm variable.
	(set_flag): Removed.
	(io_result): Add var argument.  Changed to read common.flags field
	from automatic structure variable and bitwise AND it with 3.
	(set_error_locus): Add var argument.  Changed to set fields in
	automatic structure variable rather than set a field in a global
	_gfortran_{filename,line} variables.
	(gfc_trans_open): Use gfc_start_block rather than gfc_init_block.
	Create a temporary st_parameter_* structure.  Adjust callers of
	all above mentioned functions.  Pass address of the temporary
	variable as first argument to the generated function call.
	Use iocall array rather than ioparm_* separate variables.
	(gfc_trans_close, build_filepos, gfc_trans_inquire): Likewise.
	(build_dt): Likewise.  Change first argument to tree from tree *.
	Don't dereference code->ext.dt if last_dt == INQUIRE.  Emit
	IOLENGTH argument setup here.  Set dt_parm/dt_post_end_block
	variables and gfc_trans_code the nested data transfer commands
	in code->block.
	(gfc_trans_iolength): Just set last_dt and call build_dt immediately.
	(transfer_namelist_element): Pass address of dt_parm variable
	to generated functions.  Use iocall array rather than ioparm_*
	separate variables.
	(gfc_trans_backspace, gfc_trans_endfile, gfc_trans_rewind,
	gfc_trans_flush, gfc_trans_read, gfc_trans_write): Use iocall array
	rather than ioparm_* separate variables.
	(gfc_trans_dt_end): Likewise.  Pass address of dt_parm variable
	as first argument to generated function.  Adjust io_result caller.
	Prepend dt_post_end_block before io_result code.
	(transfer_expr): Use iocall array rather than ioparm_* separate
	variables.  Pass address of dt_parm variables as first argument
	to generated functions.
	* ioparm.def: New file.
gcc/testsuite/
	PR fortran/24774
	* gfortran.dg/inquire_9.f90: New test.

	PR fortran/21647
	* gfortran.fortran-torture/execute/inquire_5.f90: New test.
libgfortran/
	PR fortran/24774
	PR fortran/14943
	PR fortran/21647
	* Makefile.am (AM_CPPFLAGS): Add gcc directories as -I paths,
	add -D_GNU_SOURCE.
	* Makefile.in: Regenerated.
	* acinclude.m4 (LIBGFOR_CHECK_SYNC_FETCH_AND_ADD,
	LIBGFOR_CHECK_GTHR_DEFAULT, LIBGFOR_CHECK_PRAGMA_WEAK): New macros.
	* configure.ac: Add them.
	* configure: Rebuilt.
	* config.h.in: Rebuilt.
	* libtool-version: Bump libgfortran.so SONAME to libgfortran.so.1.
	* libgfortran.h (library_start, show_locus, internal_error,
	generate_error, find_option): Add st_parameter_common * argument.
	(library_end): Change into a dummy macro.
	* io/io.h: Include gthr.h.
	(SUPPORTS_WEAK): Define if HAVE_PRAGMA_WEAK.
	(CHARACTER): Remove define.
	(st_parameter, global_t): Remove typedef.
	(ioparm, g, ionml, current_unit): Remove variables.
	(init_error_stream): Remove prototype.
	(CHARACTER1, CHARACTER2): Define.
	(st_parameter_common, st_parameter_open, st_parameter_close,
	st_parameter_filepos, st_parameter_inquire, st_parameter_dt): New
	typedefs.
	(IOPARM_LIBRETURN_MASK, IOPARM_LIBRETURN_OK, IOPARM_LIBRETURN_ERROR,
	IOPARM_LIBRETURN_END, IOPARM_LIBRETURN_EOR, IOPARM_ERR, IOPARM_END,
	IOPARM_EOR, IOPARM_HAS_IOSTAT, IOPARM_HAS_IOMSG, IOPARM_COMMON_MASK,
	IOPARM_OPEN_HAS_RECL_IN, IOPARM_OPEN_HAS_FILE, IOPARM_OPEN_HAS_STATUS,
	IOPARM_OPEN_HAS_ACCESS, IOPARM_OPEN_HAS_FORM, IOPARM_OPEN_HAS_BLANK,
	IOPARM_OPEN_HAS_POSITION, IOPARM_OPEN_HAS_ACTION,
	IOPARM_OPEN_HAS_DELIM, IOPARM_OPEN_HAS_PAD, IOPARM_CLOSE_HAS_STATUS,
	IOPARM_INQUIRE_HAS_EXIST, IOPARM_INQUIRE_HAS_OPENED,
	IOPARM_INQUIRE_HAS_NUMBER, IOPARM_INQUIRE_HAS_NAMED,
	IOPARM_INQUIRE_HAS_NEXTREC, IOPARM_INQUIRE_HAS_RECL_OUT,
	IOPARM_INQUIRE_HAS_FILE, IOPARM_INQUIRE_HAS_ACCESS,
	IOPARM_INQUIRE_HAS_FORM, IOPARM_INQUIRE_HAS_BLANK,
	IOPARM_INQUIRE_HAS_POSITION, IOPARM_INQUIRE_HAS_ACTION,
	IOPARM_INQUIRE_HAS_DELIM, IOPARM_INQUIRE_HAS_PAD,
	IOPARM_INQUIRE_HAS_NAME, IOPARM_INQUIRE_HAS_SEQUENTIAL,
	IOPARM_INQUIRE_HAS_DIRECT, IOPARM_INQUIRE_HAS_FORMATTED,
	IOPARM_INQUIRE_HAS_UNFORMATTED, IOPARM_INQUIRE_HAS_READ,
	IOPARM_INQUIRE_HAS_WRITE, IOPARM_INQUIRE_HAS_READWRITE,
	IOPARM_DT_LIST_FORMAT, IOPARM_DT_NAMELIST_READ_MODE,
	IOPARM_DT_HAS_REC, IOPARM_DT_HAS_SIZE, IOPARM_DT_HAS_IOLENGTH,
	IOPARM_DT_HAS_FORMAT, IOPARM_DT_HAS_ADVANCE,
	IOPARM_DT_HAS_INTERNAL_UNIT, IOPARM_DT_HAS_NAMELIST_NAME,
	IOPARM_DT_IONML_SET): Define.
	(gfc_unit): Add lock, waiting and close fields.  Change file
	from flexible array member into pointer to char.
	(open_external): Add st_parameter_open * argument.
	(find_file, file_exists): Add file and file_len arguments.
	(flush_all_units): New prototype.
	(max_offset, unit_root, unit_lock): New variable.
	(is_internal_unit, is_array_io, next_array_record,
	parse_format, next_format, unget_format, format_error,
	read_block, write_block, next_record, convert_real,
	read_a, read_f, read_l, read_x, read_radix, read_decimal,
	list_formatted_read, finish_list_read, namelist_read,
	namelist_write, write_a, write_b, write_d, write_e, write_en,
	write_es, write_f, write_i, write_l, write_o, write_x, write_z,
	list_formatted_write, get_unit): Add st_parameter_dt * argument.
	(insert_unit): Remove prototype.
	(find_or_create_unit, unlock_unit): New prototype.
	(new_unit): Return gfc_unit *.  Add st_parameter_open *
	and gfc_unit * arguments.
	(free_fnodes): Remove prototype.
	(free_format_data): New prototype.
	(scratch): Remove.
	(init_at_eol): Remove prototype.
	(free_ionml): New prototype.
	(inc_waiting_locked, predec_waiting_locked, dec_waiting_unlocked):
	New inline functions.
	* io/unit.c (max_offset, unit_root, unit_lock): New variables.
	(insert): Adjust os_error caller.
	(insert_unit): Made static.  Allocate memory here, initialize
	lock and after inserting it return it, locked.
	(delete_unit): Adjust for deletion of g.
	(find_unit_1): New function.
	(find_unit): Use it.
	(find_or_create_unit): New function.
	(get_unit): Add dtp argument, change meaning of the int argument
	as creation request flag.  Adjust for different st_* calling
	conventions, lock internal unit's lock before returning it
	and removal of g.  Call find_unit_1 instead of find_unit.
	(is_internal_unit, is_array_io): Add dtp argument, adjust for
	removal of most of global variables.
	(init_units): Initialize unit_lock.  Adjust insert_unit callers
	and adjust for g removal.
	(close_unit_1): New function.
	(close_unit): Use it.
	(unlock_unit): New function.
	(close_units): Lock unit_lock, use close_unit_1 rather than
	close_unit.
	* io/close.c (st_close): Add clp argument.  Adjust for new
	st_* calling conventions and internal function API changes.
	* io/file_pos.c (st_backspace, st_endfile, st_rewind, st_flush):
	Add fpp argument.  Adjust for new st_* calling conventions and
	internal function API changes.
	(formatted_backspace, unformatted_backspace): Likewise.  Add
	u argument.
	* io/open.c (edit_modes, st_open): Add opp argument.  Adjust for
	new st_* calling conventions and internal function API changes.
	(already_open): Likewise.  If not HAVE_UNLINK_OPEN_FILE, unlink
	scratch file.  Instead of calling close_unit just call sclose,
	free u->file if any and clear a few u fields before calling
	new_unit.
	(new_unit): Return gfc_unit *.  Add opp and u arguments.
	Adjust for new st_* calling conventions and internal function
	API changes.  Don't allocate unit here, rather than work with
	already created unit u already locked on entry.  In case
	of failure, close_unit it.
	* io/unix.c: Include unix.h.
	(BUFFER_SIZE, unix_stream): Moved to unix.h.
	(unit_to_fd): Add unlock_unit call.
	(tempfile): Add opp argument, use its fields rather than ioparm.
	(regular_file): Likewise.
	(open_external): Likewise.  Only unlink file if fd >= 0.
	(init_error_stream): Add error argument, set structure it points
	to rather than filling static variable and returning its address.
	(FIND_FILE0_DECL, FIND_FILE0_ARGS): Define.
	(find_file0): Use them.  Don't crash if u->s == NULL.
	(find_file): Add file and file_len arguments, use them instead
	of ioparm.  Add locking.  Pass either an array of 2 struct stat
	or file and file_len pair to find_file0.
	(flush_all_units_1, flush_all_units): New functions.
	(file_exists): Add file and file_len arguments, use them instead
	of ioparm.
	* io/unix.h: New file.
	* io/lock.c (ioparm, g, ionml): Remove variables.
	(library_start): Add cmp argument, adjust for new st_* calling
	conventions.
	(library_end): Remove.
	(free_ionml): New function.
	* io/inquire.c (inquire_via_unit, inquire_via_filename,
	st_inquire): Add iqp argument, adjust for new st_* calling
	conventions and internal function API changes.
	* io/format.c (FARRAY_SIZE): Decrease to 64.
	(fnode_array, format_data): New typedefs.
	(avail, array, format_string, string, error, saved_token, value,
	format_string_len, reversion_ok, saved_format): Remove variables.
	(colon_node): Add const.
	(free_fnode, free_fnodes): Remove.
	(free_format_data): New function.
	(next_char, unget_char, get_fnode, format_lex, parse_format_list,
	format_error, parse_format, revert, unget_format, next_test): Add
	fmt or dtp arguments, pass it all around, adjust for internal
	function API changes and adjust for removal of global variables.
	(next_format): Likewise.  Constify return type.
	(next_format0): Constify return type.
	* io/transfer.c (current_unit, sf_seen_eor, eor_condition, max_pos,
	skips, pending_spaces, scratch, line_buffer, advance_status,
	transfer): Remove variables.
	(transfer_integer, transfer_real, transfer_logical,
	transfer_character, transfer_complex, transfer_array, current_mode,
	read_sf, read_block, read_block_direct, write_block,
	write_block_direct, unformatted_read, unformatted_write,
	type_name, write_constant_string, require_type,
	formatted_transfer_scalar, us_read, us_write, pre_position,
	data_transfer_init, next_record_r, next_record_w, next_record,
	finalize_transfer, iolength_transfer, iolength_transfer_init,
	st_iolength, st_iolength_done, st_read, st_read_done, st_write,
	st_write_done, st_set_nml_var, st_set_nml_var_dim,
	next_array_record): Add dtp argument, pass it all around, adjust for
	internal function API changes and removal of global variables.
	* io/list_read.c (repeat_count, saved_length, saved_used,
	input_complete, at_eol, comma_flag, last_char, saved_string,
	saved_type, namelist_mode, nml_read_error, value, parse_err_msg,
	nml_err_msg, prev_nl): Remove variables.
	(push_char, free_saved, next_char, unget_char, eat_spaces,
	eat_separator, finish_separator, nml_bad_return, convert_integer,
	parse_repeat, read_logical, read_integer, read_character,
	parse_real, read_complex, read_real, check_type,
	list_formatted_read_scalar, list_formatted_read, finish_list_read,
	find_nml_node, nml_untouch_nodes, nml_match_name, nml_query,
	namelist_read): Add dtp argument, pass it all around, adjust for
	internal function API changes and removal of global variables.
	(nml_parse_qualifier): Likewise.  Add parse_err_msg argument.
	(nml_read_obj): Likewise.  Add pprev_nl, nml_err_msg, clow and
	chigh arguments.
	(nml_get_obj_data): Likewise.  Add pprev_nl and nml_err_msg
	arguments.
	(init_at_eol): Removed.
	* io/read.c (convert_real, read_l, read_a, next_char, read_decimal,
	read_radix, read_f, read_x): Add dtp argument, pass it all around,
	adjust for internal function API changes and removal of global
	variables.
	(set_integer): Adjust internal_error caller.
	* io/write.c (no_leading_blank, nml_delim): Remove variables.
	(write_a, calculate_sign, calculate_G_format, output_float,
	write_l, write_float, write_int, write_decimal, write_i, write_b,
	write_o, write_z, write_d, write_e, write_f, write_en, write_es,
	write_x, write_char, write_logical, write_integer, write_character,
	write_real, write_complex, write_separator,
	list_formatted_write_scalar, list_formatted_write, nml_write_obj,
	namelist_write): Add dtp argument, pass it all around, adjust for
	internal function API changes and removal of global variables.
	(extract_int, extract_uint, extract_real): Adjust internal_error
	callers.
	* runtime/fpu.c (_GNU_SOURCE): Don't define here.
	* runtime/error.c: Include ../io/unix.h.
	(filename, line): Remove variables.
	(st_printf): Pass address of a local variable to init_error_stream.
	(show_locus): Add cmp argument.  Use fields it points to rather than
	filename and line variables.
	(os_error, runtime_error): Remove show_locus calls.
	(internal_error): Add cmp argument.  Pass it down to show_locus.
	(generate_error): Likewise.  Use flags bitmask instead of non-NULL
	check for iostat and iomsg parameter presence, adjust for st_*
	calling convention changes.
	* runtime/stop.c (stop_numeric, stop_string): Remove show_locus
	calls.
	* runtime/pause.c (pause_numeric, pause_string): Likewise.
	* runtime/string.c: Include ../io/io.h.
	(find_option): Add cmp argument.  Pass it down to generate_error.
	* intrinsics/flush.c (recursive_flush): Remove.
	(flush_i4, flush_i8): Use flush_all_units.  Add unlock_unit
	call.
	* intrinsics/rand.c: Include ../io/io.h.
	(rand_seed_lock): New variable.
	(srand, irand): Add locking.
	(init): New constructor function.
	* intrinsics/random.c: Include ../io/io.h.
	(random_lock): New variable.
	(random_r4, random_r8, arandom_r4, arandom_r8): Add locking.
	(random_seed): Likewise.  open failed if fd < 0.  Set i correctly.
	(init): New constructor function.
	* intrinsics/system_clock.c (tp0, t0): Remove.
	(system_clock_4, system_clock_8): Don't subtract tp0/t0 from current
	time, use just integer arithmetics.
	* intrinsics/tty.c (isatty_l4, isatty_l8, ttynam_sub): Add
	unlock_unit calls.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@107328 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 852 insertions, 482 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 355430d553a..4a124d3b3ad 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,88 @@
+2005-11-21  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/14943
+	PR fortran/21647
+	* Make-lang.in (fortran/trans-io.o): Depend on fortran/ioparm.def.
+	* dump-parse-tree.c (gfc_show_code_node): Dump c->block for
+	EXEC_{READ,WRITE,IOLENGTH} nodes.
+	* io.c (terminate_io, match_io, gfc_match_inquire): Put data
+	transfer commands into EXEC_{READ,WRITE,IOLENGTH}'s code->block.
+	* resolve.c (resolve_blocks): Handle EXEC_{READ,WRITE,IOLENGTH}.
+	* trans-io.c (ioparm_unit, ioparm_err, ioparm_end, ioparm_eor,
+	ioparm_list_format, ioparm_library_return, ioparm_iostat,
+	ioparm_exist, ioparm_opened, ioparm_number, ioparm_named,
+	ioparm_rec, ioparm_nextrec, ioparm_size, ioparm_recl_in,
+	ioparm_recl_out, ioparm_iolength, ioparm_file, ioparm_file_len,
+	ioparm_status, ioparm_status_len, ioparm_access, ioparm_access_len,
+	ioparm_form, ioparm_form_len, ioparm_blank, ioparm_blank_len,
+	ioparm_position, ioparm_position_len, ioparm_action,
+	ioparm_action_len, ioparm_delim, ioparm_delim_len, ioparm_pad,
+	ioparm_pad_len, ioparm_format, ioparm_format_len, ioparm_advance,
+	ioparm_advance_len, ioparm_name, ioparm_name_len,
+	ioparm_internal_unit, ioparm_internal_unit_len,
+	ioparm_internal_unit_desc, ioparm_sequential, ioparm_sequential_len,
+	ioparm_direct, ioparm_direct_len, ioparm_formatted,
+	ioparm_formatted_len, ioparm_unformatted, ioparm_unformatted_len,
+	ioparm_read, ioparm_read_len, ioparm_write, ioparm_write_len,
+	ioparm_readwrite, ioparm_readwrite_len, ioparm_namelist_name,
+	ioparm_namelist_name_len, ioparm_namelist_read_mode, ioparm_iomsg,
+	ioparm_iomsg_len, ioparm_var): Remove.
+	(enum ioparam_type, enum iofield_type, enum iofield,
+	enum iocall): New enums.
+	(gfc_st_parameter_field, gfc_st_parameter): New typedefs.
+	(st_parameter, st_parameter_field, iocall): New variables.
+	(ADD_FIELD, ADD_STRING): Remove.
+	(dt_parm, dt_post_end_block): New variables.
+	(gfc_build_st_parameter): New function.
+	(gfc_build_io_library_fndecls): Use it.  Initialize iocall
+	array rather than ioparm_*, add extra first arguments to
+	the function types.
+	(set_parameter_const): New function.
+	(set_parameter_value): Add type argument, return a bitmask.
+	Changed to set a field in automatic structure variable rather
+	than set a field in a global _gfortran_ioparm variable.
+	(set_parameter_ref): Likewise.  If requested var has different
+	size than what field should point to, call with a temporary and
+	then copy into the user variable.  Add postblock argument.
+	(set_string): Remove var_len argument, add type argument, return
+	a bitmask.  Changed to set fields in automatic structure variable
+	rather than set a field in a global _gfortran_ioparm variable.
+	(set_internal_unit): Remove iunit, iunit_len, iunit_desc arguments,
+	add var argument.  Return a bitmask.  Changed to set fields in
+	automatic structure variable rather than set a field in a global
+	_gfortran_ioparm variable.
+	(set_flag): Removed.
+	(io_result): Add var argument.  Changed to read common.flags field
+	from automatic structure variable and bitwise AND it with 3.
+	(set_error_locus): Add var argument.  Changed to set fields in
+	automatic structure variable rather than set a field in a global
+	_gfortran_{filename,line} variables.
+	(gfc_trans_open): Use gfc_start_block rather than gfc_init_block.
+	Create a temporary st_parameter_* structure.  Adjust callers of
+	all above mentioned functions.  Pass address of the temporary
+	variable as first argument to the generated function call.
+	Use iocall array rather than ioparm_* separate variables.
+	(gfc_trans_close, build_filepos, gfc_trans_inquire): Likewise.
+	(build_dt): Likewise.  Change first argument to tree from tree *.
+	Don't dereference code->ext.dt if last_dt == INQUIRE.  Emit
+	IOLENGTH argument setup here.  Set dt_parm/dt_post_end_block
+	variables and gfc_trans_code the nested data transfer commands
+	in code->block.
+	(gfc_trans_iolength): Just set last_dt and call build_dt immediately.
+	(transfer_namelist_element): Pass address of dt_parm variable
+	to generated functions.  Use iocall array rather than ioparm_*
+	separate variables.
+	(gfc_trans_backspace, gfc_trans_endfile, gfc_trans_rewind,
+	gfc_trans_flush, gfc_trans_read, gfc_trans_write): Use iocall array
+	rather than ioparm_* separate variables.
+	(gfc_trans_dt_end): Likewise.  Pass address of dt_parm variable
+	as first argument to generated function.  Adjust io_result caller.
+	Prepend dt_post_end_block before io_result code.
+	(transfer_expr): Use iocall array rather than ioparm_* separate
+	variables.  Pass address of dt_parm variables as first argument
+	to generated functions.
+	* ioparm.def: New file.
+
 2005-11-21  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/24223
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 96b6e252110..5d3a0e0ef5f 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -287,7 +287,8 @@ fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \
 fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS)
 fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
 fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS)
-fortran/trans-io.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-io.h
+fortran/trans-io.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-io.h \
+  fortran/ioparm.def
 fortran/trans-array.o: $(GFORTRAN_TRANS_DEPS)
 fortran/trans-intrinsic.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
   gt-fortran-trans-intrinsic.h
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 7d2b26d2d72..499e1fa22e5 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1357,6 +1357,7 @@ gfc_show_code_node (int level, gfc_code * c)
     case EXEC_IOLENGTH:
       gfc_status ("IOLENGTH ");
       gfc_show_expr (c->expr);
+      goto show_dt_code;
       break;
 
     case EXEC_READ:
@@ -1411,7 +1412,11 @@ gfc_show_code_node (int level, gfc_code * c)
 	  gfc_show_expr (dt->advance);
 	}
 
-      break;
+    show_dt_code:
+      gfc_status_char ('\n');
+      for (c = c->block->next; c; c = c->next)
+	gfc_show_code_node (level + (c->next != NULL), c);
+      return;
 
     case EXEC_TRANSFER:
       gfc_status ("TRANSFER ");
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 183948e5788..26c335688fc 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -2147,7 +2147,7 @@ terminate_io (gfc_code * io_code)
   gfc_code *c;
 
   if (io_code == NULL)
-    io_code = &new_st;
+    io_code = new_st.block;
 
   c = gfc_get_code ();
   c->op = EXEC_DT_END;
@@ -2353,7 +2353,9 @@ get_io_list:
 
   new_st.op = (k == M_READ) ? EXEC_READ : EXEC_WRITE;
   new_st.ext.dt = dt;
-  new_st.next = io_code;
+  new_st.block = gfc_get_code ();
+  new_st.block->op = new_st.op;
+  new_st.block->next = io_code;
 
   terminate_io (io_code);
 
@@ -2522,8 +2524,6 @@ gfc_match_inquire (void)
       if (m == MATCH_NO)
 	goto syntax;
 
-      terminate_io (code);
-
       new_st.op = EXEC_IOLENGTH;
       new_st.expr = inquire->iolength;
       new_st.ext.inquire = inquire;
@@ -2535,7 +2535,10 @@ gfc_match_inquire (void)
 	  return MATCH_ERROR;
 	}
 
-      new_st.next = code;
+      new_st.block = gfc_get_code ();
+      new_st.block->op = EXEC_IOLENGTH;
+      terminate_io (code);
+      new_st.block->next = code;
       return MATCH_YES;
     }
 
diff --git a/gcc/fortran/ioparm.def b/gcc/fortran/ioparm.def
new file mode 100644
index 00000000000..9ca0cf659b1
--- /dev/null
+++ b/gcc/fortran/ioparm.def
@@ -0,0 +1,67 @@
+#ifndef IOPARM_common_libreturn_mask
+#define IOPARM_common_libreturn_mask	3
+#define IOPARM_common_libreturn_ok	0
+#define IOPARM_common_libreturn_error	1
+#define IOPARM_common_libreturn_end	2
+#define IOPARM_common_libreturn_eor	3
+#define IOPARM_common_err		(1 << 2)
+#define IOPARM_common_end		(1 << 3)
+#define IOPARM_common_eor		(1 << 4)
+#endif
+IOPARM (common,  flags,		0,       int4)
+IOPARM (common,  unit,		0,       int4)
+IOPARM (common,  filename,	0,       pchar)
+IOPARM (common,  line,		0,       int4)
+IOPARM (common,  iomsg,		1 << 6,  char2)
+IOPARM (common,  iostat,	1 << 5,  pint4)
+IOPARM (open,    common,	0,	 common)
+IOPARM (open,    recl_in,	1 << 7,  int4)
+IOPARM (open,    file,		1 << 8,  char2)
+IOPARM (open,    status,	1 << 9,  char1)
+IOPARM (open,    access,	1 << 10, char2)
+IOPARM (open,    form,		1 << 11, char1)
+IOPARM (open,    blank,		1 << 12, char2)
+IOPARM (open,    position,	1 << 13, char1)
+IOPARM (open,    action,	1 << 14, char2)
+IOPARM (open,    delim,		1 << 15, char1)
+IOPARM (open,    pad,		1 << 16, char2)
+IOPARM (close,   common,	0,	 common)
+IOPARM (close,   status,	1 << 7,  char1)
+IOPARM (filepos, common,	0,	 common)
+IOPARM (inquire, common,	0,	 common)
+IOPARM (inquire, exist,		1 << 7,  pint4)
+IOPARM (inquire, opened,	1 << 8,  pint4)
+IOPARM (inquire, number,	1 << 9,  pint4)
+IOPARM (inquire, named,		1 << 10, pint4)
+IOPARM (inquire, nextrec,	1 << 11, pint4)
+IOPARM (inquire, recl_out,	1 << 12, pint4)
+IOPARM (inquire, file,		1 << 13, char1)
+IOPARM (inquire, access,	1 << 14, char2)
+IOPARM (inquire, form,		1 << 15, char1)
+IOPARM (inquire, blank,		1 << 16, char2)
+IOPARM (inquire, position,	1 << 17, char1)
+IOPARM (inquire, action,	1 << 18, char2)
+IOPARM (inquire, delim,		1 << 19, char1)
+IOPARM (inquire, pad,		1 << 20, char2)
+IOPARM (inquire, name,		1 << 21, char1)
+IOPARM (inquire, sequential,	1 << 22, char2)
+IOPARM (inquire, direct,	1 << 23, char1)
+IOPARM (inquire, formatted,	1 << 24, char2)
+IOPARM (inquire, unformatted,	1 << 25, char1)
+IOPARM (inquire, read,		1 << 26, char2)
+IOPARM (inquire, write,		1 << 27, char1)
+IOPARM (inquire, readwrite,	1 << 28, char2)
+#ifndef IOPARM_dt_list_format
+#define IOPARM_dt_list_format		(1 << 7)
+#define IOPARM_dt_namelist_read_mode	(1 << 8)
+#endif
+IOPARM (dt,      common,	0,	 common)
+IOPARM (dt,      rec,		1 << 9,  int4)
+IOPARM (dt,      size,		1 << 10, pint4)
+IOPARM (dt,      iolength,	1 << 11, pint4)
+IOPARM (dt,      internal_unit_desc, 0,  parray)
+IOPARM (dt,      format,	1 << 12, char1)
+IOPARM (dt,      advance,	1 << 13, char2)
+IOPARM (dt,      internal_unit,	1 << 14, char1)
+IOPARM (dt,      namelist_name,	1 << 15, char2)
+IOPARM (dt,      u,		0,       pad)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index cb9c65bee7b..c543a956369 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3892,6 +3892,9 @@ resolve_blocks (gfc_code * b, gfc_namespace * ns)
 	case EXEC_FORALL:
 	case EXEC_DO:
 	case EXEC_DO_WHILE:
+	case EXEC_READ:
+	case EXEC_WRITE:
+	case EXEC_IOLENGTH:
 	  break;
 
 	default:
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index bdfa450dc2a..720ff5858e0 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -38,351 +38,403 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 
 /* Members of the ioparm structure.  */
 
-static GTY(()) tree ioparm_unit;
-static GTY(()) tree ioparm_err;
-static GTY(()) tree ioparm_end;
-static GTY(()) tree ioparm_eor;
-static GTY(()) tree ioparm_list_format;
-static GTY(()) tree ioparm_library_return;
-static GTY(()) tree ioparm_iostat;
-static GTY(()) tree ioparm_exist;
-static GTY(()) tree ioparm_opened;
-static GTY(()) tree ioparm_number;
-static GTY(()) tree ioparm_named;
-static GTY(()) tree ioparm_rec;
-static GTY(()) tree ioparm_nextrec;
-static GTY(()) tree ioparm_size;
-static GTY(()) tree ioparm_recl_in;
-static GTY(()) tree ioparm_recl_out;
-static GTY(()) tree ioparm_iolength;
-static GTY(()) tree ioparm_file;
-static GTY(()) tree ioparm_file_len;
-static GTY(()) tree ioparm_status;
-static GTY(()) tree ioparm_status_len;
-static GTY(()) tree ioparm_access;
-static GTY(()) tree ioparm_access_len;
-static GTY(()) tree ioparm_form;
-static GTY(()) tree ioparm_form_len;
-static GTY(()) tree ioparm_blank;
-static GTY(()) tree ioparm_blank_len;
-static GTY(()) tree ioparm_position;
-static GTY(()) tree ioparm_position_len;
-static GTY(()) tree ioparm_action;
-static GTY(()) tree ioparm_action_len;
-static GTY(()) tree ioparm_delim;
-static GTY(()) tree ioparm_delim_len;
-static GTY(()) tree ioparm_pad;
-static GTY(()) tree ioparm_pad_len;
-static GTY(()) tree ioparm_format;
-static GTY(()) tree ioparm_format_len;
-static GTY(()) tree ioparm_advance;
-static GTY(()) tree ioparm_advance_len;
-static GTY(()) tree ioparm_name;
-static GTY(()) tree ioparm_name_len;
-static GTY(()) tree ioparm_internal_unit;
-static GTY(()) tree ioparm_internal_unit_len;
-static GTY(()) tree ioparm_internal_unit_desc;
-static GTY(()) tree ioparm_sequential;
-static GTY(()) tree ioparm_sequential_len;
-static GTY(()) tree ioparm_direct;
-static GTY(()) tree ioparm_direct_len;
-static GTY(()) tree ioparm_formatted;
-static GTY(()) tree ioparm_formatted_len;
-static GTY(()) tree ioparm_unformatted;
-static GTY(()) tree ioparm_unformatted_len;
-static GTY(()) tree ioparm_read;
-static GTY(()) tree ioparm_read_len;
-static GTY(()) tree ioparm_write;
-static GTY(()) tree ioparm_write_len;
-static GTY(()) tree ioparm_readwrite;
-static GTY(()) tree ioparm_readwrite_len;
-static GTY(()) tree ioparm_namelist_name;
-static GTY(()) tree ioparm_namelist_name_len;
-static GTY(()) tree ioparm_namelist_read_mode;
-static GTY(()) tree ioparm_iomsg;
-static GTY(()) tree ioparm_iomsg_len;
-
-/* The global I/O variables */
-
-static GTY(()) tree ioparm_var;
-static GTY(()) tree locus_file;
-static GTY(()) tree locus_line;
+enum ioparam_type
+{
+  IOPARM_ptype_common,
+  IOPARM_ptype_open,
+  IOPARM_ptype_close,
+  IOPARM_ptype_filepos,
+  IOPARM_ptype_inquire,
+  IOPARM_ptype_dt,
+  IOPARM_ptype_num
+};
+
+enum iofield_type
+{
+  IOPARM_type_int4,
+  IOPARM_type_pint4,
+  IOPARM_type_pchar,
+  IOPARM_type_parray,
+  IOPARM_type_pad,
+  IOPARM_type_char1,
+  IOPARM_type_char2,
+  IOPARM_type_common,
+  IOPARM_type_num
+};
+
+typedef struct gfc_st_parameter_field GTY(())
+{
+  const char *name;
+  unsigned int mask;
+  enum ioparam_type param_type;
+  enum iofield_type type;
+  tree field;
+  tree field_len;
+}
+gfc_st_parameter_field;
 
+typedef struct gfc_st_parameter GTY(())
+{
+  const char *name;
+  tree type;
+}
+gfc_st_parameter;
+
+enum iofield
+{
+#define IOPARM(param_type, name, mask, type) IOPARM_##param_type##_##name,
+#include "ioparm.def"
+#undef IOPARM
+  IOPARM_field_num
+};
+
+static GTY(()) gfc_st_parameter st_parameter[] =
+{
+  { "common", NULL },
+  { "open", NULL },
+  { "close", NULL },
+  { "filepos", NULL },
+  { "inquire", NULL },
+  { "dt", NULL }
+};
+
+static GTY(()) gfc_st_parameter_field st_parameter_field[] =
+{
+#define IOPARM(param_type, name, mask, type) \
+  { #name, mask, IOPARM_ptype_##param_type, IOPARM_type_##type, NULL, NULL },
+#include "ioparm.def"
+#undef IOPARM
+  { NULL, 0, 0, 0, NULL, NULL }
+};
 
 /* Library I/O subroutines */
 
-static GTY(()) tree iocall_read;
-static GTY(()) tree iocall_read_done;
-static GTY(()) tree iocall_write;
-static GTY(()) tree iocall_write_done;
-static GTY(()) tree iocall_x_integer;
-static GTY(()) tree iocall_x_logical;
-static GTY(()) tree iocall_x_character;
-static GTY(()) tree iocall_x_real;
-static GTY(()) tree iocall_x_complex;
-static GTY(()) tree iocall_x_array;
-static GTY(()) tree iocall_open;
-static GTY(()) tree iocall_close;
-static GTY(()) tree iocall_inquire;
-static GTY(()) tree iocall_iolength;
-static GTY(()) tree iocall_iolength_done;
-static GTY(()) tree iocall_rewind;
-static GTY(()) tree iocall_backspace;
-static GTY(()) tree iocall_endfile;
-static GTY(()) tree iocall_flush;
-static GTY(()) tree iocall_set_nml_val;
-static GTY(()) tree iocall_set_nml_val_dim;
+enum iocall
+{
+  IOCALL_READ,
+  IOCALL_READ_DONE,
+  IOCALL_WRITE,
+  IOCALL_WRITE_DONE,
+  IOCALL_X_INTEGER,
+  IOCALL_X_LOGICAL,
+  IOCALL_X_CHARACTER,
+  IOCALL_X_REAL,
+  IOCALL_X_COMPLEX,
+  IOCALL_X_ARRAY,
+  IOCALL_OPEN,
+  IOCALL_CLOSE,
+  IOCALL_INQUIRE,
+  IOCALL_IOLENGTH,
+  IOCALL_IOLENGTH_DONE,
+  IOCALL_REWIND,
+  IOCALL_BACKSPACE,
+  IOCALL_ENDFILE,
+  IOCALL_FLUSH,
+  IOCALL_SET_NML_VAL,
+  IOCALL_SET_NML_VAL_DIM,
+  IOCALL_NUM
+};
+
+static GTY(()) tree iocall[IOCALL_NUM];
 
 /* Variable for keeping track of what the last data transfer statement
    was.  Used for deciding which subroutine to call when the data
    transfer is complete.  */
 static enum { READ, WRITE, IOLENGTH } last_dt;
 
-#define ADD_FIELD(name, type)						\
-  ioparm_ ## name = gfc_add_field_to_struct				\
-        (&(TYPE_FIELDS (ioparm_type)), ioparm_type,			\
-	 get_identifier (stringize(name)), type)
+/* The data transfer parameter block that should be shared by all
+   data transfer calls belonging to the same read/write/iolength.  */
+static GTY(()) tree dt_parm;
+static stmtblock_t *dt_post_end_block;
 
-#define ADD_STRING(name) \
-  ioparm_ ## name = gfc_add_field_to_struct				\
-        (&(TYPE_FIELDS (ioparm_type)), ioparm_type,			\
-	 get_identifier (stringize(name)), pchar_type_node);		\
-  ioparm_ ## name ## _len = gfc_add_field_to_struct			\
-        (&(TYPE_FIELDS (ioparm_type)), ioparm_type,			\
-	 get_identifier (stringize(name) "_len"), gfc_charlen_type_node)
+static void
+gfc_build_st_parameter (enum ioparam_type ptype, tree *types)
+{
+  enum iofield type;
+  gfc_st_parameter_field *p;
+  char name[64];
+  size_t len;
+  tree t = make_node (RECORD_TYPE);
+
+  len = strlen (st_parameter[ptype].name);
+  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);
+  TYPE_NAME (t) = get_identifier (name);
+
+  for (type = 0, p = st_parameter_field; type < IOPARM_field_num; type++, p++)
+    if (p->param_type == ptype)
+      switch (p->type)
+	{
+	case IOPARM_type_int4:
+	case IOPARM_type_pint4:
+	case IOPARM_type_parray:
+	case IOPARM_type_pchar:
+	case IOPARM_type_pad:
+	  p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t,
+					      get_identifier (p->name),
+					      types[p->type]);
+	  break;
+	case IOPARM_type_char1:
+	  p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t,
+					      get_identifier (p->name),
+					      pchar_type_node);
+	  /* FALLTHROUGH */
+	case IOPARM_type_char2:
+	  len = strlen (p->name);
+	  gcc_assert (len <= sizeof (name) - sizeof ("_len"));
+	  memcpy (name, p->name, len);
+	  memcpy (name + len, "_len", sizeof ("_len"));
+	  p->field_len = gfc_add_field_to_struct (&TYPE_FIELDS (t), t,
+						  get_identifier (name),
+						  gfc_charlen_type_node);
+	  if (p->type == IOPARM_type_char2)
+	    p->field = gfc_add_field_to_struct (&TYPE_FIELDS (t), t,
+						get_identifier (p->name),
+						pchar_type_node);
+	  break;
+	case IOPARM_type_common:
+	  p->field
+	    = gfc_add_field_to_struct (&TYPE_FIELDS (t), t,
+				       get_identifier (p->name),
+				       st_parameter[IOPARM_ptype_common].type);
+	  break;
+	case IOPARM_type_num:
+	  gcc_unreachable ();
+	}
 
+  gfc_finish_type (t);
+  st_parameter[ptype].type = t;
+}
 
 /* Create function decls for IO library functions.  */
 
 void
 gfc_build_io_library_fndecls (void)
 {
-  tree gfc_int4_type_node;
-  tree gfc_pint4_type_node;
+  tree types[IOPARM_type_num], pad_idx, gfc_int4_type_node;
+  tree parm_type, dt_parm_type;
   tree gfc_c_int_type_node;
-  tree ioparm_type;
-
-  gfc_int4_type_node = gfc_get_int_type (4);
-  gfc_pint4_type_node = build_pointer_type (gfc_int4_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_pint4] = build_pointer_type (gfc_int4_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);
   gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
 
-  /* Build the st_parameter structure.  Information associated with I/O
-     calls are transferred here.  This must match the one defined in the
-     library exactly.  */
-
-  ioparm_type = make_node (RECORD_TYPE);
-  TYPE_NAME (ioparm_type) = get_identifier ("_gfc_ioparm");
-
-  ADD_FIELD (unit, gfc_int4_type_node);
-  ADD_FIELD (err, gfc_int4_type_node);
-  ADD_FIELD (end, gfc_int4_type_node);
-  ADD_FIELD (eor, gfc_int4_type_node);
-  ADD_FIELD (list_format, gfc_int4_type_node);
-  ADD_FIELD (library_return, gfc_int4_type_node);
-
-  ADD_FIELD (iostat, gfc_pint4_type_node);
-  ADD_FIELD (exist, gfc_pint4_type_node);
-  ADD_FIELD (opened, gfc_pint4_type_node);
-  ADD_FIELD (number, gfc_pint4_type_node);
-  ADD_FIELD (named, gfc_pint4_type_node);
-  ADD_FIELD (rec, gfc_int4_type_node);
-  ADD_FIELD (nextrec, gfc_pint4_type_node);
-  ADD_FIELD (size, gfc_pint4_type_node);
-
-  ADD_FIELD (recl_in, gfc_int4_type_node);
-  ADD_FIELD (recl_out, gfc_pint4_type_node);
-
-  ADD_FIELD (iolength, gfc_pint4_type_node);
-
-  ADD_STRING (file);
-  ADD_STRING (status);
-
-  ADD_STRING (access);
-  ADD_STRING (form);
-  ADD_STRING (blank);
-  ADD_STRING (position);
-  ADD_STRING (action);
-  ADD_STRING (delim);
-  ADD_STRING (pad);
-  ADD_STRING (format);
-  ADD_STRING (advance);
-  ADD_STRING (name);
-  ADD_STRING (internal_unit);
-  ADD_FIELD (internal_unit_desc, pchar_type_node);
-  ADD_STRING (sequential);
-
-  ADD_STRING (direct);
-  ADD_STRING (formatted);
-  ADD_STRING (unformatted);
-  ADD_STRING (read);
-  ADD_STRING (write);
-  ADD_STRING (readwrite);
-
-  ADD_STRING (namelist_name);
-  ADD_FIELD (namelist_read_mode, gfc_int4_type_node);
-  ADD_STRING (iomsg);
-
-  gfc_finish_type (ioparm_type);
-
-  ioparm_var = build_decl (VAR_DECL, get_identifier (PREFIX("ioparm")),
-			   ioparm_type);
-  DECL_EXTERNAL (ioparm_var) = 1;
-  TREE_PUBLIC (ioparm_var) = 1;
-
-  locus_line = build_decl (VAR_DECL, get_identifier (PREFIX("line")),
-			   gfc_int4_type_node);
-  DECL_EXTERNAL (locus_line) = 1;
-  TREE_PUBLIC (locus_line) = 1;
-
-  locus_file = build_decl (VAR_DECL, get_identifier (PREFIX("filename")),
-			   pchar_type_node);
-  DECL_EXTERNAL (locus_file) = 1;
-  TREE_PUBLIC (locus_file) = 1;
+  for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++)
+    gfc_build_st_parameter (ptype, types);
 
   /* Define the transfer functions.  */
 
-  iocall_x_integer =
+  dt_parm_type = build_pointer_type (st_parameter[IOPARM_ptype_dt].type);
+
+  iocall[IOCALL_X_INTEGER] =
     gfc_build_library_function_decl (get_identifier
 				     (PREFIX("transfer_integer")),
-				     void_type_node, 2, pvoid_type_node,
-				     gfc_int4_type_node);
+				     void_type_node, 3, dt_parm_type,
+				     pvoid_type_node, gfc_int4_type_node);
 
-  iocall_x_logical =
+  iocall[IOCALL_X_LOGICAL] =
     gfc_build_library_function_decl (get_identifier
 				     (PREFIX("transfer_logical")),
-				     void_type_node, 2, pvoid_type_node,
-				     gfc_int4_type_node);
+				     void_type_node, 3, dt_parm_type,
+				     pvoid_type_node, gfc_int4_type_node);
 
-  iocall_x_character =
+  iocall[IOCALL_X_CHARACTER] =
     gfc_build_library_function_decl (get_identifier
 				     (PREFIX("transfer_character")),
-				     void_type_node, 2, pvoid_type_node,
-				     gfc_int4_type_node);
+				     void_type_node, 3, dt_parm_type,
+				     pvoid_type_node, gfc_int4_type_node);
 
-  iocall_x_real =
+  iocall[IOCALL_X_REAL] =
     gfc_build_library_function_decl (get_identifier (PREFIX("transfer_real")),
-				     void_type_node, 2,
+				     void_type_node, 3, dt_parm_type,
 				     pvoid_type_node, gfc_int4_type_node);
 
-  iocall_x_complex =
+  iocall[IOCALL_X_COMPLEX] =
     gfc_build_library_function_decl (get_identifier
 				     (PREFIX("transfer_complex")),
-				     void_type_node, 2, pvoid_type_node,
-				     gfc_int4_type_node);
+				     void_type_node, 3, dt_parm_type,
+				     pvoid_type_node, gfc_int4_type_node);
 
-  iocall_x_array =
+  iocall[IOCALL_X_ARRAY] =
     gfc_build_library_function_decl (get_identifier
 				     (PREFIX("transfer_array")),
-				     void_type_node, 3, pvoid_type_node,
-				     gfc_c_int_type_node,
+				     void_type_node, 4, dt_parm_type,
+				     pvoid_type_node, gfc_c_int_type_node,
 				     gfc_charlen_type_node);
 
   /* Library entry points */
 
-  iocall_read =
+  iocall[IOCALL_READ] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_read")),
-				     void_type_node, 0);
+				     void_type_node, 1, dt_parm_type);
 
-  iocall_write =
+  iocall[IOCALL_WRITE] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_write")),
-				     void_type_node, 0);
-  iocall_open =
+				     void_type_node, 1, dt_parm_type);
+
+  parm_type = build_pointer_type (st_parameter[IOPARM_ptype_open].type);
+  iocall[IOCALL_OPEN] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_open")),
-				     void_type_node, 0);
+				     void_type_node, 1, parm_type);
+
 
-  iocall_close =
+  parm_type = build_pointer_type (st_parameter[IOPARM_ptype_close].type);
+  iocall[IOCALL_CLOSE] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_close")),
-				     void_type_node, 0);
+				     void_type_node, 1, parm_type);
 
-  iocall_inquire =
+  parm_type = build_pointer_type (st_parameter[IOPARM_ptype_inquire].type);
+  iocall[IOCALL_INQUIRE] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_inquire")),
-				     gfc_int4_type_node, 0);
+				     gfc_int4_type_node, 1, parm_type);
 
-  iocall_iolength =
+  iocall[IOCALL_IOLENGTH] =
     gfc_build_library_function_decl(get_identifier (PREFIX("st_iolength")),
-				    void_type_node, 0);
+				    void_type_node, 1, dt_parm_type);
 
-  iocall_rewind =
+  parm_type = build_pointer_type (st_parameter[IOPARM_ptype_filepos].type);
+  iocall[IOCALL_REWIND] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_rewind")),
-				     gfc_int4_type_node, 0);
+				     gfc_int4_type_node, 1, parm_type);
 
-  iocall_backspace =
+  iocall[IOCALL_BACKSPACE] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_backspace")),
-				     gfc_int4_type_node, 0);
+				     gfc_int4_type_node, 1, parm_type);
 
-  iocall_endfile =
+  iocall[IOCALL_ENDFILE] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_endfile")),
-				     gfc_int4_type_node, 0);
+				     gfc_int4_type_node, 1, parm_type);
 
-  iocall_flush =
+  iocall[IOCALL_FLUSH] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_flush")),
-				     gfc_int4_type_node, 0);
+				     gfc_int4_type_node, 1, parm_type);
 
   /* Library helpers */
 
-  iocall_read_done =
+  iocall[IOCALL_READ_DONE] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_read_done")),
-				     gfc_int4_type_node, 0);
+				     gfc_int4_type_node, 1, dt_parm_type);
 
-  iocall_write_done =
+  iocall[IOCALL_WRITE_DONE] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_write_done")),
-				     gfc_int4_type_node, 0);
+				     gfc_int4_type_node, 1, dt_parm_type);
 
-  iocall_iolength_done =
+  iocall[IOCALL_IOLENGTH_DONE] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_iolength_done")),
-				     gfc_int4_type_node, 0);
+				     gfc_int4_type_node, 1, dt_parm_type);
 
 
-  iocall_set_nml_val =
+  iocall[IOCALL_SET_NML_VAL] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var")),
-                                     void_type_node, 5,
-                                     pvoid_type_node, pvoid_type_node,
-                                     gfc_int4_type_node, gfc_charlen_type_node, 
+				     void_type_node, 6, dt_parm_type,
+				     pvoid_type_node, pvoid_type_node,
+				     gfc_int4_type_node, gfc_charlen_type_node,
 				     gfc_int4_type_node);
 
-  iocall_set_nml_val_dim =
+  iocall[IOCALL_SET_NML_VAL_DIM] =
     gfc_build_library_function_decl (get_identifier (PREFIX("st_set_nml_var_dim")),
-				     void_type_node, 4,
+				     void_type_node, 5, dt_parm_type,
 				     gfc_int4_type_node, gfc_int4_type_node,
 				     gfc_int4_type_node, gfc_int4_type_node);
 }
 
 
+/* Generate code to store an integer constant into the
+   st_parameter_XXX structure.  */
+
+static unsigned int
+set_parameter_const (stmtblock_t *block, tree var, enum iofield type,
+		     unsigned int val)
+{
+  tree tmp;
+  gfc_st_parameter_field *p = &st_parameter_field[type];
+
+  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, build_int_cst (TREE_TYPE (p->field), val));
+  return p->mask;
+}
+
+
 /* Generate code to store a non-string I/O parameter into the
-   ioparm structure.  This is a pass by value.  */
+   st_parameter_XXX structure.  This is a pass by value.  */
 
-static void
-set_parameter_value (stmtblock_t * block, tree var, gfc_expr * e)
+static unsigned int
+set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
+		     gfc_expr *e)
 {
   gfc_se se;
   tree tmp;
+  gfc_st_parameter_field *p = &st_parameter_field[type];
 
   gfc_init_se (&se, NULL);
-  gfc_conv_expr_type (&se, e, TREE_TYPE (var));
+  gfc_conv_expr_type (&se, e, TREE_TYPE (p->field));
   gfc_add_block_to_block (block, &se.pre);
 
-  tmp = build3 (COMPONENT_REF, TREE_TYPE (var), ioparm_var, var, NULL_TREE);
+  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, se.expr);
+  return p->mask;
 }
 
 
 /* Generate code to store a non-string I/O parameter into the
-   ioparm structure.  This is pass by reference.  */
+   st_parameter_XXX structure.  This is pass by reference.  */
 
-static void
-set_parameter_ref (stmtblock_t * block, tree var, gfc_expr * e)
+static unsigned int
+set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock,
+		   tree var, enum iofield type, gfc_expr *e)
 {
   gfc_se se;
-  tree tmp;
+  tree tmp, addr;
+  gfc_st_parameter_field *p = &st_parameter_field[type];
 
+  gcc_assert (e->ts.type == BT_INTEGER || e->ts.type == BT_LOGICAL);
   gfc_init_se (&se, NULL);
-  se.want_pointer = 1;
+  gfc_conv_expr_lhs (&se, e);
 
-  gfc_conv_expr_type (&se, e, TREE_TYPE (var));
   gfc_add_block_to_block (block, &se.pre);
 
-  tmp = build3 (COMPONENT_REF, TREE_TYPE (var), ioparm_var, var, NULL_TREE);
-  gfc_add_modify_expr (block, tmp, se.expr);
+  if (TYPE_MODE (TREE_TYPE (se.expr))
+      == TYPE_MODE (TREE_TYPE (TREE_TYPE (p->field))))
+    addr = convert (TREE_TYPE (p->field),
+		    gfc_build_addr_expr (NULL, se.expr));
+  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);
+      addr = gfc_build_addr_expr (NULL, tmpvar);
+      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
@@ -450,22 +502,27 @@ gfc_convert_array_to_string (gfc_se * se, gfc_expr * e)
 
 
 /* Generate code to store a string and its length into the
-   ioparm structure.  */
+   st_parameter_XXX structure.  */
 
-static void
+static unsigned int
 set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
-	    tree var_len, gfc_expr * e)
+	    enum iofield type, gfc_expr * e)
 {
   gfc_se se;
   tree tmp;
   tree msg;
   tree io;
   tree len;
+  gfc_st_parameter_field *p = &st_parameter_field[type];
 
   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,
+  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);
+  io = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field,
+	       NULL_TREE);
+  len = build3 (COMPONENT_REF, TREE_TYPE (p->field_len), var, p->field_len,
 		NULL_TREE);
 
   /* Integer variable assigned a format label.  */
@@ -500,28 +557,34 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
 
   gfc_add_block_to_block (block, &se.pre);
   gfc_add_block_to_block (postblock, &se.post);
+  return p->mask;
 }
 
 
 /* Generate code to store the character (array) and the character length
    for an internal unit.  */
 
-static void
-set_internal_unit (stmtblock_t * block, tree iunit, tree iunit_len,
-		   tree iunit_desc, gfc_expr * e)
+static unsigned int
+set_internal_unit (stmtblock_t * block, tree var, gfc_expr * e)
 {
   gfc_se se;
   tree io;
   tree len;
   tree desc;
   tree tmp;
+  gfc_st_parameter_field *p;
+  unsigned int mask;
 
   gfc_init_se (&se, NULL);
 
-  io = build3 (COMPONENT_REF, TREE_TYPE (iunit), ioparm_var, iunit, NULL_TREE);
-  len = build3 (COMPONENT_REF, TREE_TYPE (iunit_len), ioparm_var, iunit_len,
+  p = &st_parameter_field[IOPARM_dt_internal_unit];
+  mask = p->mask;
+  io = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field,
+	       NULL_TREE);
+  len = build3 (COMPONENT_REF, TREE_TYPE (p->field_len), var, p->field_len,
 		NULL_TREE);
-  desc = build3 (COMPONENT_REF, TREE_TYPE (iunit_desc), ioparm_var, iunit_desc,
+  p = &st_parameter_field[IOPARM_dt_internal_unit_desc];
+  desc = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field,
 		 NULL_TREE);
 
   gcc_assert (e->ts.type == BT_CHARACTER);
@@ -555,19 +618,9 @@ set_internal_unit (stmtblock_t * block, tree iunit, tree iunit_len,
   gfc_add_modify_expr (&se.pre, desc, se.expr);
 
   gfc_add_block_to_block (block, &se.pre);
+  return mask;
 }
 
-/* Set a member of the ioparm structure to one.  */
-static void
-set_flag (stmtblock_t *block, tree var)
-{
-  tree tmp, type = TREE_TYPE (var);
-
-  tmp = build3 (COMPONENT_REF, type, ioparm_var, var, NULL_TREE);
-  gfc_add_modify_expr (block, tmp, convert (type, integer_one_node));
-}
-
-
 /* Add a case to a IO-result switch.  */
 
 static void
@@ -600,11 +653,12 @@ add_case (int label_value, gfc_st_label * label, stmtblock_t * body)
    be created anyway.  */
 
 static void
-io_result (stmtblock_t * block, gfc_st_label * err_label,
+io_result (stmtblock_t * block, tree var, gfc_st_label * err_label,
 	   gfc_st_label * end_label, gfc_st_label * eor_label)
 {
   stmtblock_t body;
   tree tmp, rc;
+  gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_flags];
 
   /* If no labels are specified, ignore the result instead
      of building an empty switch.  */
@@ -624,8 +678,12 @@ io_result (stmtblock_t * block, gfc_st_label * err_label,
 
   tmp = gfc_finish_block (&body);
 
-  rc = build3 (COMPONENT_REF, TREE_TYPE (ioparm_library_return), ioparm_var,
-	       ioparm_library_return, NULL_TREE);
+  var = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
+		var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  rc = build3 (COMPONENT_REF, TREE_TYPE (p->field), var, p->field,
+	       NULL_TREE);
+  rc = build2 (BIT_AND_EXPR, TREE_TYPE (rc), rc,
+	       build_int_cst (TREE_TYPE (rc), IOPARM_common_libreturn_mask));
 
   tmp = build3_v (SWITCH_EXPR, rc, tmp, NULL_TREE);
 
@@ -637,24 +695,29 @@ io_result (stmtblock_t * block, gfc_st_label * err_label,
    library call goes awry, we can tell the user where the problem is.  */
 
 static void
-set_error_locus (stmtblock_t * block, locus * where)
+set_error_locus (stmtblock_t * block, tree var, locus * where)
 {
   gfc_file *f;
-  tree tmp;
+  tree str, locus_file;
   int line;
+  gfc_st_parameter_field *p = &st_parameter_field[IOPARM_common_filename];
 
+  locus_file = build3 (COMPONENT_REF, st_parameter[IOPARM_ptype_common].type,
+		       var, TYPE_FIELDS (TREE_TYPE (var)), NULL_TREE);
+  locus_file = build3 (COMPONENT_REF, TREE_TYPE (p->field), locus_file,
+		       p->field, NULL_TREE);
   f = where->lb->file;
-  tmp = gfc_build_cstring_const (f->filename);
+  str = gfc_build_cstring_const (f->filename);
 
-  tmp = gfc_build_addr_expr (pchar_type_node, tmp);
-  gfc_add_modify_expr (block, locus_file, tmp);
+  str = gfc_build_addr_expr (pchar_type_node, str);
+  gfc_add_modify_expr (block, locus_file, str);
 
 #ifdef USE_MAPPED_LOCATION
   line = LOCATION_LINE (where->lb->location);
 #else
   line = where->lb->linenum;
 #endif
-  gfc_add_modify_expr (block, locus_line, build_int_cst (NULL_TREE, line));
+  set_parameter_const (block, var, IOPARM_common_line, line);
 }
 
 
@@ -665,69 +728,79 @@ gfc_trans_open (gfc_code * code)
 {
   stmtblock_t block, post_block;
   gfc_open *p;
-  tree tmp;
+  tree tmp, var;
+  unsigned int mask = 0;
 
-  gfc_init_block (&block);
+  gfc_start_block (&block);
   gfc_init_block (&post_block);
 
-  set_error_locus (&block, &code->loc);
+  var = gfc_create_var (st_parameter[IOPARM_ptype_open].type, "open_parm");
+
+  set_error_locus (&block, var, &code->loc);
   p = code->ext.open;
 
   if (p->unit)
-    set_parameter_value (&block, ioparm_unit, p->unit);
+    set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+  else
+    set_parameter_const (&block, var, IOPARM_common_unit, 0);
 
   if (p->file)
-    set_string (&block, &post_block, ioparm_file, ioparm_file_len, p->file);
+    mask |= set_string (&block, &post_block, var, IOPARM_open_file, p->file);
 
   if (p->status)
-    set_string (&block, &post_block, ioparm_status,
-		ioparm_status_len, p->status);
+    mask |= set_string (&block, &post_block, var, IOPARM_open_status,
+			p->status);
 
   if (p->access)
-    set_string (&block, &post_block, ioparm_access,
-		ioparm_access_len, p->access);
+    mask |= set_string (&block, &post_block, var, IOPARM_open_access,
+			p->access);
 
   if (p->form)
-    set_string (&block, &post_block, ioparm_form, ioparm_form_len, p->form);
+    mask |= set_string (&block, &post_block, var, IOPARM_open_form, p->form);
 
   if (p->recl)
-    set_parameter_value (&block, ioparm_recl_in, p->recl);
+    mask |= set_parameter_value (&block, var, IOPARM_open_recl_in, p->recl);
 
   if (p->blank)
-    set_string (&block, &post_block, ioparm_blank, ioparm_blank_len,
-		p->blank);
+    mask |= set_string (&block, &post_block, var, IOPARM_open_blank,
+			p->blank);
 
   if (p->position)
-    set_string (&block, &post_block, ioparm_position,
-		ioparm_position_len, p->position);
+    mask |= set_string (&block, &post_block, var, IOPARM_open_position,
+			p->position);
 
   if (p->action)
-    set_string (&block, &post_block, ioparm_action,
-		ioparm_action_len, p->action);
+    mask |= set_string (&block, &post_block, var, IOPARM_open_action,
+			p->action);
 
   if (p->delim)
-    set_string (&block, &post_block, ioparm_delim, ioparm_delim_len,
-		p->delim);
+    mask |= set_string (&block, &post_block, var, IOPARM_open_delim,
+			p->delim);
 
   if (p->pad)
-    set_string (&block, &post_block, ioparm_pad, ioparm_pad_len, p->pad);
+    mask |= set_string (&block, &post_block, var, IOPARM_open_pad, p->pad);
 
   if (p->iomsg)
-    set_string (&block, &post_block, ioparm_iomsg, ioparm_iomsg_len,
-		p->iomsg);
+    mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			p->iomsg);
 
   if (p->iostat)
-    set_parameter_ref (&block, ioparm_iostat, p->iostat);
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat,
+			       p->iostat);
 
   if (p->err)
-    set_flag (&block, ioparm_err);
+    mask |= IOPARM_common_err;
+
+  set_parameter_const (&block, var, IOPARM_common_flags, mask);
 
-  tmp = gfc_build_function_call (iocall_open, NULL_TREE);
+  tmp = gfc_build_addr_expr (NULL_TREE, var);
+  tmp = gfc_chainon_list (NULL_TREE, tmp);
+  tmp = gfc_build_function_call (iocall[IOCALL_OPEN], tmp);
   gfc_add_expr_to_block (&block, tmp);
 
   gfc_add_block_to_block (&block, &post_block);
 
-  io_result (&block, p->err, NULL, NULL);
+  io_result (&block, var, p->err, NULL, NULL);
 
   return gfc_finish_block (&block);
 }
@@ -740,37 +813,47 @@ gfc_trans_close (gfc_code * code)
 {
   stmtblock_t block, post_block;
   gfc_close *p;
-  tree tmp;
+  tree tmp, var;
+  unsigned int mask = 0;
 
-  gfc_init_block (&block);
+  gfc_start_block (&block);
   gfc_init_block (&post_block);
 
-  set_error_locus (&block, &code->loc);
+  var = gfc_create_var (st_parameter[IOPARM_ptype_close].type, "close_parm");
+
+  set_error_locus (&block, var, &code->loc);
   p = code->ext.close;
 
   if (p->unit)
-    set_parameter_value (&block, ioparm_unit, p->unit);
+    set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+  else
+    set_parameter_const (&block, var, IOPARM_common_unit, 0);
 
   if (p->status)
-    set_string (&block, &post_block, ioparm_status,
-		ioparm_status_len, p->status);
+    mask |= set_string (&block, &post_block, var, IOPARM_close_status,
+			p->status);
 
   if (p->iomsg)
-    set_string (&block, &post_block, ioparm_iomsg, ioparm_iomsg_len,
-		p->iomsg);
+    mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			p->iomsg);
 
   if (p->iostat)
-    set_parameter_ref (&block, ioparm_iostat, p->iostat);
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat,
+			       p->iostat);
 
   if (p->err)
-    set_flag (&block, ioparm_err);
+    mask |= IOPARM_common_err;
 
-  tmp = gfc_build_function_call (iocall_close, NULL_TREE);
+  set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+  tmp = gfc_build_addr_expr (NULL_TREE, var);
+  tmp = gfc_chainon_list (NULL_TREE, tmp);
+  tmp = gfc_build_function_call (iocall[IOCALL_CLOSE], tmp);
   gfc_add_expr_to_block (&block, tmp);
 
   gfc_add_block_to_block (&block, &post_block);
 
-  io_result (&block, p->err, NULL, NULL);
+  io_result (&block, var, p->err, NULL, NULL);
 
   return gfc_finish_block (&block);
 }
@@ -783,34 +866,45 @@ build_filepos (tree function, gfc_code * code)
 {
   stmtblock_t block, post_block;
   gfc_filepos *p;
-  tree tmp;
+  tree tmp, var;
+  unsigned int mask = 0;
 
   p = code->ext.filepos;
 
-  gfc_init_block (&block);
+  gfc_start_block (&block);
   gfc_init_block (&post_block);
 
-  set_error_locus (&block, &code->loc);
+  var = gfc_create_var (st_parameter[IOPARM_ptype_filepos].type,
+			"filepos_parm");
+
+  set_error_locus (&block, var, &code->loc);
 
   if (p->unit)
-    set_parameter_value (&block, ioparm_unit, p->unit);
+    set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+  else
+    set_parameter_const (&block, var, IOPARM_common_unit, 0);
 
   if (p->iomsg)
-    set_string (&block, &post_block, ioparm_iomsg, ioparm_iomsg_len,
-		p->iomsg);
+    mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			p->iomsg);
 
   if (p->iostat)
-    set_parameter_ref (&block, ioparm_iostat, p->iostat);
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat,
+			       p->iostat);
 
   if (p->err)
-    set_flag (&block, ioparm_err);
+    mask |= IOPARM_common_err;
 
-  tmp = gfc_build_function_call (function, NULL);
+  set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+  tmp = gfc_build_addr_expr (NULL_TREE, var);
+  tmp = gfc_chainon_list (NULL_TREE, tmp);
+  tmp = gfc_build_function_call (function, tmp);
   gfc_add_expr_to_block (&block, tmp);
 
   gfc_add_block_to_block (&block, &post_block);
 
-  io_result (&block, p->err, NULL, NULL);
+  io_result (&block, var, p->err, NULL, NULL);
 
   return gfc_finish_block (&block);
 }
@@ -821,8 +915,7 @@ build_filepos (tree function, gfc_code * code)
 tree
 gfc_trans_backspace (gfc_code * code)
 {
-
-  return build_filepos (iocall_backspace, code);
+  return build_filepos (iocall[IOCALL_BACKSPACE], code);
 }
 
 
@@ -831,8 +924,7 @@ gfc_trans_backspace (gfc_code * code)
 tree
 gfc_trans_endfile (gfc_code * code)
 {
-
-  return build_filepos (iocall_endfile, code);
+  return build_filepos (iocall[IOCALL_ENDFILE], code);
 }
 
 
@@ -841,8 +933,7 @@ gfc_trans_endfile (gfc_code * code)
 tree
 gfc_trans_rewind (gfc_code * code)
 {
-
-  return build_filepos (iocall_rewind, code);
+  return build_filepos (iocall[IOCALL_REWIND], code);
 }
 
 
@@ -851,8 +942,7 @@ gfc_trans_rewind (gfc_code * code)
 tree
 gfc_trans_flush (gfc_code * code)
 {
-
-  return build_filepos (iocall_flush, code);
+  return build_filepos (iocall[IOCALL_FLUSH], code);
 }
 
 
@@ -863,12 +953,16 @@ gfc_trans_inquire (gfc_code * code)
 {
   stmtblock_t block, post_block;
   gfc_inquire *p;
-  tree tmp;
+  tree tmp, var;
+  unsigned int mask = 0;
 
-  gfc_init_block (&block);
+  gfc_start_block (&block);
   gfc_init_block (&post_block);
 
-  set_error_locus (&block, &code->loc);
+  var = gfc_create_var (st_parameter[IOPARM_ptype_inquire].type,
+			"inquire_parm");
+
+  set_error_locus (&block, var, &code->loc);
   p = code->ext.inquire;
 
   /* Sanity check.  */
@@ -876,102 +970,119 @@ gfc_trans_inquire (gfc_code * code)
     gfc_error ("INQUIRE statement at %L cannot contain both FILE and UNIT specifiers.", &code->loc);
 
   if (p->unit)
-    set_parameter_value (&block, ioparm_unit, p->unit);
+    set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
+  else
+    set_parameter_const (&block, var, IOPARM_common_unit, 0);
 
   if (p->file)
-    set_string (&block, &post_block, ioparm_file, ioparm_file_len, p->file);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_file,
+			p->file);
 
   if (p->iomsg)
-    set_string (&block, &post_block, ioparm_iomsg, ioparm_iomsg_len,
-		p->iomsg);
+    mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			p->iomsg);
 
   if (p->iostat)
-    set_parameter_ref (&block, ioparm_iostat, p->iostat);
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat,
+			       p->iostat);
 
   if (p->exist)
-    set_parameter_ref (&block, ioparm_exist, p->exist);
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_exist,
+			       p->exist);
 
   if (p->opened)
-    set_parameter_ref (&block, ioparm_opened, p->opened);
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_opened,
+			       p->opened);
 
   if (p->number)
-    set_parameter_ref (&block, ioparm_number, p->number);
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_number,
+			       p->number);
 
   if (p->named)
-    set_parameter_ref (&block, ioparm_named, p->named);
+    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_named,
+			       p->named);
 
   if (p->name)
-    set_string (&block, &post_block, ioparm_name, ioparm_name_len, p->name);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_name,
+			p->name);
 
   if (p->access)
-    set_string (&block, &post_block, ioparm_access,
-		ioparm_access_len, p->access);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_access,
+			p->access);
 
   if (p->sequential)
-    set_string (&block, &post_block, ioparm_sequential,
-		ioparm_sequential_len, p->sequential);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_sequential,
+			p->sequential);
 
   if (p->direct)
-    set_string (&block, &post_block, ioparm_direct,
-		ioparm_direct_len, p->direct);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_direct,
+			p->direct);
 
   if (p->form)
-    set_string (&block, &post_block, ioparm_form, ioparm_form_len, p->form);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_form,
+			p->form);
 
   if (p->formatted)
-    set_string (&block, &post_block, ioparm_formatted,
-		ioparm_formatted_len, p->formatted);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_formatted,
+			p->formatted);
 
   if (p->unformatted)
-    set_string (&block, &post_block, ioparm_unformatted,
-		ioparm_unformatted_len, p->unformatted);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_unformatted,
+			p->unformatted);
 
   if (p->recl)
-    set_parameter_ref (&block, ioparm_recl_out, p->recl);
+    mask |= set_parameter_ref (&block, &post_block, var,
+			       IOPARM_inquire_recl_out, p->recl);
 
   if (p->nextrec)
-    set_parameter_ref (&block, ioparm_nextrec, p->nextrec);
+    mask |= set_parameter_ref (&block, &post_block, var,
+			       IOPARM_inquire_nextrec, p->nextrec);
 
   if (p->blank)
-    set_string (&block, &post_block, ioparm_blank, ioparm_blank_len,
-		p->blank);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_blank,
+			p->blank);
 
   if (p->position)
-    set_string (&block, &post_block, ioparm_position,
-		ioparm_position_len, p->position);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_position,
+			p->position);
 
   if (p->action)
-    set_string (&block, &post_block, ioparm_action,
-		ioparm_action_len, p->action);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_action,
+			p->action);
 
   if (p->read)
-    set_string (&block, &post_block, ioparm_read, ioparm_read_len, p->read);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_read,
+			p->read);
 
   if (p->write)
-    set_string (&block, &post_block, ioparm_write,
-		ioparm_write_len, p->write);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_write,
+			p->write);
 
   if (p->readwrite)
-    set_string (&block, &post_block, ioparm_readwrite,
-		ioparm_readwrite_len, p->readwrite);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_readwrite,
+			p->readwrite);
 
   if (p->delim)
-    set_string (&block, &post_block, ioparm_delim, ioparm_delim_len,
-		p->delim);
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_delim,
+			p->delim);
 
   if (p->pad)
-    set_string (&block, &post_block, ioparm_pad, ioparm_pad_len,
-                p->pad); 
+    mask |= set_string (&block, &post_block, var, IOPARM_inquire_pad,
+			p->pad);
 
   if (p->err)
-    set_flag (&block, ioparm_err);
+    mask |= IOPARM_common_err;
 
-  tmp = gfc_build_function_call (iocall_inquire, NULL);
+  set_parameter_const (&block, var, IOPARM_common_flags, mask);
+
+  tmp = gfc_build_addr_expr (NULL_TREE, var);
+  tmp = gfc_chainon_list (NULL_TREE, tmp);
+  tmp = gfc_build_function_call (iocall[IOCALL_INQUIRE], tmp);
   gfc_add_expr_to_block (&block, tmp);
 
   gfc_add_block_to_block (&block, &post_block);
 
-  io_result (&block, p->err, NULL, NULL);
+  io_result (&block, var, p->err, NULL, NULL);
 
   return gfc_finish_block (&block);
 }
@@ -1085,8 +1196,8 @@ nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,
 }
 
 /* For an object VAR_NAME whose base address is BASE_ADDR, generate a
-   call to iocall_set_nml_val.  For derived type variable, recursively
-   generate calls to iocall_set_nml_val for each component.  */
+   call to iocall[IOCALL_SET_NML_VAL].  For derived type variable, recursively
+   generate calls to iocall[IOCALL_SET_NML_VAL] for each component.  */
 
 #define NML_FIRST_ARG(a) args = gfc_chainon_list (NULL_TREE, a)
 #define NML_ADD_ARG(a) args = gfc_chainon_list (args, a)
@@ -1105,6 +1216,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
   tree tmp;
   tree args;
   tree dtype;
+  tree dt_parm_addr;
   int n_dim; 
   int itype;
   int rank = 0;
@@ -1167,7 +1279,9 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
      The call for the scalar part transfers:
      (address, name, type, kind or string_length, dtype)  */
 
-  NML_FIRST_ARG (addr_expr);
+  dt_parm_addr = gfc_build_addr_expr (NULL_TREE, dt_parm);
+  NML_FIRST_ARG (dt_parm_addr);
+  NML_ADD_ARG (addr_expr);
   NML_ADD_ARG (string);
   NML_ADD_ARG (IARG (ts->kind));
 
@@ -1177,7 +1291,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
     NML_ADD_ARG (convert (gfc_charlen_type_node, integer_zero_node));
 
   NML_ADD_ARG (dtype);
-  tmp = gfc_build_function_call (iocall_set_nml_val, args);
+  tmp = gfc_build_function_call (iocall[IOCALL_SET_NML_VAL], args);
   gfc_add_expr_to_block (block, tmp);
 
   /* If the object is an array, transfer rank times:
@@ -1185,11 +1299,12 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
 
   for ( n_dim = 0 ; n_dim < rank ; n_dim++ )
     {
-      NML_FIRST_ARG (IARG (n_dim));
+      NML_FIRST_ARG (dt_parm_addr);
+      NML_ADD_ARG (IARG (n_dim));
       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_set_nml_val_dim, args);
+      tmp = gfc_build_function_call (iocall[IOCALL_SET_NML_VAL_DIM], args);
       gfc_add_expr_to_block (block, tmp);
     }
 
@@ -1221,98 +1336,142 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
    out by now.  */
 
 static tree
-build_dt (tree * function, gfc_code * code)
+build_dt (tree function, gfc_code * code)
 {
-  stmtblock_t block, post_block;
+  stmtblock_t block, post_block, post_end_block;
   gfc_dt *dt;
-  tree tmp;
+  tree tmp, var;
   gfc_expr *nmlname;
   gfc_namelist *nml;
+  unsigned int mask = 0;
 
-  gfc_init_block (&block);
+  gfc_start_block (&block);
   gfc_init_block (&post_block);
+  gfc_init_block (&post_end_block);
+
+  var = gfc_create_var (st_parameter[IOPARM_ptype_dt].type, "dt_parm");
+
+  set_error_locus (&block, var, &code->loc);
+
+  if (last_dt == IOLENGTH)
+    {
+      gfc_inquire *inq;
+
+      inq = code->ext.inquire;
 
-  set_error_locus (&block, &code->loc);
-  dt = code->ext.dt;
+      /* First check that preconditions are met.  */
+      gcc_assert (inq != NULL);
+      gcc_assert (inq->iolength != NULL);
 
-  gcc_assert (dt != NULL);
+      /* Connect to the iolength variable.  */
+      mask |= set_parameter_ref (&block, &post_end_block, var,
+				 IOPARM_dt_iolength, inq->iolength);
+      dt = NULL;
+    }
+  else
+    {
+      dt = code->ext.dt;
+      gcc_assert (dt != NULL);
+    }
 
-  if (dt->io_unit)
+  if (dt && dt->io_unit)
     {
       if (dt->io_unit->ts.type == BT_CHARACTER)
 	{
-	  set_internal_unit (&block,
-			     ioparm_internal_unit,
-			     ioparm_internal_unit_len,
-			     ioparm_internal_unit_desc,
-			     dt->io_unit);
+	  mask |= set_internal_unit (&block, var, dt->io_unit);
+	  set_parameter_const (&block, var, IOPARM_common_unit, 0);
 	}
       else
-	set_parameter_value (&block, ioparm_unit, dt->io_unit);
+	set_parameter_value (&block, var, IOPARM_common_unit, dt->io_unit);
     }
+  else
+    set_parameter_const (&block, var, IOPARM_common_unit, 0);
 
-  if (dt->rec)
-    set_parameter_value (&block, ioparm_rec, dt->rec);
+  if (dt)
+    {
+      if (dt->rec)
+	mask |= set_parameter_value (&block, var, IOPARM_dt_rec, dt->rec);
 
-  if (dt->advance)
-    set_string (&block, &post_block, ioparm_advance, ioparm_advance_len,
-		dt->advance);
+      if (dt->advance)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_advance,
+			    dt->advance);
 
-  if (dt->format_expr)
-    set_string (&block, &post_block, ioparm_format, ioparm_format_len,
-		dt->format_expr);
+      if (dt->format_expr)
+	mask |= set_string (&block, &post_block, var, IOPARM_dt_format,
+			    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->format_label)
+	{
+	  if (dt->format_label == &format_asterisk)
+	    mask |= IOPARM_dt_list_format;
+	  else
+	    mask |= set_string (&block, &post_block, var, IOPARM_dt_format,
+				dt->format_label->format);
+	}
 
-  if (dt->iomsg)
-    set_string (&block, &post_block, ioparm_iomsg, ioparm_iomsg_len,
-		dt->iomsg);
+      if (dt->iomsg)
+	mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
+			    dt->iomsg);
 
-  if (dt->iostat)
-    set_parameter_ref (&block, ioparm_iostat, dt->iostat);
+      if (dt->iostat)
+	mask |= set_parameter_ref (&block, &post_end_block, var,
+				   IOPARM_common_iostat, dt->iostat);
 
-  if (dt->size)
-    set_parameter_ref (&block, ioparm_size, dt->size);
+      if (dt->size)
+	mask |= set_parameter_ref (&block, &post_end_block, var,
+				   IOPARM_dt_size, dt->size);
 
-  if (dt->err)
-    set_flag (&block, ioparm_err);
+      if (dt->err)
+	mask |= IOPARM_common_err;
 
-  if (dt->eor)
-    set_flag(&block, ioparm_eor);
+      if (dt->eor)
+	mask |= IOPARM_common_eor;
 
-  if (dt->end)
-    set_flag(&block, ioparm_end);
+      if (dt->end)
+	mask |= IOPARM_common_end;
 
-  if (dt->namelist)
-    {
-      if (dt->format_expr || dt->format_label)
-        gfc_internal_error ("build_dt: format with namelist");
+      if (dt->namelist)
+	{
+	  if (dt->format_expr || dt->format_label)
+	    gfc_internal_error ("build_dt: format with namelist");
+
+	  nmlname = gfc_new_nml_name_expr (dt->namelist->name);
 
-      nmlname = gfc_new_nml_name_expr(dt->namelist->name);
+	  mask |= set_string (&block, &post_block, var, IOPARM_dt_namelist_name,
+			      nmlname);
 
-      set_string (&block, &post_block, ioparm_namelist_name,
-		  ioparm_namelist_name_len, nmlname);
+	  if (last_dt == READ)
+	    mask |= IOPARM_dt_namelist_read_mode;
 
-      if (last_dt == READ)
-	set_flag (&block, ioparm_namelist_read_mode);
+	  set_parameter_const (&block, var, IOPARM_common_flags, mask);
 
-      for (nml = dt->namelist->namelist; nml; nml = nml->next)
-	transfer_namelist_element (&block, nml->sym->name, nml->sym,
-				   NULL, NULL);
+	  dt_parm = var;
+
+	  for (nml = dt->namelist->namelist; nml; nml = nml->next)
+	    transfer_namelist_element (&block, nml->sym->name, nml->sym,
+				       NULL, NULL);
+	}
+      else
+	set_parameter_const (&block, var, IOPARM_common_flags, mask);
     }
+  else
+    set_parameter_const (&block, var, IOPARM_common_flags, mask);
 
-  tmp = gfc_build_function_call (*function, NULL_TREE);
+  tmp = gfc_build_addr_expr (NULL_TREE, var);
+  tmp = gfc_chainon_list (NULL_TREE, tmp);
+  tmp = gfc_build_function_call (function, tmp);
   gfc_add_expr_to_block (&block, tmp);
 
   gfc_add_block_to_block (&block, &post_block);
 
+  dt_parm = var;
+  dt_post_end_block = &post_end_block;
+
+  gfc_add_expr_to_block (&block, gfc_trans_code (code->block->next));
+
+  dt_parm = NULL;
+  dt_post_end_block = NULL;
+
   return gfc_finish_block (&block);
 }
 
@@ -1324,31 +1483,8 @@ build_dt (tree * function, gfc_code * code)
 tree
 gfc_trans_iolength (gfc_code * code)
 {
-  stmtblock_t block;
-  gfc_inquire *inq;
-  tree dt;
-
-  gfc_init_block (&block);
-
-  set_error_locus (&block, &code->loc);
-
-  inq = code->ext.inquire;
-
-  /* First check that preconditions are met.  */
-  gcc_assert (inq != NULL);
-  gcc_assert (inq->iolength != NULL);
-
-  /* Connect to the iolength variable.  */
-  if (inq->iolength)
-    set_parameter_ref (&block, ioparm_iolength, inq->iolength);
-
-  /* Actual logic.  */
   last_dt = IOLENGTH;
-  dt = build_dt(&iocall_iolength, code);
-
-  gfc_add_expr_to_block (&block, dt);
-
-  return gfc_finish_block (&block);
+  return build_dt (iocall[IOCALL_IOLENGTH], code);
 }
 
 
@@ -1357,9 +1493,8 @@ gfc_trans_iolength (gfc_code * code)
 tree
 gfc_trans_read (gfc_code * code)
 {
-
   last_dt = READ;
-  return build_dt (&iocall_read, code);
+  return build_dt (iocall[IOCALL_READ], code);
 }
 
 
@@ -1368,9 +1503,8 @@ gfc_trans_read (gfc_code * code)
 tree
 gfc_trans_write (gfc_code * code)
 {
-
   last_dt = WRITE;
-  return build_dt (&iocall_write, code);
+  return build_dt (iocall[IOCALL_WRITE], code);
 }
 
 
@@ -1387,28 +1521,32 @@ gfc_trans_dt_end (gfc_code * code)
   switch (last_dt)
     {
     case READ:
-      function = iocall_read_done;
+      function = iocall[IOCALL_READ_DONE];
       break;
 
     case WRITE:
-      function = iocall_write_done;
+      function = iocall[IOCALL_WRITE_DONE];
       break;
 
     case IOLENGTH:
-      function = iocall_iolength_done;
+      function = iocall[IOCALL_IOLENGTH_DONE];
       break;
 
     default:
       gcc_unreachable ();
     }
 
-  tmp = gfc_build_function_call (function, NULL);
+  tmp = gfc_build_addr_expr (NULL_TREE, dt_parm);
+  tmp = gfc_chainon_list (NULL_TREE, tmp);
+  tmp = gfc_build_function_call (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);
 
   if (last_dt != IOLENGTH)
     {
       gcc_assert (code->ext.dt != NULL);
-      io_result (&block, code->ext.dt->err,
+      io_result (&block, dt_parm, code->ext.dt->err,
 		 code->ext.dt->end, code->ext.dt->eor);
     }
 
@@ -1523,22 +1661,22 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr)
     {
     case BT_INTEGER:
       arg2 = build_int_cst (NULL_TREE, kind);
-      function = iocall_x_integer;
+      function = iocall[IOCALL_X_INTEGER];
       break;
 
     case BT_REAL:
       arg2 = build_int_cst (NULL_TREE, kind);
-      function = iocall_x_real;
+      function = iocall[IOCALL_X_REAL];
       break;
 
     case BT_COMPLEX:
       arg2 = build_int_cst (NULL_TREE, kind);
-      function = iocall_x_complex;
+      function = iocall[IOCALL_X_COMPLEX];
       break;
 
     case BT_LOGICAL:
       arg2 = build_int_cst (NULL_TREE, kind);
-      function = iocall_x_logical;
+      function = iocall[IOCALL_X_LOGICAL];
       break;
 
     case BT_CHARACTER:
@@ -1550,7 +1688,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr)
 	  gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE);
 	  arg2 = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (tmp)));
 	}
-      function = iocall_x_character;
+      function = iocall[IOCALL_X_CHARACTER];
       break;
 
     case BT_DERIVED:
@@ -1584,7 +1722,9 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr)
       internal_error ("Bad IO basetype (%d)", ts->type);
     }
 
-  args = gfc_chainon_list (NULL_TREE, addr_expr);
+  tmp = gfc_build_addr_expr (NULL_TREE, dt_parm);
+  args = gfc_chainon_list (NULL_TREE, tmp);
+  args = gfc_chainon_list (args, addr_expr);
   args = gfc_chainon_list (args, arg2);
 
   tmp = gfc_build_function_call (function, args);
@@ -1609,10 +1749,12 @@ transfer_array_desc (gfc_se * se, gfc_typespec * ts, tree addr_expr)
 
   kind_arg = build_int_cst (NULL_TREE, ts->kind);
 
-  args = gfc_chainon_list (NULL_TREE, addr_expr);
+  tmp = gfc_build_addr_expr (NULL_TREE, dt_parm);
+  args = gfc_chainon_list (NULL_TREE, tmp);
+  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_x_array, args);
+  tmp = gfc_build_function_call (iocall[IOCALL_X_ARRAY], args);
   gfc_add_expr_to_block (&se->pre, tmp);
   gfc_add_block_to_block (&se->pre, &se->post);
 }
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 315c0f9648f..23dabc9ce9a 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2005-11-21  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/24774
+	* gfortran.dg/inquire_9.f90: New test.
+
+	PR fortran/21647
+	* gfortran.fortran-torture/execute/inquire_5.f90: New test.
+
 2005-11-21  Eric Botcazou  <ebotcazou@libertysurf.fr>
 
 	PR libfortran/24432
diff --git a/gcc/testsuite/gfortran.dg/inquire_9.f90 b/gcc/testsuite/gfortran.dg/inquire_9.f90
new file mode 100644
index 00000000000..f1f8ffd1556
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquire_9.f90
@@ -0,0 +1,24 @@
+! PR fortran/24774
+! { dg-do run }
+  logical :: l
+  l = .true.
+  inquire (file='inquire_9 file that should not exist', exist=l)
+  if (l) call abort
+  l = .true.
+  inquire (unit=-16, exist=l)
+  if (l) call abort
+  open (unit=16, file='inquire_9.tst')
+  print (unit=16, fmt='(a)'), 'Test'
+  l = .false.
+  inquire (unit=16, exist=l)
+  if (.not.l) call abort
+  l = .false.
+  inquire (file='inquire_9.tst', exist=l)
+  if (.not.l) call abort
+  close (unit=16)
+  l = .false.
+  inquire (file='inquire_9.tst', exist=l)
+  if (.not.l) call abort
+  open (unit=16, file='inquire_9.tst')
+  close (unit=16, status='delete')
+end
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/inquire_5.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/inquire_5.f90
new file mode 100644
index 00000000000..1077650d87d
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/inquire_5.f90
@@ -0,0 +1,32 @@
+! PR fortran/21647
+program inquire_5
+  integer (kind = 8) :: unit8
+  logical (kind = 8) :: exist8
+  integer (kind = 4) :: unit4
+  logical (kind = 4) :: exist4
+  integer (kind = 2) :: unit2
+  logical (kind = 2) :: exist2
+  integer (kind = 1) :: unit1
+  logical (kind = 1) :: exist1
+  character (len = 6) :: del
+  unit8 = 78
+  open (file = 'inquire_5.txt', unit = unit8)
+  unit8 = -1
+  exist8 = .false.
+  unit4 = -1
+  exist4 = .false.
+  unit2 = -1
+  exist2 = .false.
+  unit1 = -1
+  exist1 = .false.
+  inquire (file = 'inquire_5.txt', number = unit8, exist = exist8)
+  if (unit8 .ne. 78 .or. .not. exist8) call abort
+  inquire (file = 'inquire_5.txt', number = unit4, exist = exist4)
+  if (unit4 .ne. 78 .or. .not. exist4) call abort
+  inquire (file = 'inquire_5.txt', number = unit2, exist = exist2)
+  if (unit2 .ne. 78 .or. .not. exist2) call abort
+  inquire (file = 'inquire_5.txt', number = unit1, exist = exist1)
+  if (unit1 .ne. 78 .or. .not. exist1) call abort
+  del = 'delete'
+  close (unit = 78, status = del)
+end