1 /* Copyright (C) 2002, 2003, 2004 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. */
24 /* IO library include. */
27 #include "libgfortran.h"
28 #define DEFAULT_TEMPDIR "/var/tmp"
30 /* Basic types used in data transfers. */
33 { BT_NULL
, BT_INTEGER
, BT_LOGICAL
, BT_CHARACTER
, BT_REAL
,
40 { SUCCESS
= 1, FAILURE
}
45 char *(*alloc_w_at
) (struct stream
*, int *, gfc_offset
);
46 char *(*alloc_r_at
) (struct stream
*, int *, gfc_offset
);
47 try (*sfree
) (struct stream
*);
48 try (*close
) (struct stream
*);
49 try (*seek
) (struct stream
*, gfc_offset
);
50 try (*truncate
) (struct stream
*);
55 /* Macros for doing file I/O given a stream. */
57 #define sfree(s) ((s)->sfree)(s)
58 #define sclose(s) ((s)->close)(s)
60 #define salloc_r(s, len) ((s)->alloc_r_at)(s, len, -1)
61 #define salloc_w(s, len) ((s)->alloc_w_at)(s, len, -1)
63 #define salloc_r_at(s, len, where) ((s)->alloc_r_at)(s, len, where)
64 #define salloc_w_at(s, len, where) ((s)->alloc_w_at)(s, len, where)
66 #define sseek(s, pos) ((s)->seek)(s, pos)
67 #define struncate(s) ((s)->truncate)(s)
69 /* Namelist represent object */
72 &groupname object=value [,object=value].../
74 &groupname object=value [,object=value]...&groupname
76 Even more complex, during the execution of a program containing a
77 namelist READ statement, you can specify a question mark character(?)
78 or a question mark character preceded by an equal sign(=?) to get
79 the information of the namelist group. By '?', the name of variables
80 in the namelist will be displayed, by '=?', the name and value of
81 variables will be displayed.
83 All these requirements need a new data structure to record all info
87 typedef struct namelist_type
95 struct namelist_type
* next
;
99 /* Options for the OPEN statement. */
102 { ACCESS_SEQUENTIAL
, ACCESS_DIRECT
,
108 { ACTION_READ
, ACTION_WRITE
, ACTION_READWRITE
,
114 { BLANK_NULL
, BLANK_ZERO
, BLANK_UNSPECIFIED
}
118 { DELIM_NONE
, DELIM_APOSTROPHE
, DELIM_QUOTE
,
124 { FORM_FORMATTED
, FORM_UNFORMATTED
, FORM_UNSPECIFIED
}
128 { POSITION_ASIS
, POSITION_REWIND
, POSITION_APPEND
,
134 { STATUS_UNKNOWN
, STATUS_OLD
, STATUS_NEW
, STATUS_SCRATCH
,
135 STATUS_REPLACE
, STATUS_UNSPECIFIED
140 { PAD_YES
, PAD_NO
, PAD_UNSPECIFIED
}
144 { ADVANCE_YES
, ADVANCE_NO
, ADVANCE_UNSPECIFIED
}
151 /* Statement parameters. These are all the things that can appear in
152 an I/O statement. Some are inputs and some are outputs, but none
153 are both. All of these values are initially zeroed and are zeroed
154 at the end of a library statement. The relevant values need to be
155 set before entry to an I/O statement. This structure needs to be
156 duplicated by the back end. */
161 int err
, end
, eor
, list_format
; /* These are flags, not values. */
163 /* Return values from library statements. These are returned only if
164 the labels are specified in the statement itself and the condition
165 occurs. In most cases, none of the labels are specified and the
166 return value does not have to be checked. Must be consistent with
178 int *iostat
, *exist
, *opened
, *number
, *named
, rec
, *nextrec
, *size
;
210 int internal_unit_len
;
226 /* namelist related data */
227 char * namelist_name
;
228 int namelist_name_len
;
229 int namelist_read_mode
;
235 #define ioparm prefix(ioparm)
236 extern st_parameter ioparm
;
238 #define ionml prefix(ionml)
239 extern namelist_info
* ionml
;
249 unit_position position
;
256 /* The default value of record length is defined here. This value can
257 be overriden by the OPEN statement or by an environment variable. */
259 #define DEFAULT_RECL 10000
262 typedef struct gfc_unit
268 struct gfc_unit
*left
, *right
; /* Treap links. */
271 int read_bad
, current_record
;
273 { NO_ENDFILE
, AT_ENDFILE
, AFTER_ENDFILE
}
278 gfc_offset recl
, last_record
, maxrec
, bytes_left
;
280 /* recl -- Record length of the file.
281 last_record -- Last record number read or written
282 maxrec -- Maximum record number in a direct access file
283 bytes_left -- Bytes left in current record. */
286 char file
[1]; /* Filename is allocated at the end of the structure. */
290 /* Global variables. Putting these in a structure makes it easier to
291 maintain, particularly with the constraint of a prefix. */
295 int in_library
; /* Nonzero if a library call is being processed. */
296 int size
; /* Bytes processed by the current data-transfer statement. */
297 gfc_offset max_offset
; /* Maximum file offset. */
298 int item_count
; /* Item number in a formatted data transfer. */
299 int reversion_flag
; /* Format reversion has occurred. */
307 unit_blank blank_status
;
308 enum {SIGN_S
, SIGN_SS
, SIGN_SP
} sign_status
;
319 #define current_unit prefix(current_unit)
320 extern gfc_unit
*current_unit
;
322 /* Format tokens. Only about half of these can be stored in the
327 FMT_NONE
= 0, FMT_UNKNOWN
, FMT_SIGNED_INT
, FMT_ZERO
, FMT_POSINT
, FMT_PERIOD
,
328 FMT_COMMA
, FMT_COLON
, FMT_SLASH
, FMT_DOLLAR
, FMT_T
, FMT_TR
, FMT_TL
,
329 FMT_LPAREN
, FMT_RPAREN
, FMT_X
, FMT_S
, FMT_SS
, FMT_SP
, FMT_STRING
,
330 FMT_BADSTRING
, FMT_P
, FMT_I
, FMT_B
, FMT_BN
, FMT_BZ
, FMT_O
, FMT_Z
, FMT_F
,
331 FMT_E
, FMT_EN
, FMT_ES
, FMT_G
, FMT_L
, FMT_A
, FMT_D
, FMT_H
, FMT_END
336 /* Format nodes. A format string is converted into a tree of these
337 structures, which is traversed as part of a data transfer statement. */
376 /* Members for traversing the tree during data transfer. */
379 struct fnode
*current
;
387 #define sys_exit prefix(sys_exit)
388 void sys_exit (int) __attribute__ ((noreturn
));
390 #define move_pos_offset prefix(move_pos_offset)
391 int move_pos_offset (stream
*, int);
393 #define get_oserror prefix(get_oserror)
394 const char *get_oserror (void);
396 #define compare_files prefix(compare_files)
397 int compare_files (stream
*, stream
*);
399 #define init_error_stream prefix(init_error_stream)
400 stream
*init_error_stream (void);
402 #define open_external prefix(open_external)
403 stream
*open_external (unit_action
, unit_status
);
405 #define open_internal prefix(open_internal)
406 stream
*open_internal (char *, int);
408 #define input_stream prefix(input_stream)
409 stream
*input_stream (void);
411 #define output_stream prefix(output_stream)
412 stream
*output_stream (void);
414 #define compare_file_filename prefix(compare_file_filename)
415 int compare_file_filename (stream
*, const char *, int);
417 #define find_file prefix(find_file)
418 gfc_unit
*find_file (void);
420 #define stream_at_bof prefix(stream_at_bof)
421 int stream_at_bof (stream
*);
423 #define stream_at_eof prefix(stream_at_eof)
424 int stream_at_eof (stream
*);
426 #define delete_file prefix(delete_file)
427 int delete_file (gfc_unit
*);
429 #define file_exists prefix(file_exists)
430 int file_exists (void);
432 #define inquire_sequential prefix(inquire_sequential)
433 const char *inquire_sequential (const char *, int);
435 #define inquire_direct prefix(inquire_direct)
436 const char *inquire_direct (const char *, int);
438 #define inquire_formatted prefix(inquire_formatted)
439 const char *inquire_formatted (const char *, int);
441 #define inquire_unformatted prefix(inquire_unformatted)
442 const char *inquire_unformatted (const char *, int);
444 #define inquire_read prefix(inquire_read)
445 const char *inquire_read (const char *, int);
447 #define inquire_write prefix(inquire_write)
448 const char *inquire_write (const char *, int);
450 #define inquire_readwrite prefix(inquire_readwrite)
451 const char *inquire_readwrite (const char *, int);
453 #define file_length prefix(file_length)
454 gfc_offset
file_length (stream
*);
456 #define file_position prefix(file_position)
457 gfc_offset
file_position (stream
*);
459 #define is_seekable prefix(is_seekable)
460 int is_seekable (stream
*);
462 #define empty_internal_buffer prefix(empty_internal_buffer)
463 void empty_internal_buffer(stream
*);
465 #define flush prefix(flush)
466 try flush (stream
*);
471 #define insert_unit prefix(insert_unix)
472 void insert_unit (gfc_unit
*);
474 #define close_unit prefix(close_unit)
475 int close_unit (gfc_unit
*);
477 #define is_internal_unit prefix(is_internal_unit)
478 int is_internal_unit (void);
480 #define find_unit prefix(find_unit)
481 gfc_unit
*find_unit (int);
483 #define get_unit prefix(get_unit)
484 gfc_unit
*get_unit (int);
488 #define test_endfile prefix(test_endfile)
489 void test_endfile (gfc_unit
*);
491 #define new_unit prefix(new_unit)
492 void new_unit (unit_flags
*);
496 #define parse_format prefix(parse_format)
497 void parse_format (void);
499 #define next_format prefix(next_format)
500 fnode
*next_format (void);
502 #define unget_format prefix(unget_format)
503 void unget_format (fnode
*);
505 #define format_error prefix(format_error)
506 void format_error (fnode
*, const char *);
508 #define free_fnodes prefix(free_fnodes)
509 void free_fnodes (void);
513 #define SCRATCH_SIZE 300
515 #define scratch prefix(scratch)
516 extern char scratch
[];
518 #define type_name prefix(type_name)
519 const char *type_name (bt
);
521 #define read_block prefix(read_block)
522 void *read_block (int *);
524 #define write_block prefix(write_block)
525 void *write_block (int);
527 #define transfer_integer prefix(transfer_integer)
528 void transfer_integer (void *, int);
530 #define transfer_real prefix(transfer_real)
531 void transfer_real (void *, int);
533 #define transfer_logical prefix(transfer_logical)
534 void transfer_logical (void *, int);
536 #define transfer_character prefix(transfer_character)
537 void transfer_character (void *, int);
539 #define transfer_complex prefix(transfer_complex)
540 void transfer_complex (void *, int);
542 #define next_record prefix(next_record)
543 void next_record (int);
545 #define st_set_nml_var_int prefix(st_set_nml_var_int)
546 void st_set_nml_var_int (void * , char * , int , int );
548 #define st_set_nml_var_float prefix(st_set_nml_var_float)
549 void st_set_nml_var_float (void * , char * , int , int );
551 #define st_set_nml_var_char prefix(st_set_nml_var_char)
552 void st_set_nml_var_char (void * , char * , int , int, gfc_charlen_type
);
554 #define st_set_nml_var_complex prefix(st_set_nml_var_complex)
555 void st_set_nml_var_complex (void * , char * , int , int );
557 #define st_set_nml_var_log prefix(st_set_nml_var_log)
558 void st_set_nml_var_log (void * , char * , int , int );
562 #define set_integer prefix(set_integer)
563 void set_integer (void *, int64_t, int);
565 #define max_value prefix(max_value)
566 uint64_t max_value (int, int);
568 #define convert_real prefix(convert_real)
569 int convert_real (void *, const char *, int);
571 #define read_a prefix(read_a)
572 void read_a (fnode
*, char *, int);
574 #define read_f prefix(read_f)
575 void read_f (fnode
*, char *, int);
577 #define read_l prefix(read_l)
578 void read_l (fnode
*, char *, int);
580 #define read_x prefix(read_x)
581 void read_x (fnode
*);
583 #define read_radix prefix(read_radix)
584 void read_radix (fnode
*, char *, int, int);
586 #define read_decimal prefix(read_decimal)
587 void read_decimal (fnode
*, char *, int);
591 #define list_formatted_read prefix(list_formatted_read)
592 void list_formatted_read (bt
, void *, int);
594 #define finish_list_read prefix(finish_list_read)
595 void finish_list_read (void);
597 #define init_at_eol prefix(init_at_eol)
600 #define namelist_read prefix(namelist_read)
601 void namelist_read();
603 #define namelist_write prefix(namelist_write)
604 void namelist_write();
608 #define write_a prefix(write_a)
609 void write_a (fnode
*, const char *, int);
611 #define write_b prefix(write_b)
612 void write_b (fnode
*, const char *, int);
614 #define write_d prefix(write_d)
615 void write_d (fnode
*, const char *, int);
617 #define write_e prefix(write_e)
618 void write_e (fnode
*, const char *, int);
620 #define write_en prefix(write_en)
621 void write_en (fnode
*, const char *, int);
623 #define write_es prefix(write_es)
624 void write_es (fnode
*, const char *, int);
626 #define write_f prefix(write_f)
627 void write_f (fnode
*, const char *, int);
629 #define write_i prefix(write_i)
630 void write_i (fnode
*, const char *, int);
632 #define write_l prefix(write_l)
633 void write_l (fnode
*, char *, int);
635 #define write_o prefix(write_o)
636 void write_o (fnode
*, const char *, int);
638 #define write_x prefix(write_x)
639 void write_x (fnode
*);
641 #define write_z prefix(write_z)
642 void write_z (fnode
*, const char *, int);
644 #define list_formatted_write prefix(list_formatted_write)
645 void list_formatted_write (bt
, void *, int);
648 #define st_open prefix(st_open)
649 #define st_close prefix(st_close)
650 #define st_inquire prefix(st_inquire)
651 #define st_iolength prefix(st_iolength)
652 #define st_iolength_done prefix(st_iolength_done)
653 #define st_rewind prefix(st_rewind)
654 #define st_read prefix(st_read)
655 #define st_read_done prefix(st_read_done)
656 #define st_write prefix(st_write)
657 #define st_write_done prefix(st_write_done)
658 #define st_backspace prefix(st_backspace)
659 #define st_endfile prefix(st_endfile)