1 /* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008, 2009
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 95 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/>. */
33 static const st_option access_opt
[] = {
34 {"sequential", ACCESS_SEQUENTIAL
},
35 {"direct", ACCESS_DIRECT
},
36 {"append", ACCESS_APPEND
},
37 {"stream", ACCESS_STREAM
},
41 static const st_option action_opt
[] =
43 { "read", ACTION_READ
},
44 { "write", ACTION_WRITE
},
45 { "readwrite", ACTION_READWRITE
},
49 static const st_option blank_opt
[] =
51 { "null", BLANK_NULL
},
52 { "zero", BLANK_ZERO
},
56 static const st_option delim_opt
[] =
58 { "none", DELIM_NONE
},
59 { "apostrophe", DELIM_APOSTROPHE
},
60 { "quote", DELIM_QUOTE
},
64 static const st_option form_opt
[] =
66 { "formatted", FORM_FORMATTED
},
67 { "unformatted", FORM_UNFORMATTED
},
71 static const st_option position_opt
[] =
73 { "asis", POSITION_ASIS
},
74 { "rewind", POSITION_REWIND
},
75 { "append", POSITION_APPEND
},
79 static const st_option status_opt
[] =
81 { "unknown", STATUS_UNKNOWN
},
84 { "replace", STATUS_REPLACE
},
85 { "scratch", STATUS_SCRATCH
},
89 static const st_option pad_opt
[] =
96 static const st_option decimal_opt
[] =
98 { "point", DECIMAL_POINT
},
99 { "comma", DECIMAL_COMMA
},
103 static const st_option encoding_opt
[] =
105 { "utf-8", ENCODING_UTF8
},
106 { "default", ENCODING_DEFAULT
},
110 static const st_option round_opt
[] =
113 { "down", ROUND_DOWN
},
114 { "zero", ROUND_ZERO
},
115 { "nearest", ROUND_NEAREST
},
116 { "compatible", ROUND_COMPATIBLE
},
117 { "processor_defined", ROUND_PROCDEFINED
},
121 static const st_option sign_opt
[] =
123 { "plus", SIGN_PLUS
},
124 { "suppress", SIGN_SUPPRESS
},
125 { "processor_defined", SIGN_PROCDEFINED
},
129 static const st_option convert_opt
[] =
131 { "native", GFC_CONVERT_NATIVE
},
132 { "swap", GFC_CONVERT_SWAP
},
133 { "big_endian", GFC_CONVERT_BIG
},
134 { "little_endian", GFC_CONVERT_LITTLE
},
138 static const st_option async_opt
[] =
145 /* Given a unit, test to see if the file is positioned at the terminal
146 point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
147 This prevents us from changing the state from AFTER_ENDFILE to
151 test_endfile (gfc_unit
* u
)
153 if (u
->endfile
== NO_ENDFILE
&& file_length (u
->s
) == stell (u
->s
))
154 u
->endfile
= AT_ENDFILE
;
158 /* Change the modes of a file, those that are allowed * to be
162 edit_modes (st_parameter_open
*opp
, gfc_unit
* u
, unit_flags
* flags
)
164 /* Complain about attempts to change the unchangeable. */
166 if (flags
->status
!= STATUS_UNSPECIFIED
&& flags
->status
!= STATUS_OLD
&&
167 u
->flags
.status
!= flags
->status
)
168 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
169 "Cannot change STATUS parameter in OPEN statement");
171 if (flags
->access
!= ACCESS_UNSPECIFIED
&& u
->flags
.access
!= flags
->access
)
172 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
173 "Cannot change ACCESS parameter in OPEN statement");
175 if (flags
->form
!= FORM_UNSPECIFIED
&& u
->flags
.form
!= flags
->form
)
176 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
177 "Cannot change FORM parameter in OPEN statement");
179 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
)
180 && opp
->recl_in
!= u
->recl
)
181 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
182 "Cannot change RECL parameter in OPEN statement");
184 if (flags
->action
!= ACTION_UNSPECIFIED
&& u
->flags
.action
!= flags
->action
)
185 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
186 "Cannot change ACTION parameter in OPEN statement");
188 /* Status must be OLD if present. */
190 if (flags
->status
!= STATUS_UNSPECIFIED
&& flags
->status
!= STATUS_OLD
&&
191 flags
->status
!= STATUS_UNKNOWN
)
193 if (flags
->status
== STATUS_SCRATCH
)
194 notify_std (&opp
->common
, GFC_STD_GNU
,
195 "OPEN statement must have a STATUS of OLD or UNKNOWN");
197 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
198 "OPEN statement must have a STATUS of OLD or UNKNOWN");
201 if (u
->flags
.form
== FORM_UNFORMATTED
)
203 if (flags
->delim
!= DELIM_UNSPECIFIED
)
204 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
205 "DELIM parameter conflicts with UNFORMATTED form in "
208 if (flags
->blank
!= BLANK_UNSPECIFIED
)
209 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
210 "BLANK parameter conflicts with UNFORMATTED form in "
213 if (flags
->pad
!= PAD_UNSPECIFIED
)
214 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
215 "PAD parameter conflicts with UNFORMATTED form in "
218 if (flags
->decimal
!= DECIMAL_UNSPECIFIED
)
219 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
220 "DECIMAL parameter conflicts with UNFORMATTED form in "
223 if (flags
->encoding
!= ENCODING_UNSPECIFIED
)
224 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
225 "ENCODING parameter conflicts with UNFORMATTED form in "
228 if (flags
->round
!= ROUND_UNSPECIFIED
)
229 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
230 "ROUND parameter conflicts with UNFORMATTED form in "
233 if (flags
->sign
!= SIGN_UNSPECIFIED
)
234 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
235 "SIGN parameter conflicts with UNFORMATTED form in "
239 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
241 /* Change the changeable: */
242 if (flags
->blank
!= BLANK_UNSPECIFIED
)
243 u
->flags
.blank
= flags
->blank
;
244 if (flags
->delim
!= DELIM_UNSPECIFIED
)
245 u
->flags
.delim
= flags
->delim
;
246 if (flags
->pad
!= PAD_UNSPECIFIED
)
247 u
->flags
.pad
= flags
->pad
;
248 if (flags
->decimal
!= DECIMAL_UNSPECIFIED
)
249 u
->flags
.decimal
= flags
->decimal
;
250 if (flags
->encoding
!= ENCODING_UNSPECIFIED
)
251 u
->flags
.encoding
= flags
->encoding
;
252 if (flags
->async
!= ASYNC_UNSPECIFIED
)
253 u
->flags
.async
= flags
->async
;
254 if (flags
->round
!= ROUND_UNSPECIFIED
)
255 u
->flags
.round
= flags
->round
;
256 if (flags
->sign
!= SIGN_UNSPECIFIED
)
257 u
->flags
.sign
= flags
->sign
;
260 /* Reposition the file if necessary. */
262 switch (flags
->position
)
264 case POSITION_UNSPECIFIED
:
268 case POSITION_REWIND
:
269 if (sseek (u
->s
, 0, SEEK_SET
) != 0)
272 u
->current_record
= 0;
278 case POSITION_APPEND
:
279 if (sseek (u
->s
, 0, SEEK_END
) < 0)
282 if (flags
->access
!= ACCESS_STREAM
)
283 u
->current_record
= 0;
285 u
->endfile
= AT_ENDFILE
; /* We are at the end. */
289 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
297 /* Open an unused unit. */
300 new_unit (st_parameter_open
*opp
, gfc_unit
*u
, unit_flags
* flags
)
304 char tmpname
[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
306 /* Change unspecifieds to defaults. Leave (flags->action ==
307 ACTION_UNSPECIFIED) alone so open_external() can set it based on
308 what type of open actually works. */
310 if (flags
->access
== ACCESS_UNSPECIFIED
)
311 flags
->access
= ACCESS_SEQUENTIAL
;
313 if (flags
->form
== FORM_UNSPECIFIED
)
314 flags
->form
= (flags
->access
== ACCESS_SEQUENTIAL
)
315 ? FORM_FORMATTED
: FORM_UNFORMATTED
;
317 if (flags
->async
== ASYNC_UNSPECIFIED
)
318 flags
->async
= ASYNC_NO
;
320 if (flags
->status
== STATUS_UNSPECIFIED
)
321 flags
->status
= STATUS_UNKNOWN
;
325 if (flags
->delim
== DELIM_UNSPECIFIED
)
326 flags
->delim
= DELIM_NONE
;
329 if (flags
->form
== FORM_UNFORMATTED
)
331 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
332 "DELIM parameter conflicts with UNFORMATTED form in "
338 if (flags
->blank
== BLANK_UNSPECIFIED
)
339 flags
->blank
= BLANK_NULL
;
342 if (flags
->form
== FORM_UNFORMATTED
)
344 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
345 "BLANK parameter conflicts with UNFORMATTED form in "
351 if (flags
->pad
== PAD_UNSPECIFIED
)
352 flags
->pad
= PAD_YES
;
355 if (flags
->form
== FORM_UNFORMATTED
)
357 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
358 "PAD parameter conflicts with UNFORMATTED form in "
364 if (flags
->decimal
== DECIMAL_UNSPECIFIED
)
365 flags
->decimal
= DECIMAL_POINT
;
368 if (flags
->form
== FORM_UNFORMATTED
)
370 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
371 "DECIMAL parameter conflicts with UNFORMATTED form "
372 "in OPEN statement");
377 if (flags
->encoding
== ENCODING_UNSPECIFIED
)
378 flags
->encoding
= ENCODING_DEFAULT
;
381 if (flags
->form
== FORM_UNFORMATTED
)
383 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
384 "ENCODING parameter conflicts with UNFORMATTED form in "
390 /* NB: the value for ROUND when it's not specified by the user does not
391 have to be PROCESSOR_DEFINED; the standard says that it is
392 processor dependent, and requires that it is one of the
393 possible value (see F2003, 9.4.5.13). */
394 if (flags
->round
== ROUND_UNSPECIFIED
)
395 flags
->round
= ROUND_PROCDEFINED
;
398 if (flags
->form
== FORM_UNFORMATTED
)
400 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
401 "ROUND parameter conflicts with UNFORMATTED form in "
407 if (flags
->sign
== SIGN_UNSPECIFIED
)
408 flags
->sign
= SIGN_PROCDEFINED
;
411 if (flags
->form
== FORM_UNFORMATTED
)
413 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
414 "SIGN parameter conflicts with UNFORMATTED form in "
420 if (flags
->position
!= POSITION_ASIS
&& flags
->access
== ACCESS_DIRECT
)
422 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
423 "ACCESS parameter conflicts with SEQUENTIAL access in "
428 if (flags
->position
== POSITION_UNSPECIFIED
)
429 flags
->position
= POSITION_ASIS
;
431 if (flags
->access
== ACCESS_DIRECT
432 && (opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) == 0)
434 generate_error (&opp
->common
, LIBERROR_MISSING_OPTION
,
435 "Missing RECL parameter in OPEN statement");
439 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) && opp
->recl_in
<= 0)
441 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
442 "RECL parameter is non-positive in OPEN statement");
446 switch (flags
->status
)
449 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
455 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
456 "FILE parameter must not be present in OPEN statement");
463 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
))
468 opp
->file_len
= snprintf(opp
->file
, sizeof (tmpname
), "fort.%d",
469 (int) opp
->common
.unit
);
471 opp
->file_len
= sprintf(opp
->file
, "fort.%d", (int) opp
->common
.unit
);
476 internal_error (&opp
->common
, "new_unit(): Bad status");
479 /* Make sure the file isn't already open someplace else.
480 Do not error if opening file preconnected to stdin, stdout, stderr. */
483 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) != 0)
484 u2
= find_file (opp
->file
, opp
->file_len
);
486 && (options
.stdin_unit
< 0 || u2
->unit_number
!= options
.stdin_unit
)
487 && (options
.stdout_unit
< 0 || u2
->unit_number
!= options
.stdout_unit
)
488 && (options
.stderr_unit
< 0 || u2
->unit_number
!= options
.stderr_unit
))
491 generate_error (&opp
->common
, LIBERROR_ALREADY_OPEN
, NULL
);
500 s
= open_external (opp
, flags
);
504 path
= (char *) gfc_alloca (opp
->file_len
+ 1);
505 msg
= (char *) gfc_alloca (opp
->file_len
+ 51);
506 unpack_filename (path
, opp
->file
, opp
->file_len
);
511 sprintf (msg
, "File '%s' does not exist", path
);
515 sprintf (msg
, "File '%s' already exists", path
);
519 sprintf (msg
, "Permission denied trying to open file '%s'", path
);
523 sprintf (msg
, "'%s' is a directory", path
);
530 generate_error (&opp
->common
, LIBERROR_OS
, msg
);
534 if (flags
->status
== STATUS_NEW
|| flags
->status
== STATUS_REPLACE
)
535 flags
->status
= STATUS_OLD
;
537 /* Create the unit structure. */
539 u
->file
= get_mem (opp
->file_len
);
540 if (u
->unit_number
!= opp
->common
.unit
)
541 internal_error (&opp
->common
, "Unit number changed");
545 u
->endfile
= NO_ENDFILE
;
547 u
->current_record
= 0;
553 if (flags
->position
== POSITION_APPEND
)
555 if (sseek (u
->s
, 0, SEEK_END
) < 0)
556 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
557 u
->endfile
= AT_ENDFILE
;
560 /* Unspecified recl ends up with a processor dependent value. */
562 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
564 u
->flags
.has_recl
= 1;
565 u
->recl
= opp
->recl_in
;
566 u
->recl_subrecord
= u
->recl
;
567 u
->bytes_left
= u
->recl
;
571 u
->flags
.has_recl
= 0;
572 u
->recl
= max_offset
;
573 if (compile_options
.max_subrecord_length
)
575 u
->recl_subrecord
= compile_options
.max_subrecord_length
;
579 switch (compile_options
.record_marker
)
583 case sizeof (GFC_INTEGER_4
):
584 u
->recl_subrecord
= GFC_MAX_SUBRECORD_LENGTH
;
587 case sizeof (GFC_INTEGER_8
):
588 u
->recl_subrecord
= max_offset
- 16;
592 runtime_error ("Illegal value for record marker");
598 /* If the file is direct access, calculate the maximum record number
599 via a division now instead of letting the multiplication overflow
602 if (flags
->access
== ACCESS_DIRECT
)
603 u
->maxrec
= max_offset
/ u
->recl
;
605 if (flags
->access
== ACCESS_STREAM
)
607 u
->maxrec
= max_offset
;
610 u
->strm_pos
= stell (u
->s
) + 1;
613 memmove (u
->file
, opp
->file
, opp
->file_len
);
614 u
->file_len
= opp
->file_len
;
616 /* Curiously, the standard requires that the
617 position specifier be ignored for new files so a newly connected
618 file starts out at the initial point. We still need to figure
619 out if the file is at the end or not. */
623 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
624 free_mem (opp
->file
);
626 if (flags
->form
== FORM_FORMATTED
)
628 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
629 fbuf_init (u
, u
->recl
);
642 /* Free memory associated with a temporary filename. */
644 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
645 free_mem (opp
->file
);
654 /* Open a unit which is already open. This involves changing the
655 modes or closing what is there now and opening the new file. */
658 already_open (st_parameter_open
*opp
, gfc_unit
* u
, unit_flags
* flags
)
660 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
662 edit_modes (opp
, u
, flags
);
666 /* If the file is connected to something else, close it and open a
669 if (!compare_file_filename (u
, opp
->file
, opp
->file_len
))
671 #if !HAVE_UNLINK_OPEN_FILE
673 if (u
->file
&& u
->flags
.status
== STATUS_SCRATCH
)
675 path
= (char *) gfc_alloca (u
->file_len
+ 1);
676 unpack_filename (path
, u
->file
, u
->file_len
);
680 if (sclose (u
->s
) == -1)
683 generate_error (&opp
->common
, LIBERROR_OS
,
684 "Error closing file in OPEN statement");
694 #if !HAVE_UNLINK_OPEN_FILE
699 u
= new_unit (opp
, u
, flags
);
705 edit_modes (opp
, u
, flags
);
711 extern void st_open (st_parameter_open
*opp
);
712 export_proto(st_open
);
715 st_open (st_parameter_open
*opp
)
719 GFC_INTEGER_4 cf
= opp
->common
.flags
;
722 library_start (&opp
->common
);
724 /* Decode options. */
726 flags
.access
= !(cf
& IOPARM_OPEN_HAS_ACCESS
) ? ACCESS_UNSPECIFIED
:
727 find_option (&opp
->common
, opp
->access
, opp
->access_len
,
728 access_opt
, "Bad ACCESS parameter in OPEN statement");
730 flags
.action
= !(cf
& IOPARM_OPEN_HAS_ACTION
) ? ACTION_UNSPECIFIED
:
731 find_option (&opp
->common
, opp
->action
, opp
->action_len
,
732 action_opt
, "Bad ACTION parameter in OPEN statement");
734 flags
.blank
= !(cf
& IOPARM_OPEN_HAS_BLANK
) ? BLANK_UNSPECIFIED
:
735 find_option (&opp
->common
, opp
->blank
, opp
->blank_len
,
736 blank_opt
, "Bad BLANK parameter in OPEN statement");
738 flags
.delim
= !(cf
& IOPARM_OPEN_HAS_DELIM
) ? DELIM_UNSPECIFIED
:
739 find_option (&opp
->common
, opp
->delim
, opp
->delim_len
,
740 delim_opt
, "Bad DELIM parameter in OPEN statement");
742 flags
.pad
= !(cf
& IOPARM_OPEN_HAS_PAD
) ? PAD_UNSPECIFIED
:
743 find_option (&opp
->common
, opp
->pad
, opp
->pad_len
,
744 pad_opt
, "Bad PAD parameter in OPEN statement");
746 flags
.decimal
= !(cf
& IOPARM_OPEN_HAS_DECIMAL
) ? DECIMAL_UNSPECIFIED
:
747 find_option (&opp
->common
, opp
->decimal
, opp
->decimal_len
,
748 decimal_opt
, "Bad DECIMAL parameter in OPEN statement");
750 flags
.encoding
= !(cf
& IOPARM_OPEN_HAS_ENCODING
) ? ENCODING_UNSPECIFIED
:
751 find_option (&opp
->common
, opp
->encoding
, opp
->encoding_len
,
752 encoding_opt
, "Bad ENCODING parameter in OPEN statement");
754 flags
.async
= !(cf
& IOPARM_OPEN_HAS_ASYNCHRONOUS
) ? ASYNC_UNSPECIFIED
:
755 find_option (&opp
->common
, opp
->asynchronous
, opp
->asynchronous_len
,
756 async_opt
, "Bad ASYNCHRONOUS parameter in OPEN statement");
758 flags
.round
= !(cf
& IOPARM_OPEN_HAS_ROUND
) ? ROUND_UNSPECIFIED
:
759 find_option (&opp
->common
, opp
->round
, opp
->round_len
,
760 round_opt
, "Bad ROUND parameter in OPEN statement");
762 flags
.sign
= !(cf
& IOPARM_OPEN_HAS_SIGN
) ? SIGN_UNSPECIFIED
:
763 find_option (&opp
->common
, opp
->sign
, opp
->sign_len
,
764 sign_opt
, "Bad SIGN parameter in OPEN statement");
766 flags
.form
= !(cf
& IOPARM_OPEN_HAS_FORM
) ? FORM_UNSPECIFIED
:
767 find_option (&opp
->common
, opp
->form
, opp
->form_len
,
768 form_opt
, "Bad FORM parameter in OPEN statement");
770 flags
.position
= !(cf
& IOPARM_OPEN_HAS_POSITION
) ? POSITION_UNSPECIFIED
:
771 find_option (&opp
->common
, opp
->position
, opp
->position_len
,
772 position_opt
, "Bad POSITION parameter in OPEN statement");
774 flags
.status
= !(cf
& IOPARM_OPEN_HAS_STATUS
) ? STATUS_UNSPECIFIED
:
775 find_option (&opp
->common
, opp
->status
, opp
->status_len
,
776 status_opt
, "Bad STATUS parameter in OPEN statement");
778 /* First, we check wether the convert flag has been set via environment
779 variable. This overrides the convert tag in the open statement. */
781 conv
= get_unformatted_convert (opp
->common
.unit
);
783 if (conv
== GFC_CONVERT_NONE
)
785 /* Nothing has been set by environment variable, check the convert tag. */
786 if (cf
& IOPARM_OPEN_HAS_CONVERT
)
787 conv
= find_option (&opp
->common
, opp
->convert
, opp
->convert_len
,
789 "Bad CONVERT parameter in OPEN statement");
791 conv
= compile_options
.convert
;
794 /* We use big_endian, which is 0 on little-endian machines
795 and 1 on big-endian machines. */
798 case GFC_CONVERT_NATIVE
:
799 case GFC_CONVERT_SWAP
:
802 case GFC_CONVERT_BIG
:
803 conv
= big_endian
? GFC_CONVERT_NATIVE
: GFC_CONVERT_SWAP
;
806 case GFC_CONVERT_LITTLE
:
807 conv
= big_endian
? GFC_CONVERT_SWAP
: GFC_CONVERT_NATIVE
;
811 internal_error (&opp
->common
, "Illegal value for CONVERT");
815 flags
.convert
= conv
;
817 if (opp
->common
.unit
< 0)
818 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
819 "Bad unit number in OPEN statement");
821 if (flags
.position
!= POSITION_UNSPECIFIED
822 && flags
.access
== ACCESS_DIRECT
)
823 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
824 "Cannot use POSITION with direct access files");
826 if (flags
.access
== ACCESS_APPEND
)
828 if (flags
.position
!= POSITION_UNSPECIFIED
829 && flags
.position
!= POSITION_APPEND
)
830 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
831 "Conflicting ACCESS and POSITION flags in"
834 notify_std (&opp
->common
, GFC_STD_GNU
,
835 "Extension: APPEND as a value for ACCESS in OPEN statement");
836 flags
.access
= ACCESS_SEQUENTIAL
;
837 flags
.position
= POSITION_APPEND
;
840 if (flags
.position
== POSITION_UNSPECIFIED
)
841 flags
.position
= POSITION_ASIS
;
843 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
845 u
= find_or_create_unit (opp
->common
.unit
);
849 u
= new_unit (opp
, u
, &flags
);
854 already_open (opp
, u
, &flags
);