Mercurial > octave-nkf
changeset 8658:73c4516fae10
New evaluator and debugger derived from tree-walker class
line wrap: on
line diff
--- a/src/ChangeLog Tue Feb 03 12:47:38 2009 +0100 +++ b/src/ChangeLog Wed Feb 04 00:47:53 2009 -0500 @@ -1,3 +1,289 @@ +2009-02-04 John W. Eaton <jwe@octave.org> + + New evaluator and debugger derived from tree-walker class. + + * pt-eval.h, pt-eval.cc: New files. Parse tree evaluator code + adapted from eval member functions in classes derived from + tree_command. + * Makefile.in (PT_INCLUDES, PT_SRC): Add them to the lists + + * pt-cmd.cc (tree_function_def::eval): Delete. + * pt-cmd.h: Delete decl. + (tree_command::eval): Delete pure virtual function. + (tree_no_op_command::eval): Delete. + (tree_function_def::function): Return octave_value, instead of + pointer to octave_function. Change all uses. + + * pt-except.cc (do_catch_code, tree_try_catch_command::eval, + do_unwind_protect_cleanup_code, + tree_unwind_protect_command::eval): Delete. + * pt-except.h: Delete decls. + + * pt-jump.cc (tree_break_command::eval, tree_return_command::eval, + tree_continue_command::eval): Delete. + * pt-jump.h: Delete decls. + + * pt-loop.cc (DO_ND_LOOP): Delete macro. + (tree_while_command::eval, tree_do_until_command::eval, + tree_simple_for_command::do_for_loop_once, + tree_simple_for_command::eval, + tree_complex_for_command::do_for_loop_once, + tree_complex_for_command::eval): + * pt-loop.h: Delete decls. + + * pt-select.cc (tree_if_clause::eval, tree_if_command_list::eval, + tree_if_command::eval, tree_switch_case::eval, + tree_switch_case_list::eval, tree_switch_command::eval): Delete. + * pt-select.h: Delete decls. + (class tree_if_clause, class tree_switch_case): Derive from tree. + Handle line and column in constructors. + + * pt-stmt.cc (tree_statement::eval): Delete + * pt-stmt.h: Delete decl. + + * pt-stmt.cc, pt-stmt.h (tree_statement::is_command, + tree_statement::is_expression, tree_statement::line, + tree_statement::column): Now const. + + * pt-stmt.cc (tree_statement::set_print_flag, + tree_statement::is_end_of_fcn_or_script): New functions. + * pt-stmt.h: Provide decl. + (set_breakpoint, delete_breakpoint, is_breakpoint): New function. + (bp): New member variable. + (print_result): Delete member variable. + (tree_statement_list::anon_function_body): New member variable. + (tree_statement_list::mark_as_anon_function_body, + tree_statement_list::is_anon_function_body, + tree_statement_list::is_script_body): New functions. + + * pt-decl.cc (tree_decl_init_list::eval, + tree_decl_command::accept, tree_global_command::do_init, + tree_global_command::eval, tree_static_command::do_init, + tree_static_command::eval): Delete. + * pt-decl.h: Delete decls. + (tree_decl_elt::eval_fcn): Delete typedef. + + * pt-decl.cc (tree_global_command::accept, + tree_static_command::accept): New functions. + + * pt-stmt.cc (tree_statement::print_result): Move here from + pt-stmt.h. Return true if expr is printable. + + * ov-base.cc (Vsilent_functions): Delete. + (octave_base_value::print_with_name): Don't check + evaluating_function_body && Vsilent_functions here. + * ov-class.cc (octave_class::print_with_name): Likewise. + * ov-base.h (Vsilent_functions): Delete decl. + * pt-eval.cc (Fsilent_functions): Move here from ov-base.cc. + (Vsilent_functions): New static variable. + + * sighandlers.cc (user_abort): Set tree_evaluator::debug_mode here. + + * pt.h (tree::bp): Rename from tree::break_point. + (tree::set_breakpoint, tree::delete_breakpoint, tree::is_breakpoint): + No longer virtual. + + * input.cc (get_debug_input): Use current_evaluator and + tree-walker to evaluate command. + * ov-usr-fcn.cc (octave_user_script::do_multi_index_op): Likewise. + * toplev.cc (main_loop): Likewise. + * parse.y (eval_string): + + * input.h, input.cc (Vdebugging_current_line): Delete. + (get_debug_input): Use tree_evaluator::debug_line instead of + Vdebugging_current_line. + + * ov-usr-fcn.cc (octave_user_function::do_multi_index_op): + Handle inline functions and anonymous functions as single + expressions. + * parse.y (eval_string): Likewise. + + * parse.y (make_do_until_command): Rename first argument from + do_tok to until_tok. + (loop_command): Pass UNTIL token instead of DO token to + make_do_until_command. + (make_elseif_clause): New arg, elseif_tok. Pass line and column + info to tree_if_clause constructor. + (elseif_clause): Pass ELSEIF token to make_elseif_clause. + (make_switch_case): New arg, case_tok. Pass line and column info + to tree_switch_case constructor. + (switch_case): Pass CASE token to make_switch_case. + (make_script): New arg end_script. Append it to cmds. + (script): Create no-op command for end of script and pass it to + make_script. + (start_function): New arg, end_function. Append it to body. + (function2): Pass end_function to start_function. + (make_end): New function. + (function_end): Declare as tree_statement_type. + Create no-op command for end of script. + (make_anon_fcn_handle): Mark body as anonymous function. + (set_stmt_print_flag): Set print flag for all separator types + + * parse.y (fold (tree_binary_expression*), + fold (tree_unary_expression *), finish_colon_expression, + finish_matrix): Call rvalue1 instead of rvalue. + Stash line number in new tree_constant object. + + * debug.h (bp_table::have_breakpoints): New static function. + (bp_table::do_have_breakpoints): New member function. + * debug.cc (bp_table::do_add_breakpoint, + bp_table::do_remove_breakpoint, + bp_table::do_remove_all_breakpoints_in_file, + bp_table::do_remove_all_breakpoints): Call + bp_table::have_breakpoints to set tree_evaluator::debug_mode. + (Fdbnext): Delete function. Alias to dbstep. + (Fdbquit, Fdbcont): Set tree_evaluator::dbstep_flag to zero. + (Fdbstep): Rewrite to use tree_evaluator::dbstep_flag instead of + tree::break_next, tree::last_line, tree::break_function, and + tree::last_break_function. + (Fdbwhere): Use tree_evaluator::debug_line and + tree_evaluator::debug_column to get current line and column info. + Don't print column if it is less than zero. + * pt.cc, pt.h (tree::break_next, tree::last_line, + tree::last_break_function, tree::break_function, + tree::break_statement): Delete. + + * pt-bp.cc (tree_breakpoint::visit_global_command, + tree_breakpoint::visit_static_command, + tree_breakpoint::take_action (tree_statement&)): New functions. + * pt-bp.h: Provide decls. + + * pt-bp.h (tree_walker::visit_global_command, + tree_walker::visit_static_command): New pure virtual functions. + (tree_walker::visit_decl_command): Delete. + + * pt-bp.cc (tree_breakpoint::visit_decl_command): Delete. + * pt-bp.h: Delete decl. + (MAYBE_DO_BREAKPOINT): Delete macro and all uses. + + * pt-bp.cc (tree_breakpoint::visit_no_op_command): Do nothing. + (tree_breakpoint::visit_argument_list, + tree_breakpoint::visit_binary_expression, + tree_breakpoint::visit_colon_expression, + tree_breakpoint::visit_decl_elt, + tree_breakpoint::visit_decl_init_list, + tree_breakpoint::visit_octave_user_script, + tree_breakpoint::visit_octave_user_function, + tree_breakpoint::visit_octave_user_function_header, + tree_breakpoint::visit_octave_user_function_trailer, + tree_breakpoint::visit_identifier, + tree_breakpoint::visit_index_expression, + tree_breakpoint::visit_matrix, tree_breakpoint::visit_cell, + tree_breakpoint::visit_multi_assignment, + tree_breakpoint::visit_anon_fcn_handle, + tree_breakpoint::visit_constant, + tree_breakpoint::visit_fcn_handle, + tree_breakpoint::visit_parameter_list, + tree_breakpoint::visit_postfix_expression, + tree_breakpoint::visit_prefix_expression, + tree_breakpoint::visit_return_list, + tree_breakpoint::visit_simple_assignment): Call panic_impossible + since breakpoints aren't set on expressions. + (tree_breakpoint::visit_if_clause): Fold into visit_if_command_list. + (tree_breakpoint::visit_switch_case): Fold into visit_switch_case_list. + (tree_breakpoint::visit_try_catch_command, + tree_breakpoint::visit_unwind_protect_command): + Don't set breakpoint on command itself, the the statements it + contains. + (tree_breakpoint::visit_global_command, + tree_breakpoint::visit_static_command): Call do_decl_command to do + actual work. + (tree_breakpoint::visit_while_command, + tree_breakpoint::visit_do_until_command, + tree_breakpoint::visit_simple_for_command, + tree_breakpoint::visit_complex_for_command, + tree_breakpoint::visit_statement, + tree_breakpoint::visit_statement_list, + tree_breakpoint::visit_switch_case_list): Set breakpoints at + appropriate places. + + * pt-pr-code.h, pt-pr-code.cc (tree_print_code::visit_global_command, + tree_print_code::visit_static_command, + tree_print_code::do_decl_command): New functions. + (tree_print_code::visit_decl_command): Delete. + + * pt-check.h, pt-check.cc (tree_checker::visit_global_command, + tree_checker::visit_static_command, tree_checker::do_decl_command): + New functions. + (tree_checker::visit_decl_command): Delete. + + * pt-select.cc (tree_switch_case::label_matches): Call rvalue1 + instead of rvalue. + + * pt-exp.h, pt-exp.cc (tree_expression::rvalue1): New function. + (tree_expression::rvalue (void)): Delete. + (tree_expression::is_logically_true): Call rvalue1 instead of rvalue. + + * pt-fcn-handle.h, pt-fcn-handle.cc (tree_fcn_handle::rvalue1, + tree_anon_fcn_handle::rvalue1): New functions. + (tree_fcn_handle:rvalue (void), + tree_anon_fcn_handle::rvalue1 (void)): Delete. + (tree_fcn_handle::rvalue (int), tree_anon_fcn_handle_rvalue (int)): + Call rvalue1 instead of rvalue. + + * pt-idx.h, pt-idx.cc (tree_index_expression::rvalue1): New function. + (tree_index_expression::rvalue (void)): Delete. + (tree_index_expression::get_struct_index, + tree_index_expression::rvalue (int)): Call rvalue1 instead of rvalue. + + * pt-mat.h, pt-mat.cc (tree_matrix::rvalue1): New function. + (tree_matrix::rvalue (void)): Delete. + (tm_row_const::tm_row_const_rep::init, + tree_matrix::rvalue (int)): Call rvalue1 instead of rvalue. + + * pt-misc.cc (tree_parameter_list::convert_to_const_vector): + Call rvalue1 instead of rvalue. + * pt-arg-list.cc (tree_argument_list::convert_to_const_vector): + Likewise. + + * pt-unop.h, pt-unop.cc (tree_prefix_expression::rvalue1, + tree_postfix_expression::rvalue1): New functions. + (tree_prefix_expression::rvalue (void), + tree_postfix_expression::rvalue (void)): Delete. + (tree_prefix_expression::rvalue (int), + tree_postfix_expression::rvalue (int)): + Call rvalue1 instead of rvalue. + + * pt-id.h, pt-id.cc (tree_identifier::rvalue1): New function. + (tree_identifier::rvalue (void)): Delete. + + * pt-assign.h, pt-assign.cc (tree_simple_assignment::rvalue1, + tree_multi_assignment::rvalue1): New functions. + (tree_simple_assignment::rvalue (void), + tree_multi_assignment::rvalue (void): Delete. + (tree_simple_assignment::rvalue (int)): + Call rvalue1 instead of rvalue. + + * pt-binop.h, pt-binop.cc (tree_binary_expression::rvalue1, + tree_boolean_expression::rvalue1): New functions. + (tree_binary_expression::rvalue (void), + tree_boolean_expression::rvalue (void)): Delete. + (tree_binary_expression::rvalue (int), + tree_boolean_expression::rvalue (int)): + Call rvalue1 instead of rvalue. + + * pt-cbinop.h, pt-cbinop.cc + (tree_compound_binary_expression::rvalue1): New function. + (tree_compound_binary_expression::rvalue (void)): Delete. + + * pt-cell.h, pt-cell.cc (tree_cell::rvalue1): New function. + (tree_cell::rvalue (void)): Delete. + (tree_cell::rvalue (int)): Call rvalue1 instead of rvalue. + + * pt-colon.h, pt-colon.cc (tree_colon_expression::rvalue1): + New function. + (tree_colon_expression::rvalue (void)): Delete. + (tree_colon_expression::rvalue (int)): + Call rvalue1 instead of rvalue. + + * pt-const.h, pt-const.cc (tree_constant::rvalue1): New function. + (tree_constant::rvalue (void)): Delete. + (tree_constant::rvalue (int)): Call rvalue1 instead of rvalue. + + * pt-decl.h, pt-decl.cc (tree_decl_elt::ravlue1): New function. + (tree_decl_elt::ravlue (void)): Delete. + (tree_decl_elt::eval): Call rvalue1 instead of rvalue. + 2009-02-03 Jaroslav Hajek <highegg@gmail.com> * TEMPLATE-INST/Array-tc.cc: Replace vec_index by pointers.
--- a/src/Makefile.in Tue Feb 03 12:47:38 2009 +0100 +++ b/src/Makefile.in Wed Feb 04 00:47:53 2009 -0500 @@ -115,9 +115,9 @@ PT_INCLUDES := pt.h pt-all.h pt-arg-list.h pt-assign.h pt-binop.h \ pt-bp.h pt-cbinop.h pt-cell.h pt-check.h pt-cmd.h pt-colon.h \ - pt-const.h pt-decl.h pt-except.h pt-exp.h pt-fcn-handle.h \ + pt-const.h pt-decl.h pt-eval.h pt-except.h pt-exp.h pt-fcn-handle.h \ pt-id.h pt-idx.h pt-jump.h pt-loop.h pt-mat.h pt-misc.h \ - pt-pr-code.h pt-select.h pt-stmt.h pt-unop.h pt-walk.h \ + pt-pr-code.h pt-select.h pt-stmt.h pt-unop.h pt-walk.h INCLUDES := Cell.h base-list.h builtins.h c-file-ptr-stream.h \ comment-list.h debug.h defun-dld.h defun-int.h defun.h \ @@ -210,9 +210,10 @@ PT_SRC := pt.cc pt-arg-list.cc pt-assign.cc pt-bp.cc pt-binop.cc \ pt-cbinop.cc pt-cell.cc pt-check.cc pt-cmd.cc pt-colon.cc \ - pt-const.cc pt-decl.cc pt-except.cc pt-exp.cc pt-fcn-handle.cc \ - pt-id.cc pt-idx.cc pt-jump.cc pt-loop.cc pt-mat.cc pt-misc.cc \ - pt-pr-code.cc pt-select.cc pt-stmt.cc pt-unop.cc + pt-const.cc pt-decl.cc pt-eval.cc pt-except.cc pt-exp.cc \ + pt-fcn-handle.cc pt-id.cc pt-idx.cc pt-jump.cc pt-loop.cc \ + pt-mat.cc pt-misc.cc pt-pr-code.cc pt-select.cc pt-stmt.cc \ + pt-unop.cc DIST_SRC := Cell.cc bitfcns.cc c-file-ptr-stream.cc comment-list.cc \ cutils.c data.cc debug.cc defaults.cc defun.cc dirfns.cc \
--- a/src/debug.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/debug.cc Wed Feb 04 00:47:53 2009 -0500 @@ -24,10 +24,13 @@ #include <config.h> #endif -#include <iostream> +#include <deque> #include <fstream> +#include <iostream> +#include <set> #include <string> -#include <set> + +#include "file-stat.h" #include "defun.h" #include "error.h" @@ -45,8 +48,8 @@ #include "ov-list.h" #include "ov-struct.h" #include "pt-pr-code.h" -#include "pt.h" #include "pt-bp.h" +#include "pt-eval.h" #include "pt-stmt.h" #include "toplev.h" #include "unwind-prot.h" @@ -57,6 +60,108 @@ // Initialize the singleton object bp_table *bp_table::instance = 0; +static std::string +snarf_file (const std::string& fname) +{ + std::string retval; + + file_stat fs (fname); + + if (fs) + { + size_t sz = fs.size (); + + std::ifstream file (fname.c_str (), std::ios::in|std::ios::binary); + + if (file) + { + std::string buf (sz+1, 0); + + file.read (&buf[0], sz+1); + + if (file.eof ()) + { + // Expected to read the entire file. + + retval = buf; + } + else + error ("error reading file %s", fname.c_str ()); + } + } + + return retval; +} + +static std::deque<size_t> +get_line_offsets (const std::string& buf) +{ + // This could maybe be smarter. Is deque the right thing to use + // here? + + std::deque<size_t> offsets; + + offsets.push_back (0); + + size_t len = buf.length (); + + for (size_t i = 0; i < len; i++) + { + char c = buf[i]; + + if (c == '\r' && ++i < len) + { + c = buf[i]; + + if (c == '\n') + offsets.push_back (i+1); + else + offsets.push_back (i); + } + else if (c == '\n') + offsets.push_back (i+1); + } + + offsets.push_back (len); + + return offsets; +} + +std::string +get_file_line (const std::string& fname, size_t line) +{ + std::string retval; + + static std::string last_fname; + + static std::string buf; + + static std::deque<size_t> offsets; + + if (fname != last_fname) + { + buf = snarf_file (fname); + + offsets = get_line_offsets (buf); + } + + if (line > 0) + line--; + + if (line < offsets.size () - 1) + { + size_t bol = offsets[line]; + size_t eol = offsets[line+1]; + + while (eol > 0 && buf[eol-1] == '\n' || buf[eol-1] == '\r') + eol--; + + retval = buf.substr (bol, eol - bol); + } + + return retval; +} + // Return a pointer to the user-defined function FNAME. If FNAME is // empty, search backward for the first user-defined function in the // current call stack. @@ -180,6 +285,8 @@ else error ("add_breakpoint: unable to find the function requested\n"); + tree_evaluator::debug_mode = bp_table::have_breakpoints (); + return retval; } @@ -233,6 +340,9 @@ else error ("remove_breakpoint: unable to find the function requested\n"); } + + tree_evaluator::debug_mode = bp_table::have_breakpoints (); + return retval; } @@ -270,6 +380,8 @@ error ("remove_all_breakpoint_in_file: " "unable to find the function requested\n"); + tree_evaluator::debug_mode = bp_table::have_breakpoints (); + return retval; } @@ -279,6 +391,8 @@ for (const_breakpoint_map_iterator it = bp_map.begin (); it != bp_map.end (); it++) remove_all_breakpoints_in_file (it->first); + + tree_evaluator::debug_mode = bp_table::have_breakpoints (); } std::string @@ -295,6 +409,7 @@ break; } } + return retval; } @@ -544,16 +659,39 @@ if (dbg_fcn) { - std::string name = dbg_fcn->name (); + bool have_file = true; + + std::string name = dbg_fcn->fcn_file_name (); + + if (name.empty ()) + { + have_file = false; + + name = dbg_fcn->name (); + } octave_stdout << name << ":"; - const tree *dbg_stmt = tree::break_statement; + int l = tree_evaluator::debug_line (); + + if (l > 0) + { + octave_stdout << " line " << l; + + int c = tree_evaluator::debug_column (); - if (dbg_stmt) - { - octave_stdout << " line " << dbg_stmt->line () << ", "; - octave_stdout << "column " << dbg_stmt->column () << std::endl; + if (c > 0) + octave_stdout << ", column " << c; + + octave_stdout << std::endl; + + if (have_file) + { + std::string line = get_file_line (name, l); + + if (! line.empty ()) + octave_stdout << l << ": " << line << std::endl; + } } else octave_stdout << " (unknown line)\n"; @@ -872,71 +1010,49 @@ if (nargin > 1) print_usage (); - else if (nargin == 1 && args(0).is_string ()) + else if (nargin == 1) { - std::string arg = args(0).string_value (); - - if (! error_state) + if (args(0).is_string ()) { - if (arg == "in") - { - Vdebugging = false; - - tree::break_next = 0; + std::string arg = args(0).string_value (); - tree::last_line = Vdebugging_current_line; - - tree::break_function = 0; - - tree::last_break_function = - octave_call_stack::caller_user_code (); - } - else if (arg == "out") + if (! error_state) { - Vdebugging = false; - - tree::break_next = 0; + if (arg == "in") + { + Vdebugging = false; - tree::last_line = -1; - - tree::break_function = - octave_call_stack::caller_user_code (1); - - tree::last_break_function = - octave_call_stack::caller_user_code (); - } - else - { - int n = atoi (arg.c_str ()); + tree_evaluator::dbstep_flag = -1; + } + else if (arg == "out") + { + Vdebugging = false; - Vdebugging = false; - - if (n < 0) - tree::break_next = 0; + tree_evaluator::dbstep_flag = -2; + } else - tree::break_next = n; + { + int n = atoi (arg.c_str ()); - tree::last_line = Vdebugging_current_line; - - tree::break_function = octave_call_stack::caller_user_code (); + if (n > 0) + { + Vdebugging = false; - tree::last_break_function = - octave_call_stack::caller_user_code (); + tree_evaluator::dbstep_flag = n; + } + else + error ("dbstep: invalid argument"); + } } } + else + error ("dbstep: expecting character string as argument"); } else { Vdebugging = false; - tree::break_next = 0; - - tree::last_line = Vdebugging_current_line; - - tree::break_function = octave_call_stack::caller_user_code (); - - tree::last_break_function = - octave_call_stack::caller_user_code (); + tree_evaluator::dbstep_flag = 1; } } else @@ -945,6 +1061,8 @@ return octave_value_list (); } +DEFALIAS (dbnext, dbstep); + DEFCMD (dbcont, args, , "-*- texinfo -*-\n\ @deftypefn {Command} {} dbcont ()\n\ @@ -953,10 +1071,16 @@ @end deftypefn") { if (Vdebugging) - if (args.length() == 0) - Vdebugging = false; - else - print_usage (); + { + if (args.length () == 0) + { + Vdebugging = false; + + tree_evaluator::dbstep_flag = 0; + } + else + print_usage (); + } else error ("dbcont: can only be called in debug mode"); @@ -971,47 +1095,22 @@ @end deftypefn") { if (Vdebugging) - if (args.length() == 0) - octave_throw_interrupt_exception (); - else - print_usage (); + { + if (args.length () == 0) + { + tree_evaluator::dbstep_flag = 0; + + octave_throw_interrupt_exception (); + } + else + print_usage (); + } else error ("dbquit: can only be called in debug mode"); return octave_value_list (); } -DEFCMD (dbnext, args, , - "-*- texinfo -*-\n\ -@deftypefn {Command} {} dbnext ()\n\ -In debugging mode, execute the next line of code without stepping in to\n\ -functions. This is synonymous with @code{dbstep}.\n\ -@seealso{dbstep, dbcont, dbquit}\n\ -@end deftypefn") -{ - if (Vdebugging) - { - if (args.length() == 0) - { - Vdebugging = false; - - tree::break_next = 0; - - tree::last_line = Vdebugging_current_line; - - tree::break_function = octave_call_stack::caller_user_code (); - - tree::last_break_function = octave_call_stack::caller_user_code (); - } - else - print_usage (); - } - else - error ("dbnext: can only be called in debug mode"); - - return octave_value_list (); -} - DEFCMD (isdebugmode, args, , "-*- texinfo -*-\n\ @deftypefn {Command} {} isdebugmode ()\n\ @@ -1021,8 +1120,8 @@ { octave_value retval; - if (args.length() == 0) - retval = Vdebugging; + if (args.length () == 0) + retval = Vdebugging; else print_usage ();
--- a/src/debug.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/debug.h Wed Feb 04 00:47:53 2009 -0500 @@ -108,6 +108,12 @@ ? instance->do_get_breakpoint_list (fname_list) : fname_line_map (); } + static bool + have_breakpoints (void) + { + return instance_ok () ? instance->do_have_breakpoints () : 0; + } + private: // Map from function names to function objects for functions @@ -132,8 +138,11 @@ fname_line_map do_get_breakpoint_list (const octave_value_list& fname_list); + bool do_have_breakpoints (void) { return (! bp_map.empty ()); } }; +std::string get_file_line (const std::string& fname, size_t line); + #endif /*
--- a/src/input.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/input.cc Wed Feb 04 00:47:53 2009 -0500 @@ -48,6 +48,7 @@ #include "quit.h" #include "str-vec.h" +#include "debug.h" #include "defun.h" #include "dirfns.h" #include "error.h" @@ -64,6 +65,7 @@ #include "pathlen.h" #include "pt.h" #include "pt-const.h" +#include "pt-eval.h" #include "pt-stmt.h" #include "sighandlers.h" #include "sysdep.h" @@ -147,9 +149,6 @@ // TRUE if we are in debugging mode. bool Vdebugging = false; -// The current line that we are debugging -int Vdebugging_current_line = -1; - // TRUE if we are running in the Emacs GUD mode. static bool Vgud_mode = false; @@ -576,17 +575,21 @@ octave_user_code *caller = octave_call_stack::caller_user_code (); std::string nm; + int curr_debug_line = tree_evaluator::debug_line (); + + bool have_file = false; + if (caller) { nm = caller->fcn_file_name (); if (nm.empty ()) nm = caller->name (); - - Vdebugging_current_line = octave_call_stack::current_line (); + else + have_file = true; } else - Vdebugging_current_line = -1; + curr_debug_line = -1; std::ostringstream buf; @@ -596,14 +599,27 @@ { static char ctrl_z = 'Z' & 0x1f; - buf << ctrl_z << ctrl_z << nm << ":" << Vdebugging_current_line; + buf << ctrl_z << ctrl_z << nm << ":" << curr_debug_line; } else { + // FIXME -- we should come up with a clean way to detect + // that we are stopped on the no-op command that marks the + // end of a function or script. + buf << "stopped in " << nm; - if (Vdebugging_current_line > 0) - buf << " at line " << Vdebugging_current_line; + if (curr_debug_line > 0) + buf << " at line " << curr_debug_line; + + if (have_file) + { + std::string line_buf + = get_file_line (nm, curr_debug_line); + + if (! line_buf.empty ()) + buf << "\n" << curr_debug_line << ": " << line_buf; + } } } @@ -631,7 +647,7 @@ if (retval == 0 && global_command) { - global_command->eval (); + global_command->accept (*current_evaluator); // FIXME -- To avoid a memory leak, global_command should be // deleted, I think. But doing that here causes trouble if
--- a/src/input.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/input.h Wed Feb 04 00:47:53 2009 -0500 @@ -91,9 +91,6 @@ // TRUE if we are in debugging mode. extern bool Vdebugging; -// The current line that we are debugging -extern int Vdebugging_current_line; - extern std::string gnu_readline (const std::string& s, bool force_readline = false); extern void initialize_command_input (void);
--- a/src/ov-base.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/ov-base.cc Wed Feb 04 00:47:53 2009 -0500 @@ -57,10 +57,6 @@ DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_base_value, "<unknown type>", "unknown"); -// If TRUE, turn off printing of results in functions (as if a -// semicolon has been appended to each statement). -bool Vsilent_functions = false; - // TRUE means to perform automatic sparse to real mutation if there // is memory to be saved bool Vsparse_auto_mutate = false; @@ -357,15 +353,12 @@ const std::string& name, bool print_padding) const { - if (! (evaluating_function_body && Vsilent_functions)) - { - bool pad_after = print_name_tag (output_buf, name); + bool pad_after = print_name_tag (output_buf, name); - print (output_buf); + print (output_buf); - if (print_padding && pad_after) - newline (output_buf); - } + if (print_padding && pad_after) + newline (output_buf); } void @@ -1322,19 +1315,6 @@ INSTALL_WIDENOP (octave_base_value, octave_cell, cell_conv); } -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); -} - DEFUN (sparse_auto_mutate, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} sparse_auto_mutate ()\n\
--- a/src/ov-base.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/ov-base.h Wed Feb 04 00:47:53 2009 -0500 @@ -622,10 +622,6 @@ DECLARE_OV_BASE_TYPEID_FUNCTIONS_AND_DATA }; -// If TRUE, turn off printing of results in functions (as if a -// semicolon has been appended to each statement). -extern bool Vsilent_functions; - // TRUE means to perform automatic sparse to real mutation if there // is memory to be saved extern bool Vsparse_auto_mutate;
--- a/src/ov-class.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/ov-class.cc Wed Feb 04 00:47:53 2009 -0500 @@ -660,24 +660,21 @@ octave_class::print_with_name (std::ostream&, const std::string& name, bool) const { - if (! (evaluating_function_body && Vsilent_functions)) - { - octave_value fcn = symbol_table::find_method ("display", class_name ()); + octave_value fcn = symbol_table::find_method ("display", class_name ()); - if (fcn.is_defined ()) - { - octave_value_list args; + if (fcn.is_defined ()) + { + octave_value_list args; - args(0) = octave_value (clone (), 1); + args(0) = octave_value (clone (), 1); - string_vector arg_names (1); + string_vector arg_names (1); - arg_names[0] = name; + arg_names[0] = name; - args.stash_name_tags (arg_names); + args.stash_name_tags (arg_names); - feval (fcn.function_value (), args); - } + feval (fcn.function_value (), args); } }
--- a/src/ov-usr-fcn.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/ov-usr-fcn.cc Wed Feb 04 00:47:53 2009 -0500 @@ -36,6 +36,7 @@ #include "ov-usr-fcn.h" #include "ov.h" #include "pager.h" +#include "pt-eval.h" #include "pt-jump.h" #include "pt-misc.h" #include "pt-pr-code.h" @@ -127,7 +128,7 @@ unwind_protect::add (octave_call_stack::unwind_pop, 0); - cmd_list->eval (); + cmd_list->accept (*current_evaluator); if (tree_return_command::returning) tree_return_command::returning = 0; @@ -432,14 +433,25 @@ unwind_protect_bool (evaluating_function_body); evaluating_function_body = true; - if (is_inline_function ()) + bool special_expr = (is_inline_function () + || cmd_list->is_anon_function_body ()); + + if (special_expr) { assert (cmd_list->length () == 1); - retval = cmd_list->eval (false, nargout); + tree_statement *stmt = 0; + + if ((stmt = cmd_list->front ()) + && stmt->is_expression ()) + { + tree_expression *expr = stmt->expression (); + + retval = expr->rvalue (nargout); + } } else - cmd_list->eval (); + cmd_list->accept (*current_evaluator); if (echo_commands) print_code_function_trailer (); @@ -458,7 +470,7 @@ // Copy return values out. - if (ret_list && ! is_inline_function ()) + if (ret_list && ! special_expr) { ret_list->initialize_undefined_elements (my_name, nargout, Matrix ());
--- a/src/parse.y Tue Feb 03 12:47:38 2009 +0100 +++ b/src/parse.y Wed Feb 04 00:47:53 2009 -0500 @@ -70,6 +70,7 @@ #include "pager.h" #include "parse.h" #include "pt-all.h" +#include "pt-eval.h" #include "symtab.h" #include "token.h" #include "unwind-prot.h" @@ -209,7 +210,7 @@ // Build a do-until command. static tree_command * -make_do_until_command (token *do_tok, tree_statement_list *body, +make_do_until_command (token *until_tok, tree_statement_list *body, tree_expression *expr, octave_comment_list *lc); // Build a for command. @@ -241,8 +242,8 @@ // Build an elseif clause. static tree_if_clause * -make_elseif_clause (tree_expression *expr, tree_statement_list *list, - octave_comment_list *lc); +make_elseif_clause (token *elseif_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc); // Finish a switch command. static tree_switch_command * @@ -252,8 +253,8 @@ // Build a switch case. static tree_switch_case * -make_switch_case (tree_expression *expr, tree_statement_list *list, - octave_comment_list *lc); +make_switch_case (token *case_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc); // Build an assignment to a variable. static tree_expression * @@ -262,11 +263,16 @@ // Define a script. static void -make_script (tree_statement_list *cmds); +make_script (tree_statement_list *cmds, tree_statement *end_script); // Begin defining a function. static octave_user_function * -start_function (tree_parameter_list *param_list, tree_statement_list *body); +start_function (tree_parameter_list *param_list, tree_statement_list *body, + tree_statement *end_function); + +// Create a no-op statement for end_function. +static tree_statement * +make_end (const std::string& type, int l, int c); // Do most of the work for defining a function. static octave_user_function * @@ -457,7 +463,7 @@ %type <tree_decl_elt_type> decl2 %type <tree_decl_init_list_type> decl1 %type <tree_decl_command_type> declaration -%type <tree_statement_type> statement +%type <tree_statement_type> statement function_end %type <tree_statement_list_type> simple_list simple_list1 list list1 %type <tree_statement_list_type> opt_list input1 @@ -995,13 +1001,11 @@ ; elseif_clause : ELSEIF stash_comment opt_sep expression opt_sep opt_list - { $$ = make_elseif_clause ($4, $6, $2); } + { $$ = make_elseif_clause ($1, $4, $6, $2); } ; else_clause : ELSE stash_comment opt_sep opt_list - { - $$ = new tree_if_clause ($4, $2); - } + { $$ = new tree_if_clause ($4, $2); } ; // ================ @@ -1036,7 +1040,7 @@ ; switch_case : CASE stash_comment opt_sep expression opt_sep opt_list - { $$ = make_switch_case ($4, $6, $2); } + { $$ = make_switch_case ($1, $4, $6, $2); } ; default_case : OTHERWISE stash_comment opt_sep opt_list @@ -1056,7 +1060,7 @@ } | DO stash_comment opt_sep opt_list UNTIL expression { - if (! ($$ = make_do_until_command ($1, $4, $6, $2))) + if (! ($$ = make_do_until_command ($5, $4, $6, $2))) ABORT_PARSE; } | FOR stash_comment assign_lhs '=' expression opt_sep opt_list END @@ -1226,7 +1230,12 @@ script : SCRIPT opt_list END_OF_INPUT { - make_script ($2); + tree_statement *end_of_script + = make_end ("endscript", input_line_number, + current_input_column); + + make_script ($2, end_of_script); + $$ = 0; } ; @@ -1278,14 +1287,16 @@ ; function2 : param_list opt_sep opt_list function_end - { $$ = start_function ($1, $3); } + { $$ = start_function ($1, $3, $4); } | opt_sep opt_list function_end - { $$ = start_function (0, $2); } + { $$ = start_function (0, $2, $3); } ; function_end : END { - if (! end_token_ok ($1, token::function_end)) + if (end_token_ok ($1, token::function_end)) + $$ = make_end ("endfunction", $1->line (), $1->column ()); + else ABORT_PARSE; } | END_OF_INPUT @@ -1293,8 +1304,11 @@ if (lexer_flags.parsing_nested_function) lexer_flags.parsing_nested_function = -1; - if (! (reading_fcn_file || reading_script_file - || get_input_from_eval_string)) + if (reading_fcn_file || reading_script_file + || get_input_from_eval_string) + $$ = make_end ("endfunction", input_line_number, + current_input_column); + else YYABORT; } ; @@ -1554,11 +1568,12 @@ || (warning_enabled ("Octave:precedence-change") && (op_type == EXPR_OR || op_type == EXPR_OR_OR))))) { - octave_value tmp = e->rvalue (); + octave_value tmp = e->rvalue1 (); if (! (error_state || warning_state)) { - tree_constant *tc_retval = new tree_constant (tmp); + tree_constant *tc_retval + = new tree_constant (tmp, op1->line (), op1->column ()); std::ostringstream buf; @@ -1599,11 +1614,12 @@ if (op->is_constant ()) { - octave_value tmp = e->rvalue (); + octave_value tmp = e->rvalue1 (); if (! (error_state || warning_state)) { - tree_constant *tc_retval = new tree_constant (tmp); + tree_constant *tc_retval + = new tree_constant (tmp, op->line (), op->column ()); std::ostringstream buf; @@ -1653,11 +1669,12 @@ if (base->is_constant () && limit->is_constant () && (! incr || (incr && incr->is_constant ()))) { - octave_value tmp = e->rvalue (); + octave_value tmp = e->rvalue1 (); if (! (error_state || warning_state)) { - tree_constant *tc_retval = new tree_constant (tmp); + tree_constant *tc_retval + = new tree_constant (tmp, base->line (), base->column ()); std::ostringstream buf; @@ -1790,6 +1807,8 @@ tree_statement_list *body = new tree_statement_list (stmt); + body->mark_as_anon_function_body (); + tree_anon_fcn_handle *retval = new tree_anon_fcn_handle (param_list, ret_list, body, fcn_scope, l, c); @@ -2133,7 +2152,7 @@ // Build a do-until command. static tree_command * -make_do_until_command (token *do_tok, tree_statement_list *body, +make_do_until_command (token *until_tok, tree_statement_list *body, tree_expression *expr, octave_comment_list *lc) { tree_command *retval = 0; @@ -2144,8 +2163,8 @@ lexer_flags.looping--; - int l = do_tok->line (); - int c = do_tok->column (); + int l = until_tok->line (); + int c = until_tok->column (); retval = new tree_do_until_command (expr, body, lc, tc, l, c); @@ -2289,12 +2308,15 @@ // Build an elseif clause. static tree_if_clause * -make_elseif_clause (tree_expression *expr, tree_statement_list *list, - octave_comment_list *lc) +make_elseif_clause (token *elseif_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc) { maybe_warn_assign_as_truth_value (expr); - return new tree_if_clause (expr, list, lc); + int l = elseif_tok->line (); + int c = elseif_tok->column (); + + return new tree_if_clause (expr, list, lc, l, c); } // Finish a switch command. @@ -2322,12 +2344,15 @@ // Build a switch case. static tree_switch_case * -make_switch_case (tree_expression *expr, tree_statement_list *list, - octave_comment_list *lc) +make_switch_case (token *case_tok, tree_expression *expr, + tree_statement_list *list, octave_comment_list *lc) { maybe_warn_variable_switch_label (expr); - return new tree_switch_case (expr, list, lc); + int l = case_tok->line (); + int c = case_tok->column (); + + return new tree_switch_case (expr, list, lc, l, c); } // Build an assignment to a variable. @@ -2427,7 +2452,7 @@ // Define a function. static void -make_script (tree_statement_list *cmds) +make_script (tree_statement_list *cmds, tree_statement *end_script) { std::string doc_string; @@ -2437,6 +2462,11 @@ help_buf.pop (); } + if (! cmds) + cmds = new tree_statement_list (); + + cmds->append (end_script); + octave_user_script *script = new octave_user_script (curr_fcn_file_full_name, curr_fcn_file_name, cmds, doc_string); @@ -2451,10 +2481,16 @@ // Begin defining a function. static octave_user_function * -start_function (tree_parameter_list *param_list, tree_statement_list *body) +start_function (tree_parameter_list *param_list, tree_statement_list *body, + tree_statement *end_fcn_stmt) { // We'll fill in the return list later. + if (! body) + body = new tree_statement_list (); + + body->append (end_fcn_stmt); + octave_user_function *fcn = new octave_user_function (symbol_table::current_scope (), param_list, 0, body); @@ -2469,6 +2505,12 @@ return fcn; } +static tree_statement * +make_end (const std::string& type, int l, int c) +{ + return make_statement (new tree_no_op_command (type, l, c)); +} + // Do most of the work for defining a function. static octave_user_function * @@ -2773,11 +2815,12 @@ if (m->all_elements_are_constant ()) { - octave_value tmp = m->rvalue (); + octave_value tmp = m->rvalue1 (); if (! (error_state || warning_state)) { - tree_constant *tc_retval = new tree_constant (tmp); + tree_constant *tc_retval + = new tree_constant (tmp, m->line (), m->column ()); std::ostringstream buf; @@ -2830,12 +2873,13 @@ switch (sep) { case ';': - tmp->set_print_flag (0); + tmp->set_print_flag (false); break; case 0: case ',': case '\n': + tmp->set_print_flag (true); if (warn_missing_semi) maybe_warn_missing_semi (list); break; @@ -3797,20 +3841,62 @@ parse_status = yyparse (); - tree_statement_list *command = global_command; + tree_statement_list *command_list = global_command; // Restore previous value of global_command. unwind_protect::run (); if (parse_status == 0) { - if (command) + if (command_list) { - retval = command->eval (silent, nargout); - - delete command; - - command = 0; + tree_statement *stmt = 0; + + if (command_list->length () == 1 + && (stmt = command_list->front ()) + && stmt->is_expression ()) + { + tree_expression *expr = stmt->expression (); + + if (silent) + expr->set_print_flag (false); + + 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 ()); + + retval = expr->rvalue (nargout); + + if (do_bind_ans && ! (error_state || retval.empty ())) + bind_ans (retval(0), expr->print_result ()); + + if (nargout == 0) + retval = octave_value_list (); + } + else if (nargout == 0) + { + tree_evaluator evaluator; + + unwind_protect_ptr (current_evaluator); + + current_evaluator = &evaluator; + + command_list->accept (evaluator); + } + else + error ("eval: invalid use of statement list"); + + delete command_list; + + command_list = 0; if (error_state || tree_return_command::returning
--- a/src/pt-arg-list.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-arg-list.cc Wed Feb 04 00:47:53 2009 -0500 @@ -192,7 +192,7 @@ if (elt) { - octave_value tmp = elt->rvalue (); + octave_value tmp = elt->rvalue1 (); if (error_state) {
--- a/src/pt-assign.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-assign.cc Wed Feb 04 00:47:53 2009 -0500 @@ -176,12 +176,10 @@ { octave_value_list retval; - MAYBE_DO_BREAKPOINT; - if (nargout > 1) error ("invalid number of output arguments for expression X = RHS"); else - retval = rvalue (); + retval = rvalue1 (nargout); return retval; } @@ -190,7 +188,7 @@ // it were broken up into a couple of separate functions. octave_value -tree_simple_assignment::rvalue (void) +tree_simple_assignment::rvalue1 (int) { octave_value retval; @@ -202,7 +200,7 @@ if (rhs) { - octave_value_list tmp = rhs->rvalue (); + octave_value_list tmp = rhs->rvalue1 (); if (! (error_state || tmp.empty ())) { @@ -311,11 +309,11 @@ } octave_value -tree_multi_assignment::rvalue (void) +tree_multi_assignment::rvalue1 (int nargout) { octave_value retval; - const octave_value_list tmp = rvalue (1); + const octave_value_list tmp = rvalue (nargout); if (! tmp.empty ()) retval = tmp(0);
--- a/src/pt-assign.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-assign.h Wed Feb 04 00:47:53 2009 -0500 @@ -60,7 +60,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout); @@ -135,7 +135,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout);
--- a/src/pt-binop.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-binop.cc Wed Feb 04 00:47:53 2009 -0500 @@ -43,28 +43,26 @@ error ("binary operator `%s': invalid number of output arguments", oper () . c_str ()); else - retval = rvalue (); + retval = rvalue1 (nargout); return retval; } octave_value -tree_binary_expression::rvalue (void) +tree_binary_expression::rvalue1 (int) { octave_value retval; - MAYBE_DO_BREAKPOINT; - if (error_state) return retval; if (op_lhs) { - octave_value a = op_lhs->rvalue (); + octave_value a = op_lhs->rvalue1 (); if (! error_state && a.is_defined () && op_rhs) { - octave_value b = op_rhs->rvalue (); + octave_value b = op_rhs->rvalue1 (); if (! error_state && b.is_defined ()) { @@ -112,19 +110,17 @@ { octave_value_list retval; - MAYBE_DO_BREAKPOINT; - if (nargout > 1) error ("binary operator `%s': invalid number of output arguments", oper () . c_str ()); else - retval = rvalue (); + retval = rvalue1 (nargout); return retval; } octave_value -tree_boolean_expression::rvalue (void) +tree_boolean_expression::rvalue1 (int) { octave_value retval; @@ -135,7 +131,7 @@ if (op_lhs) { - octave_value a = op_lhs->rvalue (); + octave_value a = op_lhs->rvalue1 (); if (! error_state) { @@ -159,7 +155,7 @@ if (op_rhs) { - octave_value b = op_rhs->rvalue (); + octave_value b = op_rhs->rvalue1 (); if (! error_state) result = b.is_true ();
--- a/src/pt-binop.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-binop.h Wed Feb 04 00:47:53 2009 -0500 @@ -70,7 +70,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout); @@ -131,7 +131,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout);
--- a/src/pt-bp.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-bp.cc Wed Feb 04 00:47:53 2009 -0500 @@ -33,8 +33,410 @@ // available breakpoint. bool octave_debug_on_interrupt_state = false; -void -tree_breakpoint::take_action (tree &tr) +void +tree_breakpoint::visit_while_command (tree_while_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); + + if (! found) + { + tree_statement_list *lst = cmd.body (); + + if (lst) + lst->accept (*this); + } +} + +void +tree_breakpoint::visit_do_until_command (tree_do_until_command& cmd) +{ + if (! found) + { + tree_statement_list *lst = cmd.body (); + + if (lst) + lst->accept (*this); + + if (! found) + { + if (cmd.line () >= line) + take_action (cmd); + } + } +} + +void +tree_breakpoint::visit_argument_list (tree_argument_list&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_binary_expression (tree_binary_expression&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_break_command (tree_break_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); +} + +void +tree_breakpoint::visit_colon_expression (tree_colon_expression&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_continue_command (tree_continue_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); +} + +void +tree_breakpoint::do_decl_command (tree_decl_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); +} + +void +tree_breakpoint::visit_global_command (tree_global_command& cmd) +{ + do_decl_command (cmd); +} + +void +tree_breakpoint::visit_static_command (tree_static_command& cmd) +{ + do_decl_command (cmd); +} + +void +tree_breakpoint::visit_decl_elt (tree_decl_elt&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_decl_init_list (tree_decl_init_list&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_simple_for_command (tree_simple_for_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); + + if (! found) + { + tree_statement_list *lst = cmd.body (); + + if (lst) + lst->accept (*this); + } +} + +void +tree_breakpoint::visit_complex_for_command (tree_complex_for_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); + + if (! found) + { + tree_statement_list *lst = cmd.body (); + + if (lst) + lst->accept (*this); + } +} + +void +tree_breakpoint::visit_octave_user_script (octave_user_script&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_octave_user_function (octave_user_function&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_octave_user_function_header (octave_user_function&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_octave_user_function_trailer (octave_user_function&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_function_def (tree_function_def& fdef) +{ + octave_value fcn = fdef.function (); + + octave_function *f = fcn.function_value (); + + if (f) + f->accept (*this); +} + +void +tree_breakpoint::visit_identifier (tree_identifier&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_if_clause (tree_if_clause&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_if_command (tree_if_command& cmd) +{ + tree_if_command_list *lst = cmd.cmd_list (); + + if (lst) + lst->accept (*this); +} + +void +tree_breakpoint::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 *t = *p; + + if (t->line () >= line) + take_action (*t); + + if (! found) + { + tree_statement_list *stmt_lst = t->commands (); + + if (stmt_lst) + stmt_lst->accept (*this); + } + + if (found) + break; + } +} + +void +tree_breakpoint::visit_index_expression (tree_index_expression&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_matrix (tree_matrix&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_cell (tree_cell&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_multi_assignment (tree_multi_assignment&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_no_op_command (tree_no_op_command&) +{ +} + +void +tree_breakpoint::visit_anon_fcn_handle (tree_anon_fcn_handle&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_constant (tree_constant&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_fcn_handle (tree_fcn_handle&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_parameter_list (tree_parameter_list&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_postfix_expression (tree_postfix_expression&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_prefix_expression (tree_prefix_expression&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_return_command (tree_return_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); +} + +void +tree_breakpoint::visit_return_list (tree_return_list&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_simple_assignment (tree_simple_assignment&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_statement (tree_statement& stmt) +{ + if (stmt.line () >= line) + { + take_action (stmt); + } + else if (stmt.is_command ()) + { + tree_command *cmd = stmt.command (); + + cmd->accept (*this); + } + + // There is no need to do anything for expressions because they + // can't contain additional lists of statements. +} + +void +tree_breakpoint::visit_statement_list (tree_statement_list& lst) +{ + for (tree_statement_list::iterator p = lst.begin (); p != lst.end (); p++) + { + tree_statement *elt = *p; + + if (elt) + { + elt->accept (*this); + + if (found) + break; + } + } +} + +void +tree_breakpoint::visit_switch_case (tree_switch_case&) +{ + panic_impossible (); +} + +void +tree_breakpoint::visit_switch_case_list (tree_switch_case_list& lst) +{ + for (tree_switch_case_list::iterator p = lst.begin (); p != lst.end (); p++) + { + tree_switch_case *t = *p; + + if (t->line () >= line) + take_action (*t); + + if (! found) + { + tree_statement_list *stmt_lst = t->commands (); + + if (stmt_lst) + stmt_lst->accept (*this); + } + + if (found) + break; + } +} + +void +tree_breakpoint::visit_switch_command (tree_switch_command& cmd) +{ + if (cmd.line () >= line) + take_action (cmd); + + if (! found) + { + tree_switch_case_list *lst = cmd.case_list (); + + if (lst) + lst->accept (*this); + } +} + +void +tree_breakpoint::visit_try_catch_command (tree_try_catch_command& cmd) +{ + tree_statement_list *try_code = cmd.body (); + + if (try_code) + try_code->accept (*this); + + if (! found) + { + tree_statement_list *catch_code = cmd.cleanup (); + + if (catch_code) + catch_code->accept (*this); + } +} + +void +tree_breakpoint::visit_unwind_protect_command (tree_unwind_protect_command& cmd) +{ + tree_statement_list *body = cmd.body (); + + if (body) + body->accept (*this); + + if (! found) + { + tree_statement_list *cleanup = cmd.cleanup (); + + if (cleanup) + cleanup->accept (*this); + } +} + +void +tree_breakpoint::take_action (tree& tr) { if (act == set) { @@ -57,635 +459,34 @@ } else panic_impossible (); - - return; -} - -void -tree_breakpoint::visit_while_command (tree_while_command& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); - - tree_expression *expr = cmd.condition (); - - if (expr) - expr->accept (*this); - - tree_statement_list *lst = cmd.body (); - - if (lst) - lst->accept (*this); -} - -void -tree_breakpoint::visit_do_until_command (tree_do_until_command& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); - - tree_statement_list *lst = cmd.body (); - - if (lst) - lst->accept (*this); - - if (found) - return; - - tree_expression *expr = cmd.condition (); - - if (expr) - expr->accept (*this); -} - -void -tree_breakpoint::visit_argument_list (tree_argument_list& lst) -{ - if (found) - return; - - for (tree_argument_list::iterator p = lst.begin (); p != lst.end (); p++) - { - tree_expression *elt = *p; - - if (elt) - elt->accept (*this); - } -} - -void -tree_breakpoint::visit_binary_expression (tree_binary_expression& expr) -{ - if (found) - return; - - tree_expression *lhs = expr.lhs (); - tree_expression *rhs = expr.rhs (); - - if (lhs && lhs->line () >= line) - lhs->accept (*this); - - if (rhs && rhs->line () >= line) - rhs->accept (*this); -} - -void -tree_breakpoint::visit_break_command (tree_break_command& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); -} - -void -tree_breakpoint::visit_colon_expression (tree_colon_expression& expr) -{ - if (found) - return; - - if (expr.line () >= line) - take_action (expr); - - tree_expression *base = expr.base (); - - if (base) - base->accept (*this); - - tree_expression *increment = expr.increment (); - - if (increment) - increment->accept (*this); - - tree_expression *limit = expr.limit (); - - if (limit) - limit->accept (*this); -} - -void -tree_breakpoint::visit_continue_command (tree_continue_command& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); -} - -void -tree_breakpoint::visit_decl_command (tree_decl_command& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); - - tree_decl_init_list *init_list = cmd.initializer_list (); - - if (init_list) - init_list->accept (*this); -} - -void -tree_breakpoint::visit_decl_elt (tree_decl_elt& cmd) -{ - if (found) - return; - - tree_identifier *ident = cmd.ident (); - - if (ident) - ident->accept (*this); - - tree_expression *expr = cmd.expression (); - - if (expr) - expr->accept (*this); - -} - -void -tree_breakpoint::visit_decl_init_list (tree_decl_init_list& lst) -{ - if (found) - return; - - for (tree_decl_init_list::iterator p = lst.begin (); p != lst.end (); p++) - { - tree_decl_elt *elt = *p; - - if (elt) - elt->accept (*this); - } -} - -void -tree_breakpoint::visit_simple_for_command (tree_simple_for_command& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); - - tree_expression *expr = cmd.control_expr (); - - if (expr) - expr->accept (*this); - - tree_statement_list *lst = cmd.body (); - - if (lst) - lst->accept (*this); -} - -void -tree_breakpoint::visit_complex_for_command (tree_complex_for_command& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); - - tree_expression *expr = cmd.control_expr (); - - if (expr) - expr->accept (*this); - - tree_statement_list *lst = cmd.body (); - - if (lst) - lst->accept (*this); - -} - -void -tree_breakpoint::visit_octave_user_script (octave_user_script&) -{ - // FIXME -- should anything happen here? -} - -void -tree_breakpoint::visit_octave_user_function (octave_user_function&) -{ - // We should not visit octave user functions because the function we - // are currently in is the function where the breakpoint was - // requested. -} - -void -tree_breakpoint::visit_octave_user_function_header (octave_user_function&) -{ - // Do nothing. -} - -void -tree_breakpoint::visit_octave_user_function_trailer (octave_user_function&) -{ - // Do nothing. -} - -void -tree_breakpoint::visit_function_def (tree_function_def& fdef) -{ - if (found) - return; - - octave_function *fcn = fdef.function (); - - if (fcn) - fcn->accept (*this); -} - -void -tree_breakpoint::visit_identifier (tree_identifier& id) -{ - if (found) - return; - - if (id.line () >= line ) - take_action (id); -} - -void -tree_breakpoint::visit_if_clause (tree_if_clause& cmd) -{ - if (found) - return; - - tree_expression *expr = cmd.condition (); - - if (expr) - expr->accept (*this); - - tree_statement_list *lst = cmd.commands (); - - if (lst) - lst->accept (*this); -} - -void -tree_breakpoint::visit_if_command (tree_if_command& cmd) -{ - if (found) - return; - - tree_if_command_list *lst = cmd.cmd_list (); - - if (lst) - lst->accept (*this); } void -tree_breakpoint::visit_if_command_list (tree_if_command_list& lst) -{ - if (found) - return; - - for (tree_if_command_list::iterator p = lst.begin (); p != lst.end (); p++) - { - tree_if_clause *elt = *p; - - if (elt) - elt->accept (*this); - } -} - -void -tree_breakpoint::visit_index_expression (tree_index_expression& cmd) +tree_breakpoint::take_action (tree_statement& stmt) { - if (found) - return; - - tree_expression *expr = cmd.expression (); - - if (expr && expr->line () >= line) - take_action (*expr); - - std::list<tree_argument_list *> lst = cmd.arg_lists (); - + int lineno = stmt.line (); - if (! lst.empty ()) + if (act == set) + { + stmt.set_breakpoint (); + line = lineno; + found = true; + } + else if (act == clear) { - for (std::list<tree_argument_list *>::iterator p = lst.begin (); - p != lst.end (); - p++) + stmt.delete_breakpoint (); + found = true; + } + else if (act == list) + { + if (stmt.is_breakpoint ()) { - tree_argument_list *elt = *p; - - if (elt) - elt->accept (*this); + bp_list.append (octave_value (lineno)); + line = lineno + 1; } } -} - -void -tree_breakpoint::visit_matrix (tree_matrix& mat) -{ - if (found) - return; - - tree_matrix::iterator p = mat.begin (); - - while (p != mat.end ()) - { - tree_argument_list *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_breakpoint::visit_cell (tree_cell& cell) -{ - if (found) - return; - - tree_cell::iterator p = cell.begin (); - - while (p != cell.end ()) - { - tree_argument_list *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_breakpoint::visit_multi_assignment (tree_multi_assignment& expr) -{ - if (found) - return; - - tree_argument_list *lst = expr.left_hand_side (); - - if (lst) - lst->accept (*this); - - tree_expression *rhs = expr.right_hand_side (); - - if (rhs) - rhs->accept (*this); -} - -void -tree_breakpoint::visit_no_op_command (tree_no_op_command& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); -} - -void -tree_breakpoint::visit_anon_fcn_handle (tree_anon_fcn_handle& afh) -{ - if (found) - return; - - if (afh.line () >= line) - take_action (afh); -} - -void -tree_breakpoint::visit_constant (tree_constant& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); -} - -void -tree_breakpoint::visit_fcn_handle (tree_fcn_handle& fh) -{ - if (found) - return; - - if (fh.line () >= line) - take_action (fh); -} - -void -tree_breakpoint::visit_parameter_list (tree_parameter_list& lst) -{ - if (found) - return; - - tree_parameter_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_decl_elt *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_breakpoint::visit_postfix_expression (tree_postfix_expression& expr) -{ - if (found) - return; - - if (expr.line () >= line) - take_action (expr); - - tree_expression *e = expr.operand (); - - if (e) - e->accept (*this); -} - -void -tree_breakpoint::visit_prefix_expression (tree_prefix_expression& expr) -{ - if (found) - return; - - if (expr.line () >= line) - take_action (expr); - - tree_expression *e = expr.operand (); - - if (e) - e->accept (*this); -} - -void -tree_breakpoint::visit_return_command (tree_return_command& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); -} - -void -tree_breakpoint::visit_return_list (tree_return_list& lst) -{ - if (found) - return; - - tree_return_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_index_expression *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - -void -tree_breakpoint::visit_simple_assignment (tree_simple_assignment& expr) -{ - if (found) - return; - - if (expr.line () >= line) - take_action (expr); - -} - -void -tree_breakpoint::visit_statement (tree_statement& stmt) -{ - if (found) - return; - - tree_command *cmd = stmt.command (); - - if (cmd) - cmd->accept (*this); else - { - tree_expression *expr = stmt.expression (); - - if (expr) - expr->accept (*this); - } -} - -void -tree_breakpoint::visit_statement_list (tree_statement_list& lst) -{ - if (found) - return; - - for (tree_statement_list::iterator p = lst.begin (); p != lst.end (); p++) - { - tree_statement *elt = *p; - - if (elt) - elt->accept (*this); - } -} - -void -tree_breakpoint::visit_switch_case (tree_switch_case& cmd) -{ - if (found) - return; - - // Disallow breakpoints on the label. - - tree_statement_list *lst = cmd.commands (); - - if (lst) - lst->accept (*this); -} - -void -tree_breakpoint::visit_switch_case_list (tree_switch_case_list& lst) -{ - if (found) - return; - - tree_switch_case_list::iterator p = lst.begin (); - - while (p != lst.end ()) - { - tree_switch_case *elt = *p++; - - if (elt) - elt->accept (*this); - } -} - - -void -tree_breakpoint::visit_switch_command (tree_switch_command& cmd) -{ - if (found) - return; - - tree_expression *expr = cmd.switch_value (); - - if (expr) - expr->accept (*this); - - tree_switch_case_list *lst = cmd.case_list (); - - if (lst) - lst->accept (*this); -} - -void -tree_breakpoint::visit_try_catch_command (tree_try_catch_command& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); - - tree_statement_list *try_code = cmd.body (); - - if (try_code) - try_code->accept (*this); - - tree_statement_list *catch_code = cmd.cleanup (); - - if (catch_code) - catch_code->accept (*this); -} - -void -tree_breakpoint::visit_unwind_protect_command (tree_unwind_protect_command& cmd) -{ - if (found) - return; - - if (cmd.line () >= line) - take_action (cmd); - - tree_statement_list *lstA = cmd.body (); - - if (lstA) - lstA->accept (*this); - - tree_statement_list *lstB = cmd.cleanup (); - - if (lstB) - lstB->accept (*this); + panic_impossible (); } /*
--- a/src/pt-bp.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-bp.h Wed Feb 04 00:47:53 2009 -0500 @@ -30,6 +30,7 @@ #include "toplev.h" class tree; +class tree_decl_command; class tree_breakpoint : public tree_walker @@ -55,7 +56,9 @@ void visit_continue_command (tree_continue_command&); - void visit_decl_command (tree_decl_command&); + void visit_global_command (tree_global_command&); + + void visit_static_command (tree_static_command&); void visit_decl_elt (tree_decl_elt&); @@ -135,7 +138,11 @@ private: - void take_action (tree &tr); + void do_decl_command (tree_decl_command&); + + void take_action (tree& tr); + + void take_action (tree_statement& stmt); // Statement line number we are looking for. int line; @@ -160,49 +167,6 @@ // available breakpoint. extern bool octave_debug_on_interrupt_state; -#define MAYBE_DO_BREAKPOINT \ - do \ - { \ - octave_function *xfcn = octave_call_stack::current (); \ - \ - if (octave_debug_on_interrupt_state \ - || (tree::break_next >= 0 \ - && (tree::break_function == 0 || tree::break_function == xfcn) \ - && (tree::last_break_function != xfcn || tree::last_line != line ())) \ - || is_breakpoint ()) \ - { \ - if (!octave_debug_on_interrupt_state && tree::break_next > 0) \ - { \ - tree::break_next--; \ - if (tree::last_line > 0) \ - tree::last_line = line(); \ - } \ - else \ - { \ - octave_debug_on_interrupt_state = false; \ - \ - tree::break_next = -1; \ - \ - if (xfcn) \ - octave_stdout << xfcn->name () << ": "; \ - \ - octave_stdout << "line " << line () << ", " \ - << "column " << column () \ - << std::endl; \ - \ - tree_print_code tpc (octave_stdout); \ - this->accept (tpc); \ - \ - octave_stdout << std::endl; \ - \ - tree::break_statement = this; \ - \ - do_keyboard (); \ - } \ - } \ - } \ - while (0) - #endif /*
--- a/src/pt-cbinop.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-cbinop.cc Wed Feb 04 00:47:53 2009 -0500 @@ -110,24 +110,21 @@ return ret; } - octave_value -tree_compound_binary_expression::rvalue (void) +tree_compound_binary_expression::rvalue1 (int) { octave_value retval; - MAYBE_DO_BREAKPOINT; - if (error_state) return retval; if (op_lhs) { - octave_value a = op_lhs->rvalue (); + octave_value a = op_lhs->rvalue1 (); if (! error_state && a.is_defined () && op_rhs) { - octave_value b = op_rhs->rvalue (); + octave_value b = op_rhs->rvalue1 (); if (! error_state && b.is_defined ()) {
--- a/src/pt-cbinop.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-cbinop.h Wed Feb 04 00:47:53 2009 -0500 @@ -50,7 +50,7 @@ : tree_binary_expression (a, b, l, c, t), op_lhs (ca), op_rhs (cb), etype (ct) { } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value::compound_binary_op cop_type (void) const { return etype; }
--- a/src/pt-cell.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-cell.cc Wed Feb 04 00:47:53 2009 -0500 @@ -41,12 +41,10 @@ #include "variables.h" octave_value -tree_cell::rvalue (void) +tree_cell::rvalue1 (int) { octave_value retval; - MAYBE_DO_BREAKPOINT; - octave_idx_type nr = length (); octave_idx_type nc = -1; @@ -99,7 +97,7 @@ if (nargout > 1) error ("invalid number of output arguments for cell array"); else - retval = rvalue (); + retval = rvalue1 (nargout); return retval; }
--- a/src/pt-cell.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-cell.h Wed Feb 04 00:47:53 2009 -0500 @@ -49,7 +49,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int);
--- a/src/pt-check.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-check.cc Wed Feb 04 00:47:53 2009 -0500 @@ -91,7 +91,7 @@ } void -tree_checker::visit_decl_command (tree_decl_command& cmd) +tree_checker::do_decl_command (tree_decl_command& cmd) { tree_decl_init_list *init_list = cmd.initializer_list (); @@ -100,6 +100,18 @@ } void +tree_checker::visit_global_command (tree_global_command& cmd) +{ + do_decl_command (cmd); +} + +void +tree_checker::visit_static_command (tree_static_command& cmd) +{ + do_decl_command (cmd); +} + +void tree_checker::visit_decl_elt (tree_decl_elt& cmd) { tree_identifier *id = cmd.ident (); @@ -201,10 +213,12 @@ void tree_checker::visit_function_def (tree_function_def& fdef) { - octave_function *fcn = fdef.function (); + octave_value fcn = fdef.function (); - if (fcn) - fcn->accept (*this); + octave_function *f = fcn.function_value (); + + if (f) + f->accept (*this); } void
--- a/src/pt-check.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-check.h Wed Feb 04 00:47:53 2009 -0500 @@ -26,6 +26,8 @@ #include "pt-walk.h" +class tree_decl_command; + // How to check the semantics of the code that the parse trees represent. class @@ -48,7 +50,9 @@ void visit_continue_command(tree_continue_command&); - void visit_decl_command (tree_decl_command&); + void visit_global_command (tree_global_command&); + + void visit_static_command (tree_static_command&); void visit_decl_elt (tree_decl_elt&); @@ -122,6 +126,8 @@ bool do_lvalue_check; + void do_decl_command (tree_decl_command&); + void gripe (const std::string& msg, int line); // No copying!
--- a/src/pt-cmd.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-cmd.cc Wed Feb 04 00:47:53 2009 -0500 @@ -45,24 +45,6 @@ // Function definition. -void -tree_function_def::eval (void) -{ - octave_function *f = function (); - - 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 (); - } -} - tree_command * tree_function_def::dup (symbol_table::scope_id, symbol_table::context_id /*context*/)
--- a/src/pt-cmd.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-cmd.h Wed Feb 04 00:47:53 2009 -0500 @@ -45,8 +45,6 @@ virtual ~tree_command (void) { } - virtual void eval (void) = 0; - virtual tree_command *dup (symbol_table::scope_id, symbol_table::context_id context) = 0; @@ -71,8 +69,6 @@ ~tree_no_op_command (void) { } - void eval (void) { MAYBE_DO_BREAKPOINT; } - tree_command *dup (symbol_table::scope_id scope, symbol_table::context_id context); @@ -103,14 +99,12 @@ ~tree_function_def (void) { } - void eval (void); - tree_command *dup (symbol_table::scope_id scope, symbol_table::context_id context); void accept (tree_walker& tw); - octave_function *function (void) { return fcn.function_value (); } + octave_value function (void) { return fcn; } private:
--- a/src/pt-colon.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-colon.cc Wed Feb 04 00:47:53 2009 -0500 @@ -76,7 +76,7 @@ if (nargout > 1) error ("invalid number of output arguments for colon expression"); else - retval = rvalue (); + retval = rvalue1 (nargout); return retval; } @@ -165,22 +165,20 @@ } octave_value -tree_colon_expression::rvalue (void) +tree_colon_expression::rvalue1 (int) { octave_value retval; - MAYBE_DO_BREAKPOINT; - if (error_state || ! op_base || ! op_limit) return retval; - octave_value ov_base = op_base->rvalue (); + octave_value ov_base = op_base->rvalue1 (); if (error_state || ov_base.is_undefined ()) eval_error ("invalid base value in colon expression"); else { - octave_value ov_limit = op_limit->rvalue (); + octave_value ov_limit = op_limit->rvalue1 (); if (error_state || ov_limit.is_undefined ()) eval_error ("invalid limit value in colon expression"); @@ -190,7 +188,7 @@ if (op_increment) { - octave_value ov_increment = op_increment->rvalue (); + octave_value ov_increment = op_increment->rvalue1 (); if (error_state || ov_increment.is_undefined ()) eval_error ("invalid increment value in colon expression"); @@ -228,7 +226,7 @@ if (op_increment) { - ov_increment = op_increment->rvalue (); + ov_increment = op_increment->rvalue1 (); if (error_state || ov_increment.is_undefined ()) eval_error ("invalid increment value in colon expression");
--- a/src/pt-colon.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-colon.h Wed Feb 04 00:47:53 2009 -0500 @@ -77,7 +77,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout);
--- a/src/pt-const.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-const.cc Wed Feb 04 00:47:53 2009 -0500 @@ -65,7 +65,7 @@ if (nargout > 1) error ("invalid number of output arguments for constant expression"); else - retval = rvalue (); + retval = rvalue1 (nargout); return retval; }
--- a/src/pt-const.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-const.h Wed Feb 04 00:47:53 2009 -0500 @@ -74,11 +74,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void) - { - MAYBE_DO_BREAKPOINT; - return val; - } + octave_value rvalue1 (int = 1) { return val; } octave_value_list rvalue (int nargout);
--- a/src/pt-decl.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-decl.cc Wed Feb 04 00:47:53 2009 -0500 @@ -55,7 +55,7 @@ { octave_lvalue ult = id->lvalue (); - octave_value init_val = expr->rvalue (); + octave_value init_val = expr->rvalue1 (); if (! error_state) { @@ -84,20 +84,6 @@ // Initializer lists for declaration statements. -void -tree_decl_init_list::eval (tree_decl_elt::eval_fcn f) -{ - for (iterator p = begin (); p != end (); p++) - { - tree_decl_elt *elt = *p; - - f (*elt); - - if (error_state) - break; - } -} - tree_decl_init_list * tree_decl_init_list::dup (symbol_table::scope_id scope, symbol_table::context_id context) @@ -127,53 +113,8 @@ delete init_list; } -void -tree_decl_command::accept (tree_walker& tw) -{ - tw.visit_decl_command (*this); -} - // Global. -void -tree_global_command::do_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->rvalue (); - else - init_val = Matrix (); - - ult.assign (octave_value::op_asn_eq, init_val); - } - } - } -} - -void -tree_global_command::eval (void) -{ - MAYBE_DO_BREAKPOINT; - - if (init_list) - init_list->eval (do_init); -} - tree_command * tree_global_command::dup (symbol_table::scope_id scope, symbol_table::context_id context) @@ -183,45 +124,13 @@ line (), column ()); } -// Static. - void -tree_static_command::do_init (tree_decl_elt& elt) +tree_global_command::accept (tree_walker& tw) { - 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->rvalue (); - else - init_val = Matrix (); - - ult.assign (octave_value::op_asn_eq, init_val); - } - } + tw.visit_global_command (*this); } -void -tree_static_command::eval (void) -{ - MAYBE_DO_BREAKPOINT; - - // Static variables only need to be marked and initialized once. - - if (init_list) - init_list->eval (do_init); -} +// Static. tree_command * tree_static_command::dup (symbol_table::scope_id scope, @@ -232,6 +141,12 @@ line (), column ()); } +void +tree_static_command::accept (tree_walker& tw) +{ + tw.visit_static_command (*this); +} + /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/pt-decl.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-decl.h Wed Feb 04 00:47:53 2009 -0500 @@ -44,8 +44,6 @@ { public: - typedef void (*eval_fcn) (tree_decl_elt &); - tree_decl_elt (tree_identifier *i = 0, tree_expression *e = 0) : id (i), expr (e) { } @@ -65,12 +63,22 @@ bool lvalue_ok (void) { return id ? id->lvalue_ok () : false; } - // Do not allow functions return null values - octave_value rvalue (void) { return id ? id->rvalue ().storable_value () : octave_value (); } + // Do not allow functions to return null values. + octave_value rvalue1 (int nargout = 1) + { + return id ? id->rvalue1 (nargout).storable_value () : octave_value (); + } octave_value_list rvalue (int nargout) { - return id ? id->rvalue (nargout) : octave_value_list (); + octave_value_list retval; + + if (nargout > 1) + error ("invalid number of output arguments in declaration list"); + else + retval = rvalue1 (nargout); + + return retval; } octave_lvalue lvalue (void) { return id ? id->lvalue () : octave_lvalue (); } @@ -118,8 +126,6 @@ } } - void eval (tree_decl_elt::eval_fcn); - tree_decl_init_list *dup (symbol_table::scope_id scope, symbol_table::context_id context); @@ -152,8 +158,6 @@ tree_decl_init_list *initializer_list (void) { return init_list; } - void accept (tree_walker& tw); - std::string name (void) { return cmd_name; } protected: @@ -188,11 +192,11 @@ ~tree_global_command (void) { } - void eval (void); - tree_command *dup (symbol_table::scope_id scope, symbol_table::context_id context); + void accept (tree_walker& tw); + private: static void do_init (tree_decl_elt& elt); @@ -219,11 +223,11 @@ ~tree_static_command (void) { } - void eval (void); - tree_command *dup (symbol_table::scope_id scope, symbol_table::context_id context); + void accept (tree_walker& tw); + private: static void do_init (tree_decl_elt& elt);
--- /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: *** +*/
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/pt-eval.h Wed Feb 04 00:47:53 2009 -0500 @@ -0,0 +1,185 @@ +/* + +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/>. + +*/ + +#if !defined (octave_tree_eval_h) +#define octave_tree_eval_h 1 + +#include <stack> +#include <string> + +#include "comment-list.h" +#include "oct-obj.h" +#include "pt-walk.h" + +class tree_expression; + +// How to evaluate the code that the parse trees represent. + +class +tree_evaluator : public tree_walker +{ +public: + + typedef void (*decl_elt_init_fcn) (tree_decl_elt&); + + tree_evaluator (bool in_function_or_script_body_arg = false) + : in_function_or_script_body (in_function_or_script_body_arg) { } + + ~tree_evaluator (void) { } + + void reset (void) + { + in_function_or_script_body = false; + } + + void visit_anon_fcn_handle (tree_anon_fcn_handle&); + + void visit_argument_list (tree_argument_list&); + + void visit_binary_expression (tree_binary_expression&); + + void visit_break_command (tree_break_command&); + + void visit_colon_expression (tree_colon_expression&); + + void visit_continue_command (tree_continue_command&); + + void visit_global_command (tree_global_command&); + + void visit_static_command (tree_static_command&); + + void visit_decl_elt (tree_decl_elt&); + + void visit_decl_init_list (tree_decl_init_list&); + + void visit_simple_for_command (tree_simple_for_command&); + + void visit_complex_for_command (tree_complex_for_command&); + + void visit_octave_user_script (octave_user_script&); + + void visit_octave_user_function (octave_user_function&); + + void visit_octave_user_function_header (octave_user_function&); + + void visit_octave_user_function_trailer (octave_user_function&); + + void visit_function_def (tree_function_def&); + + void visit_identifier (tree_identifier&); + + void visit_if_clause (tree_if_clause&); + + void visit_if_command (tree_if_command&); + + void visit_if_command_list (tree_if_command_list&); + + void visit_index_expression (tree_index_expression&); + + void visit_matrix (tree_matrix&); + + void visit_cell (tree_cell&); + + void visit_multi_assignment (tree_multi_assignment&); + + void visit_no_op_command (tree_no_op_command&); + + void visit_constant (tree_constant&); + + void visit_fcn_handle (tree_fcn_handle&); + + void visit_parameter_list (tree_parameter_list&); + + void visit_postfix_expression (tree_postfix_expression&); + + void visit_prefix_expression (tree_prefix_expression&); + + void visit_return_command (tree_return_command&); + + void visit_return_list (tree_return_list&); + + void visit_simple_assignment (tree_simple_assignment&); + + void visit_statement (tree_statement&); + + void visit_statement_list (tree_statement_list&); + + void visit_switch_case (tree_switch_case&); + + void visit_switch_case_list (tree_switch_case_list&); + + void visit_switch_command (tree_switch_command&); + + void visit_try_catch_command (tree_try_catch_command&); + + void visit_unwind_protect_command (tree_unwind_protect_command&); + + void visit_while_command (tree_while_command&); + + void visit_do_until_command (tree_do_until_command&); + + static int debug_line (void) { return db_line; } + + static int debug_column (void) { return db_column; } + + // If > 0, stop executing at the (N-1)th stopping point, counting + // from the the current execution point in the current frame. + // + // If < 0, stop executing at the next possible stopping point. + static int dbstep_flag; + + // The number of the stack frame we are currently debugging. + static size_t current_frame; + + static bool debug_mode; + +private: + + bool in_function_or_script_body; + + void do_decl_init_list (decl_elt_init_fcn fcn, + tree_decl_init_list *init_list); + + void do_breakpoint (tree_statement& stmt) const; + + void do_breakpoint (bool is_breakpoint, int l, int c, + bool is_end_of_fcn_or_script = false) const; + + static int db_line; + static int db_column; + + // No copying! + + tree_evaluator (const tree_evaluator&); + + tree_evaluator& operator = (const tree_evaluator&); +}; + +extern tree_evaluator *current_evaluator; + +#endif + +/* +;;; Local Variables: *** +;;; mode: C++ *** +;;; End: *** +*/
--- a/src/pt-except.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-except.cc Wed Feb 04 00:47:53 2009 -0500 @@ -51,89 +51,6 @@ delete trail_comm; } -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->eval (); -} - -void -tree_try_catch_command::eval (void) -{ - unwind_protect::begin_frame ("tree_try_catch::eval"); - - MAYBE_DO_BREAKPOINT; - - 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; - - unwind_protect::add (do_catch_code, catch_code); - - if (try_code) - try_code->eval (); - - if (catch_code && error_state) - { - error_state = 0; - unwind_protect::run_frame ("tree_try_catch::eval"); - } - 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 (); - } -} - tree_command * tree_try_catch_command::dup (symbol_table::scope_id scope, symbol_table::context_id context) @@ -164,94 +81,6 @@ delete trail_comm; } -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->eval (); - - // 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_unwind_protect_command::eval (void) -{ - unwind_protect::add (do_unwind_protect_cleanup_code, cleanup_code); - - MAYBE_DO_BREAKPOINT; - - if (unwind_protect_code) - unwind_protect_code->eval (); - - unwind_protect::run (); -} - tree_command * tree_unwind_protect_command::dup (symbol_table::scope_id scope, symbol_table::context_id context)
--- a/src/pt-except.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-except.h Wed Feb 04 00:47:53 2009 -0500 @@ -53,8 +53,6 @@ ~tree_try_catch_command (void); - void eval (void); - tree_statement_list *body (void) { return try_code; } tree_statement_list *cleanup (void) { return catch_code; } @@ -116,8 +114,6 @@ ~tree_unwind_protect_command (void); - void eval (void); - tree_statement_list *body (void) { return unwind_protect_code; } tree_statement_list *cleanup (void) { return cleanup_code; }
--- a/src/pt-exp.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-exp.cc Wed Feb 04 00:47:53 2009 -0500 @@ -40,7 +40,7 @@ { bool expr_value = false; - octave_value t1 = rvalue (); + octave_value t1 = rvalue1 (); if (! error_state) { @@ -55,7 +55,7 @@ } octave_value -tree_expression::rvalue (void) +tree_expression::rvalue1 (int) { ::error ("invalid rvalue function called in expression"); return octave_value ();
--- a/src/pt-exp.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-exp.h Wed Feb 04 00:47:53 2009 -0500 @@ -74,7 +74,7 @@ virtual bool rvalue_ok (void) const { return false; } - virtual octave_value rvalue (void); + virtual octave_value rvalue1 (int nargout = 1); virtual octave_value_list rvalue (int nargout);
--- a/src/pt-fcn-handle.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-fcn-handle.cc Wed Feb 04 00:47:53 2009 -0500 @@ -49,14 +49,11 @@ } octave_value -tree_fcn_handle::rvalue (void) +tree_fcn_handle::rvalue1 (int) { - MAYBE_DO_BREAKPOINT; - return make_fcn_handle (nm); } - octave_value_list tree_fcn_handle::rvalue (int nargout) { @@ -65,7 +62,7 @@ if (nargout > 1) error ("invalid number of output arguments for function handle expression"); else - retval = rvalue (); + retval = rvalue1 (nargout); return retval; } @@ -88,10 +85,8 @@ } octave_value -tree_anon_fcn_handle::rvalue (void) +tree_anon_fcn_handle::rvalue1 (int) { - MAYBE_DO_BREAKPOINT; - tree_parameter_list *param_list = parameter_list (); tree_parameter_list *ret_list = return_list (); tree_statement_list *cmd_list = body (); @@ -140,7 +135,7 @@ if (nargout > 1) error ("invalid number of output arguments for anonymous function handle expression"); else - retval = rvalue (); + retval = rvalue1 (nargout); return retval; }
--- a/src/pt-fcn-handle.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-fcn-handle.h Wed Feb 04 00:47:53 2009 -0500 @@ -65,7 +65,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout); @@ -106,7 +106,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout);
--- a/src/pt-id.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-id.cc Wed Feb 04 00:47:53 2009 -0500 @@ -100,11 +100,11 @@ } octave_value -tree_identifier::rvalue (void) +tree_identifier::rvalue1 (int nargout) { octave_value retval; - octave_value_list tmp = rvalue (1); + octave_value_list tmp = rvalue (nargout); if (! tmp.empty ()) retval = tmp(0);
--- a/src/pt-id.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-id.h Wed Feb 04 00:47:53 2009 -0500 @@ -87,8 +87,6 @@ do_lookup (tree_argument_list *args, const string_vector& arg_names, octave_value_list& evaluated_args, bool& args_evaluated) { - MAYBE_DO_BREAKPOINT; - return xsym().find (args, arg_names, evaluated_args, args_evaluated); } @@ -103,7 +101,7 @@ bool lvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout);
--- a/src/pt-idx.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-idx.cc Wed Feb 04 00:47:53 2009 -0500 @@ -199,7 +199,7 @@ if (df) { - octave_value t = df->rvalue (); + octave_value t = df->rvalue1 (); if (! error_state) { @@ -300,7 +300,7 @@ if (! error_state) { if (first_expr_val.is_undefined ()) - first_expr_val = expr->rvalue (); + first_expr_val = expr->rvalue1 (); octave_value tmp = first_expr_val; octave_idx_type tmpi = 0; @@ -386,11 +386,11 @@ } octave_value -tree_index_expression::rvalue (void) +tree_index_expression::rvalue1 (int nargout) { octave_value retval; - const octave_value_list tmp = rvalue (1); + const octave_value_list tmp = rvalue (nargout); if (! tmp.empty ()) retval = tmp(0);
--- a/src/pt-idx.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-idx.h Wed Feb 04 00:47:53 2009 -0500 @@ -82,7 +82,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout);
--- a/src/pt-jump.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-jump.cc Wed Feb 04 00:47:53 2009 -0500 @@ -38,16 +38,6 @@ // Nonzero means we're breaking out of a loop or function body. int tree_break_command::breaking = 0; -void -tree_break_command::eval (void) -{ - // Even if we have an error we should still enter debug mode. - MAYBE_DO_BREAKPOINT; - - if (! error_state) - breaking = 1; -} - tree_command * tree_break_command::dup (symbol_table::scope_id, symbol_table::context_id /*context*/) @@ -66,15 +56,6 @@ // Nonzero means we're jumping to the end of a loop. int tree_continue_command::continuing = 0; -void -tree_continue_command::eval (void) -{ - MAYBE_DO_BREAKPOINT; - - if (! error_state) - continuing = 1; -} - tree_command * tree_continue_command::dup (symbol_table::scope_id, symbol_table::context_id /*context*/) @@ -93,15 +74,6 @@ // Nonzero means we're returning from a function. int tree_return_command::returning = 0; -void -tree_return_command::eval (void) -{ - MAYBE_DO_BREAKPOINT; - - if (! error_state) - returning = 1; -} - tree_command * tree_return_command::dup (symbol_table::scope_id, symbol_table::context_id /*context*/)
--- a/src/pt-jump.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-jump.h Wed Feb 04 00:47:53 2009 -0500 @@ -40,8 +40,6 @@ ~tree_break_command (void) { } - void eval (void); - tree_command *dup (symbol_table::scope_id scope, symbol_table::context_id context); @@ -70,8 +68,6 @@ ~tree_continue_command (void) { } - void eval (void); - tree_command *dup (symbol_table::scope_id scope, symbol_table::context_id context); @@ -100,8 +96,6 @@ ~tree_return_command (void) { } - void eval (void); - tree_command *dup (symbol_table::scope_id scope, symbol_table::context_id context);
--- a/src/pt-loop.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-loop.cc Wed Feb 04 00:47:53 2009 -0500 @@ -77,44 +77,6 @@ delete trail_comm; } -void -tree_while_command::eval (void) -{ - if (error_state) - return; - - unwind_protect::begin_frame ("while_command::eval"); - - unwind_protect_bool (evaluating_looping_command); - - evaluating_looping_command = true; - - if (! expr) - panic_impossible (); - - for (;;) - { - if (expr->is_logically_true ("while")) - { - if (list) - { - list->eval (); - - if (error_state) - goto cleanup; - } - - if (quit_loop_now ()) - break; - } - else - break; - } - - cleanup: - unwind_protect::run_frame ("while_command::eval"); -} - tree_command * tree_while_command::dup (symbol_table::scope_id scope, symbol_table::context_id context) @@ -134,41 +96,6 @@ // Do-Until -void -tree_do_until_command::eval (void) -{ - if (error_state) - return; - - unwind_protect::begin_frame ("do_until_command::eval"); - - unwind_protect_bool (evaluating_looping_command); - - evaluating_looping_command = true; - - if (! expr) - panic_impossible (); - - for (;;) - { - MAYBE_DO_BREAKPOINT; - - if (list) - { - list->eval (); - - if (error_state) - goto cleanup; - } - - if (quit_loop_now () || expr->is_logically_true ("do-until")) - break; - } - - cleanup: - unwind_protect::run_frame ("do_until_command::eval"); -} - tree_command * tree_do_until_command::dup (symbol_table::scope_id scope, symbol_table::context_id context) @@ -196,263 +123,6 @@ delete trail_comm; } -inline void -tree_simple_for_command::do_for_loop_once (octave_lvalue& ult, - const octave_value& rhs, - bool& quit) -{ - ult.assign (octave_value::op_asn_eq, rhs); - - if (! error_state && list) - list->eval (); - - quit = quit_loop_now (); -} - -#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++) \ - { \ - MAYBE_DO_BREAKPOINT; \ - \ - do_for_loop_once (ult, val, quit); \ - \ - if (quit) \ - break; \ - } \ - } \ - else if (nrows == 1) \ - { \ - for (octave_idx_type i = 0; i < steps; i++) \ - { \ - MAYBE_DO_BREAKPOINT; \ - \ - octave_value val (CONV (*atmp++)); \ - \ - do_for_loop_once (ult, val, quit); \ - \ - 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++) \ - { \ - MAYBE_DO_BREAKPOINT; \ - \ - for (int j = 0; j < nrows; j++) \ - ftmp[j] = *atmp++; \ - \ - octave_value val (tmp); \ - \ - do_for_loop_once (ult, val, quit); \ - quit = (i == steps - 1 ? true : quit); \ - \ - if (quit) \ - break; \ - } \ - } \ - } \ - } \ - while (0) - -void -tree_simple_for_command::eval (void) -{ - if (error_state) - return; - - unwind_protect::begin_frame ("simple_for_command::eval"); - - unwind_protect_bool (evaluating_looping_command); - - evaluating_looping_command = true; - - octave_value rhs = expr->rvalue (); - - if (error_state || rhs.is_undefined ()) - goto cleanup; - - { - octave_lvalue ult = lhs->lvalue (); - - if (error_state) - goto cleanup; - - 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++) - { - MAYBE_DO_BREAKPOINT; - - // 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_for_loop_once (ult, val, quit); - - if (quit) - break; - } - } - else if (rhs.is_scalar_type ()) - { - bool quit = false; - - MAYBE_DO_BREAKPOINT; - - do_for_loop_once (ult, rhs, quit); - } - 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++) - { - MAYBE_DO_BREAKPOINT; - - octave_value val (chm_tmp.xelem (0, i)); - - do_for_loop_once (ult, val, quit); - - if (quit) - break; - } - } - else - { - for (octave_idx_type i = 0; i < steps; i++) - { - MAYBE_DO_BREAKPOINT; - - octave_value val (chm_tmp.extract (0, i, nr-1, i), true); - - do_for_loop_once (ult, val, quit); - - 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++) - { - MAYBE_DO_BREAKPOINT; - - Cell val_lst = tmp_val.contents (p); - - octave_value val - = (val_lst.length () == 1) ? val_lst(0) : octave_value (val_lst); - - do_for_loop_once (ult, val, quit); - - 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", - line (), column ()); - } - } - - cleanup: - unwind_protect::run_frame ("simple_for_command::eval"); -} - tree_command * tree_simple_for_command::dup (symbol_table::scope_id scope, symbol_table::context_id context) @@ -479,82 +149,6 @@ delete trail_comm; } -void -tree_complex_for_command::do_for_loop_once (octave_lvalue &val_ref, - octave_lvalue &key_ref, - const octave_value& val, - const octave_value& key, - bool& quit) -{ - quit = false; - - val_ref.assign (octave_value::op_asn_eq, val); - key_ref.assign (octave_value::op_asn_eq, key); - - if (! error_state && list) - list->eval (); - - quit = quit_loop_now (); -} - -void -tree_complex_for_command::eval (void) -{ - if (error_state) - return; - - unwind_protect::begin_frame ("complex_for_command::eval"); - - unwind_protect_bool (evaluating_looping_command); - - evaluating_looping_command = true; - - octave_value rhs = expr->rvalue (); - - 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::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 ()); - - 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); - - MAYBE_DO_BREAKPOINT; - - bool quit = false; - - do_for_loop_once (key_ref, val_ref, key, val, quit); - - if (quit) - break; - } - } - else - error ("in statement `for [X, Y] = VAL', VAL must be a structure"); - - cleanup: - unwind_protect::run_frame ("complex_for_command::eval"); -} - tree_command * tree_complex_for_command::dup (symbol_table::scope_id scope, symbol_table::context_id context)
--- a/src/pt-loop.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-loop.h Wed Feb 04 00:47:53 2009 -0500 @@ -67,8 +67,6 @@ ~tree_while_command (void); - void eval (void); - tree_expression *condition (void) { return expr; } tree_statement_list *body (void) { return list; } @@ -129,8 +127,6 @@ ~tree_do_until_command (void) { } - void eval (void); - tree_command *dup (symbol_table::scope_id scope, symbol_table::context_id context); @@ -166,8 +162,6 @@ ~tree_simple_for_command (void); - void eval (void); - tree_expression *left_hand_side (void) { return lhs; } tree_expression *control_expr (void) { return expr; } @@ -229,8 +223,6 @@ ~tree_complex_for_command (void); - void eval (void); - tree_argument_list *left_hand_side (void) { return lhs; } tree_expression *control_expr (void) { return expr; }
--- a/src/pt-mat.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-mat.cc Wed Feb 04 00:47:53 2009 -0500 @@ -376,7 +376,7 @@ tree_expression *elt = *p; - octave_value tmp = elt->rvalue (); + octave_value tmp = elt->rvalue1 (); if (error_state || tmp.is_undefined ()) break; @@ -703,12 +703,10 @@ { octave_value_list retval; - MAYBE_DO_BREAKPOINT; - if (nargout > 1) error ("invalid number of output arguments for matrix list"); else - retval = rvalue (); + retval = rvalue1 (nargout); return retval; } @@ -772,7 +770,7 @@ while (0) octave_value -tree_matrix::rvalue (void) +tree_matrix::rvalue1 (int) { octave_value retval = Matrix ();
--- a/src/pt-mat.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-mat.h Wed Feb 04 00:47:53 2009 -0500 @@ -60,7 +60,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout);
--- a/src/pt-misc.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-misc.cc Wed Feb 04 00:47:53 2009 -0500 @@ -218,7 +218,7 @@ { tree_decl_elt *elt = *p; - retval(i++) = elt->is_defined () ? elt->rvalue () : octave_value (); + retval(i++) = elt->is_defined () ? elt->rvalue1 () : octave_value (); } for (octave_idx_type j = 0; j < vlen; j++)
--- a/src/pt-pr-code.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-pr-code.cc Wed Feb 04 00:47:53 2009 -0500 @@ -150,7 +150,7 @@ } void -tree_print_code::visit_decl_command (tree_decl_command& cmd) +tree_print_code::do_decl_command (tree_decl_command& cmd) { indent (); @@ -163,6 +163,18 @@ } void +tree_print_code::visit_global_command (tree_global_command& cmd) +{ + do_decl_command (cmd); +} + +void +tree_print_code::visit_static_command (tree_static_command& cmd) +{ + do_decl_command (cmd); +} + +void tree_print_code::visit_decl_elt (tree_decl_elt& cmd) { tree_identifier *id = cmd.ident (); @@ -422,10 +434,12 @@ { indent (); - octave_function *fcn = fdef.function (); + octave_value fcn = fdef.function (); - if (fcn) - fcn->accept (*this); + octave_function *f = fcn.function_value (); + + if (f) + f->accept (*this); } void
--- a/src/pt-pr-code.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-pr-code.h Wed Feb 04 00:47:53 2009 -0500 @@ -30,6 +30,7 @@ #include "comment-list.h" #include "pt-walk.h" +class tree_decl_command; class tree_expression; // How to print the code that the parse trees represent. @@ -65,7 +66,9 @@ void visit_continue_command (tree_continue_command&); - void visit_decl_command (tree_decl_command&); + void visit_global_command (tree_global_command&); + + void visit_static_command (tree_static_command&); void visit_decl_elt (tree_decl_elt&); @@ -160,6 +163,8 @@ // TRUE means we are printing newlines and indenting. bool printing_newlines; + void do_decl_command (tree_decl_command& cmd); + void reset_indent_level (void) { curr_print_indent_level = 0; } void increment_indent_level (void) { curr_print_indent_level += 2; }
--- a/src/pt-select.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-select.cc Wed Feb 04 00:47:53 2009 -0500 @@ -45,20 +45,6 @@ delete lead_comm; } -int -tree_if_clause::eval (void) -{ - if (is_else_clause () || expr->is_logically_true ("if")) - { - if (list) - list->eval (); - - return 1; - } - - return 0; -} - tree_if_clause * tree_if_clause::dup (symbol_table::scope_id scope, symbol_table::context_id context) @@ -76,18 +62,6 @@ // List of if commands. -void -tree_if_command_list::eval (void) -{ - for (iterator p = begin (); p != end (); p++) - { - tree_if_clause *t = *p; - - if (t->eval () || error_state) - break; - } -} - tree_if_command_list * tree_if_command_list::dup (symbol_table::scope_id scope, symbol_table::context_id context) @@ -119,13 +93,6 @@ delete trail_comm; } -void -tree_if_command::eval (void) -{ - if (list) - list->eval (); -} - tree_command * tree_if_command::dup (symbol_table::scope_id scope, symbol_table::context_id context) @@ -155,7 +122,7 @@ bool tree_switch_case::label_matches (const octave_value& val) { - octave_value label_value = label->rvalue (); + octave_value label_value = label->rvalue1 (); if (! error_state && label_value.is_defined() ) { @@ -190,22 +157,6 @@ return false; } -int -tree_switch_case::eval (const octave_value& val) -{ - int retval = 0; - - if (is_default_case () || label_matches (val)) - { - if (list) - list->eval (); - - retval = 1; - } - - return retval; -} - tree_switch_case * tree_switch_case::dup (symbol_table::scope_id scope, symbol_table::context_id context) @@ -223,18 +174,6 @@ // List of switch cases. -void -tree_switch_case_list::eval (const octave_value& val) -{ - for (iterator p = begin (); p != end (); p++) - { - tree_switch_case *t = *p; - - if (t->eval (val) || error_state) - break; - } -} - tree_switch_case_list * tree_switch_case_list::dup (symbol_table::scope_id scope, symbol_table::context_id context) @@ -267,21 +206,6 @@ delete trail_comm; } -void -tree_switch_command::eval (void) -{ - if (expr) - { - octave_value val = expr->rvalue (); - - if (! error_state && list) - list->eval (val); - } - else - ::error ("missing value in switch command near line %d, column %d", - line (), column ()); -} - tree_command * tree_switch_command::dup (symbol_table::scope_id scope, symbol_table::context_id context)
--- a/src/pt-select.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-select.h Wed Feb 04 00:47:53 2009 -0500 @@ -37,26 +37,25 @@ // If. class -tree_if_clause +tree_if_clause : public tree { public: - tree_if_clause (void) - : expr (0), list (0), lead_comm (0) { } + tree_if_clause (int l = -1, int c = -1) + : tree (l, c), expr (0), list (0), lead_comm (0) { } - tree_if_clause (tree_statement_list *l, octave_comment_list *lc = 0) - : expr (0), list (l), lead_comm (lc) { } + tree_if_clause (tree_statement_list *sl, octave_comment_list *lc = 0, + int l = -1, int c = -1) + : tree (l, c), expr (0), list (sl), lead_comm (lc) { } - tree_if_clause (tree_expression *e, tree_statement_list *l, - octave_comment_list *lc = 0) - : expr (e), list (l), lead_comm (lc) { } + tree_if_clause (tree_expression *e, tree_statement_list *sl, + octave_comment_list *lc = 0, + int l = -1, int c = -1) + : tree (l, c), expr (e), list (sl), lead_comm (lc) { } ~tree_if_clause (void); - bool is_else_clause (void) - { return ! expr; } - - int eval (void); + bool is_else_clause (void) { return ! expr; } tree_expression *condition (void) { return expr; } @@ -106,8 +105,6 @@ } } - void eval (void); - tree_if_command_list *dup (symbol_table::scope_id scope, symbol_table::context_id context); @@ -136,8 +133,6 @@ ~tree_if_command (void); - void eval (void); - tree_if_command_list *cmd_list (void) { return list; } octave_comment_list *leading_comment (void) { return lead_comm; } @@ -170,19 +165,21 @@ // Switch. class -tree_switch_case +tree_switch_case : public tree { public: - tree_switch_case (void) - : label (0), list (0), lead_comm (0) { } + tree_switch_case (int l = -1, int c = -1) + : tree (l, c), label (0), list (0), lead_comm (0) { } - tree_switch_case (tree_statement_list *l, octave_comment_list *lc = 0) - : label (0), list (l), lead_comm (lc) { } + tree_switch_case (tree_statement_list *sl, octave_comment_list *lc = 0, + int l = -1, int c = -1) + : tree (l, c), label (0), list (sl), lead_comm (lc) { } - tree_switch_case (tree_expression *e, tree_statement_list *l, - octave_comment_list *lc = 0) - : label (e), list (l), lead_comm (lc) { } + tree_switch_case (tree_expression *e, tree_statement_list *sl, + octave_comment_list *lc = 0, + int l = -1, int c = -1) + : tree (l, c), label (e), list (sl), lead_comm (lc) { } ~tree_switch_case (void); @@ -190,8 +187,6 @@ bool label_matches (const octave_value& val); - int eval (const octave_value& val); - tree_expression *case_label (void) { return label; } tree_statement_list *commands (void) { return list; } @@ -240,8 +235,6 @@ } } - void eval (const octave_value& val); - tree_switch_case_list *dup (symbol_table::scope_id scope, symbol_table::context_id context); @@ -273,8 +266,6 @@ ~tree_switch_command (void); - void eval (void); - tree_expression *switch_value (void) { return expr; } tree_switch_case_list *case_list (void) { return list; }
--- a/src/pt-stmt.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-stmt.cc Wed Feb 04 00:47:53 2009 -0500 @@ -25,6 +25,8 @@ #include <config.h> #endif +#include <typeinfo> + #include "quit.h" #include "defun.h" @@ -55,14 +57,27 @@ delete comm; } +void +tree_statement::set_print_flag (bool print_flag) +{ + if (expr) + expr->set_print_flag (print_flag); +} + +bool +tree_statement::print_result (void) +{ + return expr && expr->print_result (); +} + int -tree_statement::line (void) +tree_statement::line (void) const { return cmd ? cmd->line () : (expr ? expr->line () : -1); } int -tree_statement::column (void) +tree_statement::column (void) const { return cmd ? cmd->column () : (expr ? expr->column () : -1); } @@ -79,58 +94,21 @@ } } -octave_value_list -tree_statement::eval (bool silent, int nargout, - bool in_function_or_script_body) +bool +tree_statement::is_end_of_fcn_or_script (void) const { - octave_value_list retval; - - bool pf = silent ? false : print_flag; - - if (cmd || expr) - { - if (in_function_or_script_body) - octave_call_stack::set_statement (this); - - maybe_echo_code (in_function_or_script_body); - - try - { - if (cmd) - cmd->eval (); - else - { - expr->set_print_flag (pf); + bool retval = 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->rvalue () 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); + if (cmd) + { + tree_no_op_command *no_op_cmd + = dynamic_cast<tree_no_op_command *> (cmd); - do_bind_ans = (! id->is_variable ()); - } - else - do_bind_ans = (! expr->is_assignment_expression ()); - - retval = expr->rvalue (nargout); + if (no_op_cmd) + { + std::string type = no_op_cmd->original_command (); - if (do_bind_ans && ! (error_state || retval.empty ())) - bind_ans (retval(0), pf); - } - } - catch (octave_execution_exception) - { - gripe_library_execution_error (); + retval = (type == "endfunction" || type == "endscript"); } } @@ -147,9 +125,9 @@ new_stmt->expr = expr ? expr->dup (scope, context) : 0; - new_stmt->comm = comm ? comm->dup () : 0; + new_stmt->bp = bp; - new_stmt->print_flag = print_flag; + new_stmt->comm = comm ? comm->dup () : 0; return new_stmt; } @@ -160,69 +138,6 @@ tw.visit_statement (*this); } -octave_value_list -tree_statement_list::eval (bool silent, int nargout) -{ - octave_value_list retval; - - static octave_value_list empty_list; - - if (error_state) - return retval; - - iterator p = begin (); - - if (p != end ()) - { - while (true) - { - tree_statement *elt = *p++; - - if (elt) - { - OCTAVE_QUIT; - - retval = elt->eval (silent, nargout, - function_body || script_body); - - if (error_state) - break; - - if (tree_break_command::breaking - || tree_continue_command::continuing) - break; - - if (tree_return_command::returning) - break; - - if (p == 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 - - retval = empty_list; - } - } - else - error ("invalid statement found in statement list!"); - } - } - - return retval; -} - int tree_statement_list::set_breakpoint (int line) {
--- a/src/pt-stmt.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-stmt.h Wed Feb 04 00:47:53 2009 -0500 @@ -46,40 +46,45 @@ public: tree_statement (void) - : cmd (0), expr (0), comm (0), print_flag (true) { } + : cmd (0), expr (0), bp (false), comm (0) { } tree_statement (tree_command *c, octave_comment_list *cl) - : cmd (c), expr (0), comm (cl), print_flag (true) { } + : cmd (c), expr (0), bp (false), comm (cl) { } tree_statement (tree_expression *e, octave_comment_list *cl) - : cmd (0), expr (e), comm (cl), print_flag (true) { } + : cmd (0), expr (e), bp (false), comm (cl) { } ~tree_statement (void); - void set_print_flag (bool print) { print_flag = print; } + void set_print_flag (bool print_flag); + + bool print_result (void); - bool is_command (void) { return cmd != 0; } + bool is_command (void) const { return cmd != 0; } + + bool is_expression (void) const { return expr != 0; } - bool is_expression (void) { return expr != 0; } + void set_breakpoint (void) { bp = true; } + + void delete_breakpoint (void) { bp = false; } - int line (void); - int column (void); + bool is_breakpoint (void) const { return bp; } + + int line (void) const; + int column (void) const; void maybe_echo_code (bool in_function_body); - bool print_result (void) { return print_flag; } - tree_command *command (void) { return cmd; } - octave_value_list eval (bool silent, int nargout, - bool in_function_or_script_body); - tree_expression *expression (void) { return expr; } octave_comment_list *comment_text (void) { return comm; } bool is_null_statement (void) const { return ! (cmd || expr || comm); } + bool is_end_of_fcn_or_script (void) const; + // Allow modification of this statement. Note that there is no // checking. If you use these, are you sure you knwo what you are // doing? @@ -103,12 +108,12 @@ // Expression to evaluate. tree_expression *expr; + // Breakpoint flag. + bool bp; + // Comment associated with this statement. octave_comment_list *comm; - // Print result of eval for this command? - bool print_flag; - // No copying! tree_statement (const tree_statement&); @@ -123,10 +128,12 @@ public: tree_statement_list (void) - : function_body (false), script_body (false) { } + : function_body (false), anon_function_body (false), + script_body (false) { } tree_statement_list (tree_statement *s) - : function_body (false), script_body (false) { append (s); } + : function_body (false), anon_function_body (false), + script_body (false) { append (s); } ~tree_statement_list (void) { @@ -140,9 +147,15 @@ void mark_as_function_body (void) { function_body = true; } + void mark_as_anon_function_body (void) { anon_function_body = true; } + void mark_as_script_body (void) { script_body = true; } - octave_value_list eval (bool silent = false, int nargout = 0); + bool is_function_body (void) const { return function_body; } + + bool is_anon_function_body (void) const { return anon_function_body; } + + bool is_script_body (void) const { return script_body; } int set_breakpoint (int line); @@ -160,6 +173,9 @@ // Does this list of statements make up the body of a function? bool function_body; + // Does this list of statements make up the body of a function? + bool anon_function_body; + // Does this list of statements make up the body of a script? bool script_body;
--- a/src/pt-unop.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-unop.cc Wed Feb 04 00:47:53 2009 -0500 @@ -52,18 +52,16 @@ error ("prefix operator `%s': invalid number of output arguments", oper () . c_str ()); else - retval = rvalue (); + retval = rvalue1 (nargout); return retval; } octave_value -tree_prefix_expression::rvalue (void) +tree_prefix_expression::rvalue1 (int) { octave_value retval; - MAYBE_DO_BREAKPOINT; - if (error_state) return retval; @@ -71,7 +69,7 @@ { if (etype == octave_value::op_incr || etype == octave_value::op_decr) { - op->rvalue (); + op->rvalue1 (); if (! error_state) { @@ -87,7 +85,7 @@ } else { - octave_value val = op->rvalue (); + octave_value val = op->rvalue1 (); if (! error_state && val.is_defined ()) { @@ -132,18 +130,16 @@ error ("postfix operator `%s': invalid number of output arguments", oper () . c_str ()); else - retval = rvalue (); + retval = rvalue1 (nargout); return retval; } octave_value -tree_postfix_expression::rvalue (void) +tree_postfix_expression::rvalue1 (int) { octave_value retval; - MAYBE_DO_BREAKPOINT; - if (error_state) return retval; @@ -151,7 +147,7 @@ { if (etype == octave_value::op_incr || etype == octave_value::op_decr) { - op->rvalue (); + op->rvalue1 (); if (! error_state) { @@ -167,7 +163,7 @@ } else { - octave_value val = op->rvalue (); + octave_value val = op->rvalue1 (); if (! error_state && val.is_defined ()) {
--- a/src/pt-unop.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-unop.h Wed Feb 04 00:47:53 2009 -0500 @@ -100,7 +100,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout); @@ -137,7 +137,7 @@ bool rvalue_ok (void) const { return true; } - octave_value rvalue (void); + octave_value rvalue1 (int nargout = 1); octave_value_list rvalue (int nargout);
--- a/src/pt-walk.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt-walk.h Wed Feb 04 00:47:53 2009 -0500 @@ -30,7 +30,8 @@ class tree_break_command; class tree_colon_expression; class tree_continue_command; -class tree_decl_command; +class tree_global_command; +class tree_static_command; class tree_decl_elt; class tree_decl_init_list; class tree_simple_for_command; @@ -89,7 +90,10 @@ visit_continue_command (tree_continue_command&) = 0; virtual void - visit_decl_command (tree_decl_command&) = 0; + visit_global_command (tree_global_command&) = 0; + + virtual void + visit_static_command (tree_static_command&) = 0; virtual void visit_decl_elt (tree_decl_elt&) = 0;
--- a/src/pt.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt.cc Wed Feb 04 00:47:53 2009 -0500 @@ -33,21 +33,6 @@ #include "pt.h" #include "pt-pr-code.h" -// If zero, stop executing at the next possible point. -int tree::break_next = -1; - -// The line where dbnext was executed. -int tree::last_line = 0; - -// The function where the last breakpoint occurred. -const octave_function *tree::last_break_function = 0; - -// The function where the next breakpoint is request. -const octave_function *tree::break_function = 0; - -// The statement where the last breakpoint occurred. -const tree *tree::break_statement = 0; - // Hide the details of the string buffer so that we are less likely to // create a memory leak.
--- a/src/pt.h Tue Feb 03 12:47:38 2009 +0100 +++ b/src/pt.h Wed Feb 04 00:47:53 2009 -0500 @@ -38,47 +38,24 @@ { public: - tree (int l = -1, int c = -1) : break_point(false) - { - line_num = l; - column_num = c; - } + tree (int l = -1, int c = -1) + : line_num (l), column_num (c), bp (false) { } virtual ~tree (void) { } - virtual int line (void) const - { return line_num; } + virtual int line (void) const { return line_num; } + + virtual int column (void) const { return column_num; } - virtual int column (void) const - { return column_num; } + void set_breakpoint (void) { bp = true; } - virtual void accept (tree_walker& tw) = 0; + void delete_breakpoint (void) { bp = false; } + + bool is_breakpoint (void) const { return bp; } std::string str_print_code (void); - virtual void set_breakpoint (void) - { break_point = true; } - - virtual void delete_breakpoint (void) - { break_point = false; } - - virtual bool is_breakpoint (void) const - { return break_point; } - - // If true, stop executing at the next possible point. - static int break_next; - - // The line where dbnext was executed. - static int last_line; - - // The function where the last breakpoint occurred. - static const octave_function *last_break_function; - - // The function where the next breakpoint is request. - static const octave_function *break_function; - - // The statement where the last breakpoint occurred. - static const tree *break_statement; + virtual void accept (tree_walker& tw) = 0; private: @@ -87,8 +64,8 @@ int line_num; int column_num; - // Stop before executing this tree node - bool break_point; + // Breakpoint flag. + bool bp; // No copying!
--- a/src/sighandlers.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/sighandlers.cc Wed Feb 04 00:47:53 2009 -0500 @@ -41,12 +41,14 @@ #include "oct-syscalls.h" #include "quit.h" +#include "debug.h" #include "defun.h" #include "error.h" #include "load-save.h" #include "oct-map.h" #include "pager.h" #include "pt-bp.h" +#include "pt-eval.h" #include "sighandlers.h" #include "sysdep.h" #include "syswait.h" @@ -356,8 +358,8 @@ // use the value of sig, instead of just assuming that it is called // for SIGINT only. -static -void user_abort (const char *sig_name, int sig_number) +static void +user_abort (const char *sig_name, int sig_number) { if (! octave_initialized) exit (1); @@ -368,13 +370,18 @@ { if (! octave_debug_on_interrupt_state) { + tree_evaluator::debug_mode = true; octave_debug_on_interrupt_state = true; return; } else - // Clear the flag and do normal interrupt stuff. - octave_debug_on_interrupt_state = false; + { + // Clear the flag and do normal interrupt stuff. + + tree_evaluator::debug_mode = bp_table::have_breakpoints (); + octave_debug_on_interrupt_state = false; + } } if (octave_interrupt_immediately)
--- a/src/toplev.cc Tue Feb 03 12:47:38 2009 +0100 +++ b/src/toplev.cc Wed Feb 04 00:47:53 2009 -0500 @@ -67,6 +67,7 @@ #include "pathsearch.h" #include "procstream.h" #include "ov.h" +#include "pt-eval.h" #include "pt-jump.h" #include "pt-stmt.h" #include "sighandlers.h" @@ -555,7 +556,9 @@ { if (global_command) { - global_command->eval (); + current_evaluator->reset (); + + global_command->accept (*current_evaluator); delete global_command;