libgfortran/io/open.c

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