Mercurial > hg > octave-lyh

comparison libinterp/parse-tree/pt-eval.cc @ 15195:2fc554ffbc28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
split libinterp from src * libinterp: New directory. Move all files from src directory here except Makefile.am, main.cc, main-cli.cc, mkoctfile.in.cc, mkoctfilr.in.sh, octave-config.in.cc, octave-config.in.sh. * libinterp/Makefile.am: New file, extracted from src/Makefile.am. * src/Makefile.am: Delete everything except targets and definitions needed to build and link main and utility programs. * Makefile.am (SUBDIRS): Include libinterp in the list. * autogen.sh: Run config-module.sh in libinterp/dldfcn directory, not src/dldfcn directory. * configure.ac (AC_CONFIG_SRCDIR): Use libinterp/octave.cc, not src/octave.cc. (DL_LDFLAGS, LIBOCTINTERP): Use libinterp, not src. (AC_CONFIG_FILES): Include libinterp/Makefile in the list. * find-docstring-files.sh: Look in libinterp, not src. * gui/src/Makefile.am (liboctgui_la_CPPFLAGS): Find header files in libinterp, not src.
author John W. Eaton <jwe@octave.org>
date Sat, 18 Aug 2012 16:23:39 -0400
parents src/parse-tree/pt-eval.cc@46b19589b593
children 947cf10c94da c16357c4bdbb
comparison
equal deleted inserted replaced
15194:0f0b795044c3 15195:2fc554ffbc28
1 /*
2
3 Copyright (C) 2009-2012 John W. Eaton
4
5 This file is part of Octave.
6
7 Octave is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 3 of the License, or (at your
10 option) any later version.
11
12 Octave is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with Octave; see the file COPYING. If not, see
19 <http://www.gnu.org/licenses/>.
20
21 */
22
23 #ifdef HAVE_CONFIG_H
24 #include <config.h>
25 #endif
26
27 #include <cctype>
28
29 #include <iostream>
30
31 #include <fstream>
32 #include <typeinfo>
33
34 #include "debug.h"
35 #include "defun.h"
36 #include "error.h"
37 #include "gripes.h"
38 #include "input.h"
39 #include "ov-fcn-handle.h"
40 #include "ov-usr-fcn.h"
41 #include "variables.h"
42 #include "pt-all.h"
43 #include "pt-eval.h"
44 #include "symtab.h"
45 #include "unwind-prot.h"
46
47 #if HAVE_LLVM
48 //FIXME: This should be part of tree_evaluator
49 #include "pt-jit.h"
50 static tree_jit jiter;
51 #endif
52
53 static tree_evaluator std_evaluator;
54
55 tree_evaluator *current_evaluator = &std_evaluator;
56
57 int tree_evaluator::dbstep_flag = 0;
58
59 size_t tree_evaluator::current_frame = 0;
60
61 bool tree_evaluator::debug_mode = false;
62
63 tree_evaluator::stmt_list_type tree_evaluator::statement_context
64 = tree_evaluator::other;
65
66 bool tree_evaluator::in_loop_command = false;
67
68 // Maximum nesting level for functions, scripts, or sourced files called
69 // recursively.
70 int Vmax_recursion_depth = 256;
71
72 // If TRUE, turn off printing of results in functions (as if a
73 // semicolon has been appended to each statement).
74 static bool Vsilent_functions = false;
75
76 // Normal evaluator.
77
78 void
79 tree_evaluator::visit_anon_fcn_handle (tree_anon_fcn_handle&)
80 {
81 panic_impossible ();
82 }
83
84 void
85 tree_evaluator::visit_argument_list (tree_argument_list&)
86 {
87 panic_impossible ();
88 }
89
90 void
91 tree_evaluator::visit_binary_expression (tree_binary_expression&)
92 {
93 panic_impossible ();
94 }
95
96 void
97 tree_evaluator::visit_break_command (tree_break_command& cmd)
98 {
99 if (! error_state)
100 {
101 if (debug_mode)
102 do_breakpoint (cmd.is_breakpoint ());
103
104 if (statement_context == function || statement_context == script
105 || in_loop_command)
106 tree_break_command::breaking = 1;
107 }
108 }
109
110 void
111 tree_evaluator::visit_colon_expression (tree_colon_expression&)
112 {
113 panic_impossible ();
114 }
115
116 void
117 tree_evaluator::visit_continue_command (tree_continue_command& cmd)
118 {
119 if (! error_state)
120 {
121 if (debug_mode)
122 do_breakpoint (cmd.is_breakpoint ());
123
124 if (statement_context == function || statement_context == script
125 || in_loop_command)
126 tree_continue_command::continuing = 1;
127 }
128 }
129
130 void
131 tree_evaluator::reset_debug_state (void)
132 {
133 debug_mode = bp_table::have_breakpoints () || Vdebugging;
134
135 dbstep_flag = 0;
136 }
137
138 static inline void
139 do_global_init (tree_decl_elt& elt)
140 {
141 tree_identifier *id = elt.ident ();
142
143 if (id)
144 {
145 id->mark_global ();
146
147 if (! error_state)
148 {
149 octave_lvalue ult = id->lvalue ();
150
151 if (ult.is_undefined ())
152 {
153 tree_expression *expr = elt.expression ();
154
155 octave_value init_val;
156
157 if (expr)
158 init_val = expr->rvalue1 ();
159 else
160 init_val = Matrix ();
161
162 ult.assign (octave_value::op_asn_eq, init_val);
163 }
164 }
165 }
166 }
167
168 static inline void
169 do_static_init (tree_decl_elt& elt)
170 {
171 tree_identifier *id = elt.ident ();
172
173 if (id)
174 {
175 id->mark_as_static ();
176
177 octave_lvalue ult = id->lvalue ();
178
179 if (ult.is_undefined ())
180 {
181 tree_expression *expr = elt.expression ();
182
183 octave_value init_val;
184
185 if (expr)
186 init_val = expr->rvalue1 ();
187 else
188 init_val = Matrix ();
189
190 ult.assign (octave_value::op_asn_eq, init_val);
191 }
192 }
193 }
194
195 void
196 tree_evaluator::do_decl_init_list (decl_elt_init_fcn fcn,
197 tree_decl_init_list *init_list)
198 {
199 if (init_list)
200 {
201 for (tree_decl_init_list::iterator p = init_list->begin ();
202 p != init_list->end (); p++)
203 {
204 tree_decl_elt *elt = *p;
205
206 fcn (*elt);
207
208 if (error_state)
209 break;
210 }
211 }
212 }
213
214 void
215 tree_evaluator::visit_global_command (tree_global_command& cmd)
216 {
217 if (debug_mode)
218 do_breakpoint (cmd.is_breakpoint ());
219
220 do_decl_init_list (do_global_init, cmd.initializer_list ());
221 }
222
223 void
224 tree_evaluator::visit_persistent_command (tree_persistent_command& cmd)
225 {
226 if (debug_mode)
227 do_breakpoint (cmd.is_breakpoint ());
228
229 do_decl_init_list (do_static_init, cmd.initializer_list ());
230 }
231
232 void
233 tree_evaluator::visit_decl_elt (tree_decl_elt&)
234 {
235 panic_impossible ();
236 }
237
238 #if 0
239 bool
240 tree_decl_elt::eval (void)
241 {
242 bool retval = false;
243
244 if (id && expr)
245 {
246 octave_lvalue ult = id->lvalue ();
247
248 octave_value init_val = expr->rvalue1 ();
249
250 if (! error_state)
251 {
252 ult.assign (octave_value::op_asn_eq, init_val);
253
254 retval = true;
255 }
256 }
257
258 return retval;
259 }
260 #endif
261
262 void
263 tree_evaluator::visit_decl_init_list (tree_decl_init_list&)
264 {
265 panic_impossible ();
266 }
267
268 // Decide if it's time to quit a for or while loop.
269 static inline bool
270 quit_loop_now (void)
271 {
272 octave_quit ();
273
274 // Maybe handle `continue N' someday...
275
276 if (tree_continue_command::continuing)
277 tree_continue_command::continuing--;
278
279 bool quit = (error_state
280 || tree_return_command::returning
281 || tree_break_command::breaking
282 || tree_continue_command::continuing);
283
284 if (tree_break_command::breaking)
285 tree_break_command::breaking--;
286
287 return quit;
288 }
289
290 void
291 tree_evaluator::visit_simple_for_command (tree_simple_for_command& cmd)
292 {
293 if (error_state)
294 return;
295
296 if (debug_mode)
297 do_breakpoint (cmd.is_breakpoint ());
298
299 // FIXME -- need to handle PARFOR loops here using cmd.in_parallel ()
300 // and cmd.maxproc_expr ();
301
302 unwind_protect frame;
303
304 frame.protect_var (in_loop_command);
305
306 in_loop_command = true;
307
308 tree_expression *expr = cmd.control_expr ();
309
310 octave_value rhs = expr->rvalue1 ();
311
312 #if HAVE_LLVM
313 if (jiter.execute (cmd, rhs))
314 return;
315 #endif
316
317 if (error_state || rhs.is_undefined ())
318 return;
319
320 {
321 tree_expression *lhs = cmd.left_hand_side ();
322
323 octave_lvalue ult = lhs->lvalue ();
324
325 if (error_state)
326 return;
327
328 tree_statement_list *loop_body = cmd.body ();
329
330 if (rhs.is_range ())
331 {
332 Range rng = rhs.range_value ();
333
334 octave_idx_type steps = rng.nelem ();
335 double b = rng.base ();
336 double increment = rng.inc ();
337
338 for (octave_idx_type i = 0; i < steps; i++)
339 {
340 // Use multiplication here rather than declaring a
341 // temporary variable outside the loop and using
342 //
343 // tmp_val += increment
344 //
345 // to avoid problems with limited precision. Also, this
346 // is consistent with the way Range::matrix_value is
347 // implemented.
348
349 octave_value val (b + i * increment);
350
351 ult.assign (octave_value::op_asn_eq, val);
352
353 if (! error_state && loop_body)
354 loop_body->accept (*this);
355
356 if (quit_loop_now ())
357 break;
358 }
359 }
360 else if (rhs.is_scalar_type ())
361 {
362 ult.assign (octave_value::op_asn_eq, rhs);
363
364 if (! error_state && loop_body)
365 loop_body->accept (*this);
366
367 // Maybe decrement break and continue states.
368 quit_loop_now ();
369 }
370 else if (rhs.is_matrix_type () || rhs.is_cell () || rhs.is_string ()
371 || rhs.is_map ())
372 {
373 // A matrix or cell is reshaped to 2 dimensions and iterated by
374 // columns.
375
376 dim_vector dv = rhs.dims ().redim (2);
377
378 octave_idx_type nrows = dv(0), steps = dv(1);
379
380 if (steps > 0)
381 {
382 octave_value arg = rhs;
383 if (rhs.ndims () > 2)
384 arg = arg.reshape (dv);
385
386 // for row vectors, use single index to speed things up.
387 octave_value_list idx;
388 octave_idx_type iidx;
389 if (nrows == 1)
390 {
391 idx.resize (1);
392 iidx = 0;
393 }
394 else
395 {
396 idx.resize (2);
397 idx(0) = octave_value::magic_colon_t;
398 iidx = 1;
399 }
400
401 for (octave_idx_type i = 1; i <= steps; i++)
402 {
403 // do_index_op expects one-based indices.
404 idx(iidx) = i;
405 octave_value val = arg.do_index_op (idx);
406
407 ult.assign (octave_value::op_asn_eq, val);
408
409 if (! error_state && loop_body)
410 loop_body->accept (*this);
411
412 if (quit_loop_now ())
413 break;
414 }
415 }
416 }
417 else
418 {
419 ::error ("invalid type in for loop expression near line %d, column %d",
420 cmd.line (), cmd.column ());
421 }
422 }
423 }
424
425 void
426 tree_evaluator::visit_complex_for_command (tree_complex_for_command& cmd)
427 {
428 if (error_state)
429 return;
430
431 if (debug_mode)
432 do_breakpoint (cmd.is_breakpoint ());
433
434 unwind_protect frame;
435
436 frame.protect_var (in_loop_command);
437
438 in_loop_command = true;
439
440 tree_expression *expr = cmd.control_expr ();
441
442 octave_value rhs = expr->rvalue1 ();
443
444 if (error_state || rhs.is_undefined ())
445 return;
446
447 if (rhs.is_map ())
448 {
449 // Cycle through structure elements. First element of id_list
450 // is set to value and the second is set to the name of the
451 // structure element.
452
453 tree_argument_list *lhs = cmd.left_hand_side ();
454
455 tree_argument_list::iterator p = lhs->begin ();
456
457 tree_expression *elt = *p++;
458
459 octave_lvalue val_ref = elt->lvalue ();
460
461 elt = *p;
462
463 octave_lvalue key_ref = elt->lvalue ();
464
465 const octave_map tmp_val = rhs.map_value ();
466
467 tree_statement_list *loop_body = cmd.body ();
468
469 string_vector keys = tmp_val.keys ();
470
471 octave_idx_type nel = keys.numel ();
472
473 for (octave_idx_type i = 0; i < nel; i++)
474 {
475 std::string key = keys[i];
476
477 const Cell val_lst = tmp_val.contents (key);
478
479 octave_idx_type n = val_lst.numel ();
480
481 octave_value val = (n == 1) ? val_lst(0) : octave_value (val_lst);
482
483 val_ref.assign (octave_value::op_asn_eq, val);
484 key_ref.assign (octave_value::op_asn_eq, key);
485
486 if (! error_state && loop_body)
487 loop_body->accept (*this);
488
489 if (quit_loop_now ())
490 break;
491 }
492 }
493 else
494 error ("in statement `for [X, Y] = VAL', VAL must be a structure");
495 }
496
497 void
498 tree_evaluator::visit_octave_user_script (octave_user_script&)
499 {
500 panic_impossible ();
501 }
502
503 void
504 tree_evaluator::visit_octave_user_function (octave_user_function&)
505 {
506 panic_impossible ();
507 }
508
509 void
510 tree_evaluator::visit_octave_user_function_header (octave_user_function&)
511 {
512 panic_impossible ();
513 }
514
515 void
516 tree_evaluator::visit_octave_user_function_trailer (octave_user_function&)
517 {
518 panic_impossible ();
519 }
520
521 void
522 tree_evaluator::visit_function_def (tree_function_def& cmd)
523 {
524 octave_value fcn = cmd.function ();
525
526 octave_function *f = fcn.function_value ();
527
528 if (f)
529 {
530 std::string nm = f->name ();
531
532 symbol_table::install_cmdline_function (nm, fcn);
533
534 // Make sure that any variable with the same name as the new
535 // function is cleared.
536
537 symbol_table::varref (nm) = octave_value ();
538 }
539 }
540
541 void
542 tree_evaluator::visit_identifier (tree_identifier&)
543 {
544 panic_impossible ();
545 }
546
547 void
548 tree_evaluator::visit_if_clause (tree_if_clause&)
549 {
550 panic_impossible ();
551 }
552
553 void
554 tree_evaluator::visit_if_command (tree_if_command& cmd)
555 {
556 if (debug_mode)
557 do_breakpoint (cmd.is_breakpoint ());
558
559 tree_if_command_list *lst = cmd.cmd_list ();
560
561 if (lst)
562 lst->accept (*this);
563 }
564
565 void
566 tree_evaluator::visit_if_command_list (tree_if_command_list& lst)
567 {
568 for (tree_if_command_list::iterator p = lst.begin (); p != lst.end (); p++)
569 {
570 tree_if_clause *tic = *p;
571
572 tree_expression *expr = tic->condition ();
573
574 if (debug_mode && ! tic->is_else_clause ())
575 do_breakpoint (tic->is_breakpoint ());
576
577 if (tic->is_else_clause () || expr->is_logically_true ("if"))
578 {
579 if (! error_state)
580 {
581 tree_statement_list *stmt_lst = tic->commands ();
582
583 if (stmt_lst)
584 stmt_lst->accept (*this);
585 }
586
587 break;
588 }
589 }
590 }
591
592 void
593 tree_evaluator::visit_index_expression (tree_index_expression&)
594 {
595 panic_impossible ();
596 }
597
598 void
599 tree_evaluator::visit_matrix (tree_matrix&)
600 {
601 panic_impossible ();
602 }
603
604 void
605 tree_evaluator::visit_cell (tree_cell&)
606 {
607 panic_impossible ();
608 }
609
610 void
611 tree_evaluator::visit_multi_assignment (tree_multi_assignment&)
612 {
613 panic_impossible ();
614 }
615
616 void
617 tree_evaluator::visit_no_op_command (tree_no_op_command& cmd)
618 {
619 if (debug_mode && cmd.is_end_of_fcn_or_script ())
620 do_breakpoint (cmd.is_breakpoint (), true);
621 }
622
623 void
624 tree_evaluator::visit_constant (tree_constant&)
625 {
626 panic_impossible ();
627 }
628
629 void
630 tree_evaluator::visit_fcn_handle (tree_fcn_handle&)
631 {
632 panic_impossible ();
633 }
634
635 void
636 tree_evaluator::visit_parameter_list (tree_parameter_list&)
637 {
638 panic_impossible ();
639 }
640
641 void
642 tree_evaluator::visit_postfix_expression (tree_postfix_expression&)
643 {
644 panic_impossible ();
645 }
646
647 void
648 tree_evaluator::visit_prefix_expression (tree_prefix_expression&)
649 {
650 panic_impossible ();
651 }
652
653 void
654 tree_evaluator::visit_return_command (tree_return_command& cmd)
655 {
656 if (! error_state)
657 {
658 if (debug_mode)
659 do_breakpoint (cmd.is_breakpoint ());
660
661 // Act like dbcont.
662
663 if (Vdebugging
664 && octave_call_stack::current_frame () == current_frame)
665 {
666 Vdebugging = false;
667
668 reset_debug_state ();
669 }
670 else if (statement_context == function || statement_context == script
671 || in_loop_command)
672 tree_return_command::returning = 1;
673 }
674 }
675
676 void
677 tree_evaluator::visit_return_list (tree_return_list&)
678 {
679 panic_impossible ();
680 }
681
682 void
683 tree_evaluator::visit_simple_assignment (tree_simple_assignment&)
684 {
685 panic_impossible ();
686 }
687
688 void
689 tree_evaluator::visit_statement (tree_statement& stmt)
690 {
691 tree_command *cmd = stmt.command ();
692 tree_expression *expr = stmt.expression ();
693
694 if (cmd || expr)
695 {
696 if (statement_context == function || statement_context == script)
697 {
698 // Skip commands issued at a debug> prompt to avoid disturbing
699 // the state of the program we are debugging.
700
701 if (! Vdebugging)
702 octave_call_stack::set_statement (&stmt);
703
704 // FIXME -- we need to distinguish functions from scripts to
705 // get this right.
706 if ((statement_context == script
707 && ((Vecho_executing_commands & ECHO_SCRIPTS)
708 || (Vecho_executing_commands & ECHO_FUNCTIONS)))
709 || (statement_context == function
710 && (Vecho_executing_commands & ECHO_FUNCTIONS)))
711 stmt.echo_code ();
712 }
713
714 try
715 {
716 if (cmd)
717 cmd->accept (*this);
718 else
719 {
720 if (debug_mode)
721 do_breakpoint (expr->is_breakpoint ());
722
723 if ((statement_context == function || statement_context == script)
724 && Vsilent_functions)
725 expr->set_print_flag (false);
726
727 // FIXME -- maybe all of this should be packaged in
728 // one virtual function that returns a flag saying whether
729 // or not the expression will take care of binding ans and
730 // printing the result.
731
732 // FIXME -- it seems that we should just have to
733 // call expr->rvalue1 () and that should take care of
734 // everything, binding ans as necessary?
735
736 bool do_bind_ans = false;
737
738 if (expr->is_identifier ())
739 {
740 tree_identifier *id = dynamic_cast<tree_identifier *> (expr);
741
742 do_bind_ans = (! id->is_variable ());
743 }
744 else
745 do_bind_ans = (! expr->is_assignment_expression ());
746
747 octave_value tmp_result = expr->rvalue1 (0);
748
749 if (do_bind_ans && ! (error_state || tmp_result.is_undefined ()))
750 bind_ans (tmp_result, expr->print_result ());
751
752 // if (tmp_result.is_defined ())
753 // result_values(0) = tmp_result;
754 }
755 }
756 catch (octave_execution_exception)
757 {
758 gripe_library_execution_error ();
759 }
760 }
761 }
762
763 void
764 tree_evaluator::visit_statement_list (tree_statement_list& lst)
765 {
766 static octave_value_list empty_list;
767
768 if (error_state)
769 return;
770
771 tree_statement_list::iterator p = lst.begin ();
772
773 if (p != lst.end ())
774 {
775 while (true)
776 {
777 tree_statement *elt = *p++;
778
779 if (elt)
780 {
781 octave_quit ();
782
783 elt->accept (*this);
784
785 if (error_state)
786 break;
787
788 if (tree_break_command::breaking
789 || tree_continue_command::continuing)
790 break;
791
792 if (tree_return_command::returning)
793 break;
794
795 if (p == lst.end ())
796 break;
797 else
798 {
799 // Clear preivous values before next statement is
800 // evaluated so that we aren't holding an extra
801 // reference to a value that may be used next. For
802 // example, in code like this:
803 //
804 // X = rand (N); ## refcount for X should be 1
805 // ## after this statement
806 //
807 // X(idx) = val; ## no extra copy of X should be
808 // ## needed, but we will be faked
809 // ## out if retval is not cleared
810 // ## between statements here
811
812 // result_values = empty_list;
813 }
814 }
815 else
816 error ("invalid statement found in statement list!");
817 }
818 }
819 }
820
821 void
822 tree_evaluator::visit_switch_case (tree_switch_case&)
823 {
824 panic_impossible ();
825 }
826
827 void
828 tree_evaluator::visit_switch_case_list (tree_switch_case_list&)
829 {
830 panic_impossible ();
831 }
832
833 void
834 tree_evaluator::visit_switch_command (tree_switch_command& cmd)
835 {
836 if (debug_mode)
837 do_breakpoint (cmd.is_breakpoint ());
838
839 tree_expression *expr = cmd.switch_value ();
840
841 if (expr)
842 {
843 octave_value val = expr->rvalue1 ();
844
845 tree_switch_case_list *lst = cmd.case_list ();
846
847 if (! error_state && lst)
848 {
849 for (tree_switch_case_list::iterator p = lst->begin ();
850 p != lst->end (); p++)
851 {
852 tree_switch_case *t = *p;
853
854 if (debug_mode && ! t->is_default_case ())
855 do_breakpoint (t->is_breakpoint ());
856
857 if (t->is_default_case () || t->label_matches (val))
858 {
859 if (error_state)
860 break;
861
862 tree_statement_list *stmt_lst = t->commands ();
863
864 if (stmt_lst)
865 stmt_lst->accept (*this);
866
867 break;
868 }
869 }
870 }
871 }
872 else
873 ::error ("missing value in switch command near line %d, column %d",
874 cmd.line (), cmd.column ());
875 }
876
877 void
878 tree_evaluator::visit_try_catch_command (tree_try_catch_command& cmd)
879 {
880 unwind_protect frame;
881
882 frame.protect_var (buffer_error_messages);
883 frame.protect_var (Vdebug_on_error);
884 frame.protect_var (Vdebug_on_warning);
885
886 buffer_error_messages++;
887 Vdebug_on_error = false;
888 Vdebug_on_warning = false;
889
890 tree_statement_list *catch_code = cmd.cleanup ();
891
892 // The catch code is *not* added to unwind_protect stack; it doesn't need
893 // to be run on interrupts.
894
895 tree_statement_list *try_code = cmd.body ();
896
897 if (try_code)
898 {
899 try_code->accept (*this);
900 // FIXME: should std::bad_alloc be handled here?
901 }
902
903 if (error_state)
904 {
905 error_state = 0;
906
907 if (catch_code)
908 {
909 // Set up for letting the user print any messages from errors that
910 // occurred in the body of the try_catch statement.
911
912 buffer_error_messages--;
913
914 if (catch_code)
915 catch_code->accept (*this);
916 }
917 }
918 }
919
920 void
921 tree_evaluator::do_unwind_protect_cleanup_code (tree_statement_list *list)
922 {
923 unwind_protect frame;
924
925 frame.protect_var (octave_interrupt_state);
926 octave_interrupt_state = 0;
927
928 // We want to run the cleanup code without error_state being set,
929 // but we need to restore its value, so that any errors encountered
930 // in the first part of the unwind_protect are not completely
931 // ignored.
932
933 frame.protect_var (error_state);
934 error_state = 0;
935
936 // We want to preserve the last statement indicator for possible
937 // backtracking.
938 frame.add_fcn (octave_call_stack::set_statement,
939 octave_call_stack::current_statement ());
940
941 // Similarly, if we have seen a return or break statement, allow all
942 // the cleanup code to run before returning or handling the break.
943 // We don't have to worry about continue statements because they can
944 // only occur in loops.
945
946 frame.protect_var (tree_return_command::returning);
947 tree_return_command::returning = 0;
948
949 frame.protect_var (tree_break_command::breaking);
950 tree_break_command::breaking = 0;
951
952 if (list)
953 list->accept (*this);
954
955 // The unwind_protects are popped off the stack in the reverse of
956 // the order they are pushed on.
957
958 // FIXME -- these statements say that if we see a break or
959 // return statement in the cleanup block, that we want to use the
960 // new value of the breaking or returning flag instead of restoring
961 // the previous value. Is that the right thing to do? I think so.
962 // Consider the case of
963 //
964 // function foo ()
965 // unwind_protect
966 // stderr << "1: this should always be executed\n";
967 // break;
968 // stderr << "1: this should never be executed\n";
969 // unwind_protect_cleanup
970 // stderr << "2: this should always be executed\n";
971 // return;
972 // stderr << "2: this should never be executed\n";
973 // end_unwind_protect
974 // endfunction
975 //
976 // If we reset the value of the breaking flag, both the returning
977 // flag and the breaking flag will be set, and we shouldn't have
978 // both. So, use the most recent one. If there is no return or
979 // break in the cleanup block, the values should be reset to
980 // whatever they were when the cleanup block was entered.
981
982 if (tree_break_command::breaking || tree_return_command::returning)
983 {
984 frame.discard_top (2);
985 }
986 else
987 {
988 frame.run_top (2);
989 }
990
991 // We don't want to ignore errors that occur in the cleanup code, so
992 // if an error is encountered there, leave error_state alone.
993 // Otherwise, set it back to what it was before.
994
995 if (error_state)
996 frame.discard_top (2);
997 else
998 frame.run_top (2);
999
1000 frame.run ();
1001 }
1002
1003 void
1004 tree_evaluator::visit_unwind_protect_command (tree_unwind_protect_command& cmd)
1005 {
1006 tree_statement_list *cleanup_code = cmd.cleanup ();
1007
1008 tree_statement_list *unwind_protect_code = cmd.body ();
1009
1010 if (unwind_protect_code)
1011 {
1012 try
1013 {
1014 unwind_protect_code->accept (*this);
1015 }
1016 catch (...)
1017 {
1018 // Run the cleanup code on exceptions, so that it is run even in case
1019 // of interrupt or out-of-memory.
1020 do_unwind_protect_cleanup_code (cleanup_code);
1021 // FIXME: should error_state be checked here?
1022 // We want to rethrow the exception, even if error_state is set, so
1023 // that interrupts continue.
1024 throw;
1025 }
1026
1027 do_unwind_protect_cleanup_code (cleanup_code);
1028 }
1029 }
1030
1031 void
1032 tree_evaluator::visit_while_command (tree_while_command& cmd)
1033 {
1034 if (error_state)
1035 return;
1036
1037 #if HAVE_LLVM
1038 if (jiter.execute (cmd))
1039 return;
1040 #endif
1041
1042 unwind_protect frame;
1043
1044 frame.protect_var (in_loop_command);
1045
1046 in_loop_command = true;
1047
1048 tree_expression *expr = cmd.condition ();
1049
1050 if (! expr)
1051 panic_impossible ();
1052
1053 for (;;)
1054 {
1055 if (debug_mode)
1056 do_breakpoint (cmd.is_breakpoint ());
1057
1058 if (expr->is_logically_true ("while"))
1059 {
1060 tree_statement_list *loop_body = cmd.body ();
1061
1062 if (loop_body)
1063 {
1064 loop_body->accept (*this);
1065
1066 if (error_state)
1067 return;
1068 }
1069
1070 if (quit_loop_now ())
1071 break;
1072 }
1073 else
1074 break;
1075 }
1076 }
1077
1078 void
1079 tree_evaluator::visit_do_until_command (tree_do_until_command& cmd)
1080 {
1081 if (error_state)
1082 return;
1083
1084 unwind_protect frame;
1085
1086 frame.protect_var (in_loop_command);
1087
1088 in_loop_command = true;
1089
1090 tree_expression *expr = cmd.condition ();
1091
1092 if (! expr)
1093 panic_impossible ();
1094
1095 for (;;)
1096 {
1097 tree_statement_list *loop_body = cmd.body ();
1098
1099 if (loop_body)
1100 {
1101 loop_body->accept (*this);
1102
1103 if (error_state)
1104 return;
1105 }
1106
1107 if (quit_loop_now ())
1108 break;
1109
1110 if (debug_mode)
1111 do_breakpoint (cmd.is_breakpoint ());
1112
1113 if (expr->is_logically_true ("do-until"))
1114 break;
1115 }
1116 }
1117
1118 void
1119 tree_evaluator::do_breakpoint (tree_statement& stmt) const
1120 {
1121 do_breakpoint (stmt.is_breakpoint (), stmt.is_end_of_fcn_or_script ());
1122 }
1123
1124 void
1125 tree_evaluator::do_breakpoint (bool is_breakpoint,
1126 bool is_end_of_fcn_or_script) const
1127 {
1128 bool break_on_this_statement = false;
1129
1130 // Don't decrement break flag unless we are in the same frame as we
1131 // were when we saw the "dbstep N" command.
1132
1133 if (dbstep_flag > 1)
1134 {
1135 if (octave_call_stack::current_frame () == current_frame)
1136 {
1137 // Don't allow dbstep N to step past end of current frame.
1138
1139 if (is_end_of_fcn_or_script)
1140 dbstep_flag = 1;
1141 else
1142 dbstep_flag--;
1143 }
1144 }
1145
1146 if (octave_debug_on_interrupt_state)
1147 {
1148 break_on_this_statement = true;
1149
1150 octave_debug_on_interrupt_state = false;
1151
1152 current_frame = octave_call_stack::current_frame ();
1153 }
1154 else if (is_breakpoint)
1155 {
1156 break_on_this_statement = true;
1157
1158 dbstep_flag = 0;
1159
1160 current_frame = octave_call_stack::current_frame ();
1161 }
1162 else if (dbstep_flag == 1)
1163 {
1164 if (octave_call_stack::current_frame () == current_frame)
1165 {
1166 // We get here if we are doing a "dbstep" or a "dbstep N"
1167 // and the count has reached 1 and we are in the current
1168 // debugging frame.
1169
1170 break_on_this_statement = true;
1171
1172 dbstep_flag = 0;
1173 }
1174 }
1175 else if (dbstep_flag == -1)
1176 {
1177 // We get here if we are doing a "dbstep in".
1178
1179 break_on_this_statement = true;
1180
1181 dbstep_flag = 0;
1182
1183 current_frame = octave_call_stack::current_frame ();
1184 }
1185 else if (dbstep_flag == -2)
1186 {
1187 // We get here if we are doing a "dbstep out".
1188
1189 if (is_end_of_fcn_or_script)
1190 dbstep_flag = -1;
1191 }
1192
1193 if (break_on_this_statement)
1194 do_keyboard ();
1195
1196 }
1197
1198 // ARGS is currently unused, but since the do_keyboard function in
1199 // input.cc accepts an argument list, we preserve it here so that the
1200 // interface won't have to change if we decide to use it in the future.
1201
1202 octave_value
1203 tree_evaluator::do_keyboard (const octave_value_list& args) const
1204 {
1205 return ::do_keyboard (args);
1206 }
1207
1208 DEFUN (max_recursion_depth, args, nargout,
1209 "-*- texinfo -*-\n\
1210 @deftypefn {Built-in Function} {@var{val} =} max_recursion_depth ()\n\
1211 @deftypefnx {Built-in Function} {@var{old_val} =} max_recursion_depth (@var{new_val})\n\
1212 @deftypefnx {Built-in Function} {} max_recursion_depth (@var{new_val}, \"local\")\n\
1213 Query or set the internal limit on the number of times a function may\n\
1214 be called recursively. If the limit is exceeded, an error message is\n\
1215 printed and control returns to the top level.\n\
1216 \n\
1217 When called from inside a function with the \"local\" option, the variable is\n\
1218 changed locally for the function and any subroutines it calls. The original\n\
1219 variable value is restored when exiting the function.\n\
1220 @end deftypefn")
1221 {
1222 return SET_INTERNAL_VARIABLE (max_recursion_depth);
1223 }
1224
1225 /*
1226 %!test
1227 %! orig_val = max_recursion_depth ();
1228 %! old_val = max_recursion_depth (2*orig_val);
1229 %! assert (orig_val, old_val);
1230 %! assert (max_recursion_depth (), 2*orig_val);
1231 %! max_recursion_depth (orig_val);
1232 %! assert (max_recursion_depth (), orig_val);
1233
1234 %!error (max_recursion_depth (1, 2))
1235 */
1236
1237 DEFUN (silent_functions, args, nargout,
1238 "-*- texinfo -*-\n\
1239 @deftypefn {Built-in Function} {@var{val} =} silent_functions ()\n\
1240 @deftypefnx {Built-in Function} {@var{old_val} =} silent_functions (@var{new_val})\n\
1241 @deftypefnx {Built-in Function} {} silent_functions (@var{new_val}, \"local\")\n\
1242 Query or set the internal variable that controls whether internal\n\
1243 output from a function is suppressed. If this option is disabled,\n\
1244 Octave will display the results produced by evaluating expressions\n\
1245 within a function body that are not terminated with a semicolon.\n\
1246 \n\
1247 When called from inside a function with the \"local\" option, the variable is\n\
1248 changed locally for the function and any subroutines it calls. The original\n\
1249 variable value is restored when exiting the function.\n\
1250 @end deftypefn")
1251 {
1252 return SET_INTERNAL_VARIABLE (silent_functions);
1253 }
1254
1255 /*
1256 %!test
1257 %! orig_val = silent_functions ();
1258 %! old_val = silent_functions (! orig_val);
1259 %! assert (orig_val, old_val);
1260 %! assert (silent_functions (), ! orig_val);
1261 %! silent_functions (orig_val);
1262 %! assert (silent_functions (), orig_val);
1263
1264 %!error (silent_functions (1, 2))
1265 */