-/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
Contributed by Andy Vaught
F2003 I/O support contributed by Jerry DeLisle
Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
Libgfortran is distributed in the hope that it will be useful,
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
-You should have received a copy of the GNU General Public License
-along with Libgfortran; see the file COPYING. If not, write to
-the Free Software Foundation, 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
-/* As a special exception, if you link this library with other files,
- some of which are compiled with GCC, to produce an executable,
- this library does not by itself cause the resulting executable
- to be covered by the GNU General Public License.
- This exception does not however invalidate any other reasons why
- the executable file might be covered by the GNU General Public License. */
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
#ifndef GFOR_IO_H
#define GFOR_IO_H
}
bt;
+/* Forward declarations. */
struct st_parameter_dt;
+typedef struct stream stream;
+struct fbuf;
+struct format_data;
+typedef struct fnode fnode;
+struct gfc_unit;
-typedef struct stream
-{
- char *(*alloc_w_at) (struct stream *, int *);
- try (*sfree) (struct stream *);
- try (*close) (struct stream *);
- try (*seek) (struct stream *, gfc_offset);
- try (*trunc) (struct stream *);
- int (*read) (struct stream *, void *, size_t *);
- int (*write) (struct stream *, const void *, size_t *);
- try (*set) (struct stream *, int, size_t);
-}
-stream;
-
-typedef enum
-{ SYNC_BUFFERED, SYNC_UNBUFFERED, ASYNC }
-io_mode;
-
-/* Macros for doing file I/O given a stream. */
-
-#define sfree(s) ((s)->sfree)(s)
-#define sclose(s) ((s)->close)(s)
-
-#define salloc_w(s, len) ((s)->alloc_w_at)(s, len)
-
-#define sseek(s, pos) ((s)->seek)(s, pos)
-#define struncate(s) ((s)->trunc)(s)
-#define sread(s, buf, nbytes) ((s)->read)(s, buf, nbytes)
-#define swrite(s, buf, nbytes) ((s)->write)(s, buf, nbytes)
-
-#define sset(s, c, n) ((s)->set)(s, c, n)
/* Macros for testing what kinds of I/O we are doing. */
}
array_loop_spec;
+/* A stucture to build a hash table for format data. */
+
+#define FORMAT_HASH_SIZE 16
+
+typedef struct format_hash_entry
+{
+ char *key;
+ gfc_charlen_type key_len;
+ struct format_data *hashed_fmt;
+}
+format_hash_entry;
+
/* Representation of a namelist object in libgfortran
Namelist Records
typedef struct namelist_type
{
-
/* Object type, stored as GFC_DTYPE_xxxx. */
- bt type;
+ dtype type;
/* Object name. */
char * var_name;
CHARACTER2 (round);
CHARACTER1 (sign);
CHARACTER2 (asynchronous);
+ GFC_INTEGER_4 *newunit;
}
st_parameter_open;
#define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0)
#define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1)
#define IOPARM_INQUIRE_HAS_ENCODING (1 << 2)
-#define IOPARM_INQUIRE_HAS_PENDING (1 << 3)
-#define IOPARM_INQUIRE_HAS_ROUND (1 << 4)
-#define IOPARM_INQUIRE_HAS_SIGN (1 << 5)
+#define IOPARM_INQUIRE_HAS_ROUND (1 << 3)
+#define IOPARM_INQUIRE_HAS_SIGN (1 << 4)
+#define IOPARM_INQUIRE_HAS_PENDING (1 << 5)
#define IOPARM_INQUIRE_HAS_SIZE (1 << 6)
#define IOPARM_INQUIRE_HAS_ID (1 << 7)
CHARACTER1 (asynchronous);
CHARACTER2 (decimal);
CHARACTER1 (encoding);
- CHARACTER2 (pending);
- CHARACTER1 (round);
- CHARACTER2 (sign);
- GFC_INTEGER_4 *size;
+ CHARACTER2 (round);
+ CHARACTER1 (sign);
+ GFC_INTEGER_4 *pending;
+ GFC_IO_INT *size;
GFC_INTEGER_4 *id;
}
st_parameter_inquire;
-struct gfc_unit;
-struct format_data;
#define IOPARM_DT_LIST_FORMAT (1 << 7)
#define IOPARM_DT_NAMELIST_READ_MODE (1 << 8)
#define IOPARM_DT_IONML_SET (1 << 31)
-typedef struct st_parameter_43
-{
- void (*transfer) (struct st_parameter_dt *, bt, void *, int,
- size_t, size_t);
- struct gfc_unit *current_unit;
- /* Item number in a formatted data transfer. Also used in namelist
- read_logical as an index into line_buffer. */
- int item_count;
- unit_mode mode;
- unit_blank blank_status;
- unit_sign sign_status;
- int scale_factor;
- int max_pos; /* Maximum righthand column written to. */
- /* Number of skips + spaces to be done for T and X-editing. */
- int skips;
- /* Number of spaces to be done for T and X-editing. */
- int pending_spaces;
- /* Whether an EOR condition was encountered. Value is:
- 0 if no EOR was encountered
- 1 if an EOR was encountered due to a 1-byte marker (LF)
- 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
- int sf_seen_eor;
- unit_advance advance_status;
- unsigned reversion_flag : 1; /* Format reversion has occurred. */
- unsigned first_item : 1;
- unsigned seen_dollar : 1;
- unsigned eor_condition : 1;
- unsigned no_leading_blank : 1;
- unsigned char_flag : 1;
- unsigned input_complete : 1;
- unsigned at_eol : 1;
- unsigned comma_flag : 1;
- /* A namelist specific flag used in the list directed library
- to flag that calls are being made from namelist read (eg. to
- ignore comments or to treat '/' as a terminator) */
- unsigned namelist_mode : 1;
- /* A namelist specific flag used in the list directed library
- to flag read errors and return, so that an attempt can be
- made to read a new object name. */
- unsigned nml_read_error : 1;
- /* A sequential formatted read specific flag used to signal that a
- character string is being read so don't use commas to shorten a
- formatted field width. */
- unsigned sf_read_comma : 1;
- /* A namelist specific flag used to enable reading input from
- line_buffer for logical reads. */
- unsigned line_buffer_enabled : 1;
- /* An internal unit specific flag used to identify that the associated
- unit is internal. */
- unsigned unit_is_internal : 1;
- /* An internal unit specific flag to signify an EOF condition for list
- directed read. */
- unsigned at_eof : 1;
- /* 16 unused bits. */
-
- char last_char;
- char nml_delim;
-
- int repeat_count;
- int saved_length;
- int saved_used;
- bt saved_type;
- char *saved_string;
- char *scratch;
- char *line_buffer;
- struct format_data *fmt;
- jmp_buf *eof_jump;
- namelist_info *ionml;
- /* A flag used to identify when a non-standard expanded namelist read
- has occurred. */
- int expanded_read;
- /* Storage area for values except for strings. Must be large
- enough to hold a complex value (two reals) of the largest
- kind. */
- char value[32];
- gfc_offset size_used;
-} st_parameter_43;
-
-
-typedef struct st_parameter_44
-{
- GFC_INTEGER_4 *id;
- GFC_IO_INT pos;
- CHARACTER1 (asynchronous);
- CHARACTER2 (blank);
- CHARACTER1 (decimal);
- CHARACTER2 (delim);
- CHARACTER1 (pad);
- CHARACTER2 (round);
- CHARACTER1 (sign);
- void (*transfer) (struct st_parameter_dt *, bt, void *, int,
- size_t, size_t);
- struct gfc_unit *current_unit;
- /* Item number in a formatted data transfer. Also used in namelist
- read_logical as an index into line_buffer. */
- int item_count;
- unit_mode mode;
- unit_blank blank_status;
- unit_sign sign_status;
- int scale_factor;
- int max_pos; /* Maximum righthand column written to. */
- /* Number of skips + spaces to be done for T and X-editing. */
- int skips;
- /* Number of spaces to be done for T and X-editing. */
- int pending_spaces;
- /* Whether an EOR condition was encountered. Value is:
- 0 if no EOR was encountered
- 1 if an EOR was encountered due to a 1-byte marker (LF)
- 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
- int sf_seen_eor;
- unit_advance advance_status;
- unsigned reversion_flag : 1; /* Format reversion has occurred. */
- unsigned first_item : 1;
- unsigned seen_dollar : 1;
- unsigned eor_condition : 1;
- unsigned no_leading_blank : 1;
- unsigned char_flag : 1;
- unsigned input_complete : 1;
- unsigned at_eol : 1;
- unsigned comma_flag : 1;
- /* A namelist specific flag used in the list directed library
- to flag that calls are being made from namelist read (eg. to
- ignore comments or to treat '/' as a terminator) */
- unsigned namelist_mode : 1;
- /* A namelist specific flag used in the list directed library
- to flag read errors and return, so that an attempt can be
- made to read a new object name. */
- unsigned nml_read_error : 1;
- /* A sequential formatted read specific flag used to signal that a
- character string is being read so don't use commas to shorten a
- formatted field width. */
- unsigned sf_read_comma : 1;
- /* A namelist specific flag used to enable reading input from
- line_buffer for logical reads. */
- unsigned line_buffer_enabled : 1;
- /* An internal unit specific flag used to identify that the associated
- unit is internal. */
- unsigned unit_is_internal : 1;
- /* An internal unit specific flag to signify an EOF condition for list
- directed read. */
- unsigned at_eof : 1;
- /* 16 unused bits. */
-
- char last_char;
- char nml_delim;
-
- int repeat_count;
- int saved_length;
- int saved_used;
- bt saved_type;
- char *saved_string;
- char *scratch;
- char *line_buffer;
- struct format_data *fmt;
- jmp_buf *eof_jump;
- namelist_info *ionml;
- /* A flag used to identify when a non-standard expanded namelist read
- has occurred. */
- int expanded_read;
- /* Storage area for values except for strings. Must be large
- enough to hold a complex value (two reals) of the largest
- kind. */
- char value[32];
- gfc_offset size_used;
-} st_parameter_44;
-
typedef struct st_parameter_dt
{
st_parameter_common common;
to reserve enough space. */
union
{
- st_parameter_43 q;
- st_parameter_44 p;
+ struct
+ {
+ void (*transfer) (struct st_parameter_dt *, bt, void *, int,
+ size_t, size_t);
+ struct gfc_unit *current_unit;
+ /* Item number in a formatted data transfer. Also used in namelist
+ read_logical as an index into line_buffer. */
+ int item_count;
+ unit_mode mode;
+ unit_blank blank_status;
+ unit_sign sign_status;
+ int scale_factor;
+ int max_pos; /* Maximum righthand column written to. */
+ /* Number of skips + spaces to be done for T and X-editing. */
+ int skips;
+ /* Number of spaces to be done for T and X-editing. */
+ int pending_spaces;
+ /* Whether an EOR condition was encountered. Value is:
+ 0 if no EOR was encountered
+ 1 if an EOR was encountered due to a 1-byte marker (LF)
+ 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
+ int sf_seen_eor;
+ unit_advance advance_status;
+ unsigned reversion_flag : 1; /* Format reversion has occurred. */
+ unsigned first_item : 1;
+ unsigned seen_dollar : 1;
+ unsigned eor_condition : 1;
+ unsigned no_leading_blank : 1;
+ unsigned char_flag : 1;
+ unsigned input_complete : 1;
+ unsigned at_eol : 1;
+ unsigned comma_flag : 1;
+ /* A namelist specific flag used in the list directed library
+ to flag that calls are being made from namelist read (eg. to
+ ignore comments or to treat '/' as a terminator) */
+ unsigned namelist_mode : 1;
+ /* A namelist specific flag used in the list directed library
+ to flag read errors and return, so that an attempt can be
+ made to read a new object name. */
+ unsigned nml_read_error : 1;
+ /* A sequential formatted read specific flag used to signal that a
+ character string is being read so don't use commas to shorten a
+ formatted field width. */
+ unsigned sf_read_comma : 1;
+ /* A namelist specific flag used to enable reading input from
+ line_buffer for logical reads. */
+ unsigned line_buffer_enabled : 1;
+ /* An internal unit specific flag used to identify that the associated
+ unit is internal. */
+ unsigned unit_is_internal : 1;
+ /* An internal unit specific flag to signify an EOF condition for list
+ directed read. */
+ unsigned at_eof : 1;
+ /* Used for g0 floating point output. */
+ unsigned g0_no_blanks : 1;
+ /* Used to signal use of free_format_data. */
+ unsigned format_not_saved : 1;
+ /* 14 unused bits. */
+
+ char last_char;
+ char nml_delim;
+
+ int repeat_count;
+ int saved_length;
+ int saved_used;
+ bt saved_type;
+ char *saved_string;
+ char *scratch;
+ char *line_buffer;
+ struct format_data *fmt;
+ jmp_buf *eof_jump;
+ namelist_info *ionml;
+ /* A flag used to identify when a non-standard expanded namelist read
+ has occurred. */
+ int expanded_read;
+ /* Storage area for values except for strings. Must be
+ large enough to hold a complex value (two reals) of the
+ largest kind. */
+ char value[32];
+ GFC_IO_INT size_used;
+ } p;
/* This pad size must be equal to the pad_size declared in
trans-io.c (gfc_build_io_library_fndecls). The above structure
must be smaller or equal to this array. */
- char pad[32 * sizeof (char *) + 32 * sizeof (int)];
+ char pad[16 * sizeof (char *) + 32 * sizeof (int)];
} u;
+ GFC_INTEGER_4 *id;
+ GFC_IO_INT pos;
+ CHARACTER1 (asynchronous);
+ CHARACTER2 (blank);
+ CHARACTER1 (decimal);
+ CHARACTER2 (delim);
+ CHARACTER1 (pad);
+ CHARACTER2 (round);
+ CHARACTER1 (sign);
}
st_parameter_dt;
unit_flags;
-/* Formatting buffer. This is a temporary scratch buffer. Currently used only
- by formatted writes. After every
- formatted write statement, this buffer is flushed. This buffer is needed since
- not all devices are seekable, and T or TL edit descriptors require
- moving backwards in the record. However, advance='no' complicates the
- situation, so the buffer must only be partially flushed from the end of the
- last flush until the current position in the record. */
-
-typedef struct fbuf
-{
- char *buf; /* Start of buffer. */
- size_t len; /* Length of buffer. */
- size_t act; /* Active bytes in buffer. */
- size_t flushed; /* Flushed bytes from beginning of buffer. */
- size_t pos; /* Current position in buffer. */
-}
-fbuf;
-
-
typedef struct gfc_unit
{
int unit_number;
unit_pad pad_status;
unit_decimal decimal_status;
unit_delim delim_status;
+ unit_round round_status;
/* recl -- Record length of the file.
last_record -- Last record number read or written
int file_len;
char *file;
+
+ /* The format hash table. */
+ struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE];
/* Formatting buffer. */
struct fbuf *fbuf;
}
gfc_unit;
-/* Format tokens. Only about half of these can be stored in the
- format nodes. */
-
-typedef enum
-{
- FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
- FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL,
- FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING,
- FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F,
- FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC,
- FMT_DP
-}
-format_token;
-
-
-/* Format nodes. A format string is converted into a tree of these
- structures, which is traversed as part of a data transfer statement. */
-
-typedef struct fnode
-{
- format_token format;
- int repeat;
- struct fnode *next;
- char *source;
-
- union
- {
- struct
- {
- int w, d, e;
- }
- real;
-
- struct
- {
- int length;
- char *p;
- }
- string;
-
- struct
- {
- int w, m;
- }
- integer;
-
- int w;
- int k;
- int r;
- int n;
-
- struct fnode *child;
- }
- u;
-
- /* Members for traversing the tree during data transfer. */
-
- int count;
- struct fnode *current;
-
-}
-fnode;
-
-
-/* unix.c */
-
-extern int move_pos_offset (stream *, int);
-internal_proto(move_pos_offset);
-
-extern int compare_files (stream *, stream *);
-internal_proto(compare_files);
-
-extern stream *open_external (st_parameter_open *, unit_flags *);
-internal_proto(open_external);
-
-extern stream *open_internal (char *, int, gfc_offset);
-internal_proto(open_internal);
-
-extern stream *input_stream (void);
-internal_proto(input_stream);
-
-extern stream *output_stream (void);
-internal_proto(output_stream);
-
-extern stream *error_stream (void);
-internal_proto(error_stream);
-
-extern int compare_file_filename (gfc_unit *, const char *, int);
-internal_proto(compare_file_filename);
-
-extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
-internal_proto(find_file);
-
-extern int stream_at_bof (stream *);
-internal_proto(stream_at_bof);
-
-extern int stream_at_eof (stream *);
-internal_proto(stream_at_eof);
-
-extern int delete_file (gfc_unit *);
-internal_proto(delete_file);
-
-extern int file_exists (const char *file, gfc_charlen_type file_len);
-internal_proto(file_exists);
-
-extern const char *inquire_sequential (const char *, int);
-internal_proto(inquire_sequential);
-
-extern const char *inquire_direct (const char *, int);
-internal_proto(inquire_direct);
-
-extern const char *inquire_formatted (const char *, int);
-internal_proto(inquire_formatted);
-
-extern const char *inquire_unformatted (const char *, int);
-internal_proto(inquire_unformatted);
-
-extern const char *inquire_read (const char *, int);
-internal_proto(inquire_read);
-
-extern const char *inquire_write (const char *, int);
-internal_proto(inquire_write);
-
-extern const char *inquire_readwrite (const char *, int);
-internal_proto(inquire_readwrite);
-
-extern gfc_offset file_length (stream *);
-internal_proto(file_length);
-
-extern gfc_offset file_position (stream *);
-internal_proto(file_position);
-
-extern int is_seekable (stream *);
-internal_proto(is_seekable);
-
-extern int is_special (stream *);
-internal_proto(is_special);
-
-extern int is_preconnected (stream *);
-internal_proto(is_preconnected);
-
-extern void flush_if_preconnected (stream *);
-internal_proto(flush_if_preconnected);
-
-extern void empty_internal_buffer(stream *);
-internal_proto(empty_internal_buffer);
-
-extern try flush (stream *);
-internal_proto(flush);
-
-extern int stream_isatty (stream *);
-internal_proto(stream_isatty);
-
-extern char * stream_ttyname (stream *);
-internal_proto(stream_ttyname);
-
-extern gfc_offset stream_offset (stream *s);
-internal_proto(stream_offset);
-
-extern int unpack_filename (char *, const char *, int);
-internal_proto(unpack_filename);
/* unit.c */
extern gfc_offset max_offset;
internal_proto(max_offset);
+/* Unit number to be assigned when NEWUNIT is used in an OPEN statement. */
+extern GFC_INTEGER_4 next_available_newunit;
+internal_proto(next_available_newunit);
+
/* Unit tree root. */
extern gfc_unit *unit_root;
internal_proto(unit_root);
extern void finish_last_advance_record (gfc_unit *u);
internal_proto (finish_last_advance_record);
+extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
+internal_proto (unit_truncate);
+
+extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *);
+internal_proto(get_unique_unit_number);
+
/* open.c */
extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
internal_proto(new_unit);
-/* format.c */
-
-extern void parse_format (st_parameter_dt *);
-internal_proto(parse_format);
-
-extern const fnode *next_format (st_parameter_dt *);
-internal_proto(next_format);
-
-extern void unget_format (st_parameter_dt *, const fnode *);
-internal_proto(unget_format);
-
-extern void format_error (st_parameter_dt *, const fnode *, const char *);
-internal_proto(format_error);
-
-extern void free_format_data (st_parameter_dt *);
-internal_proto(free_format_data);
/* transfer.c */
extern const char *type_name (bt);
internal_proto(type_name);
-extern try read_block_form (st_parameter_dt *, void *, size_t *);
+extern void * read_block_form (st_parameter_dt *, int *);
internal_proto(read_block_form);
-extern char *read_sf (st_parameter_dt *, int *, int);
-internal_proto(read_sf);
-
extern void *write_block (st_parameter_dt *, int);
internal_proto(write_block);
extern void st_wait (st_parameter_wait *);
export_proto(st_wait);
+extern void hit_eof (st_parameter_dt *);
+internal_proto(hit_eof);
+
/* read.c */
extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
extern size_t size_from_complex_kind (int);
internal_proto(size_from_complex_kind);
-/* fbuf.c */
-extern void fbuf_init (gfc_unit *, size_t);
-internal_proto(fbuf_init);
-
-extern void fbuf_destroy (gfc_unit *);
-internal_proto(fbuf_destroy);
-
-extern void fbuf_reset (gfc_unit *);
-internal_proto(fbuf_reset);
-
-extern char * fbuf_alloc (gfc_unit *, size_t);
-internal_proto(fbuf_alloc);
-
-extern int fbuf_flush (gfc_unit *, int);
-internal_proto(fbuf_flush);
-
-extern int fbuf_seek (gfc_unit *, gfc_offset);
-internal_proto(fbuf_seek);
/* lock.c */
extern void free_ionml (st_parameter_dt *);
OSDN Git Service
