io.h

gcc-fortran,linux使用fortran的编译软件。很好用的。

/* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
   Contributed by Andy Vaught

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

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

/* IO library include.  */

#include <setjmp.h>
#include "libgfortran.h"

#include <gthr.h>

#define DEFAULT_TEMPDIR "/tmp"

/* Basic types used in data transfers.  */

typedef enum
{ BT_NULL, BT_INTEGER, BT_LOGICAL, BT_CHARACTER, BT_REAL,
  BT_COMPLEX
}
bt;


typedef enum
{ SUCCESS = 1, FAILURE }
try;

struct st_parameter_dt;

typedef struct stream
{
  char *(*alloc_w_at) (struct stream *, int *, gfc_offset);
  char *(*alloc_r_at) (struct stream *, int *, gfc_offset);
  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;


/* Macros for doing file I/O given a stream.  */

#define sfree(s) ((s)->sfree)(s)
#define sclose(s) ((s)->close)(s)

#define salloc_r(s, len) ((s)->alloc_r_at)(s, len, -1)
#define salloc_w(s, len) ((s)->alloc_w_at)(s, len, -1)

#define salloc_r_at(s, len, where) ((s)->alloc_r_at)(s, len, where)
#define salloc_w_at(s, len, where) ((s)->alloc_w_at)(s, len, where)

#define 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 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 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.

   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, stored as GFC_DTYPE_xxxx.  */
  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_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
{ ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
unit_advance;

typedef enum
{READING, WRITING}
unit_mode;

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

#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_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;
	  int item_count; /* Item number in a formatted data transfer.  */
	  unit_mode mode;
	  unit_blank blank_status;
	  enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
	  int scale_factor;
	  int max_pos; /* Maximum righthand column written to.  */
	  /* Number of skips + spaces to be done for T and X-editing.  */
	  int skips;
	  /* Number of spaces to be done for T and X-editing.  */
	  int pending_spaces;
	  /* Whether an EOR condition was encountered. Value is:
	       0 if no EOR was encountered
	       1 if an EOR was encountered due to a 1-byte marker (LF)
	       2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
	  int sf_seen_eor;
	  unit_advance advance_status;

	  unsigned reversion_flag : 1; /* Format reversion has occurred.  */
	  unsigned first_item : 1;
	  unsigned seen_dollar : 1;
	  unsigned eor_condition : 1;
	  unsigned no_leading_blank : 1;
	  unsigned char_flag : 1;
	  unsigned input_complete : 1;
	  unsigned at_eol : 1;
	  unsigned comma_flag : 1;
	  /* A namelist specific flag used in the list directed library
	     to flag that calls are being made from namelist read (eg. to
	     ignore comments or to treat '/' as a terminator)  */
	  unsigned namelist_mode : 1;
	  /* A namelist specific flag used in the list directed library
	     to flag read errors and return, so that an attempt can be
	     made to read a new object name.  */
	  unsigned nml_read_error : 1;
	  /* 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;
	  /* 19 unused bits.  */

	  char last_char;
	  char nml_delim;

	  int repeat_count;
	  int saved_length;
	  int saved_used;
	  bt saved_type;
	  char *saved_string;
	  char *scratch;
	  char *line_buffer;
	  struct format_data *fmt;
	  jmp_buf *eof_jump;
	  namelist_info *ionml;

	  /* Storage area for values except for strings.  Must be large
	     enough to hold a complex value (two reals) of the largest
	     kind.  */
	  char value[32];
	} p;
      char pad[16 * sizeof (char *) + 34 * sizeof (int)];
    } u;
}
st_parameter_dt;

#undef CHARACTER1
#undef CHARACTER2

typedef struct
{
  unit_access access;
  unit_action action;
  unit_blank blank;
  unit_delim delim;
  unit_form form;
  int is_notpadded;