You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
- 02111-1307, USA. */
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ 02110-1301, USA. */
#include <config.h>
-#include <assert.h>
+#include "error.h"
#include "alloc.h"
-#include "approx.h"
+#include "case.h"
#include "command.h"
+#include "dictionary.h"
#include "do-ifP.h"
#include "error.h"
-#include "expr.h"
+#include "expressions/public.h"
#include "lexer.h"
+#include "misc.h"
#include "settings.h"
#include "str.h"
#include "var.h"
-#undef DEBUGGING
-/*#define DEBUGGING 1*/
#include "debug-print.h"
-/* *INDENT-OFF* */
/* LOOP strategy:
Each loop causes 3 different transformations to be output. The
transformation to -1. This ensures that the pass number is set to
-1 every time the loop is encountered, before the first iteration.
- The second transformation increments the pass number. If there is
- no indexing or test clause on either LOOP or END LOOP, then the
- pass number is checked against MXLOOPS and control may pass out of
- the loop; otherwise the indexing or test clause(s) on LOOP are
- checked, and again control may pass out of the loop.
+ The second transformation increments the pass number. If
+ there is no indexing or test clause on either LOOP or END
+ LOOP, then the pass number is checked against MXLOOPS and
+ control may pass out of the loop. Otherwise the indexing or
+ test clause(s) on LOOP are checked, and again control may pass
+ out of the loop.
- After the second transformation the body of the loop is executed.
+ After the second transformation the body of the loop is
+ executed.
The last transformation checks the test clause if present and
- either jumps back up to the second transformation or terminates the
- loop.
-
- Flow of control: (The characters ^V<> represents arrows.)
-
- 1. LOOP (sets pass # to -1)
- V
- V
- >>2. LOOP (increment pass number)
- ^ (test optional indexing clause)
- ^ (test optional IF clause)
- ^ if we need another trip if we're done with the loop>>V
- ^ V V
- ^ V V
- ^ *. execute loop body V
- ^ . V
- ^ . (any number of transformations) V
- ^ . V
- ^ V
- ^ 3. END LOOP (test optional IF clause) V
- ^<<<<if we need another trip if we're done with the loop>>V
- V
- V
- *. transformations after loop body<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ either jumps back up to the second transformation or
+ terminates the loop.
+
+ Flow of control:
+
+ 1. LOOP. Sets pass number to -1 and continues to next
+ transformation.
+
+ 2. LOOP. Increments pass number. Tests optional indexing
+ clause and optional IF clause. If we're done with the
+ loop, we jump to the transformation just after LOOP
+ transformation 3.
+ Otherwise, we continue through the transformations in the
+ loop body.
+
+ 3. END LOOP. We test the optional IF clause. If we need to
+ make another pass through the loop, we jump to LOOP
+ transformation 2.
+
+ Otherwise, we continue with the transformation jump after
+ the loop.
*/
-/* *INDENT-ON* */
/* Types of limits on loop execution. */
enum
static int internal_cmd_loop (void);
static int internal_cmd_end_loop (void);
-static int break_trns_proc (struct trns_header *, struct ccase *);
-static int loop_1_trns_proc (struct trns_header *, struct ccase *);
-static void loop_1_trns_free (struct trns_header *);
-static int loop_2_trns_proc (struct trns_header *, struct ccase *);
-static void loop_2_trns_free (struct trns_header *);
-static int loop_3_trns_proc (struct trns_header *, struct ccase *);
-static void loop_3_trns_free (struct trns_header *);
+static trns_proc_func break_trns_proc;
+static trns_proc_func loop_1_trns_proc, loop_2_trns_proc, loop_3_trns_proc;
+static trns_free_func loop_1_trns_free, loop_2_trns_free, loop_3_trns_free;
static void pop_ctl_stack (void);
\f
/* LOOP. */
internal_cmd_loop (void)
{
/* Name of indexing variable if applicable. */
- char name[9];
-
- lex_match_id ("LOOP");
+ char name[LONG_NAME_LEN + 1];
/* Create and initialize transformations to facilitate
error-handling. */
/* Parse indexing clause. */
if (token == T_ID && lex_look_ahead () == '=')
{
- struct variable *v = find_variable (tokid);
+ struct variable *v = dict_lookup_var (default_dict, tokid);
two->flags |= LPC_INDEX;
assert (token == '=');
lex_get ();
- one->init = expr_parse (PXP_NUMERIC);
+ one->init = expr_parse (default_dict, EXPR_NUMBER);
if (!one->init)
return 0;
expr_free (one->init);
return 0;
}
- one->term = expr_parse (PXP_NUMERIC);
+ one->term = expr_parse (default_dict, EXPR_NUMBER);
if (!one->term)
{
expr_free (one->init);
if (lex_match (T_BY))
{
- one->incr = expr_parse (PXP_NUMERIC);
+ one->incr = expr_parse (default_dict, EXPR_NUMBER);
if (!one->incr)
return 0;
}
}
else
- name[0] = 0;
+ name[0] = '\0';
/* Parse IF clause. */
if (lex_match_id ("IF"))
{
two->flags |= LPC_COND;
- two->cond = expr_parse (PXP_BOOLEAN);
+ two->cond = expr_parse (default_dict, EXPR_BOOLEAN);
if (!two->cond)
return 0;
}
}
/* Find variable; create if necessary. */
- if (name[0])
+ if (name[0] != '\0')
{
- two->index = find_variable (name);
+ two->index = dict_lookup_var (default_dict, name);
if (!two->index)
- {
- two->index = force_create_variable (&default_dict, name, NUMERIC, 0);
-#if DEBUGGING
- envector (two->index);
-#endif
- }
+ two->index = dict_create_var (default_dict, name, 0);
}
/* Push on control stack. */
add_transformation ((struct trns_header *) one);
add_transformation ((struct trns_header *) two);
-#if DEBUGGING
- printf ("LOOP");
- if (two->flags & LPC_INDEX)
- printf ("(INDEX)");
- if (two->flags & LPC_COND)
- printf ("(IF)");
- printf ("\n");
-#endif
-
return 1;
}
/* Parse the expression if any. */
if (lex_match_id ("IF"))
{
- thr->cond = expr_parse (PXP_BOOLEAN);
+ thr->cond = expr_parse (default_dict, EXPR_BOOLEAN);
if (!thr->cond)
return 0;
}
/* Pop off the top of stack. */
ctl_stack = ctl_stack->down;
-#if DEBUGGING
- printf ("END LOOP");
- if (thr->cond)
- printf ("(IF)");
- printf ("\n");
-#endif
-
return 1;
}
/* Performs transformation 1. */
static int
-loop_1_trns_proc (struct trns_header * trns, struct ccase * c)
+loop_1_trns_proc (struct trns_header * trns, struct ccase * c,
+ int case_num)
{
struct loop_1_trns *one = (struct loop_1_trns *) trns;
struct loop_2_trns *two = one->two;
two->pass = -1;
if (two->flags & LPC_INDEX)
{
- union value t1, t2, t3;
+ double t1, t2, t3;
- expr_evaluate (one->init, c, &t1);
+ t1 = expr_evaluate_num (one->init, c, case_num);
if (one->incr)
- expr_evaluate (one->incr, c, &t2);
+ t2 = expr_evaluate_num (one->incr, c, case_num);
else
- t2.f = 1.0;
- expr_evaluate (one->term, c, &t3);
+ t2 = 1.0;
+ t3 = expr_evaluate_num (one->term, c, case_num);
/* Even if the loop is never entered, force the index variable
to assume the initial value. */
- c->data[two->index->fv].f = t1.f;
+ case_data_rw (c, two->index->fv)->f = t1;
/* Throw out various pathological cases. */
- if (!finite (t1.f) || !finite (t2.f) || !finite (t3.f)
- || approx_eq (t2.f, 0.0))
+ if (!finite (t1) || !finite (t2) || !finite (t3) || t2 == 0.0)
return two->loop_term;
debug_printf (("LOOP %s=%g TO %g BY %g.\n", two->index->name,
- t1.f, t3.f, t2.f));
- if (t2.f > 0.0)
+ t1, t3, t2));
+ if (t2 > 0.0)
{
/* Loop counts upward: I=1 TO 5 BY 1. */
two->flags &= ~LPC_RINDEX;
/* incr>0 but init>term */
- if (approx_gt (t1.f, t3.f))
+ if (t1 > t3)
return two->loop_term;
}
else
two->flags |= LPC_RINDEX;
/* incr<0 but init<term */
- if (approx_lt (t1.f, t3.f))
+ if (t1 < t3)
return two->loop_term;
}
- two->curr = t1.f;
- two->incr = t2.f;
- two->term = t3.f;
+ two->curr = t1;
+ two->incr = t2;
+ two->term = t3;
}
return -1;
/* Performs transformation 2. */
static int
-loop_2_trns_proc (struct trns_header * trns, struct ccase * c)
+loop_2_trns_proc (struct trns_header * trns, struct ccase * c,
+ int case_num UNUSED)
{
struct loop_2_trns *two = (struct loop_2_trns *) trns;
if (two->flags == 0)
{
two->pass++;
- if (two->pass > set_mxloops)
+ if (two->pass > get_mxloops() )
return two->loop_term;
}
if (two->flags & LPC_RINDEX)
{
/* Test if we're at the end of the looping. */
- if (approx_lt (two->curr, two->term))
+ if (two->curr < two->term)
return two->loop_term;
/* Set the current value into the case. */
- c->data[two->index->fv].f = two->curr;
+ case_data_rw (c, two->index->fv)->f = two->curr;
/* Decrement the current value. */
two->curr += two->incr;
else if (two->flags & LPC_INDEX)
{
/* Test if we're at the end of the looping. */
- if (approx_gt (two->curr, two->term))
+ if (two->curr > two->term)
return two->loop_term;
/* Set the current value into the case. */
- c->data[two->index->fv].f = two->curr;
+ case_data_rw (c, two->index->fv)->f = two->curr;
/* Increment the current value. */
two->curr += two->incr;
/* Conditional clause limiter. */
if ((two->flags & LPC_COND)
- && expr_evaluate (two->cond, c, NULL) != 1.0)
+ && expr_evaluate_num (two->cond, c, case_num) != 1.0)
return two->loop_term;
return -1;
/* Performs transformation 3. */
static int
-loop_3_trns_proc (struct trns_header * trns, struct ccase * c)
+loop_3_trns_proc (struct trns_header * trns, struct ccase * c,
+ int case_num)
{
struct loop_3_trns *thr = (struct loop_3_trns *) trns;
/* Note that it breaks out of the loop if the expression is true *or
missing*. This is conformant. */
- if (thr->cond && expr_evaluate (two->cond, c, NULL) != 0.0)
+ if (thr->cond && expr_evaluate_num (two->cond, c, case_num) != 0.0)
return -1;
return thr->loop_start;
/* New transformation. */
struct break_trns *t;
- lex_match_id ("BREAK");
-
for (loop = ctl_stack; loop; loop = loop->down)
if (loop->type == CST_LOOP)
break;
}
static int
-break_trns_proc (struct trns_header * trns, struct ccase * c unused)
+break_trns_proc (struct trns_header * trns, struct ccase * c UNUSED,
+ int case_num UNUSED)
{
return ((struct break_trns *) trns)->loop_term;
}