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>
PR fortran/35786
......
......@@ -1405,11 +1405,36 @@ gfc_show_code_node (int level, gfc_code *c)
gfc_status (" 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)
{
gfc_status (" CONVERT=");
gfc_show_expr (open->convert);
}
if (open->asynchronous)
{
gfc_status (" ASYNCHRONOUS=");
gfc_show_expr (open->asynchronous);
}
if (open->err != NULL)
gfc_status (" ERR=%d", open->err->value);
......@@ -1616,6 +1641,46 @@ gfc_show_code_node (int level, gfc_code *c)
gfc_status (" 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)
gfc_status (" ERR=%d", i->err->value);
......@@ -1678,6 +1743,51 @@ gfc_show_code_node (int level, gfc_code *c)
gfc_status (" 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:
gfc_status_char ('\n');
......
......@@ -211,8 +211,8 @@ typedef enum
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_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_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WAIT,
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_ENUM, ST_ENUMERATOR, ST_END_ENUM,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_CRITICAL,
......@@ -1635,7 +1635,8 @@ gfc_alloc;
typedef struct
{
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_open;
......@@ -1662,7 +1663,8 @@ typedef struct
gfc_expr *unit, *file, *iostat, *exist, *opened, *number, *named,
*name, *access, *sequential, *direct, *form, *formatted,
*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;
......@@ -1672,7 +1674,17 @@ gfc_inquire;
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;
/* A format_label of `format_asterisk' indicates the "*" format */
......@@ -1701,7 +1713,7 @@ typedef enum
EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT,
EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT,
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_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH,
EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
......@@ -1738,6 +1750,7 @@ typedef struct gfc_code
gfc_close *close;
gfc_filepos *filepos;
gfc_inquire *inquire;
gfc_wait *wait;
gfc_dt *dt;
gfc_forall_iterator *forall_iterator;
struct gfc_code *whichloop;
......@@ -2323,6 +2336,8 @@ void gfc_free_inquire (gfc_inquire *);
try gfc_resolve_inquire (gfc_inquire *);
void gfc_free_dt (gfc_dt *);
try gfc_resolve_dt (gfc_dt *);
void gfc_free_wait (gfc_wait *);
try gfc_resolve_wait (gfc_wait *);
/* module.c */
void gfc_module_init_2 (void);
......
......@@ -8,10 +8,10 @@
#define IOPARM_common_end (1 << 3)
#define IOPARM_common_eor (1 << 4)
#endif
IOPARM (common, flags, 0, int4)
IOPARM (common, unit, 0, int4)
IOPARM (common, filename, 0, pchar)
IOPARM (common, line, 0, int4)
IOPARM (common, flags, 0, int4)
IOPARM (common, unit, 0, int4)
IOPARM (common, filename, 0, pchar)
IOPARM (common, line, 0, int4)
IOPARM (common, iomsg, 1 << 6, char2)
IOPARM (common, iostat, 1 << 5, pint4)
IOPARM (open, common, 0, common)
......@@ -25,7 +25,12 @@ IOPARM (open, position, 1 << 13, char1)
IOPARM (open, action, 1 << 14, char2)
IOPARM (open, delim, 1 << 15, char1)
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, status, 1 << 7, char1)
IOPARM (filepos, common, 0, common)
......@@ -53,7 +58,18 @@ IOPARM (inquire, unformatted, 1 << 26, char1)
IOPARM (inquire, read, 1 << 27, char2)
IOPARM (inquire, write, 1 << 28, char1)
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
#define IOPARM_dt_list_format (1 << 7)
#define IOPARM_dt_namelist_read_mode (1 << 8)
......@@ -67,4 +83,13 @@ IOPARM (dt, format, 1 << 12, char1)
IOPARM (dt, advance, 1 << 13, char2)
IOPARM (dt, internal_unit, 1 << 14, char1)
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)
match ("return", gfc_match_return, ST_RETURN)
match ("rewind", gfc_match_rewind, ST_REWIND)
match ("stop", gfc_match_stop, ST_STOP)
match ("wait", gfc_match_wait, ST_WAIT)
match ("where", match_simple_where, ST_WHERE)
match ("write", gfc_match_write, ST_WRITE)
......
......@@ -212,6 +212,7 @@ match gfc_match_rewind (void);
match gfc_match_flush (void);
match gfc_match_inquire (void);
match gfc_match_read (void);
match gfc_match_wait (void);
match gfc_match_write (void);
match gfc_match_print (void);
......
......@@ -440,6 +440,7 @@ decode_statement (void)
break;
case 'w':
match ("wait", gfc_match_wait, ST_WAIT);
match ("write", gfc_match_write, ST_WRITE);
break;
}
......@@ -861,9 +862,9 @@ next_statement (void)
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_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_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_OMP_BARRIER
......@@ -1268,6 +1269,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_WHERE:
p = "WHERE";
break;
case ST_WAIT:
p = "WAIT";
break;
case ST_WRITE:
p = "WRITE";
break;
......
......@@ -5964,6 +5964,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
case EXEC_READ:
case EXEC_WRITE:
case EXEC_IOLENGTH:
case EXEC_WAIT:
break;
case EXEC_OMP_ATOMIC:
......@@ -6373,6 +6374,15 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
resolve_branch (code->ext.inquire->err, code);
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_WRITE:
if (gfc_resolve_dt (code->ext.dt) == FAILURE)
......
......@@ -146,6 +146,10 @@ gfc_free_statement (gfc_code *p)
gfc_free_inquire (p->ext.inquire);
break;
case EXEC_WAIT:
gfc_free_wait (p->ext.wait);
break;
case EXEC_READ:
case EXEC_WRITE:
gfc_free_dt (p->ext.dt);
......
......@@ -45,6 +45,7 @@ enum ioparam_type
IOPARM_ptype_filepos,
IOPARM_ptype_inquire,
IOPARM_ptype_dt,
IOPARM_ptype_wait,
IOPARM_ptype_num
};
......@@ -96,7 +97,8 @@ static GTY(()) gfc_st_parameter st_parameter[] =
{ "close", NULL },
{ "filepos", NULL },
{ "inquire", NULL },
{ "dt", NULL }
{ "dt", NULL },
{ "wait", NULL }
};
static GTY(()) gfc_st_parameter_field st_parameter_field[] =
......@@ -133,6 +135,7 @@ enum iocall
IOCALL_FLUSH,
IOCALL_SET_NML_VAL,
IOCALL_SET_NML_VAL_DIM,
IOCALL_WAIT,
IOCALL_NUM
};
......@@ -372,6 +375,11 @@ gfc_build_io_library_fndecls (void)
gfc_build_library_function_decl(get_identifier (PREFIX("st_iolength")),
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);
iocall[IOCALL_REWIND] =
gfc_build_library_function_decl (get_identifier (PREFIX("st_rewind")),
......@@ -921,6 +929,24 @@ gfc_trans_open (gfc_code * code)
if (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)
mask |= set_string (&block, &post_block, var, IOPARM_open_convert,
p->convert);
......@@ -1117,7 +1143,7 @@ gfc_trans_inquire (gfc_code * code)
stmtblock_t block, post_block;
gfc_inquire *p;
tree tmp, var;
unsigned int mask = 0;
unsigned int mask = 0, mask2 = 0;
gfc_start_block (&block);
gfc_init_block (&post_block);
......@@ -1248,6 +1274,43 @@ gfc_trans_inquire (gfc_code * code)
mask |= set_parameter_ref (&block, &post_block, var,
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);
if (p->unit)
......@@ -1266,6 +1329,56 @@ gfc_trans_inquire (gfc_code * code)
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 *
gfc_new_nml_name_expr (const char * name)
{
......@@ -1583,6 +1696,41 @@ build_dt (tree function, gfc_code * code)
if (dt->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)
mask |= set_parameter_value (&block, var, IOPARM_dt_rec, dt->rec);
......
......@@ -69,3 +69,4 @@ tree gfc_trans_flush (gfc_code *);
tree gfc_trans_transfer (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)
res = gfc_trans_inquire (code);
break;
case EXEC_WAIT:
res = gfc_trans_wait (code);
break;
case EXEC_REWIND:
res = gfc_trans_rewind (code);
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