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
 328   if (find_file () != NULL)
 329     {
 330       generate_error (ERROR_ALREADY_OPEN, NULL);
 331       goto cleanup;
 332     }
 333
 334   /* Open file.  */
 335
 336   s = open_external (flags);
 337   if (s == NULL)
 338     {
 339       generate_error (ERROR_OS, NULL);
 340       goto cleanup;
 341     }
 342
 343   if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE)
 344     flags->status = STATUS_OLD;
 345
 346   /* Create the unit structure.  */
 347
 348   u = get_mem (sizeof (gfc_unit) + ioparm.file_len);
 349
 350   u->unit_number = ioparm.unit;
 351   u->s = s;
 352   u->flags = *flags;
 353
 354   /* Unspecified recl ends up with a processor dependent value.  */
 355
 356   u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : DEFAULT_RECL;
 357   u->last_record = 0;
 358   u->current_record = 0;
 359
 360   /* If the file is direct access, calculate the maximum record number
 361      via a division now instead of letting the multiplication overflow
 362      later.  */
 363
 364   if (flags->access == ACCESS_DIRECT)
 365     u->maxrec = g.max_offset / u->recl;
 366
 367   memmove (u->file, ioparm.file, ioparm.file_len);
 368   u->file_len = ioparm.file_len;
 369
 370   insert_unit (u);
 371
 372   /* The file is now connected.  Errors after this point leave the
 373      file connected.  Curiously, the standard requires that the
 374      position specifier be ignored for new files so a newly connected
 375      file starts out that the initial point.  We still need to figure
 376      out if the file is at the end or not.  */
 377
 378   test_endfile (u);
 379
 380  cleanup:
 381
 382   /* Free memory associated with a temporary filename.  */
 383
 384   if (flags->status == STATUS_SCRATCH)
 385     free_mem (ioparm.file);
 386 }
 387
 388
 389 /* Open a unit which is already open.  This involves changing the
 390    modes or closing what is there now and opening the new file.  */
 391
 392 static void
 393 already_open (gfc_unit * u, unit_flags * flags)
 394 {
 395   if (ioparm.file == NULL)
 396     {
 397       edit_modes (u, flags);
 398       return;
 399     }
 400
 401   /* If the file is connected to something else, close it and open a
 402      new unit.  */
 403
 404   if (!compare_file_filename (u->s, ioparm.file, ioparm.file_len))
 405     {
 406       if (close_unit (u))
 407         {
 408           generate_error (ERROR_OS, "Error closing file in OPEN statement");
 409           return;
 410         }
 411
 412       new_unit (flags);
 413       return;
 414     }
 415
 416   edit_modes (u, flags);
 417 }
 418
 419
 420 /* Open file.  */
 421
 422 extern void st_open (void);
 423 export_proto(st_open);
 424
 425 void
 426 st_open (void)
 427 {
 428   unit_flags flags;
 429   gfc_unit *u = NULL;
 430
 431   library_start ();
 432
 433   /* Decode options.  */
 434
 435   flags.access = (ioparm.access == NULL) ? ACCESS_UNSPECIFIED :
 436     find_option (ioparm.access, ioparm.access_len, access_opt,
 437                  "Bad ACCESS parameter in OPEN statement");
 438
 439   flags.action = (ioparm.action == NULL) ? ACTION_UNSPECIFIED :
 440     find_option (ioparm.action, ioparm.action_len, action_opt,
 441                  "Bad ACTION parameter in OPEN statement");
 442
 443   flags.blank = (ioparm.blank == NULL) ? BLANK_UNSPECIFIED :
 444     find_option (ioparm.blank, ioparm.blank_len, blank_opt,
 445                  "Bad BLANK parameter in OPEN statement");
 446
 447   flags.delim = (ioparm.delim == NULL) ? DELIM_UNSPECIFIED :
 448     find_option (ioparm.delim, ioparm.delim_len, delim_opt,
 449                  "Bad DELIM parameter in OPEN statement");
 450
 451   flags.pad = (ioparm.pad == NULL) ? PAD_UNSPECIFIED :
 452     find_option (ioparm.pad, ioparm.pad_len, pad_opt,
 453                  "Bad PAD parameter in OPEN statement");
 454
 455   flags.form = (ioparm.form == NULL) ? FORM_UNSPECIFIED :
 456     find_option (ioparm.form, ioparm.form_len, form_opt,
 457                  "Bad FORM parameter in OPEN statement");
 458
 459   flags.position = (ioparm.position == NULL) ? POSITION_UNSPECIFIED :
 460     find_option (ioparm.position, ioparm.position_len, position_opt,
 461                  "Bad POSITION parameter in OPEN statement");
 462
 463   flags.status = (ioparm.status == NULL) ? STATUS_UNSPECIFIED :
 464     find_option (ioparm.status, ioparm.status_len, status_opt,
 465                  "Bad STATUS parameter in OPEN statement");
 466
 467   if (ioparm.unit < 0)
 468     generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement");
 469
 470   if (flags.position != POSITION_UNSPECIFIED
 471       && flags.access == ACCESS_DIRECT)
 472     generate_error (ERROR_BAD_OPTION,
 473                     "Cannot use POSITION with direct access files");
 474
 475   if (flags.position == POSITION_UNSPECIFIED)
 476     flags.position = POSITION_ASIS;
 477
 478   if (ioparm.library_return != LIBRARY_OK)
 479     return;
 480
 481   u = find_unit (ioparm.unit);
 482
 483   if (u == NULL)
 484     new_unit (&flags);
 485   else
 486     already_open (u, &flags);
 487
 488   library_end ();
 489 }