Mercurial > hg > octave-lyh
annotate src/pt-loop.cc @ 7469:360b4f7684fd
fix for loop iteration limit bug with ranges
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Tue, 12 Feb 2008 03:15:49 -0500 |
parents | 745a8299c2b5 |
children | 71f068b22fcc |
rev | line source |
---|---|
2982 | 1 /* |
2 | |
7017 | 3 Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005, |
4 2006, 2007 John W. Eaton | |
2982 | 5 |
6 This file is part of Octave. | |
7 | |
8 Octave is free software; you can redistribute it and/or modify it | |
9 under the terms of the GNU General Public License as published by the | |
7016 | 10 Free Software Foundation; either version 3 of the License, or (at your |
11 option) any later version. | |
2982 | 12 |
13 Octave is distributed in the hope that it will be useful, but WITHOUT | |
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
7016 | 19 along with Octave; see the file COPYING. If not, see |
20 <http://www.gnu.org/licenses/>. | |
2982 | 21 |
22 */ | |
23 | |
24 #ifdef HAVE_CONFIG_H | |
25 #include <config.h> | |
26 #endif | |
27 | |
4153 | 28 #include "quit.h" |
29 | |
2982 | 30 #include "error.h" |
31 #include "gripes.h" | |
32 #include "oct-map.h" | |
33 #include "oct-lvalue.h" | |
34 #include "ov.h" | |
35 #include "pt-arg-list.h" | |
3770 | 36 #include "pt-bp.h" |
2982 | 37 #include "pt-cmd.h" |
38 #include "pt-exp.h" | |
2985 | 39 #include "pt-jump.h" |
2982 | 40 #include "pt-loop.h" |
41 #include "pt-stmt.h" | |
42 #include "pt-walk.h" | |
3877 | 43 #include "unwind-prot.h" |
44 | |
45 // TRUE means we are evaluating some kind of looping construct. | |
46 bool evaluating_looping_command = false; | |
2982 | 47 |
48 // Decide if it's time to quit a for or while loop. | |
49 static inline bool | |
50 quit_loop_now (void) | |
51 { | |
4153 | 52 OCTAVE_QUIT; |
53 | |
2982 | 54 // Maybe handle `continue N' someday... |
55 | |
4207 | 56 if (tree_continue_command::continuing) |
57 tree_continue_command::continuing--; | |
2982 | 58 |
2985 | 59 bool quit = (error_state |
4207 | 60 || tree_return_command::returning |
61 || tree_break_command::breaking | |
62 || tree_continue_command::continuing); | |
2982 | 63 |
4207 | 64 if (tree_break_command::breaking) |
65 tree_break_command::breaking--; | |
2982 | 66 |
67 return quit; | |
68 } | |
69 | |
70 // While. | |
71 | |
72 tree_while_command::~tree_while_command (void) | |
73 { | |
74 delete expr; | |
75 delete list; | |
3665 | 76 delete lead_comm; |
77 delete trail_comm; | |
2982 | 78 } |
79 | |
80 void | |
81 tree_while_command::eval (void) | |
82 { | |
83 if (error_state) | |
84 return; | |
85 | |
3877 | 86 unwind_protect::begin_frame ("while_command::eval"); |
87 | |
88 unwind_protect_bool (evaluating_looping_command); | |
89 | |
90 evaluating_looping_command = true; | |
91 | |
2982 | 92 if (! expr) |
93 panic_impossible (); | |
94 | |
95 for (;;) | |
96 { | |
97 if (expr->is_logically_true ("while")) | |
98 { | |
99 if (list) | |
100 { | |
101 list->eval (); | |
102 | |
103 if (error_state) | |
104 { | |
105 eval_error (); | |
3877 | 106 goto cleanup; |
2982 | 107 } |
108 } | |
109 | |
110 if (quit_loop_now ()) | |
111 break; | |
112 } | |
113 else | |
114 break; | |
115 } | |
3877 | 116 |
117 cleanup: | |
118 unwind_protect::run_frame ("while_command::eval"); | |
2982 | 119 } |
120 | |
121 void | |
122 tree_while_command::eval_error (void) | |
123 { | |
3965 | 124 ::error ("evaluating while command near line %d, column %d", |
125 line (), column ()); | |
2982 | 126 } |
127 | |
5861 | 128 tree_command * |
7336 | 129 tree_while_command::dup (symbol_table::scope_id scope) |
5861 | 130 { |
7336 | 131 return new tree_while_command (expr ? expr->dup (scope) : 0, |
132 list ? list->dup (scope) : 0, | |
5861 | 133 lead_comm ? lead_comm->dup () : 0, |
134 trail_comm ? trail_comm->dup (): 0, | |
135 line (), column ()); | |
136 } | |
137 | |
2982 | 138 void |
139 tree_while_command::accept (tree_walker& tw) | |
140 { | |
141 tw.visit_while_command (*this); | |
142 } | |
143 | |
3484 | 144 // Do-Until |
145 | |
146 void | |
147 tree_do_until_command::eval (void) | |
148 { | |
149 if (error_state) | |
150 return; | |
151 | |
3877 | 152 unwind_protect::begin_frame ("do_until_command::eval"); |
153 | |
154 unwind_protect_bool (evaluating_looping_command); | |
155 | |
156 evaluating_looping_command = true; | |
157 | |
3484 | 158 if (! expr) |
159 panic_impossible (); | |
160 | |
161 for (;;) | |
162 { | |
3770 | 163 MAYBE_DO_BREAKPOINT; |
164 | |
3484 | 165 if (list) |
166 { | |
167 list->eval (); | |
168 | |
169 if (error_state) | |
170 { | |
171 eval_error (); | |
3877 | 172 goto cleanup; |
3484 | 173 } |
174 } | |
175 | |
176 if (quit_loop_now () || expr->is_logically_true ("do-until")) | |
177 break; | |
178 } | |
3877 | 179 |
180 cleanup: | |
181 unwind_protect::run_frame ("do_until_command::eval"); | |
3484 | 182 } |
183 | |
184 void | |
185 tree_do_until_command::eval_error (void) | |
186 { | |
3965 | 187 ::error ("evaluating do-until command near line %d, column %d", |
188 line (), column ()); | |
3484 | 189 } |
190 | |
5861 | 191 tree_command * |
7336 | 192 tree_do_until_command::dup (symbol_table::scope_id scope) |
5861 | 193 { |
7336 | 194 return new tree_do_until_command (expr ? expr->dup (scope) : 0, |
195 list ? list->dup (scope) : 0, | |
5861 | 196 lead_comm ? lead_comm->dup () : 0, |
197 trail_comm ? trail_comm->dup (): 0, | |
198 line (), column ()); | |
199 } | |
200 | |
3484 | 201 void |
202 tree_do_until_command::accept (tree_walker& tw) | |
203 { | |
204 tw.visit_do_until_command (*this); | |
205 } | |
206 | |
2982 | 207 // For. |
208 | |
209 tree_simple_for_command::~tree_simple_for_command (void) | |
210 { | |
211 delete expr; | |
212 delete list; | |
3665 | 213 delete lead_comm; |
214 delete trail_comm; | |
2982 | 215 } |
216 | |
217 inline void | |
218 tree_simple_for_command::do_for_loop_once (octave_lvalue& ult, | |
219 const octave_value& rhs, | |
220 bool& quit) | |
221 { | |
3538 | 222 ult.assign (octave_value::op_asn_eq, rhs); |
2982 | 223 |
224 if (! error_state) | |
225 { | |
226 if (list) | |
227 { | |
228 list->eval (); | |
229 | |
230 if (error_state) | |
231 eval_error (); | |
232 } | |
233 } | |
234 else | |
235 eval_error (); | |
236 | |
237 quit = quit_loop_now (); | |
238 } | |
239 | |
6602 | 240 #define DO_ND_LOOP(MTYPE, TYPE, CONV, ARG) \ |
2982 | 241 do \ |
242 { \ | |
6602 | 243 dim_vector dv = ARG.dims (); \ |
2982 | 244 \ |
6602 | 245 bool quit = false; \ |
246 \ | |
247 TYPE *atmp = ARG.fortran_vec (); \ | |
248 \ | |
5570 | 249 octave_idx_type steps = dv(1); \ |
4911 | 250 \ |
6602 | 251 octave_idx_type nrows = dv(0); \ |
252 \ | |
253 int ndims = dv.length (); \ | |
254 if (ndims > 2) \ | |
255 { \ | |
256 for (int i = 2; i < ndims; i++) \ | |
257 steps *= dv(i); \ | |
258 dv(1) = steps; \ | |
259 dv.resize (2); \ | |
260 } \ | |
4911 | 261 \ |
6602 | 262 if (steps > 0) \ |
263 { \ | |
264 if (nrows == 0) \ | |
265 { \ | |
6665 | 266 MTYPE tarray (dim_vector (0, 1)); \ |
267 \ | |
268 octave_value val (tarray); \ | |
6602 | 269 \ |
270 for (octave_idx_type i = 0; i < steps; i++) \ | |
271 { \ | |
272 MAYBE_DO_BREAKPOINT; \ | |
5570 | 273 \ |
6602 | 274 do_for_loop_once (ult, val, quit); \ |
5570 | 275 \ |
6602 | 276 if (quit) \ |
277 break; \ | |
278 } \ | |
279 } \ | |
280 else if (nrows == 1) \ | |
281 { \ | |
282 for (octave_idx_type i = 0; i < steps; i++) \ | |
283 { \ | |
284 MAYBE_DO_BREAKPOINT; \ | |
5570 | 285 \ |
6602 | 286 octave_value val (CONV (*atmp++)); \ |
287 \ | |
288 do_for_loop_once (ult, val, quit); \ | |
5570 | 289 \ |
6602 | 290 if (quit) \ |
291 break; \ | |
292 } \ | |
293 } \ | |
294 else \ | |
295 { \ | |
296 if (ndims > 2) \ | |
297 ARG = ARG.reshape (dv); \ | |
4911 | 298 \ |
6602 | 299 MTYPE tmp (dim_vector (nrows, 1)); \ |
300 \ | |
301 TYPE *ftmp = tmp.fortran_vec (); \ | |
4911 | 302 \ |
6602 | 303 for (octave_idx_type i = 0; i < steps; i++) \ |
304 { \ | |
305 MAYBE_DO_BREAKPOINT; \ | |
306 \ | |
307 for (int j = 0; j < nrows; j++) \ | |
308 ftmp[j] = *atmp++; \ | |
309 \ | |
310 octave_value val (tmp); \ | |
4911 | 311 \ |
6602 | 312 do_for_loop_once (ult, val, quit); \ |
313 quit = (i == steps - 1 ? true : quit); \ | |
4911 | 314 \ |
6602 | 315 if (quit) \ |
316 break; \ | |
317 } \ | |
318 } \ | |
319 } \ | |
4911 | 320 } \ |
321 while (0) | |
322 | |
2982 | 323 void |
324 tree_simple_for_command::eval (void) | |
325 { | |
326 if (error_state) | |
327 return; | |
328 | |
3877 | 329 unwind_protect::begin_frame ("simple_for_command::eval"); |
330 | |
331 unwind_protect_bool (evaluating_looping_command); | |
332 | |
333 evaluating_looping_command = true; | |
334 | |
2982 | 335 octave_value rhs = expr->rvalue (); |
336 | |
337 if (error_state || rhs.is_undefined ()) | |
338 { | |
339 eval_error (); | |
3877 | 340 goto cleanup; |
2982 | 341 } |
342 | |
3877 | 343 { |
344 octave_lvalue ult = lhs->lvalue (); | |
3180 | 345 |
3877 | 346 if (error_state) |
347 { | |
348 eval_error (); | |
349 goto cleanup; | |
350 } | |
351 | |
352 if (rhs.is_range ()) | |
353 { | |
354 Range rng = rhs.range_value (); | |
3180 | 355 |
5275 | 356 octave_idx_type steps = rng.nelem (); |
3877 | 357 double b = rng.base (); |
358 double increment = rng.inc (); | |
6602 | 359 bool quit = false; |
3770 | 360 |
7469
360b4f7684fd
fix for loop iteration limit bug with ranges
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
361 for (octave_idx_type i = 0; i < steps; i++) |
3877 | 362 { |
363 MAYBE_DO_BREAKPOINT; | |
3180 | 364 |
7469
360b4f7684fd
fix for loop iteration limit bug with ranges
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
365 // Use multiplication here rather than declaring a |
360b4f7684fd
fix for loop iteration limit bug with ranges
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
366 // temporary variable outside the loop and using |
360b4f7684fd
fix for loop iteration limit bug with ranges
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
367 // |
360b4f7684fd
fix for loop iteration limit bug with ranges
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
368 // tmp_val += increment |
360b4f7684fd
fix for loop iteration limit bug with ranges
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
369 // |
360b4f7684fd
fix for loop iteration limit bug with ranges
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
370 // to avoid problems with limited precision. Also, this |
360b4f7684fd
fix for loop iteration limit bug with ranges
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
371 // is consistent with the way Range::matrix_value is |
360b4f7684fd
fix for loop iteration limit bug with ranges
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
372 // implemented. |
360b4f7684fd
fix for loop iteration limit bug with ranges
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
373 |
360b4f7684fd
fix for loop iteration limit bug with ranges
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
374 octave_value val (b + i * increment); |
3180 | 375 |
3877 | 376 do_for_loop_once (ult, val, quit); |
3180 | 377 |
3877 | 378 if (quit) |
379 break; | |
380 } | |
381 } | |
382 else if (rhs.is_scalar_type ()) | |
383 { | |
384 bool quit = false; | |
385 | |
386 MAYBE_DO_BREAKPOINT; | |
2982 | 387 |
3877 | 388 do_for_loop_once (ult, rhs, quit); |
389 } | |
390 else if (rhs.is_string ()) | |
391 { | |
392 charMatrix chm_tmp = rhs.char_matrix_value (); | |
5275 | 393 octave_idx_type nr = chm_tmp.rows (); |
394 octave_idx_type steps = chm_tmp.columns (); | |
6602 | 395 bool quit = false; |
3215 | 396 |
3877 | 397 if (error_state) |
398 goto cleanup; | |
3215 | 399 |
3877 | 400 if (nr == 1) |
6602 | 401 { |
402 for (octave_idx_type i = 0; i < steps; i++) | |
403 { | |
404 MAYBE_DO_BREAKPOINT; | |
405 | |
406 octave_value val (chm_tmp.xelem (0, i)); | |
407 | |
408 do_for_loop_once (ult, val, quit); | |
409 | |
410 if (quit) | |
411 break; | |
412 } | |
413 } | |
3877 | 414 else |
415 { | |
5275 | 416 for (octave_idx_type i = 0; i < steps; i++) |
3877 | 417 { |
418 MAYBE_DO_BREAKPOINT; | |
3770 | 419 |
3877 | 420 octave_value val (chm_tmp.extract (0, i, nr-1, i), true); |
3215 | 421 |
3877 | 422 do_for_loop_once (ult, val, quit); |
3215 | 423 |
3877 | 424 if (quit) |
425 break; | |
426 } | |
427 } | |
428 } | |
429 else if (rhs.is_matrix_type ()) | |
430 { | |
3998 | 431 if (rhs.is_real_type ()) |
3877 | 432 { |
6602 | 433 NDArray m_tmp = rhs.array_value (); |
434 | |
435 if (error_state) | |
436 goto cleanup; | |
437 | |
438 DO_ND_LOOP (NDArray, double, , m_tmp); | |
3877 | 439 } |
440 else | |
441 { | |
6602 | 442 ComplexNDArray cm_tmp = rhs.complex_array_value (); |
5570 | 443 |
6602 | 444 if (error_state) |
445 goto cleanup; | |
5570 | 446 |
6602 | 447 DO_ND_LOOP (ComplexNDArray, Complex, , cm_tmp); |
5246 | 448 } |
3877 | 449 } |
450 else if (rhs.is_map ()) | |
451 { | |
452 Octave_map tmp_val (rhs.map_value ()); | |
2982 | 453 |
6602 | 454 bool quit = false; |
455 | |
4219 | 456 for (Octave_map::iterator p = tmp_val.begin (); |
457 p != tmp_val.end (); | |
458 p++) | |
3877 | 459 { |
460 MAYBE_DO_BREAKPOINT; | |
3770 | 461 |
4513 | 462 Cell val_lst = tmp_val.contents (p); |
4121 | 463 |
464 octave_value val | |
465 = (val_lst.length () == 1) ? val_lst(0) : octave_value (val_lst); | |
2982 | 466 |
3877 | 467 do_for_loop_once (ult, val, quit); |
2982 | 468 |
3877 | 469 if (quit) |
470 break; | |
471 } | |
472 } | |
4911 | 473 else if (rhs.is_cell ()) |
474 { | |
475 Cell c_tmp = rhs.cell_value (); | |
5248 | 476 |
6602 | 477 DO_ND_LOOP (Cell, octave_value, Cell, c_tmp); |
4911 | 478 } |
3877 | 479 else |
480 { | |
481 ::error ("invalid type in for loop expression near line %d, column %d", | |
482 line (), column ()); | |
483 } | |
484 } | |
485 | |
486 cleanup: | |
487 unwind_protect::run_frame ("simple_for_command::eval"); | |
2982 | 488 } |
489 | |
490 void | |
491 tree_simple_for_command::eval_error (void) | |
492 { | |
3965 | 493 ::error ("evaluating for command near line %d, column %d", |
494 line (), column ()); | |
2982 | 495 } |
496 | |
5861 | 497 tree_command * |
7336 | 498 tree_simple_for_command::dup (symbol_table::scope_id scope) |
5861 | 499 { |
7336 | 500 return new tree_simple_for_command (lhs ? lhs->dup (scope) : 0, |
501 expr ? expr->dup (scope) : 0, | |
502 list ? list->dup (scope) : 0, | |
5861 | 503 lead_comm ? lead_comm->dup () : 0, |
504 trail_comm ? trail_comm->dup () : 0, | |
505 line (), column ()); | |
506 } | |
507 | |
2982 | 508 void |
509 tree_simple_for_command::accept (tree_walker& tw) | |
510 { | |
511 tw.visit_simple_for_command (*this); | |
512 } | |
513 | |
514 tree_complex_for_command::~tree_complex_for_command (void) | |
515 { | |
516 delete expr; | |
517 delete list; | |
3665 | 518 delete lead_comm; |
519 delete trail_comm; | |
2982 | 520 } |
521 | |
522 void | |
523 tree_complex_for_command::do_for_loop_once (octave_lvalue &val_ref, | |
524 octave_lvalue &key_ref, | |
525 const octave_value& val, | |
526 const octave_value& key, | |
527 bool& quit) | |
528 { | |
529 quit = false; | |
530 | |
3538 | 531 val_ref.assign (octave_value::op_asn_eq, val); |
532 key_ref.assign (octave_value::op_asn_eq, key); | |
2982 | 533 |
534 if (! error_state) | |
535 { | |
536 if (list) | |
537 { | |
538 list->eval (); | |
539 | |
540 if (error_state) | |
541 eval_error (); | |
542 } | |
543 } | |
544 else | |
545 eval_error (); | |
546 | |
547 quit = quit_loop_now (); | |
548 } | |
549 | |
550 void | |
551 tree_complex_for_command::eval (void) | |
552 { | |
553 if (error_state) | |
554 return; | |
555 | |
3877 | 556 unwind_protect::begin_frame ("complex_for_command::eval"); |
557 | |
558 unwind_protect_bool (evaluating_looping_command); | |
559 | |
560 evaluating_looping_command = true; | |
561 | |
2982 | 562 octave_value rhs = expr->rvalue (); |
563 | |
564 if (error_state || rhs.is_undefined ()) | |
565 { | |
566 eval_error (); | |
3877 | 567 goto cleanup; |
2982 | 568 } |
569 | |
570 if (rhs.is_map ()) | |
571 { | |
572 // Cycle through structure elements. First element of id_list | |
573 // is set to value and the second is set to the name of the | |
574 // structure element. | |
575 | |
4219 | 576 tree_argument_list::iterator p = lhs->begin (); |
577 tree_expression *elt = *p++; | |
2982 | 578 octave_lvalue val_ref = elt->lvalue (); |
4219 | 579 elt = *p; |
2982 | 580 octave_lvalue key_ref = elt->lvalue (); |
581 | |
582 Octave_map tmp_val (rhs.map_value ()); | |
583 | |
4300 | 584 for (Octave_map::iterator q = tmp_val.begin (); q != tmp_val.end (); q++) |
2982 | 585 { |
4219 | 586 octave_value key = tmp_val.key (q); |
4121 | 587 |
4513 | 588 Cell val_lst = tmp_val.contents (q); |
4121 | 589 |
5275 | 590 octave_idx_type n = tmp_val.numel (); |
4121 | 591 |
592 octave_value val = (n == 1) ? val_lst(0) : octave_value (val_lst); | |
2982 | 593 |
3770 | 594 MAYBE_DO_BREAKPOINT; |
595 | |
2982 | 596 bool quit = false; |
597 | |
598 do_for_loop_once (key_ref, val_ref, key, val, quit); | |
599 | |
600 if (quit) | |
601 break; | |
602 } | |
603 } | |
604 else | |
605 error ("in statement `for [X, Y] = VAL', VAL must be a structure"); | |
3877 | 606 |
607 cleanup: | |
608 unwind_protect::run_frame ("complex_for_command::eval"); | |
2982 | 609 } |
610 | |
611 void | |
612 tree_complex_for_command::eval_error (void) | |
613 { | |
3965 | 614 ::error ("evaluating for command near line %d, column %d", |
615 line (), column ()); | |
2982 | 616 } |
617 | |
5861 | 618 tree_command * |
7336 | 619 tree_complex_for_command::dup (symbol_table::scope_id scope) |
5861 | 620 { |
7336 | 621 return new tree_complex_for_command (lhs ? lhs->dup (scope) : 0, |
622 expr ? expr->dup (scope) : 0, | |
623 list ? list->dup (scope) : 0, | |
5861 | 624 lead_comm ? lead_comm->dup () : 0, |
625 trail_comm ? trail_comm->dup () : 0, | |
626 line (), column ()); | |
627 } | |
628 | |
2982 | 629 void |
630 tree_complex_for_command::accept (tree_walker& tw) | |
631 { | |
632 tw.visit_complex_for_command (*this); | |
633 } | |
634 | |
635 /* | |
636 ;;; Local Variables: *** | |
637 ;;; mode: C++ *** | |
638 ;;; End: *** | |
639 */ |