-/* Copyright (C) 2002-2003 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+ 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).
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, 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, 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.
+
+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
/* IO library include. */
-#include <setjmp.h>
#include "libgfortran.h"
-#define DEFAULT_TEMPDIR "/var/tmp"
+
+#include <setjmp.h>
+#include <gthr.h>
/* 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 *);
+ ssize_t (*read) (struct stream *, void *, ssize_t);
+ ssize_t (*write) (struct stream *, const void *, ssize_t);
+ off_t (*seek) (struct stream *, off_t, int);
+ off_t (*tell) (struct stream *);
+ /* Avoid keyword truncate due to AIX namespace collision. */
+ int (*trunc) (struct stream *, off_t);
+ int (*flush) (struct stream *);
+ int (*close) (struct stream *);
}
stream;
+/* Inline functions for doing file I/O given a stream. */
+static inline ssize_t
+sread (stream * s, void * buf, ssize_t nbyte)
+{
+ return s->read (s, buf, nbyte);
+}
-/* Macros for doing file I/O given a stream. */
+static inline ssize_t
+swrite (stream * s, const void * buf, ssize_t nbyte)
+{
+ return s->write (s, buf, nbyte);
+}
+
+static inline off_t
+sseek (stream * s, off_t offset, int whence)
+{
+ return s->seek (s, offset, whence);
+}
+
+static inline off_t
+stell (stream * s)
+{
+ return s->tell (s);
+}
+
+static inline int
+struncate (stream * s, off_t length)
+{
+ return s->trunc (s, length);
+}
+
+static inline int
+sflush (stream * s)
+{
+ return s->flush (s);
+}
+
+static inline int
+sclose (stream * s)
+{
+ return s->close (s);
+}
+
+
+/* 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. */
+
+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;
-#define sfree(s) ((s)->sfree)(s)
-#define sclose(s) ((s)->close)(s)
+/* A stucture to build a hash table for format data. */
-#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 FORMAT_HASH_SIZE 16
-#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)
+typedef struct format_hash_entry
+{
+ char *key;
+ gfc_charlen_type key_len;
+ struct format_data *hashed_fmt;
+}
+format_hash_entry;
-#define sseek(s, pos) ((s)->seek)(s, pos)
-#define struncate(s) ((s)->truncate)(s)
+/* 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 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
+ 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_STREAM,
ACCESS_UNSPECIFIED
}
unit_access;
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;
+typedef enum
+{READING, WRITING}
+unit_mode;
+typedef enum
+{ ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
+unit_async;
-/* 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
+{ SIGN_S, SIGN_SS, SIGN_SP }
+unit_sign_s;
+
+#define CHARACTER1(name) \
+ char * name; \
+ gfc_charlen_type name ## _len
+#define CHARACTER2(name) \
+ gfc_charlen_type name ## _len; \
+ char * name
typedef struct
{
- int unit;
- int err, end, eor, list_format; /* These are flags, not values. */
+ 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);
+ CHARACTER2 (decimal);
+ CHARACTER1 (encoding);
+ CHARACTER2 (round);
+ CHARACTER1 (sign);
+ CHARACTER2 (asynchronous);
+}
+st_parameter_open;
-/* 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. */
+#define IOPARM_CLOSE_HAS_STATUS (1 << 7)
- enum
- {
- LIBRARY_OK = 0,
- LIBRARY_ERROR,
- LIBRARY_END,
- LIBRARY_EOR
- }
- library_return;
+typedef struct
+{
+ st_parameter_common common;
+ CHARACTER1 (status);
+}
+st_parameter_close;
- int *iostat, *exist, *opened, *number, *named, rec, *nextrec, *size;
+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_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_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)
- int recl_in;
- int *recl_out;
+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);
+ 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);
+ GFC_INTEGER_4 flags2;
+ CHARACTER1 (asynchronous);
+ CHARACTER2 (decimal);
+ CHARACTER1 (encoding);
+ CHARACTER2 (round);
+ CHARACTER1 (sign);
+ GFC_INTEGER_4 *pending;
+ GFC_INTEGER_4 *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_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)
+#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_dt
+{
+ st_parameter_common common;
+ GFC_IO_INT rec;
+ GFC_IO_INT *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;
+ 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;
+ /* 15 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[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;
- 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;
-}
-st_parameter;
-
-
-
-#define ioparm prefix(ioparm)
-extern st_parameter ioparm;
-
-#define ionml prefix(ionml)
-extern namelist_info * ionml;
+/* 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
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 is defined here. This value can
- be overriden by the OPEN statement or by an environment variable. */
+/* 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 10000
+typedef struct fbuf
+{
+ char *buf; /* Start of buffer. */
+ int len; /* Length of buffer. */
+ int act; /* Active bytes in buffer. */
+ int pos; /* Current position in buffer. */
+}
+fbuf;
-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;
+ int read_bad, current_record, saved_pos, previous_nonadvancing_write;
+
enum
{ 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. */
+ unit_pad pad_status;
+ unit_decimal decimal_status;
+ unit_delim delim_status;
+
+ /* 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.
+ 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;
+ char *file;
- unit_blank blank_status;
- enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
- int scale_factor;
- jmp_buf eof_jump;
+ /* The format hash table. */
+ struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE];
+
+ /* Formatting buffer. */
+ struct fbuf *fbuf;
}
-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. */
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;
/* 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, gfc_offset);
+internal_proto(open_internal);
-#define compare_files prefix(compare_files)
-int compare_files (stream *, stream *);
+extern char * mem_alloc_w (stream *, int *);
+internal_proto(mem_alloc_w);
-#define init_error_stream prefix(init_error_stream)
-stream *init_error_stream (void);
+extern char * mem_alloc_r (stream *, int *);
+internal_proto(mem_alloc_w);
-#define open_external prefix(open_external)
-stream *open_external (unit_action, unit_status);
+extern stream *input_stream (void);
+internal_proto(input_stream);
-#define open_internal prefix(open_internal)
-stream *open_internal (char *, int);
+extern stream *output_stream (void);
+internal_proto(output_stream);
-#define input_stream prefix(input_stream)
-stream *input_stream (void);
+extern stream *error_stream (void);
+internal_proto(error_stream);
-#define output_stream prefix(output_stream)
-stream *output_stream (void);
+extern int compare_file_filename (gfc_unit *, const char *, int);
+internal_proto(compare_file_filename);
-#define compare_file_filename prefix(compare_file_filename)
-int compare_file_filename (stream *, const char *, int);
+extern gfc_unit *find_file (const char *file, gfc_charlen_type file_len);
+internal_proto(find_file);
-#define find_file prefix(find_file)
-unit_t *find_file (void);
+extern int delete_file (gfc_unit *);
+internal_proto(delete_file);
-#define stream_at_bof prefix(stream_at_bof)
-int stream_at_bof (stream *);
+extern int file_exists (const char *file, gfc_charlen_type file_len);
+internal_proto(file_exists);
-#define stream_at_eof prefix(stream_at_eof)
-int stream_at_eof (stream *);
+extern const char *inquire_sequential (const char *, int);
+internal_proto(inquire_sequential);
-#define delete_file prefix(delete_file)
-int delete_file (unit_t *);
+extern const char *inquire_direct (const char *, int);
+internal_proto(inquire_direct);
-#define file_exists prefix(file_exists)
-int file_exists (void);
+extern const char *inquire_formatted (const char *, int);
+internal_proto(inquire_formatted);
-#define inquire_sequential prefix(inquire_sequential)
-const char *inquire_sequential (const char *, int);
+extern const char *inquire_unformatted (const char *, int);
+internal_proto(inquire_unformatted);
-#define inquire_direct prefix(inquire_direct)
-const char *inquire_direct (const char *, int);
+extern const char *inquire_read (const char *, int);
+internal_proto(inquire_read);
-#define inquire_formatted prefix(inquire_formatted)
-const char *inquire_formatted (const char *, int);
+extern const char *inquire_write (const char *, int);
+internal_proto(inquire_write);
-#define inquire_unformatted prefix(inquire_unformatted)
-const char *inquire_unformatted (const char *, int);
+extern const char *inquire_readwrite (const char *, int);
+internal_proto(inquire_readwrite);
-#define inquire_read prefix(inquire_read)
-const char *inquire_read (const char *, int);
+extern gfc_offset file_length (stream *);
+internal_proto(file_length);
-#define inquire_write prefix(inquire_write)
-const char *inquire_write (const char *, int);
+extern int is_seekable (stream *);
+internal_proto(is_seekable);
-#define inquire_readwrite prefix(inquire_readwrite)
-const char *inquire_readwrite (const char *, int);
+extern int is_special (stream *);
+internal_proto(is_special);
-#define file_length prefix(file_length)
-offset_t file_length (stream *);
+extern int is_preconnected (stream *);
+internal_proto(is_preconnected);
-#define file_position prefix(file_position)
-offset_t file_position (stream *);
+extern void flush_if_preconnected (stream *);
+internal_proto(flush_if_preconnected);
-#define is_seekable prefix(is_seekable)
-int is_seekable (stream *);
+extern void empty_internal_buffer(stream *);
+internal_proto(empty_internal_buffer);
-#define empty_internal_buffer prefix(empty_internal_buffer)
-void empty_internal_buffer(stream *);
+extern int stream_isatty (stream *);
+internal_proto(stream_isatty);
+extern char * stream_ttyname (stream *);
+internal_proto(stream_ttyname);
+
+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);
+
+extern gfc_unit *find_unit (int);
+internal_proto(find_unit);
+
+extern gfc_unit *find_or_create_unit (int);
+internal_proto(find_or_create_unit);
-#define test_endfile prefix(test_endfile)
-void test_endfile (unit_t *);
+extern gfc_unit *get_unit (st_parameter_dt *, int);
+internal_proto(get_unit);
-#define new_unit prefix(new_unit)
-void new_unit (unit_flags *);
+extern void unlock_unit (gfc_unit *);
+internal_proto(unlock_unit);
+
+extern void update_position (gfc_unit *);
+internal_proto(update_position);
+
+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);
+
+/* open.c */
+
+extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);
+internal_proto(new_unit);
/* format.c */
-#define parse_format prefix(parse_format)
-void parse_format (void);
+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);
-#define next_format prefix(next_format)
-fnode *next_format (void);
+extern void free_format_data (struct format_data *);
+internal_proto(free_format_data);
-#define unget_format prefix(unget_format)
-void unget_format (fnode *);
+extern void free_format_hash_table (gfc_unit *);
+internal_proto(free_format_hash_table);
-#define format_error prefix(format_error)
-void format_error (fnode *, const char *);
+extern void init_format_hash (st_parameter_dt *);
+internal_proto(init_format_hash);
-#define free_fnodes prefix(free_fnodes)
-void free_fnodes (void);
+extern void free_format_hash (st_parameter_dt *);
+internal_proto(free_format_hash);
/* transfer.c */
#define SCRATCH_SIZE 300
-#define scratch prefix(scratch)
-extern char scratch[];
+extern const char *type_name (bt);
+internal_proto(type_name);
-#define type_name prefix(type_name)
-const char *type_name (bt);
+extern void * read_block_form (st_parameter_dt *, int *);
+internal_proto(read_block_form);
-#define read_block prefix(read_block)
-void *read_block (int *);
+extern char *read_sf (st_parameter_dt *, int *, int);
+internal_proto(read_sf);
-#define write_block prefix(write_block)
-void *write_block (int);
+extern void *write_block (st_parameter_dt *, int);
+internal_proto(write_block);
-#define transfer_integer prefix(transfer_integer)
-void transfer_integer (void *, int);
+extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
+ int*);
+internal_proto(next_array_record);
-#define transfer_real prefix(transfer_real)
-void transfer_real (void *, int);
+extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *,
+ gfc_offset *);
+internal_proto(init_loop_spec);
-#define transfer_logical prefix(transfer_logical)
-void transfer_logical (void *, int);
+extern void next_record (st_parameter_dt *, int);
+internal_proto(next_record);
-#define transfer_character prefix(transfer_character)
-void transfer_character (void *, int);
+extern void reverse_memcpy (void *, const void *, size_t);
+internal_proto (reverse_memcpy);
-#define transfer_complex prefix(transfer_complex)
-void transfer_complex (void *, int);
+extern void st_wait (st_parameter_wait *);
+export_proto(st_wait);
-#define next_record prefix(next_record)
-void next_record (int);
+extern void hit_eof (st_parameter_dt *);
+internal_proto(hit_eof);
-#define st_set_nml_var_int prefix(st_set_nml_var_int)
-void st_set_nml_var_int (void * , char * , int , int );
+/* read.c */
-#define st_set_nml_var_float prefix(st_set_nml_var_float)
-void st_set_nml_var_float (void * , char * , int , int );
+extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
+internal_proto(set_integer);
-#define st_set_nml_var_char prefix(st_set_nml_var_char)
-void st_set_nml_var_char (void * , char * , int , int );
+extern GFC_UINTEGER_LARGEST max_value (int, int);
+internal_proto(max_value);
-#define st_set_nml_var_complex prefix(st_set_nml_var_complex)
-void st_set_nml_var_complex (void * , char * , int , int );
+extern int convert_real (st_parameter_dt *, void *, const char *, int);
+internal_proto(convert_real);
-#define st_set_nml_var_log prefix(st_set_nml_var_log)
-void st_set_nml_var_log (void * , char * , int , int );
+extern void read_a (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(read_a);
-/* read.c */
+extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(read_a);
-#define set_integer prefix(set_integer)
-void set_integer (void *, int64_t, int);
+extern void read_f (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(read_f);
-#define max_value prefix(max_value)
-uint64_t max_value (int, int);
+extern void read_l (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(read_l);
-#define convert_real prefix(convert_real)
-int convert_real (void *, const char *, int);
+extern void read_x (st_parameter_dt *, int);
+internal_proto(read_x);
-#define read_a prefix(read_a)
-void read_a (fnode *, char *, int);
+extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
+internal_proto(read_radix);
-#define read_f prefix(read_f)
-void read_f (fnode *, char *, int);
+extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(read_decimal);
-#define read_l prefix(read_l)
-void read_l (fnode *, char *, int);
+/* list_read.c */
-#define read_x prefix(read_x)
-void read_x (fnode *);
+extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
+ size_t);
+internal_proto(list_formatted_read);
-#define read_radix prefix(read_radix)
-void read_radix (fnode *, char *, int, int);
+extern void finish_list_read (st_parameter_dt *);
+internal_proto(finish_list_read);
-#define read_decimal prefix(read_decimal)
-void read_decimal (fnode *, char *, int);
+extern void namelist_read (st_parameter_dt *);
+internal_proto(namelist_read);
-/* list_read.c */
+extern void namelist_write (st_parameter_dt *);
+internal_proto(namelist_write);
-#define list_formatted_read prefix(list_formatted_read)
-void list_formatted_read (bt, void *, int);
+/* write.c */
-#define finish_list_read prefix(finish_list_read)
-void finish_list_read (void);
+extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_a);
-#define init_at_eol prefix(init_at_eol)
-void init_at_eol();
+extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_a_char4);
-#define namelist_read prefix(namelist_read)
-void namelist_read();
+extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_b);
-#define namelist_write prefix(namelist_write)
-void namelist_write();
+extern void write_d (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_d);
-/* write.c */
+extern void write_e (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_e);
+
+extern void write_en (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_en);
+
+extern void write_es (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_es);
+
+extern void write_f (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_f);
-#define write_a prefix(write_a)
-void write_a (fnode *, const char *, int);
+extern void write_i (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_i);
-#define write_b prefix(write_b)
-void write_b (fnode *, const char *, int);
+extern void write_l (st_parameter_dt *, const fnode *, char *, int);
+internal_proto(write_l);
-#define write_d prefix(write_d)
-void write_d (fnode *, const char *, int);
+extern void write_o (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_o);
-#define write_e prefix(write_e)
-void write_e (fnode *, const char *, int);
+extern void write_real (st_parameter_dt *, const char *, int);
+internal_proto(write_real);
-#define write_en prefix(write_en)
-void write_en (fnode *, const char *, int);
+extern void write_real_g0 (st_parameter_dt *, const char *, int, int);
+internal_proto(write_real_g0);
-#define write_es prefix(write_es)
-void write_es (fnode *, const char *, int);
+extern void write_x (st_parameter_dt *, int, int);
+internal_proto(write_x);
-#define write_f prefix(write_f)
-void write_f (fnode *, const char *, int);
+extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
+internal_proto(write_z);
-#define write_i prefix(write_i)
-void write_i (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_l prefix(write_l)
-void write_l (fnode *, char *, int);
+/* size_from_kind.c */
+extern size_t size_from_real_kind (int);
+internal_proto(size_from_real_kind);
-#define write_o prefix(write_o)
-void write_o (fnode *, const char *, int);
+extern size_t size_from_complex_kind (int);
+internal_proto(size_from_complex_kind);
-#define write_x prefix(write_x)
-void write_x (fnode *);
+/* fbuf.c */
+extern void fbuf_init (gfc_unit *, int);
+internal_proto(fbuf_init);
-#define write_z prefix(write_z)
-void write_z (fnode *, const char *, int);
+extern void fbuf_destroy (gfc_unit *);
+internal_proto(fbuf_destroy);
-#define list_formatted_write prefix(list_formatted_write)
-void list_formatted_write (bt, void *, int);
+extern int fbuf_reset (gfc_unit *);
+internal_proto(fbuf_reset);
+extern char * fbuf_alloc (gfc_unit *, int);
+internal_proto(fbuf_alloc);
-#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)
+extern int fbuf_flush (gfc_unit *, unit_mode);
+internal_proto(fbuf_flush);
+extern int fbuf_seek (gfc_unit *, int, int);
+internal_proto(fbuf_seek);
-void __MAIN (void);
+extern char * fbuf_read (gfc_unit *, int *);
+internal_proto(fbuf_read);
+/* Never call this function, only use fbuf_getc(). */
+extern int fbuf_getc_refill (gfc_unit *);
+internal_proto(fbuf_getc_refill);
+
+static inline int
+fbuf_getc (gfc_unit * u)
+{
+ if (u->fbuf->pos < u->fbuf->act)
+ return (unsigned char) u->fbuf->buf[u->fbuf->pos++];
+ return fbuf_getc_refill (u);
+}
+
+/* lock.c */
+extern void free_ionml (st_parameter_dt *);
+internal_proto(free_ionml);
+
+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
+}
+
+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
+