-/* Copyright (C) 2002-2003 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran).
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, 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+the Free Software Foundation, 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
+
+/* 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. */
#ifndef GFOR_IO_H
#define GFOR_IO_H
#include <setjmp.h>
#include "libgfortran.h"
-#define DEFAULT_TEMPDIR "/var/tmp"
+
+#include <gthr.h>
+
+#define DEFAULT_TEMPDIR "/tmp"
/* Basic types used in data transfers. */
bt;
-typedef enum
-{ SUCCESS = 1, FAILURE }
-try;
+struct st_parameter_dt;
typedef struct stream
{
- char *(*alloc_w_at) (struct stream *, int *, offset_t);
- char *(*alloc_r_at) (struct stream *, int *, offset_t);
- try (*sfree) (struct stream *);
- try (*close) (struct stream *);
- try (*seek) (struct stream *, offset_t);
- try (*truncate) (struct stream *);
+ char *(*alloc_w_at) (struct stream *, int *, gfc_offset);
+ char *(*alloc_r_at) (struct stream *, int *, gfc_offset);
+ try (*sfree) (struct stream *);
+ try (*close) (struct stream *);
+ try (*seek) (struct stream *, gfc_offset);
+ try (*truncate) (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;
#define sseek(s, pos) ((s)->seek)(s, pos)
#define struncate(s) ((s)->truncate)(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)
+
+/* 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. */
+
+typedef struct array_loop_spec
+{
+ /* Index counter for this dimension. */
+ ssize_t idx;
+
+ /* Start for the index counter. */
+ ssize_t start;
+
+ /* End for the index counter. */
+ ssize_t end;
+
+ /* Step for the index counter. */
+ ssize_t step;
+}
+array_loop_spec;
+
+/* Representation of a namelist object in libgfortran
-/* Namelist represent object */
-/*
Namelist Records
- &groupname object=value [,object=value].../
+ &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]].../
or
- &groupname object=value [,object=value]...&groupname
+ &GROUPNAME OBJECT=value[s] [,OBJECT=value[s]]...&END
+
+ The object can be a fully qualified, compound name for an instrinsic
+ 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
+ to be available to list_read.c and write.
- Even more complex, during the execution of a program containing a
- namelist READ statement, you can specify a question mark character(?)
- or a question mark character preceded by an equal sign(=?) to get
- the information of the namelist group. By '?', the name of variables
- in the namelist will be displayed, by '=?', the name and value of
- variables will be displayed.
+ These requirements are met by the following data structures.
- All these requirements need a new data structure to record all info
- about the namelist.
-*/
+ namelist_info type contains all the scalar information about the
+ object and arrays of descriptor_dimension and array_loop_spec types for
+ arrays. */
typedef struct namelist_type
{
+
+ /* Object type, stored as GFC_DTYPE_xxxx. */
+ bt type;
+
+ /* Object name. */
char * var_name;
+
+ /* Address for the start of the object's data. */
void * mem_pos;
- int value_acquired;
+
+ /* Flag to show that a read is to be attempted for this node. */
+ int touched;
+
+ /* Length of intrinsic type in bytes. */
int len;
- bt type;
+
+ /* Rank of the object. */
+ int var_rank;
+
+ /* Overall size of the object in bytes. */
+ index_type size;
+
+ /* Length of character string. */
+ index_type string_length;
+
+ descriptor_dimension * dim;
+ array_loop_spec * ls;
struct namelist_type * next;
}
namelist_info;
/* Options for the OPEN statement. */
typedef enum
-{ ACCESS_SEQUENTIAL, ACCESS_DIRECT,
+{ ACCESS_SEQUENTIAL, ACCESS_DIRECT, ACCESS_APPEND,
ACCESS_UNSPECIFIED
}
unit_access;
{ ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
unit_advance;
+typedef enum
+{READING, WRITING}
+unit_mode;
-
-/* Statement parameters. These are all the things that can appear in
- an I/O statement. Some are inputs and some are outputs, but none
- are both. All of these values are initially zeroed and are zeroed
- at the end of a library statement. The relevant values need to be
- set before entry to an I/O statement. This structure needs to be
- duplicated by the back end. */
+typedef enum
+{ CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
+unit_convert;
+
+#define CHARACTER1(name) \
+ char * name; \
+ gfc_charlen_type name ## _len
+#define CHARACTER2(name) \
+ 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)
+#define IOPARM_OPEN_HAS_CONVERT (1 << 17)
typedef struct
{
- int unit;
- int err, end, eor, list_format; /* These are flags, not values. */
-
-/* Return values from library statements. These are returned only if
- the labels are specified in the statement itself and the condition
- occurs. In most cases, none of the labels are specified and the
- return value does not have to be checked. Must be consistent with
- the front end. */
-
- enum
- {
- LIBRARY_OK = 0,
- LIBRARY_ERROR,
- LIBRARY_END,
- LIBRARY_EOR
- }
- library_return;
-
- int *iostat, *exist, *opened, *number, *named, rec, *nextrec, *size;
+ st_parameter_common common;
+ GFC_INTEGER_4 recl_in;
+ CHARACTER2 (file);
+ CHARACTER1 (status);
+ CHARACTER2 (access);
+ CHARACTER1 (form);
+ CHARACTER2 (blank);
+ CHARACTER1 (position);
+ CHARACTER2 (action);
+ CHARACTER1 (delim);
+ CHARACTER2 (pad);
+ CHARACTER1 (convert);
+}
+st_parameter_open;
- int recl_in;
- int *recl_out;
+#define IOPARM_CLOSE_HAS_STATUS (1 << 7)
- char *file;
- int file_len;
- char *status;
- int status_len;
- char *access;
- int access_len;
- char *form;
- int form_len;
- char *blank;
- int blank_len;
- char *position;
- int position_len;
- char *action;
- int action_len;
- char *delim;
- int delim_len;
- char *pad;
- int pad_len;
- char *format;
- int format_len;
- char *advance;
- int advance_len;
- char *name;
- int name_len;
- char *internal_unit;
- int internal_unit_len;
- char *sequential;
- int sequential_len;
- char *direct;
- int direct_len;
- char *formatted;
- int formatted_len;
- char *unformatted;
- int unformatted_len;
- char *read;
- int read_len;
- char *write;
- int write_len;
- char *readwrite;
- int readwrite_len;
-
-/* namelist related data */
- char * namelist_name;
- int namelist_name_len;
- int namelist_read_mode;
+typedef struct
+{
+ st_parameter_common common;
+ CHARACTER1 (status);
}
-st_parameter;
+st_parameter_close;
+typedef struct
+{
+ st_parameter_common common;
+}
+st_parameter_filepos;
+
+#define IOPARM_INQUIRE_HAS_EXIST (1 << 7)
+#define IOPARM_INQUIRE_HAS_OPENED (1 << 8)
+#define IOPARM_INQUIRE_HAS_NUMBER (1 << 9)
+#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_CONVERT (1 << 29)
+typedef struct
+{
+ st_parameter_common common;
+ GFC_INTEGER_4 *exist, *opened, *number, *named;
+ GFC_INTEGER_4 *nextrec, *recl_out;
+ CHARACTER1 (file);
+ CHARACTER2 (access);
+ CHARACTER1 (form);
+ CHARACTER2 (blank);
+ CHARACTER1 (position);
+ CHARACTER2 (action);
+ CHARACTER1 (delim);
+ CHARACTER2 (pad);
+ CHARACTER1 (name);
+ CHARACTER2 (sequential);
+ CHARACTER1 (direct);
+ CHARACTER2 (formatted);
+ CHARACTER1 (unformatted);
+ CHARACTER2 (read);
+ CHARACTER1 (write);
+ CHARACTER2 (readwrite);
+ CHARACTER1 (convert);
+}
+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_HAS_REC (1 << 9)
+#define IOPARM_DT_HAS_SIZE (1 << 10)
+#define IOPARM_DT_HAS_IOLENGTH (1 << 11)
+#define IOPARM_DT_HAS_FORMAT (1 << 12)
+#define IOPARM_DT_HAS_ADVANCE (1 << 13)
+#define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14)
+#define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15)
+/* Internal use bit. */
+#define IOPARM_DT_IONML_SET (1 << 31)
+
+typedef struct st_parameter_dt
+{
+ st_parameter_common common;
+ GFC_INTEGER_4 rec;
+ GFC_INTEGER_4 *size, *iolength;
+ gfc_array_char *internal_unit_desc;
+ CHARACTER1 (format);
+ CHARACTER2 (advance);
+ CHARACTER1 (internal_unit);
+ CHARACTER2 (namelist_name);
+ /* Private part of the structure. The compiler just needs
+ to reserve enough space. */
+ union
+ {
+ 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;
+ 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;
+ /* 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;
+ /* 17 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;
+ } 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[16 * sizeof (char *) + 32 * sizeof (int)];
+ } u;
+}
+st_parameter_dt;
-#define ioparm prefix(ioparm)
-extern st_parameter ioparm;
+/* 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 ionml prefix(ionml)
-extern namelist_info * ionml;
+#undef CHARACTER1
+#undef CHARACTER2
typedef struct
{
unit_position position;
unit_status status;
unit_pad pad;
+ unit_convert convert;
}
unit_flags;
-/* The default value of record length is defined here. This value can
- be overriden by the OPEN statement or by an environment variable. */
+/* 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. */
-#define DEFAULT_RECL 10000
+#define DEFAULT_RECL 1073741824
-typedef struct unit_t
+typedef struct gfc_unit
{
int unit_number;
-
stream *s;
-
- struct unit_t *left, *right; /* Treap links. */
+
+ /* Treap links. */
+ struct gfc_unit *left, *right;
int priority;
int read_bad, current_record;
{ NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
endfile;
+ unit_mode mode;
unit_flags flags;
- offset_t 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. */
+ gfc_offset recl, last_record, maxrec, bytes_left;
+
+ __gthread_mutex_t lock;
+ /* Number of threads waiting to acquire this unit's lock.
+ When non-zero, close_unit doesn't only removes the unit
+ from the UNIT_ROOT tree, but doesn't free it and the
+ last of the waiting threads will do that.
+ This must be either atomically increased/decreased, or
+ always guarded by UNIT_LOCK. */
+ int waiting;
+ /* Flag set by close_unit if the unit as been closed.
+ Must be manipulated under unit's lock. */
+ int closed;
+
+ /* For traversing arrays */
+ array_loop_spec *ls;
+ int rank;
int file_len;
- char file[1]; /* Filename is allocated at the end of the structure. */
-}
-unit_t;
-
-/* Global variables. Putting these in a structure makes it easier to
- maintain, particularly with the constraint of a prefix. */
-
-typedef struct
-{
- int in_library; /* Nonzero if a library call is being processed. */
- int size; /* Bytes processed by the current data-transfer statement. */
- offset_t max_offset; /* Maximum file offset. */
- int item_count; /* Item number in a formatted data transfer. */
- int reversion_flag; /* Format reversion has occurred. */
- int first_item;
-
- unit_t *unit_root;
- int seen_dollar;
-
- enum {READING, WRITING} mode;
-
- unit_blank blank_status;
- enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
- int scale_factor;
- jmp_buf eof_jump;
+ char *file;
}
-global_t;
-
-
-#define g prefix(g)
-extern global_t g;
-
-
-#define current_unit prefix(current_unit)
-extern unit_t *current_unit;
+gfc_unit;
/* Format tokens. Only about half of these can be stored in the
format nodes. */
/* unix.c */
-#define sys_exit prefix(sys_exit)
-void sys_exit (int) __attribute__ ((noreturn));
+extern int move_pos_offset (stream *, int);
+internal_proto(move_pos_offset);
+
+extern int compare_files (stream *, stream *);
+internal_proto(compare_files);
-#define move_pos_offset prefix(move_pos_offset)
-int move_pos_offset (stream *, int);
+extern stream *open_external (st_parameter_open *, unit_flags *);
+internal_proto(open_external);
-#define get_oserror prefix(get_oserror)
-const char *get_oserror (void);
+extern stream *open_internal (char *, int);
+internal_proto(open_internal);
-#define compare_files prefix(compare_files)
-int compare_files (stream *, stream *);
+extern stream *input_stream (void);
+internal_proto(input_stream);
-#define init_error_stream prefix(init_error_stream)
-stream *init_error_stream (void);
+extern stream *output_stream (void);
+internal_proto(output_stream);
-#define open_external prefix(open_external)
-stream *open_external (unit_action, unit_status);
+extern stream *error_stream (void);
+internal_proto(error_stream);
-#define open_internal prefix(open_internal)
-stream *open_internal (char *, int);
+extern int compare_file_filename (gfc_unit *, const char *, int);
+internal_proto(compare_file_filename);
-#define input_stream prefix(input_stream)
-stream *input_stream (void);
+extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
+internal_proto(find_file);
-#define output_stream prefix(output_stream)
-stream *output_stream (void);
+extern void flush_all_units (void);
+internal_proto(flush_all_units);
-#define compare_file_filename prefix(compare_file_filename)
-int compare_file_filename (stream *, const char *, int);
+extern int stream_at_bof (stream *);
+internal_proto(stream_at_bof);
-#define find_file prefix(find_file)
-unit_t *find_file (void);
+extern int stream_at_eof (stream *);
+internal_proto(stream_at_eof);
-#define stream_at_bof prefix(stream_at_bof)
-int stream_at_bof (stream *);
+extern int delete_file (gfc_unit *);
+internal_proto(delete_file);
-#define stream_at_eof prefix(stream_at_eof)
-int stream_at_eof (stream *);
+extern int file_exists (const char *file, gfc_charlen_type file_len);
+internal_proto(file_exists);
-#define delete_file prefix(delete_file)
-int delete_file (unit_t *);
+extern const char *inquire_sequential (const char *, int);
+internal_proto(inquire_sequential);
-#define file_exists prefix(file_exists)
-int file_exists (void);
+extern const char *inquire_direct (const char *, int);
+internal_proto(inquire_direct);
-#define inquire_sequential prefix(inquire_sequential)
-const char *inquire_sequential (const char *, int);
+extern const char *inquire_formatted (const char *, int);
+internal_proto(inquire_formatted);
-#define inquire_direct prefix(inquire_direct)
-const char *inquire_direct (const char *, int);
+extern const char *inquire_unformatted (const char *, int);
+internal_proto(inquire_unformatted);
-#define inquire_formatted prefix(inquire_formatted)
-const char *inquire_formatted (const char *, int);
+extern const char *inquire_read (const char *, int);
+internal_proto(inquire_read);
-#define inquire_unformatted prefix(inquire_unformatted)
-const char *inquire_unformatted (const char *, int);
+extern const char *inquire_write (const char *, int);
+internal_proto(inquire_write);
-#define inquire_read prefix(inquire_read)
-const char *inquire_read (const char *, int);
+extern const char *inquire_readwrite (const char *, int);
+internal_proto(inquire_readwrite);
-#define inquire_write prefix(inquire_write)
-const char *inquire_write (const char *, int);
+extern gfc_offset file_length (stream *);
+internal_proto(file_length);
-#define inquire_readwrite prefix(inquire_readwrite)
-const char *inquire_readwrite (const char *, int);
+extern gfc_offset file_position (stream *);
+internal_proto(file_position);
-#define file_length prefix(file_length)
-offset_t file_length (stream *);
+extern int is_seekable (stream *);
+internal_proto(is_seekable);
-#define file_position prefix(file_position)
-offset_t file_position (stream *);
+extern int is_preconnected (stream *);
+internal_proto(is_preconnected);
-#define is_seekable prefix(is_seekable)
-int is_seekable (stream *);
+extern void flush_if_preconnected (stream *);
+internal_proto(flush_if_preconnected);
-#define empty_internal_buffer prefix(empty_internal_buffer)
-void empty_internal_buffer(stream *);
+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 */
-#define insert_unit prefix(insert_unix)
-void insert_unit (unit_t *);
+/* Maximum file offset, computed at library initialization time. */
+extern gfc_offset max_offset;
+internal_proto(max_offset);
-#define close_unit prefix(close_unit)
-int close_unit (unit_t *);
+/* Unit tree root. */
+extern gfc_unit *unit_root;
+internal_proto(unit_root);
-#define is_internal_unit prefix(is_internal_unit)
-int is_internal_unit (void);
+extern __gthread_mutex_t unit_lock;
+internal_proto(unit_lock);
-#define find_unit prefix(find_unit)
-unit_t *find_unit (int);
+extern int close_unit (gfc_unit *);
+internal_proto(close_unit);
-#define get_unit prefix(get_unit)
-unit_t *get_unit (int);
+extern gfc_unit *get_internal_unit (st_parameter_dt *);
+internal_proto(get_internal_unit);
-/* open.c */
+extern void free_internal_unit (st_parameter_dt *);
+internal_proto(free_internal_unit);
-#define test_endfile prefix(test_endfile)
-void test_endfile (unit_t *);
+extern int is_internal_unit (st_parameter_dt *);
+internal_proto(is_internal_unit);
-#define new_unit prefix(new_unit)
-void new_unit (unit_flags *);
+extern int is_array_io (st_parameter_dt *);
+internal_proto(is_array_io);
-/* format.c */
+extern gfc_unit *find_unit (int);
+internal_proto(find_unit);
-#define parse_format prefix(parse_format)
-void parse_format (void);
+extern gfc_unit *find_or_create_unit (int);
+internal_proto(find_or_create_unit);
-#define next_format prefix(next_format)
-fnode *next_format (void);
+extern gfc_unit *get_unit (st_parameter_dt *, int);
+internal_proto(get_unit);
-#define unget_format prefix(unget_format)
-void unget_format (fnode *);
+extern void unlock_unit (gfc_unit *);
+internal_proto(unlock_unit);
-#define format_error prefix(format_error)
-void format_error (fnode *, const char *);
+/* open.c */
-#define free_fnodes prefix(free_fnodes)
-void free_fnodes (void);
+extern void test_endfile (gfc_unit *);
+internal_proto(test_endfile);
-/* transfer.c */
+extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
+internal_proto(new_unit);
-#define SCRATCH_SIZE 300
+/* format.c */
-#define scratch prefix(scratch)
-extern char scratch[];
+extern void parse_format (st_parameter_dt *);
+internal_proto(parse_format);
-#define type_name prefix(type_name)
-const char *type_name (bt);
+extern const fnode *next_format (st_parameter_dt *);
+internal_proto(next_format);
-#define read_block prefix(read_block)
-void *read_block (int *);
+extern void unget_format (st_parameter_dt *, const fnode *);
+internal_proto(unget_format);
-#define write_block prefix(write_block)
-void *write_block (int);
+extern void format_error (st_parameter_dt *, const fnode *, const char *);
+internal_proto(format_error);
-#define transfer_integer prefix(transfer_integer)
-void transfer_integer (void *, int);
+extern void free_format_data (st_parameter_dt *);
+internal_proto(free_format_data);
-#define transfer_real prefix(transfer_real)
-void transfer_real (void *, int);
+/* transfer.c */
-#define transfer_logical prefix(transfer_logical)
-void transfer_logical (void *, int);
+#define SCRATCH_SIZE 300
-#define transfer_character prefix(transfer_character)
-void transfer_character (void *, int);
+extern const char *type_name (bt);
+internal_proto(type_name);
-#define transfer_complex prefix(transfer_complex)
-void transfer_complex (void *, int);
+extern void *read_block (st_parameter_dt *, int *);
+internal_proto(read_block);
-#define next_record prefix(next_record)
-void next_record (int);
+extern char *read_sf (st_parameter_dt *, int *, int);
+internal_proto(read_sf);
-#define st_set_nml_var_int prefix(st_set_nml_var_int)
-void st_set_nml_var_int (void * , char * , int , int );
+extern void *write_block (st_parameter_dt *, int);
+internal_proto(write_block);
-#define st_set_nml_var_float prefix(st_set_nml_var_float)
-void st_set_nml_var_float (void * , char * , int , int );
+extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *);
+internal_proto(next_array_record);
-#define st_set_nml_var_char prefix(st_set_nml_var_char)
-void st_set_nml_var_char (void * , char * , int , int );
+extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *);
+internal_proto(init_loop_spec);
-#define st_set_nml_var_complex prefix(st_set_nml_var_complex)
-void st_set_nml_var_complex (void * , char * , int , int );
+extern void next_record (st_parameter_dt *, int);
+internal_proto(next_record);
-#define st_set_nml_var_log prefix(st_set_nml_var_log)
-void st_set_nml_var_log (void * , char * , int , int );
+extern void reverse_memcpy (void *, const void *, size_t);
+internal_proto (reverse_memcpy);
/* read.c */
-#define set_integer prefix(set_integer)
-void set_integer (void *, int64_t, int);
+extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
+internal_proto(set_integer);
-#define max_value prefix(max_value)
-uint64_t max_value (int, int);
+extern GFC_UINTEGER_LARGEST max_value (int, int);
+internal_proto(max_value);
-#define convert_real prefix(convert_real)
-int convert_real (void *, const char *, int);
+extern int convert_real (st_parameter_dt *, void *, const char *, int);
+internal_proto(convert_real);
-#define read_a prefix(read_a)
-void read_a (fnode *, char *, int);
+extern void read_a (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(read_a);
-#define read_f prefix(read_f)
-void read_f (fnode *, char *, int);
+extern void read_f (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(read_f);
-#define read_l prefix(read_l)
-void read_l (fnode *, char *, int);
+extern void read_l (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(read_l);
-#define read_x prefix(read_x)
-void read_x (fnode *);
+extern void read_x (st_parameter_dt *, int);
+internal_proto(read_x);
-#define read_radix prefix(read_radix)
-void read_radix (fnode *, char *, int, int);
+extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
+internal_proto(read_radix);
-#define read_decimal prefix(read_decimal)
-void read_decimal (fnode *, char *, int);
+extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(read_decimal);
/* list_read.c */
-#define list_formatted_read prefix(list_formatted_read)
-void list_formatted_read (bt, void *, int);
-
-#define finish_list_read prefix(finish_list_read)
-void finish_list_read (void);
+extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
+ size_t);
+internal_proto(list_formatted_read);
-#define init_at_eol prefix(init_at_eol)
-void init_at_eol();
+extern void finish_list_read (st_parameter_dt *);
+internal_proto(finish_list_read);
-#define namelist_read prefix(namelist_read)
-void namelist_read();
+extern void namelist_read (st_parameter_dt *);
+internal_proto(namelist_read);
-#define namelist_write prefix(namelist_write)
-void namelist_write();
+extern void namelist_write (st_parameter_dt *);
+internal_proto(namelist_write);
/* write.c */
-#define write_a prefix(write_a)
-void write_a (fnode *, const char *, int);
+extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_a);
+
+extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_b);
+
+extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_d);
+
+extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_e);
-#define write_b prefix(write_b)
-void write_b (fnode *, const char *, int);
+extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_en);
-#define write_d prefix(write_d)
-void write_d (fnode *, const char *, int);
+extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_es);
-#define write_e prefix(write_e)
-void write_e (fnode *, const char *, int);
+extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_f);
-#define write_en prefix(write_en)
-void write_en (fnode *, const char *, int);
+extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_i);
-#define write_es prefix(write_es)
-void write_es (fnode *, const char *, int);
+extern void write_l (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(write_l);
-#define write_f prefix(write_f)
-void write_f (fnode *, const char *, int);
+extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_o);
-#define write_i prefix(write_i)
-void write_i (fnode *, const char *, int);
+extern void write_x (st_parameter_dt *, int, int);
+internal_proto(write_x);
-#define write_l prefix(write_l)
-void write_l (fnode *, char *, int);
+extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_z);
-#define write_o prefix(write_o)
-void write_o (fnode *, const char *, int);
+extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
+ size_t);
+internal_proto(list_formatted_write);
-#define write_x prefix(write_x)
-void write_x (fnode *);
+/* error.c */
+extern notification notification_std(int);
+internal_proto(notification_std);
-#define write_z prefix(write_z)
-void write_z (fnode *, const char *, int);
+/* size_from_kind.c */
+extern size_t size_from_real_kind (int);
+internal_proto(size_from_real_kind);
-#define list_formatted_write prefix(list_formatted_write)
-void list_formatted_write (bt, void *, int);
+extern size_t size_from_complex_kind (int);
+internal_proto(size_from_complex_kind);
+/* lock.c */
+extern void free_ionml (st_parameter_dt *);
+internal_proto(free_ionml);
-#define st_open prefix(st_open)
-#define st_close prefix(st_close)
-#define st_inquire prefix(st_inquire)
-#define st_rewind prefix(st_rewind)
-#define st_read prefix(st_read)
-#define st_read_done prefix(st_read_done)
-#define st_write prefix(st_write)
-#define st_write_done prefix(st_write_done)
-#define st_backspace prefix(st_backspace)
-#define st_endfile prefix(st_endfile)
+static inline void
+inc_waiting_locked (gfc_unit *u)
+{
+#ifdef HAVE_SYNC_FETCH_AND_ADD
+ (void) __sync_fetch_and_add (&u->waiting, 1);
+#else
+ u->waiting++;
+#endif
+}
+static inline int
+predec_waiting_locked (gfc_unit *u)
+{
+#ifdef HAVE_SYNC_FETCH_AND_ADD
+ return __sync_add_and_fetch (&u->waiting, -1);
+#else
+ return --u->waiting;
+#endif
+}
-void __MAIN (void);
+static inline void
+dec_waiting_unlocked (gfc_unit *u)
+{
+#ifdef HAVE_SYNC_FETCH_AND_ADD
+ (void) __sync_fetch_and_add (&u->waiting, -1);
+#else
+ __gthread_mutex_lock (&unit_lock);
+ u->waiting--;
+ __gthread_mutex_unlock (&unit_lock);
+#endif
+}
#endif
+
+/* ../runtime/environ.c This is here because we return unit_convert. */
+
+unit_convert get_unformatted_convert (int);
+internal_proto(get_unformatted_convert);