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