From: pault Date: Mon, 30 Mar 2009 19:35:14 +0000 (+0000) Subject: 2009-03-30 Paul Thomas X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=83aeedb979b2d203e4135bb55fa0c07e5b250635 2009-03-30 Paul Thomas PR fortran/22571 PR fortran/26227 PR fortran/24886 * symbol.c : Add gfc_global_ns_list. * decl.c (add_global_entry): Set the namespace ('ns') field. * gfortran.h : Add the resolved field to gfc_namespace. Add the namespace ('ns') field to gfc_gsymbol. Add flag_whole_file to gfc_option_t. Add the prototype for gfc_free_dt_list. * lang.opt : Add the whole-file option. * invoke.texi : Document the whole-file option. * resolve.c (resolve_global_procedure): If the fwhole-file option is set, reorder gsymbols to ensure that translation is in the right order. Resolve the gsymbol's namespace if that has not occurred and then check interfaces. (resolve_function): Move call to resolve_global_procedure. (resolve_call): The same. (resolve_codes): Store the current labels_obstack. (gfc_resolve) : Return if the namespace is already resolved. trans-decl.c (gfc_get_extern_function_decl): If the whole_file option is selected, use the backend_decl of a gsymbol, if it is available. parse.c (add_global_procedure, add_global_program): If the flag whole-file is set, add the namespace to the gsymbol. (gfc_parse_file): On -fwhole-file, put procedure namespaces on the global namespace list. Rearrange to do resolution of all the procedures in a file, followed by their translation. * options.c (gfc_init_options): Add -fwhole-file. (gfc_handle_option): The same. 2009-03-30 Paul Thomas PR fortran/22571 * gfortran.dg/whole_file_1.f90: New test. PR fortran/26227 * gfortran.dg/whole_file_2.f90: New test. * gfortran.dg/whole_file_3.f90: New test. PR fortran/24886 * gfortran.dg/whole_file_4.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@145314 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 51f82c5a39b..28764ec69ce 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,34 @@ +2009-03-30 Paul Thomas + + PR fortran/22571 + PR fortran/26227 + PR fortran/24886 + * symbol.c : Add gfc_global_ns_list. + * decl.c (add_global_entry): Set the namespace ('ns') field. + * gfortran.h : Add the resolved field to gfc_namespace. Add the + namespace ('ns') field to gfc_gsymbol. Add flag_whole_file to + gfc_option_t. Add the prototype for gfc_free_dt_list. + * lang.opt : Add the whole-file option. + * invoke.texi : Document the whole-file option. + * resolve.c (resolve_global_procedure): If the fwhole-file + option is set, reorder gsymbols to ensure that translation is + in the right order. Resolve the gsymbol's namespace if that + has not occurred and then check interfaces. + (resolve_function): Move call to resolve_global_procedure. + (resolve_call): The same. + (resolve_codes): Store the current labels_obstack. + (gfc_resolve) : Return if the namespace is already resolved. + trans-decl.c (gfc_get_extern_function_decl): If the whole_file + option is selected, use the backend_decl of a gsymbol, if it is + available. + parse.c (add_global_procedure, add_global_program): If the flag + whole-file is set, add the namespace to the gsymbol. + (gfc_parse_file): On -fwhole-file, put procedure namespaces on + the global namespace list. Rearrange to do resolution of all + the procedures in a file, followed by their translation. + * options.c (gfc_init_options): Add -fwhole-file. + (gfc_handle_option): The same. + 2009-03-30 Ulrich Weigand * f95-lang.c (gfc_init_builtin_functions): Define BUILT_IN_HUGE_VAL diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 54a32f173af..1e83d21bbe0 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -4530,6 +4530,7 @@ add_global_entry (const char *name, int sub) s->type = type; s->where = gfc_current_locus; s->defined = 1; + s->ns = gfc_current_ns; return true; } return false; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 3a7f98a8792..7ea9aa7b243 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1306,10 +1306,14 @@ typedef struct gfc_namespace /* Set to 1 if namespace is an interface body with "IMPORT" used. */ int has_import_set; + + /* Set to 1 if resolved has been called for this namespace. */ + int resolved; } gfc_namespace; extern gfc_namespace *gfc_current_ns; +extern gfc_namespace *gfc_global_ns_list; /* Global symbols are symbols of global scope. Currently we only use this to detect collisions already when parsing. @@ -1328,6 +1332,7 @@ typedef struct gfc_gsymbol int defined, used; locus where; + gfc_namespace *ns; } gfc_gsymbol; @@ -2027,6 +2032,7 @@ typedef struct int flag_init_character; char flag_init_character_value; int flag_align_commons; + int flag_whole_file; int fpe; int rtcheck; @@ -2354,6 +2360,8 @@ void gfc_traverse_user_op (gfc_namespace *, void (*)(gfc_user_op *)); void gfc_save_all (gfc_namespace *); void gfc_symbol_state (void); +void gfc_free_dt_list (void); + gfc_gsymbol *gfc_get_gsymbol (const char *); gfc_gsymbol *gfc_find_gsymbol (gfc_gsymbol *, const char *); diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index a263a150c82..e49297d3aaa 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -164,7 +164,7 @@ and warnings}. @item Code Generation Options @xref{Code Gen Options,,Options for code generation conventions}. @gccoptlist{-fno-automatic -ff2c -fno-underscoring @gol --fsecond-underscore @gol +-fwhole-file -fsecond-underscore @gol -fbounds-check -fcheck-array-temporaries -fmax-array-constructor =@var{n} @gol -fcheck=@var{} -fmax-stack-var-size=@var{n} @gol @@ -1158,6 +1158,19 @@ in the source, even if the names as seen by the linker are mangled to prevent accidental linking between procedures with incompatible interfaces. +@item -fwhole-file +@opindex @code{fwhole-file} +By default, GNU Fortran parses, resolves and translates each procedure +in a file separately. Using this option modifies this such that the +whole file is parsed and placed in a single front-end tree. During +resolution, in addition to all the usual checks and fixups, references +to external procedures that are in the same file effect resolution of +that procedure, if not already done, and a check of the interfaces. The +dependences are resolved by changing the order in which the file is +translated into the backend tree. Thus, a procedure that is referenced +is translated before the reference and the duplication of backend tree +declarations eliminated. + @item -fsecond-underscore @opindex @code{fsecond-underscore} @cindex underscore diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 193604a2fe3..9da290c81fa 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -360,6 +360,10 @@ funderscoring Fortran Append underscores to externally visible names +fwhole-file +Fortran +Compile all program units at once and check all interfaces + fworking-directory Fortran ; Documented in C diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 17c577d38be..b45696ddf35 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -93,6 +93,7 @@ gfc_init_options (unsigned int argc, const char **argv) gfc_option.flag_default_real = 0; gfc_option.flag_dollar_ok = 0; gfc_option.flag_underscoring = 1; + gfc_option.flag_whole_file = 0; gfc_option.flag_f2c = 0; gfc_option.flag_second_underscore = -1; gfc_option.flag_implicit_none = 0; @@ -673,6 +674,10 @@ gfc_handle_option (size_t scode, const char *arg, int value) gfc_option.flag_underscoring = value; break; + case OPT_fwhole_file: + gfc_option.flag_whole_file = 1; + break; + case OPT_fsecond_underscore: gfc_option.flag_second_underscore = value; break; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 0800fc1ec68..19251984c1d 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -3715,6 +3715,7 @@ add_global_procedure (int sub) s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; s->where = gfc_current_locus; s->defined = 1; + s->ns = gfc_current_ns; } } @@ -3737,6 +3738,7 @@ add_global_program (void) s->type = GSYM_PROGRAM; s->where = gfc_current_locus; s->defined = 1; + s->ns = gfc_current_ns; } } @@ -3750,6 +3752,7 @@ gfc_parse_file (void) gfc_state_data top, s; gfc_statement st; locus prog_locus; + gfc_namespace *next; gfc_start_source_files (); @@ -3768,6 +3771,10 @@ gfc_parse_file (void) if (setjmp (eof_buf)) return FAILURE; /* Come here on unexpected EOF */ + /* Prepare the global namespace that will contain the + program units. */ + gfc_global_ns_list = next = NULL; + seen_program = 0; /* Exit early for empty files. */ @@ -3794,6 +3801,8 @@ loop: accept_statement (st); add_global_program (); parse_progunit (ST_NONE); + if (gfc_option.flag_whole_file) + goto prog_units; break; case ST_SUBROUTINE: @@ -3801,6 +3810,8 @@ loop: push_state (&s, COMP_SUBROUTINE, gfc_new_block); accept_statement (st); parse_progunit (ST_NONE); + if (gfc_option.flag_whole_file) + goto prog_units; break; case ST_FUNCTION: @@ -3808,6 +3819,8 @@ loop: push_state (&s, COMP_FUNCTION, gfc_new_block); accept_statement (st); parse_progunit (ST_NONE); + if (gfc_option.flag_whole_file) + goto prog_units; break; case ST_BLOCK_DATA: @@ -3834,9 +3847,12 @@ loop: push_state (&s, COMP_PROGRAM, gfc_new_block); main_program_symbol (gfc_current_ns, "MAIN__"); parse_progunit (st); + if (gfc_option.flag_whole_file) + goto prog_units; break; } + /* Handle the non-program units. */ gfc_current_ns->code = s.head; gfc_resolve (gfc_current_ns); @@ -3862,7 +3878,56 @@ loop: gfc_done_2 (); goto loop; -done: +prog_units: + /* The main program and non-contained procedures are put + in the global namespace list, so that they can be processed + later and all their interfaces resolved. */ + gfc_current_ns->code = s.head; + if (next) + next->sibling = gfc_current_ns; + else + gfc_global_ns_list = gfc_current_ns; + + next = gfc_current_ns; + + pop_state (); + goto loop; + + done: + + if (!gfc_option.flag_whole_file) + goto termination; + + /* Do the resolution. */ + gfc_current_ns = gfc_global_ns_list; + for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) + { + gfc_current_locus = gfc_current_ns->proc_name->declared_at; + gfc_resolve (gfc_current_ns); + } + + /* Do the parse tree dump. */ + gfc_current_ns = gfc_option.dump_parse_tree ? gfc_global_ns_list : NULL; + for (; gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) + { + gfc_dump_parse_tree (gfc_current_ns, stdout); + fputs ("-----------------------------------------\n\n", stdout); + } + + gfc_current_ns = gfc_global_ns_list; + gfc_get_errors (NULL, &errors); + + /* Do the translation. This could be in a different order to + resolution if there are forward references in the file. */ + for (; !errors && gfc_current_ns; gfc_current_ns = gfc_current_ns->sibling) + { + gfc_current_locus = gfc_current_ns->proc_name->declared_at; + gfc_generate_code (gfc_current_ns); + } + +termination: + gfc_free_dt_list (); + gfc_end_source_files (); return SUCCESS; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b79e4851ea3..81d5ed8b1d0 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1582,12 +1582,19 @@ find_noncopying_intrinsics (gfc_symbol *fnsym, gfc_actual_arglist *actual) reference being resolved must correspond to the type of gsymbol. Otherwise, the new symbol is equipped with the attributes of the reference. The corresponding code that is called in creating - global entities is parse.c. */ + global entities is parse.c. + + In addition, for all but -std=legacy, the gsymbols are used to + check the interfaces of external procedures from the same file. + The namespace of the gsymbol is resolved and then, once this is + done the interface is checked. */ static void -resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) +resolve_global_procedure (gfc_symbol *sym, locus *where, + gfc_actual_arglist **actual, int sub) { gfc_gsymbol * gsym; + gfc_namespace *ns; unsigned int type; type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION; @@ -1597,6 +1604,32 @@ resolve_global_procedure (gfc_symbol *sym, locus *where, int sub) if ((gsym->type != GSYM_UNKNOWN && gsym->type != type)) gfc_global_used (gsym, where); + if (gfc_option.flag_whole_file + && gsym->type != GSYM_UNKNOWN + && gsym->ns + && gsym->ns->proc_name + && gsym->ns->proc_name->formal) + { + /* Make sure that translation for the gsymbol occurs before + the procedure currently being resolved. */ + ns = gsym->ns->resolved ? NULL : gfc_global_ns_list; + for (; ns && ns != gsym->ns; ns = ns->sibling) + { + if (ns->sibling == gsym->ns) + { + ns->sibling = gsym->ns->sibling; + gsym->ns->sibling = gfc_global_ns_list; + gfc_global_ns_list = gsym->ns; + break; + } + } + + if (!gsym->ns->resolved) + gfc_resolve (gsym->ns); + + gfc_procedure_use (gsym->ns->proc_name, actual, where); + } + if (gsym->type == GSYM_UNKNOWN) { gsym->type = type; @@ -2310,10 +2343,6 @@ resolve_function (gfc_expr *expr) return FAILURE; } - /* If the procedure is external, check for usage. */ - if (sym && is_external_proc (sym)) - resolve_global_procedure (sym, &expr->where, 0); - /* Switch off assumed size checking and do this again for certain kinds of procedure, once the procedure itself is resolved. */ need_full_assumed_size++; @@ -2342,6 +2371,11 @@ resolve_function (gfc_expr *expr) /* Resume assumed_size checking. */ need_full_assumed_size--; + /* If the procedure is external, check for usage. */ + if (sym && is_external_proc (sym)) + resolve_global_procedure (sym, &expr->where, + &expr->value.function.actual, 0); + if (sym && sym->ts.type == BT_CHARACTER && sym->ts.cl && sym->ts.cl->length == NULL @@ -2931,10 +2965,6 @@ resolve_call (gfc_code *c) } } - /* If external, check for usage. */ - if (csym && is_external_proc (csym)) - resolve_global_procedure (csym, &c->loc, 1); - /* Subroutines without the RECURSIVE attribution are not allowed to * call themselves. */ if (csym && is_illegal_recursion (csym, gfc_current_ns)) @@ -2965,6 +2995,10 @@ resolve_call (gfc_code *c) /* Resume assumed_size checking. */ need_full_assumed_size--; + /* If external, check for usage. */ + if (csym && is_external_proc (csym)) + resolve_global_procedure (csym, &c->loc, &c->ext.actual, 1); + t = SUCCESS; if (c->resolved_sym == NULL) { @@ -10559,6 +10593,7 @@ static void resolve_codes (gfc_namespace *ns) { gfc_namespace *n; + bitmap_obstack old_obstack; for (n = ns->contained; n; n = n->sibling) resolve_codes (n); @@ -10568,9 +10603,13 @@ resolve_codes (gfc_namespace *ns) /* Set to an out of range value. */ current_entry_id = -1; + old_obstack = labels_obstack; bitmap_obstack_initialize (&labels_obstack); + resolve_code (ns->code, ns); + bitmap_obstack_release (&labels_obstack); + labels_obstack = old_obstack; } @@ -10585,10 +10624,14 @@ gfc_resolve (gfc_namespace *ns) { gfc_namespace *old_ns; + if (ns->resolved) + return; + old_ns = gfc_current_ns; resolve_types (ns); resolve_codes (ns); gfc_current_ns = old_ns; + ns->resolved = 1; } diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index ca9d0a3fe53..788823503aa 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -93,6 +93,7 @@ static int next_dummy_order = 1; gfc_namespace *gfc_current_ns; +gfc_namespace *gfc_global_ns_list; gfc_gsymbol *gfc_gsym_root = NULL; @@ -2938,7 +2939,7 @@ free_sym_tree (gfc_symtree *sym_tree) /* Free the derived type list. */ -static void +void gfc_free_dt_list (void) { gfc_dt_list *dt, *n; diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index e7b52325495..2442fd214d1 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -4741,6 +4741,8 @@ get_array_charlen (gfc_expr *expr, gfc_se *se) { get_array_charlen (expr->value.op.op2, se); + gcc_assert (expr->value.op.op == INTRINSIC_CONCAT); + /* Add the string lengths and assign them to the expression string length backend declaration. */ gfc_add_modify (&se->pre, expr->ts.cl->backend_decl, diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 6cfc86a4bb7..774f42078da 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1221,6 +1221,7 @@ gfc_get_extern_function_decl (gfc_symbol * sym) char s[GFC_MAX_SYMBOL_LEN + 23]; /* "_gfortran_f2c_specific" and '\0'. */ tree name; tree mangled_name; + gfc_gsymbol *gsym; if (sym->backend_decl) return sym->backend_decl; @@ -1233,6 +1234,41 @@ gfc_get_extern_function_decl (gfc_symbol * sym) if (sym->attr.proc_pointer) return get_proc_pointer_decl (sym); + /* See if this is an external procedure from the same file. If so, + return the backend_decl. */ + gsym = gfc_find_gsymbol (gfc_gsym_root, sym->name); + + if (gfc_option.flag_whole_file + && !sym->backend_decl + && gsym && gsym->ns + && ((gsym->type == GSYM_SUBROUTINE) || (gsym->type == GSYM_FUNCTION)) + && gsym->ns->proc_name->backend_decl) + { + /* If the namespace has entries, the proc_name is the + entry master. Find the entry and use its backend_decl. + otherwise, use the proc_name backend_decl. */ + if (gsym->ns->entries) + { + gfc_entry_list *entry = gsym->ns->entries; + + for (; entry; entry = entry->next) + { + if (strcmp (gsym->name, entry->sym->name) == 0) + { + sym->backend_decl = entry->sym->backend_decl; + break; + } + } + } + else + { + sym->backend_decl = gsym->ns->proc_name->backend_decl; + } + + if (sym->backend_decl) + return sym->backend_decl; + } + if (sym->attr.intrinsic) { /* Call the resolution function to get the actual name. This is diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index cf19d16e87f..daa454456ae 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2009-03-30 Paul Thomas + + PR fortran/22571 + * gfortran.dg/whole_file_1.f90: New test. + PR fortran/26227 + * gfortran.dg/whole_file_2.f90: New test. + * gfortran.dg/whole_file_3.f90: New test. + PR fortran/24886 + * gfortran.dg/whole_file_4.f90: New test. + 2009-03-30 Jakub Jelinek * gfortran.dg/bind_c_usage_19.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/whole_file_1.f90 b/gcc/testsuite/gfortran.dg/whole_file_1.f90 new file mode 100644 index 00000000000..d7137eed013 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/whole_file_1.f90 @@ -0,0 +1,60 @@ +! { dg-do compile } +! { dg-options "-fwhole-file" } +! Tests the fix for PR22571 in which the derived types in a, b +! c and d were not detected to be different. In e and f, they +! are the same because they are sequence types. +! +! Contributed by Joost VandeVondele +! +subroutine a(p) + type t + integer :: t1 + end type + type(t) :: p + p%t1 = 42 +end subroutine + +subroutine b + type u + integer :: u1 + end type + type (u) :: q + call a(q) ! { dg-error "Type mismatch" } + print *, q%u1 +end subroutine + +subroutine c(p) + type u + integer :: u1 + end type + type(u) :: p + p%u1 = 42 +end subroutine + +subroutine d + type u + integer :: u1 + end type + type (u) :: q + call c(q) ! { dg-error "Type mismatch" } + print *, q%u1 +end subroutine + +subroutine e(p) + type u + sequence + integer :: u1 + end type + type(u) :: p + p%u1 = 42 +end subroutine + +subroutine f + type u + sequence + integer :: u1 + end type + type (u) :: q + call e(q) ! This is OK because the types are sequence. + print *, q%u1 +end subroutine diff --git a/gcc/testsuite/gfortran.dg/whole_file_2.f90 b/gcc/testsuite/gfortran.dg/whole_file_2.f90 new file mode 100644 index 00000000000..7f403522618 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/whole_file_2.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fwhole-file" } +! Tests the fix for PR26227 in which the interface mismatches +! below were not detected. +! +! Contributed by Andrew Pinski +! +function a(b) +REAL ::b +b = 2.0 +a = 1.0 +end function + +program gg +real :: h +character (5) :: chr = 'hello' +h = a(); ! { dg-error "Missing actual argument" } +call test ([chr]) ! { dg-error "Rank mismatch" } +end program gg + +subroutine test (a) + character (5) :: a + if (a .ne. 'hello') call abort +end subroutine test + diff --git a/gcc/testsuite/gfortran.dg/whole_file_3.f90 b/gcc/testsuite/gfortran.dg/whole_file_3.f90 new file mode 100644 index 00000000000..7ad762ccf97 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/whole_file_3.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-options "-fwhole-file" } +! Tests the fix for PR26227 in which the interface mismatches +! below were not detected. +! +! Contributed by Andrew Pinski +! + SUBROUTINE PHLOAD (READER,*) + IMPLICIT NONE + EXTERNAL READER + CALL READER (*1) + 1 RETURN 1 + END SUBROUTINE + + program test + EXTERNAL R + call PHLOAD (R, 1) ! { dg-error "Missing alternate return spec" } + CALL PHLOAD (R, 2) ! { dg-error "Missing alternate return spec" } + CALL PHLOAD (R, *999) ! This one is OK + 999 continue + END program test diff --git a/gcc/testsuite/gfortran.dg/whole_file_4.f90 b/gcc/testsuite/gfortran.dg/whole_file_4.f90 new file mode 100644 index 00000000000..671bc2db5d0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/whole_file_4.f90 @@ -0,0 +1,19 @@ +! { dg-do compile } +! { dg-options "-fwhole-file -std=legacy" } +! Tests the fix for PR24886 in which the mismatch between the +! character lengths of the actual and formal arguments of +! 'foo' was not detected. +! +! Contributed by Uttam Pawar +! + subroutine foo(y) + character(len=20) :: y + y = 'hello world' + end + + program test + character(len=10) :: x + call foo(x) ! { dg-warning "actual argument shorter" } + write(*,*) 'X=',x + pause + end