Peter Schorn wrote:
Waldek Hebisch wrote:
Peter Schorn wrote:
are there any plans to make non-local exits out of a method legal? This works in CodeWarrior Pascal and looks somehow better than a goto. The following program illustrates the issue: I could not find a way to make a non-local exit out of q using the exit statement.
<snip>
Should be easy. Does CodeWarrior support both forms?
CodeWarrior only supports the first form (exit(p)).
OK. The following patch (to may current version, but should work with gpc-20060215) should do this:
Index: parse.y =================================================================== RCS file: /mn/a8/cvsroot/gpc/p/parse.y,v retrieving revision 1.13 diff -u -p -r1.13 parse.y --- parse.y 7 Mar 2006 16:56:39 -0000 1.13 +++ parse.y 9 Mar 2006 00:38:30 -0000 @@ -1515,6 +1515,8 @@ unlabelled_statement: { build_predef_call (p_Exit, build_tree_list (NULL_TREE, void_type_node)); } | p_Exit '(' id ')' { build_predef_call (p_Exit, build_tree_list (NULL_TREE, $3)); } + | p_Exit '(' id '.' id ')' + { build_predef_call (p_Exit, build_tree_list ($3, $5)); } | builtin_procedure_statement | p_with with_list p_do pushlevel optional_statement poplevel { restore_identifiers ($2); } Index: predef.c =================================================================== RCS file: /mn/a8/cvsroot/gpc/p/predef.c,v retrieving revision 1.12 diff -u -p -r1.12 predef.c --- predef.c 6 Mar 2006 12:18:41 -0000 1.12 +++ predef.c 9 Mar 2006 01:14:13 -0000 @@ -1216,18 +1216,44 @@ build_predef_call (int r_num, tree apar) if (r_num == p_Exit && apar) { tree id = TREE_VALUE (apar); + tree obn = TREE_PURPOSE (apar); apar = NULL_TREE; - chk_dialect ("`Exit' with an argument is", U_M_PASCAL); + if (obn) + chk_dialect ("`Exit' with a qualified indentifier as an argument is", + GNU_PASCAL); + else + chk_dialect ("`Exit' with an argument is", U_M_PASCAL); if (id == void_type_node || (current_module->main_program && id == current_module->name)) r_num = p_Halt; - else if (!(current_function_decl && id == DECL_NAME (current_function_decl))) + else if (!(current_function_decl && !obn + && id == DECL_NAME (current_function_decl))) { - struct function *p; + struct function *p = outer_function_chain; + while (p) + { + if (!obn && DECL_NAME (p->decl) == id) + break; + if (PASCAL_METHOD (p->decl)) + { + tree ot = DECL_CONTEXT (p->decl); + tree on, mn; + gcc_assert (ot && PASCAL_TYPE_OBJECT (ot)); + if (TYPE_POINTER_TO (ot) && + PASCAL_TYPE_CLASS (TYPE_POINTER_TO (ot))) + ot = TYPE_POINTER_TO (ot); + on = DECL_NAME (TYPE_NAME (TYPE_MAIN_VARIANT (ot))); + if (obn && on != obn) + continue; + mn = get_method_name (on, id); + if (mn == DECL_NAME (p->decl)) + break; + } #ifdef EGCS97 - for (p = outer_function_chain; p && DECL_NAME (p->decl) != id; p = p->outer) ; + p = p->outer; #else - for (p = outer_function_chain; p && DECL_NAME (p->decl) != id; p = p->next) ; + p = p->next; #endif + } if (!p) error ("invalid argument `%s' to `Exit'", IDENTIFIER_NAME (id)); else if (DECL_LANG_SPECIFIC (p->decl) && DECL_LANG_NONLOCAL_EXIT_LABEL (p->decl))