libgfortran/io/open.c

   1 /* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
   2    Contributed by Andy Vaught
   3
   4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
   5
   6 Libgfortran is free software; you can redistribute it and/or modify
   7 it under the terms of the GNU General Public License as published by
   8 the Free Software Foundation; either version 2, or (at your option)
   9 any later version.
  10
  11 In addition to the permissions in the GNU General Public License, the
  12 Free Software Foundation gives you unlimited permission to link the
  13 compiled version of this file into combinations with other programs,
  14 and to distribute those combinations without any restriction coming
  15 from the use of this file.  (The General Public License restrictions
  16 do apply in other respects; for example, they cover modification of
  17 the file, and distribution when not linked into a combine
  18 executable.)
  19
  20 Libgfortran is distributed in the hope that it will be useful,
  21 but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 GNU General Public License for more details.
  24
  25 You should have received a copy of the GNU General Public License
  26 along with Libgfortran; see the file COPYING.  If not, write to
  27 the Free Software Foundation, 59 Temple Place - Suite 330,
  28 Boston, MA 02111-1307, USA.  */
  29
  30 #include "config.h"
  31 #include <unistd.h>
  32 #include <stdio.h>
  33 #include <string.h>
  34 #include "libgfortran.h"
  35 #include "io.h"
  36
  37
  38 static st_option access_opt[] = {
  39   {"sequential", ACCESS_SEQUENTIAL},
  40   {"direct", ACCESS_DIRECT},
  41   {NULL}
  42 };
  43
  44 static st_option action_opt[] =
  45 {
  46   { "read", ACTION_READ},
  47   { "write", ACTION_WRITE},
  48   { "readwrite", ACTION_READWRITE},
  49   { NULL}
  50 };
  51
  52 static st_option blank_opt[] =
  53 {
  54   { "null", BLANK_NULL},
  55   { "zero", BLANK_ZERO},
  56   { NULL}
  57 };
  58
  59 static st_option delim_opt[] =
  60 {
  61   { "none", DELIM_NONE},
  62   { "apostrophe", DELIM_APOSTROPHE},
  63   { "quote", DELIM_QUOTE},
  64   { NULL}
  65 };
  66
  67 static st_option form_opt[] =
  68 {
  69   { "formatted", FORM_FORMATTED},
  70   { "unformatted", FORM_UNFORMATTED},
  71   { NULL}
  72 };
  73
  74 static st_option position_opt[] =
  75 {
  76   { "asis", POSITION_ASIS},
  77   { "rewind", POSITION_REWIND},
  78   { "append", POSITION_APPEND},
  79   { NULL}
  80 };
  81
  82 static st_option status_opt[] =
  83 {
  84   { "unknown", STATUS_UNKNOWN},
  85   { "old", STATUS_OLD},
  86   { "new", STATUS_NEW},
  87   { "replace", STATUS_REPLACE},
  88   { "scratch", STATUS_SCRATCH},
  89   { NULL}
  90 };
  91
  92 static st_option pad_opt[] =
  93 {
  94   { "yes", PAD_YES},
  95   { "no", PAD_NO},
  96   { NULL}
  97 };
  98
  99
 100 /* Given a unit, test to see if the file is positioned at the terminal
 101    point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
 102    This prevents us from changing the state from AFTER_ENDFILE to
 103    AT_ENDFILE.  */
 104
 105 void
 106 test_endfile (gfc_unit * u)
 107 {
 108   if (u->endfile == NO_ENDFILE && file_length (u->s) == file_position (u->s))
 109     u->endfile = AT_ENDFILE;
 110 }
 111
 112
 113 /* Change the modes of a file, those that are allowed * to be
 114    changed.  */
 115
 116 static void
 117 edit_modes (gfc_unit * u, unit_flags * flags)
 118 {
 119   /* Complain about attempts to change the unchangeable.  */
 120
 121   if (flags->status != STATUS_UNSPECIFIED &&
 122       u->flags.status != flags->position)
 123     generate_error (ERROR_BAD_OPTION,
 124                     "Cannot change STATUS parameter in OPEN statement");
 125
 126   if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access)
 127     generate_error (ERROR_BAD_OPTION,
 128                     "Cannot change ACCESS parameter in OPEN statement");
 129
 130   if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form)
 131     generate_error (ERROR_BAD_OPTION,
 132                     "Cannot change FORM parameter in OPEN statement");
 133
 134   if (ioparm.recl_in != 0 && ioparm.recl_in != u->recl)
 135     generate_error (ERROR_BAD_OPTION,
 136                     "Cannot change RECL parameter in OPEN statement");
 137
 138   if (flags->action != ACTION_UNSPECIFIED && u->flags.access != flags->access)
 139     generate_error (ERROR_BAD_OPTION,
 140                     "Cannot change ACTION parameter in OPEN statement");
 141
 142   /* Status must be OLD if present.  */
 143
 144   if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD)
 145     generate_error (ERROR_BAD_OPTION,
 146                     "OPEN statement must have a STATUS of OLD");
 147
 148   if (u->flags.form == FORM_UNFORMATTED)
 149     {
 150       if (flags->delim != DELIM_UNSPECIFIED)
 151         generate_error (ERROR_OPTION_CONFLICT,
 152                         "DELIM parameter conflicts with UNFORMATTED form in "
 153                         "OPEN statement");
 154
 155       if (flags->blank != BLANK_UNSPECIFIED)
 156         generate_error (ERROR_OPTION_CONFLICT,
 157                         "BLANK parameter conflicts with UNFORMATTED form in "
 158                         "OPEN statement");
 159
 160       if (flags->pad != PAD_UNSPECIFIED)
 161         generate_error (ERROR_OPTION_CONFLICT,
 162                         "PAD paramter conflicts with UNFORMATTED form in "
 163                         "OPEN statement");
 164     }
 165
 166   if (ioparm.library_return == LIBRARY_OK)
 167     {
 168       /* Change the changeable:  */
 169       if (flags->blank != BLANK_UNSPECIFIED)
 170         u->flags.blank = flags->blank;
 171       if (flags->delim != DELIM_UNSPECIFIED)
 172         u->flags.delim = flags->delim;
 173       if (flags->pad != PAD_UNSPECIFIED)
 174         u->flags.pad = flags->pad;
 175     }
 176
 177   /* Reposition the file if necessary.  */
 178
 179   switch (flags->position)
 180     {
 181     case POSITION_UNSPECIFIED:
 182     case POSITION_ASIS:
 183       break;
 184
 185     case POSITION_REWIND:
 186       if (sseek (u->s, 0) == FAILURE)
 187         goto seek_error;
 188
 189       u->current_record = 0;
 190       u->last_record = 0;
 191
 192       test_endfile (u);         /* We might be at the end.  */
 193       break;
 194
 195     case POSITION_APPEND:
 196       if (sseek (u->s, file_length (u->s)) == FAILURE)
 197         goto seek_error;
 198
 199       u->current_record = 0;
 200       u->endfile = AT_ENDFILE;  /* We are at the end.  */
 201       break;
 202
 203     seek_error:
 204       generate_error (ERROR_OS, NULL);
 205       break;
 206     }
 207 }
 208
 209
 210 /* Open an unused unit.  */
 211
 212 void
 213 new_unit (unit_flags * flags)
 214 {
 215   gfc_unit *u;
 216   stream *s;
 217   char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
 218
 219   /* Change unspecifieds to defaults.  Leave (flags->action ==
 220      ACTION_UNSPECIFIED) alone so open_external() can set it based on
 221      what type of open actually works.  */
 222
 223   if (flags->access == ACCESS_UNSPECIFIED)
 224     flags->access = ACCESS_SEQUENTIAL;
 225
 226   if (flags->form == FORM_UNSPECIFIED)
 227     flags->form = (flags->access == ACCESS_SEQUENTIAL)
 228       ? FORM_FORMATTED : FORM_UNFORMATTED;
 229
 230
 231   if (flags->delim == DELIM_UNSPECIFIED)
 232     flags->delim = DELIM_NONE;
 233   else
 234     {
 235       if (flags->form == FORM_UNFORMATTED)
 236         {
 237           generate_error (ERROR_OPTION_CONFLICT,
 238                           "DELIM parameter conflicts with UNFORMATTED form in "
 239                           "OPEN statement");
 240           goto cleanup;
 241         }
 242     }
 243
 244   if (flags->blank == BLANK_UNSPECIFIED)
 245     flags->blank = BLANK_NULL;
 246   else
 247     {
 248       if (flags->form == FORM_UNFORMATTED)
 249         {
 250           generate_error (ERROR_OPTION_CONFLICT,
 251                           "BLANK parameter conflicts with UNFORMATTED form in "
 252                           "OPEN statement");
 253           goto cleanup;
 254         }
 255     }
 256
 257   if (flags->pad == PAD_UNSPECIFIED)
 258     flags->pad = PAD_YES;
 259   else
 260     {
 261       if (flags->form == FORM_UNFORMATTED)
 262         {
 263           generate_error (ERROR_OPTION_CONFLICT,
 264                           "PAD paramter conflicts with UNFORMATTED form in "
 265                           "OPEN statement");
 266           goto cleanup;
 267         }
 268     }
 269
 270   if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
 271    {
 272      generate_error (ERROR_OPTION_CONFLICT,
 273                      "ACCESS parameter conflicts with SEQUENTIAL access in "
 274                      "OPEN statement");
 275      goto cleanup;
 276    }
 277   else
 278    if (flags->position == POSITION_UNSPECIFIED)
 279      flags->position = POSITION_ASIS;
 280
 281
 282   if (flags->status == STATUS_UNSPECIFIED)
 283     flags->status = STATUS_UNKNOWN;
 284
 285   /* Checks.  */
 286
 287   if (flags->access == ACCESS_DIRECT && ioparm.recl_in == 0)
 288     {
 289       generate_error (ERROR_MISSING_OPTION,
 290                       "Missing RECL parameter in OPEN statement");
 291       goto cleanup;
 292     }
 293
 294   if (ioparm.recl_in != 0 && ioparm.recl_in <= 0)
 295     {
 296       generate_error (ERROR_BAD_OPTION,
 297                       "RECL parameter is non-positive in OPEN statement");
 298       goto cleanup;
 299     }
 300
 301   switch (flags->status)
 302     {
 303     case STATUS_SCRATCH:
 304       if (ioparm.file == NULL)
 305         break;
 306
 307       generate_error (ERROR_BAD_OPTION,
 308                       "FILE parameter must not be present in OPEN statement");
 309       return;
 310
 311     case STATUS_OLD:
 312     case STATUS_NEW:
 313     case STATUS_REPLACE:
 314     case STATUS_UNKNOWN:
 315       if (ioparm.file != NULL)
 316         break;
 317
 318       ioparm.file = tmpname;
 319       ioparm.file_len = sprintf(ioparm.file, "fort.%d", ioparm.unit);
 320       break;
 321
 322     default:
 323       internal_error ("new_unit(): Bad status");
 324     }
 325
 326   /* Make sure the file isn't already open someplace else.
 327      Do not error if opening file preconnected to stdin, stdout, stderr.  */
 328
 329   u = find_file ();
 330   if (u != NULL
 331       && (options.stdin_unit < 0 || u->unit_number != options.stdin_unit)
 332       && (options.stdout_unit < 0 || u->unit_number != options.stdout_unit)
 333       && (options.stderr_unit < 0 || u->unit_number != options.stderr_unit))
 334     {
 335       generate_error (ERROR_ALREADY_OPEN, NULL);
 336       goto cleanup;
 337     }
 338
 339   /* Open file.  */
 340
 341   s = open_external (flags);
 342   if (s == NULL)
 343     {
 344       generate_error (ERROR_OS, NULL);
 345       goto cleanup;
 346     }
 347
 348   if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE)
 349     flags->status = STATUS_OLD;
 350
 351   /* Create the unit structure.  */
 352
 353   u = get_mem (sizeof (gfc_unit) + ioparm.file_len);
 354   memset (u, '\0', sizeof (gfc_unit) + ioparm.file_len);
 355
 356   u->unit_number = ioparm.unit;
 357   u->s = s;
 358   u->flags = *flags;
 359
 360   if (flags->position == POSITION_APPEND)
 361   {
 362     if (sseek (u->s, file_length (u->s)) == FAILURE)
 363       generate_error (ERROR_OS, NULL);
 364     u->endfile = AT_ENDFILE;
 365   }
 366
 367   /* Unspecified recl ends up with a processor dependent value.  */
 368
 369   u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : g.max_offset;
 370   u->last_record = 0;
 371   u->current_record = 0;
 372
 373   /* If the file is direct access, calculate the maximum record number
 374      via a division now instead of letting the multiplication overflow
 375      later.  */
 376
 377   if (flags->access == ACCESS_DIRECT)
 378     u->maxrec = g.max_offset / u->recl;
 379
 380   memmove (u->file, ioparm.file, ioparm.file_len);
 381   u->file_len = ioparm.file_len;
 382
 383   insert_unit (u);
 384
 385   /* The file is now connected.  Errors after this point leave the
 386      file connected.  Curiously, the standard requires that the
 387      position specifier be ignored for new files so a newly connected
 388      file starts out that the initial point.  We still need to figure
 389      out if the file is at the end or not.  */
 390
 391   test_endfile (u);
 392
 393  cleanup:
 394
 395   /* Free memory associated with a temporary filename.  */
 396
 397   if (flags->status == STATUS_SCRATCH)
 398     free_mem (ioparm.file);
 399 }
 400
 401
 402 /* Open a unit which is already open.  This involves changing the
 403    modes or closing what is there now and opening the new file.  */
 404
 405 static void
 406 already_open (gfc_unit * u, unit_flags * flags)
 407 {
 408   if (ioparm.file == NULL)
 409     {
 410       edit_modes (u, flags);
 411       return;
 412     }
 413
 414   /* If the file is connected to something else, close it and open a
 415      new unit.  */
 416
 417   if (!compare_file_filename (u->s, ioparm.file, ioparm.file_len))
 418     {
 419       if (close_unit (u))
 420         {
 421           generate_error (ERROR_OS, "Error closing file in OPEN statement");
 422           return;
 423         }
 424
 425       new_unit (flags);
 426       return;
 427     }
 428
 429   edit_modes (u, flags);
 430 }
 431
 432
 433 /* Open file.  */
 434
 435 extern void st_open (void);
 436 export_proto(st_open);
 437
 438 void
 439 st_open (void)
 440 {
 441   unit_flags flags;
 442   gfc_unit *u = NULL;
 443
 444   library_start ();
 445
 446   /* Decode options.  */
 447
 448   flags.access = (ioparm.access == NULL) ? ACCESS_UNSPECIFIED :
 449     find_option (ioparm.access, ioparm.access_len, access_opt,
 450                  "Bad ACCESS parameter in OPEN statement");
 451
 452   flags.action = (ioparm.action == NULL) ? ACTION_UNSPECIFIED :
 453     find_option (ioparm.action, ioparm.action_len, action_opt,
 454                  "Bad ACTION parameter in OPEN statement");
 455
 456   flags.blank = (ioparm.blank == NULL) ? BLANK_UNSPECIFIED :
 457     find_option (ioparm.blank, ioparm.blank_len, blank_opt,
 458                  "Bad BLANK parameter in OPEN statement");
 459
 460   flags.delim = (ioparm.delim == NULL) ? DELIM_UNSPECIFIED :
 461     find_option (ioparm.delim, ioparm.delim_len, delim_opt,
 462                  "Bad DELIM parameter in OPEN statement");
 463
 464   flags.pad = (ioparm.pad == NULL) ? PAD_UNSPECIFIED :
 465     find_option (ioparm.pad, ioparm.pad_len, pad_opt,
 466                  "Bad PAD parameter in OPEN statement");
 467
 468   flags.form = (ioparm.form == NULL) ? FORM_UNSPECIFIED :
 469     find_option (ioparm.form, ioparm.form_len, form_opt,
 470                  "Bad FORM parameter in OPEN statement");
 471
 472   flags.position = (ioparm.position == NULL) ? POSITION_UNSPECIFIED :
 473     find_option (ioparm.position, ioparm.position_len, position_opt,
 474                  "Bad POSITION parameter in OPEN statement");
 475
 476   flags.status = (ioparm.status == NULL) ? STATUS_UNSPECIFIED :
 477     find_option (ioparm.status, ioparm.status_len, status_opt,
 478                  "Bad STATUS parameter in OPEN statement");
 479
 480   if (ioparm.unit < 0)
 481     generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement");
 482
 483   if (flags.position != POSITION_UNSPECIFIED
 484       && flags.access == ACCESS_DIRECT)
 485     generate_error (ERROR_BAD_OPTION,
 486                     "Cannot use POSITION with direct access files");
 487
 488   if (flags.position == POSITION_UNSPECIFIED)
 489     flags.position = POSITION_ASIS;
 490
 491   if (ioparm.library_return != LIBRARY_OK)
 492   {
 493     library_end ();
 494     return;
 495   }
 496
 497   u = find_unit (ioparm.unit);
 498
 499   if (u == NULL)
 500     new_unit (&flags);
 501   else
 502     already_open (u, &flags);
 503
 504   library_end ();
 505 }