libgfortran/io/open.c

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