Mercurial > hg > octave-lyh
view src/pt-eval.cc @ 12011:67ad3b58b99a release-3-2-x
improve error handling
author | Jaroslav Hajek <highegg@gmail.com> |
---|---|
date | Wed, 24 Jun 2009 07:31:32 +0200 |
parents | eabdfcc977f1 |
children | 664597f88284 |
line wrap: on
line source
/* Copyright (C) 2009 John W. Eaton This file is part of Octave. Octave is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3 of the License, or (at your option) any later version. Octave is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with Octave; see the file COPYING. If not, see <http://www.gnu.org/licenses/>. */ #ifdef HAVE_CONFIG_H #include <config.h> #endif #include <cctype> #include <iostream> #include <fstream> #include <typeinfo> #include "defun.h" #include "error.h" #include "gripes.h" #include "input.h" #include "ov-fcn-handle.h" #include "ov-usr-fcn.h" #include "variables.h" #include "pt-all.h" #include "pt-eval.h" #include "symtab.h" #include "unwind-prot.h" static tree_evaluator std_evaluator; tree_evaluator *current_evaluator = &std_evaluator; int tree_evaluator::dbstep_flag = 0; size_t tree_evaluator::current_frame = 0; bool tree_evaluator::debug_mode = false; bool tree_evaluator::in_fcn_or_script_body = false; bool tree_evaluator::in_loop_command = false; int tree_evaluator::db_line = -1; int tree_evaluator::db_column = -1; // If TRUE, turn off printing of results in functions (as if a // semicolon has been appended to each statement). static bool Vsilent_functions = false; // Normal evaluator. void tree_evaluator::visit_anon_fcn_handle (tree_anon_fcn_handle&) { panic_impossible (); } void tree_evaluator::visit_argument_list (tree_argument_list&) { panic_impossible (); } void tree_evaluator::visit_binary_expression (tree_binary_expression&) { panic_impossible (); } void tree_evaluator::visit_break_command (tree_break_command& cmd) { if (! error_state) { if (debug_mode) do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ()); tree_break_command::breaking = 1; } } void tree_evaluator::visit_colon_expression (tree_colon_expression&) { panic_impossible (); } void tree_evaluator::visit_continue_command (tree_continue_command&) { if (! error_state) tree_continue_command::continuing = 1; } static inline void do_global_init (tree_decl_elt& elt) { tree_identifier *id = elt.ident (); if (id) { id->mark_global (); if (! error_state) { octave_lvalue ult = id->lvalue (); if (ult.is_undefined ()) { tree_expression *expr = elt.expression (); octave_value init_val; if (expr) init_val = expr->rvalue1 (); else init_val = Matrix (); ult.assign (octave_value::op_asn_eq, init_val); } } } } static inline void do_static_init (tree_decl_elt& elt) { tree_identifier *id = elt.ident (); if (id) { id->mark_as_static (); octave_lvalue ult = id->lvalue (); if (ult.is_undefined ()) { tree_expression *expr = elt.expression (); octave_value init_val; if (expr) init_val = expr->rvalue1 (); else init_val = Matrix (); ult.assign (octave_value::op_asn_eq, init_val); } } } void tree_evaluator::do_decl_init_list (decl_elt_init_fcn fcn, tree_decl_init_list *init_list) { if (init_list) { for (tree_decl_init_list::iterator p = init_list->begin (); p != init_list->end (); p++) { tree_decl_elt *elt = *p; fcn (*elt); if (error_state) break; } } } void tree_evaluator::visit_global_command (tree_global_command& cmd) { if (debug_mode) do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ()); do_decl_init_list (do_global_init, cmd.initializer_list ()); } void tree_evaluator::visit_static_command (tree_static_command& cmd) { if (debug_mode) do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ()); do_decl_init_list (do_static_init, cmd.initializer_list ()); } void tree_evaluator::visit_decl_elt (tree_decl_elt&) { panic_impossible (); } #if 0 bool tree_decl_elt::eval (void) { bool retval = false; if (id && expr) { octave_lvalue ult = id->lvalue (); octave_value init_val = expr->rvalue1 (); if (! error_state) { ult.assign (octave_value::op_asn_eq, init_val); retval = true; } } return retval; } #endif void tree_evaluator::visit_decl_init_list (tree_decl_init_list&) { panic_impossible (); } // Decide if it's time to quit a for or while loop. static inline bool quit_loop_now (void) { OCTAVE_QUIT; // Maybe handle `continue N' someday... if (tree_continue_command::continuing) tree_continue_command::continuing--; bool quit = (error_state || tree_return_command::returning || tree_break_command::breaking || tree_continue_command::continuing); if (tree_break_command::breaking) tree_break_command::breaking--; return quit; } #define DO_SIMPLE_FOR_LOOP_ONCE(VAL) \ do \ { \ ult.assign (octave_value::op_asn_eq, VAL); \ \ if (! error_state && loop_body) \ loop_body->accept (*this); \ \ quit = quit_loop_now (); \ } \ while (0) void tree_evaluator::visit_simple_for_command (tree_simple_for_command& cmd) { if (error_state) return; if (debug_mode) do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ()); unwind_protect::begin_frame ("tree_evaluator::visit_simple_for_command"); unwind_protect_bool (in_loop_command); in_loop_command = true; tree_expression *expr = cmd.control_expr (); octave_value rhs = expr->rvalue1 (); if (error_state || rhs.is_undefined ()) goto cleanup; { tree_expression *lhs = cmd.left_hand_side (); octave_lvalue ult = lhs->lvalue (); if (error_state) goto cleanup; tree_statement_list *loop_body = cmd.body (); if (rhs.is_range ()) { Range rng = rhs.range_value (); octave_idx_type steps = rng.nelem (); double b = rng.base (); double increment = rng.inc (); bool quit = false; for (octave_idx_type i = 0; i < steps; i++) { // Use multiplication here rather than declaring a // temporary variable outside the loop and using // // tmp_val += increment // // to avoid problems with limited precision. Also, this // is consistent with the way Range::matrix_value is // implemented. octave_value val (b + i * increment); DO_SIMPLE_FOR_LOOP_ONCE (val); if (quit) break; } } else if (rhs.is_scalar_type ()) { bool quit = false; DO_SIMPLE_FOR_LOOP_ONCE (rhs); } else if (rhs.is_matrix_type () || rhs.is_cell () || rhs.is_string () || rhs.is_map ()) { // A matrix or cell is reshaped to 2 dimensions and iterated by // columns. bool quit = false; dim_vector dv = rhs.dims ().redim (2); octave_idx_type nrows = dv(0), steps = dv(1); if (steps > 0) { octave_value arg = rhs; if (rhs.ndims () > 2) arg = arg.reshape (dv); // for row vectors, use single index to speed things up. octave_value_list idx; octave_idx_type iidx; if (nrows == 1) { idx.resize (1); iidx = 0; } else { idx.resize (2); idx(0) = octave_value::magic_colon_t; iidx = 1; } for (octave_idx_type i = 1; i <= steps; i++) { // do_index_op expects one-based indices. idx(iidx) = i; octave_value val = arg.do_index_op (idx); DO_SIMPLE_FOR_LOOP_ONCE (val); if (quit) break; } } } else { ::error ("invalid type in for loop expression near line %d, column %d", cmd.line (), cmd.column ()); } } cleanup: unwind_protect::run_frame ("tree_evaluator::visit_simple_for_command"); } void tree_evaluator::visit_complex_for_command (tree_complex_for_command& cmd) { if (error_state) return; if (debug_mode) do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ()); unwind_protect::begin_frame ("tree_evaluator::visit_complex_for_command"); unwind_protect_bool (in_loop_command); in_loop_command = true; tree_expression *expr = cmd.control_expr (); octave_value rhs = expr->rvalue1 (); if (error_state || rhs.is_undefined ()) goto cleanup; if (rhs.is_map ()) { // Cycle through structure elements. First element of id_list // is set to value and the second is set to the name of the // structure element. tree_argument_list *lhs = cmd.left_hand_side (); tree_argument_list::iterator p = lhs->begin (); tree_expression *elt = *p++; octave_lvalue val_ref = elt->lvalue (); elt = *p; octave_lvalue key_ref = elt->lvalue (); const Octave_map tmp_val (rhs.map_value ()); tree_statement_list *loop_body = cmd.body (); for (Octave_map::const_iterator q = tmp_val.begin (); q != tmp_val.end (); q++) { octave_value key = tmp_val.key (q); const Cell val_lst = tmp_val.contents (q); octave_idx_type n = tmp_val.numel (); octave_value val = (n == 1) ? val_lst(0) : octave_value (val_lst); val_ref.assign (octave_value::op_asn_eq, val); key_ref.assign (octave_value::op_asn_eq, key); if (! error_state && loop_body) loop_body->accept (*this); if (quit_loop_now ()) break; } } else error ("in statement `for [X, Y] = VAL', VAL must be a structure"); cleanup: unwind_protect::run_frame ("tree_evaluator::visit_complex_for_command"); } void tree_evaluator::visit_octave_user_script (octave_user_script&) { panic_impossible (); } void tree_evaluator::visit_octave_user_function (octave_user_function&) { panic_impossible (); } void tree_evaluator::visit_octave_user_function_header (octave_user_function&) { panic_impossible (); } void tree_evaluator::visit_octave_user_function_trailer (octave_user_function&) { panic_impossible (); } void tree_evaluator::visit_function_def (tree_function_def& cmd) { octave_value fcn = cmd.function (); octave_function *f = fcn.function_value (); if (f) { std::string nm = f->name (); symbol_table::install_cmdline_function (nm, fcn); // Make sure that any variable with the same name as the new // function is cleared. symbol_table::varref (nm) = octave_value (); } } void tree_evaluator::visit_identifier (tree_identifier&) { panic_impossible (); } void tree_evaluator::visit_if_clause (tree_if_clause&) { panic_impossible (); } void tree_evaluator::visit_if_command (tree_if_command& cmd) { tree_if_command_list *lst = cmd.cmd_list (); if (lst) lst->accept (*this); } void tree_evaluator::visit_if_command_list (tree_if_command_list& lst) { for (tree_if_command_list::iterator p = lst.begin (); p != lst.end (); p++) { tree_if_clause *tic = *p; tree_expression *expr = tic->condition (); if (debug_mode && ! tic->is_else_clause ()) do_breakpoint (tic->is_breakpoint (), tic->line (), tic->column ()); if (tic->is_else_clause () || expr->is_logically_true ("if")) { if (! error_state) { tree_statement_list *stmt_lst = tic->commands (); if (stmt_lst) stmt_lst->accept (*this); } break; } } } void tree_evaluator::visit_index_expression (tree_index_expression&) { panic_impossible (); } void tree_evaluator::visit_matrix (tree_matrix&) { panic_impossible (); } void tree_evaluator::visit_cell (tree_cell&) { panic_impossible (); } void tree_evaluator::visit_multi_assignment (tree_multi_assignment&) { panic_impossible (); } void tree_evaluator::visit_no_op_command (tree_no_op_command& cmd) { if (debug_mode && cmd.is_end_of_fcn_or_script ()) do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column (), true); } void tree_evaluator::visit_constant (tree_constant&) { panic_impossible (); } void tree_evaluator::visit_fcn_handle (tree_fcn_handle&) { panic_impossible (); } void tree_evaluator::visit_parameter_list (tree_parameter_list&) { panic_impossible (); } void tree_evaluator::visit_postfix_expression (tree_postfix_expression&) { panic_impossible (); } void tree_evaluator::visit_prefix_expression (tree_prefix_expression&) { panic_impossible (); } void tree_evaluator::visit_return_command (tree_return_command& cmd) { if (! error_state) { if (debug_mode) do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ()); tree_return_command::returning = 1; } } void tree_evaluator::visit_return_list (tree_return_list&) { panic_impossible (); } void tree_evaluator::visit_simple_assignment (tree_simple_assignment&) { panic_impossible (); } void tree_evaluator::visit_statement (tree_statement& stmt) { tree_command *cmd = stmt.command (); tree_expression *expr = stmt.expression (); if (cmd || expr) { if (in_fcn_or_script_body) { octave_call_stack::set_statement (&stmt); if (Vecho_executing_commands & ECHO_FUNCTIONS) stmt.echo_code (); } try { if (cmd) cmd->accept (*this); else { if (debug_mode) do_breakpoint (expr->is_breakpoint (), expr->line (), expr->column ()); if (in_fcn_or_script_body && Vsilent_functions) expr->set_print_flag (false); // FIXME -- maybe all of this should be packaged in // one virtual function that returns a flag saying whether // or not the expression will take care of binding ans and // printing the result. // FIXME -- it seems that we should just have to // call expr->rvalue1 () and that should take care of // everything, binding ans as necessary? bool do_bind_ans = false; if (expr->is_identifier ()) { tree_identifier *id = dynamic_cast<tree_identifier *> (expr); do_bind_ans = (! id->is_variable ()); } else do_bind_ans = (! expr->is_assignment_expression ()); octave_value tmp_result = expr->rvalue1 (0); if (do_bind_ans && ! (error_state || tmp_result.is_undefined ())) bind_ans (tmp_result, expr->print_result ()); // if (tmp_result.is_defined ()) // result_values(0) = tmp_result; } } catch (octave_execution_exception) { gripe_library_execution_error (); } } } void tree_evaluator::visit_statement_list (tree_statement_list& lst) { static octave_value_list empty_list; if (error_state) return; tree_statement_list::iterator p = lst.begin (); if (p != lst.end ()) { while (true) { tree_statement *elt = *p++; if (elt) { OCTAVE_QUIT; elt->accept (*this); if (error_state) break; if (tree_break_command::breaking || tree_continue_command::continuing) break; if (tree_return_command::returning) break; if (p == lst.end ()) break; else { // Clear preivous values before next statement is // evaluated so that we aren't holding an extra // reference to a value that may be used next. For // example, in code like this: // // X = rand (N); ## refcount for X should be 1 // ## after this statement // // X(idx) = val; ## no extra copy of X should be // ## needed, but we will be faked // ## out if retval is not cleared // ## between statements here // result_values = empty_list; } } else error ("invalid statement found in statement list!"); } } } void tree_evaluator::visit_switch_case (tree_switch_case&) { panic_impossible (); } void tree_evaluator::visit_switch_case_list (tree_switch_case_list&) { panic_impossible (); } void tree_evaluator::visit_switch_command (tree_switch_command& cmd) { tree_expression *expr = cmd.switch_value (); if (expr) { octave_value val = expr->rvalue1 (); tree_switch_case_list *lst = cmd.case_list (); if (! error_state && lst) { for (tree_switch_case_list::iterator p = lst->begin (); p != lst->end (); p++) { tree_switch_case *t = *p; if (debug_mode && ! t->is_default_case ()) do_breakpoint (t->is_breakpoint (), t->line (), t->column ()); if (t->is_default_case () || t->label_matches (val)) { if (error_state) break; tree_statement_list *stmt_lst = t->commands (); if (stmt_lst) stmt_lst->accept (*this); break; } } } } else ::error ("missing value in switch command near line %d, column %d", cmd.line (), cmd.column ()); } static void do_catch_code (void *ptr) { // Is it safe to call OCTAVE_QUIT here? We are already running // something on the unwind_protect stack, but the element for this // action would have already been popped from the top of the stack, // so we should not be attempting to run it again. OCTAVE_QUIT; // If we are interrupting immediately, or if an interrupt is in // progress (octave_interrupt_state < 0), then we don't want to run // the catch code (it should only run on errors, not interrupts). // If octave_interrupt_state is positive, an interrupt is pending. // The only way that could happen would be for the interrupt to // come in after the OCTAVE_QUIT above and before the if statement // below -- it's possible, but unlikely. In any case, we should // probably let the catch code throw the exception because we don't // want to skip that and potentially run some other code. For // example, an error may have originally brought us here for some // cleanup operation and we shouldn't skip that. if (octave_interrupt_immediately || octave_interrupt_state < 0) return; tree_statement_list *list = static_cast<tree_statement_list *> (ptr); // Set up for letting the user print any messages from errors that // occurred in the body of the try_catch statement. buffer_error_messages--; if (list) list->accept (*current_evaluator); } void tree_evaluator::visit_try_catch_command (tree_try_catch_command& cmd) { unwind_protect::begin_frame ("tree_evaluator::visit_try_catch_command"); unwind_protect_int (buffer_error_messages); unwind_protect_bool (Vdebug_on_error); unwind_protect_bool (Vdebug_on_warning); buffer_error_messages++; Vdebug_on_error = false; Vdebug_on_warning = false; tree_statement_list *catch_code = cmd.cleanup (); unwind_protect::add (do_catch_code, catch_code); tree_statement_list *try_code = cmd.body (); if (try_code) try_code->accept (*this); if (catch_code && error_state) { error_state = 0; unwind_protect::run_frame ("tree_evaluator::visit_try_catch_command"); } else { error_state = 0; // Unwind stack elements must be cleared or run in the reverse // order in which they were added to the stack. // For clearing the do_catch_code cleanup function. unwind_protect::discard (); // For restoring Vdebug_on_warning, Vdebug_on_error, and // buffer_error_messages. unwind_protect::run (); unwind_protect::run (); unwind_protect::run (); // Also clear the frame marker. unwind_protect::discard (); } } static void do_unwind_protect_cleanup_code (void *ptr) { tree_statement_list *list = static_cast<tree_statement_list *> (ptr); unwind_protect_int (octave_interrupt_state); octave_interrupt_state = 0; // We want to run the cleanup code without error_state being set, // but we need to restore its value, so that any errors encountered // in the first part of the unwind_protect are not completely // ignored. unwind_protect_int (error_state); error_state = 0; // Similarly, if we have seen a return or break statement, allow all // the cleanup code to run before returning or handling the break. // We don't have to worry about continue statements because they can // only occur in loops. unwind_protect_int (tree_return_command::returning); tree_return_command::returning = 0; unwind_protect_int (tree_break_command::breaking); tree_break_command::breaking = 0; if (list) list->accept (*current_evaluator); // The unwind_protects are popped off the stack in the reverse of // the order they are pushed on. // FIXME -- these statements say that if we see a break or // return statement in the cleanup block, that we want to use the // new value of the breaking or returning flag instead of restoring // the previous value. Is that the right thing to do? I think so. // Consider the case of // // function foo () // unwind_protect // stderr << "1: this should always be executed\n"; // break; // stderr << "1: this should never be executed\n"; // unwind_protect_cleanup // stderr << "2: this should always be executed\n"; // return; // stderr << "2: this should never be executed\n"; // end_unwind_protect // endfunction // // If we reset the value of the breaking flag, both the returning // flag and the breaking flag will be set, and we shouldn't have // both. So, use the most recent one. If there is no return or // break in the cleanup block, the values should be reset to // whatever they were when the cleanup block was entered. if (tree_break_command::breaking || tree_return_command::returning) { unwind_protect::discard (); unwind_protect::discard (); } else { unwind_protect::run (); unwind_protect::run (); } // We don't want to ignore errors that occur in the cleanup code, so // if an error is encountered there, leave error_state alone. // Otherwise, set it back to what it was before. if (error_state) unwind_protect::discard (); else unwind_protect::run (); } void tree_evaluator::visit_unwind_protect_command (tree_unwind_protect_command& cmd) { tree_statement_list *cleanup_code = cmd.cleanup (); unwind_protect::add (do_unwind_protect_cleanup_code, cleanup_code); tree_statement_list *unwind_protect_code = cmd.body (); if (unwind_protect_code) unwind_protect_code->accept (*this); unwind_protect::run (); } void tree_evaluator::visit_while_command (tree_while_command& cmd) { if (error_state) return; unwind_protect::begin_frame ("tree_evaluator::visit_while_command"); unwind_protect_bool (in_loop_command); in_loop_command = true; tree_expression *expr = cmd.condition (); if (! expr) panic_impossible (); int l = expr->line (); int c = expr->column (); for (;;) { if (debug_mode) do_breakpoint (cmd.is_breakpoint (), l, c); if (expr->is_logically_true ("while")) { tree_statement_list *loop_body = cmd.body (); if (loop_body) { loop_body->accept (*this); if (error_state) goto cleanup; } if (quit_loop_now ()) break; } else break; } cleanup: unwind_protect::run_frame ("tree_evaluator::visit_while_command"); } void tree_evaluator::visit_do_until_command (tree_do_until_command& cmd) { if (error_state) return; unwind_protect::begin_frame ("tree_evaluator::visit_do_until_command"); unwind_protect_bool (in_loop_command); in_loop_command = true; tree_expression *expr = cmd.condition (); if (! expr) panic_impossible (); int l = expr->line (); int c = expr->column (); for (;;) { tree_statement_list *loop_body = cmd.body (); if (loop_body) { loop_body->accept (*this); if (error_state) goto cleanup; } if (quit_loop_now ()) break; if (debug_mode) do_breakpoint (cmd.is_breakpoint (), l, c); if (expr->is_logically_true ("do-until")) break; } cleanup: unwind_protect::run_frame ("tree_evaluator::visit_do_until_command"); } void tree_evaluator::do_breakpoint (tree_statement& stmt) const { do_breakpoint (stmt.is_breakpoint (), stmt.line (), stmt.column (), stmt.is_end_of_fcn_or_script ()); } void tree_evaluator::do_breakpoint (bool is_breakpoint, int l, int c, bool is_end_of_fcn_or_script) const { bool break_on_this_statement = false; // Don't decrement break flag unless we are in the same frame as we // were when we saw the "dbstep N" command. if (dbstep_flag > 1) { if (octave_call_stack::current_frame () == current_frame) { // Don't allow dbstep N to step past end of current frame. if (is_end_of_fcn_or_script) dbstep_flag = 1; else dbstep_flag--; } } if (octave_debug_on_interrupt_state) { break_on_this_statement = true; octave_debug_on_interrupt_state = false; current_frame = octave_call_stack::current_frame (); } else if (is_breakpoint) { break_on_this_statement = true; dbstep_flag = 0; current_frame = octave_call_stack::current_frame (); } else if (dbstep_flag == 1) { if (octave_call_stack::current_frame () == current_frame) { // We get here if we are doing a "dbstep" or a "dbstep N" // and the count has reached 1 and we are in the current // debugging frame. break_on_this_statement = true; dbstep_flag = 0; } } else if (dbstep_flag == -1) { // We get here if we are doing a "dbstep in". break_on_this_statement = true; dbstep_flag = 0; current_frame = octave_call_stack::current_frame (); } else if (dbstep_flag == -2) { // We get here if we are doing a "dbstep out". if (is_end_of_fcn_or_script) dbstep_flag = -1; } if (break_on_this_statement) { octave_function *xfcn = octave_call_stack::current (); if (xfcn) std::cerr << xfcn->name () << ": "; std::cerr << "line " << l << ", " << "column " << c << std::endl; db_line = l; db_column = c; // FIXME -- probably we just want to print one line, not the // entire statement, which might span many lines... // // tree_print_code tpc (octave_stdout); // stmt.accept (tpc); do_keyboard (); } } DEFUN (silent_functions, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} silent_functions ()\n\ @deftypefnx {Built-in Function} {@var{old_val} =} silent_functions (@var{new_val})\n\ Query or set the internal variable that controls whether internal\n\ output from a function is suppressed. If this option is disabled,\n\ Octave will display the results produced by evaluating expressions\n\ within a function body that are not terminated with a semicolon.\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (silent_functions); } /* ;;; Local Variables: *** ;;; mode: C++ *** ;;; End: *** */