/*

Copyright (C) 2009 John W. Eaton

This file is part of Octave.

Octave is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the
Free Software Foundation; either version 3 of the License, or (at your
option) any later version.

Octave is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
for more details.

You should have received a copy of the GNU General Public License
along with Octave; see the file COPYING.  If not, see
<http://www.gnu.org/licenses/>.

*/

#ifdef HAVE_CONFIG_H
#include <config.h>
#endif

#include <cctype>

#include <iostream>

#include <fstream>
#include <typeinfo>

#include "defun.h"
#include "error.h"
#include "gripes.h"
#include "input.h"
#include "ov-fcn-handle.h"
#include "ov-usr-fcn.h"
#include "variables.h"
#include "pt-all.h"
#include "pt-eval.h"
#include "symtab.h"
#include "unwind-prot.h"

static tree_evaluator std_evaluator;

tree_evaluator *current_evaluator = &std_evaluator;

int tree_evaluator::dbstep_flag = 0;

size_t tree_evaluator::current_frame = 0;

bool tree_evaluator::debug_mode = false;

bool tree_evaluator::in_fcn_or_script_body = false;

bool tree_evaluator::in_loop_command = false;

int tree_evaluator::db_line = -1;
int tree_evaluator::db_column = -1;

// If TRUE, turn off printing of results in functions (as if a
// semicolon has been appended to each statement).
static bool Vsilent_functions = false;

// Normal evaluator.

void
tree_evaluator::visit_anon_fcn_handle (tree_anon_fcn_handle&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_argument_list (tree_argument_list&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_binary_expression (tree_binary_expression&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_break_command (tree_break_command& cmd)
{
  if (! error_state)
    {
      if (debug_mode)
	do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

      tree_break_command::breaking = 1;
    }
}

void
tree_evaluator::visit_colon_expression (tree_colon_expression&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_continue_command (tree_continue_command&)
{
  if (! error_state)
    tree_continue_command::continuing = 1;
}

static inline void
do_global_init (tree_decl_elt& elt)
{
  tree_identifier *id = elt.ident ();

  if (id)
    {
      id->mark_global ();

      if (! error_state)
	{
	  octave_lvalue ult = id->lvalue ();

	  if (ult.is_undefined ())
	    {
	      tree_expression *expr = elt.expression ();

	      octave_value init_val;

	      if (expr)
		init_val = expr->rvalue1 ();
	      else
		init_val = Matrix ();

	      ult.assign (octave_value::op_asn_eq, init_val);
	    }
	}
    }
}

static inline void
do_static_init (tree_decl_elt& elt)
{
  tree_identifier *id = elt.ident ();

  if (id)
    {
      id->mark_as_static ();

      octave_lvalue ult = id->lvalue ();

      if (ult.is_undefined ())
	{
	  tree_expression *expr = elt.expression ();

	  octave_value init_val;

	  if (expr)
	    init_val = expr->rvalue1 ();
	  else
	    init_val = Matrix ();

	  ult.assign (octave_value::op_asn_eq, init_val);
	}
    }
}

void
tree_evaluator::do_decl_init_list (decl_elt_init_fcn fcn,
				   tree_decl_init_list *init_list)
{
  if (init_list)
    {
      for (tree_decl_init_list::iterator p = init_list->begin ();
	   p != init_list->end (); p++)
	{
	  tree_decl_elt *elt = *p;

	  fcn (*elt);

	  if (error_state)
	    break;
	}
    }
}

void
tree_evaluator::visit_global_command (tree_global_command& cmd)
{
  if (debug_mode)
    do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

  do_decl_init_list (do_global_init, cmd.initializer_list ());
}

void
tree_evaluator::visit_static_command (tree_static_command& cmd)
{
  if (debug_mode)
    do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

  do_decl_init_list (do_static_init, cmd.initializer_list ());
}

void
tree_evaluator::visit_decl_elt (tree_decl_elt&)
{
  panic_impossible ();
}

#if 0
bool
tree_decl_elt::eval (void)
{
  bool retval = false;

  if (id && expr)
    {
      octave_lvalue ult = id->lvalue ();

      octave_value init_val = expr->rvalue1 ();

      if (! error_state)
       {
         ult.assign (octave_value::op_asn_eq, init_val);

         retval = true;
       }
    }

  return retval;
}
#endif

void
tree_evaluator::visit_decl_init_list (tree_decl_init_list&)
{
  panic_impossible ();
}

// Decide if it's time to quit a for or while loop.
static inline bool
quit_loop_now (void)
{
  OCTAVE_QUIT;

  // Maybe handle `continue N' someday...

  if (tree_continue_command::continuing)
    tree_continue_command::continuing--;

  bool quit = (error_state
	       || tree_return_command::returning
	       || tree_break_command::breaking
	       || tree_continue_command::continuing);

  if (tree_break_command::breaking)
    tree_break_command::breaking--;

  return quit;
}

#define DO_SIMPLE_FOR_LOOP_ONCE(VAL) \
  do \
    { \
      ult.assign (octave_value::op_asn_eq, VAL); \
 \
      if (! error_state && loop_body) \
	loop_body->accept (*this); \
 \
      quit = quit_loop_now (); \
    } \
  while (0)

void
tree_evaluator::visit_simple_for_command (tree_simple_for_command& cmd)
{
  if (error_state)
    return;

  if (debug_mode)
    do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

  unwind_protect::begin_frame ("tree_evaluator::visit_simple_for_command");

  unwind_protect_bool (in_loop_command);

  in_loop_command = true;

  tree_expression *expr = cmd.control_expr ();

  octave_value rhs = expr->rvalue1 ();

  if (error_state || rhs.is_undefined ())
    goto cleanup;

  {
    tree_expression *lhs = cmd.left_hand_side ();

    octave_lvalue ult = lhs->lvalue ();

    if (error_state)
      goto cleanup;

    tree_statement_list *loop_body = cmd.body ();

    if (rhs.is_range ())
      {
	Range rng = rhs.range_value ();

	octave_idx_type steps = rng.nelem ();
	double b = rng.base ();
	double increment = rng.inc ();
	bool quit = false;

	for (octave_idx_type i = 0; i < steps; i++)
	  {
	    // Use multiplication here rather than declaring a
	    // temporary variable outside the loop and using
	    //
	    //   tmp_val += increment
	    //
	    // to avoid problems with limited precision.  Also, this
	    // is consistent with the way Range::matrix_value is
	    // implemented.

	    octave_value val (b + i * increment);

	    DO_SIMPLE_FOR_LOOP_ONCE (val);

	    if (quit)
	      break;
	  }
      }
    else if (rhs.is_scalar_type ())
      {
	bool quit = false;

	DO_SIMPLE_FOR_LOOP_ONCE (rhs);
      }
    else if (rhs.is_matrix_type () 
             || rhs.is_cell () || rhs.is_string ())
      {
        // A matrix or cell is reshaped to 2 dimensions and iterated by
        // columns.

        bool quit = false;

        dim_vector dv = rhs.dims ().redim (2);

        octave_idx_type nrows = dv(0), steps = dv(1);

        if (steps > 0)
          {
            octave_value arg = rhs;
            if (rhs.ndims () > 2)
              arg = arg.reshape (dv);

            // for row vectors, use single index to speed things up.
            octave_value_list idx;
            octave_idx_type iidx;
            if (nrows == 1)
              {
                idx.resize (1);
                iidx = 0;
              }
            else
              {
                idx.resize (2);
                idx(0) = octave_value::magic_colon_t;
                iidx = 1;
              }

            for (octave_idx_type i = 1; i <= steps; i++)
              {
                // do_index_op expects one-based indices.
                idx(iidx) = i;
                octave_value val = arg.do_index_op (idx);
                DO_SIMPLE_FOR_LOOP_ONCE (val);

                if (quit)
                  break;
              }
          }
      }
    else 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
      {
	::error ("invalid type in for loop expression near line %d, column %d",
		 cmd.line (), cmd.column ());
      }
  }

 cleanup:
  unwind_protect::run_frame ("tree_evaluator::visit_simple_for_command");
}

void
tree_evaluator::visit_complex_for_command (tree_complex_for_command& cmd)
{
  if (error_state)
    return;

  if (debug_mode)
    do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

  unwind_protect::begin_frame ("tree_evaluator::visit_complex_for_command");

  unwind_protect_bool (in_loop_command);

  in_loop_command = true;

  tree_expression *expr = cmd.control_expr ();

  octave_value rhs = expr->rvalue1 ();

  if (error_state || rhs.is_undefined ())
    goto cleanup;

  if (rhs.is_map ())
    {
      // Cycle through structure elements.  First element of id_list
      // is set to value and the second is set to the name of the
      // structure element.

      tree_argument_list *lhs = cmd.left_hand_side ();

      tree_argument_list::iterator p = lhs->begin ();

      tree_expression *elt = *p++;

      octave_lvalue val_ref = elt->lvalue ();

      elt = *p;

      octave_lvalue key_ref = elt->lvalue ();

      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&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_if_command (tree_if_command& cmd)
{
  tree_if_command_list *lst = cmd.cmd_list ();

  if (lst)
    lst->accept (*this);
}

void
tree_evaluator::visit_if_command_list (tree_if_command_list& lst)
{
  for (tree_if_command_list::iterator p = lst.begin (); p != lst.end (); p++)
    {
      tree_if_clause *tic = *p;

      tree_expression *expr = tic->condition ();

      if (debug_mode && ! tic->is_else_clause ())
	do_breakpoint (tic->is_breakpoint (), tic->line (), tic->column ());

      if (tic->is_else_clause () || expr->is_logically_true ("if"))
	{
	  if (! error_state)
	    {
	      tree_statement_list *stmt_lst = tic->commands ();

	      if (stmt_lst)
		stmt_lst->accept (*this);
	    }

	  break;
	}
    }
}

void
tree_evaluator::visit_index_expression (tree_index_expression&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_matrix (tree_matrix&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_cell (tree_cell&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_multi_assignment (tree_multi_assignment&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_no_op_command (tree_no_op_command& cmd)
{
  if (debug_mode && cmd.is_end_of_fcn_or_script ())
    do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column (), true);
}

void
tree_evaluator::visit_constant (tree_constant&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_fcn_handle (tree_fcn_handle&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_parameter_list (tree_parameter_list&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_postfix_expression (tree_postfix_expression&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_prefix_expression (tree_prefix_expression&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_return_command (tree_return_command& cmd)
{
  if (! error_state)
    {
      if (debug_mode)
	do_breakpoint (cmd.is_breakpoint (), cmd.line (), cmd.column ());

      tree_return_command::returning = 1;
    }
}

void
tree_evaluator::visit_return_list (tree_return_list&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_simple_assignment (tree_simple_assignment&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_statement (tree_statement& stmt)
{
  tree_command *cmd = stmt.command ();
  tree_expression *expr = stmt.expression ();

  if (cmd || expr)
    {
      if (in_fcn_or_script_body)
	{
	  octave_call_stack::set_statement (&stmt);

	  if (Vecho_executing_commands & ECHO_FUNCTIONS)
	    stmt.echo_code ();
	}

      try
	{
	  if (cmd)
	    cmd->accept (*this);
	  else
	    {
	      if (debug_mode)
		do_breakpoint (expr->is_breakpoint (), expr->line (),
			       expr->column ());

	      if (in_fcn_or_script_body && Vsilent_functions)
		expr->set_print_flag (false);

	      // FIXME -- maybe all of this should be packaged in
	      // one virtual function that returns a flag saying whether
	      // or not the expression will take care of binding ans and
	      // printing the result.

	      // FIXME -- it seems that we should just have to
	      // call expr->rvalue1 () and that should take care of
	      // everything, binding ans as necessary?

	      bool do_bind_ans = false;

	      if (expr->is_identifier ())
		{
		  tree_identifier *id = dynamic_cast<tree_identifier *> (expr);

		  do_bind_ans = (! id->is_variable ());
		}
	      else
		do_bind_ans = (! expr->is_assignment_expression ());

	      octave_value tmp_result = expr->rvalue1 (0);

	      if (do_bind_ans && ! (error_state || tmp_result.is_undefined ()))
		bind_ans (tmp_result, expr->print_result ());

	      //	      if (tmp_result.is_defined ())
	      //		result_values(0) = tmp_result;
	    }
	}
      catch (octave_execution_exception)
	{
	  gripe_library_execution_error ();
	}
    }
}

void
tree_evaluator::visit_statement_list (tree_statement_list& lst)
{
  static octave_value_list empty_list;

  if (error_state)
    return;

  tree_statement_list::iterator p = lst.begin ();

  if (p != lst.end ())
    {
      while (true)
	{
	  tree_statement *elt = *p++;

	  if (elt)
	    {
	      OCTAVE_QUIT;

	      elt->accept (*this);

	      if (error_state)
		break;

	      if (tree_break_command::breaking
		  || tree_continue_command::continuing)
		break;

	      if (tree_return_command::returning)
		break;

	      if (p == lst.end ())
		break;
	      else
		{
		  // Clear preivous values before next statement is
		  // evaluated so that we aren't holding an extra
		  // reference to a value that may be used next.  For
		  // example, in code like this:
		  //
		  //   X = rand (N);  ## refcount for X should be 1
		  //                  ## after this statement
		  //
		  //   X(idx) = val;  ## no extra copy of X should be
		  //                  ## needed, but we will be faked
		  //                  ## out if retval is not cleared
		  //                  ## between statements here

		  //		  result_values = empty_list;
		}
	    }
	  else
	    error ("invalid statement found in statement list!");
	}
    }
}

void
tree_evaluator::visit_switch_case (tree_switch_case&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_switch_case_list (tree_switch_case_list&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_switch_command (tree_switch_command& cmd)
{
  tree_expression *expr = cmd.switch_value ();

  if (expr)
    {
      octave_value val = expr->rvalue1 ();

      tree_switch_case_list *lst = cmd.case_list ();

      if (! error_state && lst)
	{
	  for (tree_switch_case_list::iterator p = lst->begin ();
	       p != lst->end (); p++)
	    {
	      tree_switch_case *t = *p;

	      if (debug_mode && ! t->is_default_case ())
		do_breakpoint (t->is_breakpoint (), t->line (), t->column ());

	      if (t->is_default_case () || t->label_matches (val))
		{
		  if (error_state)
		    break;

		  tree_statement_list *stmt_lst = t->commands ();

		  if (stmt_lst)
		    stmt_lst->accept (*this);

		  break;
		}
	    }
	}
    }
  else
    ::error ("missing value in switch command near line %d, column %d",
	     cmd.line (), cmd.column ());
}

static void
do_catch_code (void *ptr)
{
  // Is it safe to call OCTAVE_QUIT here?  We are already running
  // something on the unwind_protect stack, but the element for this
  // action would have already been popped from the top of the stack,
  // so we should not be attempting to run it again.

  OCTAVE_QUIT;

  // If we are interrupting immediately, or if an interrupt is in
  // progress (octave_interrupt_state < 0), then we don't want to run
  // the catch code (it should only run on errors, not interrupts).

  // If octave_interrupt_state is positive, an interrupt is pending.
  // The only way that could happen would be for the interrupt to
  // come in after the OCTAVE_QUIT above and before the if statement
  // below -- it's possible, but unlikely.  In any case, we should
  // probably let the catch code throw the exception because we don't
  // want to skip that and potentially run some other code.  For
  // example, an error may have originally brought us here for some
  // cleanup operation and we shouldn't skip that.

  if (octave_interrupt_immediately || octave_interrupt_state < 0)
    return;

  tree_statement_list *list = static_cast<tree_statement_list *> (ptr);

  // Set up for letting the user print any messages from errors that
  // occurred in the body of the try_catch statement.

  buffer_error_messages--;

  if (list)
    list->accept (*current_evaluator);
}

void
tree_evaluator::visit_try_catch_command (tree_try_catch_command& cmd)
{
  unwind_protect::begin_frame ("tree_evaluator::visit_try_catch_command");
  
  unwind_protect_int (buffer_error_messages);
  unwind_protect_bool (Vdebug_on_error);
  unwind_protect_bool (Vdebug_on_warning);

  buffer_error_messages++;
  Vdebug_on_error = false;
  Vdebug_on_warning = false;

  tree_statement_list *catch_code = cmd.cleanup ();

  unwind_protect::add (do_catch_code, catch_code);

  tree_statement_list *try_code = cmd.body ();

  if (try_code)
    try_code->accept (*this);

  if (catch_code && error_state)
    {
      error_state = 0;
      unwind_protect::run_frame ("tree_evaluator::visit_try_catch_command");
    }
  else
    {
      error_state = 0;

      // Unwind stack elements must be cleared or run in the reverse
      // order in which they were added to the stack.

      // For clearing the do_catch_code cleanup function.
      unwind_protect::discard ();

      // For restoring Vdebug_on_warning, Vdebug_on_error, and
      // buffer_error_messages.
      unwind_protect::run ();
      unwind_protect::run ();
      unwind_protect::run ();

      // Also clear the frame marker.
      unwind_protect::discard ();
    }
}

static void
do_unwind_protect_cleanup_code (void *ptr)
{
  tree_statement_list *list = static_cast<tree_statement_list *> (ptr);

  // We want to run the cleanup code without error_state being set,
  // but we need to restore its value, so that any errors encountered
  // in the first part of the unwind_protect are not completely
  // ignored.

  unwind_protect_int (error_state);
  error_state = 0;

  // Similarly, if we have seen a return or break statement, allow all
  // the cleanup code to run before returning or handling the break.
  // We don't have to worry about continue statements because they can
  // only occur in loops.

  unwind_protect_int (tree_return_command::returning);
  tree_return_command::returning = 0;

  unwind_protect_int (tree_break_command::breaking);
  tree_break_command::breaking = 0;

  if (list)
    list->accept (*current_evaluator);

  // The unwind_protects are popped off the stack in the reverse of
  // the order they are pushed on.

  // FIXME -- these statements say that if we see a break or
  // return statement in the cleanup block, that we want to use the
  // new value of the breaking or returning flag instead of restoring
  // the previous value.  Is that the right thing to do?  I think so.
  // Consider the case of
  //
  //   function foo ()
  //     unwind_protect
  //       stderr << "1: this should always be executed\n";
  //       break;
  //       stderr << "1: this should never be executed\n";
  //     unwind_protect_cleanup
  //       stderr << "2: this should always be executed\n";
  //       return;
  //       stderr << "2: this should never be executed\n";
  //     end_unwind_protect
  //   endfunction
  //
  // If we reset the value of the breaking flag, both the returning
  // flag and the breaking flag will be set, and we shouldn't have
  // both.  So, use the most recent one.  If there is no return or
  // break in the cleanup block, the values should be reset to
  // whatever they were when the cleanup block was entered.

  if (tree_break_command::breaking || tree_return_command::returning)
    {
      unwind_protect::discard ();
      unwind_protect::discard ();
    }
  else
    {
      unwind_protect::run ();
      unwind_protect::run ();
    }

  // We don't want to ignore errors that occur in the cleanup code, so
  // if an error is encountered there, leave error_state alone.
  // Otherwise, set it back to what it was before.

  if (error_state)
    unwind_protect::discard ();
  else
    unwind_protect::run ();
}

void
tree_evaluator::visit_unwind_protect_command (tree_unwind_protect_command& cmd)
{
  tree_statement_list *cleanup_code = cmd.cleanup ();

  unwind_protect::add (do_unwind_protect_cleanup_code, cleanup_code);

  tree_statement_list *unwind_protect_code = cmd.body ();

  if (unwind_protect_code)
    unwind_protect_code->accept (*this);

  unwind_protect::run ();
}

void
tree_evaluator::visit_while_command (tree_while_command& cmd)
{
  if (error_state)
    return;

  unwind_protect::begin_frame ("tree_evaluator::visit_while_command");

  unwind_protect_bool (in_loop_command);

  in_loop_command = true;

  tree_expression *expr = cmd.condition ();

  if (! expr)
    panic_impossible ();

  int l = expr->line ();
  int c = expr->column ();

  for (;;)
    {
      if (debug_mode)
	do_breakpoint (cmd.is_breakpoint (), l, c);

      if (expr->is_logically_true ("while"))
	{
	  tree_statement_list *loop_body = cmd.body ();

	  if (loop_body)
	    {
	      loop_body->accept (*this);

	      if (error_state)
		goto cleanup;
	    }

	  if (quit_loop_now ())
	    break;
	}
      else
	break;
    }

 cleanup:
  unwind_protect::run_frame ("tree_evaluator::visit_while_command");
}

void
tree_evaluator::visit_do_until_command (tree_do_until_command& cmd)
{
  if (error_state)
    return;

  unwind_protect::begin_frame ("tree_evaluator::visit_do_until_command");

  unwind_protect_bool (in_loop_command);

  in_loop_command = true;

  tree_expression *expr = cmd.condition ();

  if (! expr)
    panic_impossible ();

  int l = expr->line ();
  int c = expr->column ();

  for (;;)
    {
      tree_statement_list *loop_body = cmd.body ();

      if (loop_body)
	{
	  loop_body->accept (*this);

	  if (error_state)
	    goto cleanup;
	}

      if (quit_loop_now ())
	break;

      if (debug_mode)
	do_breakpoint (cmd.is_breakpoint (), l, c);

      if (expr->is_logically_true ("do-until"))
	break;
    }

 cleanup:
  unwind_protect::run_frame ("tree_evaluator::visit_do_until_command");
}

void
tree_evaluator::do_breakpoint (tree_statement& stmt) const
{
  do_breakpoint (stmt.is_breakpoint (), stmt.line (), stmt.column (),
		 stmt.is_end_of_fcn_or_script ());
}

void
tree_evaluator::do_breakpoint (bool is_breakpoint, int l, int c,
			       bool is_end_of_fcn_or_script) const
{
  bool break_on_this_statement = false;

  // Don't decrement break flag unless we are in the same frame as we
  // were when we saw the "dbstep N" command.

  if (dbstep_flag > 1)
    {
      if (octave_call_stack::current_frame () == current_frame)
	{
	  // Don't allow dbstep N to step past end of current frame.

	  if (is_end_of_fcn_or_script)
	    dbstep_flag = 1;
	  else
	    dbstep_flag--;
	}
    }

  if (octave_debug_on_interrupt_state)
    {
      break_on_this_statement = true;

      octave_debug_on_interrupt_state = false;

      current_frame = octave_call_stack::current_frame ();
    }
  else if (is_breakpoint)
    {
      break_on_this_statement = true;

      dbstep_flag = 0;

      current_frame = octave_call_stack::current_frame ();
    }
  else if (dbstep_flag == 1)
    {
      if (octave_call_stack::current_frame () == current_frame)
	{
	  // We get here if we are doing a "dbstep" or a "dbstep N"
	  // and the count has reached 1 and we are in the current
	  // debugging frame.

	  break_on_this_statement = true;

	  dbstep_flag = 0;
	}
    }
  else if (dbstep_flag == -1)
    {
      // We get here if we are doing a "dbstep in".

      break_on_this_statement = true;

      dbstep_flag = 0;

      current_frame = octave_call_stack::current_frame ();
    }
  else if (dbstep_flag == -2)
    {
      // We get here if we are doing a "dbstep out".

      if (is_end_of_fcn_or_script)
	dbstep_flag = -1;
    }

  if (break_on_this_statement)
    {
      octave_function *xfcn = octave_call_stack::current ();

      if (xfcn)
	std::cerr << xfcn->name () << ": "; 

      std::cerr << "line " << l << ", " << "column " << c << std::endl;

      db_line = l;
      db_column = c;

      // FIXME -- probably we just want to print one line, not the
      // entire statement, which might span many lines...
      //
      // tree_print_code tpc (octave_stdout);
      // stmt.accept (tpc);

      do_keyboard ();
    }
}

DEFUN (silent_functions, args, nargout,
  "-*- texinfo -*-\n\
@deftypefn {Built-in Function} {@var{val} =} silent_functions ()\n\
@deftypefnx {Built-in Function} {@var{old_val} =} silent_functions (@var{new_val})\n\
Query or set the internal variable that controls whether internal\n\
output from a function is suppressed.  If this option is disabled,\n\
Octave will display the results produced by evaluating expressions\n\
within a function body that are not terminated with a semicolon.\n\
@end deftypefn")
{
  return SET_INTERNAL_VARIABLE (silent_functions);
}

/*
;;; Local Variables: ***
;;; mode: C++ ***
;;; End: ***
*/