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

1 files changed, 319 insertions, 155 deletions

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 47a564f5e7d..f080c4607ad 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -32,6 +32,11 @@ Boston, MA 02110-1301, USA.  */
 
 #include <setjmp.h>
 #include "libgfortran.h"
+#ifdef HAVE_PRAGMA_WEAK
+/* Used by gthr.h.  */
+#define SUPPORTS_WEAK 1
+#endif
+#include <gthr.h>
 
 #define DEFAULT_TEMPDIR "/tmp"
 
@@ -48,6 +53,8 @@ typedef enum
 { SUCCESS = 1, FAILURE }
 try;
 
+struct st_parameter_dt;
+
 typedef struct stream
 {
   char *(*alloc_w_at) (struct stream *, int *, gfc_offset);
@@ -202,83 +209,213 @@ typedef enum
 {READING, WRITING}
 unit_mode;
 
-/* Statement parameters.  These are all the things that can appear in
-   an I/O statement.  Some are inputs and some are outputs, but none
-   are both.  All of these values are initially zeroed and are zeroed
-   at the end of a library statement.  The relevant values need to be
-   set before entry to an I/O statement.  This structure needs to be
-   duplicated by the back end.  */
+#define CHARACTER1(name) \
+	      char * name; \
+	      gfc_charlen_type name ## _len
+#define CHARACTER2(name) \
+	      gfc_charlen_type name ## _len; \
+	      char * name
+
+#define IOPARM_LIBRETURN_MASK		(3 << 0)
+#define IOPARM_LIBRETURN_OK		(0 << 0)
+#define IOPARM_LIBRETURN_ERROR		(1 << 0)
+#define IOPARM_LIBRETURN_END		(2 << 0)
+#define IOPARM_LIBRETURN_EOR		(3 << 0)
+#define IOPARM_ERR			(1 << 2)
+#define IOPARM_END			(1 << 3)
+#define IOPARM_EOR			(1 << 4)
+#define IOPARM_HAS_IOSTAT		(1 << 5)
+#define IOPARM_HAS_IOMSG		(1 << 6)
+
+#define IOPARM_COMMON_MASK		((1 << 7) - 1)
+
+typedef struct st_parameter_common
+{
+  GFC_INTEGER_4 flags;
+  GFC_INTEGER_4 unit;
+  const char *filename;
+  GFC_INTEGER_4 line;
+  CHARACTER2 (iomsg);
+  GFC_INTEGER_4 *iostat;
+}
+st_parameter_common;
+
+#define IOPARM_OPEN_HAS_RECL_IN		(1 << 7)
+#define IOPARM_OPEN_HAS_FILE		(1 << 8)
+#define IOPARM_OPEN_HAS_STATUS		(1 << 9)
+#define IOPARM_OPEN_HAS_ACCESS		(1 << 10)
+#define IOPARM_OPEN_HAS_FORM		(1 << 11)
+#define IOPARM_OPEN_HAS_BLANK		(1 << 12)
+#define IOPARM_OPEN_HAS_POSITION	(1 << 13)
+#define IOPARM_OPEN_HAS_ACTION		(1 << 14)
+#define IOPARM_OPEN_HAS_DELIM		(1 << 15)
+#define IOPARM_OPEN_HAS_PAD		(1 << 16)
 
 typedef struct
 {
-  GFC_INTEGER_4 unit;
-  GFC_INTEGER_4 err, end, eor, list_format; /* These are flags, not values.  */
+  st_parameter_common common;
+  GFC_INTEGER_4 recl_in;
+  CHARACTER2 (file);
+  CHARACTER1 (status);
+  CHARACTER2 (access);
+  CHARACTER1 (form);
+  CHARACTER2 (blank);
+  CHARACTER1 (position);
+  CHARACTER2 (action);
+  CHARACTER1 (delim);
+  CHARACTER2 (pad);
+}
+st_parameter_open;
 
-/* Return values from library statements.  These are returned only if
-   the labels are specified in the statement itself and the condition
-   occurs.  In most cases, none of the labels are specified and the
-   return value does not have to be checked.  Must be consistent with
-   the front end.  */
+#define IOPARM_CLOSE_HAS_STATUS		(1 << 7)
 
-  enum
-  {
-    LIBRARY_OK = 0,
-    LIBRARY_ERROR,
-    LIBRARY_END,
-    LIBRARY_EOR
-  }
-  library_return;
+typedef struct
+{
+  st_parameter_common common;
+  CHARACTER1 (status);
+}
+st_parameter_close;
 
-  GFC_INTEGER_4 *iostat, *exist, *opened, *number, *named;
-  GFC_INTEGER_4 rec;
-  GFC_INTEGER_4 *nextrec, *size;
+typedef struct
+{
+  st_parameter_common common;
+}
+st_parameter_filepos;
+
+#define IOPARM_INQUIRE_HAS_EXIST	(1 << 7)
+#define IOPARM_INQUIRE_HAS_OPENED	(1 << 8)
+#define IOPARM_INQUIRE_HAS_NUMBER	(1 << 9)
+#define IOPARM_INQUIRE_HAS_NAMED	(1 << 10)
+#define IOPARM_INQUIRE_HAS_NEXTREC	(1 << 11)
+#define IOPARM_INQUIRE_HAS_RECL_OUT	(1 << 12)
+#define IOPARM_INQUIRE_HAS_FILE		(1 << 13)
+#define IOPARM_INQUIRE_HAS_ACCESS	(1 << 14)
+#define IOPARM_INQUIRE_HAS_FORM		(1 << 15)
+#define IOPARM_INQUIRE_HAS_BLANK	(1 << 16)
+#define IOPARM_INQUIRE_HAS_POSITION	(1 << 17)
+#define IOPARM_INQUIRE_HAS_ACTION	(1 << 18)
+#define IOPARM_INQUIRE_HAS_DELIM	(1 << 19)
+#define IOPARM_INQUIRE_HAS_PAD		(1 << 20)
+#define IOPARM_INQUIRE_HAS_NAME		(1 << 21)
+#define IOPARM_INQUIRE_HAS_SEQUENTIAL	(1 << 22)
+#define IOPARM_INQUIRE_HAS_DIRECT	(1 << 23)
+#define IOPARM_INQUIRE_HAS_FORMATTED	(1 << 24)
+#define IOPARM_INQUIRE_HAS_UNFORMATTED	(1 << 25)
+#define IOPARM_INQUIRE_HAS_READ		(1 << 26)
+#define IOPARM_INQUIRE_HAS_WRITE	(1 << 27)
+#define IOPARM_INQUIRE_HAS_READWRITE	(1 << 28)
 
-  GFC_INTEGER_4 recl_in;
-  GFC_INTEGER_4 *recl_out;
-
-  GFC_INTEGER_4 *iolength;
-
-#define CHARACTER(name) \
-              char * name; \
-              gfc_charlen_type name ## _len
-  CHARACTER (file);
-  CHARACTER (status);
-  CHARACTER (access);
-  CHARACTER (form);
-  CHARACTER (blank);
-  CHARACTER (position);
-  CHARACTER (action);
-  CHARACTER (delim);
-  CHARACTER (pad);
-  CHARACTER (format);
-  CHARACTER (advance);
-  CHARACTER (name);
-  CHARACTER (internal_unit);
+typedef struct
+{
+  st_parameter_common common;
+  GFC_INTEGER_4 *exist, *opened, *number, *named;
+  GFC_INTEGER_4 *nextrec, *recl_out;
+  CHARACTER1 (file);
+  CHARACTER2 (access);
+  CHARACTER1 (form);
+  CHARACTER2 (blank);
+  CHARACTER1 (position);
+  CHARACTER2 (action);
+  CHARACTER1 (delim);
+  CHARACTER2 (pad);
+  CHARACTER1 (name);
+  CHARACTER2 (sequential);
+  CHARACTER1 (direct);
+  CHARACTER2 (formatted);
+  CHARACTER1 (unformatted);
+  CHARACTER2 (read);
+  CHARACTER1 (write);
+  CHARACTER2 (readwrite);
+}
+st_parameter_inquire;
+
+struct gfc_unit;
+struct format_data;
+
+#define IOPARM_DT_LIST_FORMAT			(1 << 7)
+#define IOPARM_DT_NAMELIST_READ_MODE		(1 << 8)
+#define IOPARM_DT_HAS_REC			(1 << 9)
+#define IOPARM_DT_HAS_SIZE			(1 << 10)
+#define IOPARM_DT_HAS_IOLENGTH			(1 << 11)
+#define IOPARM_DT_HAS_FORMAT			(1 << 12)
+#define IOPARM_DT_HAS_ADVANCE			(1 << 13)
+#define IOPARM_DT_HAS_INTERNAL_UNIT		(1 << 14)
+#define IOPARM_DT_HAS_NAMELIST_NAME		(1 << 15)
+/* Internal use bit.  */
+#define IOPARM_DT_IONML_SET			(1 << 31)
+
+typedef struct st_parameter_dt
+{
+  st_parameter_common common;
+  GFC_INTEGER_4 rec;
+  GFC_INTEGER_4 *size, *iolength;
   gfc_array_char *internal_unit_desc;
-  CHARACTER (sequential);
-  CHARACTER (direct);
-  CHARACTER (formatted);
-  CHARACTER (unformatted);
-  CHARACTER (read);
-  CHARACTER (write);
-  CHARACTER (readwrite);
-
-/* namelist related data */
-  CHARACTER (namelist_name);
-  GFC_INTEGER_4 namelist_read_mode;
-
-  /* iomsg */
-  CHARACTER (iomsg);
-
-#undef CHARACTER
+  CHARACTER1 (format);
+  CHARACTER2 (advance);
+  CHARACTER1 (internal_unit);
+  CHARACTER2 (namelist_name);
+  /* Private part of the structure.  The compiler just needs
+     to reserve enough space.  */
+  union
+    {
+      struct
+	{
+	  void (*transfer) (struct st_parameter_dt *, bt, void *, int,
+			    size_t, size_t);
+	  struct gfc_unit *current_unit;
+	  int item_count; /* Item number in a formatted data transfer.  */
+	  unit_mode mode;
+	  unit_blank blank_status;
+	  enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
+	  int scale_factor;
+	  int max_pos; /* Maximum righthand column written to.  */
+	  /* Number of skips + spaces to be done for T and X-editing.  */
+	  int skips;
+	  /* Number of spaces to be done for T and X-editing.  */
+	  int pending_spaces;
+	  unit_advance advance_status;
+	  char reversion_flag; /* Format reversion has occurred.  */
+	  char first_item;
+	  char seen_dollar;
+	  char sf_seen_eor;
+	  char eor_condition;
+	  char no_leading_blank;
+	  char nml_delim;
+	  char char_flag;
+	  char input_complete;
+	  char at_eol;
+	  char comma_flag;
+	  char last_char;
+	  /* A namelist specific flag used in the list directed library
+	     to flag that calls are being made from namelist read (eg. to
+	     ignore comments or to treat '/' as a terminator)  */
+	  char namelist_mode;
+	  /* A namelist specific flag used in the list directed library
+	     to flag read errors and return, so that an attempt can be
+	     made to read a new object name.  */
+	  char nml_read_error;
+	  /* Storage area for values except for strings.  Must be large
+	     enough to hold a complex value (two reals) of the largest
+	     kind.  */
+	  char value[32];
+	  int repeat_count;
+	  int saved_length;
+	  int saved_used;
+	  bt saved_type;
+	  char *saved_string;
+	  char *scratch;
+	  char *line_buffer;
+	  struct format_data *fmt;
+	  jmp_buf *eof_jump;
+	  namelist_info *ionml;
+	} p;
+      char pad[16 * sizeof (char *) + 32 * sizeof (int)];
+    } u;
 }
-st_parameter;
+st_parameter_dt;
 
-extern st_parameter ioparm;
-iexport_data_proto(ioparm);
-
-extern namelist_info * ionml;
-internal_proto(ionml);
+#undef CHARACTER1
+#undef CHARACTER2
 
 typedef struct
 {
@@ -316,55 +453,36 @@ typedef struct gfc_unit
   { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
   endfile;
 
-  unit_mode  mode;
+  unit_mode mode;
   unit_flags flags;
-  
+
   /* recl           -- Record length of the file.
      last_record    -- Last record number read or written
      maxrec         -- Maximum record number in a direct access file
      bytes_left     -- Bytes left in current record.  */
   gfc_offset recl, last_record, maxrec, bytes_left;
 
+  __gthread_mutex_t lock;
+  /* Number of threads waiting to acquire this unit's lock.
+     When non-zero, close_unit doesn't only removes the unit
+     from the UNIT_ROOT tree, but doesn't free it and the
+     last of the waiting threads will do that.
+     This must be either atomically increased/decreased, or
+     always guarded by UNIT_LOCK.  */
+  int waiting;
+  /* Flag set by close_unit if the unit as been closed.
+     Must be manipulated under unit's lock.  */
+  int closed;
+
   /* For traversing arrays */
   array_loop_spec *ls;
   int rank;
-  
-  /* Filename is allocated at the end of the structure.  */  
+
   int file_len;
-  char file[1];
+  char *file;
 }
 gfc_unit;
 
-/* Global variables.  Putting these in a structure makes it easier to
-   maintain, particularly with the constraint of a prefix.  */
-
-typedef struct
-{
-  int in_library;       /* Nonzero if a library call is being processed.  */
-  int size;	/* Bytes processed by the current data-transfer statement.  */
-  gfc_offset max_offset;	/* Maximum file offset.  */
-  int item_count;	/* Item number in a formatted data transfer.  */
-  int reversion_flag;	/* Format reversion has occurred.  */
-  int first_item;
-
-  gfc_unit *unit_root;
-  int seen_dollar;
-
-  unit_mode  mode;
-
-  unit_blank blank_status;
-  enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
-  int scale_factor;
-  jmp_buf eof_jump;
-}
-global_t;
-
-extern global_t g;
-internal_proto(g);
-
-extern gfc_unit *current_unit;
-internal_proto(current_unit);
-
 /* Format tokens.  Only about half of these can be stored in the
    format nodes.  */
 
@@ -436,10 +554,7 @@ internal_proto(move_pos_offset);
 extern int compare_files (stream *, stream *);
 internal_proto(compare_files);
 
-extern stream *init_error_stream (void);
-internal_proto(init_error_stream);
-
-extern stream *open_external (unit_flags *);
+extern stream *open_external (st_parameter_open *, unit_flags *);
 internal_proto(open_external);
 
 extern stream *open_internal (char *, int);
@@ -457,9 +572,12 @@ internal_proto(error_stream);
 extern int compare_file_filename (gfc_unit *, const char *, int);
 internal_proto(compare_file_filename);
 
-extern gfc_unit *find_file (void);
+extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
 internal_proto(find_file);
 
+extern void flush_all_units (void);
+internal_proto(flush_all_units);
+
 extern int stream_at_bof (stream *);
 internal_proto(stream_at_bof);
 
@@ -469,7 +587,7 @@ internal_proto(stream_at_eof);
 extern int delete_file (gfc_unit *);
 internal_proto(delete_file);
 
-extern int file_exists (void);
+extern int file_exists (const char *file, gfc_charlen_type file_len);
 internal_proto(file_exists);
 
 extern const char *inquire_sequential (const char *, int);
@@ -531,72 +649,83 @@ internal_proto(unpack_filename);
 
 /* unit.c */
 
-extern void insert_unit (gfc_unit *);
-internal_proto(insert_unit);
+/* Maximum file offset, computed at library initialization time.  */
+extern gfc_offset max_offset;
+internal_proto(max_offset);
+
+/* Unit tree root.  */
+extern gfc_unit *unit_root;
+internal_proto(unit_root);
+
+extern __gthread_mutex_t unit_lock;
+internal_proto(unit_lock);
 
 extern int close_unit (gfc_unit *);
 internal_proto(close_unit);
 
-extern int is_internal_unit (void);
+extern int is_internal_unit (st_parameter_dt *);
 internal_proto(is_internal_unit);
 
-extern int is_array_io (void);
+extern int is_array_io (st_parameter_dt *);
 internal_proto(is_array_io);
 
 extern gfc_unit *find_unit (int);
 internal_proto(find_unit);
 
-extern gfc_unit *get_unit (int);
+extern gfc_unit *find_or_create_unit (int);
+internal_proto(find_unit);
+
+extern gfc_unit *get_unit (st_parameter_dt *, int);
 internal_proto(get_unit);
 
+extern void unlock_unit (gfc_unit *);
+internal_proto(unlock_unit);
+
 /* open.c */
 
 extern void test_endfile (gfc_unit *);
 internal_proto(test_endfile);
 
-extern void new_unit (unit_flags *);
+extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
 internal_proto(new_unit);
 
 /* format.c */
 
-extern void parse_format (void);
+extern void parse_format (st_parameter_dt *);
 internal_proto(parse_format);
 
-extern fnode *next_format (void);
+extern const fnode *next_format (st_parameter_dt *);
 internal_proto(next_format);
 
-extern void unget_format (fnode *);
+extern void unget_format (st_parameter_dt *, const fnode *);
 internal_proto(unget_format);
 
-extern void format_error (fnode *, const char *);
+extern void format_error (st_parameter_dt *, const fnode *, const char *);
 internal_proto(format_error);
 
-extern void free_fnodes (void);
-internal_proto(free_fnodes);
+extern void free_format_data (st_parameter_dt *);
+internal_proto(free_format_data);
 
 /* transfer.c */
 
 #define SCRATCH_SIZE 300
 
-extern char scratch[];
-internal_proto(scratch);
-
 extern const char *type_name (bt);
 internal_proto(type_name);
 
-extern void *read_block (int *);
+extern void *read_block (st_parameter_dt *, int *);
 internal_proto(read_block);
 
-extern void *write_block (int);
+extern void *write_block (st_parameter_dt *, int);
 internal_proto(write_block);
 
-extern gfc_offset next_array_record (array_loop_spec *);
+extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *);
 internal_proto(next_array_record);
 
-extern gfc_offset init_loop_spec (gfc_array_char *desc, array_loop_spec *ls);
+extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *);
 internal_proto(init_loop_spec);
 
-extern void next_record (int);
+extern void next_record (st_parameter_dt *, int);
 internal_proto(next_record);
 
 /* read.c */
@@ -607,83 +736,82 @@ internal_proto(set_integer);
 extern GFC_UINTEGER_LARGEST max_value (int, int);
 internal_proto(max_value);
 
-extern int convert_real (void *, const char *, int);
+extern int convert_real (st_parameter_dt *, void *, const char *, int);
 internal_proto(convert_real);
 
-extern void read_a (fnode *, char *, int);
+extern void read_a (st_parameter_dt *, const fnode *, char *, int);
 internal_proto(read_a);
 
-extern void read_f (fnode *, char *, int);
+extern void read_f (st_parameter_dt *, const fnode *, char *, int);
 internal_proto(read_f);
 
-extern void read_l (fnode *, char *, int);
+extern void read_l (st_parameter_dt *, const fnode *, char *, int);
 internal_proto(read_l);
 
-extern void read_x (int);
+extern void read_x (st_parameter_dt *, int);
 internal_proto(read_x);
 
-extern void read_radix (fnode *, char *, int, int);
+extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
 internal_proto(read_radix);
 
-extern void read_decimal (fnode *, char *, int);
+extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
 internal_proto(read_decimal);
 
 /* list_read.c */
 
-extern void list_formatted_read (bt, void *, int, size_t, size_t);
+extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
+				 size_t);
 internal_proto(list_formatted_read);
 
-extern void finish_list_read (void);
+extern void finish_list_read (st_parameter_dt *);
 internal_proto(finish_list_read);
 
-extern void init_at_eol (void);
-internal_proto(init_at_eol);
-
-extern void namelist_read (void);
+extern void namelist_read (st_parameter_dt *);
 internal_proto(namelist_read);
 
-extern void namelist_write (void);
+extern void namelist_write (st_parameter_dt *);
 internal_proto(namelist_write);
 
 /* write.c */
 
-extern void write_a (fnode *, const char *, int);
+extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_a);
 
-extern void write_b (fnode *, const char *, int);
+extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_b);
 
-extern void write_d (fnode *, const char *, int);
+extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_d);
 
-extern void write_e (fnode *, const char *, int);
+extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_e);
 
-extern void write_en (fnode *, const char *, int);
+extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_en);
 
-extern void write_es (fnode *, const char *, int);
+extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_es);
 
-extern void write_f (fnode *, const char *, int);
+extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_f);
 
-extern void write_i (fnode *, const char *, int);
+extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_i);
 
-extern void write_l (fnode *, char *, int);
+extern void write_l (st_parameter_dt *, const fnode *, char *, int);
 internal_proto(write_l);
 
-extern void write_o (fnode *, const char *, int);
+extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_o);
 
-extern void write_x (int, int);
+extern void write_x (st_parameter_dt *, int, int);
 internal_proto(write_x);
 
-extern void write_z (fnode *, const char *, int);
+extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
 internal_proto(write_z);
 
-extern void list_formatted_write (bt, void *, int, size_t, size_t);
+extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
+				  size_t);
 internal_proto(list_formatted_write);
 
 /* error.c */
@@ -697,4 +825,40 @@ internal_proto(size_from_real_kind);
 extern size_t size_from_complex_kind (int);
 internal_proto(size_from_complex_kind);
 
+/* lock.c */
+extern void free_ionml (st_parameter_dt *);
+internal_proto(free_ionml);
+
+static inline void
+inc_waiting_locked (gfc_unit *u)
+{
+#ifdef HAVE_SYNC_FETCH_AND_ADD
+  (void) __sync_fetch_and_add (&u->waiting, 1);
+#else
+  u->waiting++;
+#endif
+}
+
+static inline int
+predec_waiting_locked (gfc_unit *u)
+{
+#ifdef HAVE_SYNC_FETCH_AND_ADD
+  return __sync_add_and_fetch (&u->waiting, -1);
+#else
+  return --u->waiting;
+#endif
+}
+
+static inline void
+dec_waiting_unlocked (gfc_unit *u)
+{
+#ifdef HAVE_SYNC_FETCH_AND_ADD
+  (void) __sync_fetch_and_add (&u->waiting, -1);
+#else
+  __gthread_mutex_lock (&unit_lock);
+  u->waiting--;
+  __gthread_mutex_unlock (&unit_lock);
+#endif
+}
+
 #endif