]> git.ipfire.org Git - thirdparty/gcc.git/blob - libgfortran/io/io.h
re PR fortran/17472 ([4.0 only] namelist does not handle arrays)
[thirdparty/gcc.git] / libgfortran / io / io.h
1 /* Copyright (C) 2002, 2003, 2004, 2005 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 Libgfortran is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with Libgfortran; see the file COPYING. If not, write to
18 the Free Software Foundation, 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* As a special exception, if you link this library with other files,
22 some of which are compiled with GCC, to produce an executable,
23 this library does not by itself cause the resulting executable
24 to be covered by the GNU General Public License.
25 This exception does not however invalidate any other reasons why
26 the executable file might be covered by the GNU General Public License. */
27
28 #ifndef GFOR_IO_H
29 #define GFOR_IO_H
30
31 /* IO library include. */
32
33 #include <setjmp.h>
34 #include "libgfortran.h"
35
36 #define DEFAULT_TEMPDIR "/var/tmp"
37
38 /* Basic types used in data transfers. */
39
40 typedef enum
41 { BT_NULL, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL,
42 BT_COMPLEX
43 }
44 bt;
45
46
47 typedef enum
48 { SUCCESS = 1, FAILURE }
49 try;
50
51 typedef struct stream
52 {
53 char *(*alloc_w_at) (struct stream *, int *, gfc_offset);
54 char *(*alloc_r_at) (struct stream *, int *, gfc_offset);
55 try (*sfree) (struct stream *);
56 try (*close) (struct stream *);
57 try (*seek) (struct stream *, gfc_offset);
58 try (*truncate) (struct stream *);
59 }
60 stream;
61
62
63 /* Macros for doing file I/O given a stream. */
64
65 #define sfree(s) ((s)->sfree)(s)
66 #define sclose(s) ((s)->close)(s)
67
68 #define salloc_r(s, len) ((s)->alloc_r_at)(s, len, -1)
69 #define salloc_w(s, len) ((s)->alloc_w_at)(s, len, -1)
70
71 #define salloc_r_at(s, len, where) ((s)->alloc_r_at)(s, len, where)
72 #define salloc_w_at(s, len, where) ((s)->alloc_w_at)(s, len, where)
73
74 #define sseek(s, pos) ((s)->seek)(s, pos)
75 #define struncate(s) ((s)->truncate)(s)
76
77 /* Representation of a namelist object in libgfortran
78
79 Namelist Records
80 &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../
81 or
82 &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END
83
84 The object can be a fully qualified, compound name for an instrinsic
85 type, derived types or derived type components. So, a substring
86 a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist
87 read. Hence full information about the structure of the object has
88 to be available to list_read.c and write.
89
90 These requirements are met by the following data structures.
91
92 nml_loop_spec contains the variables for the loops over index ranges
93 that are encountered. Since the variables can be negative, ssize_t
94 is used. */
95
96 typedef struct nml_loop_spec
97 {
98
99 /* Index counter for this dimension. */
100 ssize_t idx;
101
102 /* Start for the index counter. */
103 ssize_t start;
104
105 /* End for the index counter. */
106 ssize_t end;
107
108 /* Step for the index counter. */
109 ssize_t step;
110 }
111 nml_loop_spec;
112
113 /* namelist_info type contains all the scalar information about the
114 object and arrays of descriptor_dimension and nml_loop_spec types for
115 arrays. */
116
117 typedef struct namelist_type
118 {
119
120 /* Object type, stored as GFC_DTYPE_xxxx. */
121 bt type;
122
123 /* Object name. */
124 char * var_name;
125
126 /* Address for the start of the object's data. */
127 void * mem_pos;
128
129 /* Flag to show that a read is to be attempted for this node. */
130 int touched;
131
132 /* Length of intrinsic type in bytes. */
133 int len;
134
135 /* Rank of the object. */
136 int var_rank;
137
138 /* Overall size of the object in bytes. */
139 index_type size;
140
141 /* Length of character string. */
142 index_type string_length;
143
144 descriptor_dimension * dim;
145 nml_loop_spec * ls;
146 struct namelist_type * next;
147 }
148 namelist_info;
149
150 /* Options for the OPEN statement. */
151
152 typedef enum
153 { ACCESS_SEQUENTIAL, ACCESS_DIRECT,
154 ACCESS_UNSPECIFIED
155 }
156 unit_access;
157
158 typedef enum
159 { ACTION_READ, ACTION_WRITE, ACTION_READWRITE,
160 ACTION_UNSPECIFIED
161 }
162 unit_action;
163
164 typedef enum
165 { BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED }
166 unit_blank;
167
168 typedef enum
169 { DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE,
170 DELIM_UNSPECIFIED
171 }
172 unit_delim;
173
174 typedef enum
175 { FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED }
176 unit_form;
177
178 typedef enum
179 { POSITION_ASIS, POSITION_REWIND, POSITION_APPEND,
180 POSITION_UNSPECIFIED
181 }
182 unit_position;
183
184 typedef enum
185 { STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH,
186 STATUS_REPLACE, STATUS_UNSPECIFIED
187 }
188 unit_status;
189
190 typedef enum
191 { PAD_YES, PAD_NO, PAD_UNSPECIFIED }
192 unit_pad;
193
194 typedef enum
195 { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
196 unit_advance;
197
198 typedef enum
199 {READING, WRITING}
200 unit_mode;
201
202 /* Statement parameters. These are all the things that can appear in
203 an I/O statement. Some are inputs and some are outputs, but none
204 are both. All of these values are initially zeroed and are zeroed
205 at the end of a library statement. The relevant values need to be
206 set before entry to an I/O statement. This structure needs to be
207 duplicated by the back end. */
208
209 typedef struct
210 {
211 GFC_INTEGER_4 unit;
212 GFC_INTEGER_4 err, end, eor, list_format; /* These are flags, not values. */
213
214 /* Return values from library statements. These are returned only if
215 the labels are specified in the statement itself and the condition
216 occurs. In most cases, none of the labels are specified and the
217 return value does not have to be checked. Must be consistent with
218 the front end. */
219
220 enum
221 {
222 LIBRARY_OK = 0,
223 LIBRARY_ERROR,
224 LIBRARY_END,
225 LIBRARY_EOR
226 }
227 library_return;
228
229 GFC_INTEGER_4 *iostat, *exist, *opened, *number, *named;
230 GFC_INTEGER_4 rec;
231 GFC_INTEGER_4 *nextrec, *size;
232
233 GFC_INTEGER_4 recl_in;
234 GFC_INTEGER_4 *recl_out;
235
236 GFC_INTEGER_4 *iolength;
237
238 #define CHARACTER(name) \
239 char * name; \
240 gfc_charlen_type name ## _len
241 CHARACTER (file);
242 CHARACTER (status);
243 CHARACTER (access);
244 CHARACTER (form);
245 CHARACTER (blank);
246 CHARACTER (position);
247 CHARACTER (action);
248 CHARACTER (delim);
249 CHARACTER (pad);
250 CHARACTER (format);
251 CHARACTER (advance);
252 CHARACTER (name);
253 CHARACTER (internal_unit);
254 CHARACTER (sequential);
255 CHARACTER (direct);
256 CHARACTER (formatted);
257 CHARACTER (unformatted);
258 CHARACTER (read);
259 CHARACTER (write);
260 CHARACTER (readwrite);
261
262 /* namelist related data */
263 CHARACTER (namelist_name);
264 GFC_INTEGER_4 namelist_read_mode;
265
266 #undef CHARACTER
267 }
268 st_parameter;
269
270 extern st_parameter ioparm;
271 iexport_data_proto(ioparm);
272
273 extern namelist_info * ionml;
274 internal_proto(ionml);
275
276 typedef struct
277 {
278 unit_access access;
279 unit_action action;
280 unit_blank blank;
281 unit_delim delim;
282 unit_form form;
283 int is_notpadded;
284 unit_position position;
285 unit_status status;
286 unit_pad pad;
287 }
288 unit_flags;
289
290
291 /* The default value of record length for preconnected units is defined
292 here. This value can be overriden by an environment variable.
293 Default value is 1 Gb. */
294
295 #define DEFAULT_RECL 1073741824
296
297
298 typedef struct gfc_unit
299 {
300 int unit_number;
301
302 stream *s;
303
304 struct gfc_unit *left, *right; /* Treap links. */
305 int priority;
306
307 int read_bad, current_record;
308 enum
309 { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
310 endfile;
311
312 unit_mode mode;
313 unit_flags flags;
314 gfc_offset recl, last_record, maxrec, bytes_left;
315
316 /* recl -- Record length of the file.
317 last_record -- Last record number read or written
318 maxrec -- Maximum record number in a direct access file
319 bytes_left -- Bytes left in current record. */
320
321 int file_len;
322 char file[1]; /* Filename is allocated at the end of the structure. */
323 }
324 gfc_unit;
325
326 /* Global variables. Putting these in a structure makes it easier to
327 maintain, particularly with the constraint of a prefix. */
328
329 typedef struct
330 {
331 int in_library; /* Nonzero if a library call is being processed. */
332 int size; /* Bytes processed by the current data-transfer statement. */
333 gfc_offset max_offset; /* Maximum file offset. */
334 int item_count; /* Item number in a formatted data transfer. */
335 int reversion_flag; /* Format reversion has occurred. */
336 int first_item;
337
338 gfc_unit *unit_root;
339 int seen_dollar;
340
341 unit_mode mode;
342
343 unit_blank blank_status;
344 enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
345 int scale_factor;
346 jmp_buf eof_jump;
347 }
348 global_t;
349
350 extern global_t g;
351 internal_proto(g);
352
353 extern gfc_unit *current_unit;
354 internal_proto(current_unit);
355
356 /* Format tokens. Only about half of these can be stored in the
357 format nodes. */
358
359 typedef enum
360 {
361 FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
362 FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL,
363 FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING,
364 FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F,
365 FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END
366 }
367 format_token;
368
369
370 /* Format nodes. A format string is converted into a tree of these
371 structures, which is traversed as part of a data transfer statement. */
372
373 typedef struct fnode
374 {
375 format_token format;
376 int repeat;
377 struct fnode *next;
378 char *source;
379
380 union
381 {
382 struct
383 {
384 int w, d, e;
385 }
386 real;
387
388 struct
389 {
390 int length;
391 char *p;
392 }
393 string;
394
395 struct
396 {
397 int w, m;
398 }
399 integer;
400
401 int w;
402 int k;
403 int r;
404 int n;
405
406 struct fnode *child;
407 }
408 u;
409
410 /* Members for traversing the tree during data transfer. */
411
412 int count;
413 struct fnode *current;
414
415 }
416 fnode;
417
418
419 /* unix.c */
420
421 extern int move_pos_offset (stream *, int);
422 internal_proto(move_pos_offset);
423
424 extern int compare_files (stream *, stream *);
425 internal_proto(compare_files);
426
427 extern stream *init_error_stream (void);
428 internal_proto(init_error_stream);
429
430 extern stream *open_external (unit_flags *);
431 internal_proto(open_external);
432
433 extern stream *open_internal (char *, int);
434 internal_proto(open_internal);
435
436 extern stream *input_stream (void);
437 internal_proto(input_stream);
438
439 extern stream *output_stream (void);
440 internal_proto(output_stream);
441
442 extern stream *error_stream (void);
443 internal_proto(error_stream);
444
445 extern int compare_file_filename (stream *, const char *, int);
446 internal_proto(compare_file_filename);
447
448 extern gfc_unit *find_file (void);
449 internal_proto(find_file);
450
451 extern int stream_at_bof (stream *);
452 internal_proto(stream_at_bof);
453
454 extern int stream_at_eof (stream *);
455 internal_proto(stream_at_eof);
456
457 extern int delete_file (gfc_unit *);
458 internal_proto(delete_file);
459
460 extern int file_exists (void);
461 internal_proto(file_exists);
462
463 extern const char *inquire_sequential (const char *, int);
464 internal_proto(inquire_sequential);
465
466 extern const char *inquire_direct (const char *, int);
467 internal_proto(inquire_direct);
468
469 extern const char *inquire_formatted (const char *, int);
470 internal_proto(inquire_formatted);
471
472 extern const char *inquire_unformatted (const char *, int);
473 internal_proto(inquire_unformatted);
474
475 extern const char *inquire_read (const char *, int);
476 internal_proto(inquire_read);
477
478 extern const char *inquire_write (const char *, int);
479 internal_proto(inquire_write);
480
481 extern const char *inquire_readwrite (const char *, int);
482 internal_proto(inquire_readwrite);
483
484 extern gfc_offset file_length (stream *);
485 internal_proto(file_length);
486
487 extern gfc_offset file_position (stream *);
488 internal_proto(file_position);
489
490 extern int is_seekable (stream *);
491 internal_proto(is_seekable);
492
493 extern void empty_internal_buffer(stream *);
494 internal_proto(empty_internal_buffer);
495
496 extern try flush (stream *);
497 internal_proto(flush);
498
499 extern int unit_to_fd (int);
500 internal_proto(unit_to_fd);
501
502 /* unit.c */
503
504 extern void insert_unit (gfc_unit *);
505 internal_proto(insert_unit);
506
507 extern int close_unit (gfc_unit *);
508 internal_proto(close_unit);
509
510 extern int is_internal_unit (void);
511 internal_proto(is_internal_unit);
512
513 extern gfc_unit *find_unit (int);
514 internal_proto(find_unit);
515
516 extern gfc_unit *get_unit (int);
517 internal_proto(get_unit);
518
519 /* open.c */
520
521 extern void test_endfile (gfc_unit *);
522 internal_proto(test_endfile);
523
524 extern void new_unit (unit_flags *);
525 internal_proto(new_unit);
526
527 /* format.c */
528
529 extern void parse_format (void);
530 internal_proto(parse_format);
531
532 extern fnode *next_format (void);
533 internal_proto(next_format);
534
535 extern void unget_format (fnode *);
536 internal_proto(unget_format);
537
538 extern void format_error (fnode *, const char *);
539 internal_proto(format_error);
540
541 extern void free_fnodes (void);
542 internal_proto(free_fnodes);
543
544 /* transfer.c */
545
546 #define SCRATCH_SIZE 300
547
548 extern char scratch[];
549 internal_proto(scratch);
550
551 extern const char *type_name (bt);
552 internal_proto(type_name);
553
554 extern void *read_block (int *);
555 internal_proto(read_block);
556
557 extern void *write_block (int);
558 internal_proto(write_block);
559
560 extern void next_record (int);
561 internal_proto(next_record);
562
563 /* read.c */
564
565 extern void set_integer (void *, int64_t, int);
566 internal_proto(set_integer);
567
568 extern uint64_t max_value (int, int);
569 internal_proto(max_value);
570
571 extern int convert_real (void *, const char *, int);
572 internal_proto(convert_real);
573
574 extern void read_a (fnode *, char *, int);
575 internal_proto(read_a);
576
577 extern void read_f (fnode *, char *, int);
578 internal_proto(read_f);
579
580 extern void read_l (fnode *, char *, int);
581 internal_proto(read_l);
582
583 extern void read_x (fnode *);
584 internal_proto(read_x);
585
586 extern void read_radix (fnode *, char *, int, int);
587 internal_proto(read_radix);
588
589 extern void read_decimal (fnode *, char *, int);
590 internal_proto(read_decimal);
591
592 /* list_read.c */
593
594 extern void list_formatted_read (bt, void *, int);
595 internal_proto(list_formatted_read);
596
597 extern void finish_list_read (void);
598 internal_proto(finish_list_read);
599
600 extern void init_at_eol();
601 internal_proto(init_at_eol);
602
603 extern void namelist_read();
604 internal_proto(namelist_read);
605
606 extern void namelist_write();
607 internal_proto(namelist_write);
608
609 /* write.c */
610
611 extern void write_a (fnode *, const char *, int);
612 internal_proto(write_a);
613
614 extern void write_b (fnode *, const char *, int);
615 internal_proto(write_b);
616
617 extern void write_d (fnode *, const char *, int);
618 internal_proto(write_d);
619
620 extern void write_e (fnode *, const char *, int);
621 internal_proto(write_e);
622
623 extern void write_en (fnode *, const char *, int);
624 internal_proto(write_en);
625
626 extern void write_es (fnode *, const char *, int);
627 internal_proto(write_es);
628
629 extern void write_f (fnode *, const char *, int);
630 internal_proto(write_f);
631
632 extern void write_i (fnode *, const char *, int);
633 internal_proto(write_i);
634
635 extern void write_l (fnode *, char *, int);
636 internal_proto(write_l);
637
638 extern void write_o (fnode *, const char *, int);
639 internal_proto(write_o);
640
641 extern void write_x (fnode *);
642 internal_proto(write_x);
643
644 extern void write_z (fnode *, const char *, int);
645 internal_proto(write_z);
646
647 extern void list_formatted_write (bt, void *, int);
648 internal_proto(list_formatted_write);
649
650 #endif