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 gfc_array_char
*internal_unit_desc
;
255 CHARACTER (sequential
);
257 CHARACTER (formatted
);
258 CHARACTER (unformatted
);
261 CHARACTER (readwrite
);
263 /* namelist related data */
264 CHARACTER (namelist_name
);
265 GFC_INTEGER_4 namelist_read_mode
;
274 extern st_parameter ioparm
;
275 iexport_data_proto(ioparm
);
277 extern namelist_info
* ionml
;
278 internal_proto(ionml
);
288 unit_position position
;
295 /* The default value of record length for preconnected units is defined
296 here. This value can be overriden by an environment variable.
297 Default value is 1 Gb. */
299 #define DEFAULT_RECL 1073741824
302 typedef struct gfc_unit
308 struct gfc_unit
*left
, *right
; /* Treap links. */
311 int read_bad
, current_record
;
313 { NO_ENDFILE
, AT_ENDFILE
, AFTER_ENDFILE
}
318 gfc_offset recl
, last_record
, maxrec
, bytes_left
;
320 /* recl -- Record length of the file.
321 last_record -- Last record number read or written
322 maxrec -- Maximum record number in a direct access file
323 bytes_left -- Bytes left in current record. */
326 char file
[1]; /* Filename is allocated at the end of the structure. */
330 /* Global variables. Putting these in a structure makes it easier to
331 maintain, particularly with the constraint of a prefix. */
335 int in_library
; /* Nonzero if a library call is being processed. */
336 int size
; /* Bytes processed by the current data-transfer statement. */
337 gfc_offset max_offset
; /* Maximum file offset. */
338 int item_count
; /* Item number in a formatted data transfer. */
339 int reversion_flag
; /* Format reversion has occurred. */
347 unit_blank blank_status
;
348 enum {SIGN_S
, SIGN_SS
, SIGN_SP
} sign_status
;
357 extern gfc_unit
*current_unit
;
358 internal_proto(current_unit
);
360 /* Format tokens. Only about half of these can be stored in the
365 FMT_NONE
= 0, FMT_UNKNOWN
, FMT_SIGNED_INT
, FMT_ZERO
, FMT_POSINT
, FMT_PERIOD
,
366 FMT_COMMA
, FMT_COLON
, FMT_SLASH
, FMT_DOLLAR
, FMT_T
, FMT_TR
, FMT_TL
,
367 FMT_LPAREN
, FMT_RPAREN
, FMT_X
, FMT_S
, FMT_SS
, FMT_SP
, FMT_STRING
,
368 FMT_BADSTRING
, FMT_P
, FMT_I
, FMT_B
, FMT_BN
, FMT_BZ
, FMT_O
, FMT_Z
, FMT_F
,
369 FMT_E
, FMT_EN
, FMT_ES
, FMT_G
, FMT_L
, FMT_A
, FMT_D
, FMT_H
, FMT_END
374 /* Format nodes. A format string is converted into a tree of these
375 structures, which is traversed as part of a data transfer statement. */
414 /* Members for traversing the tree during data transfer. */
417 struct fnode
*current
;
425 extern int move_pos_offset (stream
*, int);
426 internal_proto(move_pos_offset
);
428 extern int compare_files (stream
*, stream
*);
429 internal_proto(compare_files
);
431 extern stream
*init_error_stream (void);
432 internal_proto(init_error_stream
);
434 extern stream
*open_external (unit_flags
*);
435 internal_proto(open_external
);
437 extern stream
*open_internal (char *, int);
438 internal_proto(open_internal
);
440 extern stream
*input_stream (void);
441 internal_proto(input_stream
);
443 extern stream
*output_stream (void);
444 internal_proto(output_stream
);
446 extern stream
*error_stream (void);
447 internal_proto(error_stream
);
449 extern int compare_file_filename (stream
*, const char *, int);
450 internal_proto(compare_file_filename
);
452 extern gfc_unit
*find_file (void);
453 internal_proto(find_file
);
455 extern int stream_at_bof (stream
*);
456 internal_proto(stream_at_bof
);
458 extern int stream_at_eof (stream
*);
459 internal_proto(stream_at_eof
);
461 extern int delete_file (gfc_unit
*);
462 internal_proto(delete_file
);
464 extern int file_exists (void);
465 internal_proto(file_exists
);
467 extern const char *inquire_sequential (const char *, int);
468 internal_proto(inquire_sequential
);
470 extern const char *inquire_direct (const char *, int);
471 internal_proto(inquire_direct
);
473 extern const char *inquire_formatted (const char *, int);
474 internal_proto(inquire_formatted
);
476 extern const char *inquire_unformatted (const char *, int);
477 internal_proto(inquire_unformatted
);
479 extern const char *inquire_read (const char *, int);
480 internal_proto(inquire_read
);
482 extern const char *inquire_write (const char *, int);
483 internal_proto(inquire_write
);
485 extern const char *inquire_readwrite (const char *, int);
486 internal_proto(inquire_readwrite
);
488 extern gfc_offset
file_length (stream
*);
489 internal_proto(file_length
);
491 extern gfc_offset
file_position (stream
*);
492 internal_proto(file_position
);
494 extern int is_seekable (stream
*);
495 internal_proto(is_seekable
);
497 extern int is_preconnected (stream
*);
498 internal_proto(is_preconnected
);
500 extern void empty_internal_buffer(stream
*);
501 internal_proto(empty_internal_buffer
);
503 extern try flush (stream
*);
504 internal_proto(flush
);
506 extern int stream_isatty (stream
*);
507 internal_proto(stream_isatty
);
509 extern char * stream_ttyname (stream
*);
510 internal_proto(stream_ttyname
);
512 extern int unit_to_fd (int);
513 internal_proto(unit_to_fd
);
515 extern int unpack_filename (char *, const char *, int);
516 internal_proto(unpack_filename
);
520 extern void insert_unit (gfc_unit
*);
521 internal_proto(insert_unit
);
523 extern int close_unit (gfc_unit
*);
524 internal_proto(close_unit
);
526 extern int is_internal_unit (void);
527 internal_proto(is_internal_unit
);
529 extern int is_array_io (void);
530 internal_proto(is_array_io
);
532 extern gfc_offset
get_array_unit_len (gfc_array_char
*);
533 internal_proto(get_array_unit_len
);
535 extern gfc_unit
*find_unit (int);
536 internal_proto(find_unit
);
538 extern gfc_unit
*get_unit (int);
539 internal_proto(get_unit
);
543 extern void test_endfile (gfc_unit
*);
544 internal_proto(test_endfile
);
546 extern void new_unit (unit_flags
*);
547 internal_proto(new_unit
);
551 extern void parse_format (void);
552 internal_proto(parse_format
);
554 extern fnode
*next_format (void);
555 internal_proto(next_format
);
557 extern void unget_format (fnode
*);
558 internal_proto(unget_format
);
560 extern void format_error (fnode
*, const char *);
561 internal_proto(format_error
);
563 extern void free_fnodes (void);
564 internal_proto(free_fnodes
);
568 #define SCRATCH_SIZE 300
570 extern char scratch
[];
571 internal_proto(scratch
);
573 extern const char *type_name (bt
);
574 internal_proto(type_name
);
576 extern void *read_block (int *);
577 internal_proto(read_block
);
579 extern void *write_block (int);
580 internal_proto(write_block
);
582 extern void next_record (int);
583 internal_proto(next_record
);
587 extern void set_integer (void *, GFC_INTEGER_LARGEST
, int);
588 internal_proto(set_integer
);
590 extern GFC_UINTEGER_LARGEST
max_value (int, int);
591 internal_proto(max_value
);
593 extern int convert_real (void *, const char *, int);
594 internal_proto(convert_real
);
596 extern void read_a (fnode
*, char *, int);
597 internal_proto(read_a
);
599 extern void read_f (fnode
*, char *, int);
600 internal_proto(read_f
);
602 extern void read_l (fnode
*, char *, int);
603 internal_proto(read_l
);
605 extern void read_x (int);
606 internal_proto(read_x
);
608 extern void read_radix (fnode
*, char *, int, int);
609 internal_proto(read_radix
);
611 extern void read_decimal (fnode
*, char *, int);
612 internal_proto(read_decimal
);
616 extern void list_formatted_read (bt
, void *, int, size_t);
617 internal_proto(list_formatted_read
);
619 extern void finish_list_read (void);
620 internal_proto(finish_list_read
);
622 extern void init_at_eol (void);
623 internal_proto(init_at_eol
);
625 extern void namelist_read (void);
626 internal_proto(namelist_read
);
628 extern void namelist_write (void);
629 internal_proto(namelist_write
);
633 extern void write_a (fnode
*, const char *, int);
634 internal_proto(write_a
);
636 extern void write_b (fnode
*, const char *, int);
637 internal_proto(write_b
);
639 extern void write_d (fnode
*, const char *, int);
640 internal_proto(write_d
);
642 extern void write_e (fnode
*, const char *, int);
643 internal_proto(write_e
);
645 extern void write_en (fnode
*, const char *, int);
646 internal_proto(write_en
);
648 extern void write_es (fnode
*, const char *, int);
649 internal_proto(write_es
);
651 extern void write_f (fnode
*, const char *, int);
652 internal_proto(write_f
);
654 extern void write_i (fnode
*, const char *, int);
655 internal_proto(write_i
);
657 extern void write_l (fnode
*, char *, int);
658 internal_proto(write_l
);
660 extern void write_o (fnode
*, const char *, int);
661 internal_proto(write_o
);
663 extern void write_x (int, int);
664 internal_proto(write_x
);
666 extern void write_z (fnode
*, const char *, int);
667 internal_proto(write_z
);
669 extern void list_formatted_write (bt
, void *, int, size_t);
670 internal_proto(list_formatted_write
);
673 extern try notify_std (int, const char *);
674 internal_proto(notify_std
);