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 }, action_opt[] =
  34 {
  35   {
  36   "read", ACTION_READ}
  37   ,
  38   {
  39   "write", ACTION_WRITE}
  40   ,
  41   {
  42   "readwrite", ACTION_READWRITE}
  43   ,
  44   {
  45   NULL}
  46 }
  47
  48 , blank_opt[] =
  49 {
  50   {
  51   "null", BLANK_NULL}
  52   ,
  53   {
  54   "zero", BLANK_ZERO}
  55   ,
  56   {
  57   NULL}
  58 }
  59
  60 , delim_opt[] =
  61 {
  62   {
  63   "none", DELIM_NONE}
  64   ,
  65   {
  66   "apostrophe", DELIM_APOSTROPHE}
  67   ,
  68   {
  69   "quote", DELIM_QUOTE}
  70   ,
  71   {
  72   NULL}
  73 }
  74
  75 , form_opt[] =
  76 {
  77   {
  78   "formatted", FORM_FORMATTED}
  79   ,
  80   {
  81   "unformatted", FORM_UNFORMATTED}
  82   ,
  83   {
  84   NULL}
  85 }
  86
  87 , position_opt[] =
  88 {
  89   {
  90   "asis", POSITION_ASIS}
  91   ,
  92   {
  93   "rewind", POSITION_REWIND}
  94   ,
  95   {
  96   "append", POSITION_APPEND}
  97   ,
  98   {
  99   NULL}
 100 }
 101
 102 , status_opt[] =
 103 {
 104   {
 105   "unknown", STATUS_UNKNOWN}
 106   ,
 107   {
 108   "old", STATUS_OLD}
 109   ,
 110   {
 111   "new", STATUS_NEW}
 112   ,
 113   {
 114   "replace", STATUS_REPLACE}
 115   ,
 116   {
 117   "scratch", STATUS_SCRATCH}
 118   ,
 119   {
 120   NULL}
 121 }
 122
 123 , pad_opt[] =
 124 {
 125   {
 126   "yes", PAD_YES}
 127   ,
 128   {
 129   "no", PAD_NO}
 130   ,
 131   {
 132   NULL}
 133 };
 134
 135
 136 /* Given a unit, test to see if the file is positioned at the terminal
 137    point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
 138    This prevents us from changing the state from AFTER_ENDFILE to
 139    AT_ENDFILE.  */
 140
 141 void
 142 test_endfile (gfc_unit * u)
 143 {
 144
 145   if (u->endfile == NO_ENDFILE && file_length (u->s) == file_position (u->s))
 146     u->endfile = AT_ENDFILE;
 147 }
 148
 149
 150 /* Change the modes of a file, those that are allowed * to be
 151    changed.  */
 152
 153 static void
 154 edit_modes (gfc_unit * u, unit_flags * flags)
 155 {
 156
 157   /* Complain about attempts to change the unchangeable.  */
 158
 159   if (flags->status != STATUS_UNSPECIFIED &&
 160       u->flags.status != flags->position)
 161     generate_error (ERROR_BAD_OPTION,
 162                     "Cannot change STATUS parameter in OPEN statement");
 163
 164   if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access)
 165     generate_error (ERROR_BAD_OPTION,
 166                     "Cannot change ACCESS parameter in OPEN statement");
 167
 168   if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form)
 169     generate_error (ERROR_BAD_OPTION,
 170                     "Cannot change FORM parameter in OPEN statement");
 171
 172   if (ioparm.recl_in != 0 && ioparm.recl_in != u->recl)
 173     generate_error (ERROR_BAD_OPTION,
 174                     "Cannot change RECL parameter in OPEN statement");
 175
 176   if (flags->action != ACTION_UNSPECIFIED && u->flags.access != flags->access)
 177     generate_error (ERROR_BAD_OPTION,
 178                     "Cannot change ACTION parameter in OPEN statement");
 179
 180   /* Status must be OLD if present.  */
 181
 182   if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD)
 183     generate_error (ERROR_BAD_OPTION,
 184                     "OPEN statement must have a STATUS of OLD");
 185
 186   if (u->flags.form == FORM_UNFORMATTED)
 187     {
 188       if (flags->delim != DELIM_UNSPECIFIED)
 189         generate_error (ERROR_OPTION_CONFLICT,
 190                         "DELIM parameter conflicts with UNFORMATTED form in "
 191                         "OPEN statement");
 192
 193       if (flags->blank != BLANK_UNSPECIFIED)
 194         generate_error (ERROR_OPTION_CONFLICT,
 195                         "BLANK parameter conflicts with UNFORMATTED form in "
 196                         "OPEN statement");
 197
 198       if (flags->pad != PAD_UNSPECIFIED)
 199         generate_error (ERROR_OPTION_CONFLICT,
 200                         "PAD paramter conflicts with UNFORMATTED form in "
 201                         "OPEN statement");
 202     }
 203
 204   if (ioparm.library_return == LIBRARY_OK)
 205     {
 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 /* 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 /* Open a unit which is already open.  This involves changing the
 429    modes or closing what is there now and opening the new file.  */
 430
 431 static void
 432 already_open (gfc_unit * u, unit_flags * flags)
 433 {
 434
 435   if (ioparm.file == NULL)
 436     {
 437       edit_modes (u, flags);
 438       return;
 439     }
 440
 441   /* If the file is connected to something else, close it and open a
 442      new unit.  */
 443
 444   if (!compare_file_filename (u->s, ioparm.file, ioparm.file_len))
 445     {
 446       if (close_unit (u))
 447         {
 448           generate_error (ERROR_OS, "Error closing file in OPEN statement");
 449           return;
 450         }
 451
 452       new_unit (flags);
 453       return;
 454     }
 455
 456   edit_modes (u, flags);
 457 }
 458
 459
 460 /* Open file.  */
 461
 462 void
 463 st_open (void)
 464 {
 465   unit_flags flags;
 466   gfc_unit *u = NULL;
 467
 468   library_start ();
 469
 470   /* Decode options.  */
 471
 472   flags.access = (ioparm.access == NULL) ? ACCESS_UNSPECIFIED :
 473     find_option (ioparm.access, ioparm.access_len, access_opt,
 474                  "Bad ACCESS parameter in OPEN statement");
 475
 476   flags.action = (ioparm.action == NULL) ? ACTION_UNSPECIFIED :
 477     find_option (ioparm.action, ioparm.action_len, action_opt,
 478                  "Bad ACTION parameter in OPEN statement");
 479
 480   flags.blank = (ioparm.blank == NULL) ? BLANK_UNSPECIFIED :
 481     find_option (ioparm.blank, ioparm.blank_len, blank_opt,
 482                  "Bad BLANK parameter in OPEN statement");
 483
 484   flags.delim = (ioparm.delim == NULL) ? DELIM_UNSPECIFIED :
 485     find_option (ioparm.delim, ioparm.delim_len, delim_opt,
 486                  "Bad DELIM parameter in OPEN statement");
 487
 488   flags.pad = (ioparm.pad == NULL) ? PAD_UNSPECIFIED :
 489     find_option (ioparm.pad, ioparm.pad_len, pad_opt,
 490                  "Bad PAD parameter in OPEN statement");
 491
 492   flags.form = (ioparm.form == NULL) ? FORM_UNSPECIFIED :
 493     find_option (ioparm.form, ioparm.form_len, form_opt,
 494                  "Bad FORM parameter in OPEN statement");
 495
 496   flags.position = (ioparm.position == NULL) ? POSITION_UNSPECIFIED :
 497     find_option (ioparm.position, ioparm.position_len, position_opt,
 498                  "Bad POSITION parameter in OPEN statement");
 499
 500   flags.status = (ioparm.status == NULL) ? STATUS_UNSPECIFIED :
 501     find_option (ioparm.status, ioparm.status_len, status_opt,
 502                  "Bad STATUS parameter in OPEN statement");
 503
 504   if (ioparm.unit < 0)
 505     generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement");
 506
 507   if (flags.position != POSITION_UNSPECIFIED
 508       && flags.access == ACCESS_DIRECT)
 509     generate_error (ERROR_BAD_OPTION,
 510                     "Cannot use POSITION with direct access files");
 511
 512   if (flags.position == POSITION_UNSPECIFIED)
 513     flags.position = POSITION_ASIS;
 514
 515   if (ioparm.library_return != LIBRARY_OK)
 516     return;
 517
 518   u = find_unit (ioparm.unit);
 519
 520   if (u == NULL)
 521     new_unit (&flags);
 522   else
 523     already_open (u, &flags);
 524
 525   library_end ();
 526 }