1 /* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008, 2009, 2010, 2011, 2012
2 Free Software Foundation, Inc.
3 Contributed by Andy Vaught
4 F2003 I/O support contributed by Jerry DeLisle
6 This file is part of the GNU Fortran runtime library (libgfortran).
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)
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.
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.
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/>. */
36 static const st_option access_opt
[] = {
37 {"sequential", ACCESS_SEQUENTIAL
},
38 {"direct", ACCESS_DIRECT
},
39 {"append", ACCESS_APPEND
},
40 {"stream", ACCESS_STREAM
},
44 static const st_option action_opt
[] =
46 { "read", ACTION_READ
},
47 { "write", ACTION_WRITE
},
48 { "readwrite", ACTION_READWRITE
},
52 static const st_option blank_opt
[] =
54 { "null", BLANK_NULL
},
55 { "zero", BLANK_ZERO
},
59 static const st_option delim_opt
[] =
61 { "none", DELIM_NONE
},
62 { "apostrophe", DELIM_APOSTROPHE
},
63 { "quote", DELIM_QUOTE
},
67 static const st_option form_opt
[] =
69 { "formatted", FORM_FORMATTED
},
70 { "unformatted", FORM_UNFORMATTED
},
74 static const st_option position_opt
[] =
76 { "asis", POSITION_ASIS
},
77 { "rewind", POSITION_REWIND
},
78 { "append", POSITION_APPEND
},
82 static const st_option status_opt
[] =
84 { "unknown", STATUS_UNKNOWN
},
87 { "replace", STATUS_REPLACE
},
88 { "scratch", STATUS_SCRATCH
},
92 static const st_option pad_opt
[] =
99 static const st_option decimal_opt
[] =
101 { "point", DECIMAL_POINT
},
102 { "comma", DECIMAL_COMMA
},
106 static const st_option encoding_opt
[] =
108 { "utf-8", ENCODING_UTF8
},
109 { "default", ENCODING_DEFAULT
},
113 static const st_option round_opt
[] =
116 { "down", ROUND_DOWN
},
117 { "zero", ROUND_ZERO
},
118 { "nearest", ROUND_NEAREST
},
119 { "compatible", ROUND_COMPATIBLE
},
120 { "processor_defined", ROUND_PROCDEFINED
},
124 static const st_option sign_opt
[] =
126 { "plus", SIGN_PLUS
},
127 { "suppress", SIGN_SUPPRESS
},
128 { "processor_defined", SIGN_PROCDEFINED
},
132 static const st_option convert_opt
[] =
134 { "native", GFC_CONVERT_NATIVE
},
135 { "swap", GFC_CONVERT_SWAP
},
136 { "big_endian", GFC_CONVERT_BIG
},
137 { "little_endian", GFC_CONVERT_LITTLE
},
141 static const st_option async_opt
[] =
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
154 test_endfile (gfc_unit
* u
)
156 if (u
->endfile
== NO_ENDFILE
&& ssize (u
->s
) == stell (u
->s
))
157 u
->endfile
= AT_ENDFILE
;
161 /* Change the modes of a file, those that are allowed * to be
165 edit_modes (st_parameter_open
*opp
, gfc_unit
* u
, unit_flags
* flags
)
167 /* Complain about attempts to change the unchangeable. */
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");
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");
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");
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");
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");
191 /* Status must be OLD if present. */
193 if (flags
->status
!= STATUS_UNSPECIFIED
&& flags
->status
!= STATUS_OLD
&&
194 flags
->status
!= STATUS_UNKNOWN
)
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");
200 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
201 "OPEN statement must have a STATUS of OLD or UNKNOWN");
204 if (u
->flags
.form
== FORM_UNFORMATTED
)
206 if (flags
->delim
!= DELIM_UNSPECIFIED
)
207 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
208 "DELIM parameter conflicts with UNFORMATTED form in "
211 if (flags
->blank
!= BLANK_UNSPECIFIED
)
212 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
213 "BLANK parameter conflicts with UNFORMATTED form in "
216 if (flags
->pad
!= PAD_UNSPECIFIED
)
217 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
218 "PAD parameter conflicts with UNFORMATTED form in "
221 if (flags
->decimal
!= DECIMAL_UNSPECIFIED
)
222 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
223 "DECIMAL parameter conflicts with UNFORMATTED form in "
226 if (flags
->encoding
!= ENCODING_UNSPECIFIED
)
227 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
228 "ENCODING parameter conflicts with UNFORMATTED form in "
231 if (flags
->round
!= ROUND_UNSPECIFIED
)
232 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
233 "ROUND parameter conflicts with UNFORMATTED form in "
236 if (flags
->sign
!= SIGN_UNSPECIFIED
)
237 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
238 "SIGN parameter conflicts with UNFORMATTED form in "
242 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
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
;
263 /* Reposition the file if necessary. */
265 switch (flags
->position
)
267 case POSITION_UNSPECIFIED
:
271 case POSITION_REWIND
:
272 if (sseek (u
->s
, 0, SEEK_SET
) != 0)
275 u
->current_record
= 0;
281 case POSITION_APPEND
:
282 if (sseek (u
->s
, 0, SEEK_END
) < 0)
285 if (flags
->access
!= ACCESS_STREAM
)
286 u
->current_record
= 0;
288 u
->endfile
= AT_ENDFILE
; /* We are at the end. */
292 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
300 /* Open an unused unit. */
303 new_unit (st_parameter_open
*opp
, gfc_unit
*u
, unit_flags
* flags
)
307 char tmpname
[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
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. */
313 if (flags
->access
== ACCESS_UNSPECIFIED
)
314 flags
->access
= ACCESS_SEQUENTIAL
;
316 if (flags
->form
== FORM_UNSPECIFIED
)
317 flags
->form
= (flags
->access
== ACCESS_SEQUENTIAL
)
318 ? FORM_FORMATTED
: FORM_UNFORMATTED
;
320 if (flags
->async
== ASYNC_UNSPECIFIED
)
321 flags
->async
= ASYNC_NO
;
323 if (flags
->status
== STATUS_UNSPECIFIED
)
324 flags
->status
= STATUS_UNKNOWN
;
328 if (flags
->delim
== DELIM_UNSPECIFIED
)
329 flags
->delim
= DELIM_NONE
;
332 if (flags
->form
== FORM_UNFORMATTED
)
334 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
335 "DELIM parameter conflicts with UNFORMATTED form in "
341 if (flags
->blank
== BLANK_UNSPECIFIED
)
342 flags
->blank
= BLANK_NULL
;
345 if (flags
->form
== FORM_UNFORMATTED
)
347 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
348 "BLANK parameter conflicts with UNFORMATTED form in "
354 if (flags
->pad
== PAD_UNSPECIFIED
)
355 flags
->pad
= PAD_YES
;
358 if (flags
->form
== FORM_UNFORMATTED
)
360 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
361 "PAD parameter conflicts with UNFORMATTED form in "
367 if (flags
->decimal
== DECIMAL_UNSPECIFIED
)
368 flags
->decimal
= DECIMAL_POINT
;
371 if (flags
->form
== FORM_UNFORMATTED
)
373 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
374 "DECIMAL parameter conflicts with UNFORMATTED form "
375 "in OPEN statement");
380 if (flags
->encoding
== ENCODING_UNSPECIFIED
)
381 flags
->encoding
= ENCODING_DEFAULT
;
384 if (flags
->form
== FORM_UNFORMATTED
)
386 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
387 "ENCODING parameter conflicts with UNFORMATTED form in "
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
;
401 if (flags
->form
== FORM_UNFORMATTED
)
403 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
404 "ROUND parameter conflicts with UNFORMATTED form in "
410 if (flags
->sign
== SIGN_UNSPECIFIED
)
411 flags
->sign
= SIGN_PROCDEFINED
;
414 if (flags
->form
== FORM_UNFORMATTED
)
416 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
417 "SIGN parameter conflicts with UNFORMATTED form in "
423 if (flags
->position
!= POSITION_ASIS
&& flags
->access
== ACCESS_DIRECT
)
425 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
426 "ACCESS parameter conflicts with SEQUENTIAL access in "
431 if (flags
->position
== POSITION_UNSPECIFIED
)
432 flags
->position
= POSITION_ASIS
;
434 if (flags
->access
== ACCESS_DIRECT
435 && (opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) == 0)
437 generate_error (&opp
->common
, LIBERROR_MISSING_OPTION
,
438 "Missing RECL parameter in OPEN statement");
442 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) && opp
->recl_in
<= 0)
444 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
445 "RECL parameter is non-positive in OPEN statement");
449 switch (flags
->status
)
452 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
458 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
459 "FILE parameter must not be present in OPEN statement");
466 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
))
470 opp
->file_len
= snprintf(opp
->file
, sizeof (tmpname
), "fort.%d",
471 (int) opp
->common
.unit
);
475 internal_error (&opp
->common
, "new_unit(): Bad status");
478 /* Make sure the file isn't already open someplace else.
479 Do not error if opening file preconnected to stdin, stdout, stderr. */
482 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) != 0)
483 u2
= find_file (opp
->file
, opp
->file_len
);
485 && (options
.stdin_unit
< 0 || u2
->unit_number
!= options
.stdin_unit
)
486 && (options
.stdout_unit
< 0 || u2
->unit_number
!= options
.stdout_unit
)
487 && (options
.stderr_unit
< 0 || u2
->unit_number
!= options
.stderr_unit
))
490 generate_error (&opp
->common
, LIBERROR_ALREADY_OPEN
, NULL
);
499 s
= open_external (opp
, flags
);
504 path
= (char *) gfc_alloca (opp
->file_len
+ 1);
505 msglen
= opp
->file_len
+ 51;
506 msg
= (char *) gfc_alloca (msglen
);
507 unpack_filename (path
, opp
->file
, opp
->file_len
);
512 snprintf (msg
, msglen
, "File '%s' does not exist", path
);
516 snprintf (msg
, msglen
, "File '%s' already exists", path
);
520 snprintf (msg
, msglen
,
521 "Permission denied trying to open file '%s'", path
);
525 snprintf (msg
, msglen
, "'%s' is a directory", path
);
532 generate_error (&opp
->common
, LIBERROR_OS
, msg
);
536 if (flags
->status
== STATUS_NEW
|| flags
->status
== STATUS_REPLACE
)
537 flags
->status
= STATUS_OLD
;
539 /* Create the unit structure. */
541 u
->file
= xmalloc (opp
->file_len
);
542 if (u
->unit_number
!= opp
->common
.unit
)
543 internal_error (&opp
->common
, "Unit number changed");
547 u
->endfile
= NO_ENDFILE
;
549 u
->current_record
= 0;
555 if (flags
->position
== POSITION_APPEND
)
557 if (sseek (u
->s
, 0, SEEK_END
) < 0)
558 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
559 u
->endfile
= AT_ENDFILE
;
562 /* Unspecified recl ends up with a processor dependent value. */
564 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
566 u
->flags
.has_recl
= 1;
567 u
->recl
= opp
->recl_in
;
568 u
->recl_subrecord
= u
->recl
;
569 u
->bytes_left
= u
->recl
;
573 u
->flags
.has_recl
= 0;
574 u
->recl
= max_offset
;
575 if (compile_options
.max_subrecord_length
)
577 u
->recl_subrecord
= compile_options
.max_subrecord_length
;
581 switch (compile_options
.record_marker
)
585 case sizeof (GFC_INTEGER_4
):
586 u
->recl_subrecord
= GFC_MAX_SUBRECORD_LENGTH
;
589 case sizeof (GFC_INTEGER_8
):
590 u
->recl_subrecord
= max_offset
- 16;
594 runtime_error ("Illegal value for record marker");
600 /* If the file is direct access, calculate the maximum record number
601 via a division now instead of letting the multiplication overflow
604 if (flags
->access
== ACCESS_DIRECT
)
605 u
->maxrec
= max_offset
/ u
->recl
;
607 if (flags
->access
== ACCESS_STREAM
)
609 u
->maxrec
= max_offset
;
612 u
->strm_pos
= stell (u
->s
) + 1;
615 memmove (u
->file
, opp
->file
, opp
->file_len
);
616 u
->file_len
= opp
->file_len
;
618 /* Curiously, the standard requires that the
619 position specifier be ignored for new files so a newly connected
620 file starts out at the initial point. We still need to figure
621 out if the file is at the end or not. */
625 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
628 if (flags
->form
== FORM_FORMATTED
)
630 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
631 fbuf_init (u
, u
->recl
);
644 /* Free memory associated with a temporary filename. */
646 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
656 /* Open a unit which is already open. This involves changing the
657 modes or closing what is there now and opening the new file. */
660 already_open (st_parameter_open
*opp
, gfc_unit
* u
, unit_flags
* flags
)
662 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
664 edit_modes (opp
, u
, flags
);
668 /* If the file is connected to something else, close it and open a
671 if (!compare_file_filename (u
, opp
->file
, opp
->file_len
))
673 #if !HAVE_UNLINK_OPEN_FILE
675 if (u
->file
&& u
->flags
.status
== STATUS_SCRATCH
)
677 path
= (char *) gfc_alloca (u
->file_len
+ 1);
678 unpack_filename (path
, u
->file
, u
->file_len
);
682 if (sclose (u
->s
) == -1)
685 generate_error (&opp
->common
, LIBERROR_OS
,
686 "Error closing file in OPEN statement");
695 #if !HAVE_UNLINK_OPEN_FILE
700 u
= new_unit (opp
, u
, flags
);
706 edit_modes (opp
, u
, flags
);
712 extern void st_open (st_parameter_open
*opp
);
713 export_proto(st_open
);
716 st_open (st_parameter_open
*opp
)
720 GFC_INTEGER_4 cf
= opp
->common
.flags
;
723 library_start (&opp
->common
);
725 /* Decode options. */
727 flags
.access
= !(cf
& IOPARM_OPEN_HAS_ACCESS
) ? ACCESS_UNSPECIFIED
:
728 find_option (&opp
->common
, opp
->access
, opp
->access_len
,
729 access_opt
, "Bad ACCESS parameter in OPEN statement");
731 flags
.action
= !(cf
& IOPARM_OPEN_HAS_ACTION
) ? ACTION_UNSPECIFIED
:
732 find_option (&opp
->common
, opp
->action
, opp
->action_len
,
733 action_opt
, "Bad ACTION parameter in OPEN statement");
735 flags
.blank
= !(cf
& IOPARM_OPEN_HAS_BLANK
) ? BLANK_UNSPECIFIED
:
736 find_option (&opp
->common
, opp
->blank
, opp
->blank_len
,
737 blank_opt
, "Bad BLANK parameter in OPEN statement");
739 flags
.delim
= !(cf
& IOPARM_OPEN_HAS_DELIM
) ? DELIM_UNSPECIFIED
:
740 find_option (&opp
->common
, opp
->delim
, opp
->delim_len
,
741 delim_opt
, "Bad DELIM parameter in OPEN statement");
743 flags
.pad
= !(cf
& IOPARM_OPEN_HAS_PAD
) ? PAD_UNSPECIFIED
:
744 find_option (&opp
->common
, opp
->pad
, opp
->pad_len
,
745 pad_opt
, "Bad PAD parameter in OPEN statement");
747 flags
.decimal
= !(cf
& IOPARM_OPEN_HAS_DECIMAL
) ? DECIMAL_UNSPECIFIED
:
748 find_option (&opp
->common
, opp
->decimal
, opp
->decimal_len
,
749 decimal_opt
, "Bad DECIMAL parameter in OPEN statement");
751 flags
.encoding
= !(cf
& IOPARM_OPEN_HAS_ENCODING
) ? ENCODING_UNSPECIFIED
:
752 find_option (&opp
->common
, opp
->encoding
, opp
->encoding_len
,
753 encoding_opt
, "Bad ENCODING parameter in OPEN statement");
755 flags
.async
= !(cf
& IOPARM_OPEN_HAS_ASYNCHRONOUS
) ? ASYNC_UNSPECIFIED
:
756 find_option (&opp
->common
, opp
->asynchronous
, opp
->asynchronous_len
,
757 async_opt
, "Bad ASYNCHRONOUS parameter in OPEN statement");
759 flags
.round
= !(cf
& IOPARM_OPEN_HAS_ROUND
) ? ROUND_UNSPECIFIED
:
760 find_option (&opp
->common
, opp
->round
, opp
->round_len
,
761 round_opt
, "Bad ROUND parameter in OPEN statement");
763 flags
.sign
= !(cf
& IOPARM_OPEN_HAS_SIGN
) ? SIGN_UNSPECIFIED
:
764 find_option (&opp
->common
, opp
->sign
, opp
->sign_len
,
765 sign_opt
, "Bad SIGN parameter in OPEN statement");
767 flags
.form
= !(cf
& IOPARM_OPEN_HAS_FORM
) ? FORM_UNSPECIFIED
:
768 find_option (&opp
->common
, opp
->form
, opp
->form_len
,
769 form_opt
, "Bad FORM parameter in OPEN statement");
771 flags
.position
= !(cf
& IOPARM_OPEN_HAS_POSITION
) ? POSITION_UNSPECIFIED
:
772 find_option (&opp
->common
, opp
->position
, opp
->position_len
,
773 position_opt
, "Bad POSITION parameter in OPEN statement");
775 flags
.status
= !(cf
& IOPARM_OPEN_HAS_STATUS
) ? STATUS_UNSPECIFIED
:
776 find_option (&opp
->common
, opp
->status
, opp
->status_len
,
777 status_opt
, "Bad STATUS parameter in OPEN statement");
779 /* First, we check wether the convert flag has been set via environment
780 variable. This overrides the convert tag in the open statement. */
782 conv
= get_unformatted_convert (opp
->common
.unit
);
784 if (conv
== GFC_CONVERT_NONE
)
786 /* Nothing has been set by environment variable, check the convert tag. */
787 if (cf
& IOPARM_OPEN_HAS_CONVERT
)
788 conv
= find_option (&opp
->common
, opp
->convert
, opp
->convert_len
,
790 "Bad CONVERT parameter in OPEN statement");
792 conv
= compile_options
.convert
;
795 /* We use big_endian, which is 0 on little-endian machines
796 and 1 on big-endian machines. */
799 case GFC_CONVERT_NATIVE
:
800 case GFC_CONVERT_SWAP
:
803 case GFC_CONVERT_BIG
:
804 conv
= big_endian
? GFC_CONVERT_NATIVE
: GFC_CONVERT_SWAP
;
807 case GFC_CONVERT_LITTLE
:
808 conv
= big_endian
? GFC_CONVERT_SWAP
: GFC_CONVERT_NATIVE
;
812 internal_error (&opp
->common
, "Illegal value for CONVERT");
816 flags
.convert
= conv
;
818 if (!(opp
->common
.flags
& IOPARM_OPEN_HAS_NEWUNIT
) && opp
->common
.unit
< 0)
819 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
820 "Bad unit number in OPEN statement");
822 if (flags
.position
!= POSITION_UNSPECIFIED
823 && flags
.access
== ACCESS_DIRECT
)
824 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
825 "Cannot use POSITION with direct access files");
827 if (flags
.access
== ACCESS_APPEND
)
829 if (flags
.position
!= POSITION_UNSPECIFIED
830 && flags
.position
!= POSITION_APPEND
)
831 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
832 "Conflicting ACCESS and POSITION flags in"
835 notify_std (&opp
->common
, GFC_STD_GNU
,
836 "Extension: APPEND as a value for ACCESS in OPEN statement");
837 flags
.access
= ACCESS_SEQUENTIAL
;
838 flags
.position
= POSITION_APPEND
;
841 if (flags
.position
== POSITION_UNSPECIFIED
)
842 flags
.position
= POSITION_ASIS
;
844 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
846 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_NEWUNIT
))
848 *opp
->newunit
= get_unique_unit_number(opp
);
849 opp
->common
.unit
= *opp
->newunit
;
852 u
= find_or_create_unit (opp
->common
.unit
);
855 u
= new_unit (opp
, u
, &flags
);
860 already_open (opp
, u
, &flags
);