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, 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, 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 "/var/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 /* Namelist represent object */
80 &groupname object=value [,object=value].../
82 &groupname object=value [,object=value]...&groupname
84 Even more complex, during the execution of a program containing a
85 namelist READ statement, you can specify a question mark character(?)
86 or a question mark character preceded by an equal sign(=?) to get
87 the information of the namelist group. By '?', the name of variables
88 in the namelist will be displayed, by '=?', the name and value of
89 variables will be displayed.
91 All these requirements need a new data structure to record all info
95 typedef struct namelist_type
103 struct namelist_type
* next
;
107 /* Options for the OPEN statement. */
110 { ACCESS_SEQUENTIAL
, ACCESS_DIRECT
,
116 { ACTION_READ
, ACTION_WRITE
, ACTION_READWRITE
,
122 { BLANK_NULL
, BLANK_ZERO
, BLANK_UNSPECIFIED
}
126 { DELIM_NONE
, DELIM_APOSTROPHE
, DELIM_QUOTE
,
132 { FORM_FORMATTED
, FORM_UNFORMATTED
, FORM_UNSPECIFIED
}
136 { POSITION_ASIS
, POSITION_REWIND
, POSITION_APPEND
,
142 { STATUS_UNKNOWN
, STATUS_OLD
, STATUS_NEW
, STATUS_SCRATCH
,
143 STATUS_REPLACE
, STATUS_UNSPECIFIED
148 { PAD_YES
, PAD_NO
, PAD_UNSPECIFIED
}
152 { ADVANCE_YES
, ADVANCE_NO
, ADVANCE_UNSPECIFIED
}
159 /* Statement parameters. These are all the things that can appear in
160 an I/O statement. Some are inputs and some are outputs, but none
161 are both. All of these values are initially zeroed and are zeroed
162 at the end of a library statement. The relevant values need to be
163 set before entry to an I/O statement. This structure needs to be
164 duplicated by the back end. */
169 GFC_INTEGER_4 err
, end
, eor
, list_format
; /* These are flags, not values. */
171 /* Return values from library statements. These are returned only if
172 the labels are specified in the statement itself and the condition
173 occurs. In most cases, none of the labels are specified and the
174 return value does not have to be checked. Must be consistent with
186 GFC_INTEGER_4
*iostat
, *exist
, *opened
, *number
, *named
;
188 GFC_INTEGER_4
*nextrec
, *size
;
190 GFC_INTEGER_4 recl_in
;
191 GFC_INTEGER_4
*recl_out
;
193 GFC_INTEGER_4
*iolength
;
195 #define CHARACTER(name) \
197 gfc_charlen_type name ## _len
203 CHARACTER (position
);
210 CHARACTER (internal_unit
);
211 CHARACTER (sequential
);
213 CHARACTER (formatted
);
214 CHARACTER (unformatted
);
217 CHARACTER (readwrite
);
219 /* namelist related data */
220 CHARACTER (namelist_name
);
221 GFC_INTEGER_4 namelist_read_mode
;
227 extern st_parameter ioparm
;
228 iexport_data_proto(ioparm
);
230 extern namelist_info
* ionml
;
231 internal_proto(ionml
);
241 unit_position position
;
248 /* The default value of record length is defined here. This value can
249 be overriden by the OPEN statement or by an environment variable. */
251 #define DEFAULT_RECL 10000
254 typedef struct gfc_unit
260 struct gfc_unit
*left
, *right
; /* Treap links. */
263 int read_bad
, current_record
;
265 { NO_ENDFILE
, AT_ENDFILE
, AFTER_ENDFILE
}
270 gfc_offset recl
, last_record
, maxrec
, bytes_left
;
272 /* recl -- Record length of the file.
273 last_record -- Last record number read or written
274 maxrec -- Maximum record number in a direct access file
275 bytes_left -- Bytes left in current record. */
278 char file
[1]; /* Filename is allocated at the end of the structure. */
282 /* Global variables. Putting these in a structure makes it easier to
283 maintain, particularly with the constraint of a prefix. */
287 int in_library
; /* Nonzero if a library call is being processed. */
288 int size
; /* Bytes processed by the current data-transfer statement. */
289 gfc_offset max_offset
; /* Maximum file offset. */
290 int item_count
; /* Item number in a formatted data transfer. */
291 int reversion_flag
; /* Format reversion has occurred. */
299 unit_blank blank_status
;
300 enum {SIGN_S
, SIGN_SS
, SIGN_SP
} sign_status
;
309 extern gfc_unit
*current_unit
;
310 internal_proto(current_unit
);
312 /* Format tokens. Only about half of these can be stored in the
317 FMT_NONE
= 0, FMT_UNKNOWN
, FMT_SIGNED_INT
, FMT_ZERO
, FMT_POSINT
, FMT_PERIOD
,
318 FMT_COMMA
, FMT_COLON
, FMT_SLASH
, FMT_DOLLAR
, FMT_T
, FMT_TR
, FMT_TL
,
319 FMT_LPAREN
, FMT_RPAREN
, FMT_X
, FMT_S
, FMT_SS
, FMT_SP
, FMT_STRING
,
320 FMT_BADSTRING
, FMT_P
, FMT_I
, FMT_B
, FMT_BN
, FMT_BZ
, FMT_O
, FMT_Z
, FMT_F
,
321 FMT_E
, FMT_EN
, FMT_ES
, FMT_G
, FMT_L
, FMT_A
, FMT_D
, FMT_H
, FMT_END
326 /* Format nodes. A format string is converted into a tree of these
327 structures, which is traversed as part of a data transfer statement. */
366 /* Members for traversing the tree during data transfer. */
369 struct fnode
*current
;
377 extern int move_pos_offset (stream
*, int);
378 internal_proto(move_pos_offset
);
380 extern int compare_files (stream
*, stream
*);
381 internal_proto(compare_files
);
383 extern stream
*init_error_stream (void);
384 internal_proto(init_error_stream
);
386 extern stream
*open_external (unit_flags
*);
387 internal_proto(open_external
);
389 extern stream
*open_internal (char *, int);
390 internal_proto(open_internal
);
392 extern stream
*input_stream (void);
393 internal_proto(input_stream
);
395 extern stream
*output_stream (void);
396 internal_proto(output_stream
);
398 extern stream
*error_stream (void);
399 internal_proto(error_stream
);
401 extern int compare_file_filename (stream
*, const char *, int);
402 internal_proto(compare_file_filename
);
404 extern gfc_unit
*find_file (void);
405 internal_proto(find_file
);
407 extern int stream_at_bof (stream
*);
408 internal_proto(stream_at_bof
);
410 extern int stream_at_eof (stream
*);
411 internal_proto(stream_at_eof
);
413 extern int delete_file (gfc_unit
*);
414 internal_proto(delete_file
);
416 extern int file_exists (void);
417 internal_proto(file_exists
);
419 extern const char *inquire_sequential (const char *, int);
420 internal_proto(inquire_sequential
);
422 extern const char *inquire_direct (const char *, int);
423 internal_proto(inquire_direct
);
425 extern const char *inquire_formatted (const char *, int);
426 internal_proto(inquire_formatted
);
428 extern const char *inquire_unformatted (const char *, int);
429 internal_proto(inquire_unformatted
);
431 extern const char *inquire_read (const char *, int);
432 internal_proto(inquire_read
);
434 extern const char *inquire_write (const char *, int);
435 internal_proto(inquire_write
);
437 extern const char *inquire_readwrite (const char *, int);
438 internal_proto(inquire_readwrite
);
440 extern gfc_offset
file_length (stream
*);
441 internal_proto(file_length
);
443 extern gfc_offset
file_position (stream
*);
444 internal_proto(file_position
);
446 extern int is_seekable (stream
*);
447 internal_proto(is_seekable
);
449 extern void empty_internal_buffer(stream
*);
450 internal_proto(empty_internal_buffer
);
452 extern try flush (stream
*);
453 internal_proto(flush
);
455 extern int unit_to_fd (int);
456 internal_proto(unit_to_fd
);
460 extern void insert_unit (gfc_unit
*);
461 internal_proto(insert_unit
);
463 extern int close_unit (gfc_unit
*);
464 internal_proto(close_unit
);
466 extern int is_internal_unit (void);
467 internal_proto(is_internal_unit
);
469 extern gfc_unit
*find_unit (int);
470 internal_proto(find_unit
);
472 extern gfc_unit
*get_unit (int);
473 internal_proto(get_unit
);
477 extern void test_endfile (gfc_unit
*);
478 internal_proto(test_endfile
);
480 extern void new_unit (unit_flags
*);
481 internal_proto(new_unit
);
485 extern void parse_format (void);
486 internal_proto(parse_format
);
488 extern fnode
*next_format (void);
489 internal_proto(next_format
);
491 extern void unget_format (fnode
*);
492 internal_proto(unget_format
);
494 extern void format_error (fnode
*, const char *);
495 internal_proto(format_error
);
497 extern void free_fnodes (void);
498 internal_proto(free_fnodes
);
502 #define SCRATCH_SIZE 300
504 extern char scratch
[];
505 internal_proto(scratch
);
507 extern const char *type_name (bt
);
508 internal_proto(type_name
);
510 extern void *read_block (int *);
511 internal_proto(read_block
);
513 extern void *write_block (int);
514 internal_proto(write_block
);
516 extern void next_record (int);
517 internal_proto(next_record
);
521 extern void set_integer (void *, int64_t, int);
522 internal_proto(set_integer
);
524 extern uint64_t max_value (int, int);
525 internal_proto(max_value
);
527 extern int convert_real (void *, const char *, int);
528 internal_proto(convert_real
);
530 extern void read_a (fnode
*, char *, int);
531 internal_proto(read_a
);
533 extern void read_f (fnode
*, char *, int);
534 internal_proto(read_f
);
536 extern void read_l (fnode
*, char *, int);
537 internal_proto(read_l
);
539 extern void read_x (fnode
*);
540 internal_proto(read_x
);
542 extern void read_radix (fnode
*, char *, int, int);
543 internal_proto(read_radix
);
545 extern void read_decimal (fnode
*, char *, int);
546 internal_proto(read_decimal
);
550 extern void list_formatted_read (bt
, void *, int);
551 internal_proto(list_formatted_read
);
553 extern void finish_list_read (void);
554 internal_proto(finish_list_read
);
556 extern void init_at_eol();
557 internal_proto(init_at_eol
);
559 extern void namelist_read();
560 internal_proto(namelist_read
);
562 extern void namelist_write();
563 internal_proto(namelist_write
);
567 extern void write_a (fnode
*, const char *, int);
568 internal_proto(write_a
);
570 extern void write_b (fnode
*, const char *, int);
571 internal_proto(write_b
);
573 extern void write_d (fnode
*, const char *, int);
574 internal_proto(write_d
);
576 extern void write_e (fnode
*, const char *, int);
577 internal_proto(write_e
);
579 extern void write_en (fnode
*, const char *, int);
580 internal_proto(write_en
);
582 extern void write_es (fnode
*, const char *, int);
583 internal_proto(write_es
);
585 extern void write_f (fnode
*, const char *, int);
586 internal_proto(write_f
);
588 extern void write_i (fnode
*, const char *, int);
589 internal_proto(write_i
);
591 extern void write_l (fnode
*, char *, int);
592 internal_proto(write_l
);
594 extern void write_o (fnode
*, const char *, int);
595 internal_proto(write_o
);
597 extern void write_x (fnode
*);
598 internal_proto(write_x
);
600 extern void write_z (fnode
*, const char *, int);
601 internal_proto(write_z
);
603 extern void list_formatted_write (bt
, void *, int);
604 internal_proto(list_formatted_write
);