Logo Search packages:      
Sourcecode: octave3.2 version File versions

pt-eval.cc

/*

Copyright (C) 2009 John W. Eaton

This file is part of Octave.

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

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

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

*/

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

#include <cctype>

#include <iostream>

#include <fstream>
#include <typeinfo>

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

static tree_evaluator std_evaluator;

tree_evaluator *current_evaluator = &std_evaluator;

int tree_evaluator::dbstep_flag = 0;

size_t tree_evaluator::current_frame = 0;

bool tree_evaluator::debug_mode = false;

bool tree_evaluator::in_fcn_or_script_body = false;

bool tree_evaluator::in_loop_command = false;

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

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

// Normal evaluator.

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

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

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

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

      tree_break_command::breaking = 1;
    }
}

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

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

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

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

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

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

            octave_value init_val;

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

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

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

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

      octave_lvalue ult = id->lvalue ();

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

        octave_value init_val;

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

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

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

        fcn (*elt);

        if (error_state)
          break;
      }
    }
}

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

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

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

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

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

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

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

      octave_value init_val = expr->rvalue1 ();

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

         retval = true;
       }
    }

  return retval;
}
#endif

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

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

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

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

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

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

  return quit;
}

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

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

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

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

  unwind_protect_bool (in_loop_command);

  in_loop_command = true;

  tree_expression *expr = cmd.control_expr ();

  octave_value rhs = expr->rvalue1 ();

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

  {
    tree_expression *lhs = cmd.left_hand_side ();

    octave_lvalue ult = lhs->lvalue ();

    if (error_state)
      goto cleanup;

    tree_statement_list *loop_body = cmd.body ();

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

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

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

          octave_value val (b + i * increment);

          DO_SIMPLE_FOR_LOOP_ONCE (val);

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

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

        bool quit = false;

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

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

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

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

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

                if (quit)
                  break;
              }
          }
      }
    else
      {
      ::error ("invalid type in for loop expression near line %d, column %d",
             cmd.line (), cmd.column ());
      }
  }

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

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

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

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

  unwind_protect_bool (in_loop_command);

  in_loop_command = true;

  tree_expression *expr = cmd.control_expr ();

  octave_value rhs = expr->rvalue1 ();

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

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

      tree_argument_list *lhs = cmd.left_hand_side ();

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

      tree_expression *elt = *p++;

      octave_lvalue val_ref = elt->lvalue ();

      elt = *p;

      octave_lvalue key_ref = elt->lvalue ();

      const Octave_map tmp_val (rhs.map_value ());

      tree_statement_list *loop_body = cmd.body ();

      for (Octave_map::const_iterator q = tmp_val.begin (); q != tmp_val.end (); q++)
      {
        octave_value key = tmp_val.key (q);

        const Cell val_lst = tmp_val.contents (q);

        octave_idx_type n = tmp_val.numel ();

        octave_value val = (n == 1) ? val_lst(0) : octave_value (val_lst);

        val_ref.assign (octave_value::op_asn_eq, val);
        key_ref.assign (octave_value::op_asn_eq, key);

        if (! error_state && loop_body)
          loop_body->accept (*this);

        if (quit_loop_now ())
          break;
      }
    }
  else
    error ("in statement `for [X, Y] = VAL', VAL must be a structure");

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

void
tree_evaluator::visit_octave_user_script (octave_user_script&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_octave_user_function (octave_user_function&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_octave_user_function_header (octave_user_function&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_octave_user_function_trailer (octave_user_function&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_function_def (tree_function_def& cmd)
{
  octave_value fcn = cmd.function ();

  octave_function *f = fcn.function_value ();

  if (f)
    {
      std::string nm = f->name ();

      symbol_table::install_cmdline_function (nm, fcn);

      // Make sure that any variable with the same name as the new
      // function is cleared.

      symbol_table::varref (nm) = octave_value ();
    }
}

void
tree_evaluator::visit_identifier (tree_identifier&)
{
  panic_impossible ();
}

void
tree_evaluator::visit_if_clause (tree_if_clause&)
{
  panic_impossible ();
}

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

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

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

      tree_expression *expr = tic->condition ();

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

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

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

        break;
      }
    }
}

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

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

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

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

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

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

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

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

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

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

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

      tree_return_command::returning = 1;
    }
}

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

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

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

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

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

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

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

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

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

            bool do_bind_ans = false;

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

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

            octave_value tmp_result = expr->rvalue1 (0);

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

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

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

  if (error_state)
    return;

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

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

        if (elt)
          {
            OCTAVE_QUIT;

            elt->accept (*this);

            if (error_state)
            break;

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

            if (tree_return_command::returning)
            break;

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

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

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

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

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

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

      tree_switch_case_list *lst = cmd.case_list ();

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

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

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

              tree_statement_list *stmt_lst = t->commands ();

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

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

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

  OCTAVE_QUIT;

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

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

  if (octave_interrupt_immediately || octave_interrupt_state < 0)
    return;

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

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

  buffer_error_messages--;

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

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

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

  tree_statement_list *catch_code = cmd.cleanup ();

  unwind_protect::add (do_catch_code, catch_code);

  tree_statement_list *try_code = cmd.body ();

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

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

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

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

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

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

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

  // 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;

  unwind_protect_int (octave_interrupt_state);
  octave_interrupt_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: ***
*/

Generated by  Doxygen 1.6.0   Back to index