Commit 6f0f0b2e by Jerry DeLisle

PR fortran/25829 28655

2008-04-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
	    Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/25829 28655
	* dump-parse-tree.c (gfc_show_code_node): Show new I/O parameters.
	* gfortran.h (gfc_statement): Add ST_WAIT enumerator.
	(gfc_open): Add pointers for decimal, encoding, round, sign,
	asynchronous. (gfc_inquire): Add pointers for asynchronous, decimal,
	encoding, pending, round, sign, size, id.
	(gfc_wait): New typedef struct. (gfc_dt): Add pointers for id, pos,
	asynchronous, blank, decimal, delim, pad, round, sign.
	(gfc_exec_op): Add EXEC_WAIT enumerator. (gfc_code): Add pointer for
	wait. (gfc_free_wait), (gfc_resolve_wait): New function prototypes.
	* trans-stmt.h (gfc_trans_wait): New function prototype.
	* trans.c (gfc_trans_code): Add case for EXEC_WAIT.
	* io.c (io_tag): Add new tags for DECIMAL, ENCODING, ROUND, SIGN,
	ASYCHRONOUS, ID. (match_open_element): Add matchers for new tags.
	(gfc_free_open): Free new pointers. (gfc_resolve_open): Resolve new
	tags. (gfc_resolve_open): Remove comment around check for allowed
	values and ASYNCHRONOUS, update it.  Likewise for DECIMAL, ENCODING,
	ROUND, and SIGN. (match_dt_element): Add matching for new tags.
	(gfc_free_wait): New function. (gfc_resolve_wait): New function.
	(match_wait_element): New function. (gfc_match_wait): New function.
	* resolve.c (gfc_resolve_blocks): Add case for EXEC_WAIT.
	(resolve_code): Add case for EXEC_WAIT. 
	* st.c (gfc_free_statement): Add case for EXEC_WAIT.
	* trans-io.c (ioparam_type): Add IOPARM_ptype_wait. (gfc_st_parameter):
	Add "wait" entry. (iocall): Add IOCALL_WAIT enumerator.
	(gfc_build_io_library_fndecls): Add function declaration for st_wait.
	(gfc_trans_open): Add mask bits for new I/O tags.
	(gfc_trans_inquire): Add mask bits for new I/O tags.
	(gfc_trans_wait): New translation function.
	(build_dt): Add mask bits for new I/O tags.
	* match.c (gfc_match_if) Add matcher for "wait".
	* match.h (gfc_match_wait): Prototype for new function.
	* ioparm.def: Add new I/O parameter definitions.
	* parse.c (decode_statement): Add match for "wait" statement.
	(next_statement): Add case for ST_WAIT. (gfc_ascii_statement): Same.

Co-Authored-By: Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>

From-SVN: r133944
parent 10256cbe
2008-04-05 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/25829 28655
* dump-parse-tree.c (gfc_show_code_node): Show new I/O parameters.
* gfortran.h (gfc_statement): Add ST_WAIT enumerator.
(gfc_open): Add pointers for decimal, encoding, round, sign,
asynchronous. (gfc_inquire): Add pointers for asynchronous, decimal,
encoding, pending, round, sign, size, id.
(gfc_wait): New typedef struct. (gfc_dt): Add pointers for id, pos,
asynchronous, blank, decimal, delim, pad, round, sign.
(gfc_exec_op): Add EXEC_WAIT enumerator. (gfc_code): Add pointer for
wait. (gfc_free_wait), (gfc_resolve_wait): New function prototypes.
* trans-stmt.h (gfc_trans_wait): New function prototype.
* trans.c (gfc_trans_code): Add case for EXEC_WAIT.
* io.c (io_tag): Add new tags for DECIMAL, ENCODING, ROUND, SIGN,
ASYCHRONOUS, ID. (match_open_element): Add matchers for new tags.
(gfc_free_open): Free new pointers. (gfc_resolve_open): Resolve new
tags. (gfc_resolve_open): Remove comment around check for allowed
values and ASYNCHRONOUS, update it. Likewise for DECIMAL, ENCODING,
ROUND, and SIGN. (match_dt_element): Add matching for new tags.
(gfc_free_wait): New function. (gfc_resolve_wait): New function.
(match_wait_element): New function. (gfc_match_wait): New function.
* resolve.c (gfc_resolve_blocks): Add case for EXEC_WAIT.
(resolve_code): Add case for EXEC_WAIT.
* st.c (gfc_free_statement): Add case for EXEC_WAIT.
* trans-io.c (ioparam_type): Add IOPARM_ptype_wait. (gfc_st_parameter):
Add "wait" entry. (iocall): Add IOCALL_WAIT enumerator.
(gfc_build_io_library_fndecls): Add function declaration for st_wait.
(gfc_trans_open): Add mask bits for new I/O tags.
(gfc_trans_inquire): Add mask bits for new I/O tags.
(gfc_trans_wait): New translation function.
(build_dt): Add mask bits for new I/O tags.
* match.c (gfc_match_if) Add matcher for "wait".
* match.h (gfc_match_wait): Prototype for new function.
* ioparm.def: Add new I/O parameter definitions.
* parse.c (decode_statement): Add match for "wait" statement.
(next_statement): Add case for ST_WAIT. (gfc_ascii_statement): Same.
2008-04-03 Jakub Jelinek <jakub@redhat.com> 2008-04-03 Jakub Jelinek <jakub@redhat.com>
PR fortran/35786 PR fortran/35786
......
...@@ -1405,11 +1405,36 @@ gfc_show_code_node (int level, gfc_code *c) ...@@ -1405,11 +1405,36 @@ gfc_show_code_node (int level, gfc_code *c)
gfc_status (" PAD="); gfc_status (" PAD=");
gfc_show_expr (open->pad); gfc_show_expr (open->pad);
} }
if (open->decimal)
{
gfc_status (" DECIMAL=");
gfc_show_expr (open->decimal);
}
if (open->encoding)
{
gfc_status (" ENCODING=");
gfc_show_expr (open->encoding);
}
if (open->round)
{
gfc_status (" ROUND=");
gfc_show_expr (open->round);
}
if (open->sign)
{
gfc_status (" SIGN=");
gfc_show_expr (open->sign);
}
if (open->convert) if (open->convert)
{ {
gfc_status (" CONVERT="); gfc_status (" CONVERT=");
gfc_show_expr (open->convert); gfc_show_expr (open->convert);
} }
if (open->asynchronous)
{
gfc_status (" ASYNCHRONOUS=");
gfc_show_expr (open->asynchronous);
}
if (open->err != NULL) if (open->err != NULL)
gfc_status (" ERR=%d", open->err->value); gfc_status (" ERR=%d", open->err->value);
...@@ -1616,6 +1641,46 @@ gfc_show_code_node (int level, gfc_code *c) ...@@ -1616,6 +1641,46 @@ gfc_show_code_node (int level, gfc_code *c)
gfc_status (" CONVERT="); gfc_status (" CONVERT=");
gfc_show_expr (i->convert); gfc_show_expr (i->convert);
} }
if (i->asynchronous)
{
gfc_status (" ASYNCHRONOUS=");
gfc_show_expr (i->asynchronous);
}
if (i->decimal)
{
gfc_status (" DECIMAL=");
gfc_show_expr (i->decimal);
}
if (i->encoding)
{
gfc_status (" ENCODING=");
gfc_show_expr (i->encoding);
}
if (i->pending)
{
gfc_status (" PENDING=");
gfc_show_expr (i->pending);
}
if (i->round)
{
gfc_status (" ROUND=");
gfc_show_expr (i->round);
}
if (i->sign)
{
gfc_status (" SIGN=");
gfc_show_expr (i->sign);
}
if (i->size)
{
gfc_status (" SIZE=");
gfc_show_expr (i->size);
}
if (i->id)
{
gfc_status (" ID=");
gfc_show_expr (i->id);
}
if (i->err != NULL) if (i->err != NULL)
gfc_status (" ERR=%d", i->err->value); gfc_status (" ERR=%d", i->err->value);
...@@ -1678,6 +1743,51 @@ gfc_show_code_node (int level, gfc_code *c) ...@@ -1678,6 +1743,51 @@ gfc_show_code_node (int level, gfc_code *c)
gfc_status (" ADVANCE="); gfc_status (" ADVANCE=");
gfc_show_expr (dt->advance); gfc_show_expr (dt->advance);
} }
if (dt->id)
{
gfc_status (" ID=");
gfc_show_expr (dt->id);
}
if (dt->pos)
{
gfc_status (" POS=");
gfc_show_expr (dt->pos);
}
if (dt->asynchronous)
{
gfc_status (" ASYNCHRONOUS=");
gfc_show_expr (dt->asynchronous);
}
if (dt->blank)
{
gfc_status (" BLANK=");
gfc_show_expr (dt->blank);
}
if (dt->decimal)
{
gfc_status (" DECIMAL=");
gfc_show_expr (dt->decimal);
}
if (dt->delim)
{
gfc_status (" DELIM=");
gfc_show_expr (dt->delim);
}
if (dt->pad)
{
gfc_status (" PAD=");
gfc_show_expr (dt->pad);
}
if (dt->round)
{
gfc_status (" ROUND=");
gfc_show_expr (dt->round);
}
if (dt->sign)
{
gfc_status (" SIGN=");
gfc_show_expr (dt->sign);
}
show_dt_code: show_dt_code:
gfc_status_char ('\n'); gfc_status_char ('\n');
......
...@@ -211,8 +211,8 @@ typedef enum ...@@ -211,8 +211,8 @@ typedef enum
ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT, ST_INQUIRE, ST_INTERFACE, ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT, ST_INQUIRE, ST_INTERFACE,
ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN, ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN,
ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND, ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND,
ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WRITE, ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WAIT,
ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE, ST_WRITE, ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT, ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
ST_ENUM, ST_ENUMERATOR, ST_END_ENUM, ST_ENUM, ST_ENUMERATOR, ST_END_ENUM,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL, ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL,
...@@ -1635,7 +1635,8 @@ gfc_alloc; ...@@ -1635,7 +1635,8 @@ gfc_alloc;
typedef struct typedef struct
{ {
gfc_expr *unit, *file, *status, *access, *form, *recl, gfc_expr *unit, *file, *status, *access, *form, *recl,
*blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert; *blank, *position, *action, *delim, *pad, *iostat, *iomsg, *convert,
*decimal, *encoding, *round, *sign, *asynchronous, *id;
gfc_st_label *err; gfc_st_label *err;
} }
gfc_open; gfc_open;
...@@ -1662,7 +1663,8 @@ typedef struct ...@@ -1662,7 +1663,8 @@ typedef struct
gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named, gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
*name, *access, *sequential, *direct, *form, *formatted, *name, *access, *sequential, *direct, *form, *formatted,
*unformatted, *recl, *nextrec, *blank, *position, *action, *read, *unformatted, *recl, *nextrec, *blank, *position, *action, *read,
*write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos; *write, *readwrite, *delim, *pad, *iolength, *iomsg, *convert, *strm_pos,
*asynchronous, *decimal, *encoding, *pending, *round, *sign, *size, *id;
gfc_st_label *err; gfc_st_label *err;
...@@ -1672,7 +1674,17 @@ gfc_inquire; ...@@ -1672,7 +1674,17 @@ gfc_inquire;
typedef struct typedef struct
{ {
gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg; gfc_expr *unit, *iostat, *iomsg, *id;
gfc_st_label *err, *end, *eor;
}
gfc_wait;
typedef struct
{
gfc_expr *io_unit, *format_expr, *rec, *advance, *iostat, *size, *iomsg,
*id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
*sign;
gfc_symbol *namelist; gfc_symbol *namelist;
/* A format_label of `format_asterisk' indicates the "*" format */ /* A format_label of `format_asterisk' indicates the "*" format */
...@@ -1701,7 +1713,7 @@ typedef enum ...@@ -1701,7 +1713,7 @@ typedef enum
EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT,
EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_ALLOCATE, EXEC_DEALLOCATE,
EXEC_OPEN, EXEC_CLOSE, EXEC_OPEN, EXEC_CLOSE, EXEC_WAIT,
EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END, EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH, EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER, EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
...@@ -1738,6 +1750,7 @@ typedef struct gfc_code ...@@ -1738,6 +1750,7 @@ typedef struct gfc_code
gfc_close *close; gfc_close *close;
gfc_filepos *filepos; gfc_filepos *filepos;
gfc_inquire *inquire; gfc_inquire *inquire;
gfc_wait *wait;
gfc_dt *dt; gfc_dt *dt;
gfc_forall_iterator *forall_iterator; gfc_forall_iterator *forall_iterator;
struct gfc_code *whichloop; struct gfc_code *whichloop;
...@@ -2323,6 +2336,8 @@ void gfc_free_inquire (gfc_inquire *); ...@@ -2323,6 +2336,8 @@ void gfc_free_inquire (gfc_inquire *);
try gfc_resolve_inquire (gfc_inquire *); try gfc_resolve_inquire (gfc_inquire *);
void gfc_free_dt (gfc_dt *); void gfc_free_dt (gfc_dt *);
try gfc_resolve_dt (gfc_dt *); try gfc_resolve_dt (gfc_dt *);
void gfc_free_wait (gfc_wait *);
try gfc_resolve_wait (gfc_wait *);
/* module.c */ /* module.c */
void gfc_module_init_2 (void); void gfc_module_init_2 (void);
......
...@@ -8,10 +8,10 @@ ...@@ -8,10 +8,10 @@
#define IOPARM_common_end (1 << 3) #define IOPARM_common_end (1 << 3)
#define IOPARM_common_eor (1 << 4) #define IOPARM_common_eor (1 << 4)
#endif #endif
IOPARM (common, flags, 0, int4) IOPARM (common, flags, 0, int4)
IOPARM (common, unit, 0, int4) IOPARM (common, unit, 0, int4)
IOPARM (common, filename, 0, pchar) IOPARM (common, filename, 0, pchar)
IOPARM (common, line, 0, int4) IOPARM (common, line, 0, int4)
IOPARM (common, iomsg, 1 << 6, char2) IOPARM (common, iomsg, 1 << 6, char2)
IOPARM (common, iostat, 1 << 5, pint4) IOPARM (common, iostat, 1 << 5, pint4)
IOPARM (open, common, 0, common) IOPARM (open, common, 0, common)
...@@ -25,7 +25,12 @@ IOPARM (open, position, 1 << 13, char1) ...@@ -25,7 +25,12 @@ IOPARM (open, position, 1 << 13, char1)
IOPARM (open, action, 1 << 14, char2) IOPARM (open, action, 1 << 14, char2)
IOPARM (open, delim, 1 << 15, char1) IOPARM (open, delim, 1 << 15, char1)
IOPARM (open, pad, 1 << 16, char2) IOPARM (open, pad, 1 << 16, char2)
IOPARM (open, convert, 1 << 17, char1) IOPARM (open, convert, 1 << 17, char1)
IOPARM (open, decimal, 1 << 18, char2)
IOPARM (open, encoding, 1 << 19, char1)
IOPARM (open, round, 1 << 20, char2)
IOPARM (open, sign, 1 << 21, char1)
IOPARM (open, asynchronous, 1 << 22, char2)
IOPARM (close, common, 0, common) IOPARM (close, common, 0, common)
IOPARM (close, status, 1 << 7, char1) IOPARM (close, status, 1 << 7, char1)
IOPARM (filepos, common, 0, common) IOPARM (filepos, common, 0, common)
...@@ -53,7 +58,18 @@ IOPARM (inquire, unformatted, 1 << 26, char1) ...@@ -53,7 +58,18 @@ IOPARM (inquire, unformatted, 1 << 26, char1)
IOPARM (inquire, read, 1 << 27, char2) IOPARM (inquire, read, 1 << 27, char2)
IOPARM (inquire, write, 1 << 28, char1) IOPARM (inquire, write, 1 << 28, char1)
IOPARM (inquire, readwrite, 1 << 29, char2) IOPARM (inquire, readwrite, 1 << 29, char2)
IOPARM (inquire, convert, 1 << 30, char1) IOPARM (inquire, convert, 1 << 30, char1)
IOPARM (inquire, flags2, 1 << 31, int4)
IOPARM (inquire, asynchronous, 1 << 0, char1)
IOPARM (inquire, decimal, 1 << 1, char2)
IOPARM (inquire, encoding, 1 << 2, char1)
IOPARM (inquire, round, 1 << 3, char2)
IOPARM (inquire, sign, 1 << 4, char1)
IOPARM (inquire, pending, 1 << 5, pint4)
IOPARM (inquire, size, 1 << 6, pint4)
IOPARM (inquire, id, 1 << 7, pint4)
IOPARM (wait, common, 0, common)
IOPARM (wait, id, 1 << 7, pint4)
#ifndef IOPARM_dt_list_format #ifndef IOPARM_dt_list_format
#define IOPARM_dt_list_format (1 << 7) #define IOPARM_dt_list_format (1 << 7)
#define IOPARM_dt_namelist_read_mode (1 << 8) #define IOPARM_dt_namelist_read_mode (1 << 8)
...@@ -67,4 +83,13 @@ IOPARM (dt, format, 1 << 12, char1) ...@@ -67,4 +83,13 @@ IOPARM (dt, format, 1 << 12, char1)
IOPARM (dt, advance, 1 << 13, char2) IOPARM (dt, advance, 1 << 13, char2)
IOPARM (dt, internal_unit, 1 << 14, char1) IOPARM (dt, internal_unit, 1 << 14, char1)
IOPARM (dt, namelist_name, 1 << 15, char2) IOPARM (dt, namelist_name, 1 << 15, char2)
IOPARM (dt, u, 0, pad) IOPARM (dt, id, 1 << 16, pint4)
IOPARM (dt, pos, 1 << 17, intio)
IOPARM (dt, asynchronous, 1 << 18, char1)
IOPARM (dt, blank, 1 << 19, char2)
IOPARM (dt, decimal, 1 << 20, char1)
IOPARM (dt, delim, 1 << 21, char2)
IOPARM (dt, pad, 1 << 22, char1)
IOPARM (dt, round, 1 << 23, char2)
IOPARM (dt, sign, 1 << 24, char1)
IOPARM (dt, u, 0, pad)
...@@ -1533,6 +1533,7 @@ gfc_match_if (gfc_statement *if_type) ...@@ -1533,6 +1533,7 @@ gfc_match_if (gfc_statement *if_type)
match ("return", gfc_match_return, ST_RETURN) match ("return", gfc_match_return, ST_RETURN)
match ("rewind", gfc_match_rewind, ST_REWIND) match ("rewind", gfc_match_rewind, ST_REWIND)
match ("stop", gfc_match_stop, ST_STOP) match ("stop", gfc_match_stop, ST_STOP)
match ("wait", gfc_match_wait, ST_WAIT)
match ("where", match_simple_where, ST_WHERE) match ("where", match_simple_where, ST_WHERE)
match ("write", gfc_match_write, ST_WRITE) match ("write", gfc_match_write, ST_WRITE)
......
...@@ -212,6 +212,7 @@ match gfc_match_rewind (void); ...@@ -212,6 +212,7 @@ match gfc_match_rewind (void);
match gfc_match_flush (void); match gfc_match_flush (void);
match gfc_match_inquire (void); match gfc_match_inquire (void);
match gfc_match_read (void); match gfc_match_read (void);
match gfc_match_wait (void);
match gfc_match_write (void); match gfc_match_write (void);
match gfc_match_print (void); match gfc_match_print (void);
......
...@@ -440,6 +440,7 @@ decode_statement (void) ...@@ -440,6 +440,7 @@ decode_statement (void)
break; break;
case 'w': case 'w':
match ("wait", gfc_match_wait, ST_WAIT);
match ("write", gfc_match_write, ST_WRITE); match ("write", gfc_match_write, ST_WRITE);
break; break;
} }
...@@ -861,9 +862,9 @@ next_statement (void) ...@@ -861,9 +862,9 @@ next_statement (void)
case ST_CLOSE: case ST_CONTINUE: case ST_DEALLOCATE: case ST_END_FILE: \ case ST_CLOSE: case ST_CONTINUE: case ST_DEALLOCATE: case ST_END_FILE: \
case ST_GOTO: case ST_INQUIRE: case ST_NULLIFY: case ST_OPEN: \ case ST_GOTO: case ST_INQUIRE: case ST_NULLIFY: case ST_OPEN: \
case ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: \ case ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: \
case ST_PAUSE: case ST_STOP: case ST_WRITE: case ST_ASSIGNMENT: \ case ST_PAUSE: case ST_STOP: case ST_WAIT: case ST_WRITE: \
case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \ case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \
case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \ case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \ case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
case ST_OMP_BARRIER case ST_OMP_BARRIER
...@@ -1268,6 +1269,9 @@ gfc_ascii_statement (gfc_statement st) ...@@ -1268,6 +1269,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_WHERE: case ST_WHERE:
p = "WHERE"; p = "WHERE";
break; break;
case ST_WAIT:
p = "WAIT";
break;
case ST_WRITE: case ST_WRITE:
p = "WRITE"; p = "WRITE";
break; break;
......
...@@ -5964,6 +5964,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) ...@@ -5964,6 +5964,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_READ: case EXEC_READ:
case EXEC_WRITE: case EXEC_WRITE:
case EXEC_IOLENGTH: case EXEC_IOLENGTH:
case EXEC_WAIT:
break; break;
case EXEC_OMP_ATOMIC: case EXEC_OMP_ATOMIC:
...@@ -6373,6 +6374,15 @@ resolve_code (gfc_code *code, gfc_namespace *ns) ...@@ -6373,6 +6374,15 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
resolve_branch (code->ext.inquire->err, code); resolve_branch (code->ext.inquire->err, code);
break; break;
case EXEC_WAIT:
if (gfc_resolve_wait (code->ext.wait) == FAILURE)
break;
resolve_branch (code->ext.wait->err, code);
resolve_branch (code->ext.wait->end, code);
resolve_branch (code->ext.wait->eor, code);
break;
case EXEC_READ: case EXEC_READ:
case EXEC_WRITE: case EXEC_WRITE:
if (gfc_resolve_dt (code->ext.dt) == FAILURE) if (gfc_resolve_dt (code->ext.dt) == FAILURE)
......
...@@ -146,6 +146,10 @@ gfc_free_statement (gfc_code *p) ...@@ -146,6 +146,10 @@ gfc_free_statement (gfc_code *p)
gfc_free_inquire (p->ext.inquire); gfc_free_inquire (p->ext.inquire);
break; break;
case EXEC_WAIT:
gfc_free_wait (p->ext.wait);
break;
case EXEC_READ: case EXEC_READ:
case EXEC_WRITE: case EXEC_WRITE:
gfc_free_dt (p->ext.dt); gfc_free_dt (p->ext.dt);
......
...@@ -45,6 +45,7 @@ enum ioparam_type ...@@ -45,6 +45,7 @@ enum ioparam_type
IOPARM_ptype_filepos, IOPARM_ptype_filepos,
IOPARM_ptype_inquire, IOPARM_ptype_inquire,
IOPARM_ptype_dt, IOPARM_ptype_dt,
IOPARM_ptype_wait,
IOPARM_ptype_num IOPARM_ptype_num
}; };
...@@ -96,7 +97,8 @@ static GTY(()) gfc_st_parameter st_parameter[] = ...@@ -96,7 +97,8 @@ static GTY(()) gfc_st_parameter st_parameter[] =
{ "close", NULL }, { "close", NULL },
{ "filepos", NULL }, { "filepos", NULL },
{ "inquire", NULL }, { "inquire", NULL },
{ "dt", NULL } { "dt", NULL },
{ "wait", NULL }
}; };
static GTY(()) gfc_st_parameter_field st_parameter_field[] = static GTY(()) gfc_st_parameter_field st_parameter_field[] =
...@@ -133,6 +135,7 @@ enum iocall ...@@ -133,6 +135,7 @@ enum iocall
IOCALL_FLUSH, IOCALL_FLUSH,
IOCALL_SET_NML_VAL, IOCALL_SET_NML_VAL,
IOCALL_SET_NML_VAL_DIM, IOCALL_SET_NML_VAL_DIM,
IOCALL_WAIT,
IOCALL_NUM IOCALL_NUM
}; };
...@@ -372,6 +375,11 @@ gfc_build_io_library_fndecls (void) ...@@ -372,6 +375,11 @@ gfc_build_io_library_fndecls (void)
gfc_build_library_function_decl(get_identifier (PREFIX("st_iolength")), gfc_build_library_function_decl(get_identifier (PREFIX("st_iolength")),
void_type_node, 1, dt_parm_type); void_type_node, 1, dt_parm_type);
parm_type = build_pointer_type (st_parameter[IOPARM_ptype_wait].type);
iocall[IOCALL_WAIT] =
gfc_build_library_function_decl (get_identifier (PREFIX("st_wait")),
gfc_int4_type_node, 1, parm_type);
parm_type = build_pointer_type (st_parameter[IOPARM_ptype_filepos].type); parm_type = build_pointer_type (st_parameter[IOPARM_ptype_filepos].type);
iocall[IOCALL_REWIND] = iocall[IOCALL_REWIND] =
gfc_build_library_function_decl (get_identifier (PREFIX("st_rewind")), gfc_build_library_function_decl (get_identifier (PREFIX("st_rewind")),
...@@ -921,6 +929,24 @@ gfc_trans_open (gfc_code * code) ...@@ -921,6 +929,24 @@ gfc_trans_open (gfc_code * code)
if (p->pad) if (p->pad)
mask |= set_string (&block, &post_block, var, IOPARM_open_pad, p->pad); mask |= set_string (&block, &post_block, var, IOPARM_open_pad, p->pad);
if (p->decimal)
mask |= set_string (&block, &post_block, var, IOPARM_open_decimal,
p->decimal);
if (p->encoding)
mask |= set_string (&block, &post_block, var, IOPARM_open_encoding,
p->encoding);
if (p->round)
mask |= set_string (&block, &post_block, var, IOPARM_open_round, p->round);
if (p->sign)
mask |= set_string (&block, &post_block, var, IOPARM_open_sign, p->sign);
if (p->asynchronous)
mask |= set_string (&block, &post_block, var, IOPARM_open_asynchronous,
p->asynchronous);
if (p->convert) if (p->convert)
mask |= set_string (&block, &post_block, var, IOPARM_open_convert, mask |= set_string (&block, &post_block, var, IOPARM_open_convert,
p->convert); p->convert);
...@@ -1117,7 +1143,7 @@ gfc_trans_inquire (gfc_code * code) ...@@ -1117,7 +1143,7 @@ gfc_trans_inquire (gfc_code * code)
stmtblock_t block, post_block; stmtblock_t block, post_block;
gfc_inquire *p; gfc_inquire *p;
tree tmp, var; tree tmp, var;
unsigned int mask = 0; unsigned int mask = 0, mask2 = 0;
gfc_start_block (&block); gfc_start_block (&block);
gfc_init_block (&post_block); gfc_init_block (&post_block);
...@@ -1248,6 +1274,43 @@ gfc_trans_inquire (gfc_code * code) ...@@ -1248,6 +1274,43 @@ gfc_trans_inquire (gfc_code * code)
mask |= set_parameter_ref (&block, &post_block, var, mask |= set_parameter_ref (&block, &post_block, var,
IOPARM_inquire_strm_pos_out, p->strm_pos); IOPARM_inquire_strm_pos_out, p->strm_pos);
/* The second series of flags. */
if (p->asynchronous)
mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_asynchronous,
p->asynchronous);
if (p->decimal)
mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_decimal,
p->decimal);
if (p->encoding)
mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_encoding,
p->encoding);
if (p->round)
mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_round,
p->round);
if (p->sign)
mask2 |= set_string (&block, &post_block, var, IOPARM_inquire_sign,
p->sign);
if (p->pending)
mask2 |= set_parameter_ref (&block, &post_block, var,
IOPARM_inquire_pending, p->pending);
if (p->size)
mask2 |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_size,
p->size);
if (p->id)
mask2 |= set_parameter_value (&block, var, IOPARM_inquire_id, p->id);
set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2);
if (mask2)
mask |= IOPARM_inquire_flags2;
set_parameter_const (&block, var, IOPARM_common_flags, mask); set_parameter_const (&block, var, IOPARM_common_flags, mask);
if (p->unit) if (p->unit)
...@@ -1266,6 +1329,56 @@ gfc_trans_inquire (gfc_code * code) ...@@ -1266,6 +1329,56 @@ gfc_trans_inquire (gfc_code * code)
return gfc_finish_block (&block); return gfc_finish_block (&block);
} }
tree
gfc_trans_wait (gfc_code * code)
{
stmtblock_t block, post_block;
gfc_wait *p;
tree tmp, var;
unsigned int mask = 0;
gfc_start_block (&block);
gfc_init_block (&post_block);
var = gfc_create_var (st_parameter[IOPARM_ptype_wait].type,
"wait_parm");
set_error_locus (&block, var, &code->loc);
p = code->ext.wait;
/* Set parameters here. */
if (p->iomsg)
mask |= set_string (&block, &post_block, var, IOPARM_common_iomsg,
p->iomsg);
if (p->iostat)
mask |= set_parameter_ref (&block, &post_block, var, IOPARM_common_iostat,
p->iostat);
if (p->err)
mask |= IOPARM_common_err;
if (p->id)
mask |= set_parameter_value (&block, var, IOPARM_wait_id, p->id);
set_parameter_const (&block, var, IOPARM_common_flags, mask);
if (p->unit)
set_parameter_value (&block, var, IOPARM_common_unit, p->unit);
tmp = build_fold_addr_expr (var);
tmp = build_call_expr (iocall[IOCALL_WAIT], 1, tmp);
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &post_block);
io_result (&block, var, p->err, NULL, NULL);
return gfc_finish_block (&block);
}
static gfc_expr * static gfc_expr *
gfc_new_nml_name_expr (const char * name) gfc_new_nml_name_expr (const char * name)
{ {
...@@ -1583,6 +1696,41 @@ build_dt (tree function, gfc_code * code) ...@@ -1583,6 +1696,41 @@ build_dt (tree function, gfc_code * code)
if (dt->end) if (dt->end)
mask |= IOPARM_common_end; mask |= IOPARM_common_end;
if (dt->id)
mask |= set_parameter_ref (&block, &post_end_block, var,
IOPARM_dt_id, dt->id);
if (dt->pos)
mask |= set_parameter_value (&block, var, IOPARM_dt_pos, dt->pos);
if (dt->asynchronous)
mask |= set_string (&block, &post_block, var, IOPARM_dt_asynchronous,
dt->asynchronous);
if (dt->blank)
mask |= set_string (&block, &post_block, var, IOPARM_dt_blank,
dt->blank);
if (dt->decimal)
mask |= set_string (&block, &post_block, var, IOPARM_dt_decimal,
dt->decimal);
if (dt->delim)
mask |= set_string (&block, &post_block, var, IOPARM_dt_delim,
dt->delim);
if (dt->pad)
mask |= set_string (&block, &post_block, var, IOPARM_dt_pad,
dt->pad);
if (dt->round)
mask |= set_string (&block, &post_block, var, IOPARM_dt_round,
dt->round);
if (dt->sign)
mask |= set_string (&block, &post_block, var, IOPARM_dt_sign,
dt->sign);
if (dt->rec) if (dt->rec)
mask |= set_parameter_value (&block, var, IOPARM_dt_rec, dt->rec); mask |= set_parameter_value (&block, var, IOPARM_dt_rec, dt->rec);
......
...@@ -69,3 +69,4 @@ tree gfc_trans_flush (gfc_code *); ...@@ -69,3 +69,4 @@ tree gfc_trans_flush (gfc_code *);
tree gfc_trans_transfer (gfc_code *); tree gfc_trans_transfer (gfc_code *);
tree gfc_trans_dt_end (gfc_code *); tree gfc_trans_dt_end (gfc_code *);
tree gfc_trans_wait (gfc_code *);
...@@ -1108,6 +1108,10 @@ gfc_trans_code (gfc_code * code) ...@@ -1108,6 +1108,10 @@ gfc_trans_code (gfc_code * code)
res = gfc_trans_inquire (code); res = gfc_trans_inquire (code);
break; break;
case EXEC_WAIT:
res = gfc_trans_wait (code);
break;
case EXEC_REWIND: case EXEC_REWIND:
res = gfc_trans_rewind (code); res = gfc_trans_rewind (code);
break; break;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment