1 /* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
2 Contributed by Andy Vaught
4 This file is part of the GNU Fortran 95 runtime library (libgfortran).
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)
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.
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, 51 Franklin Street, Fifth Floor,
19 Boston, MA 02110-1301, USA. */
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. */
31 /* IO library include. */
34 #include "libgfortran.h"
36 #define DEFAULT_TEMPDIR "/tmp"
38 /* Basic types used in data transfers. */
41 { BT_NULL
, BT_INTEGER
, BT_LOGICAL
, BT_CHARACTER
, BT_REAL
,
48 { SUCCESS
= 1, FAILURE
}
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
*);
63 /* Macros for doing file I/O given a stream. */
65 #define sfree(s) ((s)->sfree)(s)
66 #define sclose(s) ((s)->close)(s)
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)
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)
74 #define sseek(s, pos) ((s)->seek)(s, pos)
75 #define struncate(s) ((s)->truncate)(s)
77 /* Representation of a namelist object in libgfortran
80 &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../
82 &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END
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.
90 These requirements are met by the following data structures.
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
96 typedef struct nml_loop_spec
99 /* Index counter for this dimension. */
102 /* Start for the index counter. */
105 /* End for the index counter. */
108 /* Step for the index counter. */
113 /* namelist_info type contains all the scalar information about the
114 object and arrays of descriptor_dimension and nml_loop_spec types for
117 typedef struct namelist_type
120 /* Object type, stored as GFC_DTYPE_xxxx. */
126 /* Address for the start of the object's data. */
129 /* Flag to show that a read is to be attempted for this node. */
132 /* Length of intrinsic type in bytes. */
135 /* Rank of the object. */
138 /* Overall size of the object in bytes. */
141 /* Length of character string. */
142 index_type string_length
;
144 descriptor_dimension
* dim
;
146 struct namelist_type
* next
;
150 /* Options for the OPEN statement. */
153 { ACCESS_SEQUENTIAL
, ACCESS_DIRECT
,
159 { ACTION_READ
, ACTION_WRITE
, ACTION_READWRITE
,
165 { BLANK_NULL
, BLANK_ZERO
, BLANK_UNSPECIFIED
}
169 { DELIM_NONE
, DELIM_APOSTROPHE
, DELIM_QUOTE
,
175 { FORM_FORMATTED
, FORM_UNFORMATTED
, FORM_UNSPECIFIED
}
179 { POSITION_ASIS
, POSITION_REWIND
, POSITION_APPEND
,
185 { STATUS_UNKNOWN
, STATUS_OLD
, STATUS_NEW
, STATUS_SCRATCH
,
186 STATUS_REPLACE
, STATUS_UNSPECIFIED
191 { PAD_YES
, PAD_NO
, PAD_UNSPECIFIED
}
195 { ADVANCE_YES
, ADVANCE_NO
, ADVANCE_UNSPECIFIED
}
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. */
212 GFC_INTEGER_4 err
, end
, eor
, list_format
; /* These are flags, not values. */
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
229 GFC_INTEGER_4
*iostat
, *exist
, *opened
, *number
, *named
;
231 GFC_INTEGER_4
*nextrec
, *size
;
233 GFC_INTEGER_4 recl_in
;
234 GFC_INTEGER_4
*recl_out
;
236 GFC_INTEGER_4
*iolength
;
238 #define CHARACTER(name) \
240 gfc_charlen_type name ## _len
246 CHARACTER (position
);
253 CHARACTER (internal_unit
);
254 CHARACTER (sequential
);
256 CHARACTER (formatted
);
257 CHARACTER (unformatted
);
260 CHARACTER (readwrite
);
262 /* namelist related data */
263 CHARACTER (namelist_name
);
264 GFC_INTEGER_4 namelist_read_mode
;
270 extern st_parameter ioparm
;
271 iexport_data_proto(ioparm
);
273 extern namelist_info
* ionml
;
274 internal_proto(ionml
);
284 unit_position position
;
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. */
295 #define DEFAULT_RECL 1073741824
298 typedef struct gfc_unit
304 struct gfc_unit
*left
, *right
; /* Treap links. */
307 int read_bad
, current_record
;
309 { NO_ENDFILE
, AT_ENDFILE
, AFTER_ENDFILE
}
314 gfc_offset recl
, last_record
, maxrec
, bytes_left
;
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. */
322 char file
[1]; /* Filename is allocated at the end of the structure. */
326 /* Global variables. Putting these in a structure makes it easier to
327 maintain, particularly with the constraint of a prefix. */
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. */
343 unit_blank blank_status
;
344 enum {SIGN_S
, SIGN_SS
, SIGN_SP
} sign_status
;
353 extern gfc_unit
*current_unit
;
354 internal_proto(current_unit
);
356 /* Format tokens. Only about half of these can be stored in the
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
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. */
410 /* Members for traversing the tree during data transfer. */
413 struct fnode
*current
;
421 extern int move_pos_offset (stream
*, int);
422 internal_proto(move_pos_offset
);
424 extern int compare_files (stream
*, stream
*);
425 internal_proto(compare_files
);
427 extern stream
*init_error_stream (void);
428 internal_proto(init_error_stream
);
430 extern stream
*open_external (unit_flags
*);
431 internal_proto(open_external
);
433 extern stream
*open_internal (char *, int);
434 internal_proto(open_internal
);
436 extern stream
*input_stream (void);
437 internal_proto(input_stream
);
439 extern stream
*output_stream (void);
440 internal_proto(output_stream
);
442 extern stream
*error_stream (void);
443 internal_proto(error_stream
);
445 extern int compare_file_filename (stream
*, const char *, int);
446 internal_proto(compare_file_filename
);
448 extern gfc_unit
*find_file (void);
449 internal_proto(find_file
);
451 extern int stream_at_bof (stream
*);
452 internal_proto(stream_at_bof
);
454 extern int stream_at_eof (stream
*);
455 internal_proto(stream_at_eof
);
457 extern int delete_file (gfc_unit
*);
458 internal_proto(delete_file
);
460 extern int file_exists (void);
461 internal_proto(file_exists
);
463 extern const char *inquire_sequential (const char *, int);
464 internal_proto(inquire_sequential
);
466 extern const char *inquire_direct (const char *, int);
467 internal_proto(inquire_direct
);
469 extern const char *inquire_formatted (const char *, int);
470 internal_proto(inquire_formatted
);
472 extern const char *inquire_unformatted (const char *, int);
473 internal_proto(inquire_unformatted
);
475 extern const char *inquire_read (const char *, int);
476 internal_proto(inquire_read
);
478 extern const char *inquire_write (const char *, int);
479 internal_proto(inquire_write
);
481 extern const char *inquire_readwrite (const char *, int);
482 internal_proto(inquire_readwrite
);
484 extern gfc_offset
file_length (stream
*);
485 internal_proto(file_length
);
487 extern gfc_offset
file_position (stream
*);
488 internal_proto(file_position
);
490 extern int is_seekable (stream
*);
491 internal_proto(is_seekable
);
493 extern void empty_internal_buffer(stream
*);
494 internal_proto(empty_internal_buffer
);
496 extern try flush (stream
*);
497 internal_proto(flush
);
499 extern int stream_isatty (stream
*);
500 internal_proto(stream_isatty
);
502 extern char * stream_ttyname (stream
*);
503 internal_proto(stream_ttyname
);
505 extern int unit_to_fd (int);
506 internal_proto(unit_to_fd
);
508 extern int unpack_filename (char *, const char *, int);
509 internal_proto(unpack_filename
);
513 extern void insert_unit (gfc_unit
*);
514 internal_proto(insert_unit
);
516 extern int close_unit (gfc_unit
*);
517 internal_proto(close_unit
);
519 extern int is_internal_unit (void);
520 internal_proto(is_internal_unit
);
522 extern gfc_unit
*find_unit (int);
523 internal_proto(find_unit
);
525 extern gfc_unit
*get_unit (int);
526 internal_proto(get_unit
);
530 extern void test_endfile (gfc_unit
*);
531 internal_proto(test_endfile
);
533 extern void new_unit (unit_flags
*);
534 internal_proto(new_unit
);
538 extern void parse_format (void);
539 internal_proto(parse_format
);
541 extern fnode
*next_format (void);
542 internal_proto(next_format
);
544 extern void unget_format (fnode
*);
545 internal_proto(unget_format
);
547 extern void format_error (fnode
*, const char *);
548 internal_proto(format_error
);
550 extern void free_fnodes (void);
551 internal_proto(free_fnodes
);
555 #define SCRATCH_SIZE 300
557 extern char scratch
[];
558 internal_proto(scratch
);
560 extern const char *type_name (bt
);
561 internal_proto(type_name
);
563 extern void *read_block (int *);
564 internal_proto(read_block
);
566 extern void *write_block (int);
567 internal_proto(write_block
);
569 extern void next_record (int);
570 internal_proto(next_record
);
574 extern void set_integer (void *, GFC_INTEGER_LARGEST
, int);
575 internal_proto(set_integer
);
577 extern GFC_UINTEGER_LARGEST
max_value (int, int);
578 internal_proto(max_value
);
580 extern int convert_real (void *, const char *, int);
581 internal_proto(convert_real
);
583 extern void read_a (fnode
*, char *, int);
584 internal_proto(read_a
);
586 extern void read_f (fnode
*, char *, int);
587 internal_proto(read_f
);
589 extern void read_l (fnode
*, char *, int);
590 internal_proto(read_l
);
592 extern void read_x (int);
593 internal_proto(read_x
);
595 extern void read_radix (fnode
*, char *, int, int);
596 internal_proto(read_radix
);
598 extern void read_decimal (fnode
*, char *, int);
599 internal_proto(read_decimal
);
603 extern void list_formatted_read (bt
, void *, int);
604 internal_proto(list_formatted_read
);
606 extern void finish_list_read (void);
607 internal_proto(finish_list_read
);
609 extern void init_at_eol (void);
610 internal_proto(init_at_eol
);
612 extern void namelist_read (void);
613 internal_proto(namelist_read
);
615 extern void namelist_write (void);
616 internal_proto(namelist_write
);
620 extern void write_a (fnode
*, const char *, int);
621 internal_proto(write_a
);
623 extern void write_b (fnode
*, const char *, int);
624 internal_proto(write_b
);
626 extern void write_d (fnode
*, const char *, int);
627 internal_proto(write_d
);
629 extern void write_e (fnode
*, const char *, int);
630 internal_proto(write_e
);
632 extern void write_en (fnode
*, const char *, int);
633 internal_proto(write_en
);
635 extern void write_es (fnode
*, const char *, int);
636 internal_proto(write_es
);
638 extern void write_f (fnode
*, const char *, int);
639 internal_proto(write_f
);
641 extern void write_i (fnode
*, const char *, int);
642 internal_proto(write_i
);
644 extern void write_l (fnode
*, char *, int);
645 internal_proto(write_l
);
647 extern void write_o (fnode
*, const char *, int);
648 internal_proto(write_o
);
650 extern void write_x (int, int);
651 internal_proto(write_x
);
653 extern void write_z (fnode
*, const char *, int);
654 internal_proto(write_z
);
656 extern void list_formatted_write (bt
, void *, int);
657 internal_proto(list_formatted_write
);
660 extern try notify_std (int, const char *);
661 internal_proto(notify_std
);