pt-eval.cc

Go to the documentation of this file.
00001 /*
00002 
00003 Copyright (C) 2009-2012 John W. Eaton
00004 
00005 This file is part of Octave.
00006 
00007 Octave is free software; you can redistribute it and/or modify it
00008 under the terms of the GNU General Public License as published by the
00009 Free Software Foundation; either version 3 of the License, or (at your
00010 option) any later version.
00011 
00012 Octave is distributed in the hope that it will be useful, but WITHOUT
00013 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
00014 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
00015 for more details.
00016 
00017 You should have received a copy of the GNU General Public License
00018 along with Octave; see the file COPYING.  If not, see
00019 <http://www.gnu.org/licenses/>.
00020 
00021 */
00022 
00023 #ifdef HAVE_CONFIG_H
00024 #include <config.h>
00025 #endif
00026 
00027 #include <cctype>
00028 
00029 #include <iostream>
00030 
00031 #include <fstream>
00032 #include <typeinfo>
00033 
00034 #include "debug.h"
00035 #include "defun.h"
00036 #include "error.h"
00037 #include "gripes.h"
00038 #include "input.h"
00039 #include "ov-fcn-handle.h"
00040 #include "ov-usr-fcn.h"
00041 #include "variables.h"
00042 #include "pt-all.h"
00043 #include "pt-eval.h"
00044 #include "symtab.h"
00045 #include "unwind-prot.h"
00046 
00047 static tree_evaluator std_evaluator;
00048 
00049 tree_evaluator *current_evaluator = &std_evaluator;
00050 
00051 int tree_evaluator::dbstep_flag = 0;
00052 
00053 size_t tree_evaluator::current_frame = 0;
00054 
00055 bool tree_evaluator::debug_mode = false;
00056 
00057 tree_evaluator::stmt_list_type tree_evaluator::statement_context
00058   = tree_evaluator::other;
00059 
00060 bool tree_evaluator::in_loop_command = false;
00061 
00062 // Maximum nesting level for functions, scripts, or sourced files called
00063 // recursively.
00064 int Vmax_recursion_depth = 256;
00065 
00066 // If TRUE, turn off printing of results in functions (as if a
00067 // semicolon has been appended to each statement).
00068 static bool Vsilent_functions = false;
00069 
00070 // Normal evaluator.
00071 
00072 void
00073 tree_evaluator::visit_anon_fcn_handle (tree_anon_fcn_handle&)
00074 {
00075   panic_impossible ();
00076 }
00077 
00078 void
00079 tree_evaluator::visit_argument_list (tree_argument_list&)
00080 {
00081   panic_impossible ();
00082 }
00083 
00084 void
00085 tree_evaluator::visit_binary_expression (tree_binary_expression&)
00086 {
00087   panic_impossible ();
00088 }
00089 
00090 void
00091 tree_evaluator::visit_break_command (tree_break_command& cmd)
00092 {
00093   if (! error_state)
00094     {
00095       if (debug_mode)
00096         do_breakpoint (cmd.is_breakpoint ());
00097 
00098       if (statement_context == function || statement_context == script
00099           || in_loop_command)
00100         tree_break_command::breaking = 1;
00101     }
00102 }
00103 
00104 void
00105 tree_evaluator::visit_colon_expression (tree_colon_expression&)
00106 {
00107   panic_impossible ();
00108 }
00109 
00110 void
00111 tree_evaluator::visit_continue_command (tree_continue_command& cmd)
00112 {
00113   if (! error_state)
00114     {
00115       if (debug_mode)
00116         do_breakpoint (cmd.is_breakpoint ());
00117 
00118       if (statement_context == function || statement_context == script
00119           || in_loop_command)
00120         tree_continue_command::continuing = 1;
00121     }
00122 }
00123 
00124 void
00125 tree_evaluator::reset_debug_state (void)
00126 {
00127   debug_mode = bp_table::have_breakpoints () || Vdebugging;
00128 
00129   dbstep_flag = 0;
00130 }
00131 
00132 static inline void
00133 do_global_init (tree_decl_elt& elt)
00134 {
00135   tree_identifier *id = elt.ident ();
00136 
00137   if (id)
00138     {
00139       id->mark_global ();
00140 
00141       if (! error_state)
00142         {
00143           octave_lvalue ult = id->lvalue ();
00144 
00145           if (ult.is_undefined ())
00146             {
00147               tree_expression *expr = elt.expression ();
00148 
00149               octave_value init_val;
00150 
00151               if (expr)
00152                 init_val = expr->rvalue1 ();
00153               else
00154                 init_val = Matrix ();
00155 
00156               ult.assign (octave_value::op_asn_eq, init_val);
00157             }
00158         }
00159     }
00160 }
00161 
00162 static inline void
00163 do_static_init (tree_decl_elt& elt)
00164 {
00165   tree_identifier *id = elt.ident ();
00166 
00167   if (id)
00168     {
00169       id->mark_as_static ();
00170 
00171       octave_lvalue ult = id->lvalue ();
00172 
00173       if (ult.is_undefined ())
00174         {
00175           tree_expression *expr = elt.expression ();
00176 
00177           octave_value init_val;
00178 
00179           if (expr)
00180             init_val = expr->rvalue1 ();
00181           else
00182             init_val = Matrix ();
00183 
00184           ult.assign (octave_value::op_asn_eq, init_val);
00185         }
00186     }
00187 }
00188 
00189 void
00190 tree_evaluator::do_decl_init_list (decl_elt_init_fcn fcn,
00191                                    tree_decl_init_list *init_list)
00192 {
00193   if (init_list)
00194     {
00195       for (tree_decl_init_list::iterator p = init_list->begin ();
00196            p != init_list->end (); p++)
00197         {
00198           tree_decl_elt *elt = *p;
00199 
00200           fcn (*elt);
00201 
00202           if (error_state)
00203             break;
00204         }
00205     }
00206 }
00207 
00208 void
00209 tree_evaluator::visit_global_command (tree_global_command& cmd)
00210 {
00211   if (debug_mode)
00212     do_breakpoint (cmd.is_breakpoint ());
00213 
00214   do_decl_init_list (do_global_init, cmd.initializer_list ());
00215 }
00216 
00217 void
00218 tree_evaluator::visit_static_command (tree_static_command& cmd)
00219 {
00220   if (debug_mode)
00221     do_breakpoint (cmd.is_breakpoint ());
00222 
00223   do_decl_init_list (do_static_init, cmd.initializer_list ());
00224 }
00225 
00226 void
00227 tree_evaluator::visit_decl_elt (tree_decl_elt&)
00228 {
00229   panic_impossible ();
00230 }
00231 
00232 #if 0
00233 bool
00234 tree_decl_elt::eval (void)
00235 {
00236   bool retval = false;
00237 
00238   if (id && expr)
00239     {
00240       octave_lvalue ult = id->lvalue ();
00241 
00242       octave_value init_val = expr->rvalue1 ();
00243 
00244       if (! error_state)
00245        {
00246          ult.assign (octave_value::op_asn_eq, init_val);
00247 
00248          retval = true;
00249        }
00250     }
00251 
00252   return retval;
00253 }
00254 #endif
00255 
00256 void
00257 tree_evaluator::visit_decl_init_list (tree_decl_init_list&)
00258 {
00259   panic_impossible ();
00260 }
00261 
00262 // Decide if it's time to quit a for or while loop.
00263 static inline bool
00264 quit_loop_now (void)
00265 {
00266   octave_quit ();
00267 
00268   // Maybe handle 'continue N' someday...
00269 
00270   if (tree_continue_command::continuing)
00271     tree_continue_command::continuing--;
00272 
00273   bool quit = (error_state
00274                || tree_return_command::returning
00275                || tree_break_command::breaking
00276                || tree_continue_command::continuing);
00277 
00278   if (tree_break_command::breaking)
00279     tree_break_command::breaking--;
00280 
00281   return quit;
00282 }
00283 
00284 void
00285 tree_evaluator::visit_simple_for_command (tree_simple_for_command& cmd)
00286 {
00287   if (error_state)
00288     return;
00289 
00290   if (debug_mode)
00291     do_breakpoint (cmd.is_breakpoint ());
00292 
00293   // FIXME -- need to handle PARFOR loops here using cmd.in_parallel ()
00294   // and cmd.maxproc_expr ();
00295 
00296   unwind_protect frame;
00297 
00298   frame.protect_var (in_loop_command);
00299 
00300   in_loop_command = true;
00301 
00302   tree_expression *expr = cmd.control_expr ();
00303 
00304   octave_value rhs = expr->rvalue1 ();
00305 
00306   if (error_state || rhs.is_undefined ())
00307     return;
00308 
00309   {
00310     tree_expression *lhs = cmd.left_hand_side ();
00311 
00312     octave_lvalue ult = lhs->lvalue ();
00313 
00314     if (error_state)
00315       return;
00316 
00317     tree_statement_list *loop_body = cmd.body ();
00318 
00319     if (rhs.is_range ())
00320       {
00321         Range rng = rhs.range_value ();
00322 
00323         octave_idx_type steps = rng.nelem ();
00324         double b = rng.base ();
00325         double increment = rng.inc ();
00326 
00327         for (octave_idx_type i = 0; i < steps; i++)
00328           {
00329             // Use multiplication here rather than declaring a
00330             // temporary variable outside the loop and using
00331             //
00332             //   tmp_val += increment
00333             //
00334             // to avoid problems with limited precision.  Also, this
00335             // is consistent with the way Range::matrix_value is
00336             // implemented.
00337 
00338             octave_value val (b + i * increment);
00339 
00340             ult.assign (octave_value::op_asn_eq, val);
00341 
00342             if (! error_state && loop_body)
00343               loop_body->accept (*this);
00344 
00345             if (quit_loop_now ())
00346               break;
00347           }
00348       }
00349     else if (rhs.is_scalar_type ())
00350       {
00351         ult.assign (octave_value::op_asn_eq, rhs);
00352 
00353         if (! error_state && loop_body)
00354           loop_body->accept (*this);
00355 
00356         // Maybe decrement break and continue states.
00357         quit_loop_now ();
00358       }
00359     else if (rhs.is_matrix_type () || rhs.is_cell () || rhs.is_string ()
00360              || rhs.is_map ())
00361       {
00362         // A matrix or cell is reshaped to 2 dimensions and iterated by
00363         // columns.
00364 
00365         dim_vector dv = rhs.dims ().redim (2);
00366 
00367         octave_idx_type nrows = dv(0), steps = dv(1);
00368 
00369         if (steps > 0)
00370           {
00371             octave_value arg = rhs;
00372             if (rhs.ndims () > 2)
00373               arg = arg.reshape (dv);
00374 
00375             // for row vectors, use single index to speed things up.
00376             octave_value_list idx;
00377             octave_idx_type iidx;
00378             if (nrows == 1)
00379               {
00380                 idx.resize (1);
00381                 iidx = 0;
00382               }
00383             else
00384               {
00385                 idx.resize (2);
00386                 idx(0) = octave_value::magic_colon_t;
00387                 iidx = 1;
00388               }
00389 
00390             for (octave_idx_type i = 1; i <= steps; i++)
00391               {
00392                 // do_index_op expects one-based indices.
00393                 idx(iidx) = i;
00394                 octave_value val = arg.do_index_op (idx);
00395 
00396                 ult.assign (octave_value::op_asn_eq, val);
00397 
00398                 if (! error_state && loop_body)
00399                   loop_body->accept (*this);
00400 
00401                 if (quit_loop_now ())
00402                   break;
00403               }
00404           }
00405       }
00406     else
00407       {
00408         ::error ("invalid type in for loop expression near line %d, column %d",
00409                  cmd.line (), cmd.column ());
00410       }
00411   }
00412 }
00413 
00414 void
00415 tree_evaluator::visit_complex_for_command (tree_complex_for_command& cmd)
00416 {
00417   if (error_state)
00418     return;
00419 
00420   if (debug_mode)
00421     do_breakpoint (cmd.is_breakpoint ());
00422 
00423   unwind_protect frame;
00424 
00425   frame.protect_var (in_loop_command);
00426 
00427   in_loop_command = true;
00428 
00429   tree_expression *expr = cmd.control_expr ();
00430 
00431   octave_value rhs = expr->rvalue1 ();
00432 
00433   if (error_state || rhs.is_undefined ())
00434     return;
00435 
00436   if (rhs.is_map ())
00437     {
00438       // Cycle through structure elements.  First element of id_list
00439       // is set to value and the second is set to the name of the
00440       // structure element.
00441 
00442       tree_argument_list *lhs = cmd.left_hand_side ();
00443 
00444       tree_argument_list::iterator p = lhs->begin ();
00445 
00446       tree_expression *elt = *p++;
00447 
00448       octave_lvalue val_ref = elt->lvalue ();
00449 
00450       elt = *p;
00451 
00452       octave_lvalue key_ref = elt->lvalue ();
00453 
00454       const octave_map tmp_val = rhs.map_value ();
00455 
00456       tree_statement_list *loop_body = cmd.body ();
00457 
00458       string_vector keys = tmp_val.keys ();
00459 
00460       octave_idx_type nel = keys.numel ();
00461 
00462       for (octave_idx_type i = 0; i < nel; i++)
00463         {
00464           std::string key = keys[i];
00465 
00466           const Cell val_lst = tmp_val.contents (key);
00467 
00468           octave_idx_type n = val_lst.numel ();
00469 
00470           octave_value val = (n == 1) ? val_lst(0) : octave_value (val_lst);
00471 
00472           val_ref.assign (octave_value::op_asn_eq, val);
00473           key_ref.assign (octave_value::op_asn_eq, key);
00474 
00475           if (! error_state && loop_body)
00476             loop_body->accept (*this);
00477 
00478           if (quit_loop_now ())
00479             break;
00480         }
00481     }
00482   else
00483     error ("in statement 'for [X, Y] = VAL', VAL must be a structure");
00484 }
00485 
00486 void
00487 tree_evaluator::visit_octave_user_script (octave_user_script&)
00488 {
00489   panic_impossible ();
00490 }
00491 
00492 void
00493 tree_evaluator::visit_octave_user_function (octave_user_function&)
00494 {
00495   panic_impossible ();
00496 }
00497 
00498 void
00499 tree_evaluator::visit_octave_user_function_header (octave_user_function&)
00500 {
00501   panic_impossible ();
00502 }
00503 
00504 void
00505 tree_evaluator::visit_octave_user_function_trailer (octave_user_function&)
00506 {
00507   panic_impossible ();
00508 }
00509 
00510 void
00511 tree_evaluator::visit_function_def (tree_function_def& cmd)
00512 {
00513   octave_value fcn = cmd.function ();
00514 
00515   octave_function *f = fcn.function_value ();
00516 
00517   if (f)
00518     {
00519       std::string nm = f->name ();
00520 
00521       symbol_table::install_cmdline_function (nm, fcn);
00522 
00523       // Make sure that any variable with the same name as the new
00524       // function is cleared.
00525 
00526       symbol_table::varref (nm) = octave_value ();
00527     }
00528 }
00529 
00530 void
00531 tree_evaluator::visit_identifier (tree_identifier&)
00532 {
00533   panic_impossible ();
00534 }
00535 
00536 void
00537 tree_evaluator::visit_if_clause (tree_if_clause&)
00538 {
00539   panic_impossible ();
00540 }
00541 
00542 void
00543 tree_evaluator::visit_if_command (tree_if_command& cmd)
00544 {
00545   if (debug_mode)
00546     do_breakpoint (cmd.is_breakpoint ());
00547 
00548   tree_if_command_list *lst = cmd.cmd_list ();
00549 
00550   if (lst)
00551     lst->accept (*this);
00552 }
00553 
00554 void
00555 tree_evaluator::visit_if_command_list (tree_if_command_list& lst)
00556 {
00557   for (tree_if_command_list::iterator p = lst.begin (); p != lst.end (); p++)
00558     {
00559       tree_if_clause *tic = *p;
00560 
00561       tree_expression *expr = tic->condition ();
00562 
00563       if (debug_mode && ! tic->is_else_clause ())
00564         do_breakpoint (tic->is_breakpoint ());
00565 
00566       if (tic->is_else_clause () || expr->is_logically_true ("if"))
00567         {
00568           if (! error_state)
00569             {
00570               tree_statement_list *stmt_lst = tic->commands ();
00571 
00572               if (stmt_lst)
00573                 stmt_lst->accept (*this);
00574             }
00575 
00576           break;
00577         }
00578     }
00579 }
00580 
00581 void
00582 tree_evaluator::visit_index_expression (tree_index_expression&)
00583 {
00584   panic_impossible ();
00585 }
00586 
00587 void
00588 tree_evaluator::visit_matrix (tree_matrix&)
00589 {
00590   panic_impossible ();
00591 }
00592 
00593 void
00594 tree_evaluator::visit_cell (tree_cell&)
00595 {
00596   panic_impossible ();
00597 }
00598 
00599 void
00600 tree_evaluator::visit_multi_assignment (tree_multi_assignment&)
00601 {
00602   panic_impossible ();
00603 }
00604 
00605 void
00606 tree_evaluator::visit_no_op_command (tree_no_op_command& cmd)
00607 {
00608   if (debug_mode && cmd.is_end_of_fcn_or_script ())
00609     do_breakpoint (cmd.is_breakpoint (), true);
00610 }
00611 
00612 void
00613 tree_evaluator::visit_constant (tree_constant&)
00614 {
00615   panic_impossible ();
00616 }
00617 
00618 void
00619 tree_evaluator::visit_fcn_handle (tree_fcn_handle&)
00620 {
00621   panic_impossible ();
00622 }
00623 
00624 void
00625 tree_evaluator::visit_parameter_list (tree_parameter_list&)
00626 {
00627   panic_impossible ();
00628 }
00629 
00630 void
00631 tree_evaluator::visit_postfix_expression (tree_postfix_expression&)
00632 {
00633   panic_impossible ();
00634 }
00635 
00636 void
00637 tree_evaluator::visit_prefix_expression (tree_prefix_expression&)
00638 {
00639   panic_impossible ();
00640 }
00641 
00642 void
00643 tree_evaluator::visit_return_command (tree_return_command& cmd)
00644 {
00645   if (! error_state)
00646     {
00647       if (debug_mode)
00648         do_breakpoint (cmd.is_breakpoint ());
00649 
00650       // Act like dbcont.
00651 
00652       if (Vdebugging
00653           && octave_call_stack::current_frame () == current_frame)
00654         {
00655           Vdebugging = false;
00656 
00657           reset_debug_state ();
00658         }
00659       else if (statement_context == function || statement_context == script
00660                || in_loop_command)
00661         tree_return_command::returning = 1;
00662     }
00663 }
00664 
00665 void
00666 tree_evaluator::visit_return_list (tree_return_list&)
00667 {
00668   panic_impossible ();
00669 }
00670 
00671 void
00672 tree_evaluator::visit_simple_assignment (tree_simple_assignment&)
00673 {
00674   panic_impossible ();
00675 }
00676 
00677 void
00678 tree_evaluator::visit_statement (tree_statement& stmt)
00679 {
00680   tree_command *cmd = stmt.command ();
00681   tree_expression *expr = stmt.expression ();
00682 
00683   if (cmd || expr)
00684     {
00685       if (statement_context == function || statement_context == script)
00686         {
00687           // Skip commands issued at a debug> prompt to avoid disturbing
00688           // the state of the program we are debugging.
00689 
00690           if (! Vdebugging)
00691             octave_call_stack::set_statement (&stmt);
00692 
00693           // FIXME -- we need to distinguish functions from scripts to
00694           // get this right.
00695           if ((statement_context == script
00696                && ((Vecho_executing_commands & ECHO_SCRIPTS)
00697                    || (Vecho_executing_commands & ECHO_FUNCTIONS)))
00698               || (statement_context == function
00699                   && (Vecho_executing_commands & ECHO_FUNCTIONS)))
00700             stmt.echo_code ();
00701         }
00702 
00703       try
00704         {
00705           if (cmd)
00706             cmd->accept (*this);
00707           else
00708             {
00709               if (debug_mode)
00710                 do_breakpoint (expr->is_breakpoint ());
00711 
00712               if ((statement_context == function || statement_context == script)
00713                   && Vsilent_functions)
00714                 expr->set_print_flag (false);
00715 
00716               // FIXME -- maybe all of this should be packaged in
00717               // one virtual function that returns a flag saying whether
00718               // or not the expression will take care of binding ans and
00719               // printing the result.
00720 
00721               // FIXME -- it seems that we should just have to
00722               // call expr->rvalue1 () and that should take care of
00723               // everything, binding ans as necessary?
00724 
00725               bool do_bind_ans = false;
00726 
00727               if (expr->is_identifier ())
00728                 {
00729                   tree_identifier *id = dynamic_cast<tree_identifier *> (expr);
00730 
00731                   do_bind_ans = (! id->is_variable ());
00732                 }
00733               else
00734                 do_bind_ans = (! expr->is_assignment_expression ());
00735 
00736               octave_value tmp_result = expr->rvalue1 (0);
00737 
00738               if (do_bind_ans && ! (error_state || tmp_result.is_undefined ()))
00739                 bind_ans (tmp_result, expr->print_result ());
00740 
00741               //              if (tmp_result.is_defined ())
00742               //                result_values(0) = tmp_result;
00743             }
00744         }
00745       catch (octave_execution_exception)
00746         {
00747           gripe_library_execution_error ();
00748         }
00749     }
00750 }
00751 
00752 void
00753 tree_evaluator::visit_statement_list (tree_statement_list& lst)
00754 {
00755   static octave_value_list empty_list;
00756 
00757   if (error_state)
00758     return;
00759 
00760   tree_statement_list::iterator p = lst.begin ();
00761 
00762   if (p != lst.end ())
00763     {
00764       while (true)
00765         {
00766           tree_statement *elt = *p++;
00767 
00768           if (elt)
00769             {
00770               octave_quit ();
00771 
00772               elt->accept (*this);
00773 
00774               if (error_state)
00775                 break;
00776 
00777               if (tree_break_command::breaking
00778                   || tree_continue_command::continuing)
00779                 break;
00780 
00781               if (tree_return_command::returning)
00782                 break;
00783 
00784               if (p == lst.end ())
00785                 break;
00786               else
00787                 {
00788                   // Clear preivous values before next statement is
00789                   // evaluated so that we aren't holding an extra
00790                   // reference to a value that may be used next.  For
00791                   // example, in code like this:
00792                   //
00793                   //   X = rand (N);  ## refcount for X should be 1
00794                   //                  ## after this statement
00795                   //
00796                   //   X(idx) = val;  ## no extra copy of X should be
00797                   //                  ## needed, but we will be faked
00798                   //                  ## out if retval is not cleared
00799                   //                  ## between statements here
00800 
00801                   //              result_values = empty_list;
00802                 }
00803             }
00804           else
00805             error ("invalid statement found in statement list!");
00806         }
00807     }
00808 }
00809 
00810 void
00811 tree_evaluator::visit_switch_case (tree_switch_case&)
00812 {
00813   panic_impossible ();
00814 }
00815 
00816 void
00817 tree_evaluator::visit_switch_case_list (tree_switch_case_list&)
00818 {
00819   panic_impossible ();
00820 }
00821 
00822 void
00823 tree_evaluator::visit_switch_command (tree_switch_command& cmd)
00824 {
00825   if (debug_mode)
00826     do_breakpoint (cmd.is_breakpoint ());
00827 
00828   tree_expression *expr = cmd.switch_value ();
00829 
00830   if (expr)
00831     {
00832       octave_value val = expr->rvalue1 ();
00833 
00834       tree_switch_case_list *lst = cmd.case_list ();
00835 
00836       if (! error_state && lst)
00837         {
00838           for (tree_switch_case_list::iterator p = lst->begin ();
00839                p != lst->end (); p++)
00840             {
00841               tree_switch_case *t = *p;
00842 
00843               if (debug_mode && ! t->is_default_case ())
00844                 do_breakpoint (t->is_breakpoint ());
00845 
00846               if (t->is_default_case () || t->label_matches (val))
00847                 {
00848                   if (error_state)
00849                     break;
00850 
00851                   tree_statement_list *stmt_lst = t->commands ();
00852 
00853                   if (stmt_lst)
00854                     stmt_lst->accept (*this);
00855 
00856                   break;
00857                 }
00858             }
00859         }
00860     }
00861   else
00862     ::error ("missing value in switch command near line %d, column %d",
00863              cmd.line (), cmd.column ());
00864 }
00865 
00866 void
00867 tree_evaluator::visit_try_catch_command (tree_try_catch_command& cmd)
00868 {
00869   unwind_protect frame;
00870 
00871   frame.protect_var (buffer_error_messages);
00872   frame.protect_var (Vdebug_on_error);
00873   frame.protect_var (Vdebug_on_warning);
00874 
00875   buffer_error_messages++;
00876   Vdebug_on_error = false;
00877   Vdebug_on_warning = false;
00878 
00879   tree_statement_list *catch_code = cmd.cleanup ();
00880 
00881   // The catch code is *not* added to unwind_protect stack; it doesn't need
00882   // to be run on interrupts.
00883 
00884   tree_statement_list *try_code = cmd.body ();
00885 
00886   if (try_code)
00887     {
00888       try_code->accept (*this);
00889       // FIXME: should std::bad_alloc be handled here?
00890     }
00891 
00892   if (error_state)
00893     {
00894       error_state = 0;
00895 
00896       if (catch_code)
00897         {
00898           // Set up for letting the user print any messages from errors that
00899           // occurred in the body of the try_catch statement.
00900 
00901           buffer_error_messages--;
00902 
00903           if (catch_code)
00904             catch_code->accept (*this);
00905         }
00906     }
00907 }
00908 
00909 void
00910 tree_evaluator::do_unwind_protect_cleanup_code (tree_statement_list *list)
00911 {
00912   unwind_protect frame;
00913 
00914   frame.protect_var (octave_interrupt_state);
00915   octave_interrupt_state = 0;
00916 
00917   // We want to run the cleanup code without error_state being set,
00918   // but we need to restore its value, so that any errors encountered
00919   // in the first part of the unwind_protect are not completely
00920   // ignored.
00921 
00922   frame.protect_var (error_state);
00923   error_state = 0;
00924 
00925   // We want to preserve the last statement indicator for possible
00926   // backtracking.
00927   frame.add_fcn (octave_call_stack::set_statement,
00928                  octave_call_stack::current_statement ());
00929 
00930   // Similarly, if we have seen a return or break statement, allow all
00931   // the cleanup code to run before returning or handling the break.
00932   // We don't have to worry about continue statements because they can
00933   // only occur in loops.
00934 
00935   frame.protect_var (tree_return_command::returning);
00936   tree_return_command::returning = 0;
00937 
00938   frame.protect_var (tree_break_command::breaking);
00939   tree_break_command::breaking = 0;
00940 
00941   if (list)
00942     list->accept (*this);
00943 
00944   // The unwind_protects are popped off the stack in the reverse of
00945   // the order they are pushed on.
00946 
00947   // FIXME -- these statements say that if we see a break or
00948   // return statement in the cleanup block, that we want to use the
00949   // new value of the breaking or returning flag instead of restoring
00950   // the previous value.  Is that the right thing to do?  I think so.
00951   // Consider the case of
00952   //
00953   //   function foo ()
00954   //     unwind_protect
00955   //       stderr << "1: this should always be executed\n";
00956   //       break;
00957   //       stderr << "1: this should never be executed\n";
00958   //     unwind_protect_cleanup
00959   //       stderr << "2: this should always be executed\n";
00960   //       return;
00961   //       stderr << "2: this should never be executed\n";
00962   //     end_unwind_protect
00963   //   endfunction
00964   //
00965   // If we reset the value of the breaking flag, both the returning
00966   // flag and the breaking flag will be set, and we shouldn't have
00967   // both.  So, use the most recent one.  If there is no return or
00968   // break in the cleanup block, the values should be reset to
00969   // whatever they were when the cleanup block was entered.
00970 
00971   if (tree_break_command::breaking || tree_return_command::returning)
00972     {
00973       frame.discard_top (2);
00974     }
00975   else
00976     {
00977       frame.run_top (2);
00978     }
00979 
00980   // We don't want to ignore errors that occur in the cleanup code, so
00981   // if an error is encountered there, leave error_state alone.
00982   // Otherwise, set it back to what it was before.
00983 
00984   if (error_state)
00985     frame.discard_top (2);
00986   else
00987     frame.run_top (2);
00988 
00989   frame.run ();
00990 }
00991 
00992 void
00993 tree_evaluator::visit_unwind_protect_command (tree_unwind_protect_command& cmd)
00994 {
00995   tree_statement_list *cleanup_code = cmd.cleanup ();
00996 
00997   tree_statement_list *unwind_protect_code = cmd.body ();
00998 
00999   if (unwind_protect_code)
01000     {
01001       try
01002         {
01003           unwind_protect_code->accept (*this);
01004         }
01005       catch (...)
01006         {
01007           // Run the cleanup code on exceptions, so that it is run even in case
01008           // of interrupt or out-of-memory.
01009           do_unwind_protect_cleanup_code (cleanup_code);
01010           // FIXME: should error_state be checked here?
01011           // We want to rethrow the exception, even if error_state is set, so
01012           // that interrupts continue.
01013           throw;
01014         }
01015 
01016       do_unwind_protect_cleanup_code (cleanup_code);
01017     }
01018 }
01019 
01020 void
01021 tree_evaluator::visit_while_command (tree_while_command& cmd)
01022 {
01023   if (error_state)
01024     return;
01025 
01026   unwind_protect frame;
01027 
01028   frame.protect_var (in_loop_command);
01029 
01030   in_loop_command = true;
01031 
01032   tree_expression *expr = cmd.condition ();
01033 
01034   if (! expr)
01035     panic_impossible ();
01036 
01037   for (;;)
01038     {
01039       if (debug_mode)
01040         do_breakpoint (cmd.is_breakpoint ());
01041 
01042       if (expr->is_logically_true ("while"))
01043         {
01044           tree_statement_list *loop_body = cmd.body ();
01045 
01046           if (loop_body)
01047             {
01048               loop_body->accept (*this);
01049 
01050               if (error_state)
01051                 return;
01052             }
01053 
01054           if (quit_loop_now ())
01055             break;
01056         }
01057       else
01058         break;
01059     }
01060 }
01061 
01062 void
01063 tree_evaluator::visit_do_until_command (tree_do_until_command& cmd)
01064 {
01065   if (error_state)
01066     return;
01067 
01068   unwind_protect frame;
01069 
01070   frame.protect_var (in_loop_command);
01071 
01072   in_loop_command = true;
01073 
01074   tree_expression *expr = cmd.condition ();
01075 
01076   if (! expr)
01077     panic_impossible ();
01078 
01079   for (;;)
01080     {
01081       tree_statement_list *loop_body = cmd.body ();
01082 
01083       if (loop_body)
01084         {
01085           loop_body->accept (*this);
01086 
01087           if (error_state)
01088             return;
01089         }
01090 
01091       if (quit_loop_now ())
01092         break;
01093 
01094       if (debug_mode)
01095         do_breakpoint (cmd.is_breakpoint ());
01096 
01097       if (expr->is_logically_true ("do-until"))
01098         break;
01099     }
01100 }
01101 
01102 void
01103 tree_evaluator::do_breakpoint (tree_statement& stmt) const
01104 {
01105   do_breakpoint (stmt.is_breakpoint (), stmt.is_end_of_fcn_or_script ());
01106 }
01107 
01108 void
01109 tree_evaluator::do_breakpoint (bool is_breakpoint,
01110                                bool is_end_of_fcn_or_script) const
01111 {
01112   bool break_on_this_statement = false;
01113 
01114   // Don't decrement break flag unless we are in the same frame as we
01115   // were when we saw the "dbstep N" command.
01116 
01117   if (dbstep_flag > 1)
01118     {
01119       if (octave_call_stack::current_frame () == current_frame)
01120         {
01121           // Don't allow dbstep N to step past end of current frame.
01122 
01123           if (is_end_of_fcn_or_script)
01124             dbstep_flag = 1;
01125           else
01126             dbstep_flag--;
01127         }
01128     }
01129 
01130   if (octave_debug_on_interrupt_state)
01131     {
01132       break_on_this_statement = true;
01133 
01134       octave_debug_on_interrupt_state = false;
01135 
01136       current_frame = octave_call_stack::current_frame ();
01137     }
01138   else if (is_breakpoint)
01139     {
01140       break_on_this_statement = true;
01141 
01142       dbstep_flag = 0;
01143 
01144       current_frame = octave_call_stack::current_frame ();
01145     }
01146   else if (dbstep_flag == 1)
01147     {
01148       if (octave_call_stack::current_frame () == current_frame)
01149         {
01150           // We get here if we are doing a "dbstep" or a "dbstep N"
01151           // and the count has reached 1 and we are in the current
01152           // debugging frame.
01153 
01154           break_on_this_statement = true;
01155 
01156           dbstep_flag = 0;
01157         }
01158     }
01159   else if (dbstep_flag == -1)
01160     {
01161       // We get here if we are doing a "dbstep in".
01162 
01163       break_on_this_statement = true;
01164 
01165       dbstep_flag = 0;
01166 
01167       current_frame = octave_call_stack::current_frame ();
01168     }
01169   else if (dbstep_flag == -2)
01170     {
01171       // We get here if we are doing a "dbstep out".
01172 
01173       if (is_end_of_fcn_or_script)
01174         dbstep_flag = -1;
01175     }
01176 
01177   if (break_on_this_statement)
01178     do_keyboard ();
01179 
01180 }
01181 
01182 // ARGS is currently unused, but since the do_keyboard function in
01183 // input.cc accepts an argument list, we preserve it here so that the
01184 // interface won't have to change if we decide to use it in the future.
01185 
01186 octave_value
01187 tree_evaluator::do_keyboard (const octave_value_list& args) const
01188 {
01189   return ::do_keyboard (args);
01190 }
01191 
01192 DEFUN (max_recursion_depth, args, nargout,
01193   "-*- texinfo -*-\n\
01194 @deftypefn  {Built-in Function} {@var{val} =} max_recursion_depth ()\n\
01195 @deftypefnx {Built-in Function} {@var{old_val} =} max_recursion_depth (@var{new_val})\n\
01196 @deftypefnx {Built-in Function} {} max_recursion_depth (@var{new_val}, \"local\")\n\
01197 Query or set the internal limit on the number of times a function may\n\
01198 be called recursively.  If the limit is exceeded, an error message is\n\
01199 printed and control returns to the top level.\n\
01200 \n\
01201 When called from inside a function with the \"local\" option, the variable is\n\
01202 changed locally for the function and any subroutines it calls.  The original\n\
01203 variable value is restored when exiting the function.\n\
01204 @end deftypefn")
01205 {
01206   return SET_INTERNAL_VARIABLE (max_recursion_depth);
01207 }
01208 
01209 /*
01210 %!error (max_recursion_depth (1, 2));
01211 %!test
01212 %! orig_val = max_recursion_depth ();
01213 %! old_val = max_recursion_depth (2*orig_val);
01214 %! assert (orig_val, old_val);
01215 %! assert (max_recursion_depth (), 2*orig_val);
01216 %! max_recursion_depth (orig_val);
01217 %! assert (max_recursion_depth (), orig_val);
01218 */
01219 
01220 DEFUN (silent_functions, args, nargout,
01221   "-*- texinfo -*-\n\
01222 @deftypefn  {Built-in Function} {@var{val} =} silent_functions ()\n\
01223 @deftypefnx {Built-in Function} {@var{old_val} =} silent_functions (@var{new_val})\n\
01224 @deftypefnx {Built-in Function} {} silent_functions (@var{new_val}, \"local\")\n\
01225 Query or set the internal variable that controls whether internal\n\
01226 output from a function is suppressed.  If this option is disabled,\n\
01227 Octave will display the results produced by evaluating expressions\n\
01228 within a function body that are not terminated with a semicolon.\n\
01229 \n\
01230 When called from inside a function with the \"local\" option, the variable is\n\
01231 changed locally for the function and any subroutines it calls.  The original\n\
01232 variable value is restored when exiting the function.\n\
01233 @end deftypefn")
01234 {
01235   return SET_INTERNAL_VARIABLE (silent_functions);
01236 }
01237 
01238 /*
01239 %!error (silent_functions (1, 2));
01240 %!test
01241 %! orig_val = silent_functions ();
01242 %! old_val = silent_functions (! orig_val);
01243 %! assert (orig_val, old_val);
01244 %! assert (silent_functions (), ! orig_val);
01245 %! silent_functions (orig_val);
01246 %! assert (silent_functions (), orig_val);
01247 */
 All Classes Files Functions Variables Typedefs Enumerations Enumerator Friends Defines