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 ();
 }