]> gcc.gnu.org Git - gcc.git/blob - libgfortran/io/open.c
eaeb5a298c0c694c94363af9a73593fb26948cb2
[gcc.git] / libgfortran / io / open.c
1 /* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
3
4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
5
6 Libgfortran is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
10
11 In addition to the permissions in the GNU General Public License, the
12 Free Software Foundation gives you unlimited permission to link the
13 compiled version of this file into combinations with other programs,
14 and to distribute those combinations without any restriction coming
15 from the use of this file. (The General Public License restrictions
16 do apply in other respects; for example, they cover modification of
17 the file, and distribution when not linked into a combine
18 executable.)
19
20 Libgfortran is distributed in the hope that it will be useful,
21 but WITHOUT ANY WARRANTY; without even the implied warranty of
22 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 GNU General Public License for more details.
24
25 You should have received a copy of the GNU General Public License
26 along with Libgfortran; see the file COPYING. If not, write to
27 the Free Software Foundation, 59 Temple Place - Suite 330,
28 Boston, MA 02111-1307, USA. */
29
30 #include "config.h"
31 #include <unistd.h>
32 #include <stdio.h>
33 #include <string.h>
34 #include "libgfortran.h"
35 #include "io.h"
36
37
38 static st_option access_opt[] = {
39 {"sequential", ACCESS_SEQUENTIAL},
40 {"direct", ACCESS_DIRECT},
41 {NULL}
42 };
43
44 static st_option action_opt[] =
45 {
46 { "read", ACTION_READ},
47 { "write", ACTION_WRITE},
48 { "readwrite", ACTION_READWRITE},
49 { NULL}
50 };
51
52 static st_option blank_opt[] =
53 {
54 { "null", BLANK_NULL},
55 { "zero", BLANK_ZERO},
56 { NULL}
57 };
58
59 static st_option delim_opt[] =
60 {
61 { "none", DELIM_NONE},
62 { "apostrophe", DELIM_APOSTROPHE},
63 { "quote", DELIM_QUOTE},
64 { NULL}
65 };
66
67 static st_option form_opt[] =
68 {
69 { "formatted", FORM_FORMATTED},
70 { "unformatted", FORM_UNFORMATTED},
71 { NULL}
72 };
73
74 static st_option position_opt[] =
75 {
76 { "asis", POSITION_ASIS},
77 { "rewind", POSITION_REWIND},
78 { "append", POSITION_APPEND},
79 { NULL}
80 };
81
82 static st_option status_opt[] =
83 {
84 { "unknown", STATUS_UNKNOWN},
85 { "old", STATUS_OLD},
86 { "new", STATUS_NEW},
87 { "replace", STATUS_REPLACE},
88 { "scratch", STATUS_SCRATCH},
89 { NULL}
90 };
91
92 static st_option pad_opt[] =
93 {
94 { "yes", PAD_YES},
95 { "no", PAD_NO},
96 { NULL}
97 };
98
99
100 /* Given a unit, test to see if the file is positioned at the terminal
101 point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
102 This prevents us from changing the state from AFTER_ENDFILE to
103 AT_ENDFILE. */
104
105 void
106 test_endfile (gfc_unit * u)
107 {
108 if (u->endfile == NO_ENDFILE && file_length (u->s) == file_position (u->s))
109 u->endfile = AT_ENDFILE;
110 }
111
112
113 /* Change the modes of a file, those that are allowed * to be
114 changed. */
115
116 static void
117 edit_modes (gfc_unit * u, unit_flags * flags)
118 {
119 /* Complain about attempts to change the unchangeable. */
120
121 if (flags->status != STATUS_UNSPECIFIED &&
122 u->flags.status != flags->position)
123 generate_error (ERROR_BAD_OPTION,
124 "Cannot change STATUS parameter in OPEN statement");
125
126 if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access)
127 generate_error (ERROR_BAD_OPTION,
128 "Cannot change ACCESS parameter in OPEN statement");
129
130 if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form)
131 generate_error (ERROR_BAD_OPTION,
132 "Cannot change FORM parameter in OPEN statement");
133
134 if (ioparm.recl_in != 0 && ioparm.recl_in != u->recl)
135 generate_error (ERROR_BAD_OPTION,
136 "Cannot change RECL parameter in OPEN statement");
137
138 if (flags->action != ACTION_UNSPECIFIED && u->flags.access != flags->access)
139 generate_error (ERROR_BAD_OPTION,
140 "Cannot change ACTION parameter in OPEN statement");
141
142 /* Status must be OLD if present. */
143
144 if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD)
145 generate_error (ERROR_BAD_OPTION,
146 "OPEN statement must have a STATUS of OLD");
147
148 if (u->flags.form == FORM_UNFORMATTED)
149 {
150 if (flags->delim != DELIM_UNSPECIFIED)
151 generate_error (ERROR_OPTION_CONFLICT,
152 "DELIM parameter conflicts with UNFORMATTED form in "
153 "OPEN statement");
154
155 if (flags->blank != BLANK_UNSPECIFIED)
156 generate_error (ERROR_OPTION_CONFLICT,
157 "BLANK parameter conflicts with UNFORMATTED form in "
158 "OPEN statement");
159
160 if (flags->pad != PAD_UNSPECIFIED)
161 generate_error (ERROR_OPTION_CONFLICT,
162 "PAD paramter conflicts with UNFORMATTED form in "
163 "OPEN statement");
164 }
165
166 if (ioparm.library_return == LIBRARY_OK)
167 {
168 /* Change the changeable: */
169 if (flags->blank != BLANK_UNSPECIFIED)
170 u->flags.blank = flags->blank;
171 if (flags->delim != DELIM_UNSPECIFIED)
172 u->flags.delim = flags->delim;
173 if (flags->pad != PAD_UNSPECIFIED)
174 u->flags.pad = flags->pad;
175 }
176
177 /* Reposition the file if necessary. */
178
179 switch (flags->position)
180 {
181 case POSITION_UNSPECIFIED:
182 case POSITION_ASIS:
183 break;
184
185 case POSITION_REWIND:
186 if (sseek (u->s, 0) == FAILURE)
187 goto seek_error;
188
189 u->current_record = 0;
190 u->last_record = 0;
191
192 test_endfile (u); /* We might be at the end. */
193 break;
194
195 case POSITION_APPEND:
196 if (sseek (u->s, file_length (u->s)) == FAILURE)
197 goto seek_error;
198
199 u->current_record = 0;
200 u->endfile = AT_ENDFILE; /* We are at the end. */
201 break;
202
203 seek_error:
204 generate_error (ERROR_OS, NULL);
205 break;
206 }
207 }
208
209
210 /* Open an unused unit. */
211
212 void
213 new_unit (unit_flags * flags)
214 {
215 gfc_unit *u;
216 stream *s;
217 char tmpname[5 /* fort. */ + 10 /* digits of unit number */ + 1 /* 0 */];
218
219 /* Change unspecifieds to defaults. Leave (flags->action ==
220 ACTION_UNSPECIFIED) alone so open_external() can set it based on
221 what type of open actually works. */
222
223 if (flags->access == ACCESS_UNSPECIFIED)
224 flags->access = ACCESS_SEQUENTIAL;
225
226 if (flags->form == FORM_UNSPECIFIED)
227 flags->form = (flags->access == ACCESS_SEQUENTIAL)
228 ? FORM_FORMATTED : FORM_UNFORMATTED;
229
230
231 if (flags->delim == DELIM_UNSPECIFIED)
232 flags->delim = DELIM_NONE;
233 else
234 {
235 if (flags->form == FORM_UNFORMATTED)
236 {
237 generate_error (ERROR_OPTION_CONFLICT,
238 "DELIM parameter conflicts with UNFORMATTED form in "
239 "OPEN statement");
240 goto cleanup;
241 }
242 }
243
244 if (flags->blank == BLANK_UNSPECIFIED)
245 flags->blank = BLANK_NULL;
246 else
247 {
248 if (flags->form == FORM_UNFORMATTED)
249 {
250 generate_error (ERROR_OPTION_CONFLICT,
251 "BLANK parameter conflicts with UNFORMATTED form in "
252 "OPEN statement");
253 goto cleanup;
254 }
255 }
256
257 if (flags->pad == PAD_UNSPECIFIED)
258 flags->pad = PAD_YES;
259 else
260 {
261 if (flags->form == FORM_UNFORMATTED)
262 {
263 generate_error (ERROR_OPTION_CONFLICT,
264 "PAD paramter conflicts with UNFORMATTED form in "
265 "OPEN statement");
266 goto cleanup;
267 }
268 }
269
270 if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
271 {
272 generate_error (ERROR_OPTION_CONFLICT,
273 "ACCESS parameter conflicts with SEQUENTIAL access in "
274 "OPEN statement");
275 goto cleanup;
276 }
277 else
278 if (flags->position == POSITION_UNSPECIFIED)
279 flags->position = POSITION_ASIS;
280
281
282 if (flags->status == STATUS_UNSPECIFIED)
283 flags->status = STATUS_UNKNOWN;
284
285 /* Checks. */
286
287 if (flags->access == ACCESS_DIRECT && ioparm.recl_in == 0)
288 {
289 generate_error (ERROR_MISSING_OPTION,
290 "Missing RECL parameter in OPEN statement");
291 goto cleanup;
292 }
293
294 if (ioparm.recl_in != 0 && ioparm.recl_in <= 0)
295 {
296 generate_error (ERROR_BAD_OPTION,
297 "RECL parameter is non-positive in OPEN statement");
298 goto cleanup;
299 }
300
301 switch (flags->status)
302 {
303 case STATUS_SCRATCH:
304 if (ioparm.file == NULL)
305 break;
306
307 generate_error (ERROR_BAD_OPTION,
308 "FILE parameter must not be present in OPEN statement");
309 return;
310
311 case STATUS_OLD:
312 case STATUS_NEW:
313 case STATUS_REPLACE:
314 case STATUS_UNKNOWN:
315 if (ioparm.file != NULL)
316 break;
317
318 ioparm.file = tmpname;
319 ioparm.file_len = sprintf(ioparm.file, "fort.%d", ioparm.unit);
320 break;
321
322 default:
323 internal_error ("new_unit(): Bad status");
324 }
325
326 /* Make sure the file isn't already open someplace else.
327 Do not error if opening file preconnected to stdin, stdout, stderr. */
328
329 u = find_file ();
330 if (u != NULL
331 && (options.stdin_unit < 0 || u->unit_number != options.stdin_unit)
332 && (options.stdout_unit < 0 || u->unit_number != options.stdout_unit)
333 && (options.stderr_unit < 0 || u->unit_number != options.stderr_unit))
334 {
335 generate_error (ERROR_ALREADY_OPEN, NULL);
336 goto cleanup;
337 }
338
339 /* Open file. */
340
341 s = open_external (flags);
342 if (s == NULL)
343 {
344 generate_error (ERROR_OS, NULL);
345 goto cleanup;
346 }
347
348 if (flags->status == STATUS_NEW || flags->status == STATUS_REPLACE)
349 flags->status = STATUS_OLD;
350
351 /* Create the unit structure. */
352
353 u = get_mem (sizeof (gfc_unit) + ioparm.file_len);
354
355 u->unit_number = ioparm.unit;
356 u->s = s;
357 u->flags = *flags;
358
359 /* Unspecified recl ends up with a processor dependent value. */
360
361 u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : DEFAULT_RECL;
362 u->last_record = 0;
363 u->current_record = 0;
364
365 /* If the file is direct access, calculate the maximum record number
366 via a division now instead of letting the multiplication overflow
367 later. */
368
369 if (flags->access == ACCESS_DIRECT)
370 u->maxrec = g.max_offset / u->recl;
371
372 memmove (u->file, ioparm.file, ioparm.file_len);
373 u->file_len = ioparm.file_len;
374
375 insert_unit (u);
376
377 /* The file is now connected. Errors after this point leave the
378 file connected. Curiously, the standard requires that the
379 position specifier be ignored for new files so a newly connected
380 file starts out that the initial point. We still need to figure
381 out if the file is at the end or not. */
382
383 test_endfile (u);
384
385 cleanup:
386
387 /* Free memory associated with a temporary filename. */
388
389 if (flags->status == STATUS_SCRATCH)
390 free_mem (ioparm.file);
391 }
392
393
394 /* Open a unit which is already open. This involves changing the
395 modes or closing what is there now and opening the new file. */
396
397 static void
398 already_open (gfc_unit * u, unit_flags * flags)
399 {
400 if (ioparm.file == NULL)
401 {
402 edit_modes (u, flags);
403 return;
404 }
405
406 /* If the file is connected to something else, close it and open a
407 new unit. */
408
409 if (!compare_file_filename (u->s, ioparm.file, ioparm.file_len))
410 {
411 if (close_unit (u))
412 {
413 generate_error (ERROR_OS, "Error closing file in OPEN statement");
414 return;
415 }
416
417 new_unit (flags);
418 return;
419 }
420
421 edit_modes (u, flags);
422 }
423
424
425 /* Open file. */
426
427 extern void st_open (void);
428 export_proto(st_open);
429
430 void
431 st_open (void)
432 {
433 unit_flags flags;
434 gfc_unit *u = NULL;
435
436 library_start ();
437
438 /* Decode options. */
439
440 flags.access = (ioparm.access == NULL) ? ACCESS_UNSPECIFIED :
441 find_option (ioparm.access, ioparm.access_len, access_opt,
442 "Bad ACCESS parameter in OPEN statement");
443
444 flags.action = (ioparm.action == NULL) ? ACTION_UNSPECIFIED :
445 find_option (ioparm.action, ioparm.action_len, action_opt,
446 "Bad ACTION parameter in OPEN statement");
447
448 flags.blank = (ioparm.blank == NULL) ? BLANK_UNSPECIFIED :
449 find_option (ioparm.blank, ioparm.blank_len, blank_opt,
450 "Bad BLANK parameter in OPEN statement");
451
452 flags.delim = (ioparm.delim == NULL) ? DELIM_UNSPECIFIED :
453 find_option (ioparm.delim, ioparm.delim_len, delim_opt,
454 "Bad DELIM parameter in OPEN statement");
455
456 flags.pad = (ioparm.pad == NULL) ? PAD_UNSPECIFIED :
457 find_option (ioparm.pad, ioparm.pad_len, pad_opt,
458 "Bad PAD parameter in OPEN statement");
459
460 flags.form = (ioparm.form == NULL) ? FORM_UNSPECIFIED :
461 find_option (ioparm.form, ioparm.form_len, form_opt,
462 "Bad FORM parameter in OPEN statement");
463
464 flags.position = (ioparm.position == NULL) ? POSITION_UNSPECIFIED :
465 find_option (ioparm.position, ioparm.position_len, position_opt,
466 "Bad POSITION parameter in OPEN statement");
467
468 flags.status = (ioparm.status == NULL) ? STATUS_UNSPECIFIED :
469 find_option (ioparm.status, ioparm.status_len, status_opt,
470 "Bad STATUS parameter in OPEN statement");
471
472 if (ioparm.unit < 0)
473 generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement");
474
475 if (flags.position != POSITION_UNSPECIFIED
476 && flags.access == ACCESS_DIRECT)
477 generate_error (ERROR_BAD_OPTION,
478 "Cannot use POSITION with direct access files");
479
480 if (flags.position == POSITION_UNSPECIFIED)
481 flags.position = POSITION_ASIS;
482
483 if (ioparm.library_return != LIBRARY_OK)
484 return;
485
486 u = find_unit (ioparm.unit);
487
488 if (u == NULL)
489 new_unit (&flags);
490 else
491 already_open (u, &flags);
492
493 library_end ();
494 }
This page took 0.056389 seconds and 4 git commands to generate.