2010-04-06 Tobias Burnus <burnus@net-b.de>
+ PR fortran/39997
+ * intrinsic.c (add_functions): Add num_images.
+ * decl.c (gfc_match_end): Handle END CRITICAL.
+ * intrinsic.h (gfc_simplify_num_images): Add prototype.
+ * dump-parse-tree.c (show_code_node): Dump CRITICAL, ERROR STOP,
+ and SYNC.
+ * gfortran.h (gfc_statement): Add enum items for those.
+ (gfc_exec_op) Ditto.
+ (gfc_isym_id): Add num_images.
+ * trans-stmt.c (gfc_trans_stop): Handle ERROR STOP.
+ (gfc_trans_sync,gfc_trans_critical): New functions.
+ * trans-stmt.h (gfc_trans_stop,gfc_trans_sync,
+ gfc_trans_critical): Add/update prototypes.
+ * trans.c (gfc_trans_code): Handle CRITICAL, ERROR STOP,
+ and SYNC statements.
+ * trans.h (gfor_fndecl_error_stop_string) Add variable.
+ * resolve.c (resolve_sync): Add function.
+ (gfc_resolve_blocks): Handle CRITICAL.
+ (resolve_code): Handle CRITICAL, ERROR STOP,
+ (resolve_branch): Add CRITICAL constraint check.
+ and SYNC statements.
+ * st.c (gfc_free_statement): Add new statements.
+ * trans-decl.c (gfor_fndecl_error_stop_string): Global variable.
+ (gfc_build_builtin_function_decls): Initialize it.
+ * match.c (gfc_match_if): Handle ERROR STOP and SYNC.
+ (gfc_match_critical, gfc_match_error_stop, sync_statement,
+ gfc_match_sync_all, gfc_match_sync_images, gfc_match_sync_memory):
+ New functions.
+ (match_exit_cycle): Handle CRITICAL constraint.
+ (gfc_match_stopcode): Handle ERROR STOP.
+ * match.h (gfc_match_critical, gfc_match_error_stop,
+ gfc_match_sync_all, gfc_match_sync_images,
+ gfc_match_sync_memory): Add prototype.
+ * parse.c (decode_statement, gfc_ascii_statement,
+ parse_executable): Handle new statements.
+ (parse_critical_block): New function.
+ * parse.h (gfc_compile_state): Add COMP_CRITICAL.
+ * intrinsic.texi (num_images): Document new function.
+ * simplify.c (gfc_simplify_num_images): Add function.
+
+2010-04-06 Tobias Burnus <burnus@net-b.de>
+
PR fortran/43178
* trans-array.c (gfc_conv_expr_descriptor): Update
gfc_trans_scalar_assign call.
eos_ok = 0;
break;
+ case COMP_CRITICAL:
+ *st = ST_END_CRITICAL;
+ target = " critical";
+ eos_ok = 0;
+ break;
+
case COMP_SELECT:
case COMP_SELECT_TYPE:
*st = ST_END_SELECT;
{
if (*st != ST_ENDDO && *st != ST_ENDIF && *st != ST_END_SELECT
- && *st != ST_END_FORALL && *st != ST_END_WHERE && *st != ST_END_BLOCK)
+ && *st != ST_END_FORALL && *st != ST_END_WHERE && *st != ST_END_BLOCK
+ && *st != ST_END_CRITICAL)
return MATCH_YES;
if (!block_name)
/* Parse tree dumper
- Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009
+ Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
Contributed by Steven Bosscher
break;
+ case EXEC_ERROR_STOP:
+ fputs ("ERROR ", dumpfile);
+ /* Fall through. */
+
case EXEC_STOP:
fputs ("STOP ", dumpfile);
break;
+ case EXEC_SYNC_ALL:
+ fputs ("SYNC ALL ", dumpfile);
+ if (c->expr2 != NULL)
+ {
+ fputs (" stat=", dumpfile);
+ show_expr (c->expr2);
+ }
+ if (c->expr3 != NULL)
+ {
+ fputs (" errmsg=", dumpfile);
+ show_expr (c->expr3);
+ }
+ break;
+
+ case EXEC_SYNC_MEMORY:
+ fputs ("SYNC MEMORY ", dumpfile);
+ if (c->expr2 != NULL)
+ {
+ fputs (" stat=", dumpfile);
+ show_expr (c->expr2);
+ }
+ if (c->expr3 != NULL)
+ {
+ fputs (" errmsg=", dumpfile);
+ show_expr (c->expr3);
+ }
+ break;
+
+ case EXEC_SYNC_IMAGES:
+ fputs ("SYNC IMAGES image-set=", dumpfile);
+ if (c->expr1 != NULL)
+ show_expr (c->expr1);
+ else
+ fputs ("* ", dumpfile);
+ if (c->expr2 != NULL)
+ {
+ fputs (" stat=", dumpfile);
+ show_expr (c->expr2);
+ }
+ if (c->expr3 != NULL)
+ {
+ fputs (" errmsg=", dumpfile);
+ show_expr (c->expr3);
+ }
+ break;
+
case EXEC_ARITHMETIC_IF:
fputs ("IF ", dumpfile);
show_expr (c->expr1);
fputs ("END FORALL", dumpfile);
break;
+ case EXEC_CRITICAL:
+ fputs ("CRITICAL\n", dumpfile);
+ show_code (level + 1, c->block->next);
+ code_indent (level, 0);
+ fputs ("END CRITICAL", dumpfile);
+ break;
+
case EXEC_DO:
fputs ("DO ", dumpfile);
ST_END_FILE, ST_FINAL, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF,
ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT,
ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE,
- ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO,
- ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT,
- ST_INQUIRE, ST_INTERFACE,
+ ST_ERROR_STOP, ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION,
+ ST_GOTO, ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_IMPORT,
+ ST_INQUIRE, ST_INTERFACE, ST_SYNC_ALL, ST_SYNC_MEMORY, ST_SYNC_IMAGES,
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_WAIT,
ST_OMP_PARALLEL, ST_OMP_PARALLEL_DO, ST_OMP_PARALLEL_SECTIONS,
ST_OMP_PARALLEL_WORKSHARE, ST_OMP_SECTIONS, ST_OMP_SECTION, ST_OMP_SINGLE,
ST_OMP_THREADPRIVATE, ST_OMP_WORKSHARE, ST_OMP_TASK, ST_OMP_END_TASK,
- ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC,
+ ST_OMP_TASKWAIT, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
ST_GET_FCN_CHARACTERISTICS, ST_NONE
}
gfc_statement;
GFC_ISYM_NINT,
GFC_ISYM_NOT,
GFC_ISYM_NULL,
+ GFC_ISYM_NUMIMAGES,
GFC_ISYM_OR,
GFC_ISYM_PACK,
GFC_ISYM_PERROR,
typedef enum
{
EXEC_NOP = 1, EXEC_END_BLOCK, EXEC_ASSIGN, EXEC_LABEL_ASSIGN,
- EXEC_POINTER_ASSIGN,
+ EXEC_POINTER_ASSIGN, EXEC_CRITICAL, EXEC_ERROR_STOP,
EXEC_GOTO, EXEC_CALL, EXEC_COMPCALL, EXEC_ASSIGN_CALL, EXEC_RETURN,
EXEC_ENTRY, EXEC_PAUSE, EXEC_STOP, EXEC_CONTINUE, EXEC_INIT_ASSIGN,
EXEC_IF, EXEC_ARITHMETIC_IF, EXEC_DO, EXEC_DO_WHILE, EXEC_SELECT, EXEC_BLOCK,
EXEC_FORALL, EXEC_WHERE, EXEC_CYCLE, EXEC_EXIT, EXEC_CALL_PPC,
EXEC_ALLOCATE, EXEC_DEALLOCATE, EXEC_END_PROCEDURE, EXEC_SELECT_TYPE,
+ EXEC_SYNC_ALL, EXEC_SYNC_MEMORY, EXEC_SYNC_IMAGES,
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,
make_generic ("null", GFC_ISYM_NULL, GFC_STD_F95);
+ add_sym_0 ("num_images", GFC_ISYM_NUMIMAGES, CLASS_INQUIRY, ACTUAL_NO, BT_INTEGER, di, GFC_STD_F2008,
+ NULL, gfc_simplify_num_images, NULL);
+
add_sym_3 ("pack", GFC_ISYM_PACK, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_REAL, dr, GFC_STD_F95,
gfc_check_pack, gfc_simplify_pack, gfc_resolve_pack,
ar, BT_REAL, dr, REQUIRED, msk, BT_LOGICAL, dl, REQUIRED,
/* Header file for intrinsics check, resolve and simplify function
prototypes.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
- Free Software Foundation, Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+ 2010 Free Software Foundation, Inc.
Contributed by Andy Vaught & Katherine Holcomb
This file is part of GCC.
gfc_expr *gfc_simplify_new_line (gfc_expr *);
gfc_expr *gfc_simplify_nint (gfc_expr *, gfc_expr *);
gfc_expr *gfc_simplify_null (gfc_expr *);
+gfc_expr *gfc_simplify_num_images (void);
gfc_expr *gfc_simplify_idnint (gfc_expr *);
gfc_expr *gfc_simplify_not (gfc_expr *);
gfc_expr *gfc_simplify_or (gfc_expr *, gfc_expr *);
* @code{NINT}: NINT, Nearest whole number
* @code{NOT}: NOT, Logical negation
* @code{NULL}: NULL, Function that returns an disassociated pointer
+* @code{NUM_IMAGES}: NUM_IMAGES, Number of images
* @code{OR}: OR, Bitwise logical OR
* @code{PACK}: PACK, Pack an array into an array of rank one
* @code{PERROR}: PERROR, Print system error message
+@node NUM_IMAGES
+@section @code{NUM_IMAGES} --- Function that returns the number of images
+@fnindex NUM_IMAGES
+@cindex coarray, NUM_IMAGES
+@cindex images, number of
+
+@table @asis
+@item @emph{Description}:
+Returns the number of images.
+
+@item @emph{Standard}:
+Fortran 2008 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = NUM_IMAGES()}
+
+@item @emph{Arguments}: None.
+
+@item @emph{Return value}:
+Scalar default-kind integer.
+
+@item @emph{Example}:
+@smallexample
+INTEGER :: value[*]
+INTEGER :: i
+value = THIS_IMAGE()
+SYNC ALL
+IF (THIS_IMAGE() == 1) THEN
+ DO i = 1, NUM_IMAGES()
+ WRITE(*,'(2(a,i0))') 'value[', i, '] is ', value[i]
+ END DO
+END IF
+@end smallexample
+
+@item @emph{See also}:
+@c FIXME: ref{THIS_IMAGE}
+@end table
+
+
+
@node OR
@section @code{OR} --- Bitwise logical OR
@fnindex OR
/* Matching subroutines in all sizes, shapes and colors.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
- Free Software Foundation, Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+ 2010 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
match ("cycle", gfc_match_cycle, ST_CYCLE)
match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE)
match ("end file", gfc_match_endfile, ST_END_FILE)
+ match ("error stop", gfc_match_error_stop, ST_ERROR_STOP)
match ("exit", gfc_match_exit, ST_EXIT)
match ("flush", gfc_match_flush, ST_FLUSH)
match ("forall", match_simple_forall, ST_FORALL)
match ("rewind", gfc_match_rewind, ST_REWIND)
match ("stop", gfc_match_stop, ST_STOP)
match ("wait", gfc_match_wait, ST_WAIT)
+ match ("sync all", gfc_match_sync_all, ST_SYNC_CALL);
+ match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
+ match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
match ("where", match_simple_where, ST_WHERE)
match ("write", gfc_match_write, ST_WRITE)
}
+/* Match a CRITICAL statement. */
+match
+gfc_match_critical (void)
+{
+ gfc_st_label *label = NULL;
+
+ if (gfc_match_label () == MATCH_ERROR)
+ return MATCH_ERROR;
+
+ if (gfc_match (" critical") != MATCH_YES)
+ return MATCH_NO;
+
+ if (gfc_match_st_label (&label) == MATCH_ERROR)
+ return MATCH_ERROR;
+
+ if (gfc_match_eos () != MATCH_YES)
+ {
+ gfc_syntax_error (ST_CRITICAL);
+ return MATCH_ERROR;
+ }
+
+ if (gfc_pure (NULL))
+ {
+ gfc_error ("Image control statement CRITICAL at %C in PURE procedure");
+ return MATCH_ERROR;
+ }
+
+ if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: CRITICAL statement at %C")
+ == FAILURE)
+ return MATCH_ERROR;
+
+ if (gfc_find_state (COMP_CRITICAL) == SUCCESS)
+ {
+ gfc_error ("Nested CRITICAL block at %C");
+ return MATCH_ERROR;
+ }
+
+ new_st.op = EXEC_CRITICAL;
+
+ if (label != NULL
+ && gfc_reference_st_label (label, ST_LABEL_TARGET) == FAILURE)
+ return MATCH_ERROR;
+
+ return MATCH_YES;
+}
+
+
/* Match a BLOCK statement. */
match
break;
else if (o == NULL && p->state == COMP_OMP_STRUCTURED_BLOCK)
o = p;
+ else if (p->state == COMP_CRITICAL)
+ {
+ gfc_error("%s statement at %C leaves CRITICAL construct",
+ gfc_ascii_statement (st));
+ return MATCH_ERROR;
+ }
if (p == NULL)
{
}
-/* Match a number or character constant after a STOP or PAUSE statement. */
+/* Match a number or character constant after an (ALL) STOP or PAUSE statement. */
static match
gfc_match_stopcode (gfc_statement st)
goto cleanup;
}
- new_st.op = st == ST_STOP ? EXEC_STOP : EXEC_PAUSE;
+ if (st == ST_STOP && gfc_find_state (COMP_CRITICAL) == SUCCESS)
+ {
+ gfc_error ("Image control statement STOP at %C in CRITICAL block");
+ return MATCH_ERROR;
+ }
+
+ switch (st)
+ {
+ case ST_STOP:
+ new_st.op = EXEC_STOP;
+ break;
+ case ST_ERROR_STOP:
+ new_st.op = EXEC_ERROR_STOP;
+ break;
+ case ST_PAUSE:
+ new_st.op = EXEC_PAUSE;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
new_st.expr1 = e;
new_st.ext.stop_code = stop_code;
}
+/* Match the ERROR STOP statement. */
+
+match
+gfc_match_error_stop (void)
+{
+ if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: ERROR STOP statement at %C")
+ == FAILURE)
+ return MATCH_ERROR;
+
+ return gfc_match_stopcode (ST_ERROR_STOP);
+}
+
+
+/* Match SYNC ALL/IMAGES/MEMORY statement. Syntax:
+ SYNC ALL [(sync-stat-list)]
+ SYNC MEMORY [(sync-stat-list)]
+ SYNC IMAGES (image-set [, sync-stat-list] )
+ with sync-stat is int-expr or *. */
+
+static match
+sync_statement (gfc_statement st)
+{
+ match m;
+ gfc_expr *tmp, *imageset, *stat, *errmsg;
+ bool saw_stat, saw_errmsg;
+
+ tmp = imageset = stat = errmsg = NULL;
+ saw_stat = saw_errmsg = false;
+
+ if (gfc_pure (NULL))
+ {
+ gfc_error ("Image control statement SYNC at %C in PURE procedure");
+ return MATCH_ERROR;
+ }
+
+ if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: SYNC statement at %C")
+ == FAILURE)
+ return MATCH_ERROR;
+
+ if (gfc_find_state (COMP_CRITICAL) == SUCCESS)
+ {
+ gfc_error ("Image control statement SYNC at %C in CRITICAL block");
+ return MATCH_ERROR;
+ }
+
+ if (gfc_match_eos () == MATCH_YES)
+ {
+ if (st == ST_SYNC_IMAGES)
+ goto syntax;
+ goto done;
+ }
+
+ if (gfc_match_char ('(') != MATCH_YES)
+ goto syntax;
+
+ if (st == ST_SYNC_IMAGES)
+ {
+ /* Denote '*' as imageset == NULL. */
+ m = gfc_match_char ('*');
+ if (m == MATCH_ERROR)
+ goto syntax;
+ if (m == MATCH_NO)
+ {
+ if (gfc_match ("%e", &imageset) != MATCH_YES)
+ goto syntax;
+ }
+ m = gfc_match_char (',');
+ if (m == MATCH_ERROR)
+ goto syntax;
+ if (m == MATCH_NO)
+ {
+ m = gfc_match_char (')');
+ if (m == MATCH_YES)
+ goto done;
+ goto syntax;
+ }
+ }
+
+ for (;;)
+ {
+ m = gfc_match (" stat = %v", &tmp);
+ if (m == MATCH_ERROR)
+ goto syntax;
+ if (m == MATCH_YES)
+ {
+ if (saw_stat)
+ {
+ gfc_error ("Redundant STAT tag found at %L ", &tmp->where);
+ goto cleanup;
+ }
+ stat = tmp;
+ saw_stat = true;
+
+ if (gfc_match_char (',') == MATCH_YES)
+ continue;
+ }
+
+ m = gfc_match (" errmsg = %v", &tmp);
+ if (m == MATCH_ERROR)
+ goto syntax;
+ if (m == MATCH_YES)
+ {
+ if (saw_errmsg)
+ {
+ gfc_error ("Redundant ERRMSG tag found at %L ", &tmp->where);
+ goto cleanup;
+ }
+ errmsg = tmp;
+ saw_errmsg = true;
+
+ if (gfc_match_char (',') == MATCH_YES)
+ continue;
+ }
+
+ gfc_gobble_whitespace ();
+
+ if (gfc_peek_char () == ')')
+ break;
+
+ goto syntax;
+ }
+
+ if (gfc_match (" )%t") != MATCH_YES)
+ goto syntax;
+
+done:
+ switch (st)
+ {
+ case ST_SYNC_ALL:
+ new_st.op = EXEC_SYNC_ALL;
+ break;
+ case ST_SYNC_IMAGES:
+ new_st.op = EXEC_SYNC_IMAGES;
+ break;
+ case ST_SYNC_MEMORY:
+ new_st.op = EXEC_SYNC_MEMORY;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ new_st.expr1 = imageset;
+ new_st.expr2 = stat;
+ new_st.expr3 = errmsg;
+
+ return MATCH_YES;
+
+syntax:
+ gfc_syntax_error (st);
+
+cleanup:
+ gfc_free_expr (tmp);
+ gfc_free_expr (imageset);
+ gfc_free_expr (stat);
+ gfc_free_expr (errmsg);
+
+ return MATCH_ERROR;
+}
+
+
+/* Match SYNC ALL statement. */
+
+match
+gfc_match_sync_all (void)
+{
+ return sync_statement (ST_SYNC_ALL);
+}
+
+
+/* Match SYNC IMAGES statement. */
+
+match
+gfc_match_sync_images (void)
+{
+ return sync_statement (ST_SYNC_IMAGES);
+}
+
+
+/* Match SYNC MEMORY statement. */
+
+match
+gfc_match_sync_memory (void)
+{
+ return sync_statement (ST_SYNC_MEMORY);
+}
+
+
/* Match a CONTINUE statement. */
match
gfc_compile_state s;
e = NULL;
+
+ if (gfc_find_state (COMP_CRITICAL) == SUCCESS)
+ {
+ gfc_error ("Image control statement RETURN at %C in CRITICAL block");
+ return MATCH_ERROR;
+ }
+
if (gfc_match_eos () == MATCH_YES)
goto done;
match gfc_match_if (gfc_statement *);
match gfc_match_else (void);
match gfc_match_elseif (void);
+match gfc_match_critical (void);
match gfc_match_block (void);
match gfc_match_do (void);
match gfc_match_cycle (void);
match gfc_match_exit (void);
match gfc_match_pause (void);
match gfc_match_stop (void);
+match gfc_match_error_stop (void);
match gfc_match_continue (void);
match gfc_match_assign (void);
match gfc_match_goto (void);
+match gfc_match_sync_all (void);
+match gfc_match_sync_images (void);
+match gfc_match_sync_memory (void);
match gfc_match_allocate (void);
match gfc_match_nullify (void);
gfc_undo_symbols ();
gfc_current_locus = old_locus;
- /* Check for the IF, DO, SELECT, WHERE, FORALL and BLOCK statements, which
- might begin with a block label. The match functions for these
- statements are unusual in that their keyword is not seen before
+ /* Check for the IF, DO, SELECT, WHERE, FORALL, CRITICAL, and BLOCK
+ statements, which might begin with a block label. The match functions for
+ these statements are unusual in that their keyword is not seen before
the matcher is called. */
if (gfc_match_if (&st) == MATCH_YES)
gfc_undo_symbols ();
gfc_current_locus = old_locus;
- match (NULL, gfc_match_block, ST_BLOCK);
match (NULL, gfc_match_do, ST_DO);
+ match (NULL, gfc_match_block, ST_BLOCK);
+ match (NULL, gfc_match_critical, ST_CRITICAL);
match (NULL, gfc_match_select, ST_SELECT_CASE);
match (NULL, gfc_match_select_type, ST_SELECT_TYPE);
match ("else", gfc_match_else, ST_ELSE);
match ("else where", gfc_match_elsewhere, ST_ELSEWHERE);
match ("else if", gfc_match_elseif, ST_ELSEIF);
+ match ("error stop", gfc_match_error_stop, ST_ERROR_STOP);
match ("enum , bind ( c )", gfc_match_enum, ST_ENUM);
if (gfc_match_end (&st) == MATCH_YES)
match ("sequence", gfc_match_eos, ST_SEQUENCE);
match ("stop", gfc_match_stop, ST_STOP);
match ("save", gfc_match_save, ST_ATTR_DECL);
+ match ("sync all", gfc_match_sync_all, ST_SYNC_ALL);
+ match ("sync images", gfc_match_sync_images, ST_SYNC_IMAGES);
+ match ("sync memory", gfc_match_sync_memory, ST_SYNC_MEMORY);
break;
case 't':
case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \
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: case ST_OMP_TASKWAIT
+ case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_ERROR_STOP: \
+ case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY
/* Statements that mark other executable statements. */
case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
- case ST_OMP_TASK
+ case ST_OMP_TASK: case ST_CRITICAL
/* Declaration statements */
case ST_ENDDO:
case ST_ENDIF:
case ST_END_SELECT:
+ case ST_END_CRITICAL:
case_executable:
case_exec_markers:
type = ST_LABEL_TARGET;
case ST_CONTAINS:
p = "CONTAINS";
break;
+ case ST_CRITICAL:
+ p = "CRITICAL";
+ break;
case ST_CYCLE:
p = "CYCLE";
break;
case ST_END_BLOCK_DATA:
p = "END BLOCK DATA";
break;
+ case ST_END_CRITICAL:
+ p = "END CRITICAL";
+ break;
case ST_ENDDO:
p = "END DO";
break;
case ST_EQUIVALENCE:
p = "EQUIVALENCE";
break;
+ case ST_ERROR_STOP:
+ p = "ERROR STOP";
+ break;
case ST_EXIT:
p = "EXIT";
break;
case ST_STOP:
p = "STOP";
break;
+ case ST_SYNC_ALL:
+ p = "SYNC ALL";
+ break;
+ case ST_SYNC_IMAGES:
+ p = "SYNC IMAGES";
+ break;
+ case ST_SYNC_MEMORY:
+ p = "SYNC MEMORY";
+ break;
case ST_SUBROUTINE:
p = "SUBROUTINE";
break;
case ST_ENDIF:
case ST_END_SELECT:
+ case ST_END_CRITICAL:
if (gfc_statement_label != NULL)
{
new_st.op = EXEC_END_BLOCK;
static void parse_progunit (gfc_statement);
+/* Parse a CRITICAL block. */
+
+static void
+parse_critical_block (void)
+{
+ gfc_code *top, *d;
+ gfc_state_data s;
+ gfc_statement st;
+
+ s.ext.end_do_label = new_st.label1;
+
+ accept_statement (ST_CRITICAL);
+ top = gfc_state_stack->tail;
+
+ push_state (&s, COMP_CRITICAL, gfc_new_block);
+
+ d = add_statement ();
+ d->op = EXEC_CRITICAL;
+ top->block = d;
+
+ do
+ {
+ st = parse_executable (ST_NONE);
+
+ switch (st)
+ {
+ case ST_NONE:
+ unexpected_eof ();
+ break;
+
+ case ST_END_CRITICAL:
+ if (s.ext.end_do_label != NULL
+ && s.ext.end_do_label != gfc_statement_label)
+ gfc_error_now ("Statement label in END CRITICAL at %C does not "
+ "match CRITIAL label");
+
+ if (gfc_statement_label != NULL)
+ {
+ new_st.op = EXEC_NOP;
+ add_statement ();
+ }
+ break;
+
+ default:
+ unexpected_statement (st);
+ break;
+ }
+ }
+ while (st != ST_END_CRITICAL);
+
+ pop_state ();
+ accept_statement (st);
+}
+
+
/* Set up the local namespace for a BLOCK construct. */
gfc_namespace*
case ST_CYCLE:
case ST_PAUSE:
case ST_STOP:
+ case ST_ERROR_STOP:
case ST_END_SUBROUTINE:
case ST_DO:
+ case ST_CRITICAL:
+ case ST_BLOCK:
case ST_FORALL:
case ST_WHERE:
case ST_SELECT_CASE:
return ST_IMPLIED_ENDDO;
break;
+ case ST_CRITICAL:
+ parse_critical_block ();
+ break;
+
case ST_WHERE_BLOCK:
parse_where_block ();
break;
/* Parser header
- Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
Contributed by Steven Bosscher
COMP_BLOCK_DATA, COMP_INTERFACE, COMP_DERIVED, COMP_DERIVED_CONTAINS,
COMP_BLOCK, COMP_IF,
COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM,
- COMP_SELECT_TYPE, COMP_OMP_STRUCTURED_BLOCK
+ COMP_SELECT_TYPE, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL
}
gfc_compile_state;
}
}
+
+static void
+resolve_sync (gfc_code *code)
+{
+ /* Check imageset. The * case matches expr1 == NULL. */
+ if (code->expr1)
+ {
+ if (code->expr1->ts.type != BT_INTEGER || code->expr1->rank > 1)
+ gfc_error ("Imageset argument at %L must be a scalar or rank-1 "
+ "INTEGER expression", &code->expr1->where);
+ if (code->expr1->expr_type == EXPR_CONSTANT && code->expr1->rank == 0
+ && mpz_cmp_si (code->expr1->value.integer, 1) < 0)
+ gfc_error ("Imageset argument at %L must between 1 and num_images()",
+ &code->expr1->where);
+ else if (code->expr1->expr_type == EXPR_ARRAY
+ && gfc_simplify_expr (code->expr1, 0) == SUCCESS)
+ {
+ gfc_constructor *cons;
+ for (cons = code->expr1->value.constructor; cons; cons = cons->next)
+ if (cons->expr->expr_type == EXPR_CONSTANT
+ && mpz_cmp_si (cons->expr->value.integer, 1) < 0)
+ gfc_error ("Imageset argument at %L must between 1 and "
+ "num_images()", &cons->expr->where);
+ }
+ }
+
+ /* Check STAT. */
+ if (code->expr2
+ && (code->expr2->ts.type != BT_INTEGER || code->expr2->rank != 0
+ || code->expr2->expr_type != EXPR_VARIABLE))
+ gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
+ &code->expr2->where);
+
+ /* Check ERRMSG. */
+ if (code->expr3
+ && (code->expr3->ts.type != BT_CHARACTER || code->expr3->rank != 0
+ || code->expr3->expr_type != EXPR_VARIABLE))
+ gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
+ &code->expr3->where);
+}
+
+
/* Given a branch to a label, see if the branch is conforming.
The code node describes where the branch is located. */
the bitmap reachable_labels. */
if (bitmap_bit_p (cs_base->reachable_labels, label->value))
- return;
+ {
+ /* Check now whether there is a CRITICAL construct; if so, check
+ whether the label is still visible outside of the CRITICAL block,
+ which is invalid. */
+ for (stack = cs_base; stack; stack = stack->prev)
+ if (stack->current->op == EXEC_CRITICAL
+ && bitmap_bit_p (stack->reachable_labels, label->value))
+ gfc_error ("GOTO statement at %L leaves CRITICAL construct for label"
+ " at %L", &code->loc, &label->where);
+
+ return;
+ }
/* Step four: If we haven't found the label in the bitmap, it may
still be the label of the END of the enclosing block, in which
case we find it by going up the code_stack. */
for (stack = cs_base; stack; stack = stack->prev)
- if (stack->current->next && stack->current->next->here == label)
- break;
+ {
+ if (stack->current->next && stack->current->next->here == label)
+ break;
+ if (stack->current->op == EXEC_CRITICAL)
+ {
+ /* Note: A label at END CRITICAL does not leave the CRITICAL
+ construct as END CRITICAL is still part of it. */
+ gfc_error ("GOTO statement at %L leaves CRITICAL construct for label"
+ " at %L", &code->loc, &label->where);
+ return;
+ }
+ }
if (stack)
{
case EXEC_FORALL:
case EXEC_DO:
case EXEC_DO_WHILE:
+ case EXEC_CRITICAL:
case EXEC_READ:
case EXEC_WRITE:
case EXEC_IOLENGTH:
case EXEC_CYCLE:
case EXEC_PAUSE:
case EXEC_STOP:
+ case EXEC_ERROR_STOP:
case EXEC_EXIT:
case EXEC_CONTINUE:
case EXEC_DT_END:
case EXEC_ASSIGN_CALL:
+ case EXEC_CRITICAL:
+ break;
+
+ case EXEC_SYNC_ALL:
+ case EXEC_SYNC_IMAGES:
+ case EXEC_SYNC_MEMORY:
+ resolve_sync (code);
break;
case EXEC_ENTRY:
/* Simplify intrinsic functions at compile-time.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
- Free Software Foundation, Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
+ 2010 Free Software Foundation, Inc.
Contributed by Andy Vaught & Katherine Holcomb
This file is part of GCC.
return range_check (result, "EXP");
}
+
gfc_expr *
gfc_simplify_exponent (gfc_expr *x)
{
gfc_expr *
+gfc_simplify_num_images (void)
+{
+ gfc_expr *result;
+ /* FIXME: gfc_current_locus is wrong. */
+ result = gfc_constant_result (BT_INTEGER, gfc_default_integer_kind, &gfc_current_locus);
+ mpz_set_si (result->value.integer, 1);
+ return result;
+}
+
+
+gfc_expr *
gfc_simplify_or (gfc_expr *x, gfc_expr *y)
{
gfc_expr *result;
/* Build executable statement trees.
- Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009
+ Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
Contributed by Andy Vaught
case EXEC_IF:
case EXEC_PAUSE:
case EXEC_STOP:
+ case EXEC_ERROR_STOP:
case EXEC_EXIT:
case EXEC_WHERE:
case EXEC_IOLENGTH:
case EXEC_LABEL_ASSIGN:
case EXEC_ENTRY:
case EXEC_ARITHMETIC_IF:
+ case EXEC_CRITICAL:
+ case EXEC_SYNC_ALL:
+ case EXEC_SYNC_IMAGES:
+ case EXEC_SYNC_MEMORY:
break;
case EXEC_BLOCK:
tree gfor_fndecl_pause_string;
tree gfor_fndecl_stop_numeric;
tree gfor_fndecl_stop_string;
+tree gfor_fndecl_error_stop_string;
tree gfor_fndecl_runtime_error;
tree gfor_fndecl_runtime_error_at;
tree gfor_fndecl_runtime_warning_at;
/* Stop doesn't return. */
TREE_THIS_VOLATILE (gfor_fndecl_stop_string) = 1;
+ gfor_fndecl_error_stop_string =
+ gfc_build_library_function_decl (get_identifier (PREFIX("error_stop_string")),
+ void_type_node, 2, pchar_type_node,
+ gfc_int4_type_node);
+ /* ERROR STOP doesn't return. */
+ TREE_THIS_VOLATILE (gfor_fndecl_error_stop_string) = 1;
+
gfor_fndecl_pause_numeric =
gfc_build_library_function_decl (get_identifier (PREFIX("pause_numeric")),
void_type_node, 1, gfc_int4_type_node);
to a runtime library call. */
tree
-gfc_trans_stop (gfc_code * code)
+gfc_trans_stop (gfc_code *code, bool error_stop)
{
tree gfc_int4_type_node = gfc_get_int_type (4);
gfc_se se;
gfc_init_se (&se, NULL);
gfc_start_block (&se.pre);
-
if (code->expr1 == NULL)
{
tmp = build_int_cst (gfc_int4_type_node, code->ext.stop_code);
{
gfc_conv_expr_reference (&se, code->expr1);
tmp = build_call_expr_loc (input_location,
- gfor_fndecl_stop_string, 2,
- se.expr, se.string_length);
+ error_stop ? gfor_fndecl_error_stop_string
+ : gfor_fndecl_stop_string,
+ 2, se.expr, se.string_length);
}
gfc_add_expr_to_block (&se.pre, tmp);
}
+tree
+gfc_trans_sync (gfc_code *code, gfc_exec_op type __attribute__ ((unused)))
+{
+ gfc_se se;
+
+ if ((code->expr1 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) || code->expr2)
+ {
+ gfc_init_se (&se, NULL);
+ gfc_start_block (&se.pre);
+ }
+
+ /* Check SYNC IMAGES(imageset) for valid image index.
+ FIXME: Add a check for image-set arrays. */
+ if (code->expr1 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+ && code->expr1->rank == 0)
+ {
+ tree cond;
+ gfc_conv_expr (&se, code->expr1);
+ cond = fold_build2 (NE_EXPR, boolean_type_node, se.expr,
+ build_int_cst (TREE_TYPE (se.expr), 1));
+ gfc_trans_runtime_check (true, false, cond, &se.pre,
+ &code->expr1->where, "Invalid image number "
+ "%d in SYNC IMAGES",
+ fold_convert (integer_type_node, se.expr));
+ }
+
+ /* If STAT is present, set it to zero. */
+ if (code->expr2)
+ {
+ gcc_assert (code->expr2->expr_type == EXPR_VARIABLE);
+ gfc_conv_expr (&se, code->expr2);
+ gfc_add_modify (&se.pre, se.expr, build_int_cst (TREE_TYPE (se.expr), 0));
+ }
+
+ if ((code->expr1 && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) || code->expr2)
+ return gfc_finish_block (&se.pre);
+
+ return NULL_TREE;
+}
+
+
/* Generate GENERIC for the IF construct. This function also deals with
the simple IF statement, because the front end translates the IF
statement into an IF construct.
}
+/* Translate a CRITICAL block. */
+tree
+gfc_trans_critical (gfc_code *code)
+{
+ stmtblock_t block;
+ tree tmp;
+
+ gfc_start_block (&block);
+ tmp = gfc_trans_code (code->block->next);
+ gfc_add_expr_to_block (&block, tmp);
+
+ return gfc_finish_block (&block);
+}
+
+
/* Translate a BLOCK construct. This is basically what we would do for a
procedure body. */
/* trans-stmt.c */
tree gfc_trans_cycle (gfc_code *);
+tree gfc_trans_critical (gfc_code *);
tree gfc_trans_exit (gfc_code *);
tree gfc_trans_label_assign (gfc_code *);
tree gfc_trans_label_here (gfc_code *);
tree gfc_trans_goto (gfc_code *);
tree gfc_trans_entry (gfc_code *);
tree gfc_trans_pause (gfc_code *);
-tree gfc_trans_stop (gfc_code *);
+tree gfc_trans_stop (gfc_code *, bool);
tree gfc_trans_call (gfc_code *, bool, tree, tree, bool);
tree gfc_trans_return (gfc_code *);
tree gfc_trans_if (gfc_code *);
tree gfc_trans_do (gfc_code *, tree);
tree gfc_trans_do_while (gfc_code *);
tree gfc_trans_select (gfc_code *);
+tree gfc_trans_sync (gfc_code *, gfc_exec_op);
tree gfc_trans_forall (gfc_code *);
tree gfc_trans_where (gfc_code *);
tree gfc_trans_allocate (gfc_code *);
res = NULL_TREE;
break;
+ case EXEC_CRITICAL:
+ res = gfc_trans_critical (code);
+ break;
+
case EXEC_CYCLE:
res = gfc_trans_cycle (code);
break;
break;
case EXEC_STOP:
- res = gfc_trans_stop (code);
+ case EXEC_ERROR_STOP:
+ res = gfc_trans_stop (code, code->op == EXEC_ERROR_STOP);
break;
case EXEC_CALL:
res = gfc_trans_flush (code);
break;
+ case EXEC_SYNC_ALL:
+ case EXEC_SYNC_IMAGES:
+ case EXEC_SYNC_MEMORY:
+ res = gfc_trans_sync (code, code->op);
+ break;
+
case EXEC_FORALL:
res = gfc_trans_forall (code);
break;
extern GTY(()) tree gfor_fndecl_pause_string;
extern GTY(()) tree gfor_fndecl_stop_numeric;
extern GTY(()) tree gfor_fndecl_stop_string;
+extern GTY(()) tree gfor_fndecl_error_stop_string;
extern GTY(()) tree gfor_fndecl_runtime_error;
extern GTY(()) tree gfor_fndecl_runtime_error_at;
extern GTY(()) tree gfor_fndecl_runtime_warning_at;
+2010-04-06 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/39997
+ * gfortran.dg/coarray_1.f90: New test.
+ * gfortran.dg/coarray_2.f90: New test.
+ * gfortran.dg/coarray_3.f90: New test.
+
2010-04-06 Jason Merrill <jason@redhat.com>
PR c++/43648
--- /dev/null
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Coarray support
+! PR fortran/18918
+!
+implicit none
+integer :: n
+critical ! { dg-error "Fortran 2008:" }
+ sync all() ! { dg-error "Fortran 2008:" }
+end critical ! { dg-error "Expecting END PROGRAM" }
+sync memory ! { dg-error "Fortran 2008:" }
+sync images(*) ! { dg-error "Fortran 2008:" }
+
+! num_images is implicitly defined:
+n = num_images() ! { dg-error "convert UNKNOWN to INTEGER" }
+error stop 'stop' ! { dg-error "Fortran 2008:" }
+end
--- /dev/null
+! { dg-do run }
+! { dg-shouldfail "error stop" }
+!
+! Coarray support
+! PR fortran/18918
+
+implicit none
+integer :: n
+character(len=30) :: str
+critical
+end critical
+myCr: critical
+end critical myCr
+ sync all
+ sync all ( )
+ n = 5
+ sync all (stat=n)
+ if (n /= 0) call abort()
+ n = 5
+ sync all (stat=n,errmsg=str)
+ if (n /= 0) call abort()
+ sync all (errmsg=str)
+
+ sync memory
+ sync memory ( )
+ n = 5
+ sync memory (stat=n)
+ if (n /= 0) call abort()
+ n = 5
+ sync memory (errmsg=str,stat=n)
+ if (n /= 0) call abort()
+ sync memory (errmsg=str)
+
+sync images (*, stat=n)
+sync images (1, errmsg=str)
+sync images ([1],errmsg=str,stat=n)
+
+sync images (*)
+sync images (1)
+sync images ([1])
+
+if (num_images() /= 1) call abort()
+error stop 'stop'
+end
+
+! { dg-output "ERROR STOP stop" }
--- /dev/null
+! { dg-do compile }
+!
+! Coarray support
+! PR fortran/18918
+
+implicit none
+integer :: n, m(1), k
+character(len=30) :: str(2)
+
+critical fkl ! { dg-error "Syntax error in CRITICAL" }
+end critical fkl ! { dg-error "Expecting END PROGRAM" }
+
+sync all (stat=1) ! { dg-error "Syntax error in SYNC ALL" }
+sync all ( stat = n,stat=k) ! { dg-error "Redundant STAT" }
+sync memory (errmsg=str)
+sync memory (errmsg=n) ! { dg-error "must be a scalar CHARACTER variable" }
+sync images (*, stat=1.0) ! { dg-error "Syntax error in SYNC IMAGES" }
+sync images (-1) ! { dg-error "must between 1 and num_images" }
+sync images (1)
+sync images ( [ 1 ])
+sync images ( m(1:0) )
+sync images ( reshape([1],[1,1])) ! { dg-error "must be a scalar or rank-1" }
+end
+
+subroutine foo
+critical
+ stop 'error' ! { dg-error "Image control statement STOP" }
+ sync all ! { dg-error "Image control statement SYNC" }
+ return 1 ! { dg-error "Image control statement RETURN" }
+ critical ! { dg-error "Nested CRITICAL block" }
+ end critical
+end critical ! { dg-error "Expecting END SUBROUTINE" }
+end
+
+subroutine bar()
+do
+ critical
+ cycle ! { dg-error "leaves CRITICAL construct" }
+ end critical
+end do
+
+outer: do
+ critical
+ do
+ exit
+ exit outer ! { dg-error "leaves CRITICAL construct" }
+ end do
+ end critical
+end do outer
+end subroutine bar
+
+
+subroutine sub()
+333 continue ! { dg-error "leaves CRITICAL construct" }
+do
+ critical
+ if (.false.) then
+ goto 333 ! { dg-error "leaves CRITICAL construct" }
+ goto 777
+777 end if
+ end critical
+end do
+
+if (.true.) then
+outer: do
+ critical
+ do
+ goto 444
+ goto 555 ! { dg-error "leaves CRITICAL construct" }
+ end do
+444 continue
+ end critical
+ end do outer
+555 end if ! { dg-error "leaves CRITICAL construct" }
+end subroutine sub
+
+pure subroutine pureSub()
+ critical ! { dg-error "Image control statement CRITICAL" }
+ end critical ! { dg-error "Expecting END SUBROUTINE statement" }
+ sync all ! { dg-error "Image control statement SYNC" }
+ error stop ! { dg-error "not allowed in PURE procedure" }
+end subroutine pureSub
+
+
+SUBROUTINE TEST
+ goto 10 ! { dg-warning "is not in the same block" }
+ CRITICAL
+ goto 5 ! OK
+5 continue ! { dg-warning "is not in the same block" }
+ goto 10 ! OK
+ goto 20 ! { dg-error "leaves CRITICAL construct" }
+ goto 30 ! { dg-error "leaves CRITICAL construct" }
+10 END CRITICAL ! { dg-warning "is not in the same block" }
+ goto 5 ! { dg-warning "is not in the same block" }
+20 continue ! { dg-error "leaves CRITICAL construct" }
+ BLOCK
+30 continue ! { dg-error "leaves CRITICAL construct" }
+ END BLOCK
+end SUBROUTINE TEST
+2010-04-06 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/39997
+ * runtime/stop.c (error_stop_string): New function.
+ * gfortran.map (_gfortran_error_stop_string): Add.
+
2010-04-02 Ralf Wildenhues <Ralf.Wildenhues@gmx.de>
* Makefile.in: Regenerate.
PR libfortran/43605
* io/intrinsics.c (gf_ftell): New function, seek to correct offset.
- (ftell): Call gf_ftell.
+ (ftell): Call gf_ftell.
(FTELL_SUB): Likewise.
2010-04-01 Paul Thomas <pault@gcc.gnu.org>
_gfortran_is_extension_of;
} GFORTRAN_1.1;
+GFORTRAN_1.3 {
+ global:
+ _gfortran_error_stop_string;
+} GFORTRAN_1.2;
+
F2C_1.0 {
global:
_gfortran_f2c_specific__abs_c4;
/* Implementation of the STOP statement.
- Copyright 2002, 2005, 2007, 2009 Free Software Foundation, Inc.
+ Copyright 2002, 2005, 2007, 2009, 2010 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of the GNU Fortran 95 runtime library (libgfortran).
sys_exit (0);
}
+
+extern void error_stop_string (const char *, GFC_INTEGER_4);
+export_proto(error_stop_string);
+
+
+/* Per Fortran 2008, section 8.4: "Execution of a STOP statement initiates
+ normal termination of execution. Execution of an ERROR STOP statement
+ initiates error termination of execution." Thus, error_stop_string returns
+ a nonzero exit status code. */
+void
+error_stop_string (const char *string, GFC_INTEGER_4 len)
+{
+ st_printf ("ERROR STOP ");
+ while (len--)
+ st_printf ("%c", *(string++));
+ st_printf ("\n");
+
+ sys_exit (1);
+}
OSDN Git Service
