Mercurial > octave-libgccjit

comparison src/pt-eval.cc @ 8658:73c4516fae10

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