+
−/*
+
−
+
−Copyright (C) 2009-2012 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 "debug.h"
+
−#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"
+
−
+
−//FIXME: This should be part of tree_evaluator
+
−#include "pt-jit.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;
+
−
+
−tree_evaluator::stmt_list_type tree_evaluator::statement_context
+
−  = tree_evaluator::other;
+
−
+
−bool tree_evaluator::in_loop_command = false;
+
−
+
−// Maximum nesting level for functions, scripts, or sourced files called
+
−// recursively.
+
−int Vmax_recursion_depth = 256;
+
−
+
−// 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 ());
+
−
+
−      if (statement_context == function || statement_context == script
+
−          || in_loop_command)
+
−        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& cmd)
+
−{
+
−  if (! error_state)
+
−    {
+
−      if (debug_mode)
+
−        do_breakpoint (cmd.is_breakpoint ());
+
−
+
−      if (statement_context == function || statement_context == script
+
−          || in_loop_command)
+
−        tree_continue_command::continuing = 1;
+
−    }
+
−}
+
−
+
−void
+
−tree_evaluator::reset_debug_state (void)
+
−{
+
−  debug_mode = bp_table::have_breakpoints () || Vdebugging;
+
−
+
−  dbstep_flag = 0;
+
−}
+
−
+
−bool
+
−tree_evaluator::statement_printing_enabled (void)
+
−{
+
−  return ! (Vsilent_functions && (statement_context == function
+
−                                  || statement_context == script));
+
−}
+
−
+
−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 ());
+
−
+
−  do_decl_init_list (do_global_init, cmd.initializer_list ());
+
−}
+
−
+
−void
+
−tree_evaluator::visit_persistent_command (tree_persistent_command& cmd)
+
−{
+
−  if (debug_mode)
+
−    do_breakpoint (cmd.is_breakpoint ());
+
−
+
−  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;
+
−}
+
−
+
−void
+
−tree_evaluator::visit_simple_for_command (tree_simple_for_command& cmd)
+
−{
+
−  if (error_state)
+
−    return;
+
−
+
−  if (debug_mode)
+
−    do_breakpoint (cmd.is_breakpoint ());
+
−
+
−  // FIXME -- need to handle PARFOR loops here using cmd.in_parallel ()
+
−  // and cmd.maxproc_expr ();
+
−
+
−  unwind_protect frame;
+
−
+
−  frame.protect_var (in_loop_command);
+
−
+
−  in_loop_command = true;
+
−
+
−  tree_expression *expr = cmd.control_expr ();
+
−
+
−  octave_value rhs = expr->rvalue1 ();
+
−
+
−#if HAVE_LLVM
+
−  if (tree_jit::execute (cmd, rhs))
+
−    return;
+
−#endif
+
−
+
−  if (error_state || rhs.is_undefined ())
+
−    return;
+
−
+
−  {
+
−    tree_expression *lhs = cmd.left_hand_side ();
+
−
+
−    octave_lvalue ult = lhs->lvalue ();
+
−
+
−    if (error_state)
+
−      return;
+
−
+
−    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 ();
+
−
+
−        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);
+
−
+
−            ult.assign (octave_value::op_asn_eq, val);
+
−
+
−            if (! error_state && loop_body)
+
−              loop_body->accept (*this);
+
−
+
−            if (quit_loop_now ())
+
−              break;
+
−          }
+
−      }
+
−    else if (rhs.is_scalar_type ())
+
−      {
+
−        ult.assign (octave_value::op_asn_eq, rhs);
+
−
+
−        if (! error_state && loop_body)
+
−          loop_body->accept (*this);
+
−
+
−        // Maybe decrement break and continue states.
+
−        quit_loop_now ();
+
−      }
+
−    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.
+
−
+
−        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);
+
−
+
−                ult.assign (octave_value::op_asn_eq, val);
+
−
+
−                if (! error_state && loop_body)
+
−                  loop_body->accept (*this);
+
−
+
−                if (quit_loop_now ())
+
−                  break;
+
−              }
+
−          }
+
−      }
+
−    else
+
−      {
+
−        ::error ("invalid type in for loop expression near line %d, column %d",
+
−                 cmd.line (), cmd.column ());
+
−      }
+
−  }
+
−}
+
−
+
−void
+
−tree_evaluator::visit_complex_for_command (tree_complex_for_command& cmd)
+
−{
+
−  if (error_state)
+
−    return;
+
−
+
−  if (debug_mode)
+
−    do_breakpoint (cmd.is_breakpoint ());
+
−
+
−  unwind_protect frame;
+
−
+
−  frame.protect_var (in_loop_command);
+
−
+
−  in_loop_command = true;
+
−
+
−  tree_expression *expr = cmd.control_expr ();
+
−
+
−  octave_value rhs = expr->rvalue1 ();
+
−
+
−  if (error_state || rhs.is_undefined ())
+
−    return;
+
−
+
−  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 ();
+
−
+
−      string_vector keys = tmp_val.keys ();
+
−
+
−      octave_idx_type nel = keys.numel ();
+
−
+
−      for (octave_idx_type i = 0; i < nel; i++)
+
−        {
+
−          std::string key = keys[i];
+
−
+
−          const Cell val_lst = tmp_val.contents (key);
+
−
+
−          octave_idx_type n = val_lst.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");
+
−}
+
−
+
−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::assign (nm);
+
−    }
+
−}
+
−
+
−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 (statement_context == function || statement_context == script)
+
−        octave_call_stack::set_location (tic->line (), tic->column ());
+
−
+
−      if (debug_mode && ! tic->is_else_clause ())
+
−        do_breakpoint (tic->is_breakpoint ());
+
−
+
−      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 (), 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 ());
+
−
+
−      // Act like dbcont.
+
−
+
−      if (Vdebugging
+
−          && octave_call_stack::current_frame () == current_frame)
+
−        {
+
−          Vdebugging = false;
+
−
+
−          reset_debug_state ();
+
−        }
+
−      else if (statement_context == function || statement_context == script
+
−               || in_loop_command)
+
−        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 (statement_context == function || statement_context == script)
+
−        {
+
−          // Skip commands issued at a debug> prompt to avoid disturbing
+
−          // the state of the program we are debugging.
+
−
+
−          if (! Vdebugging)
+
−            octave_call_stack::set_location (stmt.line (), stmt.column ());
+
−
+
−          // FIXME -- we need to distinguish functions from scripts to
+
−          // get this right.
+
−          if ((statement_context == script
+
−               && ((Vecho_executing_commands & ECHO_SCRIPTS)
+
−                   || (Vecho_executing_commands & ECHO_FUNCTIONS)))
+
−              || (statement_context == function
+
−                  && (Vecho_executing_commands & ECHO_FUNCTIONS)))
+
−            stmt.echo_code ();
+
−        }
+
−
+
−      try
+
−        {
+
−          if (cmd)
+
−            cmd->accept (*this);
+
−          else
+
−            {
+
−              if (debug_mode)
+
−                do_breakpoint (expr->is_breakpoint ());
+
−
+
−              // 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 ()
+
−                          && statement_printing_enabled ());
+
−
+
−              //              if (tmp_result.is_defined ())
+
−              //                result_values(0) = tmp_result;
+
−            }
+
−        }
+
−      catch (octave_execution_exception)
+
−        {
+
−          gripe_library_execution_error ();
+
−        }
+
−      catch (std::bad_alloc)
+
−        {
+
−          // FIXME -- We want to use error_with_id here so that we set
+
−          // the error state, give users control over this error
+
−          // message, and so that we set the error_state appropriately
+
−          // so we'll get stack trace info when appropriate.  But
+
−          // error_with_id will require some memory allocations.  Is
+
−          // there anything we can do to make those more likely to
+
−          // succeed?
+
−
+
−          error_with_id ("Octave:bad-alloc",
+
−                         "out of memory or dimension too large for Octave's index type");
+
−        }
+
−    }
+
−}
+
−
+
−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)
+
−{
+
−  if (debug_mode)
+
−    do_breakpoint (cmd.is_breakpoint ());
+
−
+
−  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 (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 ());
+
−}
+
−
+
−void
+
−tree_evaluator::visit_try_catch_command (tree_try_catch_command& cmd)
+
−{
+
−  unwind_protect frame;
+
−
+
−  frame.protect_var (buffer_error_messages);
+
−  frame.protect_var (Vdebug_on_error);
+
−  frame.protect_var (Vdebug_on_warning);
+
−
+
−  buffer_error_messages++;
+
−  Vdebug_on_error = false;
+
−  Vdebug_on_warning = false;
+
−
+
−  tree_statement_list *catch_code = cmd.cleanup ();
+
−
+
−  // The catch code is *not* added to unwind_protect stack; it doesn't need
+
−  // to be run on interrupts.
+
−
+
−  tree_statement_list *try_code = cmd.body ();
+
−
+
−  if (try_code)
+
−    {
+
−      try_code->accept (*this);
+
−    }
+
−
+
−  if (error_state)
+
−    {
+
−      error_state = 0;
+
−
+
−      if (catch_code)
+
−        {
+
−          // Set up for letting the user print any messages from errors that
+
−          // occurred in the body of the try_catch statement.
+
−
+
−          buffer_error_messages--;
+
−
+
−          tree_identifier *expr_id = cmd.identifier ();
+
−          octave_lvalue ult;
+
−
+
−          if (expr_id)
+
−            {
+
−
+
−              octave_scalar_map err;
+
−
+
−              ult = expr_id->lvalue ();
+
−
+
−              if (error_state)
+
−                return;
+
−
+
−              err.assign ("message", last_error_message ());
+
−              err.assign ("identifier", last_error_id ());
+
−
+
−              if (! error_state)
+
−                ult.assign (octave_value::op_asn_eq, err);
+
−
+
−            }
+
−
+
−          if (catch_code)
+
−            catch_code->accept (*this);
+
−        }
+
−    }
+
−}
+
−
+
−void
+
−tree_evaluator::do_unwind_protect_cleanup_code (tree_statement_list *list)
+
−{
+
−  unwind_protect frame;
+
−
+
−  frame.protect_var (octave_interrupt_state);
+
−  octave_interrupt_state = 0;
+
−
+
−  // 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.
+
−
+
−  frame.protect_var (error_state);
+
−  error_state = 0;
+
−
+
−  // We want to preserve the last location info for possible
+
−  // backtracking.
+
−  frame.add_fcn (octave_call_stack::set_line,
+
−                 octave_call_stack::current_line ());
+
−  frame.add_fcn (octave_call_stack::set_column,
+
−                 octave_call_stack::current_column ());
+
−
+
−  // 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.
+
−
+
−  frame.protect_var (tree_return_command::returning);
+
−  tree_return_command::returning = 0;
+
−
+
−  frame.protect_var (tree_break_command::breaking);
+
−  tree_break_command::breaking = 0;
+
−
+
−  if (list)
+
−    list->accept (*this);
+
−
+
−  // 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)
+
−    {
+
−      frame.discard (2);
+
−    }
+
−  else
+
−    {
+
−      frame.run (2);
+
−    }
+
−
+
−  // 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)
+
−    frame.discard (2);
+
−  else
+
−    frame.run (2);
+
−
+
−  frame.run ();
+
−}
+
−
+
−void
+
−tree_evaluator::visit_unwind_protect_command (tree_unwind_protect_command& cmd)
+
−{
+
−  tree_statement_list *cleanup_code = cmd.cleanup ();
+
−
+
−  tree_statement_list *unwind_protect_code = cmd.body ();
+
−
+
−  if (unwind_protect_code)
+
−    {
+
−      try
+
−        {
+
−          unwind_protect_code->accept (*this);
+
−        }
+
−      catch (...)
+
−        {
+
−          // Run the cleanup code on exceptions, so that it is run even in case
+
−          // of interrupt or out-of-memory.
+
−          do_unwind_protect_cleanup_code (cleanup_code);
+
−          // FIXME: should error_state be checked here?
+
−          // We want to rethrow the exception, even if error_state is set, so
+
−          // that interrupts continue.
+
−          throw;
+
−        }
+
−
+
−      do_unwind_protect_cleanup_code (cleanup_code);
+
−    }
+
−}
+
−
+
−void
+
−tree_evaluator::visit_while_command (tree_while_command& cmd)
+
−{
+
−  if (error_state)
+
−    return;
+
−
+
−#if HAVE_LLVM
+
−  if (tree_jit::execute (cmd))
+
−    return;
+
−#endif
+
−
+
−  unwind_protect frame;
+
−
+
−  frame.protect_var (in_loop_command);
+
−
+
−  in_loop_command = true;
+
−
+
−  tree_expression *expr = cmd.condition ();
+
−
+
−  if (! expr)
+
−    panic_impossible ();
+
−
+
−  for (;;)
+
−    {
+
−      if (debug_mode)
+
−        do_breakpoint (cmd.is_breakpoint ());
+
−
+
−      if (expr->is_logically_true ("while"))
+
−        {
+
−          tree_statement_list *loop_body = cmd.body ();
+
−
+
−          if (loop_body)
+
−            {
+
−              loop_body->accept (*this);
+
−
+
−              if (error_state)
+
−                return;
+
−            }
+
−
+
−          if (quit_loop_now ())
+
−            break;
+
−        }
+
−      else
+
−        break;
+
−    }
+
−}
+
−
+
−void
+
−tree_evaluator::visit_do_until_command (tree_do_until_command& cmd)
+
−{
+
−  if (error_state)
+
−    return;
+
−
+
−  unwind_protect frame;
+
−
+
−  frame.protect_var (in_loop_command);
+
−
+
−  in_loop_command = true;
+
−
+
−  tree_expression *expr = cmd.condition ();
+
−
+
−  if (! expr)
+
−    panic_impossible ();
+
−
+
−  for (;;)
+
−    {
+
−      tree_statement_list *loop_body = cmd.body ();
+
−
+
−      if (loop_body)
+
−        {
+
−          loop_body->accept (*this);
+
−
+
−          if (error_state)
+
−            return;
+
−        }
+
−
+
−      if (quit_loop_now ())
+
−        break;
+
−
+
−      if (debug_mode)
+
−        do_breakpoint (cmd.is_breakpoint ());
+
−
+
−      if (expr->is_logically_true ("do-until"))
+
−        break;
+
−    }
+
−}
+
−
+
−void
+
−tree_evaluator::do_breakpoint (tree_statement& stmt) const
+
−{
+
−  do_breakpoint (stmt.is_breakpoint (), stmt.is_end_of_fcn_or_script ());
+
−}
+
−
+
−void
+
−tree_evaluator::do_breakpoint (bool is_breakpoint,
+
−                               bool is_end_of_fcn_or_script) const
+
−{
+
−  bool break_on_this_statement = false;
+
−
+
−  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 > 0)
+
−    {
+
−      if (octave_call_stack::current_frame () == current_frame)
+
−        {
+
−          if (dbstep_flag == 1 || is_end_of_fcn_or_script)
+
−            {
+
−              // We get here if we are doing a "dbstep" or a "dbstep N" and the
+
−              // count has reached 1 so that we must stop and return to debug
+
−              // prompt.  Alternatively, "dbstep N" has been used but the end
+
−              // of the frame has been reached so we stop at the last line and
+
−              // return to prompt.
+
−
+
−              break_on_this_statement = true;
+
−
+
−              dbstep_flag = 0;
+
−            }
+
−          else
+
−            {
+
−              // Executing "dbstep N".  Decrease N by one and continue.
+
−
+
−              dbstep_flag--;
+
−            }
+
−
+
−        }
+
−      else if (dbstep_flag == 1
+
−               && octave_call_stack::current_frame () < current_frame)
+
−        {
+
−          // We stepped out from the end of a function.
+
−
+
−          current_frame = octave_call_stack::current_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".  Check for end of
+
−      // function and whether the current frame is the same as the
+
−      // cached value because we want to step out from the frame where
+
−      // "dbstep out" was evaluated, not from any functions called from
+
−      // that frame.
+
−
+
−      if (is_end_of_fcn_or_script
+
−          && octave_call_stack::current_frame () == current_frame)
+
−        dbstep_flag = -1;
+
−    }
+
−
+
−  if (break_on_this_statement)
+
−    do_keyboard ();
+
−
+
−}
+
−
+
−// ARGS is currently unused, but since the do_keyboard function in
+
−// input.cc accepts an argument list, we preserve it here so that the
+
−// interface won't have to change if we decide to use it in the future.
+
−
+
−octave_value
+
−tree_evaluator::do_keyboard (const octave_value_list& args) const
+
−{
+
−  return ::do_keyboard (args);
+
−}
+
−
+
−DEFUN (max_recursion_depth, args, nargout,
+
−  "-*- texinfo -*-\n\
+
−@deftypefn  {Built-in Function} {@var{val} =} max_recursion_depth ()\n\
+
−@deftypefnx {Built-in Function} {@var{old_val} =} max_recursion_depth (@var{new_val})\n\
+
−@deftypefnx {Built-in Function} {} max_recursion_depth (@var{new_val}, \"local\")\n\
+
−Query or set the internal limit on the number of times a function may\n\
+
−be called recursively.  If the limit is exceeded, an error message is\n\
+
−printed and control returns to the top level.\n\
+
−\n\
+
−When called from inside a function with the @qcode{\"local\"} option, the\n\
+
−variable is changed locally for the function and any subroutines it calls.\n\
+
−The original variable value is restored when exiting the function.\n\
+
−@end deftypefn")
+
−{
+
−  return SET_INTERNAL_VARIABLE (max_recursion_depth);
+
−}
+
−
+
−/*
+
−%!test
+
−%! orig_val = max_recursion_depth ();
+
−%! old_val = max_recursion_depth (2*orig_val);
+
−%! assert (orig_val, old_val);
+
−%! assert (max_recursion_depth (), 2*orig_val);
+
−%! max_recursion_depth (orig_val);
+
−%! assert (max_recursion_depth (), orig_val);
+
−
+
−%!error (max_recursion_depth (1, 2))
+
−*/
+
−
+
−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\
+
−@deftypefnx {Built-in Function} {} silent_functions (@var{new_val}, \"local\")\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\
+
−\n\
+
−When called from inside a function with the @qcode{\"local\"} option, the\n\
+
−variable is changed locally for the function and any subroutines it calls.\n\
+
−The original variable value is restored when exiting the function.\n\
+
−@end deftypefn")
+
−{
+
−  return SET_INTERNAL_VARIABLE (silent_functions);
+
−}
+
−
+
−/*
+
−%!test
+
−%! orig_val = silent_functions ();
+
−%! old_val = silent_functions (! orig_val);
+
−%! assert (orig_val, old_val);
+
−%! assert (silent_functions (), ! orig_val);
+
−%! silent_functions (orig_val);
+
−%! assert (silent_functions (), orig_val);
+
−
+
−%!error (silent_functions (1, 2))
+
−*/