DoInstruction.cpp
Go to the documentation of this file.
1 /*----------------------------------------------------------------------------*/
2 /* */
3 /* Copyright (c) 1995, 2004 IBM Corporation. All rights reserved. */
4 /* Copyright (c) 2005-2009 Rexx Language Association. All rights reserved. */
5 /* */
6 /* This program and the accompanying materials are made available under */
7 /* the terms of the Common Public License v1.0 which accompanies this */
8 /* distribution. A copy is also available at the following address: */
9 /* http://www.oorexx.org/license.html */
10 /* */
11 /* Redistribution and use in source and binary forms, with or */
12 /* without modification, are permitted provided that the following */
13 /* conditions are met: */
14 /* */
15 /* Redistributions of source code must retain the above copyright */
16 /* notice, this list of conditions and the following disclaimer. */
17 /* Redistributions in binary form must reproduce the above copyright */
18 /* notice, this list of conditions and the following disclaimer in */
19 /* the documentation and/or other materials provided with the distribution. */
20 /* */
21 /* Neither the name of Rexx Language Association nor the names */
22 /* of its contributors may be used to endorse or promote products */
23 /* derived from this software without specific prior written permission. */
24 /* */
25 /* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */
26 /* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT */
27 /* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS */
28 /* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT */
29 /* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, */
30 /* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED */
31 /* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, */
32 /* OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY */
33 /* OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING */
34 /* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS */
35 /* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */
36 /* */
37 /*----------------------------------------------------------------------------*/
38 /******************************************************************************/
39 /* REXX Translator */
40 /* */
41 /* Primitive Do Parse Class */
42 /* */
43 /******************************************************************************/
44 #include <stdlib.h>
45 #include "RexxCore.h"
46 #include "StringClass.hpp"
47 #include "ArrayClass.hpp"
48 #include "RexxActivation.hpp"
49 #include "RexxActivity.hpp"
50 #include "DoInstruction.hpp"
51 #include "DoBlock.hpp"
52 #include "EndInstruction.hpp"
53 #include "Token.hpp"
54 #include "SourceFile.hpp"
56 
58  RexxInstructionEnd *_end, /* end to match up */
59  RexxSource *source ) /* parsed source file (for errors) */
60 /******************************************************************************/
61 /* Function: Verify that the name on an END and the END statement match */
62 /******************************************************************************/
63 {
64  RexxString *name = _end->name; /* get then END name */
65  SourceLocation location = _end->getLocation(); /* get location of END instruction */
66 
67  if (name != OREF_NULL) /* was a name given? */
68  {
69  size_t lineNum = this->getLineNumber(); /* Instruction line number */
70  RexxString *myLabel = getLabel();
71  if (myLabel == OREF_NULL) /* name given on non-control form? */
72  {
73  /* have a mismatched end */
74  source->error(Error_Unexpected_end_nocontrol, location, new_array(name, new_integer(lineNum)));
75  }
76  else if (name != getLabel()) /* not the same name? */
77  {
78  source->error(Error_Unexpected_end_control, location, new_array(name, myLabel, new_integer(lineNum)));
79  }
80  }
81 }
82 
84  RexxInstructionEnd *partner, /* partner END instruction for block */
85  RexxSource *source ) /* parsed source file (for errors) */
86 /******************************************************************************/
87 /* Make sure we have a match between and END and a DO */
88 /******************************************************************************/
89 {
90  this->matchLabel(partner, source); /* match up the names */
91  OrefSet(this, this->end, partner); /* match up with the END instruction */
92  if (this->type != SIMPLE_DO) /* not a simple DO form? */
93  {
94  partner->setStyle(LOOP_BLOCK); /* this is a loop form */
95  }
96  else
97  {
98  // for a simple DO, we need to check if this has a label
99  if (getLabel() != OREF_NULL)
100  {
101  partner->setStyle(LABELED_DO_BLOCK);
102  }
103  else
104  {
105  partner->setStyle(DO_BLOCK);
106  }
107  }
108 }
109 
110 
111 /**
112  * Check for a label match on a block instruction.
113  *
114  * @param name The target block name.
115  *
116  * @return True if this is a name match, false otherwise.
117  */
119 {
120  return label == name;
121 }
122 
123 /**
124  * Get the label for this block instruction.
125  *
126  * @return The label for the loop. Returns OREF_NULL if there is no label.
127  */
129 {
130  return label;
131 }
132 
133 /**
134  * Tests to see if this is a loop instruction.
135  *
136  * @return True if this is a repetitive loop, false otherwise.
137  */
139 {
140  return this->type != SIMPLE_DO;
141 }
142 
143 
144 void RexxInstructionDo::live(size_t liveMark)
145 /******************************************************************************/
146 /* Function: Normal garbage collection live marking */
147 /******************************************************************************/
148 {
149  memory_mark(this->nextInstruction); /* must be first one marked */
150  memory_mark(this->initial);
151  memory_mark(this->to);
152  memory_mark(this->by);
153  memory_mark(this->forcount);
154  memory_mark(this->control);
155  memory_mark(this->label);
156  memory_mark(this->conditional);
157  memory_mark(this->end);
158 }
159 
161 /******************************************************************************/
162 /* Function: Generalized object marking */
163 /******************************************************************************/
164 {
165  /* must be first one marked */
168  memory_mark_general(this->to);
169  memory_mark_general(this->by);
172  memory_mark_general(this->label);
174  memory_mark_general(this->end);
175 }
176 
178 /******************************************************************************/
179 /* Function: Flatten an object */
180 /******************************************************************************/
181 {
183 
184  flatten_reference(newThis->nextInstruction, envelope);
185  flatten_reference(newThis->initial, envelope);
186  flatten_reference(newThis->to, envelope);
187  flatten_reference(newThis->by, envelope);
188  flatten_reference(newThis->forcount, envelope);
189  flatten_reference(newThis->control, envelope);
190  flatten_reference(newThis->label, envelope);
191  flatten_reference(newThis->conditional, envelope);
192  flatten_reference(newThis->end, envelope);
193 
195 }
196 
198  RexxActivation *context, /* current execution context */
199  RexxDoBlock *doblock ) /* active do block */
200 /******************************************************************************/
201 /* Function: Terminate an active do loop */
202 /******************************************************************************/
203 {
204  /* perform cleanup */
205  context->terminateBlock(doblock->getIndent());
206  /* jump to the loop end */
207  context->setNext(this->end->nextInstruction);
208 }
209 
211  RexxActivation *context, /* current activation context */
212  RexxExpressionStack *stack) /* evaluation stack */
213 /******************************************************************************/
214 /* Function: Execute a REXX DO instruction */
215 /******************************************************************************/
216 {
217  RexxDoBlock *doblock = OREF_NULL; /* active DO block */
218  RexxObject *result; /* expression evaluation result */
219  ProtectedObject p_result;
220  RexxArray *array; /* converted collection object */
221  wholenumber_t count; /* count for repetitive or FOR loops */
222  RexxObject *object; /* result object (for error)*/
223 
224  context->traceInstruction(this); /* trace if necessary */
225  if (this->type != SIMPLE_DO) /* a real loop instruction? */
226  {
227  /* create an active DO block */
228  doblock = new RexxDoBlock (this, context->getIndent());
229  context->newDo(doblock); /* set the new block */
230 
231  switch (this->type) /* process each DO seperately */
232  {
233 
234  case DO_FOREVER: /* DO FOREVER loop */
235  case DO_UNTIL: /* DO UNTIL - no checks first time */
236  break; /* just quit */
237 
238  case DO_OVER: /* DO name OVER collection */
239  case DO_OVER_UNTIL: /* same as DO_OVER on first pass */
240  /* get the collection object */
241  result = this->initial->evaluate(context, stack);
242  doblock->setTo(result); /* Anchor result in doBlock to keep */
243  /* from GC. */
244  context->traceResult(result); /* trace if necessary */
245  if (isOfClass(Array, result)) /* already an array item? */
246  {
247  /* get the non-sparse version */
248  array = ((RexxArray *)result)->makeArray();
249  }
250  else /* some other type of collection */
251  {
252  /* get the array version of this */
253  array = REQUEST_ARRAY(result);
254  /* didn't convert ok? */
255  if (array == TheNilObject || !isOfClass(Array, array) )
256  {
257  /* raise an error */
259  }
260  }
261  doblock->setTo(array); /* save this as the "TO" value */
262  doblock->setFor(1); /* set the initial position */
263  /* go process the loop */
264  if (!this->checkOver(context, stack, doblock))
265  {
266  /* cause termination cleanup */
267  this->terminate(context, doblock);
268  }
269  break;
270 
271  case DO_OVER_WHILE: /* DO name OVER collection WHILE cond*/
272  /* get the collection object */
273  result = this->initial->evaluate(context, stack);
274  /* Anchor result in doBlock to keep */
275  doblock->setTo(result); /* from GC. */
276  context->traceResult(result); /* trace if necessary */
277  if (isOfClass(Array, result)) /* already an array item? */
278  {
279  /* get the non-sparse version */
280  array = ((RexxArray *)result)->makeArray();
281  }
282  else /* some other type of collection */
283  {
284  /* get the array version of this */
285  array = REQUEST_ARRAY(result);
286  /* didn't convert ok? */
287  if (array == TheNilObject || !isOfClass(Array, array) )
288  {
289  /* raise an error */
291  }
292  }
293  doblock->setTo(array); /* save this as the "TO" value */
294  doblock->setFor(1); /* set the initial position */
295  /* go process the loop */
296  if (!this->checkOver(context, stack, doblock) || !this->whileCondition(context, stack))
297  {
298  /* cause termination cleanup */
299  this->terminate(context, doblock);
300  }
301  break;
302 
303  case DO_COUNT: /* DO expr */
304  case DO_COUNT_UNTIL: /* DO expr UNTIL foo */
305  /* get the expression value */
306  result = this->forcount->evaluate(context, stack);
307  object = result; /* save for error reporting */
308  /* an integer value already, and */
309  /* we're dealing with a "normal */
310  /* NUMERIC DIGITS setting */
311  if (isOfClass(Integer, result) && context->digits() >= Numerics::DEFAULT_DIGITS)
312  {
313  /* get the value directly */
314  count = ((RexxInteger *)result)->getValue();
315  context->traceResult(result);/* trace if necessary */
316  }
317  else
318  {
319  /* get this as a number string, */
320  /* which should force string */
321  /* conversion also */
322  result = REQUEST_STRING(result);
323  p_result = result;
324  /* force rounding */
325  result = callOperatorMethod(result, OPERATOR_PLUS, OREF_NULL);
326  p_result = result;
327  context->traceResult(result);/* trace if necessary */
328  /* convert the value */
329  if (!result->requestNumber(count, number_digits()))
330  {
331  /* report an exception */
333  }
334  }
335  /* bad value, too small or too big? */
336  if (count < 0)
337  {
338  /* report an exception */
340  }
341  doblock->setFor(count); /* save the new value */
342  if (doblock->testFor()) /* is this DO 0? */
343  {
344  /* cause termination cleanup */
345  this->terminate(context, doblock);
346  }
347  break;
348 
349  case DO_COUNT_WHILE: /* DO expr WHILE foo */
350  /* get the expression value */
351  result = this->forcount->evaluate(context, stack);
352  object = result; /* save for error reporting */
353  /* an integer value already, and */
354  /* we're dealing with a "normal */
355  /* NUMERIC DIGITS setting */
356  if (isOfClass(Integer, result) && context->digits() >= Numerics::DEFAULT_DIGITS)
357  {
358  /* get the value directly */
359  count = ((RexxInteger *)result)->getValue();
360  context->traceResult(result);/* trace if necessary */
361  }
362  else
363  {
364  /* get this as a number string, */
365  /* which should force string */
366  /* conversion also */
367  result = REQUEST_STRING(result);
368  p_result = result;
369  /* force rounding */
370  result = callOperatorMethod(result, OPERATOR_PLUS, OREF_NULL);
371  p_result = result;
372  context->traceResult(result);/* trace if necessary */
373  /* convert the value */
374  if (!result->requestNumber(count, number_digits()))
375  {
376  /* report an exception */
378  }
379  }
380  /* bad value, too small or too big? */
381  if (count < 0)
382  {
383  /* report an exception */
385  }
386  doblock->setFor(count); /* save the new value */
387  /* is this DO 0? */
388  if (doblock->testFor() || !this->whileCondition(context, stack))
389  {
390  /* cause termination cleanup */
391  this->terminate(context, doblock);
392  }
393  break;
394 
395  case DO_WHILE: /* DO WHILE condition */
396  /* evaluate the condition */
397  if (!this->whileCondition(context, stack))
398  {
399  /* cause termination cleanup */
400  this->terminate(context, doblock);
401  }
402  break;
403 
404  case CONTROLLED_DO: /* DO i=expr TO expr BY expr FOR expr*/
405  case CONTROLLED_UNTIL: /* DO i=expr ... UNTIL condition */
406  /* do initial controlled loop setup */
407  this->controlSetup(context, stack, doblock);
408  /* fail the initial check? */
409  if (!this->checkControl(context, stack, doblock, false))
410  {
411  /* cause termination cleanup */
412  this->terminate(context, doblock);
413  }
414  break;
415 
416  case CONTROLLED_WHILE: /* DO i=expr ... WHILE condition */
417  /* do initial controlled loop setup */
418  this->controlSetup(context, stack, doblock);
419  /* fail the initial check or */
420  /* the WHILE check? */
421  if (!this->checkControl(context, stack, doblock, false) || !this->whileCondition(context, stack))
422  {
423  /* cause termination cleanup */
424  this->terminate(context, doblock);
425  }
426  break;
427  }
428  }
429  else /* just a simple do */
430  {
431  if (getLabel() != OREF_NULL)
432  {
433  /* create an active DO block */
434  doblock = new RexxDoBlock (this, context->getIndent());
435  context->newDo(doblock); /* set the new block */
436  }
437  else
438  {
439  context->addBlock(); /* step the nesting level */
440  }
441  }
442  /* do debug pause if necessary */
443  /* have to re-execute? */
444  if (context->conditionalPauseInstruction())
445  {
446  if (doblock != OREF_NULL)
447  {
448  this->terminate(context, doblock); /* cause termination cleanup */
449  }
450  else
451  {
452  context->removeBlock(); /* cause termination cleanup */
453  }
454  context->setNext(this); /* make this the new next instruction*/
455  }
456 }
457 
458 
460  RexxActivation *context, /* current activation context */
461  RexxExpressionStack *stack, /* evaluation stack */
462  RexxDoBlock *doblock ) /* stacked DO execution block */
463 /******************************************************************************/
464 /* Function: Setup for use of a control variable */
465 /******************************************************************************/
466 {
467  size_t i; /* loop control variable */
468  RexxObject *result; /* expression result */
469  ProtectedObject p_result;
470  RexxObject *_initial; /* initial variable value */
471  ProtectedObject p_initial;
472  RexxObject *object; /* original result object (for error)*/
473  ProtectedObject p_object;
474  wholenumber_t count; /* for count */
475 
476  /* evaluate the initial expression */
477  _initial = this->initial->evaluate(context, stack);
478  /* force rounding */
479  _initial = callOperatorMethod(_initial, OPERATOR_PLUS, OREF_NULL);
480  p_initial = _initial;
481  /* process each of the expressions */
482  for (i = 0; i < 3 && this->expressions[i] != 0; i++)
483  {
484  switch (this->expressions[i]) /* process various keywords */
485  {
486 
487  case EXP_TO: /* TO expression */
488  { /* get the expression value */
489  result = this->to->evaluate(context, stack);
490  p_result = result;
491  /* force rounding */
492  result = callOperatorMethod(result, OPERATOR_PLUS, OREF_NULL);
493  p_result = result;
494  /* if the result is a string, see if we can convert this to */
495  /* an integer value. This is very common in loops, and can */
496  /* save us a lot of processing on each loop iteration. */
497  RexxObject *temp = result->integerValue(number_digits());
498  if (temp != TheNilObject)
499  {
500  result = temp;
501  }
502  doblock->setTo(result); /* save the new value */
503  break;
504  }
505 
506  case EXP_BY: /* BY expression */
507  /* get the expression value */
508  result = this->by->evaluate(context, stack);
509  p_result = result;
510  /* force rounding */
511  result = callOperatorMethod(result, OPERATOR_PLUS, OREF_NULL);
512  doblock->setBy(result); /* save the new value */
513  /* if the BY is negative */
515  {
516  /* comparison is for less than */
517  /* the termination value */
518  doblock->setCompare(OPERATOR_LESSTHAN);
519  }
520  else
521  {
522  /* comparison is for greater than */
523  /* the termination value */
525  }
526  break;
527 
528  case EXP_FOR: /* FOR expression */
529  /* get the expression value */
530  result = this->forcount->evaluate(context, stack);
531  p_result = result;
532  object = result; /* save for error reporting */
533  p_object = object;
534  /* an integer value already, and */
535  /* we're dealing with a "normal */
536  /* NUMERIC DIGITS setting */
537  if (isOfClass(Integer, result) && context->digits() >= Numerics::DEFAULT_DIGITS)
538  {
539  /* get the value directly */
540  count = ((RexxInteger *)result)->getValue();
541  context->traceResult(result);/* trace if necessary */
542  }
543  else
544  {
545  /* get this as a number string, */
546  /* which should force string */
547  /* conversion also */
548  result = REQUEST_STRING(result);
549  p_result = result;
550  /* force rounding */
551  result = callOperatorMethod(result, OPERATOR_PLUS, OREF_NULL);
552  p_result = result;
553  context->traceResult(result);/* trace if necessary */
554  /* convert the value */
555  if (!result->requestNumber(count, number_digits()))
556  {
557  /* report an exception */
559  }
560  }
561  /* bad value, too small or too big? */
562  if (count < 0)
563  {
564  /* report an exception */
566  }
567  doblock->setFor(count); /* save the new value */
568  break;
569  }
570  }
571  if (this->by == OREF_NULL) /* no BY expression? */
572  {
573  doblock->setBy(IntegerOne); /* use an increment of 1 */
574  /* comparison is for greater than */
575  /* the termination value */
577  }
578  /* do the initial assignment */
579  this->control->assign(context, stack, _initial);
580 }
581 
583  RexxActivation *context, /* current activation context */
584  RexxExpressionStack *stack, /* evaluation stack */
585  RexxDoBlock *doblock ) /* stacked DO execution block */
586 /******************************************************************************/
587 /* Function: Process an iterationn of an OVER loop */
588 /******************************************************************************/
589 {
590  size_t over_position; /* position of DO_OVER iteration */
591  RexxArray *over_array; /* DO OVER value array */
592  RexxObject *result; /* process the result */
593  over_position = doblock->getFor(); /* get the current position */
594  /* get the value array */
595  over_array = (RexxArray *)doblock->getTo();
596  /* reached the end? */
597  if (over_array->size() < over_position)
598  {
599  return false; // time to get out of here.
600  }
601  /* get the next element */
602  result = over_array->get(over_position);
603  if (result == OREF_NULL) /* empty for some reason? */
604  {
605  result = TheNilObject; /* use .nil instead */
606  }
607  /* do the initial assignment */
608  this->control->assign(context, stack, result);
609  context->traceResult(result); /* trace if necessary */
610  doblock->setFor(over_position + 1);/* set position for next time */
611  return true;
612 }
613 
614 
616  RexxActivation *context, /* current activation context */
617  RexxExpressionStack *stack, /* evaluation stack */
618  RexxDoBlock *doblock, /* stacked DO execution block */
619  bool increment ) /* increment control variable test */
620 /******************************************************************************/
621 /* Function: Step and check the value of a control variable against the */
622 /* terminating value */
623 /******************************************************************************/
624 {
625  RexxObject *result; /* increment result */
626  /* get the control variable value */
627  result = this->control->getValue(context);
628  context->traceResult(result); /* trace if necessary */
629  if (increment)
630  { /* not the first time through? */
631  /* perform the addition */
632  result = callOperatorMethod(result, OPERATOR_PLUS, doblock->getBy());
633  /* increment the control variable */
634  /* value and assign new value */
635  this->control->set(context, result);
636  context->traceResult(result); /* trace if necessary */
637  }
638  if (this->to != OREF_NULL)
639  { /* have a termination condition? */
640  /* do the comparison */
641  if (callOperatorMethod(result, doblock->getCompare(), doblock->getTo()) == TheTrueObject)
642  {
643  return false; // time to stop if this is true
644  }
645  }
646  if (this->forcount != OREF_NULL) /* have a for count to check? */
647  {
648  if (doblock->testFor()) /* hit the end condition? */
649  {
650  return false; // done looping
651  }
652  }
653  return true; // still looping
654 }
655 
656 
658  RexxActivation *context, /* current activation context */
659  RexxExpressionStack *stack, /* evaluation stack */
660  RexxDoBlock *doblock ) /* stacked DO execution block */
661 /******************************************************************************/
662 /* Function: Handle a re-execution of a DO loop (every iteration by the */
663 /* first. */
664 /******************************************************************************/
665 {
666  /* set for the top of the loop */
667  context->setNext(this->nextInstruction);
668  context->traceInstruction(this); /* trace if necessary */
669  context->indent(); /* now indent again */
670 
671  switch (this->type) /* process each DO seperately */
672  {
673 
674  case DO_FOREVER: /* DO FOREVER loop */
675  return; /* nothing to do at all */
676 
677  case DO_OVER: /* DO name OVER collection loop */
678  /* go process the loop */
679  if (this->checkOver(context, stack, doblock))
680  {
681  return; /* finish quickly */
682  }
683  break;
684 
685  case DO_OVER_UNTIL: /* DO name OVER coll. UNTIL cond. */
686  /* go process the loop */
687  /* fail the control check or */
688  /* the UNTIL check? */
689  if (!this->untilCondition(context, stack) && this->checkOver(context, stack, doblock))
690  {
691  return; /* finish quickly */
692  }
693  break;
694 
695  case DO_OVER_WHILE: /* DO name OVER coll. WHILE cond. */
696  /* go process the loop */
697  /* fail the control check or */
698  /* the WHILE check? */
699  if (this->checkOver(context, stack, doblock) && this->whileCondition(context, stack))
700  {
701  return; /* finish quickly */
702  }
703  break;
704 
705  case DO_UNTIL: /* DO UNTIL condition */
706  /* evaluate the condition */
707  if (!this->untilCondition(context, stack))
708  return; /* finish quickly */
709  break;
710 
711  case DO_COUNT: /* DO expr */
712  if (!doblock->testFor()) /* have we reached 0? */
713  {
714  return; /* finish quickly */
715  }
716  break;
717 
718  case DO_COUNT_WHILE: /* DO expr WHILE expr */
719  /* have we reached 0? */
720  if (!doblock->testFor() && this->whileCondition(context, stack))
721  {
722  return; /* finish quickly */
723  }
724  break;
725 
726  case DO_COUNT_UNTIL: /* DO expr UNTIL expr */
727  /* have we reached 0? */
728  if (!this->untilCondition(context, stack) && !doblock->testFor())
729  {
730  return; /* finish quickly */
731  }
732  break;
733 
734  case DO_WHILE: /* DO WHILE condition */
735  /* evaluate the condition */
736  if (this->whileCondition(context, stack))
737  {
738  return; /* finish quickly */
739  }
740  break;
741 
742  case CONTROLLED_DO: /* DO i=expr TO expr BY expr FOR expr*/
743  /* fail the termination check? */
744  if (this->checkControl(context, stack, doblock, true))
745  {
746  return; /* finish quickly */
747  }
748  break;
749 
750  case CONTROLLED_UNTIL: /* DO i=expr ... UNTIL condition */
751  /* fail the control check or */
752  /* the UNTIL check? */
753  if (!this->untilCondition(context, stack) && this->checkControl(context, stack, doblock, true))
754  {
755  return; /* finish quickly */
756  }
757  break;
758 
759  case CONTROLLED_WHILE: /* DO i=expr ... WHILE condition */
760  /* fail the control check or */
761  /* the WHILE check? */
762  if (this->checkControl(context, stack, doblock, true) && this->whileCondition(context, stack))
763  {
764  return; /* finish quickly */
765  }
766  break;
767  }
768  context->popBlock(); /* cause termination cleanup */
769  context->removeBlock(); /* remove the execution nest */
770  /* jump to the loop end */
771  context->setNext(this->end->nextInstruction);
772  context->unindent(); /* step back trace indentation */
773 }
774 
776  RexxActivation *context, /* current activation context */
777  RexxExpressionStack *stack ) /* evaluation stack */
778 /******************************************************************************/
779 /* Function: Evaluate the result of a WHILE or UNTIL condition */
780 /******************************************************************************/
781 {
782  /* get the expression value */
783  RexxObject *result = this->conditional->evaluate(context, stack);
784  context->traceResult(result); /* trace if necessary */
785 
786  /* most comparisons return either true or false directly, so we */
787  /* can optimize this check. UNTIL conditions are more likely to */
788  /* evaluate to false, so we'll check that first */
789  if (result == TheFalseObject)
790  {
791  return false;
792  }
793  else if (result == TheTrueObject)
794  {
795  return true;
796  }
797  /* This is some sort of computed boolean, so we need to do a real */
798  /* validation on this */
799  return result->truthValue(Error_Logical_value_until);
800 }
801 
803  RexxActivation *context, /* current activation context */
804  RexxExpressionStack *stack ) /* evaluation stack */
805 /******************************************************************************/
806 /* Function: Evaluate the result of a WHILE or UNTIL condition */
807 /******************************************************************************/
808 {
809  /* get the expression value */
810  RexxObject *result = this->conditional->evaluate(context, stack);
811  context->traceResult(result); /* trace if necessary */
812 
813  /* most comparisons return either true or false directly, so we */
814  /* can optimize this check. WHILE conditions are more likely to */
815  /* evaluate to true, so we'll check that first */
816  if (result == TheTrueObject)
817  {
818  return true;
819  }
820  else if (result == TheFalseObject)
821  {
822  return false;
823  }
824  /* This is some sort of computed boolean, so we need to do a real */
825  /* validation on this */
826  return result->truthValue(Error_Logical_value_while);
827 }
void reportException(wholenumber_t error)
RexxArray * new_array(size_t s)
Definition: ArrayClass.hpp:259
#define DO_COUNT
#define DO_OVER_WHILE
#define EXP_TO
#define CONTROLLED_UNTIL
#define SIMPLE_DO
#define DO_OVER_UNTIL
#define DO_COUNT_WHILE
#define DO_FOREVER
#define DO_WHILE
#define DO_UNTIL
#define EXP_BY
#define DO_OVER
#define DO_COUNT_UNTIL
#define EXP_FOR
#define CONTROLLED_WHILE
#define CONTROLLED_DO
#define DO_BLOCK
#define LABELED_DO_BLOCK
#define LOOP_BLOCK
RexxInteger * new_integer(wholenumber_t v)
size_t number_digits()
Definition: Numerics.hpp:147
#define OREF_NULL
Definition: RexxCore.h:61
RexxArray * REQUEST_ARRAY(RexxObject *obj)
Definition: RexxCore.h:457
RexxString * REQUEST_STRING(RexxObject *object)
Definition: RexxCore.h:295
#define IntegerOne
Definition: RexxCore.h:200
#define OrefSet(o, r, v)
Definition: RexxCore.h:101
#define TheTrueObject
Definition: RexxCore.h:196
#define isOfClass(t, r)
Definition: RexxCore.h:224
#define TheNilObject
Definition: RexxCore.h:191
#define TheFalseObject
Definition: RexxCore.h:195
RexxObject * callOperatorMethod(RexxObject *object, size_t methodOffset, RexxObject *argument)
Definition: RexxCore.h:565
#define IntegerZero
Definition: RexxCore.h:199
#define Error_Logical_value_while
#define Error_Execution_noarray
#define Error_Unexpected_end_nocontrol
#define Error_Unexpected_end_control
#define Error_Invalid_whole_number_repeat
#define Error_Invalid_whole_number_for
#define Error_Logical_value_until
#define memory_mark(oref)
Definition: RexxMemory.hpp:450
#define flatten_reference(oref, envel)
Definition: RexxMemory.hpp:498
#define memory_mark_general(oref)
Definition: RexxMemory.hpp:451
#define cleanUpFlatten
Definition: RexxMemory.hpp:484
#define setUpFlatten(type)
Definition: RexxMemory.hpp:478
#define OPERATOR_PLUS
Definition: Token.hpp:110
#define OPERATOR_LESSTHAN
Definition: Token.hpp:124
#define OPERATOR_GREATERTHAN
Definition: Token.hpp:122
static const size_t DEFAULT_DIGITS
Definition: Numerics.hpp:66
int conditionalPauseInstruction()
void newDo(RexxDoBlock *block)
void traceResult(RexxObject *v)
void traceInstruction(RexxInstruction *v)
void terminateBlock(size_t _indent)
void setNext(RexxInstruction *v)
size_t size()
Definition: ArrayClass.hpp:202
RexxArray * makeArray()
RexxObject * get(size_t pos)
Definition: ArrayClass.hpp:203
int getCompare()
Definition: DoBlock.hpp:65
RexxObject * getBy()
Definition: DoBlock.hpp:66
RexxObject * getTo()
Definition: DoBlock.hpp:63
void setFor(wholenumber_t value)
Definition: DoBlock.hpp:71
wholenumber_t getFor()
Definition: DoBlock.hpp:64
void setTo(RexxObject *value)
Definition: DoBlock.hpp:68
void setCompare(int value)
Definition: DoBlock.hpp:70
bool testFor()
Definition: DoBlock.hpp:72
size_t getIndent()
Definition: DoBlock.hpp:73
void setBy(RexxObject *value)
Definition: DoBlock.hpp:69
void flatten(RexxEnvelope *)
bool checkOver(RexxActivation *, RexxExpressionStack *, RexxDoBlock *)
void reExecute(RexxActivation *, RexxExpressionStack *, RexxDoBlock *)
void matchEnd(RexxInstructionEnd *, RexxSource *)
void matchLabel(RexxInstructionEnd *end, RexxSource *source)
RexxVariableBase * control
RexxInstruction * end
void terminate(RexxActivation *, RexxDoBlock *)
bool isLabel(RexxString *name)
RexxString * label
bool whileCondition(RexxActivation *, RexxExpressionStack *)
RexxObject * forcount
void liveGeneral(int reason)
void execute(RexxActivation *, RexxExpressionStack *)
RexxObject * initial
uint8_t expressions[3]
RexxObject * conditional
bool checkControl(RexxActivation *, RexxExpressionStack *, RexxDoBlock *, bool)
bool untilCondition(RexxActivation *, RexxExpressionStack *)
RexxString * getLabel()
void controlSetup(RexxActivation *, RexxExpressionStack *, RexxDoBlock *)
void setStyle(size_t type)
const SourceLocation & getLocation()
RexxInstruction * nextInstruction
virtual RexxObject * evaluate(RexxActivation *, RexxExpressionStack *)
virtual RexxObject * getValue(RexxActivation *)
RexxInteger * integerValue(size_t)
bool requestNumber(wholenumber_t &, size_t)
bool truthValue(int)
void error(int)
virtual void set(RexxActivation *, RexxObject *)
virtual void assign(RexxActivation *, RexxExpressionStack *, RexxObject *)
ssize_t wholenumber_t
Definition: rexx.h:230