1 /* Copyright (C) 2002-2013 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
3 F2003 I/O support contributed by Jerry DeLisle
5 This file is part of the GNU Fortran runtime library (libgfortran).
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 3, or (at your option)
12 Libgfortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 Under Section 7 of GPL version 3, you are granted additional
18 permissions described in the GCC Runtime Library Exception, version
19 3.1, as published by the Free Software Foundation.
21 You should have received a copy of the GNU General Public License and
22 a copy of the GCC Runtime Library Exception along with this program;
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24 <http://www.gnu.org/licenses/>. */
39 static const st_option access_opt
[] = {
40 {"sequential", ACCESS_SEQUENTIAL
},
41 {"direct", ACCESS_DIRECT
},
42 {"append", ACCESS_APPEND
},
43 {"stream", ACCESS_STREAM
},
47 static const st_option action_opt
[] =
49 { "read", ACTION_READ
},
50 { "write", ACTION_WRITE
},
51 { "readwrite", ACTION_READWRITE
},
55 static const st_option blank_opt
[] =
57 { "null", BLANK_NULL
},
58 { "zero", BLANK_ZERO
},
62 static const st_option delim_opt
[] =
64 { "none", DELIM_NONE
},
65 { "apostrophe", DELIM_APOSTROPHE
},
66 { "quote", DELIM_QUOTE
},
70 static const st_option form_opt
[] =
72 { "formatted", FORM_FORMATTED
},
73 { "unformatted", FORM_UNFORMATTED
},
77 static const st_option position_opt
[] =
79 { "asis", POSITION_ASIS
},
80 { "rewind", POSITION_REWIND
},
81 { "append", POSITION_APPEND
},
85 static const st_option status_opt
[] =
87 { "unknown", STATUS_UNKNOWN
},
90 { "replace", STATUS_REPLACE
},
91 { "scratch", STATUS_SCRATCH
},
95 static const st_option pad_opt
[] =
102 static const st_option decimal_opt
[] =
104 { "point", DECIMAL_POINT
},
105 { "comma", DECIMAL_COMMA
},
109 static const st_option encoding_opt
[] =
111 { "utf-8", ENCODING_UTF8
},
112 { "default", ENCODING_DEFAULT
},
116 static const st_option round_opt
[] =
119 { "down", ROUND_DOWN
},
120 { "zero", ROUND_ZERO
},
121 { "nearest", ROUND_NEAREST
},
122 { "compatible", ROUND_COMPATIBLE
},
123 { "processor_defined", ROUND_PROCDEFINED
},
127 static const st_option sign_opt
[] =
129 { "plus", SIGN_PLUS
},
130 { "suppress", SIGN_SUPPRESS
},
131 { "processor_defined", SIGN_PROCDEFINED
},
135 static const st_option convert_opt
[] =
137 { "native", GFC_CONVERT_NATIVE
},
138 { "swap", GFC_CONVERT_SWAP
},
139 { "big_endian", GFC_CONVERT_BIG
},
140 { "little_endian", GFC_CONVERT_LITTLE
},
144 static const st_option async_opt
[] =
151 /* Given a unit, test to see if the file is positioned at the terminal
152 point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
153 This prevents us from changing the state from AFTER_ENDFILE to
157 test_endfile (gfc_unit
* u
)
159 if (u
->endfile
== NO_ENDFILE
)
161 gfc_offset sz
= ssize (u
->s
);
162 if (sz
== 0 || sz
== stell (u
->s
))
163 u
->endfile
= AT_ENDFILE
;
168 /* Change the modes of a file, those that are allowed * to be
172 edit_modes (st_parameter_open
*opp
, gfc_unit
* u
, unit_flags
* flags
)
174 /* Complain about attempts to change the unchangeable. */
176 if (flags
->status
!= STATUS_UNSPECIFIED
&& flags
->status
!= STATUS_OLD
&&
177 u
->flags
.status
!= flags
->status
)
178 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
179 "Cannot change STATUS parameter in OPEN statement");
181 if (flags
->access
!= ACCESS_UNSPECIFIED
&& u
->flags
.access
!= flags
->access
)
182 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
183 "Cannot change ACCESS parameter in OPEN statement");
185 if (flags
->form
!= FORM_UNSPECIFIED
&& u
->flags
.form
!= flags
->form
)
186 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
187 "Cannot change FORM parameter in OPEN statement");
189 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
)
190 && opp
->recl_in
!= u
->recl
)
191 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
192 "Cannot change RECL parameter in OPEN statement");
194 if (flags
->action
!= ACTION_UNSPECIFIED
&& u
->flags
.action
!= flags
->action
)
195 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
196 "Cannot change ACTION parameter in OPEN statement");
198 /* Status must be OLD if present. */
200 if (flags
->status
!= STATUS_UNSPECIFIED
&& flags
->status
!= STATUS_OLD
&&
201 flags
->status
!= STATUS_UNKNOWN
)
203 if (flags
->status
== STATUS_SCRATCH
)
204 notify_std (&opp
->common
, GFC_STD_GNU
,
205 "OPEN statement must have a STATUS of OLD or UNKNOWN");
207 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
208 "OPEN statement must have a STATUS of OLD or UNKNOWN");
211 if (u
->flags
.form
== FORM_UNFORMATTED
)
213 if (flags
->delim
!= DELIM_UNSPECIFIED
)
214 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
215 "DELIM parameter conflicts with UNFORMATTED form in "
218 if (flags
->blank
!= BLANK_UNSPECIFIED
)
219 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
220 "BLANK parameter conflicts with UNFORMATTED form in "
223 if (flags
->pad
!= PAD_UNSPECIFIED
)
224 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
225 "PAD parameter conflicts with UNFORMATTED form in "
228 if (flags
->decimal
!= DECIMAL_UNSPECIFIED
)
229 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
230 "DECIMAL parameter conflicts with UNFORMATTED form in "
233 if (flags
->encoding
!= ENCODING_UNSPECIFIED
)
234 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
235 "ENCODING parameter conflicts with UNFORMATTED form in "
238 if (flags
->round
!= ROUND_UNSPECIFIED
)
239 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
240 "ROUND parameter conflicts with UNFORMATTED form in "
243 if (flags
->sign
!= SIGN_UNSPECIFIED
)
244 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
245 "SIGN parameter conflicts with UNFORMATTED form in "
249 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
251 /* Change the changeable: */
252 if (flags
->blank
!= BLANK_UNSPECIFIED
)
253 u
->flags
.blank
= flags
->blank
;
254 if (flags
->delim
!= DELIM_UNSPECIFIED
)
255 u
->flags
.delim
= flags
->delim
;
256 if (flags
->pad
!= PAD_UNSPECIFIED
)
257 u
->flags
.pad
= flags
->pad
;
258 if (flags
->decimal
!= DECIMAL_UNSPECIFIED
)
259 u
->flags
.decimal
= flags
->decimal
;
260 if (flags
->encoding
!= ENCODING_UNSPECIFIED
)
261 u
->flags
.encoding
= flags
->encoding
;
262 if (flags
->async
!= ASYNC_UNSPECIFIED
)
263 u
->flags
.async
= flags
->async
;
264 if (flags
->round
!= ROUND_UNSPECIFIED
)
265 u
->flags
.round
= flags
->round
;
266 if (flags
->sign
!= SIGN_UNSPECIFIED
)
267 u
->flags
.sign
= flags
->sign
;
270 /* Reposition the file if necessary. */
272 switch (flags
->position
)
274 case POSITION_UNSPECIFIED
:
278 case POSITION_REWIND
:
279 if (sseek (u
->s
, 0, SEEK_SET
) != 0)
282 u
->current_record
= 0;
288 case POSITION_APPEND
:
289 if (sseek (u
->s
, 0, SEEK_END
) < 0)
292 if (flags
->access
!= ACCESS_STREAM
)
293 u
->current_record
= 0;
295 u
->endfile
= AT_ENDFILE
; /* We are at the end. */
299 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
307 /* Open an unused unit. */
310 new_unit (st_parameter_open
*opp
, gfc_unit
*u
, unit_flags
* flags
)
314 char tmpname
[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
316 /* Change unspecifieds to defaults. Leave (flags->action ==
317 ACTION_UNSPECIFIED) alone so open_external() can set it based on
318 what type of open actually works. */
320 if (flags
->access
== ACCESS_UNSPECIFIED
)
321 flags
->access
= ACCESS_SEQUENTIAL
;
323 if (flags
->form
== FORM_UNSPECIFIED
)
324 flags
->form
= (flags
->access
== ACCESS_SEQUENTIAL
)
325 ? FORM_FORMATTED
: FORM_UNFORMATTED
;
327 if (flags
->async
== ASYNC_UNSPECIFIED
)
328 flags
->async
= ASYNC_NO
;
330 if (flags
->status
== STATUS_UNSPECIFIED
)
331 flags
->status
= STATUS_UNKNOWN
;
335 if (flags
->delim
== DELIM_UNSPECIFIED
)
336 flags
->delim
= DELIM_NONE
;
339 if (flags
->form
== FORM_UNFORMATTED
)
341 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
342 "DELIM parameter conflicts with UNFORMATTED form in "
348 if (flags
->blank
== BLANK_UNSPECIFIED
)
349 flags
->blank
= BLANK_NULL
;
352 if (flags
->form
== FORM_UNFORMATTED
)
354 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
355 "BLANK parameter conflicts with UNFORMATTED form in "
361 if (flags
->pad
== PAD_UNSPECIFIED
)
362 flags
->pad
= PAD_YES
;
365 if (flags
->form
== FORM_UNFORMATTED
)
367 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
368 "PAD parameter conflicts with UNFORMATTED form in "
374 if (flags
->decimal
== DECIMAL_UNSPECIFIED
)
375 flags
->decimal
= DECIMAL_POINT
;
378 if (flags
->form
== FORM_UNFORMATTED
)
380 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
381 "DECIMAL parameter conflicts with UNFORMATTED form "
382 "in OPEN statement");
387 if (flags
->encoding
== ENCODING_UNSPECIFIED
)
388 flags
->encoding
= ENCODING_DEFAULT
;
391 if (flags
->form
== FORM_UNFORMATTED
)
393 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
394 "ENCODING parameter conflicts with UNFORMATTED form in "
400 /* NB: the value for ROUND when it's not specified by the user does not
401 have to be PROCESSOR_DEFINED; the standard says that it is
402 processor dependent, and requires that it is one of the
403 possible value (see F2003, 9.4.5.13). */
404 if (flags
->round
== ROUND_UNSPECIFIED
)
405 flags
->round
= ROUND_PROCDEFINED
;
408 if (flags
->form
== FORM_UNFORMATTED
)
410 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
411 "ROUND parameter conflicts with UNFORMATTED form in "
417 if (flags
->sign
== SIGN_UNSPECIFIED
)
418 flags
->sign
= SIGN_PROCDEFINED
;
421 if (flags
->form
== FORM_UNFORMATTED
)
423 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
424 "SIGN parameter conflicts with UNFORMATTED form in "
430 if (flags
->position
!= POSITION_ASIS
&& flags
->access
== ACCESS_DIRECT
)
432 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
433 "ACCESS parameter conflicts with SEQUENTIAL access in "
438 if (flags
->position
== POSITION_UNSPECIFIED
)
439 flags
->position
= POSITION_ASIS
;
441 if (flags
->access
== ACCESS_DIRECT
442 && (opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) == 0)
444 generate_error (&opp
->common
, LIBERROR_MISSING_OPTION
,
445 "Missing RECL parameter in OPEN statement");
449 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) && opp
->recl_in
<= 0)
451 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
452 "RECL parameter is non-positive in OPEN statement");
456 switch (flags
->status
)
459 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
465 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
466 "FILE parameter must not be present in OPEN statement");
473 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
))
477 opp
->file_len
= snprintf(opp
->file
, sizeof (tmpname
), "fort.%d",
478 (int) opp
->common
.unit
);
482 internal_error (&opp
->common
, "new_unit(): Bad status");
485 /* Make sure the file isn't already open someplace else.
486 Do not error if opening file preconnected to stdin, stdout, stderr. */
489 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) != 0)
490 u2
= find_file (opp
->file
, opp
->file_len
);
492 && (options
.stdin_unit
< 0 || u2
->unit_number
!= options
.stdin_unit
)
493 && (options
.stdout_unit
< 0 || u2
->unit_number
!= options
.stdout_unit
)
494 && (options
.stderr_unit
< 0 || u2
->unit_number
!= options
.stderr_unit
))
497 generate_error (&opp
->common
, LIBERROR_ALREADY_OPEN
, NULL
);
506 s
= open_external (opp
, flags
);
511 path
= (char *) gfc_alloca (opp
->file_len
+ 1);
512 msglen
= opp
->file_len
+ 51;
513 msg
= (char *) gfc_alloca (msglen
);
514 unpack_filename (path
, opp
->file
, opp
->file_len
);
519 snprintf (msg
, msglen
, "File '%s' does not exist", path
);
523 snprintf (msg
, msglen
, "File '%s' already exists", path
);
527 snprintf (msg
, msglen
,
528 "Permission denied trying to open file '%s'", path
);
532 snprintf (msg
, msglen
, "'%s' is a directory", path
);
539 generate_error (&opp
->common
, LIBERROR_OS
, msg
);
543 if (flags
->status
== STATUS_NEW
|| flags
->status
== STATUS_REPLACE
)
544 flags
->status
= STATUS_OLD
;
546 /* Create the unit structure. */
548 u
->file
= xmalloc (opp
->file_len
);
549 if (u
->unit_number
!= opp
->common
.unit
)
550 internal_error (&opp
->common
, "Unit number changed");
554 u
->endfile
= NO_ENDFILE
;
556 u
->current_record
= 0;
562 if (flags
->position
== POSITION_APPEND
)
564 if (sseek (u
->s
, 0, SEEK_END
) < 0)
565 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
566 u
->endfile
= AT_ENDFILE
;
569 /* Unspecified recl ends up with a processor dependent value. */
571 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
573 u
->flags
.has_recl
= 1;
574 u
->recl
= opp
->recl_in
;
575 u
->recl_subrecord
= u
->recl
;
576 u
->bytes_left
= u
->recl
;
580 u
->flags
.has_recl
= 0;
581 u
->recl
= max_offset
;
582 if (compile_options
.max_subrecord_length
)
584 u
->recl_subrecord
= compile_options
.max_subrecord_length
;
588 switch (compile_options
.record_marker
)
592 case sizeof (GFC_INTEGER_4
):
593 u
->recl_subrecord
= GFC_MAX_SUBRECORD_LENGTH
;
596 case sizeof (GFC_INTEGER_8
):
597 u
->recl_subrecord
= max_offset
- 16;
601 runtime_error ("Illegal value for record marker");
607 /* If the file is direct access, calculate the maximum record number
608 via a division now instead of letting the multiplication overflow
611 if (flags
->access
== ACCESS_DIRECT
)
612 u
->maxrec
= max_offset
/ u
->recl
;
614 if (flags
->access
== ACCESS_STREAM
)
616 u
->maxrec
= max_offset
;
619 u
->strm_pos
= stell (u
->s
) + 1;
622 memmove (u
->file
, opp
->file
, opp
->file_len
);
623 u
->file_len
= opp
->file_len
;
625 /* Curiously, the standard requires that the
626 position specifier be ignored for new files so a newly connected
627 file starts out at the initial point. We still need to figure
628 out if the file is at the end or not. */
632 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
635 if (flags
->form
== FORM_FORMATTED
)
637 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
638 fbuf_init (u
, u
->recl
);
651 /* Free memory associated with a temporary filename. */
653 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
663 /* Open a unit which is already open. This involves changing the
664 modes or closing what is there now and opening the new file. */
667 already_open (st_parameter_open
*opp
, gfc_unit
* u
, unit_flags
* flags
)
669 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
671 edit_modes (opp
, u
, flags
);
675 /* If the file is connected to something else, close it and open a
678 if (!compare_file_filename (u
, opp
->file
, opp
->file_len
))
680 #if !HAVE_UNLINK_OPEN_FILE
682 if (u
->file
&& u
->flags
.status
== STATUS_SCRATCH
)
684 path
= (char *) gfc_alloca (u
->file_len
+ 1);
685 unpack_filename (path
, u
->file
, u
->file_len
);
689 if (sclose (u
->s
) == -1)
692 generate_error (&opp
->common
, LIBERROR_OS
,
693 "Error closing file in OPEN statement");
702 #if !HAVE_UNLINK_OPEN_FILE
707 u
= new_unit (opp
, u
, flags
);
713 edit_modes (opp
, u
, flags
);
719 extern void st_open (st_parameter_open
*opp
);
720 export_proto(st_open
);
723 st_open (st_parameter_open
*opp
)
727 GFC_INTEGER_4 cf
= opp
->common
.flags
;
730 library_start (&opp
->common
);
732 /* Decode options. */
734 flags
.access
= !(cf
& IOPARM_OPEN_HAS_ACCESS
) ? ACCESS_UNSPECIFIED
:
735 find_option (&opp
->common
, opp
->access
, opp
->access_len
,
736 access_opt
, "Bad ACCESS parameter in OPEN statement");
738 flags
.action
= !(cf
& IOPARM_OPEN_HAS_ACTION
) ? ACTION_UNSPECIFIED
:
739 find_option (&opp
->common
, opp
->action
, opp
->action_len
,
740 action_opt
, "Bad ACTION parameter in OPEN statement");
742 flags
.blank
= !(cf
& IOPARM_OPEN_HAS_BLANK
) ? BLANK_UNSPECIFIED
:
743 find_option (&opp
->common
, opp
->blank
, opp
->blank_len
,
744 blank_opt
, "Bad BLANK parameter in OPEN statement");
746 flags
.delim
= !(cf
& IOPARM_OPEN_HAS_DELIM
) ? DELIM_UNSPECIFIED
:
747 find_option (&opp
->common
, opp
->delim
, opp
->delim_len
,
748 delim_opt
, "Bad DELIM parameter in OPEN statement");
750 flags
.pad
= !(cf
& IOPARM_OPEN_HAS_PAD
) ? PAD_UNSPECIFIED
:
751 find_option (&opp
->common
, opp
->pad
, opp
->pad_len
,
752 pad_opt
, "Bad PAD parameter in OPEN statement");
754 flags
.decimal
= !(cf
& IOPARM_OPEN_HAS_DECIMAL
) ? DECIMAL_UNSPECIFIED
:
755 find_option (&opp
->common
, opp
->decimal
, opp
->decimal_len
,
756 decimal_opt
, "Bad DECIMAL parameter in OPEN statement");
758 flags
.encoding
= !(cf
& IOPARM_OPEN_HAS_ENCODING
) ? ENCODING_UNSPECIFIED
:
759 find_option (&opp
->common
, opp
->encoding
, opp
->encoding_len
,
760 encoding_opt
, "Bad ENCODING parameter in OPEN statement");
762 flags
.async
= !(cf
& IOPARM_OPEN_HAS_ASYNCHRONOUS
) ? ASYNC_UNSPECIFIED
:
763 find_option (&opp
->common
, opp
->asynchronous
, opp
->asynchronous_len
,
764 async_opt
, "Bad ASYNCHRONOUS parameter in OPEN statement");
766 flags
.round
= !(cf
& IOPARM_OPEN_HAS_ROUND
) ? ROUND_UNSPECIFIED
:
767 find_option (&opp
->common
, opp
->round
, opp
->round_len
,
768 round_opt
, "Bad ROUND parameter in OPEN statement");
770 flags
.sign
= !(cf
& IOPARM_OPEN_HAS_SIGN
) ? SIGN_UNSPECIFIED
:
771 find_option (&opp
->common
, opp
->sign
, opp
->sign_len
,
772 sign_opt
, "Bad SIGN parameter in OPEN statement");
774 flags
.form
= !(cf
& IOPARM_OPEN_HAS_FORM
) ? FORM_UNSPECIFIED
:
775 find_option (&opp
->common
, opp
->form
, opp
->form_len
,
776 form_opt
, "Bad FORM parameter in OPEN statement");
778 flags
.position
= !(cf
& IOPARM_OPEN_HAS_POSITION
) ? POSITION_UNSPECIFIED
:
779 find_option (&opp
->common
, opp
->position
, opp
->position_len
,
780 position_opt
, "Bad POSITION parameter in OPEN statement");
782 flags
.status
= !(cf
& IOPARM_OPEN_HAS_STATUS
) ? STATUS_UNSPECIFIED
:
783 find_option (&opp
->common
, opp
->status
, opp
->status_len
,
784 status_opt
, "Bad STATUS parameter in OPEN statement");
786 /* First, we check wether the convert flag has been set via environment
787 variable. This overrides the convert tag in the open statement. */
789 conv
= get_unformatted_convert (opp
->common
.unit
);
791 if (conv
== GFC_CONVERT_NONE
)
793 /* Nothing has been set by environment variable, check the convert tag. */
794 if (cf
& IOPARM_OPEN_HAS_CONVERT
)
795 conv
= find_option (&opp
->common
, opp
->convert
, opp
->convert_len
,
797 "Bad CONVERT parameter in OPEN statement");
799 conv
= compile_options
.convert
;
802 /* We use big_endian, which is 0 on little-endian machines
803 and 1 on big-endian machines. */
806 case GFC_CONVERT_NATIVE
:
807 case GFC_CONVERT_SWAP
:
810 case GFC_CONVERT_BIG
:
811 conv
= big_endian
? GFC_CONVERT_NATIVE
: GFC_CONVERT_SWAP
;
814 case GFC_CONVERT_LITTLE
:
815 conv
= big_endian
? GFC_CONVERT_SWAP
: GFC_CONVERT_NATIVE
;
819 internal_error (&opp
->common
, "Illegal value for CONVERT");
823 flags
.convert
= conv
;
825 if (flags
.position
!= POSITION_UNSPECIFIED
826 && flags
.access
== ACCESS_DIRECT
)
827 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
828 "Cannot use POSITION with direct access files");
830 if (flags
.access
== ACCESS_APPEND
)
832 if (flags
.position
!= POSITION_UNSPECIFIED
833 && flags
.position
!= POSITION_APPEND
)
834 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
835 "Conflicting ACCESS and POSITION flags in"
838 notify_std (&opp
->common
, GFC_STD_GNU
,
839 "Extension: APPEND as a value for ACCESS in OPEN statement");
840 flags
.access
= ACCESS_SEQUENTIAL
;
841 flags
.position
= POSITION_APPEND
;
844 if (flags
.position
== POSITION_UNSPECIFIED
)
845 flags
.position
= POSITION_ASIS
;
847 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
849 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_NEWUNIT
))
850 opp
->common
.unit
= get_unique_unit_number(opp
);
851 else if (opp
->common
.unit
< 0)
853 u
= find_unit (opp
->common
.unit
);
854 if (u
== NULL
) /* Negative unit and no NEWUNIT-created unit found. */
855 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
856 "Bad unit number in OPEN statement");
860 u
= find_or_create_unit (opp
->common
.unit
);
863 u
= new_unit (opp
, u
, &flags
);
868 already_open (opp
, u
, &flags
);
871 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_NEWUNIT
)
872 && (opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
873 *opp
->newunit
= opp
->common
.unit
;