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