-/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,
- 2011
- Free Software Foundation, Inc.
+/* Copyright (C) 2002-2018 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).
+This file is part of the GNU Fortran 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
#include <gthr.h>
+
+/* POSIX 2008 specifies that the extended locale stuff is found in
+ locale.h, but some systems have them in xlocale.h. */
+
+#include <locale.h>
+
+#ifdef HAVE_XLOCALE_H
+#include <xlocale.h>
+#endif
+
+
/* Forward declarations. */
struct st_parameter_dt;
typedef struct stream stream;
typedef struct fnode fnode;
struct gfc_unit;
+#ifdef HAVE_NEWLOCALE
+/* We have POSIX 2008 extended locale stuff. */
+extern locale_t c_locale;
+internal_proto(c_locale);
+#else
+extern char* old_locale;
+internal_proto(old_locale);
+extern int old_locale_ctr;
+internal_proto(old_locale_ctr);
+extern __gthread_mutex_t old_locale_lock;
+internal_proto(old_locale_lock);
+#endif
+
/* Macros for testing what kinds of I/O we are doing. */
#define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM)
-#define is_char4_unit(dtp) ((dtp)->u.p.unit_is_internal && (dtp)->common.unit)
+#define is_char4_unit(dtp) ((dtp)->u.p.current_unit->internal_unit_kind == 4)
/* The array_loop_spec contains the variables for the loops over index ranges
that are encountered. */
}
array_loop_spec;
-/* A stucture to build a hash table for format data. */
+/* User defined input/output iomsg length. */
+
+#define IOMSG_LEN 256
+
+/* Subroutine formatted_dtio (struct, unit, iotype, v_list, iostat,
+ iomsg, (_iotype), (_iomsg)) */
+typedef void (*formatted_dtio)(void *, GFC_INTEGER_4 *, char *, gfc_array_i4 *,
+ GFC_INTEGER_4 *, char *,
+ gfc_charlen_type, gfc_charlen_type);
+
+/* Subroutine unformatted_dtio (struct, unit, iostat, iomsg, (_iomsg)) */
+typedef void (*unformatted_dtio)(void *, GFC_INTEGER_4 *, GFC_INTEGER_4 *,
+ char *, gfc_charlen_type);
+
+/* The dtio calls for namelist require a CLASS object to be built. */
+typedef struct gfc_class
+{
+ void *data;
+ void *vptr;
+ index_type len;
+}
+gfc_class;
+
+
+/* A structure to build a hash table for format data. */
#define FORMAT_HASH_SIZE 16
/* Address for the start of the object's data. */
void * mem_pos;
+ /* Address of specific DTIO subroutine. */
+ void * dtio_sub;
+
+ /* Address of vtable if dtio_sub non-null. */
+ void * vtable;
+
/* Flag to show that a read is to be attempted for this node. */
int touched;
unit_encoding;
typedef enum
-{ ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE,
- ROUND_PROCDEFINED, ROUND_UNSPECIFIED }
+{ ROUND_UP = GFC_FPE_UPWARD,
+ ROUND_DOWN = GFC_FPE_DOWNWARD,
+ ROUND_ZERO = GFC_FPE_TOWARDZERO,
+ ROUND_NEAREST = GFC_FPE_TONEAREST,
+ ROUND_COMPATIBLE = 10, /* round away from zero. */
+ ROUND_PROCDEFINED, /* Here as ROUND_NEAREST. */
+ ROUND_UNSPECIFIED /* Should never occur. */
+}
unit_round;
/* NOTE: unit_sign must correspond with the sign_status enumerator in
unit_advance;
typedef enum
-{READING, WRITING}
+{READING, WRITING, LIST_READING, LIST_WRITING}
unit_mode;
typedef enum
{ ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
unit_async;
+typedef enum
+{ SHARE_DENYRW, SHARE_DENYNONE,
+ SHARE_UNSPECIFIED
+}
+unit_share;
+
+typedef enum
+{ CC_LIST, CC_FORTRAN, CC_NONE,
+ CC_UNSPECIFIED
+}
+unit_cc;
+
+/* End-of-record types for CC_FORTRAN. */
+typedef enum
+{ CCF_DEFAULT=0x0,
+ CCF_OVERPRINT=0x1,
+ CCF_ONE_LF=0x2,
+ CCF_TWO_LF=0x4,
+ CCF_PAGE_FEED=0x8,
+ CCF_PROMPT=0x10,
+ CCF_OVERPRINT_NOA=0x20,
+} /* 6 bits */
+cc_fortran;
+
typedef enum
{ SIGN_S, SIGN_SS, SIGN_SP }
unit_sign_s;
+/* Make sure to keep st_parameter_* in sync with gcc/fortran/ioparm.def. */
+
#define CHARACTER1(name) \
char * name; \
gfc_charlen_type name ## _len
typedef struct
{
st_parameter_common common;
- GFC_INTEGER_4 recl_in;
+ GFC_IO_INT recl_in;
CHARACTER2 (file);
CHARACTER1 (status);
CHARACTER2 (access);
CHARACTER1 (sign);
CHARACTER2 (asynchronous);
GFC_INTEGER_4 *newunit;
+ GFC_INTEGER_4 readonly;
+ CHARACTER2 (cc);
+ CHARACTER1 (share);
}
st_parameter_open;
#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_FLAGS2 (1u << 31)
#define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0)
#define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1)
#define IOPARM_INQUIRE_HAS_PENDING (1 << 5)
#define IOPARM_INQUIRE_HAS_SIZE (1 << 6)
#define IOPARM_INQUIRE_HAS_ID (1 << 7)
+#define IOPARM_INQUIRE_HAS_IQSTREAM (1 << 8)
+#define IOPARM_INQUIRE_HAS_SHARE (1 << 9)
+#define IOPARM_INQUIRE_HAS_CC (1 << 10)
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;
+ GFC_IO_INT *nextrec, *recl_out, *strm_pos_out;
CHARACTER1 (file);
CHARACTER2 (access);
CHARACTER1 (form);
GFC_INTEGER_4 *pending;
GFC_IO_INT *size;
GFC_INTEGER_4 *id;
+ CHARACTER1 (iqstream);
+ CHARACTER2 (share);
+ CHARACTER1 (cc);
}
st_parameter_inquire;
#define IOPARM_DT_HAS_ROUND (1 << 23)
#define IOPARM_DT_HAS_SIGN (1 << 24)
#define IOPARM_DT_HAS_F2003 (1 << 25)
+#define IOPARM_DT_HAS_UDTIO (1 << 26)
+#define IOPARM_DT_DEFAULT_EXP (1 << 27)
/* Internal use bit. */
-#define IOPARM_DT_IONML_SET (1 << 31)
+#define IOPARM_DT_IONML_SET (1u << 31)
typedef struct st_parameter_dt
CHARACTER2 (advance);
CHARACTER1 (internal_unit);
CHARACTER2 (namelist_name);
+ GFC_INTEGER_4 *id;
+ GFC_IO_INT pos;
+ CHARACTER1 (asynchronous);
+ CHARACTER2 (blank);
+ CHARACTER1 (decimal);
+ CHARACTER2 (delim);
+ CHARACTER1 (pad);
+ CHARACTER2 (round);
+ CHARACTER1 (sign);
/* Private part of the structure. The compiler just needs
to reserve enough space. */
union
unit_blank blank_status;
unit_sign sign_status;
int scale_factor;
- int max_pos; /* Maximum righthand column written to. */
+ /* Maximum righthand column written to. */
+ int max_pos;
/* 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. */
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
+ to flag that calls are being made from namelist read (e.g. to
ignore comments or to treat '/' as a terminator) */
unsigned namelist_mode : 1;
/* A namelist specific flag used in the list directed library
unsigned g0_no_blanks : 1;
/* Used to signal use of free_format_data. */
unsigned format_not_saved : 1;
- /* 14 unused bits. */
-
- /* Used for ungetc() style functionality. Possible values
- are an unsigned char, EOF, or EOF - 1 used to mark the
- field as not valid. */
- int last_char;
- char nml_delim;
+ /* A flag used to identify when a non-standard expanded namelist read
+ has occurred. */
+ unsigned expanded_read : 1;
+ /* 13 unused bits. */
+ int child_saved_iostat;
+ int nml_delim;
int repeat_count;
int saved_length;
int saved_used;
char *line_buffer;
struct format_data *fmt;
namelist_info *ionml;
- /* A flag used to identify when a non-standard expanded namelist read
- has occurred. */
- int expanded_read;
+#ifdef HAVE_NEWLOCALE
+ locale_t old_locale;
+#endif
+ /* Current position within the look-ahead line buffer. */
+ int line_buffer_pos;
/* 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;
+ GFC_IO_INT not_used; /* Needed for alignment. */
+ formatted_dtio fdtio_ptr;
+ unformatted_dtio ufdtio_ptr;
+ /* With CC_FORTRAN, the first character of a record determines the
+ style of record end (and start) to use. We must mark down the type
+ when we write first in write_a so we remember the end type later in
+ next_record_w. */
+ struct
+ {
+ unsigned type : 6; /* See enum cc_fortran. */
+ unsigned len : 2; /* Always 0, 1, or 2. */
+ /* The union is updated after start-of-record is written. */
+ union
+ {
+ char start; /* Output character for start of record. */
+ char end; /* Output character for end of record. */
+ } u;
+ } cc;
} 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;
unit_round round;
unit_sign sign;
unit_async async;
+ unit_share share;
+ unit_cc cc;
+ int readonly;
}
unit_flags;
array_loop_spec *ls;
int rank;
- int file_len;
- char *file;
+ /* Name of the file at the time OPEN was executed, as a
+ null-terminated C string. */
+ char *filename;
/* The format hash table. */
struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE];
/* Formatting buffer. */
struct fbuf *fbuf;
+
+ /* Function pointer, points to list_read worker functions. */
+ int (*next_char_fn_ptr) (st_parameter_dt *);
+ void (*push_char_fn_ptr) (st_parameter_dt *, int);
+
+ /* Internal unit char string data. */
+ char * internal_unit;
+ gfc_charlen_type internal_unit_len;
+ gfc_array_char *string_unit_desc;
+ int internal_unit_kind;
+
+ /* DTIO Parent/Child procedure, 0 = parent, >0 = child level. */
+ int child_dtio;
+
+ /* Used for ungetc() style functionality. Possible values
+ are an unsigned char, EOF, or EOF - 1 used to mark the
+ field as not valid. */
+ int last_char;
+ bool has_size;
+ GFC_IO_INT size_used;
}
gfc_unit;
+typedef struct gfc_saved_unit
+{
+ GFC_INTEGER_4 unit_number;
+ gfc_unit *unit;
+}
+gfc_saved_unit;
+
+/* TEMP_FAILURE_RETRY macro from glibc. */
+
+#ifndef TEMP_FAILURE_RETRY
+/* Evaluate EXPRESSION, and repeat as long as it returns -1 with `errno'
+ set to EINTR. */
+
+# define TEMP_FAILURE_RETRY(expression) \
+ (__extension__ \
+ ({ long int __result; \
+ do __result = (long int) (expression); \
+ while (__result == -1L && errno == EINTR); \
+ __result; }))
+#endif
+
/* unit.c */
extern gfc_offset max_offset;
internal_proto(max_offset);
+/* Default RECL for sequential access if not given in OPEN statement,
+ computed at library initialization time. */
+extern gfc_offset default_recl;
+internal_proto(default_recl);
+
/* Unit tree root. */
extern gfc_unit *unit_root;
internal_proto(unit_root);
extern int close_unit (gfc_unit *);
internal_proto(close_unit);
-extern gfc_unit *get_internal_unit (st_parameter_dt *);
-internal_proto(get_internal_unit);
+extern gfc_unit *set_internal_unit (st_parameter_dt *, gfc_unit *, int);
+internal_proto(set_internal_unit);
-extern void free_internal_unit (st_parameter_dt *);
-internal_proto(free_internal_unit);
+extern void stash_internal_unit (st_parameter_dt *);
+internal_proto(stash_internal_unit);
extern gfc_unit *find_unit (int);
internal_proto(find_unit);
extern gfc_unit *get_unit (st_parameter_dt *, int);
internal_proto(get_unit);
-extern void unlock_unit (gfc_unit *);
+extern void unlock_unit(gfc_unit *);
internal_proto(unlock_unit);
extern void finish_last_advance_record (gfc_unit *u);
-internal_proto (finish_last_advance_record);
+internal_proto(finish_last_advance_record);
+
+extern int unit_truncate(gfc_unit *, gfc_offset, st_parameter_common *);
+internal_proto(unit_truncate);
-extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
-internal_proto (unit_truncate);
+extern int newunit_alloc (void);
+internal_proto(newunit_alloc);
+
+extern void newunit_free (int);
+internal_proto(newunit_free);
-extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *);
-internal_proto(get_unique_unit_number);
/* open.c */
extern const char *type_name (bt);
internal_proto(type_name);
-extern void * read_block_form (st_parameter_dt *, int *);
+extern void * read_block_form (st_parameter_dt *, size_t *);
internal_proto(read_block_form);
-extern void * read_block_form4 (st_parameter_dt *, int *);
+extern void * read_block_form4 (st_parameter_dt *, size_t *);
internal_proto(read_block_form4);
-extern void *write_block (st_parameter_dt *, int);
+extern void *write_block (st_parameter_dt *, size_t);
internal_proto(write_block);
extern gfc_offset next_array_record (st_parameter_dt *, array_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);
extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
internal_proto(set_integer);
-extern GFC_UINTEGER_LARGEST max_value (int, int);
-internal_proto(max_value);
+extern GFC_UINTEGER_LARGEST si_max (int);
+internal_proto(si_max);
extern int convert_real (st_parameter_dt *, void *, const char *, int);
internal_proto(convert_real);
extern int convert_infnan (st_parameter_dt *, void *, const char *, int);
internal_proto(convert_infnan);
-extern void read_a (st_parameter_dt *, const fnode *, char *, int);
+extern void read_a (st_parameter_dt *, const fnode *, char *, size_t);
internal_proto(read_a);
-extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, int);
+extern void read_a_char4 (st_parameter_dt *, const fnode *, char *, size_t);
internal_proto(read_a);
extern void read_f (st_parameter_dt *, const fnode *, char *, int);
extern void read_l (st_parameter_dt *, const fnode *, char *, int);
internal_proto(read_l);
-extern void read_x (st_parameter_dt *, int);
+extern void read_x (st_parameter_dt *, size_t);
internal_proto(read_x);
extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);
extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);
internal_proto(read_decimal);
+extern void read_user_defined (st_parameter_dt *, void *);
+internal_proto(read_user_defined);
+
+extern void read_user_defined (st_parameter_dt *, void *);
+internal_proto(read_user_defined);
+
/* list_read.c */
extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,
/* write.c */
-extern void write_a (st_parameter_dt *, const fnode *, const char *, int);
+extern void write_a (st_parameter_dt *, const fnode *, const char *, size_t);
internal_proto(write_a);
-extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, int);
+extern void write_a_char4 (st_parameter_dt *, const fnode *, const char *, size_t);
internal_proto(write_a_char4);
extern void write_b (st_parameter_dt *, const fnode *, const char *, int);
extern void write_z (st_parameter_dt *, const fnode *, const char *, int);
internal_proto(write_z);
+extern void write_user_defined (st_parameter_dt *, void *);
+internal_proto(write_user_defined);
+
+extern void write_user_defined (st_parameter_dt *, void *);
+internal_proto(write_user_defined);
+
extern void list_formatted_write (st_parameter_dt *, bt, void *, int, size_t,
size_t);
internal_proto(list_formatted_write);
#endif
}
+
+static inline void
+memset4 (gfc_char4_t *p, gfc_char4_t c, int k)
+{
+ int j;
+ for (j = 0; j < k; j++)
+ *p++ = c;
+}
+
#endif
projects / gcc.git / blobdiff