diff src/pt-eval.cc @ 8658:73c4516fae10

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