Subversion Repositories openrisc

/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010,

   2011

   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 3, or (at your option)

any later version.

Libgfortran is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

GNU General Public License for more details.

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 "libgfortran.h"

#include <gthr.h>

/* Forward declarations.  */

struct st_parameter_dt;

typedef struct stream stream;

struct fbuf;

struct format_data;

typedef struct fnode fnode;

struct gfc_unit;

/* 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)

#define is_char4_unit(dtp) ((dtp)->u.p.unit_is_internal && (dtp)->common.unit)

/* The array_loop_spec contains the variables for the loops over index ranges

   that are encountered.  */

typedef struct array_loop_spec

{

  /* Index counter for this dimension.  */

  index_type idx;

  /* Start for the index counter.  */

  index_type start;

  /* End for the index counter.  */

  index_type end;

  /* Step for the index counter.  */

  index_type step;

}

array_loop_spec;

/* A stucture to build a hash table for format data.  */

#define FORMAT_HASH_SIZE 16

typedef struct format_hash_entry

{

  char *key;

  gfc_charlen_type key_len;

  struct format_data *hashed_fmt;

}

format_hash_entry;

/* Representation of a namelist object in libgfortran

   Namelist Records

      &GROUPNAME  OBJECT=value[s] [,OBJECT=value[s]].../

     or

      &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.

   These requirements are met by the following data structures.

   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.  */

  bt type;

  /* Object name.  */

  char * var_name;

  /* Address for the start of the object's data.  */

  void * mem_pos;

  /* Flag to show that a read is to be attempted for this node.  */

  int touched;

  /* Length of intrinsic type in bytes.  */

  int len;

  /* 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_APPEND, ACCESS_STREAM,

  ACCESS_UNSPECIFIED

}

unit_access;

typedef enum

{ ACTION_READ, ACTION_WRITE, ACTION_READWRITE,

  ACTION_UNSPECIFIED

}

unit_action;

typedef enum

{ BLANK_NULL, BLANK_ZERO, BLANK_UNSPECIFIED }

unit_blank;

typedef enum

{ DELIM_NONE, DELIM_APOSTROPHE, DELIM_QUOTE,

  DELIM_UNSPECIFIED

}

unit_delim;

typedef enum

{ FORM_FORMATTED, FORM_UNFORMATTED, FORM_UNSPECIFIED }

unit_form;

typedef enum

{ POSITION_ASIS, POSITION_REWIND, POSITION_APPEND,

  POSITION_UNSPECIFIED

}

unit_position;

typedef enum

{ STATUS_UNKNOWN, STATUS_OLD, STATUS_NEW, STATUS_SCRATCH,

  STATUS_REPLACE, STATUS_UNSPECIFIED

}

unit_status;

typedef enum

{ PAD_YES, PAD_NO, PAD_UNSPECIFIED }

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;

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

{

  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);

  GFC_INTEGER_4 *newunit;

}

st_parameter_open;

#define IOPARM_CLOSE_HAS_STATUS         (1 << 7)

typedef struct

{

  st_parameter_common common;

  CHARACTER1 (status);

}

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_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)

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_IO_INT *size;

  GFC_INTEGER_4 *id;

}

st_parameter_inquire;

#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:

               1 if an EOR was encountered due to a 1-byte marker (LF)

               2 if an EOR was encountered due to a 2-bytes marker (CRLF) */

          int sf_seen_eor;

          unit_advance advance_status;

          unsigned reversion_flag : 1; /* Format reversion has occurred.  */

          unsigned first_item : 1;

          unsigned seen_dollar : 1;

          unsigned eor_condition : 1;

          unsigned no_leading_blank : 1;

          unsigned char_flag : 1;

          unsigned input_complete : 1;

          unsigned at_eol : 1;

          unsigned comma_flag : 1;

          /* A namelist specific flag used in the list directed library

             to flag that calls are being made from namelist read (eg. to

             ignore comments or to treat '/' as a terminator)  */

          unsigned namelist_mode : 1;

          /* A namelist specific flag used in the list directed library

             to flag read errors and return, so that an attempt can be

             made to read a new object name.  */

          unsigned nml_read_error : 1;

          /* A sequential formatted read specific flag used to signal that a

             character string is being read so don't use commas to shorten a

             formatted field width.  */

          unsigned sf_read_comma : 1;

          /* A namelist specific flag used to enable reading input from

             line_buffer for logical reads.  */

          unsigned line_buffer_enabled : 1;

          /* An internal unit specific flag used to identify that the associated

             unit is internal.  */

          unsigned unit_is_internal : 1;

          /* An internal unit specific flag to signify an EOF condition for list

             directed read.  */

          unsigned at_eof : 1;

          /* Used for g0 floating point output.  */

          unsigned g0_no_blanks : 1;

          /* Used to signal use of free_format_data.  */

          unsigned format_not_saved : 1;

          /* 14 unused bits.  */

          /* 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;

          int repeat_count;

          int saved_length;

          int saved_used;

          bt saved_type;

          char *saved_string;

          char *scratch;

          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;

          /* 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;

/* 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_access access;

  unit_action action;

  unit_blank blank;

  unit_delim delim;

  unit_form form;

  int is_notpadded;

  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;

typedef struct gfc_unit

{

  int unit_number;

  stream *s;

  /* Treap links.  */

  struct gfc_unit *left, *right;

  int priority;

  int read_bad, current_record, saved_pos, previous_nonadvancing_write;

  enum

  { NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }

  endfile;

  unit_mode mode;

  unit_flags flags;

  unit_pad pad_status;

  unit_decimal decimal_status;

  unit_delim delim_status;

  unit_round round_status;

  /* recl                 -- Record length of the file.

     last_record          -- Last record number read or written

     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;

  /* The format hash table.  */

  struct format_hash_entry format_hash_table[FORMAT_HASH_SIZE];

  /* Formatting buffer.  */

  struct fbuf *fbuf;

}

gfc_unit;

/* unit.c */

/* Maximum file offset, computed at library initialization time.  */

extern gfc_offset max_offset;

internal_proto(max_offset);

/* Unit tree root.  */

extern gfc_unit *unit_root;

internal_proto(unit_root);

extern __gthread_mutex_t unit_lock;

internal_proto(unit_lock);

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 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);

extern gfc_unit *get_unit (st_parameter_dt *, int);

internal_proto(get_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);

extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);

internal_proto (unit_truncate);

extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *);

internal_proto(get_unique_unit_number);

/* open.c */

extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);

internal_proto(new_unit);

/* transfer.c */

#define SCRATCH_SIZE 300

extern const char *type_name (bt);

internal_proto(type_name);

extern void * read_block_form (st_parameter_dt *, int *);

internal_proto(read_block_form);

extern void * read_block_form4 (st_parameter_dt *, int *);

internal_proto(read_block_form4);

extern void *write_block (st_parameter_dt *, int);

internal_proto(write_block);

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 *,

                                  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);

extern void hit_eof (st_parameter_dt *);

internal_proto(hit_eof);

/* read.c */

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 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);

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);

extern void read_l (st_parameter_dt *, const fnode *, char *, int);

internal_proto(read_l);

extern void read_x (st_parameter_dt *, int);

internal_proto(read_x);

extern void read_radix (st_parameter_dt *, const fnode *, char *, int, int);

internal_proto(read_radix);

extern void read_decimal (st_parameter_dt *, const fnode *, char *, int);

internal_proto(read_decimal);

/* list_read.c */

extern void list_formatted_read (st_parameter_dt *, bt, void *, int, size_t,

                                 size_t);

internal_proto(list_formatted_read);

extern void finish_list_read (st_parameter_dt *);

internal_proto(finish_list_read);

extern void namelist_read (st_parameter_dt *);

internal_proto(namelist_read);

extern void namelist_write (st_parameter_dt *);

internal_proto(namelist_write);

/* write.c */

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);

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);

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);

extern void write_i (st_parameter_dt *, const fnode *, const char *, int);

internal_proto(write_i);

extern void write_l (st_parameter_dt *, const fnode *, char *, int);

internal_proto(write_l);

extern void write_o (st_parameter_dt *, const fnode *, const char *, int);