OSDN Git Service

PR 43839
[pf3gnuchains/gcc-fork.git] / libgfortran / io / open.c
1 /* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008, 2009, 2010
2    Free Software Foundation, Inc.
3    Contributed by Andy Vaught
4    F2003 I/O support contributed by Jerry DeLisle
5
6 This file is part of the GNU Fortran runtime library (libgfortran).
7
8 Libgfortran is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3, or (at your option)
11 any later version.
12
13 Libgfortran is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 GNU General Public License for more details.
17
18 Under Section 7 of GPL version 3, you are granted additional
19 permissions described in the GCC Runtime Library Exception, version
20 3.1, as published by the Free Software Foundation.
21
22 You should have received a copy of the GNU General Public License and
23 a copy of the GCC Runtime Library Exception along with this program;
24 see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
25 <http://www.gnu.org/licenses/>.  */
26
27 #include "io.h"
28 #include "fbuf.h"
29 #include "unix.h"
30 #include <unistd.h>
31 #include <string.h>
32 #include <errno.h>
33 #include <stdlib.h>
34
35
36 static const st_option access_opt[] = {
37   {"sequential", ACCESS_SEQUENTIAL},
38   {"direct", ACCESS_DIRECT},
39   {"append", ACCESS_APPEND},
40   {"stream", ACCESS_STREAM},
41   {NULL, 0}
42 };
43
44 static const st_option action_opt[] =
45 {
46   { "read", ACTION_READ},
47   { "write", ACTION_WRITE},
48   { "readwrite", ACTION_READWRITE},
49   { NULL, 0}
50 };
51
52 static const st_option blank_opt[] =
53 {
54   { "null", BLANK_NULL},
55   { "zero", BLANK_ZERO},
56   { NULL, 0}
57 };
58
59 static const st_option delim_opt[] =
60 {
61   { "none", DELIM_NONE},
62   { "apostrophe", DELIM_APOSTROPHE},
63   { "quote", DELIM_QUOTE},
64   { NULL, 0}
65 };
66
67 static const st_option form_opt[] =
68 {
69   { "formatted", FORM_FORMATTED},
70   { "unformatted", FORM_UNFORMATTED},
71   { NULL, 0}
72 };
73
74 static const st_option position_opt[] =
75 {
76   { "asis", POSITION_ASIS},
77   { "rewind", POSITION_REWIND},
78   { "append", POSITION_APPEND},
79   { NULL, 0}
80 };
81
82 static const 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, 0}
90 };
91
92 static const st_option pad_opt[] =
93 {
94   { "yes", PAD_YES},
95   { "no", PAD_NO},
96   { NULL, 0}
97 };
98
99 static const st_option decimal_opt[] =
100 {
101   { "point", DECIMAL_POINT},
102   { "comma", DECIMAL_COMMA},
103   { NULL, 0}
104 };
105
106 static const st_option encoding_opt[] =
107 {
108   { "utf-8", ENCODING_UTF8},
109   { "default", ENCODING_DEFAULT},
110   { NULL, 0}
111 };
112
113 static const st_option round_opt[] =
114 {
115   { "up", ROUND_UP},
116   { "down", ROUND_DOWN},
117   { "zero", ROUND_ZERO},
118   { "nearest", ROUND_NEAREST},
119   { "compatible", ROUND_COMPATIBLE},
120   { "processor_defined", ROUND_PROCDEFINED},
121   { NULL, 0}
122 };
123
124 static const st_option sign_opt[] =
125 {
126   { "plus", SIGN_PLUS},
127   { "suppress", SIGN_SUPPRESS},
128   { "processor_defined", SIGN_PROCDEFINED},
129   { NULL, 0}
130 };
131
132 static const st_option convert_opt[] =
133 {
134   { "native", GFC_CONVERT_NATIVE},
135   { "swap", GFC_CONVERT_SWAP},
136   { "big_endian", GFC_CONVERT_BIG},
137   { "little_endian", GFC_CONVERT_LITTLE},
138   { NULL, 0}
139 };
140
141 static const st_option async_opt[] =
142 {
143   { "yes", ASYNC_YES},
144   { "no", ASYNC_NO},
145   { NULL, 0}
146 };
147
148 /* Given a unit, test to see if the file is positioned at the terminal
149    point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
150    This prevents us from changing the state from AFTER_ENDFILE to
151    AT_ENDFILE.  */
152
153 static void
154 test_endfile (gfc_unit * u)
155 {
156   if (u->endfile == NO_ENDFILE && file_length (u->s) == stell (u->s))
157     u->endfile = AT_ENDFILE;
158 }
159
160
161 /* Change the modes of a file, those that are allowed * to be
162    changed.  */
163
164 static void
165 edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
166 {
167   /* Complain about attempts to change the unchangeable.  */
168
169   if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD && 
170       u->flags.status != flags->status)
171     generate_error (&opp->common, LIBERROR_BAD_OPTION,
172                     "Cannot change STATUS parameter in OPEN statement");
173
174   if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access)
175     generate_error (&opp->common, LIBERROR_BAD_OPTION,
176                     "Cannot change ACCESS parameter in OPEN statement");
177
178   if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form)
179     generate_error (&opp->common, LIBERROR_BAD_OPTION,
180                     "Cannot change FORM parameter in OPEN statement");
181
182   if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)
183       && opp->recl_in != u->recl)
184     generate_error (&opp->common, LIBERROR_BAD_OPTION,
185                     "Cannot change RECL parameter in OPEN statement");
186
187   if (flags->action != ACTION_UNSPECIFIED && u->flags.action != flags->action)
188     generate_error (&opp->common, LIBERROR_BAD_OPTION,
189                     "Cannot change ACTION parameter in OPEN statement");
190
191   /* Status must be OLD if present.  */
192
193   if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD &&
194       flags->status != STATUS_UNKNOWN)
195     {
196       if (flags->status == STATUS_SCRATCH)
197         notify_std (&opp->common, GFC_STD_GNU,
198                     "OPEN statement must have a STATUS of OLD or UNKNOWN");
199       else
200         generate_error (&opp->common, LIBERROR_BAD_OPTION,
201                     "OPEN statement must have a STATUS of OLD or UNKNOWN");
202     }
203
204   if (u->flags.form == FORM_UNFORMATTED)
205     {
206       if (flags->delim != DELIM_UNSPECIFIED)
207         generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
208                         "DELIM parameter conflicts with UNFORMATTED form in "
209                         "OPEN statement");
210
211       if (flags->blank != BLANK_UNSPECIFIED)
212         generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
213                         "BLANK parameter conflicts with UNFORMATTED form in "
214                         "OPEN statement");
215
216       if (flags->pad != PAD_UNSPECIFIED)
217         generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
218                         "PAD parameter conflicts with UNFORMATTED form in "
219                         "OPEN statement");
220
221       if (flags->decimal != DECIMAL_UNSPECIFIED)
222         generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
223                         "DECIMAL parameter conflicts with UNFORMATTED form in "
224                         "OPEN statement");
225
226       if (flags->encoding != ENCODING_UNSPECIFIED)
227         generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
228                         "ENCODING parameter conflicts with UNFORMATTED form in "
229                         "OPEN statement");
230
231       if (flags->round != ROUND_UNSPECIFIED)
232         generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
233                         "ROUND parameter conflicts with UNFORMATTED form in "
234                         "OPEN statement");
235
236       if (flags->sign != SIGN_UNSPECIFIED)
237         generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
238                         "SIGN parameter conflicts with UNFORMATTED form in "
239                         "OPEN statement");
240     }
241
242   if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
243     {
244       /* Change the changeable:  */
245       if (flags->blank != BLANK_UNSPECIFIED)
246         u->flags.blank = flags->blank;
247       if (flags->delim != DELIM_UNSPECIFIED)
248         u->flags.delim = flags->delim;
249       if (flags->pad != PAD_UNSPECIFIED)
250         u->flags.pad = flags->pad;
251       if (flags->decimal != DECIMAL_UNSPECIFIED)
252         u->flags.decimal = flags->decimal;
253       if (flags->encoding != ENCODING_UNSPECIFIED)
254         u->flags.encoding = flags->encoding;
255       if (flags->async != ASYNC_UNSPECIFIED)
256         u->flags.async = flags->async;
257       if (flags->round != ROUND_UNSPECIFIED)
258         u->flags.round = flags->round;
259       if (flags->sign != SIGN_UNSPECIFIED)
260         u->flags.sign = flags->sign;
261     }
262
263   /* Reposition the file if necessary.  */
264
265   switch (flags->position)
266     {
267     case POSITION_UNSPECIFIED:
268     case POSITION_ASIS:
269       break;
270
271     case POSITION_REWIND:
272       if (sseek (u->s, 0, SEEK_SET) != 0)
273         goto seek_error;
274
275       u->current_record = 0;
276       u->last_record = 0;
277
278       test_endfile (u);
279       break;
280
281     case POSITION_APPEND:
282       if (sseek (u->s, 0, SEEK_END) < 0)
283         goto seek_error;
284
285       if (flags->access != ACCESS_STREAM)
286         u->current_record = 0;
287
288       u->endfile = AT_ENDFILE;  /* We are at the end.  */
289       break;
290
291     seek_error:
292       generate_error (&opp->common, LIBERROR_OS, NULL);
293       break;
294     }
295
296   unlock_unit (u);
297 }
298
299
300 /* Open an unused unit.  */
301
302 gfc_unit *
303 new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
304 {
305   gfc_unit *u2;
306   stream *s;
307   char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
308
309   /* Change unspecifieds to defaults.  Leave (flags->action ==
310      ACTION_UNSPECIFIED) alone so open_external() can set it based on
311      what type of open actually works.  */
312
313   if (flags->access == ACCESS_UNSPECIFIED)
314     flags->access = ACCESS_SEQUENTIAL;
315
316   if (flags->form == FORM_UNSPECIFIED)
317     flags->form = (flags->access == ACCESS_SEQUENTIAL)
318       ? FORM_FORMATTED : FORM_UNFORMATTED;
319
320   if (flags->async == ASYNC_UNSPECIFIED)
321     flags->async = ASYNC_NO;
322
323   if (flags->status == STATUS_UNSPECIFIED)
324     flags->status = STATUS_UNKNOWN;
325
326   /* Checks.  */
327
328   if (flags->delim == DELIM_UNSPECIFIED)
329     flags->delim = DELIM_NONE;
330   else
331     {
332       if (flags->form == FORM_UNFORMATTED)
333         {
334           generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
335                           "DELIM parameter conflicts with UNFORMATTED form in "
336                           "OPEN statement");
337           goto fail;
338         }
339     }
340
341   if (flags->blank == BLANK_UNSPECIFIED)
342     flags->blank = BLANK_NULL;
343   else
344     {
345       if (flags->form == FORM_UNFORMATTED)
346         {
347           generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
348                           "BLANK parameter conflicts with UNFORMATTED form in "
349                           "OPEN statement");
350           goto fail;
351         }
352     }
353
354   if (flags->pad == PAD_UNSPECIFIED)
355     flags->pad = PAD_YES;
356   else
357     {
358       if (flags->form == FORM_UNFORMATTED)
359         {
360           generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
361                           "PAD parameter conflicts with UNFORMATTED form in "
362                           "OPEN statement");
363           goto fail;
364         }
365     }
366
367   if (flags->decimal == DECIMAL_UNSPECIFIED)
368     flags->decimal = DECIMAL_POINT;
369   else
370     {
371       if (flags->form == FORM_UNFORMATTED)
372         {
373           generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
374                           "DECIMAL parameter conflicts with UNFORMATTED form "
375                           "in OPEN statement");
376           goto fail;
377         }
378     }
379
380   if (flags->encoding == ENCODING_UNSPECIFIED)
381     flags->encoding = ENCODING_DEFAULT;
382   else
383     {
384       if (flags->form == FORM_UNFORMATTED)
385         {
386           generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
387                           "ENCODING parameter conflicts with UNFORMATTED form in "
388                           "OPEN statement");
389           goto fail;
390         }
391     }
392
393   /* NB: the value for ROUND when it's not specified by the user does not
394          have to be PROCESSOR_DEFINED; the standard says that it is
395          processor dependent, and requires that it is one of the
396          possible value (see F2003, 9.4.5.13).  */
397   if (flags->round == ROUND_UNSPECIFIED)
398     flags->round = ROUND_PROCDEFINED;
399   else
400     {
401       if (flags->form == FORM_UNFORMATTED)
402         {
403           generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
404                           "ROUND parameter conflicts with UNFORMATTED form in "
405                           "OPEN statement");
406           goto fail;
407         }
408     }
409
410   if (flags->sign == SIGN_UNSPECIFIED)
411     flags->sign = SIGN_PROCDEFINED;
412   else
413     {
414       if (flags->form == FORM_UNFORMATTED)
415         {
416           generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
417                           "SIGN parameter conflicts with UNFORMATTED form in "
418                           "OPEN statement");
419           goto fail;
420         }
421     }
422
423   if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
424    {
425      generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
426                      "ACCESS parameter conflicts with SEQUENTIAL access in "
427                      "OPEN statement");
428      goto fail;
429    }
430   else
431    if (flags->position == POSITION_UNSPECIFIED)
432      flags->position = POSITION_ASIS;
433
434   if (flags->access == ACCESS_DIRECT
435       && (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0)
436     {
437       generate_error (&opp->common, LIBERROR_MISSING_OPTION,
438                       "Missing RECL parameter in OPEN statement");
439       goto fail;
440     }
441
442   if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in <= 0)
443     {
444       generate_error (&opp->common, LIBERROR_BAD_OPTION,
445                       "RECL parameter is non-positive in OPEN statement");
446       goto fail;
447     }
448
449   switch (flags->status)
450     {
451     case STATUS_SCRATCH:
452       if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0)
453         {
454           opp->file = NULL;
455           break;
456         }
457
458       generate_error (&opp->common, LIBERROR_BAD_OPTION,
459                       "FILE parameter must not be present in OPEN statement");
460       goto fail;
461
462     case STATUS_OLD:
463     case STATUS_NEW:
464     case STATUS_REPLACE:
465     case STATUS_UNKNOWN:
466       if ((opp->common.flags & IOPARM_OPEN_HAS_FILE))
467         break;
468
469       opp->file = tmpname;
470 #ifdef HAVE_SNPRINTF
471       opp->file_len = snprintf(opp->file, sizeof (tmpname), "fort.%d", 
472                                (int) opp->common.unit);
473 #else
474       opp->file_len = sprintf(opp->file, "fort.%d", (int) opp->common.unit);
475 #endif
476       break;
477
478     default:
479       internal_error (&opp->common, "new_unit(): Bad status");
480     }
481
482   /* Make sure the file isn't already open someplace else.
483      Do not error if opening file preconnected to stdin, stdout, stderr.  */
484
485   u2 = NULL;
486   if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) != 0)
487     u2 = find_file (opp->file, opp->file_len);
488   if (u2 != NULL
489       && (options.stdin_unit < 0 || u2->unit_number != options.stdin_unit)
490       && (options.stdout_unit < 0 || u2->unit_number != options.stdout_unit)
491       && (options.stderr_unit < 0 || u2->unit_number != options.stderr_unit))
492     {
493       unlock_unit (u2);
494       generate_error (&opp->common, LIBERROR_ALREADY_OPEN, NULL);
495       goto cleanup;
496     }
497
498   if (u2 != NULL)
499     unlock_unit (u2);
500
501   /* Open file.  */
502
503   s = open_external (opp, flags);
504   if (s == NULL)
505     {
506       char *path, *msg;
507       path = (char *) gfc_alloca (opp->file_len + 1);
508       msg = (char *) gfc_alloca (opp->file_len + 51);
509       unpack_filename (path, opp->file, opp->file_len);
510
511       switch (errno)
512         {
513         case ENOENT: 
514           sprintf (msg, "File '%s' does not exist", path);
515           break;
516
517         case EEXIST:
518           sprintf (msg, "File '%s' already exists", path);
519           break;
520
521         case EACCES:
522           sprintf (msg, "Permission denied trying to open file '%s'", path);
523           break;
524
525         case EISDIR:
526           sprintf (msg, "'%s' is a directory", path);
527           break;
528
529         default:
530           msg = NULL;
531         }
532
533       generate_error (&opp->common, LIBERROR_OS, msg);
534       goto cleanup;
535     }
536
537   if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE)
538     flags->status = STATUS_OLD;
539
540   /* Create the unit structure.  */
541
542   u->file = get_mem (opp->file_len);
543   if (u->unit_number != opp->common.unit)
544     internal_error (&opp->common, "Unit number changed");
545   u->s = s;
546   u->flags = *flags;
547   u->read_bad = 0;
548   u->endfile = NO_ENDFILE;
549   u->last_record = 0;
550   u->current_record = 0;
551   u->mode = READING;
552   u->maxrec = 0;
553   u->bytes_left = 0;
554   u->saved_pos = 0;
555
556   if (flags->position == POSITION_APPEND)
557     {
558       if (sseek (u->s, 0, SEEK_END) < 0)
559         generate_error (&opp->common, LIBERROR_OS, NULL);
560       u->endfile = AT_ENDFILE;
561     }
562
563   /* Unspecified recl ends up with a processor dependent value.  */
564
565   if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN))
566     {
567       u->flags.has_recl = 1;
568       u->recl = opp->recl_in;
569       u->recl_subrecord = u->recl;
570       u->bytes_left = u->recl;
571     }
572   else
573     {
574       u->flags.has_recl = 0;
575       u->recl = max_offset;
576       if (compile_options.max_subrecord_length)
577         {
578           u->recl_subrecord = compile_options.max_subrecord_length;
579         }
580       else
581         {
582           switch (compile_options.record_marker)
583             {
584             case 0:
585               /* Fall through */
586             case sizeof (GFC_INTEGER_4):
587               u->recl_subrecord = GFC_MAX_SUBRECORD_LENGTH;
588               break;
589
590             case sizeof (GFC_INTEGER_8):
591               u->recl_subrecord = max_offset - 16;
592               break;
593
594             default:
595               runtime_error ("Illegal value for record marker");
596               break;
597             }
598         }
599     }
600
601   /* If the file is direct access, calculate the maximum record number
602      via a division now instead of letting the multiplication overflow
603      later.  */
604
605   if (flags->access == ACCESS_DIRECT)
606     u->maxrec = max_offset / u->recl;
607   
608   if (flags->access == ACCESS_STREAM)
609     {
610       u->maxrec = max_offset;
611       u->recl = 1;
612       u->bytes_left = 1;
613       u->strm_pos = stell (u->s) + 1;
614     }
615
616   memmove (u->file, opp->file, opp->file_len);
617   u->file_len = opp->file_len;
618
619   /* Curiously, the standard requires that the
620      position specifier be ignored for new files so a newly connected
621      file starts out at the initial point.  We still need to figure
622      out if the file is at the end or not.  */
623
624   test_endfile (u);
625
626   if (flags->status == STATUS_SCRATCH && opp->file != NULL)
627     free (opp->file);
628     
629   if (flags->form == FORM_FORMATTED)
630     {
631       if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN))
632         fbuf_init (u, u->recl);
633       else
634         fbuf_init (u, 0);
635     }
636   else
637     u->fbuf = NULL;
638
639     
640     
641   return u;
642
643  cleanup:
644
645   /* Free memory associated with a temporary filename.  */
646
647   if (flags->status == STATUS_SCRATCH && opp->file != NULL)
648     free (opp->file);
649
650  fail:
651
652   close_unit (u);
653   return NULL;
654 }
655
656
657 /* Open a unit which is already open.  This involves changing the
658    modes or closing what is there now and opening the new file.  */
659
660 static void
661 already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
662 {
663   if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) == 0)
664     {
665       edit_modes (opp, u, flags);
666       return;
667     }
668
669   /* If the file is connected to something else, close it and open a
670      new unit.  */
671
672   if (!compare_file_filename (u, opp->file, opp->file_len))
673     {
674 #if !HAVE_UNLINK_OPEN_FILE
675       char *path = NULL;
676       if (u->file && u->flags.status == STATUS_SCRATCH)
677         {
678           path = (char *) gfc_alloca (u->file_len + 1);
679           unpack_filename (path, u->file, u->file_len);
680         }
681 #endif
682
683       if (sclose (u->s) == -1)
684         {
685           unlock_unit (u);
686           generate_error (&opp->common, LIBERROR_OS,
687                           "Error closing file in OPEN statement");
688           return;
689         }
690
691       u->s = NULL;
692       if (u->file)
693         free (u->file);
694       u->file = NULL;
695       u->file_len = 0;
696
697 #if !HAVE_UNLINK_OPEN_FILE
698       if (path != NULL)
699         unlink (path);
700 #endif
701
702       u = new_unit (opp, u, flags);
703       if (u != NULL)
704         unlock_unit (u);
705       return;
706     }
707
708   edit_modes (opp, u, flags);
709 }
710
711
712 /* Open file.  */
713
714 extern void st_open (st_parameter_open *opp);
715 export_proto(st_open);
716
717 void
718 st_open (st_parameter_open *opp)
719 {
720   unit_flags flags;
721   gfc_unit *u = NULL;
722   GFC_INTEGER_4 cf = opp->common.flags;
723   unit_convert conv;
724  
725   library_start (&opp->common);
726
727   /* Decode options.  */
728
729   flags.access = !(cf & IOPARM_OPEN_HAS_ACCESS) ? ACCESS_UNSPECIFIED :
730     find_option (&opp->common, opp->access, opp->access_len,
731                  access_opt, "Bad ACCESS parameter in OPEN statement");
732
733   flags.action = !(cf & IOPARM_OPEN_HAS_ACTION) ? ACTION_UNSPECIFIED :
734     find_option (&opp->common, opp->action, opp->action_len,
735                  action_opt, "Bad ACTION parameter in OPEN statement");
736
737   flags.blank = !(cf & IOPARM_OPEN_HAS_BLANK) ? BLANK_UNSPECIFIED :
738     find_option (&opp->common, opp->blank, opp->blank_len,
739                  blank_opt, "Bad BLANK parameter in OPEN statement");
740
741   flags.delim = !(cf & IOPARM_OPEN_HAS_DELIM) ? DELIM_UNSPECIFIED :
742     find_option (&opp->common, opp->delim, opp->delim_len,
743                  delim_opt, "Bad DELIM parameter in OPEN statement");
744
745   flags.pad = !(cf & IOPARM_OPEN_HAS_PAD) ? PAD_UNSPECIFIED :
746     find_option (&opp->common, opp->pad, opp->pad_len,
747                  pad_opt, "Bad PAD parameter in OPEN statement");
748
749   flags.decimal = !(cf & IOPARM_OPEN_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED :
750     find_option (&opp->common, opp->decimal, opp->decimal_len,
751                  decimal_opt, "Bad DECIMAL parameter in OPEN statement");
752
753   flags.encoding = !(cf & IOPARM_OPEN_HAS_ENCODING) ? ENCODING_UNSPECIFIED :
754     find_option (&opp->common, opp->encoding, opp->encoding_len,
755                  encoding_opt, "Bad ENCODING parameter in OPEN statement");
756
757   flags.async = !(cf & IOPARM_OPEN_HAS_ASYNCHRONOUS) ? ASYNC_UNSPECIFIED :
758     find_option (&opp->common, opp->asynchronous, opp->asynchronous_len,
759                  async_opt, "Bad ASYNCHRONOUS parameter in OPEN statement");
760
761   flags.round = !(cf & IOPARM_OPEN_HAS_ROUND) ? ROUND_UNSPECIFIED :
762     find_option (&opp->common, opp->round, opp->round_len,
763                  round_opt, "Bad ROUND parameter in OPEN statement");
764
765   flags.sign = !(cf & IOPARM_OPEN_HAS_SIGN) ? SIGN_UNSPECIFIED :
766     find_option (&opp->common, opp->sign, opp->sign_len,
767                  sign_opt, "Bad SIGN parameter in OPEN statement");
768
769   flags.form = !(cf & IOPARM_OPEN_HAS_FORM) ? FORM_UNSPECIFIED :
770     find_option (&opp->common, opp->form, opp->form_len,
771                  form_opt, "Bad FORM parameter in OPEN statement");
772
773   flags.position = !(cf & IOPARM_OPEN_HAS_POSITION) ? POSITION_UNSPECIFIED :
774     find_option (&opp->common, opp->position, opp->position_len,
775                  position_opt, "Bad POSITION parameter in OPEN statement");
776
777   flags.status = !(cf & IOPARM_OPEN_HAS_STATUS) ? STATUS_UNSPECIFIED :
778     find_option (&opp->common, opp->status, opp->status_len,
779                  status_opt, "Bad STATUS parameter in OPEN statement");
780
781   /* First, we check wether the convert flag has been set via environment
782      variable.  This overrides the convert tag in the open statement.  */
783
784   conv = get_unformatted_convert (opp->common.unit);
785
786   if (conv == GFC_CONVERT_NONE)
787     {
788       /* Nothing has been set by environment variable, check the convert tag.  */
789       if (cf & IOPARM_OPEN_HAS_CONVERT)
790         conv = find_option (&opp->common, opp->convert, opp->convert_len,
791                             convert_opt,
792                             "Bad CONVERT parameter in OPEN statement");
793       else
794         conv = compile_options.convert;
795     }
796   
797   /* We use big_endian, which is 0 on little-endian machines
798      and 1 on big-endian machines.  */
799   switch (conv)
800     {
801     case GFC_CONVERT_NATIVE:
802     case GFC_CONVERT_SWAP:
803       break;
804       
805     case GFC_CONVERT_BIG:
806       conv = big_endian ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP;
807       break;
808       
809     case GFC_CONVERT_LITTLE:
810       conv = big_endian ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE;
811       break;
812       
813     default:
814       internal_error (&opp->common, "Illegal value for CONVERT");
815       break;
816     }
817
818   flags.convert = conv;
819
820   if (!(opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT) && opp->common.unit < 0)
821     generate_error (&opp->common, LIBERROR_BAD_OPTION,
822                     "Bad unit number in OPEN statement");
823
824   if (flags.position != POSITION_UNSPECIFIED
825       && flags.access == ACCESS_DIRECT)
826     generate_error (&opp->common, LIBERROR_BAD_OPTION,
827                     "Cannot use POSITION with direct access files");
828
829   if (flags.access == ACCESS_APPEND)
830     {
831       if (flags.position != POSITION_UNSPECIFIED
832           && flags.position != POSITION_APPEND)
833         generate_error (&opp->common, LIBERROR_BAD_OPTION,
834                         "Conflicting ACCESS and POSITION flags in"
835                         " OPEN statement");
836
837       notify_std (&opp->common, GFC_STD_GNU,
838                   "Extension: APPEND as a value for ACCESS in OPEN statement");
839       flags.access = ACCESS_SEQUENTIAL;
840       flags.position = POSITION_APPEND;
841     }
842
843   if (flags.position == POSITION_UNSPECIFIED)
844     flags.position = POSITION_ASIS;
845
846   if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
847     {
848       if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT))
849         {
850           *opp->newunit = get_unique_unit_number(opp);
851           opp->common.unit = *opp->newunit;
852         }
853
854       u = find_or_create_unit (opp->common.unit);
855       if (u->s == NULL)
856         {
857           u = new_unit (opp, u, &flags);
858           if (u != NULL)
859             unlock_unit (u);
860         }
861       else
862         already_open (opp, u, &flags);
863     }
864
865   library_end ();
866 }