1 /* Copyright (C) 2002-2024 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 share_opt
[] =
57 { "denyrw", SHARE_DENYRW
},
58 { "denynone", SHARE_DENYNONE
},
62 static const st_option cc_opt
[] =
65 { "fortran", CC_FORTRAN
},
70 static const st_option blank_opt
[] =
72 { "null", BLANK_NULL
},
73 { "zero", BLANK_ZERO
},
77 static const st_option delim_opt
[] =
79 { "none", DELIM_NONE
},
80 { "apostrophe", DELIM_APOSTROPHE
},
81 { "quote", DELIM_QUOTE
},
85 static const st_option form_opt
[] =
87 { "formatted", FORM_FORMATTED
},
88 { "unformatted", FORM_UNFORMATTED
},
92 static const st_option position_opt
[] =
94 { "asis", POSITION_ASIS
},
95 { "rewind", POSITION_REWIND
},
96 { "append", POSITION_APPEND
},
100 static const st_option status_opt
[] =
102 { "unknown", STATUS_UNKNOWN
},
103 { "old", STATUS_OLD
},
104 { "new", STATUS_NEW
},
105 { "replace", STATUS_REPLACE
},
106 { "scratch", STATUS_SCRATCH
},
110 static const st_option pad_opt
[] =
117 static const st_option decimal_opt
[] =
119 { "point", DECIMAL_POINT
},
120 { "comma", DECIMAL_COMMA
},
124 static const st_option encoding_opt
[] =
126 { "utf-8", ENCODING_UTF8
},
127 { "default", ENCODING_DEFAULT
},
131 static const st_option round_opt
[] =
134 { "down", ROUND_DOWN
},
135 { "zero", ROUND_ZERO
},
136 { "nearest", ROUND_NEAREST
},
137 { "compatible", ROUND_COMPATIBLE
},
138 { "processor_defined", ROUND_PROCDEFINED
},
142 static const st_option sign_opt
[] =
144 { "plus", SIGN_PLUS
},
145 { "suppress", SIGN_SUPPRESS
},
146 { "processor_defined", SIGN_PROCDEFINED
},
150 static const st_option convert_opt
[] =
152 { "native", GFC_CONVERT_NATIVE
},
153 { "swap", GFC_CONVERT_SWAP
},
154 { "big_endian", GFC_CONVERT_BIG
},
155 { "little_endian", GFC_CONVERT_LITTLE
},
156 #ifdef HAVE_GFC_REAL_17
157 /* Rather than write a special parsing routine, enumerate all the
158 possibilities here. */
159 { "r16_ieee", GFC_CONVERT_R16_IEEE
},
160 { "r16_ibm", GFC_CONVERT_R16_IBM
},
161 { "native,r16_ieee", GFC_CONVERT_R16_IEEE
},
162 { "native,r16_ibm", GFC_CONVERT_R16_IBM
},
163 { "r16_ieee,native", GFC_CONVERT_R16_IEEE
},
164 { "r16_ibm,native", GFC_CONVERT_R16_IBM
},
165 { "swap,r16_ieee", GFC_CONVERT_R16_IEEE_SWAP
},
166 { "swap,r16_ibm", GFC_CONVERT_R16_IBM_SWAP
},
167 { "r16_ieee,swap", GFC_CONVERT_R16_IEEE_SWAP
},
168 { "r16_ibm,swap", GFC_CONVERT_R16_IBM_SWAP
},
169 { "big_endian,r16_ieee", GFC_CONVERT_R16_IEEE_BIG
},
170 { "big_endian,r16_ibm", GFC_CONVERT_R16_IBM_BIG
},
171 { "r16_ieee,big_endian", GFC_CONVERT_R16_IEEE_BIG
},
172 { "r16_ibm,big_endian", GFC_CONVERT_R16_IBM_BIG
},
173 { "little_endian,r16_ieee", GFC_CONVERT_R16_IEEE_LITTLE
},
174 { "little_endian,r16_ibm", GFC_CONVERT_R16_IBM_LITTLE
},
175 { "r16_ieee,little_endian", GFC_CONVERT_R16_IEEE_LITTLE
},
176 { "r16_ibm,little_endian", GFC_CONVERT_R16_IBM_LITTLE
},
181 static const st_option async_opt
[] =
188 /* Given a unit, test to see if the file is positioned at the terminal
189 point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
190 This prevents us from changing the state from AFTER_ENDFILE to
194 test_endfile (gfc_unit
*u
)
196 if (u
->endfile
== NO_ENDFILE
)
198 gfc_offset sz
= ssize (u
->s
);
199 if (sz
== 0 || sz
== stell (u
->s
))
200 u
->endfile
= AT_ENDFILE
;
205 /* Change the modes of a file, those that are allowed * to be
209 edit_modes (st_parameter_open
*opp
, gfc_unit
*u
, unit_flags
*flags
)
211 /* Complain about attempts to change the unchangeable. */
213 if (flags
->status
!= STATUS_UNSPECIFIED
&& flags
->status
!= STATUS_OLD
&&
214 u
->flags
.status
!= flags
->status
)
215 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
216 "Cannot change STATUS parameter in OPEN statement");
218 if (flags
->access
!= ACCESS_UNSPECIFIED
&& u
->flags
.access
!= flags
->access
)
219 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
220 "Cannot change ACCESS parameter in OPEN statement");
222 if (flags
->form
!= FORM_UNSPECIFIED
&& u
->flags
.form
!= flags
->form
)
223 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
224 "Cannot change FORM parameter in OPEN statement");
226 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
)
227 && opp
->recl_in
!= u
->recl
)
228 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
229 "Cannot change RECL parameter in OPEN statement");
231 if (flags
->action
!= ACTION_UNSPECIFIED
&& u
->flags
.action
!= flags
->action
)
232 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
233 "Cannot change ACTION parameter in OPEN statement");
235 if (flags
->share
!= SHARE_UNSPECIFIED
&& u
->flags
.share
!= flags
->share
)
236 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
237 "Cannot change SHARE parameter in OPEN statement");
239 if (flags
->cc
!= CC_UNSPECIFIED
&& u
->flags
.cc
!= flags
->cc
)
240 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
241 "Cannot change CARRIAGECONTROL parameter in OPEN statement");
243 /* Status must be OLD if present. */
245 if (flags
->status
!= STATUS_UNSPECIFIED
&& flags
->status
!= STATUS_OLD
&&
246 flags
->status
!= STATUS_UNKNOWN
)
248 if (flags
->status
== STATUS_SCRATCH
)
249 notify_std (&opp
->common
, GFC_STD_GNU
,
250 "OPEN statement must have a STATUS of OLD or UNKNOWN");
252 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
253 "OPEN statement must have a STATUS of OLD or UNKNOWN");
256 if (u
->flags
.form
== FORM_UNFORMATTED
)
258 if (flags
->delim
!= DELIM_UNSPECIFIED
)
259 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
260 "DELIM parameter conflicts with UNFORMATTED form in "
263 if (flags
->blank
!= BLANK_UNSPECIFIED
)
264 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
265 "BLANK parameter conflicts with UNFORMATTED form in "
268 if (flags
->pad
!= PAD_UNSPECIFIED
)
269 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
270 "PAD parameter conflicts with UNFORMATTED form in "
273 if (flags
->decimal
!= DECIMAL_UNSPECIFIED
)
274 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
275 "DECIMAL parameter conflicts with UNFORMATTED form in "
278 if (flags
->encoding
!= ENCODING_UNSPECIFIED
)
279 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
280 "ENCODING parameter conflicts with UNFORMATTED form in "
283 if (flags
->round
!= ROUND_UNSPECIFIED
)
284 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
285 "ROUND parameter conflicts with UNFORMATTED form in "
288 if (flags
->sign
!= SIGN_UNSPECIFIED
)
289 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
290 "SIGN parameter conflicts with UNFORMATTED form in "
294 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
296 /* Change the changeable: */
297 if (flags
->blank
!= BLANK_UNSPECIFIED
)
298 u
->flags
.blank
= flags
->blank
;
299 if (flags
->delim
!= DELIM_UNSPECIFIED
)
300 u
->flags
.delim
= flags
->delim
;
301 if (flags
->pad
!= PAD_UNSPECIFIED
)
302 u
->flags
.pad
= flags
->pad
;
303 if (flags
->decimal
!= DECIMAL_UNSPECIFIED
)
304 u
->flags
.decimal
= flags
->decimal
;
305 if (flags
->encoding
!= ENCODING_UNSPECIFIED
)
306 u
->flags
.encoding
= flags
->encoding
;
307 if (flags
->async
!= ASYNC_UNSPECIFIED
)
308 u
->flags
.async
= flags
->async
;
309 if (flags
->round
!= ROUND_UNSPECIFIED
)
310 u
->flags
.round
= flags
->round
;
311 if (flags
->sign
!= SIGN_UNSPECIFIED
)
312 u
->flags
.sign
= flags
->sign
;
314 /* Reposition the file if necessary. */
316 switch (flags
->position
)
318 case POSITION_UNSPECIFIED
:
322 case POSITION_REWIND
:
323 if (sseek (u
->s
, 0, SEEK_SET
) != 0)
326 u
->current_record
= 0;
332 case POSITION_APPEND
:
333 if (sseek (u
->s
, 0, SEEK_END
) < 0)
336 if (flags
->access
!= ACCESS_STREAM
)
337 u
->current_record
= 0;
339 u
->endfile
= AT_ENDFILE
; /* We are at the end. */
343 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
352 /* Open an unused unit. */
355 new_unit (st_parameter_open
*opp
, gfc_unit
*u
, unit_flags
*flags
)
359 char tmpname
[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
361 /* Change unspecifieds to defaults. Leave (flags->action ==
362 ACTION_UNSPECIFIED) alone so open_external() can set it based on
363 what type of open actually works. */
365 if (flags
->access
== ACCESS_UNSPECIFIED
)
366 flags
->access
= ACCESS_SEQUENTIAL
;
368 if (flags
->form
== FORM_UNSPECIFIED
)
369 flags
->form
= (flags
->access
== ACCESS_SEQUENTIAL
)
370 ? FORM_FORMATTED
: FORM_UNFORMATTED
;
372 if (flags
->async
== ASYNC_UNSPECIFIED
)
373 flags
->async
= ASYNC_NO
;
375 if (flags
->status
== STATUS_UNSPECIFIED
)
376 flags
->status
= STATUS_UNKNOWN
;
378 if (flags
->cc
== CC_UNSPECIFIED
)
379 flags
->cc
= flags
->form
== FORM_UNFORMATTED
? CC_NONE
: CC_LIST
;
380 else if (flags
->form
== FORM_UNFORMATTED
&& flags
->cc
!= CC_NONE
)
382 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
383 "CARRIAGECONTROL parameter conflicts with UNFORMATTED form in "
390 if (flags
->delim
!= DELIM_UNSPECIFIED
391 && flags
->form
== FORM_UNFORMATTED
)
393 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
394 "DELIM parameter conflicts with UNFORMATTED form in "
399 if (flags
->blank
== BLANK_UNSPECIFIED
)
400 flags
->blank
= BLANK_NULL
;
403 if (flags
->form
== FORM_UNFORMATTED
)
405 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
406 "BLANK parameter conflicts with UNFORMATTED form in "
412 if (flags
->pad
== PAD_UNSPECIFIED
)
413 flags
->pad
= PAD_YES
;
416 if (flags
->form
== FORM_UNFORMATTED
)
418 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
419 "PAD parameter conflicts with UNFORMATTED form in "
425 if (flags
->decimal
== DECIMAL_UNSPECIFIED
)
426 flags
->decimal
= DECIMAL_POINT
;
429 if (flags
->form
== FORM_UNFORMATTED
)
431 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
432 "DECIMAL parameter conflicts with UNFORMATTED form "
433 "in OPEN statement");
438 if (flags
->encoding
== ENCODING_UNSPECIFIED
)
439 flags
->encoding
= ENCODING_DEFAULT
;
442 if (flags
->form
== FORM_UNFORMATTED
)
444 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
445 "ENCODING parameter conflicts with UNFORMATTED form in "
451 /* NB: the value for ROUND when it's not specified by the user does not
452 have to be PROCESSOR_DEFINED; the standard says that it is
453 processor dependent, and requires that it is one of the
454 possible value (see F2003, 9.4.5.13). */
455 if (flags
->round
== ROUND_UNSPECIFIED
)
456 flags
->round
= ROUND_PROCDEFINED
;
459 if (flags
->form
== FORM_UNFORMATTED
)
461 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
462 "ROUND parameter conflicts with UNFORMATTED form in "
468 if (flags
->sign
== SIGN_UNSPECIFIED
)
469 flags
->sign
= SIGN_PROCDEFINED
;
472 if (flags
->form
== FORM_UNFORMATTED
)
474 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
475 "SIGN parameter conflicts with UNFORMATTED form in "
481 if (flags
->position
!= POSITION_ASIS
&& flags
->access
== ACCESS_DIRECT
)
483 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
484 "ACCESS parameter conflicts with SEQUENTIAL access in "
489 if (flags
->position
== POSITION_UNSPECIFIED
)
490 flags
->position
= POSITION_ASIS
;
492 if (flags
->access
== ACCESS_DIRECT
493 && (opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) == 0)
495 generate_error (&opp
->common
, LIBERROR_MISSING_OPTION
,
496 "Missing RECL parameter in OPEN statement");
500 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) && opp
->recl_in
<= 0)
502 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
503 "RECL parameter is non-positive in OPEN statement");
507 switch (flags
->status
)
510 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
516 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
517 "FILE parameter must not be present in OPEN statement");
524 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
))
528 opp
->file_len
= snprintf(opp
->file
, sizeof (tmpname
), "fort.%d",
529 (int) opp
->common
.unit
);
533 internal_error (&opp
->common
, "new_unit(): Bad status");
536 /* Make sure the file isn't already open someplace else.
537 Do not error if opening file preconnected to stdin, stdout, stderr. */
540 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) != 0
541 && !(compile_options
.allow_std
& GFC_STD_F2018
))
542 u2
= find_file (opp
->file
, opp
->file_len
);
544 && (options
.stdin_unit
< 0 || u2
->unit_number
!= options
.stdin_unit
)
545 && (options
.stdout_unit
< 0 || u2
->unit_number
!= options
.stdout_unit
)
546 && (options
.stderr_unit
< 0 || u2
->unit_number
!= options
.stderr_unit
))
549 generate_error (&opp
->common
, LIBERROR_ALREADY_OPEN
, NULL
);
556 /* If the unit specified is preconnected with a file specified to be open,
557 then clear the format buffer. */
558 if ((opp
->common
.unit
== options
.stdin_unit
||
559 opp
->common
.unit
== options
.stdout_unit
||
560 opp
->common
.unit
== options
.stderr_unit
)
561 && (opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) != 0)
566 s
= open_external (opp
, flags
);
570 char *path
= fc_strdup (opp
->file
, opp
->file_len
);
571 size_t msglen
= opp
->file_len
+ 22 + sizeof (errbuf
);
572 char *msg
= xmalloc (msglen
);
573 snprintf (msg
, msglen
, "Cannot open file '%s': %s", path
,
574 gf_strerror (errno
, errbuf
, sizeof (errbuf
)));
575 generate_error (&opp
->common
, LIBERROR_OS
, msg
);
581 if (flags
->status
== STATUS_NEW
|| flags
->status
== STATUS_REPLACE
)
582 flags
->status
= STATUS_OLD
;
584 /* Create the unit structure. */
586 if (u
->unit_number
!= opp
->common
.unit
)
587 internal_error (&opp
->common
, "Unit number changed");
591 u
->endfile
= NO_ENDFILE
;
593 u
->current_record
= 0;
599 if (flags
->position
== POSITION_APPEND
)
601 if (sseek (u
->s
, 0, SEEK_END
) < 0)
603 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
606 u
->endfile
= AT_ENDFILE
;
609 /* Unspecified recl ends up with a processor dependent value. */
611 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
613 u
->flags
.has_recl
= 1;
614 u
->recl
= opp
->recl_in
;
615 u
->recl_subrecord
= u
->recl
;
616 u
->bytes_left
= u
->recl
;
620 u
->flags
.has_recl
= 0;
621 u
->recl
= default_recl
;
622 if (compile_options
.max_subrecord_length
)
624 u
->recl_subrecord
= compile_options
.max_subrecord_length
;
628 switch (compile_options
.record_marker
)
632 case sizeof (GFC_INTEGER_4
):
633 u
->recl_subrecord
= GFC_MAX_SUBRECORD_LENGTH
;
636 case sizeof (GFC_INTEGER_8
):
637 u
->recl_subrecord
= max_offset
- 16;
641 runtime_error ("Illegal value for record marker");
647 /* If the file is direct access, calculate the maximum record number
648 via a division now instead of letting the multiplication overflow
651 if (flags
->access
== ACCESS_DIRECT
)
652 u
->maxrec
= max_offset
/ u
->recl
;
654 if (flags
->access
== ACCESS_STREAM
)
656 u
->maxrec
= max_offset
;
657 /* F2018 (N2137) 12.10.2.26: If the connection is for stream
658 access recl is assigned the value -2. */
661 u
->strm_pos
= stell (u
->s
) + 1;
664 u
->filename
= fc_strdup (opp
->file
, opp
->file_len
);
666 /* Curiously, the standard requires that the
667 position specifier be ignored for new files so a newly connected
668 file starts out at the initial point. We still need to figure
669 out if the file is at the end or not. */
673 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
676 if (flags
->form
== FORM_FORMATTED
)
678 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
679 fbuf_init (u
, u
->recl
);
686 /* Check if asynchrounous. */
687 if (flags
->async
== ASYNC_YES
)
696 /* Free memory associated with a temporary filename. */
698 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
708 /* Open a unit which is already open. This involves changing the
709 modes or closing what is there now and opening the new file. */
712 already_open (st_parameter_open
*opp
, gfc_unit
*u
, unit_flags
*flags
)
714 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
716 edit_modes (opp
, u
, flags
);
720 /* If the file is connected to something else, close it and open a
723 if (!compare_file_filename (u
, opp
->file
, opp
->file_len
))
725 if (sclose (u
->s
) == -1)
728 generate_error (&opp
->common
, LIBERROR_OS
,
729 "Error closing file in OPEN statement");
735 #if !HAVE_UNLINK_OPEN_FILE
736 if (u
->filename
&& u
->flags
.status
== STATUS_SCRATCH
)
737 remove (u
->filename
);
742 u
= new_unit (opp
, u
, flags
);
748 edit_modes (opp
, u
, flags
);
754 extern void st_open (st_parameter_open
*opp
);
755 export_proto(st_open
);
758 st_open (st_parameter_open
*opp
)
762 GFC_INTEGER_4 cf
= opp
->common
.flags
;
765 library_start (&opp
->common
);
767 /* Decode options. */
768 flags
.readonly
= !(cf
& IOPARM_OPEN_HAS_READONLY
) ? 0 : opp
->readonly
;
770 flags
.access
= !(cf
& IOPARM_OPEN_HAS_ACCESS
) ? ACCESS_UNSPECIFIED
:
771 find_option (&opp
->common
, opp
->access
, opp
->access_len
,
772 access_opt
, "Bad ACCESS parameter in OPEN statement");
774 flags
.action
= !(cf
& IOPARM_OPEN_HAS_ACTION
) ? ACTION_UNSPECIFIED
:
775 find_option (&opp
->common
, opp
->action
, opp
->action_len
,
776 action_opt
, "Bad ACTION parameter in OPEN statement");
778 flags
.cc
= !(cf
& IOPARM_OPEN_HAS_CC
) ? CC_UNSPECIFIED
:
779 find_option (&opp
->common
, opp
->cc
, opp
->cc_len
,
780 cc_opt
, "Bad CARRIAGECONTROL parameter in OPEN statement");
782 flags
.share
= !(cf
& IOPARM_OPEN_HAS_SHARE
) ? SHARE_UNSPECIFIED
:
783 find_option (&opp
->common
, opp
->share
, opp
->share_len
,
784 share_opt
, "Bad SHARE parameter in OPEN statement");
786 flags
.blank
= !(cf
& IOPARM_OPEN_HAS_BLANK
) ? BLANK_UNSPECIFIED
:
787 find_option (&opp
->common
, opp
->blank
, opp
->blank_len
,
788 blank_opt
, "Bad BLANK parameter in OPEN statement");
790 flags
.delim
= !(cf
& IOPARM_OPEN_HAS_DELIM
) ? DELIM_UNSPECIFIED
:
791 find_option (&opp
->common
, opp
->delim
, opp
->delim_len
,
792 delim_opt
, "Bad DELIM parameter in OPEN statement");
794 flags
.pad
= !(cf
& IOPARM_OPEN_HAS_PAD
) ? PAD_UNSPECIFIED
:
795 find_option (&opp
->common
, opp
->pad
, opp
->pad_len
,
796 pad_opt
, "Bad PAD parameter in OPEN statement");
798 flags
.decimal
= !(cf
& IOPARM_OPEN_HAS_DECIMAL
) ? DECIMAL_UNSPECIFIED
:
799 find_option (&opp
->common
, opp
->decimal
, opp
->decimal_len
,
800 decimal_opt
, "Bad DECIMAL parameter in OPEN statement");
802 flags
.encoding
= !(cf
& IOPARM_OPEN_HAS_ENCODING
) ? ENCODING_UNSPECIFIED
:
803 find_option (&opp
->common
, opp
->encoding
, opp
->encoding_len
,
804 encoding_opt
, "Bad ENCODING parameter in OPEN statement");
806 flags
.async
= !(cf
& IOPARM_OPEN_HAS_ASYNCHRONOUS
) ? ASYNC_UNSPECIFIED
:
807 find_option (&opp
->common
, opp
->asynchronous
, opp
->asynchronous_len
,
808 async_opt
, "Bad ASYNCHRONOUS parameter in OPEN statement");
810 flags
.round
= !(cf
& IOPARM_OPEN_HAS_ROUND
) ? ROUND_UNSPECIFIED
:
811 find_option (&opp
->common
, opp
->round
, opp
->round_len
,
812 round_opt
, "Bad ROUND parameter in OPEN statement");
814 flags
.sign
= !(cf
& IOPARM_OPEN_HAS_SIGN
) ? SIGN_UNSPECIFIED
:
815 find_option (&opp
->common
, opp
->sign
, opp
->sign_len
,
816 sign_opt
, "Bad SIGN parameter in OPEN statement");
818 flags
.form
= !(cf
& IOPARM_OPEN_HAS_FORM
) ? FORM_UNSPECIFIED
:
819 find_option (&opp
->common
, opp
->form
, opp
->form_len
,
820 form_opt
, "Bad FORM parameter in OPEN statement");
822 flags
.position
= !(cf
& IOPARM_OPEN_HAS_POSITION
) ? POSITION_UNSPECIFIED
:
823 find_option (&opp
->common
, opp
->position
, opp
->position_len
,
824 position_opt
, "Bad POSITION parameter in OPEN statement");
826 flags
.status
= !(cf
& IOPARM_OPEN_HAS_STATUS
) ? STATUS_UNSPECIFIED
:
827 find_option (&opp
->common
, opp
->status
, opp
->status_len
,
828 status_opt
, "Bad STATUS parameter in OPEN statement");
830 /* First, we check wether the convert flag has been set via environment
831 variable. This overrides the convert tag in the open statement. */
833 conv
= get_unformatted_convert (opp
->common
.unit
);
835 if (conv
== GFC_CONVERT_NONE
)
837 /* Nothing has been set by environment variable, check the convert tag. */
838 if (cf
& IOPARM_OPEN_HAS_CONVERT
)
839 conv
= find_option (&opp
->common
, opp
->convert
, opp
->convert_len
,
841 "Bad CONVERT parameter in OPEN statement");
843 conv
= compile_options
.convert
;
848 #ifdef HAVE_GFC_REAL_17
849 flags
.convert
= conv
& (GFC_CONVERT_R16_IEEE
| GFC_CONVERT_R16_IBM
);
850 conv
&= ~(GFC_CONVERT_R16_IEEE
| GFC_CONVERT_R16_IBM
);
855 case GFC_CONVERT_NATIVE
:
856 case GFC_CONVERT_SWAP
:
859 case GFC_CONVERT_BIG
:
860 conv
= __BYTE_ORDER__
== __ORDER_BIG_ENDIAN__
? GFC_CONVERT_NATIVE
: GFC_CONVERT_SWAP
;
863 case GFC_CONVERT_LITTLE
:
864 conv
= __BYTE_ORDER__
== __ORDER_BIG_ENDIAN__
? GFC_CONVERT_SWAP
: GFC_CONVERT_NATIVE
;
868 internal_error (&opp
->common
, "Illegal value for CONVERT");
872 flags
.convert
|= conv
;
874 if (flags
.position
!= POSITION_UNSPECIFIED
875 && flags
.access
== ACCESS_DIRECT
)
876 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
877 "Cannot use POSITION with direct access files");
880 && flags
.action
!= ACTION_UNSPECIFIED
&& flags
.action
!= ACTION_READ
)
881 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
882 "ACTION conflicts with READONLY in OPEN statement");
884 if (flags
.access
== ACCESS_APPEND
)
886 if (flags
.position
!= POSITION_UNSPECIFIED
887 && flags
.position
!= POSITION_APPEND
)
888 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
889 "Conflicting ACCESS and POSITION flags in"
892 notify_std (&opp
->common
, GFC_STD_GNU
,
893 "Extension: APPEND as a value for ACCESS in OPEN statement");
894 flags
.access
= ACCESS_SEQUENTIAL
;
895 flags
.position
= POSITION_APPEND
;
898 if (flags
.position
== POSITION_UNSPECIFIED
)
899 flags
.position
= POSITION_ASIS
;
901 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
903 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_NEWUNIT
))
904 opp
->common
.unit
= newunit_alloc ();
905 else if (opp
->common
.unit
< 0)
907 u
= find_unit (opp
->common
.unit
);
908 if (u
== NULL
) /* Negative unit and no NEWUNIT-created unit found. */
910 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
911 "Bad unit number in OPEN statement");
918 u
= find_or_create_unit (opp
->common
.unit
);
921 u
= new_unit (opp
, u
, &flags
);
926 already_open (opp
, u
, &flags
);
929 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_NEWUNIT
)
930 && (opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
931 *opp
->newunit
= opp
->common
.unit
;