gcc/libgfortran/io/io.h
Janne Blomqvist 8750f9cdec re PR fortran/15750 (IOLENGTH form of INQUIRE statement not implemented)
PR fortran/15750
	* io.c (gfc_match_inquire): Bugfix for iolength related stuff.
	(gfc_resolve_inquire): Resolve the iolength tag.  Return
	SUCCESS at end of function if no failure has occured.
	* resolve.c (resolve_code): Resolve if iolength is encountered.
	* trans-io.c: (ioparm_iolength, iocall_iolength,
	iocall_iolength_done): New variables.
	(last_dt): Add IOLENGTH.
	(gfc_build_io_library_fndecls ): Set iolength related variables.
	(gfc_trans_iolength): Implement.
	(gfc_trans_dt_end): Treat iolength as a third form of data transfer.
libgfortran/
	PR fortran/15750
	* inquire.c (st_inquire): Add comment
	* io.h (st_parameter): Add iolength.
	(st_iolength, st_iolength_done): Declare.
	* transfer.c (iolength_transfer, iolength_transfer_init,
	st_iolength, st_iolength_done): New functions.
testsuite/
	* gfortran.fortran-torture/execute/iolength_1.f90: New test.
	* gfortran.fortran-torture/execute/iolength_3.f90: New test.

From-SVN: r83472
2004-06-22 00:43:55 +00:00

661 lines
15 KiB
C++

/* Copyright (C) 2002-2003 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, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
#ifndef GFOR_IO_H
#define GFOR_IO_H
/* IO library include. */
#include <setjmp.h>
#include "libgfortran.h"
#define DEFAULT_TEMPDIR "/var/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;
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 *);
}
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)
/* Namelist represent object */
/*
Namelist Records
&groupname object=value [,object=value].../
or
&groupname object=value [,object=value]...&groupname
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.
All these requirements need a new data structure to record all info
about the namelist.
*/
typedef struct namelist_type
{
char * var_name;
void * mem_pos;
int value_acquired;
int len;
bt type;
struct namelist_type * next;
}
namelist_info;
/* Options for the OPEN statement. */
typedef enum
{ ACCESS_SEQUENTIAL, ACCESS_DIRECT,
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;
/* 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 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;
int recl_in;
int *recl_out;
int *iolength;
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;
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_flags;
/* The default value of record length is defined here. This value can
be overriden by the OPEN statement or by an environment variable. */
#define DEFAULT_RECL 10000
typedef struct gfc_unit
{
int unit_number;
stream *s;
struct gfc_unit *left, *right; /* Treap links. */
int priority;
int read_bad, current_record;
enum
{ NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
endfile;
unit_flags flags;
gfc_offset 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. */
int file_len;
char file[1]; /* Filename is allocated at the end of the structure. */
}
gfc_unit;
/* 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. */
gfc_offset 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;
gfc_unit *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;
}
global_t;
#define g prefix(g)
extern global_t g;
#define current_unit prefix(current_unit)
extern gfc_unit *current_unit;
/* Format tokens. Only about half of these can be stored in the
format nodes. */
typedef enum
{
FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
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
}
format_token;
/* Format nodes. A format string is converted into a tree of these
structures, which is traversed as part of a data transfer statement. */
typedef struct fnode
{
format_token format;
int repeat;
struct fnode *next;
char *source;
union
{
struct
{
int w, d, e;
}
real;
struct
{
int length;
char *p;
}
string;
struct
{
int w, m;
}
integer;
int w;
int k;
int r;
int n;
struct fnode *child;
}
u;
/* Members for traversing the tree during data transfer. */
int count;
struct fnode *current;
}
fnode;
/* unix.c */
#define sys_exit prefix(sys_exit)
void sys_exit (int) __attribute__ ((noreturn));
#define move_pos_offset prefix(move_pos_offset)
int move_pos_offset (stream *, int);
#define get_oserror prefix(get_oserror)
const char *get_oserror (void);
#define compare_files prefix(compare_files)
int compare_files (stream *, stream *);
#define init_error_stream prefix(init_error_stream)
stream *init_error_stream (void);
#define open_external prefix(open_external)
stream *open_external (unit_action, unit_status);
#define open_internal prefix(open_internal)
stream *open_internal (char *, int);
#define input_stream prefix(input_stream)
stream *input_stream (void);
#define output_stream prefix(output_stream)
stream *output_stream (void);
#define compare_file_filename prefix(compare_file_filename)
int compare_file_filename (stream *, const char *, int);
#define find_file prefix(find_file)
gfc_unit *find_file (void);
#define stream_at_bof prefix(stream_at_bof)
int stream_at_bof (stream *);
#define stream_at_eof prefix(stream_at_eof)
int stream_at_eof (stream *);
#define delete_file prefix(delete_file)
int delete_file (gfc_unit *);
#define file_exists prefix(file_exists)
int file_exists (void);
#define inquire_sequential prefix(inquire_sequential)
const char *inquire_sequential (const char *, int);
#define inquire_direct prefix(inquire_direct)
const char *inquire_direct (const char *, int);
#define inquire_formatted prefix(inquire_formatted)
const char *inquire_formatted (const char *, int);
#define inquire_unformatted prefix(inquire_unformatted)
const char *inquire_unformatted (const char *, int);
#define inquire_read prefix(inquire_read)
const char *inquire_read (const char *, int);
#define inquire_write prefix(inquire_write)
const char *inquire_write (const char *, int);
#define inquire_readwrite prefix(inquire_readwrite)
const char *inquire_readwrite (const char *, int);
#define file_length prefix(file_length)
gfc_offset file_length (stream *);
#define file_position prefix(file_position)
gfc_offset file_position (stream *);
#define is_seekable prefix(is_seekable)
int is_seekable (stream *);
#define empty_internal_buffer prefix(empty_internal_buffer)
void empty_internal_buffer(stream *);
#define flush prefix(flush)
try flush (stream *);
/* unit.c */
#define insert_unit prefix(insert_unix)
void insert_unit (gfc_unit *);
#define close_unit prefix(close_unit)
int close_unit (gfc_unit *);
#define is_internal_unit prefix(is_internal_unit)
int is_internal_unit (void);
#define find_unit prefix(find_unit)
gfc_unit *find_unit (int);
#define get_unit prefix(get_unit)
gfc_unit *get_unit (int);
/* open.c */
#define test_endfile prefix(test_endfile)
void test_endfile (gfc_unit *);
#define new_unit prefix(new_unit)
void new_unit (unit_flags *);
/* format.c */
#define parse_format prefix(parse_format)
void parse_format (void);
#define next_format prefix(next_format)
fnode *next_format (void);
#define unget_format prefix(unget_format)
void unget_format (fnode *);
#define format_error prefix(format_error)
void format_error (fnode *, const char *);
#define free_fnodes prefix(free_fnodes)
void free_fnodes (void);
/* transfer.c */
#define SCRATCH_SIZE 300
#define scratch prefix(scratch)
extern char scratch[];
#define type_name prefix(type_name)
const char *type_name (bt);
#define read_block prefix(read_block)
void *read_block (int *);
#define write_block prefix(write_block)
void *write_block (int);
#define transfer_integer prefix(transfer_integer)
void transfer_integer (void *, int);
#define transfer_real prefix(transfer_real)
void transfer_real (void *, int);
#define transfer_logical prefix(transfer_logical)
void transfer_logical (void *, int);
#define transfer_character prefix(transfer_character)
void transfer_character (void *, int);
#define transfer_complex prefix(transfer_complex)
void transfer_complex (void *, int);
#define next_record prefix(next_record)
void next_record (int);
#define st_set_nml_var_int prefix(st_set_nml_var_int)
void st_set_nml_var_int (void * , char * , int , int );
#define st_set_nml_var_float prefix(st_set_nml_var_float)
void st_set_nml_var_float (void * , char * , int , int );
#define st_set_nml_var_char prefix(st_set_nml_var_char)
void st_set_nml_var_char (void * , char * , int , int );
#define st_set_nml_var_complex prefix(st_set_nml_var_complex)
void st_set_nml_var_complex (void * , char * , int , int );
#define st_set_nml_var_log prefix(st_set_nml_var_log)
void st_set_nml_var_log (void * , char * , int , int );
/* read.c */
#define set_integer prefix(set_integer)
void set_integer (void *, int64_t, int);
#define max_value prefix(max_value)
uint64_t max_value (int, int);
#define convert_real prefix(convert_real)
int convert_real (void *, const char *, int);
#define read_a prefix(read_a)
void read_a (fnode *, char *, int);
#define read_f prefix(read_f)
void read_f (fnode *, char *, int);
#define read_l prefix(read_l)
void read_l (fnode *, char *, int);
#define read_x prefix(read_x)
void read_x (fnode *);
#define read_radix prefix(read_radix)
void read_radix (fnode *, char *, int, int);
#define read_decimal prefix(read_decimal)
void read_decimal (fnode *, char *, int);
/* 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);
#define init_at_eol prefix(init_at_eol)
void init_at_eol();
#define namelist_read prefix(namelist_read)
void namelist_read();
#define namelist_write prefix(namelist_write)
void namelist_write();
/* write.c */
#define write_a prefix(write_a)
void write_a (fnode *, const char *, int);
#define write_b prefix(write_b)
void write_b (fnode *, const char *, int);
#define write_d prefix(write_d)
void write_d (fnode *, const char *, int);
#define write_e prefix(write_e)
void write_e (fnode *, const char *, int);
#define write_en prefix(write_en)
void write_en (fnode *, const char *, int);
#define write_es prefix(write_es)
void write_es (fnode *, const char *, int);
#define write_f prefix(write_f)
void write_f (fnode *, const char *, int);
#define write_i prefix(write_i)
void write_i (fnode *, const char *, int);
#define write_l prefix(write_l)
void write_l (fnode *, char *, int);
#define write_o prefix(write_o)
void write_o (fnode *, const char *, int);
#define write_x prefix(write_x)
void write_x (fnode *);
#define write_z prefix(write_z)
void write_z (fnode *, const char *, int);
#define list_formatted_write prefix(list_formatted_write)
void list_formatted_write (bt, void *, int);
#define st_open prefix(st_open)
#define st_close prefix(st_close)
#define st_inquire prefix(st_inquire)
#define st_iolength prefix(st_iolength)
#define st_iolength_done prefix(st_iolength_done)
#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)
void __MAIN (void);
#endif