1 /* Copyright (C) 2002-2016 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
},
159 static const st_option async_opt
[] =
166 /* Given a unit, test to see if the file is positioned at the terminal
167 point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
168 This prevents us from changing the state from AFTER_ENDFILE to
172 test_endfile (gfc_unit
* u
)
174 if (u
->endfile
== NO_ENDFILE
)
176 gfc_offset sz
= ssize (u
->s
);
177 if (sz
== 0 || sz
== stell (u
->s
))
178 u
->endfile
= AT_ENDFILE
;
183 /* Change the modes of a file, those that are allowed * to be
187 edit_modes (st_parameter_open
*opp
, gfc_unit
* u
, unit_flags
* flags
)
189 /* Complain about attempts to change the unchangeable. */
191 if (flags
->status
!= STATUS_UNSPECIFIED
&& flags
->status
!= STATUS_OLD
&&
192 u
->flags
.status
!= flags
->status
)
193 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
194 "Cannot change STATUS parameter in OPEN statement");
196 if (flags
->access
!= ACCESS_UNSPECIFIED
&& u
->flags
.access
!= flags
->access
)
197 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
198 "Cannot change ACCESS parameter in OPEN statement");
200 if (flags
->form
!= FORM_UNSPECIFIED
&& u
->flags
.form
!= flags
->form
)
201 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
202 "Cannot change FORM parameter in OPEN statement");
204 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
)
205 && opp
->recl_in
!= u
->recl
)
206 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
207 "Cannot change RECL parameter in OPEN statement");
209 if (flags
->action
!= ACTION_UNSPECIFIED
&& u
->flags
.action
!= flags
->action
)
210 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
211 "Cannot change ACTION parameter in OPEN statement");
213 if (flags
->share
!= SHARE_UNSPECIFIED
&& u
->flags
.share
!= flags
->share
)
214 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
215 "Cannot change SHARE parameter in OPEN statement");
217 if (flags
->cc
!= CC_UNSPECIFIED
&& u
->flags
.cc
!= flags
->cc
)
218 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
219 "Cannot change CARRIAGECONTROL parameter in OPEN statement");
221 /* Status must be OLD if present. */
223 if (flags
->status
!= STATUS_UNSPECIFIED
&& flags
->status
!= STATUS_OLD
&&
224 flags
->status
!= STATUS_UNKNOWN
)
226 if (flags
->status
== STATUS_SCRATCH
)
227 notify_std (&opp
->common
, GFC_STD_GNU
,
228 "OPEN statement must have a STATUS of OLD or UNKNOWN");
230 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
231 "OPEN statement must have a STATUS of OLD or UNKNOWN");
234 if (u
->flags
.form
== FORM_UNFORMATTED
)
236 if (flags
->delim
!= DELIM_UNSPECIFIED
)
237 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
238 "DELIM parameter conflicts with UNFORMATTED form in "
241 if (flags
->blank
!= BLANK_UNSPECIFIED
)
242 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
243 "BLANK parameter conflicts with UNFORMATTED form in "
246 if (flags
->pad
!= PAD_UNSPECIFIED
)
247 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
248 "PAD parameter conflicts with UNFORMATTED form in "
251 if (flags
->decimal
!= DECIMAL_UNSPECIFIED
)
252 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
253 "DECIMAL parameter conflicts with UNFORMATTED form in "
256 if (flags
->encoding
!= ENCODING_UNSPECIFIED
)
257 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
258 "ENCODING parameter conflicts with UNFORMATTED form in "
261 if (flags
->round
!= ROUND_UNSPECIFIED
)
262 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
263 "ROUND parameter conflicts with UNFORMATTED form in "
266 if (flags
->sign
!= SIGN_UNSPECIFIED
)
267 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
268 "SIGN parameter conflicts with UNFORMATTED form in "
272 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
274 /* Change the changeable: */
275 if (flags
->blank
!= BLANK_UNSPECIFIED
)
276 u
->flags
.blank
= flags
->blank
;
277 if (flags
->delim
!= DELIM_UNSPECIFIED
)
278 u
->flags
.delim
= flags
->delim
;
279 if (flags
->pad
!= PAD_UNSPECIFIED
)
280 u
->flags
.pad
= flags
->pad
;
281 if (flags
->decimal
!= DECIMAL_UNSPECIFIED
)
282 u
->flags
.decimal
= flags
->decimal
;
283 if (flags
->encoding
!= ENCODING_UNSPECIFIED
)
284 u
->flags
.encoding
= flags
->encoding
;
285 if (flags
->async
!= ASYNC_UNSPECIFIED
)
286 u
->flags
.async
= flags
->async
;
287 if (flags
->round
!= ROUND_UNSPECIFIED
)
288 u
->flags
.round
= flags
->round
;
289 if (flags
->sign
!= SIGN_UNSPECIFIED
)
290 u
->flags
.sign
= flags
->sign
;
292 /* Reposition the file if necessary. */
294 switch (flags
->position
)
296 case POSITION_UNSPECIFIED
:
300 case POSITION_REWIND
:
301 if (sseek (u
->s
, 0, SEEK_SET
) != 0)
304 u
->current_record
= 0;
310 case POSITION_APPEND
:
311 if (sseek (u
->s
, 0, SEEK_END
) < 0)
314 if (flags
->access
!= ACCESS_STREAM
)
315 u
->current_record
= 0;
317 u
->endfile
= AT_ENDFILE
; /* We are at the end. */
321 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
330 /* Open an unused unit. */
333 new_unit (st_parameter_open
*opp
, gfc_unit
*u
, unit_flags
* flags
)
337 char tmpname
[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
339 /* Change unspecifieds to defaults. Leave (flags->action ==
340 ACTION_UNSPECIFIED) alone so open_external() can set it based on
341 what type of open actually works. */
343 if (flags
->access
== ACCESS_UNSPECIFIED
)
344 flags
->access
= ACCESS_SEQUENTIAL
;
346 if (flags
->form
== FORM_UNSPECIFIED
)
347 flags
->form
= (flags
->access
== ACCESS_SEQUENTIAL
)
348 ? FORM_FORMATTED
: FORM_UNFORMATTED
;
350 if (flags
->async
== ASYNC_UNSPECIFIED
)
351 flags
->async
= ASYNC_NO
;
353 if (flags
->status
== STATUS_UNSPECIFIED
)
354 flags
->status
= STATUS_UNKNOWN
;
356 if (flags
->cc
== CC_UNSPECIFIED
)
357 flags
->cc
= flags
->form
== FORM_UNFORMATTED
? CC_NONE
: CC_LIST
;
358 else if (flags
->form
== FORM_UNFORMATTED
&& flags
->cc
!= CC_NONE
)
360 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
361 "CARRIAGECONTROL parameter conflicts with UNFORMATTED form in "
368 if (flags
->delim
!= DELIM_UNSPECIFIED
369 && flags
->form
== FORM_UNFORMATTED
)
371 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
372 "DELIM parameter conflicts with UNFORMATTED form in "
377 if (flags
->blank
== BLANK_UNSPECIFIED
)
378 flags
->blank
= BLANK_NULL
;
381 if (flags
->form
== FORM_UNFORMATTED
)
383 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
384 "BLANK parameter conflicts with UNFORMATTED form in "
390 if (flags
->pad
== PAD_UNSPECIFIED
)
391 flags
->pad
= PAD_YES
;
394 if (flags
->form
== FORM_UNFORMATTED
)
396 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
397 "PAD parameter conflicts with UNFORMATTED form in "
403 if (flags
->decimal
== DECIMAL_UNSPECIFIED
)
404 flags
->decimal
= DECIMAL_POINT
;
407 if (flags
->form
== FORM_UNFORMATTED
)
409 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
410 "DECIMAL parameter conflicts with UNFORMATTED form "
411 "in OPEN statement");
416 if (flags
->encoding
== ENCODING_UNSPECIFIED
)
417 flags
->encoding
= ENCODING_DEFAULT
;
420 if (flags
->form
== FORM_UNFORMATTED
)
422 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
423 "ENCODING parameter conflicts with UNFORMATTED form in "
429 /* NB: the value for ROUND when it's not specified by the user does not
430 have to be PROCESSOR_DEFINED; the standard says that it is
431 processor dependent, and requires that it is one of the
432 possible value (see F2003, 9.4.5.13). */
433 if (flags
->round
== ROUND_UNSPECIFIED
)
434 flags
->round
= ROUND_PROCDEFINED
;
437 if (flags
->form
== FORM_UNFORMATTED
)
439 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
440 "ROUND parameter conflicts with UNFORMATTED form in "
446 if (flags
->sign
== SIGN_UNSPECIFIED
)
447 flags
->sign
= SIGN_PROCDEFINED
;
450 if (flags
->form
== FORM_UNFORMATTED
)
452 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
453 "SIGN parameter conflicts with UNFORMATTED form in "
459 if (flags
->position
!= POSITION_ASIS
&& flags
->access
== ACCESS_DIRECT
)
461 generate_error (&opp
->common
, LIBERROR_OPTION_CONFLICT
,
462 "ACCESS parameter conflicts with SEQUENTIAL access in "
467 if (flags
->position
== POSITION_UNSPECIFIED
)
468 flags
->position
= POSITION_ASIS
;
470 if (flags
->access
== ACCESS_DIRECT
471 && (opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) == 0)
473 generate_error (&opp
->common
, LIBERROR_MISSING_OPTION
,
474 "Missing RECL parameter in OPEN statement");
478 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
) && opp
->recl_in
<= 0)
480 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
481 "RECL parameter is non-positive in OPEN statement");
485 switch (flags
->status
)
488 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
494 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
495 "FILE parameter must not be present in OPEN statement");
502 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
))
506 opp
->file_len
= snprintf(opp
->file
, sizeof (tmpname
), "fort.%d",
507 (int) opp
->common
.unit
);
511 internal_error (&opp
->common
, "new_unit(): Bad status");
514 /* Make sure the file isn't already open someplace else.
515 Do not error if opening file preconnected to stdin, stdout, stderr. */
518 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) != 0)
519 u2
= find_file (opp
->file
, opp
->file_len
);
521 && (options
.stdin_unit
< 0 || u2
->unit_number
!= options
.stdin_unit
)
522 && (options
.stdout_unit
< 0 || u2
->unit_number
!= options
.stdout_unit
)
523 && (options
.stderr_unit
< 0 || u2
->unit_number
!= options
.stderr_unit
))
526 generate_error (&opp
->common
, LIBERROR_ALREADY_OPEN
, NULL
);
535 s
= open_external (opp
, flags
);
539 char *path
= fc_strdup (opp
->file
, opp
->file_len
);
540 size_t msglen
= opp
->file_len
+ 22 + sizeof (errbuf
);
541 char *msg
= xmalloc (msglen
);
542 snprintf (msg
, msglen
, "Cannot open file '%s': %s", path
,
543 gf_strerror (errno
, errbuf
, sizeof (errbuf
)));
544 generate_error (&opp
->common
, LIBERROR_OS
, msg
);
550 if (flags
->status
== STATUS_NEW
|| flags
->status
== STATUS_REPLACE
)
551 flags
->status
= STATUS_OLD
;
553 /* Create the unit structure. */
555 if (u
->unit_number
!= opp
->common
.unit
)
556 internal_error (&opp
->common
, "Unit number changed");
560 u
->endfile
= NO_ENDFILE
;
562 u
->current_record
= 0;
568 if (flags
->position
== POSITION_APPEND
)
570 if (sseek (u
->s
, 0, SEEK_END
) < 0)
572 generate_error (&opp
->common
, LIBERROR_OS
, NULL
);
575 u
->endfile
= AT_ENDFILE
;
578 /* Unspecified recl ends up with a processor dependent value. */
580 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
582 u
->flags
.has_recl
= 1;
583 u
->recl
= opp
->recl_in
;
584 u
->recl_subrecord
= u
->recl
;
585 u
->bytes_left
= u
->recl
;
589 u
->flags
.has_recl
= 0;
590 u
->recl
= max_offset
;
591 if (compile_options
.max_subrecord_length
)
593 u
->recl_subrecord
= compile_options
.max_subrecord_length
;
597 switch (compile_options
.record_marker
)
601 case sizeof (GFC_INTEGER_4
):
602 u
->recl_subrecord
= GFC_MAX_SUBRECORD_LENGTH
;
605 case sizeof (GFC_INTEGER_8
):
606 u
->recl_subrecord
= max_offset
- 16;
610 runtime_error ("Illegal value for record marker");
616 /* If the file is direct access, calculate the maximum record number
617 via a division now instead of letting the multiplication overflow
620 if (flags
->access
== ACCESS_DIRECT
)
621 u
->maxrec
= max_offset
/ u
->recl
;
623 if (flags
->access
== ACCESS_STREAM
)
625 u
->maxrec
= max_offset
;
628 u
->strm_pos
= stell (u
->s
) + 1;
631 u
->filename
= fc_strdup (opp
->file
, opp
->file_len
);
633 /* Curiously, the standard requires that the
634 position specifier be ignored for new files so a newly connected
635 file starts out at the initial point. We still need to figure
636 out if the file is at the end or not. */
640 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
643 if (flags
->form
== FORM_FORMATTED
)
645 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_RECL_IN
))
646 fbuf_init (u
, u
->recl
);
659 /* Free memory associated with a temporary filename. */
661 if (flags
->status
== STATUS_SCRATCH
&& opp
->file
!= NULL
)
671 /* Open a unit which is already open. This involves changing the
672 modes or closing what is there now and opening the new file. */
675 already_open (st_parameter_open
*opp
, gfc_unit
* u
, unit_flags
* flags
)
677 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_FILE
) == 0)
679 edit_modes (opp
, u
, flags
);
683 /* If the file is connected to something else, close it and open a
686 if (!compare_file_filename (u
, opp
->file
, opp
->file_len
))
688 if (sclose (u
->s
) == -1)
691 generate_error (&opp
->common
, LIBERROR_OS
,
692 "Error closing file in OPEN statement");
698 #if !HAVE_UNLINK_OPEN_FILE
699 if (u
->filename
&& u
->flags
.status
== STATUS_SCRATCH
)
700 remove (u
->filename
);
705 u
= new_unit (opp
, u
, flags
);
711 edit_modes (opp
, u
, flags
);
717 extern void st_open (st_parameter_open
*opp
);
718 export_proto(st_open
);
721 st_open (st_parameter_open
*opp
)
725 GFC_INTEGER_4 cf
= opp
->common
.flags
;
728 library_start (&opp
->common
);
730 /* Decode options. */
731 flags
.readonly
= !(cf
& IOPARM_OPEN_HAS_READONLY
) ? 0 : opp
->readonly
;
733 flags
.access
= !(cf
& IOPARM_OPEN_HAS_ACCESS
) ? ACCESS_UNSPECIFIED
:
734 find_option (&opp
->common
, opp
->access
, opp
->access_len
,
735 access_opt
, "Bad ACCESS parameter in OPEN statement");
737 flags
.action
= !(cf
& IOPARM_OPEN_HAS_ACTION
) ? ACTION_UNSPECIFIED
:
738 find_option (&opp
->common
, opp
->action
, opp
->action_len
,
739 action_opt
, "Bad ACTION parameter in OPEN statement");
741 flags
.cc
= !(cf
& IOPARM_OPEN_HAS_CC
) ? CC_UNSPECIFIED
:
742 find_option (&opp
->common
, opp
->cc
, opp
->cc_len
,
743 cc_opt
, "Bad CARRIAGECONTROL parameter in OPEN statement");
745 flags
.share
= !(cf
& IOPARM_OPEN_HAS_SHARE
) ? SHARE_UNSPECIFIED
:
746 find_option (&opp
->common
, opp
->share
, opp
->share_len
,
747 share_opt
, "Bad SHARE parameter in OPEN statement");
749 flags
.blank
= !(cf
& IOPARM_OPEN_HAS_BLANK
) ? BLANK_UNSPECIFIED
:
750 find_option (&opp
->common
, opp
->blank
, opp
->blank_len
,
751 blank_opt
, "Bad BLANK parameter in OPEN statement");
753 flags
.delim
= !(cf
& IOPARM_OPEN_HAS_DELIM
) ? DELIM_UNSPECIFIED
:
754 find_option (&opp
->common
, opp
->delim
, opp
->delim_len
,
755 delim_opt
, "Bad DELIM parameter in OPEN statement");
757 flags
.pad
= !(cf
& IOPARM_OPEN_HAS_PAD
) ? PAD_UNSPECIFIED
:
758 find_option (&opp
->common
, opp
->pad
, opp
->pad_len
,
759 pad_opt
, "Bad PAD parameter in OPEN statement");
761 flags
.decimal
= !(cf
& IOPARM_OPEN_HAS_DECIMAL
) ? DECIMAL_UNSPECIFIED
:
762 find_option (&opp
->common
, opp
->decimal
, opp
->decimal_len
,
763 decimal_opt
, "Bad DECIMAL parameter in OPEN statement");
765 flags
.encoding
= !(cf
& IOPARM_OPEN_HAS_ENCODING
) ? ENCODING_UNSPECIFIED
:
766 find_option (&opp
->common
, opp
->encoding
, opp
->encoding_len
,
767 encoding_opt
, "Bad ENCODING parameter in OPEN statement");
769 flags
.async
= !(cf
& IOPARM_OPEN_HAS_ASYNCHRONOUS
) ? ASYNC_UNSPECIFIED
:
770 find_option (&opp
->common
, opp
->asynchronous
, opp
->asynchronous_len
,
771 async_opt
, "Bad ASYNCHRONOUS parameter in OPEN statement");
773 flags
.round
= !(cf
& IOPARM_OPEN_HAS_ROUND
) ? ROUND_UNSPECIFIED
:
774 find_option (&opp
->common
, opp
->round
, opp
->round_len
,
775 round_opt
, "Bad ROUND parameter in OPEN statement");
777 flags
.sign
= !(cf
& IOPARM_OPEN_HAS_SIGN
) ? SIGN_UNSPECIFIED
:
778 find_option (&opp
->common
, opp
->sign
, opp
->sign_len
,
779 sign_opt
, "Bad SIGN parameter in OPEN statement");
781 flags
.form
= !(cf
& IOPARM_OPEN_HAS_FORM
) ? FORM_UNSPECIFIED
:
782 find_option (&opp
->common
, opp
->form
, opp
->form_len
,
783 form_opt
, "Bad FORM parameter in OPEN statement");
785 flags
.position
= !(cf
& IOPARM_OPEN_HAS_POSITION
) ? POSITION_UNSPECIFIED
:
786 find_option (&opp
->common
, opp
->position
, opp
->position_len
,
787 position_opt
, "Bad POSITION parameter in OPEN statement");
789 flags
.status
= !(cf
& IOPARM_OPEN_HAS_STATUS
) ? STATUS_UNSPECIFIED
:
790 find_option (&opp
->common
, opp
->status
, opp
->status_len
,
791 status_opt
, "Bad STATUS parameter in OPEN statement");
793 /* First, we check wether the convert flag has been set via environment
794 variable. This overrides the convert tag in the open statement. */
796 conv
= get_unformatted_convert (opp
->common
.unit
);
798 if (conv
== GFC_CONVERT_NONE
)
800 /* Nothing has been set by environment variable, check the convert tag. */
801 if (cf
& IOPARM_OPEN_HAS_CONVERT
)
802 conv
= find_option (&opp
->common
, opp
->convert
, opp
->convert_len
,
804 "Bad CONVERT parameter in OPEN statement");
806 conv
= compile_options
.convert
;
809 /* We use big_endian, which is 0 on little-endian machines
810 and 1 on big-endian machines. */
813 case GFC_CONVERT_NATIVE
:
814 case GFC_CONVERT_SWAP
:
817 case GFC_CONVERT_BIG
:
818 conv
= big_endian
? GFC_CONVERT_NATIVE
: GFC_CONVERT_SWAP
;
821 case GFC_CONVERT_LITTLE
:
822 conv
= big_endian
? GFC_CONVERT_SWAP
: GFC_CONVERT_NATIVE
;
826 internal_error (&opp
->common
, "Illegal value for CONVERT");
830 flags
.convert
= conv
;
832 if (flags
.position
!= POSITION_UNSPECIFIED
833 && flags
.access
== ACCESS_DIRECT
)
834 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
835 "Cannot use POSITION with direct access files");
838 && flags
.action
!= ACTION_UNSPECIFIED
&& flags
.action
!= ACTION_READ
)
839 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
840 "ACTION conflicts with READONLY in OPEN statement");
842 if (flags
.access
== ACCESS_APPEND
)
844 if (flags
.position
!= POSITION_UNSPECIFIED
845 && flags
.position
!= POSITION_APPEND
)
846 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
847 "Conflicting ACCESS and POSITION flags in"
850 notify_std (&opp
->common
, GFC_STD_GNU
,
851 "Extension: APPEND as a value for ACCESS in OPEN statement");
852 flags
.access
= ACCESS_SEQUENTIAL
;
853 flags
.position
= POSITION_APPEND
;
856 if (flags
.position
== POSITION_UNSPECIFIED
)
857 flags
.position
= POSITION_ASIS
;
859 if ((opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
861 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_NEWUNIT
))
862 opp
->common
.unit
= newunit_alloc ();
863 else if (opp
->common
.unit
< 0)
865 u
= find_unit (opp
->common
.unit
);
866 if (u
== NULL
) /* Negative unit and no NEWUNIT-created unit found. */
868 generate_error (&opp
->common
, LIBERROR_BAD_OPTION
,
869 "Bad unit number in OPEN statement");
876 u
= find_or_create_unit (opp
->common
.unit
);
879 u
= new_unit (opp
, u
, &flags
);
884 already_open (opp
, u
, &flags
);
887 if ((opp
->common
.flags
& IOPARM_OPEN_HAS_NEWUNIT
)
888 && (opp
->common
.flags
& IOPARM_LIBRETURN_MASK
) == IOPARM_LIBRETURN_OK
)
889 *opp
->newunit
= opp
->common
.unit
;