X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=blobdiff_plain;f=libgfortran%2Fio%2Fio.h;h=1f6041db7daf1fcd300c82d4396421693f7be2db;hp=004bcef8bf638c5ffc5e79ff663c025eeb25c58a;hb=bc45c9ffdd1813a3cecb164e96148634c5142a52;hpb=381a3bc8f9c1a1d7d6e5c33a113592177e30d91a diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 004bcef8bf6..1f6041db7da 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -1,5 +1,7 @@ -/* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc. +/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 + Free Software Foundation, Inc. Contributed by Andy Vaught + F2003 I/O support contributed by Jerry DeLisle This file is part of the GNU Fortran 95 runtime library (libgfortran). @@ -30,17 +32,11 @@ Boston, MA 02110-1301, USA. */ /* IO library include. */ -#include #include "libgfortran.h" -#ifdef HAVE_PRAGMA_WEAK -/* Used by gthr.h. */ -#define SUPPORTS_WEAK 1 -#endif +#include #include -#define DEFAULT_TEMPDIR "/tmp" - /* Basic types used in data transfers. */ typedef enum @@ -49,43 +45,47 @@ typedef enum } bt; - -typedef enum -{ SUCCESS = 1, FAILURE } -try; - struct st_parameter_dt; typedef struct stream { - char *(*alloc_w_at) (struct stream *, int *, gfc_offset); - char *(*alloc_r_at) (struct stream *, int *, gfc_offset); + char *(*alloc_w_at) (struct stream *, int *); try (*sfree) (struct stream *); try (*close) (struct stream *); try (*seek) (struct stream *, gfc_offset); - try (*truncate) (struct stream *); + 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_r(s, len) ((s)->alloc_r_at)(s, len, -1) -#define salloc_w(s, len) ((s)->alloc_w_at)(s, len, -1) - -#define salloc_r_at(s, len, where) ((s)->alloc_r_at)(s, len, where) -#define salloc_w_at(s, len, where) ((s)->alloc_w_at)(s, len, where) +#define salloc_w(s, len) ((s)->alloc_w_at)(s, len) #define sseek(s, pos) ((s)->seek)(s, pos) -#define struncate(s) ((s)->truncate)(s) +#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. */ + +#define is_array_io(dtp) ((dtp)->internal_unit_desc) + +#define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal) + +#define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM) + /* The array_loop_spec contains the variables for the loops over index ranges that are encountered. Since the variables can be negative, ssize_t is used. */ @@ -113,7 +113,7 @@ array_loop_spec; or &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END - The object can be a fully qualified, compound name for an instrinsic + The object can be a fully qualified, compound name for an intrinsic type, derived types or derived type components. So, a substring a(:)%b(4)%ch(2:4)(1:7) has to be treated correctly in namelist read. Hence full information about the structure of the object has @@ -161,7 +161,7 @@ namelist_info; /* Options for the OPEN statement. */ typedef enum -{ ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, +{ ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND, ACCESS_STREAM, ACCESS_UNSPECIFIED } unit_access; @@ -203,6 +203,25 @@ typedef enum unit_pad; typedef enum +{ DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED } +unit_decimal; + +typedef enum +{ ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED } +unit_encoding; + +typedef enum +{ ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE, + ROUND_PROCDEFINED, ROUND_UNSPECIFIED } +unit_round; + +/* NOTE: unit_sign must correspond with the sign_status enumerator in + st_parameter_dt to not break the ABI. */ +typedef enum +{ SIGN_PROCDEFINED, SIGN_SUPPRESS, SIGN_PLUS, SIGN_UNSPECIFIED } +unit_sign; + +typedef enum { ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED } unit_advance; @@ -210,6 +229,14 @@ typedef enum {READING, WRITING} unit_mode; +typedef enum +{ ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED } +unit_async; + +typedef enum +{ SIGN_S, SIGN_SS, SIGN_SP } +unit_sign_s; + #define CHARACTER1(name) \ char * name; \ gfc_charlen_type name ## _len @@ -217,41 +244,6 @@ unit_mode; gfc_charlen_type name ## _len; \ char * name -#define IOPARM_LIBRETURN_MASK (3 << 0) -#define IOPARM_LIBRETURN_OK (0 << 0) -#define IOPARM_LIBRETURN_ERROR (1 << 0) -#define IOPARM_LIBRETURN_END (2 << 0) -#define IOPARM_LIBRETURN_EOR (3 << 0) -#define IOPARM_ERR (1 << 2) -#define IOPARM_END (1 << 3) -#define IOPARM_EOR (1 << 4) -#define IOPARM_HAS_IOSTAT (1 << 5) -#define IOPARM_HAS_IOMSG (1 << 6) - -#define IOPARM_COMMON_MASK ((1 << 7) - 1) - -typedef struct st_parameter_common -{ - GFC_INTEGER_4 flags; - GFC_INTEGER_4 unit; - const char *filename; - GFC_INTEGER_4 line; - CHARACTER2 (iomsg); - GFC_INTEGER_4 *iostat; -} -st_parameter_common; - -#define IOPARM_OPEN_HAS_RECL_IN (1 << 7) -#define IOPARM_OPEN_HAS_FILE (1 << 8) -#define IOPARM_OPEN_HAS_STATUS (1 << 9) -#define IOPARM_OPEN_HAS_ACCESS (1 << 10) -#define IOPARM_OPEN_HAS_FORM (1 << 11) -#define IOPARM_OPEN_HAS_BLANK (1 << 12) -#define IOPARM_OPEN_HAS_POSITION (1 << 13) -#define IOPARM_OPEN_HAS_ACTION (1 << 14) -#define IOPARM_OPEN_HAS_DELIM (1 << 15) -#define IOPARM_OPEN_HAS_PAD (1 << 16) - typedef struct { st_parameter_common common; @@ -265,6 +257,12 @@ typedef struct CHARACTER2 (action); CHARACTER1 (delim); CHARACTER2 (pad); + CHARACTER1 (convert); + CHARACTER2 (decimal); + CHARACTER1 (encoding); + CHARACTER2 (round); + CHARACTER1 (sign); + CHARACTER2 (asynchronous); } st_parameter_open; @@ -289,28 +287,41 @@ st_parameter_filepos; #define IOPARM_INQUIRE_HAS_NAMED (1 << 10) #define IOPARM_INQUIRE_HAS_NEXTREC (1 << 11) #define IOPARM_INQUIRE_HAS_RECL_OUT (1 << 12) -#define IOPARM_INQUIRE_HAS_FILE (1 << 13) -#define IOPARM_INQUIRE_HAS_ACCESS (1 << 14) -#define IOPARM_INQUIRE_HAS_FORM (1 << 15) -#define IOPARM_INQUIRE_HAS_BLANK (1 << 16) -#define IOPARM_INQUIRE_HAS_POSITION (1 << 17) -#define IOPARM_INQUIRE_HAS_ACTION (1 << 18) -#define IOPARM_INQUIRE_HAS_DELIM (1 << 19) -#define IOPARM_INQUIRE_HAS_PAD (1 << 20) -#define IOPARM_INQUIRE_HAS_NAME (1 << 21) -#define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 22) -#define IOPARM_INQUIRE_HAS_DIRECT (1 << 23) -#define IOPARM_INQUIRE_HAS_FORMATTED (1 << 24) -#define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 25) -#define IOPARM_INQUIRE_HAS_READ (1 << 26) -#define IOPARM_INQUIRE_HAS_WRITE (1 << 27) -#define IOPARM_INQUIRE_HAS_READWRITE (1 << 28) +#define IOPARM_INQUIRE_HAS_STRM_POS_OUT (1 << 13) +#define IOPARM_INQUIRE_HAS_FILE (1 << 14) +#define IOPARM_INQUIRE_HAS_ACCESS (1 << 15) +#define IOPARM_INQUIRE_HAS_FORM (1 << 16) +#define IOPARM_INQUIRE_HAS_BLANK (1 << 17) +#define IOPARM_INQUIRE_HAS_POSITION (1 << 18) +#define IOPARM_INQUIRE_HAS_ACTION (1 << 19) +#define IOPARM_INQUIRE_HAS_DELIM (1 << 20) +#define IOPARM_INQUIRE_HAS_PAD (1 << 21) +#define IOPARM_INQUIRE_HAS_NAME (1 << 22) +#define IOPARM_INQUIRE_HAS_SEQUENTIAL (1 << 23) +#define IOPARM_INQUIRE_HAS_DIRECT (1 << 24) +#define IOPARM_INQUIRE_HAS_FORMATTED (1 << 25) +#define IOPARM_INQUIRE_HAS_UNFORMATTED (1 << 26) +#define IOPARM_INQUIRE_HAS_READ (1 << 27) +#define IOPARM_INQUIRE_HAS_WRITE (1 << 28) +#define IOPARM_INQUIRE_HAS_READWRITE (1 << 29) +#define IOPARM_INQUIRE_HAS_CONVERT (1 << 30) +#define IOPARM_INQUIRE_HAS_FLAGS2 (1 << 31) + +#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_SIZE (1 << 6) +#define IOPARM_INQUIRE_HAS_ID (1 << 7) typedef struct { st_parameter_common common; GFC_INTEGER_4 *exist, *opened, *number, *named; GFC_INTEGER_4 *nextrec, *recl_out; + GFC_IO_INT *strm_pos_out; CHARACTER1 (file); CHARACTER2 (access); CHARACTER1 (form); @@ -327,6 +338,16 @@ typedef struct CHARACTER2 (read); CHARACTER1 (write); CHARACTER2 (readwrite); + CHARACTER1 (convert); + GFC_INTEGER_4 flags2; + CHARACTER1 (asynchronous); + CHARACTER2 (decimal); + CHARACTER1 (encoding); + CHARACTER2 (pending); + CHARACTER1 (round); + CHARACTER2 (sign); + GFC_INTEGER_4 *size; + GFC_INTEGER_4 *id; } st_parameter_inquire; @@ -342,14 +363,194 @@ struct format_data; #define IOPARM_DT_HAS_ADVANCE (1 << 13) #define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14) #define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15) +#define IOPARM_DT_HAS_ID (1 << 16) +#define IOPARM_DT_HAS_POS (1 << 17) +#define IOPARM_DT_HAS_ASYNCHRONOUS (1 << 18) +#define IOPARM_DT_HAS_BLANK (1 << 19) +#define IOPARM_DT_HAS_DECIMAL (1 << 20) +#define IOPARM_DT_HAS_DELIM (1 << 21) +#define IOPARM_DT_HAS_PAD (1 << 22) +#define IOPARM_DT_HAS_ROUND (1 << 23) +#define IOPARM_DT_HAS_SIGN (1 << 24) +#define IOPARM_DT_HAS_F2003 (1 << 25) /* Internal use bit. */ #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_IO_INT *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; + unit_pad pad_status; + unit_decimal decimal_status; + unit_delim delim_status; +} st_parameter_44; + typedef struct st_parameter_dt { st_parameter_common common; - GFC_INTEGER_4 rec; - GFC_INTEGER_4 *size, *iolength; + GFC_IO_INT rec; + GFC_IO_INT *size, *iolength; gfc_array_char *internal_unit_desc; CHARACTER1 (format); CHARACTER2 (advance); @@ -359,71 +560,31 @@ typedef struct st_parameter_dt to reserve enough space. */ union { - struct - { - void (*transfer) (struct st_parameter_dt *, bt, void *, int, - size_t, size_t); - struct gfc_unit *current_unit; - int item_count; /* Item number in a formatted data transfer. */ - unit_mode mode; - unit_blank blank_status; - enum {SIGN_S, SIGN_SS, SIGN_SP} 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; - /* 20 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; - - /* 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]; - } p; - char pad[16 * sizeof (char *) + 32 * sizeof (int)]; + st_parameter_43 q; + st_parameter_44 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)]; } u; } st_parameter_dt; +/* Ensure st_parameter_dt's u.pad is bigger or equal to u.p. */ +extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad) + >= sizeof (((st_parameter_dt *) 0)->u.p) + ? 1 : -1]; + +#define IOPARM_WAIT_HAS_ID (1 << 7) + +typedef struct +{ + st_parameter_common common; + CHARACTER1 (id); +} +st_parameter_wait; + + #undef CHARACTER1 #undef CHARACTER2 @@ -438,15 +599,34 @@ typedef struct unit_position position; unit_status status; unit_pad pad; + unit_convert convert; + int has_recl; + unit_decimal decimal; + unit_encoding encoding; + unit_round round; + unit_sign sign; + unit_async async; } unit_flags; -/* The default value of record length for preconnected units is defined - here. This value can be overriden by an environment variable. - Default value is 1 Gb. */ +/* 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. */ -#define DEFAULT_RECL 1073741824 +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 @@ -458,7 +638,8 @@ typedef struct gfc_unit struct gfc_unit *left, *right; int priority; - int read_bad, current_record; + int read_bad, current_record, saved_pos, previous_nonadvancing_write; + enum { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE } endfile; @@ -466,11 +647,19 @@ typedef struct gfc_unit unit_mode mode; unit_flags flags; - /* recl -- Record length of the file. - last_record -- Last record number read or written - maxrec -- Maximum record number in a direct access file - bytes_left -- Bytes left in current record. */ - gfc_offset recl, last_record, maxrec, bytes_left; + /* recl -- Record length of the file. + last_record -- Last record number read or written + maxrec -- Maximum record number in a direct access file + bytes_left -- Bytes left in current record. + strm_pos -- Current position in file for STREAM I/O. + recl_subrecord -- Maximum length for subrecord. + bytes_left_subrecord -- Bytes left in current subrecord. */ + gfc_offset recl, last_record, maxrec, bytes_left, strm_pos, + recl_subrecord, bytes_left_subrecord; + + /* Set to 1 if we have read a subrecord. */ + + int continued; __gthread_mutex_t lock; /* Number of threads waiting to acquire this unit's lock. @@ -490,6 +679,9 @@ typedef struct gfc_unit int file_len; char *file; + + /* Formatting buffer. */ + struct fbuf *fbuf; } gfc_unit; @@ -502,7 +694,8 @@ typedef enum 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_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC, + FMT_DP } format_token; @@ -567,7 +760,7 @@ internal_proto(compare_files); extern stream *open_external (st_parameter_open *, unit_flags *); internal_proto(open_external); -extern stream *open_internal (char *, int); +extern stream *open_internal (char *, int, gfc_offset); internal_proto(open_internal); extern stream *input_stream (void); @@ -585,9 +778,6 @@ internal_proto(compare_file_filename); extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len); internal_proto(find_file); -extern void flush_all_units (void); -internal_proto(flush_all_units); - extern int stream_at_bof (stream *); internal_proto(stream_at_bof); @@ -630,6 +820,9 @@ 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); @@ -651,9 +844,6 @@ internal_proto(stream_ttyname); extern gfc_offset stream_offset (stream *s); internal_proto(stream_offset); -extern int unit_to_fd (int); -internal_proto(unit_to_fd); - extern int unpack_filename (char *, const char *, int); internal_proto(unpack_filename); @@ -673,17 +863,17 @@ internal_proto(unit_lock); extern int close_unit (gfc_unit *); internal_proto(close_unit); -extern int is_internal_unit (st_parameter_dt *); -internal_proto(is_internal_unit); +extern gfc_unit *get_internal_unit (st_parameter_dt *); +internal_proto(get_internal_unit); -extern int is_array_io (st_parameter_dt *); -internal_proto(is_array_io); +extern void free_internal_unit (st_parameter_dt *); +internal_proto(free_internal_unit); extern gfc_unit *find_unit (int); internal_proto(find_unit); extern gfc_unit *find_or_create_unit (int); -internal_proto(find_unit); +internal_proto(find_or_create_unit); extern gfc_unit *get_unit (st_parameter_dt *, int); internal_proto(get_unit); @@ -691,10 +881,13 @@ internal_proto(get_unit); extern void unlock_unit (gfc_unit *); internal_proto(unlock_unit); -/* open.c */ +extern void update_position (gfc_unit *); +internal_proto(update_position); -extern void test_endfile (gfc_unit *); -internal_proto(test_endfile); +extern void finish_last_advance_record (gfc_unit *u); +internal_proto (finish_last_advance_record); + +/* open.c */ extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *); internal_proto(new_unit); @@ -723,21 +916,32 @@ internal_proto(free_format_data); extern const char *type_name (bt); internal_proto(type_name); -extern void *read_block (st_parameter_dt *, int *); -internal_proto(read_block); +extern try read_block_form (st_parameter_dt *, void *, size_t *); +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 gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *); +extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *, + int*); internal_proto(next_array_record); -extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *); +extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *, + gfc_offset *); internal_proto(init_loop_spec); extern void next_record (st_parameter_dt *, int); internal_proto(next_record); +extern void reverse_memcpy (void *, const void *, size_t); +internal_proto (reverse_memcpy); + +extern void st_wait (st_parameter_wait *); +export_proto(st_wait); + /* read.c */ extern void set_integer (void *, GFC_INTEGER_LARGEST, int); @@ -752,6 +956,9 @@ internal_proto(convert_real); extern void read_a (st_parameter_dt *, const fnode *, char *, int); internal_proto(read_a); +extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int); +internal_proto(read_a); + extern void read_f (st_parameter_dt *, const fnode *, char *, int); internal_proto(read_f); @@ -787,6 +994,9 @@ internal_proto(namelist_write); extern void write_a (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_a); +extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int); +internal_proto(write_a_char4); + extern void write_b (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_b); @@ -814,6 +1024,12 @@ internal_proto(write_l); extern void write_o (st_parameter_dt *, const fnode *, const char *, int); internal_proto(write_o); +extern void write_real (st_parameter_dt *, const char *, int); +internal_proto(write_real); + +extern void write_real_g0 (st_parameter_dt *, const char *, int, int); +internal_proto(write_real_g0); + extern void write_x (st_parameter_dt *, int, int); internal_proto(write_x); @@ -824,10 +1040,6 @@ extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t, size_t); internal_proto(list_formatted_write); -/* error.c */ -extern try notify_std (int, const char *); -internal_proto(notify_std); - /* size_from_kind.c */ extern size_t size_from_real_kind (int); internal_proto(size_from_real_kind); @@ -835,6 +1047,25 @@ internal_proto(size_from_real_kind); 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 *); internal_proto(free_ionml); @@ -872,3 +1103,4 @@ dec_waiting_unlocked (gfc_unit *u) } #endif +