Mercurial > octave

comparison src/pt-cmd.cc @ 2982:20f5cec4f11c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1997-05-16 03:29:26 by jwe]
author jwe
date Fri, 16 May 1997 03:30:14 +0000
parents a3556d2adec9
children 6e86256e9c54
comparison
equal deleted inserted replaced
2981:38365813950d 2982:20f5cec4f11c
26 26
27 #ifdef HAVE_CONFIG_H 27 #ifdef HAVE_CONFIG_H
28 #include <config.h> 28 #include <config.h>
29 #endif 29 #endif
30 30
31 #include <iostream.h>
32
33 // Nonzero means we're breaking out of a loop or function body.
34 int breaking = 0;
35
36 // Nonzero means we're jumping to the end of a loop.
37 int continuing = 0;
38
39 // Nonzero means we're returning from a function. Global because it
40 // is also needed in tree-expr.cc.
41 int returning = 0;
42
43 #include "error.h"
44 #include "gripes.h"
45 #include "oct-map.h"
46 #include "oct-lvalue.h"
47 #include "pt-cmd.h" 31 #include "pt-cmd.h"
48 #include "symtab.h"
49 #include "ov.h"
50 #include "pt-exp.h"
51 #include "pt-id.h"
52 #include "pt-indir.h"
53 #include "pt-misc.h"
54 #include "pt-walk.h" 32 #include "pt-walk.h"
55 #include "unwind-prot.h"
56 #include "variables.h"
57
58 // Decide if it's time to quit a for or while loop.
59 static inline bool
60 quit_loop_now (void)
61 {
62 // Maybe handle `continue N' someday...
63
64 if (continuing)
65 continuing--;
66
67 bool quit = (error_state || returning || breaking || continuing);
68
69 if (breaking)
70 breaking--;
71
72 return quit;
73 }
74
75 // Base class for declaration commands (global, static).
76
77 tree_decl_command::~tree_decl_command (void)
78 {
79 delete init_list;
80 }
81
82 void
83 tree_decl_command::accept (tree_walker& tw)
84 {
85 tw.visit_decl_command (*this);
86 }
87
88 // Global.
89
90 static void
91 do_global_init (tree_decl_elt& elt, bool skip_initializer)
92 {
93 tree_identifier *id = elt.ident ();
94
95 if (id)
96 {
97 id->link_to_global ();
98
99 tree_expression *expr = elt.expression ();
100
101 if (expr)
102 {
103 octave_value init_val = expr->rvalue ();
104
105 octave_lvalue ult = id->lvalue ();
106
107 ult.assign (octave_value::asn_eq, init_val);
108 }
109 }
110 }
111
112 void
113 tree_global_command::eval (void)
114 {
115 if (init_list)
116 {
117 init_list->eval (do_global_init, initialized);
118
119 initialized = true;
120 }
121
122 if (error_state > 0)
123 ::error ("evaluating global command near line %d, column %d",
124 line (), column ());
125 }
126
127 // Static.
128
129 static void
130 do_static_init (tree_decl_elt& elt, bool)
131 {
132 tree_identifier *id = elt.ident ();
133
134 if (id)
135 {
136 id->mark_as_static ();
137
138 tree_expression *expr = elt.expression ();
139
140 if (expr)
141 {
142 octave_value init_val = expr->rvalue ();
143
144 octave_lvalue ult = id->lvalue ();
145
146 ult.assign (octave_value::asn_eq, init_val);
147 }
148 }
149 }
150
151 void
152 tree_static_command::eval (void)
153 {
154 // Static variables only need to be marked and initialized once.
155
156 if (init_list && ! initialized)
157 {
158 init_list->eval (do_static_init, initialized);
159
160 initialized = true;
161
162 if (error_state > 0)
163 ::error ("evaluating static command near line %d, column %d",
164 line (), column ());
165 }
166 }
167
168 // While.
169
170 tree_while_command::~tree_while_command (void)
171 {
172 delete expr;
173 delete list;
174 }
175
176 void
177 tree_while_command::eval (void)
178 {
179 if (error_state)
180 return;
181
182 if (! expr)
183 panic_impossible ();
184
185 for (;;)
186 {
187 if (expr->is_logically_true ("while"))
188 {
189 if (list)
190 {
191 list->eval ();
192
193 if (error_state)
194 {
195 eval_error ();
196 return;
197 }
198 }
199
200 if (quit_loop_now ())
201 break;
202 }
203 else
204 break;
205 }
206 }
207
208 void
209 tree_while_command::eval_error (void)
210 {
211 if (error_state > 0)
212 ::error ("evaluating while command near line %d, column %d",
213 line (), column ());
214 }
215
216 void
217 tree_while_command::accept (tree_walker& tw)
218 {
219 tw.visit_while_command (*this);
220 }
221
222 // For.
223
224 tree_simple_for_command::~tree_simple_for_command (void)
225 {
226 delete expr;
227 delete list;
228 }
229
230 inline void
231 tree_simple_for_command::do_for_loop_once (octave_lvalue& ult,
232 const octave_value& rhs,
233 bool& quit)
234 {
235 quit = false;
236
237 ult.assign (octave_value::asn_eq, rhs);
238
239 if (! error_state)
240 {
241 if (list)
242 {
243 list->eval ();
244
245 if (error_state)
246 eval_error ();
247 }
248 }
249 else
250 eval_error ();
251
252 quit = quit_loop_now ();
253 }
254
255 #define DO_LOOP(arg) \
256 do \
257 { \
258 for (int i = 0; i < steps; i++) \
259 { \
260 octave_value val (arg); \
261 \
262 bool quit = false; \
263 \
264 do_for_loop_once (ult, val, quit); \
265 \
266 if (quit) \
267 break; \
268 } \
269 } \
270 while (0)
271
272 void
273 tree_simple_for_command::eval (void)
274 {
275 if (error_state)
276 return;
277
278 octave_value rhs = expr->rvalue ();
279
280 if (error_state || rhs.is_undefined ())
281 {
282 eval_error ();
283 return;
284 }
285
286 octave_lvalue ult = lhs->lvalue ();
287
288 if (error_state)
289 {
290 eval_error ();
291 return;
292 }
293
294 if (rhs.is_scalar_type ())
295 {
296 bool quit = false;
297
298 do_for_loop_once (ult, rhs, quit);
299 }
300 else if (rhs.is_matrix_type ())
301 {
302 Matrix m_tmp;
303 ComplexMatrix cm_tmp;
304
305 int nr;
306 int steps;
307
308 if (rhs.is_real_matrix ())
309 {
310 m_tmp = rhs.matrix_value ();
311 nr = m_tmp.rows ();
312 steps = m_tmp.columns ();
313 }
314 else
315 {
316 cm_tmp = rhs.complex_matrix_value ();
317 nr = cm_tmp.rows ();
318 steps = cm_tmp.columns ();
319 }
320
321 if (rhs.is_real_matrix ())
322 {
323 if (nr == 1)
324 DO_LOOP (m_tmp (0, i));
325 else
326 DO_LOOP (m_tmp.extract (0, i, nr-1, i));
327 }
328 else
329 {
330 if (nr == 1)
331 DO_LOOP (cm_tmp (0, i));
332 else
333 DO_LOOP (cm_tmp.extract (0, i, nr-1, i));
334 }
335 }
336 else if (rhs.is_string ())
337 {
338 gripe_string_invalid ();
339 }
340 else if (rhs.is_range ())
341 {
342 Range rng = rhs.range_value ();
343
344 int steps = rng.nelem ();
345 double b = rng.base ();
346 double increment = rng.inc ();
347
348 for (int i = 0; i < steps; i++)
349 {
350 double tmp_val = b + i * increment;
351
352 octave_value val (tmp_val);
353
354 bool quit = false;
355
356 do_for_loop_once (ult, val, quit);
357
358 if (quit)
359 break;
360 }
361 }
362 else if (rhs.is_map ())
363 {
364 Octave_map tmp_val (rhs.map_value ());
365
366 for (Pix p = tmp_val.first (); p != 0; tmp_val.next (p))
367 {
368 octave_value val = tmp_val.contents (p);
369
370 bool quit = false;
371
372 do_for_loop_once (ult, val, quit);
373
374 if (quit)
375 break;
376 }
377 }
378 else
379 {
380 ::error ("invalid type in for loop expression near line %d, column %d",
381 line (), column ());
382 }
383 }
384
385 void
386 tree_simple_for_command::eval_error (void)
387 {
388 if (error_state > 0)
389 ::error ("evaluating for command near line %d, column %d",
390 line (), column ());
391 }
392
393 void
394 tree_simple_for_command::accept (tree_walker& tw)
395 {
396 tw.visit_simple_for_command (*this);
397 }
398
399 tree_complex_for_command::~tree_complex_for_command (void)
400 {
401 delete expr;
402 delete list;
403 }
404
405 void
406 tree_complex_for_command::do_for_loop_once (octave_lvalue &val_ref,
407 octave_lvalue &key_ref,
408 const octave_value& val,
409 const octave_value& key,
410 bool& quit)
411 {
412 quit = false;
413
414 val_ref.assign (octave_value::asn_eq, val);
415 key_ref.assign (octave_value::asn_eq, key);
416
417 if (! error_state)
418 {
419 if (list)
420 {
421 list->eval ();
422
423 if (error_state)
424 eval_error ();
425 }
426 }
427 else
428 eval_error ();
429
430 quit = quit_loop_now ();
431 }
432
433 void
434 tree_complex_for_command::eval (void)
435 {
436 if (error_state)
437 return;
438
439 octave_value rhs = expr->rvalue ();
440
441 if (error_state || rhs.is_undefined ())
442 {
443 eval_error ();
444 return;
445 }
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 Pix p = lhs->first ();
454 tree_expression *elt = lhs->operator () (p);
455 octave_lvalue val_ref = elt->lvalue ();
456
457 lhs->next (p);
458 elt = lhs->operator () (p);
459 octave_lvalue key_ref = elt->lvalue ();
460
461 Octave_map tmp_val (rhs.map_value ());
462
463 for (p = tmp_val.first (); p != 0; tmp_val.next (p))
464 {
465 octave_value key = tmp_val.key (p);
466 octave_value val = tmp_val.contents (p);
467
468 bool quit = false;
469
470 do_for_loop_once (key_ref, val_ref, key, val, quit);
471
472 if (quit)
473 break;
474 }
475 }
476 else
477 error ("in statement `for [X, Y] = VAL', VAL must be a structure");
478 }
479
480 void
481 tree_complex_for_command::eval_error (void)
482 {
483 if (error_state > 0)
484 ::error ("evaluating for command near line %d, column %d",
485 line (), column ());
486 }
487
488 void
489 tree_complex_for_command::accept (tree_walker& tw)
490 {
491 tw.visit_complex_for_command (*this);
492 }
493
494 // If.
495
496 tree_if_command::~tree_if_command (void)
497 {
498 delete list;
499 }
500
501 void
502 tree_if_command::eval (void)
503 {
504 if (list)
505 list->eval ();
506
507 if (error_state > 0)
508 ::error ("evaluating if command near line %d, column %d",
509 line (), column ());
510 }
511
512 void
513 tree_if_command::accept (tree_walker& tw)
514 {
515 tw.visit_if_command (*this);
516 }
517
518 // Switch.
519
520 tree_switch_command::~tree_switch_command (void)
521 {
522 delete expr;
523 delete list;
524 }
525
526 void
527 tree_switch_command::eval (void)
528 {
529 if (expr)
530 {
531 octave_value val = expr->rvalue ();
532
533 if (! error_state)
534 {
535 if (list)
536 list->eval (val);
537
538 if (error_state)
539 eval_error ();
540 }
541 else
542 eval_error ();
543 }
544 else
545 ::error ("missing value in switch command near line %d, column %d",
546 line (), column ());
547 }
548
549 void
550 tree_switch_command::eval_error (void)
551 {
552 ::error ("evaluating switch command near line %d, column %d",
553 line (), column ());
554 }
555
556 void
557 tree_switch_command::accept (tree_walker& tw)
558 {
559 tw.visit_switch_command (*this);
560 }
561
562 // Simple exception handling.
563
564 tree_try_catch_command::~tree_try_catch_command (void)
565 {
566 delete try_code;
567 delete catch_code;
568 }
569
570 static void
571 do_catch_code (void *ptr)
572 {
573 tree_statement_list *list = static_cast<tree_statement_list *> (ptr);
574
575 // Set up for letting the user print any messages from errors that
576 // occurred in the body of the try_catch statement.
577
578 buffer_error_messages = 0;
579 bind_global_error_variable ();
580 add_unwind_protect (clear_global_error_variable, 0);
581
582 // Similarly, if we have seen a return or break statement, allow all
583 // the catch code to run before returning or handling the break.
584 // We don't have to worry about continue statements because they can
585 // only occur in loops.
586
587 unwind_protect_int (returning);
588 returning = 0;
589
590 unwind_protect_int (breaking);
591 breaking = 0;
592
593 if (list)
594 list->eval ();
595
596 // This is the one for breaking. (The unwind_protects are popped
597 // off the stack in the reverse of the order they are pushed on).
598
599 // XXX FIXME XXX -- inside a try-catch, should break work like
600 // a return, or just jump to the end of the try_catch block?
601 // The following code makes it just jump to the end of the block.
602
603 run_unwind_protect ();
604 if (breaking)
605 breaking--;
606
607 // This is the one for returning.
608
609 if (returning)
610 discard_unwind_protect ();
611 else
612 run_unwind_protect ();
613
614 run_unwind_protect ();
615 }
616
617 void
618 tree_try_catch_command::eval (void)
619 {
620 begin_unwind_frame ("tree_try_catch::eval");
621
622 add_unwind_protect (do_catch_code, catch_code);
623
624 if (catch_code)
625 {
626 unwind_protect_int (buffer_error_messages);
627 buffer_error_messages = 1;
628 }
629
630 if (try_code)
631 try_code->eval ();
632
633 if (catch_code && error_state)
634 {
635 error_state = 0;
636 run_unwind_frame ("tree_try_catch::eval");
637 }
638 else
639 {
640 error_state = 0;
641 discard_unwind_frame ("tree_try_catch::eval");
642 }
643 }
644
645 void
646 tree_try_catch_command::accept (tree_walker& tw)
647 {
648 tw.visit_try_catch_command (*this);
649 }
650
651 // Simple exception handling.
652
653 tree_unwind_protect_command::~tree_unwind_protect_command (void)
654 {
655 delete unwind_protect_code;
656 delete cleanup_code;
657 }
658
659 static void
660 do_unwind_protect_cleanup_code (void *ptr)
661 {
662 tree_statement_list *list = static_cast<tree_statement_list *> (ptr);
663
664 // We want to run the cleanup code without error_state being set,
665 // but we need to restore its value, so that any errors encountered
666 // in the first part of the unwind_protect are not completely
667 // ignored.
668
669 unwind_protect_int (error_state);
670 error_state = 0;
671
672 // Similarly, if we have seen a return or break statement, allow all
673 // the cleanup code to run before returning or handling the break.
674 // We don't have to worry about continue statements because they can
675 // only occur in loops.
676
677 unwind_protect_int (returning);
678 returning = 0;
679
680 unwind_protect_int (breaking);
681 breaking = 0;
682
683 if (list)
684 list->eval ();
685
686 // This is the one for breaking. (The unwind_protects are popped
687 // off the stack in the reverse of the order they are pushed on).
688
689 // XXX FIXME XXX -- inside an unwind_protect, should break work like
690 // a return, or just jump to the end of the unwind_protect block?
691 // The following code makes it just jump to the end of the block.
692
693 run_unwind_protect ();
694 if (breaking)
695 breaking--;
696
697 // This is the one for returning.
698
699 if (returning)
700 discard_unwind_protect ();
701 else
702 run_unwind_protect ();
703
704 // We don't want to ignore errors that occur in the cleanup code, so
705 // if an error is encountered there, leave error_state alone.
706 // Otherwise, set it back to what it was before.
707
708 if (error_state)
709 discard_unwind_protect ();
710 else
711 run_unwind_protect ();
712 }
713
714 void
715 tree_unwind_protect_command::eval (void)
716 {
717 add_unwind_protect (do_unwind_protect_cleanup_code, cleanup_code);
718
719 if (unwind_protect_code)
720 unwind_protect_code->eval ();
721
722 run_unwind_protect ();
723 }
724
725 void
726 tree_unwind_protect_command::accept (tree_walker& tw)
727 {
728 tw.visit_unwind_protect_command (*this);
729 }
730 33
731 // No-op. 34 // No-op.
732 35
733 void 36 void
734 tree_no_op_command::accept (tree_walker& tw) 37 tree_no_op_command::accept (tree_walker& tw)
735 { 38 {
736 tw.visit_no_op_command (*this); 39 tw.visit_no_op_command (*this);
737 } 40 }
738 41
739 // Break.
740
741 void
742 tree_break_command::eval (void)
743 {
744 if (! error_state)
745 breaking = 1;
746 }
747
748 void
749 tree_break_command::accept (tree_walker& tw)
750 {
751 tw.visit_break_command (*this);
752 }
753
754 // Continue.
755
756 void
757 tree_continue_command::eval (void)
758 {
759 if (! error_state)
760 continuing = 1;
761 }
762
763 void
764 tree_continue_command::accept (tree_walker& tw)
765 {
766 tw.visit_continue_command (*this);
767 }
768
769 // Return.
770
771 void
772 tree_return_command::eval (void)
773 {
774 if (! error_state)
775 returning = 1;
776 }
777
778 void
779 tree_return_command::accept (tree_walker& tw)
780 {
781 tw.visit_return_command (*this);
782 }
783
784 /* 42 /*
785 ;;; Local Variables: *** 43 ;;; Local Variables: ***
786 ;;; mode: C++ *** 44 ;;; mode: C++ ***
787 ;;; End: *** 45 ;;; End: ***
788 */ 46 */