re PR fortran/14943 (read/write code generation is not thread safe)

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.

From-SVN: r107328

1 files changed, 170 insertions, 116 deletions

diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index c3b5dde..a1bc99b 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -116,56 +116,57 @@ test_endfile (gfc_unit * u)
    changed.  */
 
 static void
-edit_modes (gfc_unit * u, unit_flags * flags)
+edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
 {
   /* Complain about attempts to change the unchangeable.  */
 
   if (flags->status != STATUS_UNSPECIFIED &&
       u->flags.status != flags->status)
-    generate_error (ERROR_BAD_OPTION,
+    generate_error (&opp->common, ERROR_BAD_OPTION,
 		    "Cannot change STATUS parameter in OPEN statement");
 
   if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access)
-    generate_error (ERROR_BAD_OPTION,
+    generate_error (&opp->common, ERROR_BAD_OPTION,
 		    "Cannot change ACCESS parameter in OPEN statement");
 
   if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form)
-    generate_error (ERROR_BAD_OPTION,
+    generate_error (&opp->common, ERROR_BAD_OPTION,
 		    "Cannot change FORM parameter in OPEN statement");
 
-  if (ioparm.recl_in != 0 && ioparm.recl_in != u->recl)
-    generate_error (ERROR_BAD_OPTION,
+  if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)
+      && opp->recl_in != u->recl)
+    generate_error (&opp->common, ERROR_BAD_OPTION,
 		    "Cannot change RECL parameter in OPEN statement");
 
   if (flags->action != ACTION_UNSPECIFIED && u->flags.access != flags->access)
-    generate_error (ERROR_BAD_OPTION,
+    generate_error (&opp->common, ERROR_BAD_OPTION,
 		    "Cannot change ACTION parameter in OPEN statement");
 
   /* Status must be OLD if present.  */
 
   if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD)
-    generate_error (ERROR_BAD_OPTION,
+    generate_error (&opp->common, ERROR_BAD_OPTION,
 		    "OPEN statement must have a STATUS of OLD");
 
   if (u->flags.form == FORM_UNFORMATTED)
     {
       if (flags->delim != DELIM_UNSPECIFIED)
-	generate_error (ERROR_OPTION_CONFLICT,
+	generate_error (&opp->common, ERROR_OPTION_CONFLICT,
 			"DELIM parameter conflicts with UNFORMATTED form in "
 			"OPEN statement");
 
       if (flags->blank != BLANK_UNSPECIFIED)
-	generate_error (ERROR_OPTION_CONFLICT,
+	generate_error (&opp->common, ERROR_OPTION_CONFLICT,
 			"BLANK parameter conflicts with UNFORMATTED form in "
 			"OPEN statement");
 
       if (flags->pad != PAD_UNSPECIFIED)
-	generate_error (ERROR_OPTION_CONFLICT,
+	generate_error (&opp->common, ERROR_OPTION_CONFLICT,
 			"PAD paramter conflicts with UNFORMATTED form in "
 			"OPEN statement");
     }
 
-  if (ioparm.library_return == LIBRARY_OK)
+  if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
     {
       /* Change the changeable:  */
       if (flags->blank != BLANK_UNSPECIFIED)
@@ -203,18 +204,20 @@ edit_modes (gfc_unit * u, unit_flags * flags)
       break;
 
     seek_error:
-      generate_error (ERROR_OS, NULL);
+      generate_error (&opp->common, ERROR_OS, NULL);
       break;
     }
+
+  unlock_unit (u);
 }
 
 
 /* Open an unused unit.  */
 
-void
-new_unit (unit_flags * flags)
+gfc_unit *
+new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
 {
-  gfc_unit *u;
+  gfc_unit *u2;
   stream *s;
   char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
 
@@ -236,10 +239,10 @@ new_unit (unit_flags * flags)
     {
       if (flags->form == FORM_UNFORMATTED)
 	{
-	  generate_error (ERROR_OPTION_CONFLICT,
+	  generate_error (&opp->common, ERROR_OPTION_CONFLICT,
 			  "DELIM parameter conflicts with UNFORMATTED form in "
 			  "OPEN statement");
-	  goto cleanup;
+	  goto fail;
 	}
     }
 
@@ -249,10 +252,10 @@ new_unit (unit_flags * flags)
     {
       if (flags->form == FORM_UNFORMATTED)
 	{
-	  generate_error (ERROR_OPTION_CONFLICT,
+	  generate_error (&opp->common, ERROR_OPTION_CONFLICT,
 			  "BLANK parameter conflicts with UNFORMATTED form in "
 			  "OPEN statement");
-	  goto cleanup;
+	  goto fail;
 	}
     }
 
@@ -262,19 +265,19 @@ new_unit (unit_flags * flags)
     {
       if (flags->form == FORM_UNFORMATTED)
 	{
-	  generate_error (ERROR_OPTION_CONFLICT,
+	  generate_error (&opp->common, ERROR_OPTION_CONFLICT,
 			  "PAD paramter conflicts with UNFORMATTED form in "
 			  "OPEN statement");
-	  goto cleanup;
+	  goto fail;
 	}
     }
 
   if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
    {
-     generate_error (ERROR_OPTION_CONFLICT,
+     generate_error (&opp->common, ERROR_OPTION_CONFLICT,
                      "ACCESS parameter conflicts with SEQUENTIAL access in "
                      "OPEN statement");
-     goto cleanup;
+     goto fail;
    }
   else
    if (flags->position == POSITION_UNSPECIFIED)
@@ -286,64 +289,74 @@ new_unit (unit_flags * flags)
 
   /* Checks.  */
 
-  if (flags->access == ACCESS_DIRECT && ioparm.recl_in == 0)
+  if (flags->access == ACCESS_DIRECT
+      && (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0)
     {
-      generate_error (ERROR_MISSING_OPTION,
+      generate_error (&opp->common, ERROR_MISSING_OPTION,
 		      "Missing RECL parameter in OPEN statement");
-      goto cleanup;
+      goto fail;
     }
 
-  if (ioparm.recl_in != 0 && ioparm.recl_in <= 0)
+  if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in <= 0)
     {
-      generate_error (ERROR_BAD_OPTION,
+      generate_error (&opp->common, ERROR_BAD_OPTION,
 		      "RECL parameter is non-positive in OPEN statement");
-      goto cleanup;
+      goto fail;
     }
 
   switch (flags->status)
     {
     case STATUS_SCRATCH:
-      if (ioparm.file == NULL)
-	break;
+      if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0)
+	{
+	  opp->file = NULL;
+	  break;
+	}
 
-      generate_error (ERROR_BAD_OPTION,
+      generate_error (&opp->common, ERROR_BAD_OPTION,
 		      "FILE parameter must not be present in OPEN statement");
-      return;
+      goto fail;
 
     case STATUS_OLD:
     case STATUS_NEW:
     case STATUS_REPLACE:
     case STATUS_UNKNOWN:
-      if (ioparm.file != NULL)
+      if ((opp->common.flags & IOPARM_OPEN_HAS_FILE))
 	break;
 
-      ioparm.file = tmpname;
-      ioparm.file_len = sprintf(ioparm.file, "fort.%d", ioparm.unit);
+      opp->file = tmpname;
+      opp->file_len = sprintf(opp->file, "fort.%d", opp->common.unit);
       break;
 
     default:
-      internal_error ("new_unit(): Bad status");
+      internal_error (&opp->common, "new_unit(): Bad status");
     }
 
   /* Make sure the file isn't already open someplace else.
      Do not error if opening file preconnected to stdin, stdout, stderr.  */
 
-  u = find_file ();
-  if (u != NULL
+  u2 = NULL;
+  if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) != 0)
+    u2 = find_file (opp->file, opp->file_len);
+  if (u2 != NULL
       && (options.stdin_unit < 0 || u->unit_number != options.stdin_unit)
       && (options.stdout_unit < 0 || u->unit_number != options.stdout_unit)
       && (options.stderr_unit < 0 || u->unit_number != options.stderr_unit))
     {
-      generate_error (ERROR_ALREADY_OPEN, NULL);
+      unlock_unit (u2);
+      generate_error (&opp->common, ERROR_ALREADY_OPEN, NULL);
       goto cleanup;
     }
 
+  if (u2 != NULL)
+    unlock_unit (u2);
+
   /* Open file.  */
 
-  s = open_external (flags);
+  s = open_external (opp, flags);
   if (s == NULL)
     {
-      generate_error (ERROR_OS, NULL);
+      generate_error (&opp->common, ERROR_OS, NULL);
       goto cleanup;
     }
 
@@ -352,52 +365,65 @@ new_unit (unit_flags * flags)
 
   /* Create the unit structure.  */
 
-  u = get_mem (sizeof (gfc_unit) + ioparm.file_len);
-  memset (u, '\0', sizeof (gfc_unit) + ioparm.file_len);
-
-  u->unit_number = ioparm.unit;
+  u->file = get_mem (opp->file_len);
+  if (u->unit_number != opp->common.unit)
+    internal_error (&opp->common, "Unit number changed");
   u->s = s;
   u->flags = *flags;
+  u->read_bad = 0;
+  u->endfile = NO_ENDFILE;
+  u->last_record = 0;
+  u->current_record = 0;
+  u->mode = READING;
+  u->maxrec = 0;
+  u->bytes_left = 0;
 
   if (flags->position == POSITION_APPEND)
-  {
-    if (sseek (u->s, file_length (u->s)) == FAILURE)
-      generate_error (ERROR_OS, NULL);
-    u->endfile = AT_ENDFILE;
-  }
+    {
+      if (sseek (u->s, file_length (u->s)) == FAILURE)
+	generate_error (&opp->common, ERROR_OS, NULL);
+      u->endfile = AT_ENDFILE;
+    }
 
   /* Unspecified recl ends up with a processor dependent value.  */
 
-  u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : g.max_offset;
-  u->last_record = 0;
-  u->current_record = 0;
+  if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN))
+    u->recl = opp->recl_in;
+  else
+    u->recl = max_offset;
 
   /* If the file is direct access, calculate the maximum record number
      via a division now instead of letting the multiplication overflow
      later.  */
 
   if (flags->access == ACCESS_DIRECT)
-    u->maxrec = g.max_offset / u->recl;
-
-  memmove (u->file, ioparm.file, ioparm.file_len);
-  u->file_len = ioparm.file_len;
+    u->maxrec = max_offset / u->recl;
 
-  insert_unit (u);
+  memmove (u->file, opp->file, opp->file_len);
+  u->file_len = opp->file_len;
 
-  /* The file is now connected.  Errors after this point leave the
-     file connected.  Curiously, the standard requires that the
+  /* Curiously, the standard requires that the
      position specifier be ignored for new files so a newly connected
      file starts out that the initial point.  We still need to figure
      out if the file is at the end or not.  */
 
   test_endfile (u);
 
+  if (flags->status == STATUS_SCRATCH && opp->file != NULL)
+    free_mem (opp->file);
+  return u;
+
  cleanup:
 
   /* Free memory associated with a temporary filename.  */
 
-  if (flags->status == STATUS_SCRATCH)
-    free_mem (ioparm.file);
+  if (flags->status == STATUS_SCRATCH && opp->file != NULL)
+    free_mem (opp->file);
+
+ fail:
+
+  close_unit (u);
+  return NULL;
 }
 
 
@@ -405,95 +431,122 @@ new_unit (unit_flags * flags)
    modes or closing what is there now and opening the new file.  */
 
 static void
-already_open (gfc_unit * u, unit_flags * flags)
+already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
 {
-  if (ioparm.file == NULL)
+  if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0)
     {
-      edit_modes (u, flags);
+      edit_modes (opp, u, flags);
       return;
     }
 
   /* If the file is connected to something else, close it and open a
      new unit.  */
 
-  if (!compare_file_filename (u, ioparm.file, ioparm.file_len))
+  if (!compare_file_filename (u, opp->file, opp->file_len))
     {
-      if (close_unit (u))
+#if !HAVE_UNLINK_OPEN_FILE
+      char *path = NULL;
+      if (u->file && u->flags.status == STATUS_SCRATCH)
 	{
-	  generate_error (ERROR_OS, "Error closing file in OPEN statement");
+	  path = (char *) gfc_alloca (u->file_len + 1);
+	  unpack_filename (path, u->file, u->file_len);
+	}
+#endif
+
+      if (sclose (u->s) == FAILURE)
+	{
+	  unlock_unit (u);
+	  generate_error (&opp->common, ERROR_OS,
+			  "Error closing file in OPEN statement");
 	  return;
 	}
 
-      new_unit (flags);
+      u->s = NULL;
+      if (u->file)
+	free_mem (u->file);
+      u->file = NULL;
+      u->file_len = 0;
+
+#if !HAVE_UNLINK_OPEN_FILE
+      if (path != NULL)
+	unlink (path);
+#endif
+
+      u = new_unit (opp, u, flags);
+      if (u != NULL)
+	unlock_unit (u);
       return;
     }
 
-  edit_modes (u, flags);
+  edit_modes (opp, u, flags);
 }
 
 
 /* Open file.  */
 
-extern void st_open (void);
+extern void st_open (st_parameter_open *opp);
 export_proto(st_open);
 
 void
-st_open (void)
+st_open (st_parameter_open *opp)
 {
   unit_flags flags;
   gfc_unit *u = NULL;
+  GFC_INTEGER_4 cf = opp->common.flags;
  
-  library_start ();
+  library_start (&opp->common);
 
   /* Decode options.  */
 
-  flags.access = (ioparm.access == NULL) ? ACCESS_UNSPECIFIED :
-    find_option (ioparm.access, ioparm.access_len, access_opt,
-		 "Bad ACCESS parameter in OPEN statement");
+  flags.access = !(cf & IOPARM_OPEN_HAS_ACCESS) ? ACCESS_UNSPECIFIED :
+    find_option (&opp->common, opp->access, opp->access_len,
+		 access_opt, "Bad ACCESS parameter in OPEN statement");
 
-  flags.action = (ioparm.action == NULL) ? ACTION_UNSPECIFIED :
-    find_option (ioparm.action, ioparm.action_len, action_opt,
-		 "Bad ACTION parameter in OPEN statement");
+  flags.action = !(cf & IOPARM_OPEN_HAS_ACTION) ? ACTION_UNSPECIFIED :
+    find_option (&opp->common, opp->action, opp->action_len,
+		 action_opt, "Bad ACTION parameter in OPEN statement");
 
-  flags.blank = (ioparm.blank == NULL) ? BLANK_UNSPECIFIED :
-    find_option (ioparm.blank, ioparm.blank_len, blank_opt,
-		 "Bad BLANK parameter in OPEN statement");
+  flags.blank = !(cf & IOPARM_OPEN_HAS_BLANK) ? BLANK_UNSPECIFIED :
+    find_option (&opp->common, opp->blank, opp->blank_len,
+		 blank_opt, "Bad BLANK parameter in OPEN statement");
 
-  flags.delim = (ioparm.delim == NULL) ? DELIM_UNSPECIFIED :
-    find_option (ioparm.delim, ioparm.delim_len, delim_opt,
-		 "Bad DELIM parameter in OPEN statement");
+  flags.delim = !(cf & IOPARM_OPEN_HAS_DELIM) ? DELIM_UNSPECIFIED :
+    find_option (&opp->common, opp->delim, opp->delim_len,
+		 delim_opt, "Bad DELIM parameter in OPEN statement");
 
-  flags.pad = (ioparm.pad == NULL) ? PAD_UNSPECIFIED :
-    find_option (ioparm.pad, ioparm.pad_len, pad_opt,
-		 "Bad PAD parameter in OPEN statement");
+  flags.pad = !(cf & IOPARM_OPEN_HAS_PAD) ? PAD_UNSPECIFIED :
+    find_option (&opp->common, opp->pad, opp->pad_len,
+		 pad_opt, "Bad PAD parameter in OPEN statement");
 
-  flags.form = (ioparm.form == NULL) ? FORM_UNSPECIFIED :
-    find_option (ioparm.form, ioparm.form_len, form_opt,
-		 "Bad FORM parameter in OPEN statement");
+  flags.form = !(cf & IOPARM_OPEN_HAS_FORM) ? FORM_UNSPECIFIED :
+    find_option (&opp->common, opp->form, opp->form_len,
+		 form_opt, "Bad FORM parameter in OPEN statement");
 
-  flags.position = (ioparm.position == NULL) ? POSITION_UNSPECIFIED :
-    find_option (ioparm.position, ioparm.position_len, position_opt,
-		 "Bad POSITION parameter in OPEN statement");
+  flags.position = !(cf & IOPARM_OPEN_HAS_POSITION) ? POSITION_UNSPECIFIED :
+    find_option (&opp->common, opp->position, opp->position_len,
+		 position_opt, "Bad POSITION parameter in OPEN statement");
 
-  flags.status = (ioparm.status == NULL) ? STATUS_UNSPECIFIED :
-    find_option (ioparm.status, ioparm.status_len, status_opt,
-		 "Bad STATUS parameter in OPEN statement");
+  flags.status = !(cf & IOPARM_OPEN_HAS_STATUS) ? STATUS_UNSPECIFIED :
+    find_option (&opp->common, opp->status, opp->status_len,
+		 status_opt, "Bad STATUS parameter in OPEN statement");
 
-  if (ioparm.unit < 0)
-    generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement");
+  if (opp->common.unit < 0)
+    generate_error (&opp->common, ERROR_BAD_OPTION,
+		    "Bad unit number in OPEN statement");
 
   if (flags.position != POSITION_UNSPECIFIED
       && flags.access == ACCESS_DIRECT)
-    generate_error (ERROR_BAD_OPTION,
+    generate_error (&opp->common, ERROR_BAD_OPTION,
 		    "Cannot use POSITION with direct access files");
 
   if (flags.access == ACCESS_APPEND)
     {
       if (flags.position != POSITION_UNSPECIFIED
 	  && flags.position != POSITION_APPEND)
-	generate_error (ERROR_BAD_OPTION, "Conflicting ACCESS and POSITION "
-			"flags in OPEN statement");
-	
+	generate_error (&opp->common, ERROR_BAD_OPTION,
+			"Conflicting ACCESS and POSITION flags in"
+			" OPEN statement");
+
       notify_std (GFC_STD_GNU,
 		  "Extension: APPEND as a value for ACCESS in OPEN statement");
       flags.access = ACCESS_SEQUENTIAL;
@@ -503,18 +556,19 @@ st_open (void)
   if (flags.position == POSITION_UNSPECIFIED)
     flags.position = POSITION_ASIS;
 
-  if (ioparm.library_return != LIBRARY_OK)
-  {
-    library_end ();
-    return;
-  }
-
-  u = find_unit (ioparm.unit);
+  if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
+    {
+      u = find_or_create_unit (opp->common.unit);
 
-  if (u == NULL)
-    new_unit (&flags);
-  else
-    already_open (u, &flags);
+      if (u->s == NULL)
+	{
+	  u = new_unit (opp, u, &flags);
+	  if (u != NULL)
+	    unlock_unit (u);
+	}
+      else
+	already_open (opp, u, &flags);
+    }
 
   library_end ();
 }