Mercurial > octave-antonio
diff src/pt-eval.cc @ 8658:73c4516fae10
New evaluator and debugger derived from tree-walker class
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Wed, 04 Feb 2009 00:47:53 -0500 |
parents | |
children | af72c8137d64 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/pt-eval.cc Wed Feb 04 00:47:53 2009 -0500 @@ -0,0 +1,1292 @@ +/* + +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; + +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&) +{ + if (! error_state) + 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) +{ + do_decl_init_list (do_global_init, cmd.initializer_list ()); +} + +void +tree_evaluator::visit_static_command (tree_static_command& cmd) +{ + 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) + +#define DO_ND_LOOP(MTYPE, TYPE, CONV, ARG) \ + do \ + { \ + dim_vector dv = ARG.dims (); \ + \ + bool quit = false; \ + \ + TYPE *atmp = ARG.fortran_vec (); \ + \ + octave_idx_type steps = dv(1); \ + \ + octave_idx_type nrows = dv(0); \ + \ + int ndims = dv.length (); \ + if (ndims > 2) \ + { \ + for (int i = 2; i < ndims; i++) \ + steps *= dv(i); \ + dv(1) = steps; \ + dv.resize (2); \ + } \ + \ + if (steps > 0) \ + { \ + if (nrows == 0) \ + { \ + MTYPE tarray (dim_vector (0, 1)); \ + \ + octave_value val (tarray); \ + \ + for (octave_idx_type i = 0; i < steps; i++) \ + { \ + DO_SIMPLE_FOR_LOOP_ONCE (val); \ + \ + if (quit) \ + break; \ + } \ + } \ + else if (nrows == 1) \ + { \ + for (octave_idx_type i = 0; i < steps; i++) \ + { \ + octave_value val (CONV (*atmp++)); \ + \ + DO_SIMPLE_FOR_LOOP_ONCE (val); \ + \ + if (quit) \ + break; \ + } \ + } \ + else \ + { \ + if (ndims > 2) \ + ARG = ARG.reshape (dv); \ + \ + MTYPE tmp (dim_vector (nrows, 1)); \ + \ + TYPE *ftmp = tmp.fortran_vec (); \ + \ + for (octave_idx_type i = 0; i < steps; i++) \ + { \ + for (int j = 0; j < nrows; j++) \ + ftmp[j] = *atmp++; \ + \ + octave_value val (tmp); \ + \ + DO_SIMPLE_FOR_LOOP_ONCE (val); \ + quit = (i == steps - 1 ? true : quit); \ + \ + if (quit) \ + break; \ + } \ + } \ + } \ + } \ + while (0) + +void +tree_evaluator::visit_simple_for_command (tree_simple_for_command& cmd) +{ + if (error_state) + return; + + unwind_protect::begin_frame ("tree_evaluator::visit_simple_for_command"); + + unwind_protect_bool (evaluating_looping_command); + + evaluating_looping_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_string ()) + { + charMatrix chm_tmp = rhs.char_matrix_value (); + octave_idx_type nr = chm_tmp.rows (); + octave_idx_type steps = chm_tmp.columns (); + bool quit = false; + + if (error_state) + goto cleanup; + + if (nr == 1) + { + for (octave_idx_type i = 0; i < steps; i++) + { + octave_value val (chm_tmp.xelem (0, i)); + + DO_SIMPLE_FOR_LOOP_ONCE (val); + + if (quit) + break; + } + } + else + { + for (octave_idx_type i = 0; i < steps; i++) + { + octave_value val (chm_tmp.extract (0, i, nr-1, i), true); + + DO_SIMPLE_FOR_LOOP_ONCE (val); + + if (quit) + break; + } + } + } + else if (rhs.is_matrix_type ()) + { + if (rhs.is_real_type ()) + { + NDArray m_tmp = rhs.array_value (); + + if (error_state) + goto cleanup; + + DO_ND_LOOP (NDArray, double, , m_tmp); + } + else + { + ComplexNDArray cm_tmp = rhs.complex_array_value (); + + if (error_state) + goto cleanup; + + DO_ND_LOOP (ComplexNDArray, Complex, , cm_tmp); + } + } + else if (rhs.is_map ()) + { + Octave_map tmp_val (rhs.map_value ()); + + bool quit = false; + + for (Octave_map::iterator p = tmp_val.begin (); + p != tmp_val.end (); + p++) + { + Cell val_lst = tmp_val.contents (p); + + octave_value val + = (val_lst.length () == 1) ? val_lst(0) : octave_value (val_lst); + + DO_SIMPLE_FOR_LOOP_ONCE (val); + + if (quit) + break; + } + } + else if (rhs.is_cell ()) + { + Cell c_tmp = rhs.cell_value (); + + DO_ND_LOOP (Cell, octave_value, Cell, c_tmp); + } + 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; + + unwind_protect::begin_frame ("tree_evaluator::visit_complex_for_command"); + + unwind_protect_bool (evaluating_looping_command); + + evaluating_looping_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 (); + + Octave_map tmp_val (rhs.map_value ()); + + tree_statement_list *loop_body = cmd.body (); + + for (Octave_map::iterator q = tmp_val.begin (); q != tmp_val.end (); q++) + { + octave_value key = tmp_val.key (q); + + 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& tic) +{ + 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) + do_breakpoint (! tic->is_else_clause () && 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&) +{ + // Do nothing. +} + +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&) +{ + if (! error_state) + 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) +{ + if (debug_mode) + do_breakpoint (stmt); + + tree_command *cmd = stmt.command (); + tree_expression *expr = stmt.expression (); + + if (cmd || expr) + { + if (in_function_or_script_body) + octave_call_stack::set_statement (&stmt); + + stmt.maybe_echo_code (in_function_or_script_body); + + try + { + if (cmd) + cmd->accept (*this); + else + { + if (in_function_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; + + in_function_or_script_body + = lst.is_function_body () || lst.is_script_body (); + + 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) + do_breakpoint (! t->is_default_case () && 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); + + // 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 (evaluating_looping_command); + + evaluating_looping_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 (expr->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 (evaluating_looping_command); + + evaluating_looping_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 (debug_mode) + do_breakpoint (expr->is_breakpoint (), l, c); + + if (quit_loop_now () || 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) + octave_stdout << xfcn->name () << ": "; + + octave_stdout << "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: *** +*/