23 |
#include "case.h" |
#include "case.h" |
24 |
#include "command.h" |
#include "command.h" |
25 |
#include "dictionary.h" |
#include "dictionary.h" |
26 |
#include "do-ifP.h" |
#include "ctl-stack.h" |
27 |
#include "error.h" |
#include "error.h" |
28 |
#include "expressions/public.h" |
#include "expressions/public.h" |
29 |
#include "lexer.h" |
#include "lexer.h" |
30 |
#include "misc.h" |
#include "misc.h" |
31 |
|
#include "pool.h" |
32 |
#include "settings.h" |
#include "settings.h" |
33 |
#include "str.h" |
#include "str.h" |
34 |
#include "var.h" |
#include "var.h" |
36 |
#include "gettext.h" |
#include "gettext.h" |
37 |
#define _(msgid) gettext (msgid) |
#define _(msgid) gettext (msgid) |
38 |
|
|
39 |
#include "debug-print.h" |
/* LOOP outputs a transformation that is executed only on the |
40 |
|
first pass through the loop. On this trip, it initializes for |
41 |
|
the first pass by resetting the pass number, setting up the |
42 |
|
indexing clause, and testing the LOOP IF clause. If the loop |
43 |
|
is not to be entered at all, it jumps forward just past the |
44 |
|
END LOOP transformation; otherwise, it continues to the |
45 |
|
transformation following LOOP. |
46 |
|
|
47 |
|
END LOOP outputs a transformation that executes at the end of |
48 |
|
each trip through the loop. It checks the END LOOP IF clause, |
49 |
|
then updates the pass number, increments the indexing clause, |
50 |
|
and tests the LOOP IF clause. If another pass through the |
51 |
|
loop is due, it jumps backward to just after the LOOP |
52 |
|
transformation; otherwise, it continues to the transformation |
53 |
|
following END LOOP. */ |
54 |
|
|
55 |
/* LOOP strategy: |
struct loop_trns |
|
|
|
|
Each loop causes 3 different transformations to be output. The |
|
|
first two are output when the LOOP command is encountered; the last |
|
|
is output when the END LOOP command is encountered. |
|
|
|
|
|
The first to be output resets the pass number in the second |
|
|
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. |
|
|
|
|
|
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: |
|
|
|
|
|
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. |
|
|
*/ |
|
|
|
|
|
/* Types of limits on loop execution. */ |
|
|
enum |
|
|
{ |
|
|
LPC_INDEX = 001, /* Limited by indexing clause. */ |
|
|
LPC_COND = 002, /* Limited by IF clause. */ |
|
|
LPC_RINDEX = 004 /* Indexing clause counts downward, at least |
|
|
for this pass thru the loop. */ |
|
|
}; |
|
|
|
|
|
/* LOOP transformation 1. */ |
|
|
struct loop_1_trns |
|
56 |
{ |
{ |
57 |
struct trns_header h; |
struct pool *pool; |
58 |
|
|
59 |
struct loop_2_trns *two; /* Allows modification of associated |
/* Iteration limit. */ |
60 |
second transformation. */ |
int max_pass_count; /* Maximum number of passes (-1=unlimited). */ |
|
|
|
|
struct expression *init; /* Starting index. */ |
|
|
struct expression *incr; /* Index increment. */ |
|
|
struct expression *term; /* Terminal index. */ |
|
|
}; |
|
|
|
|
|
/* LOOP transformation 2. */ |
|
|
struct loop_2_trns |
|
|
{ |
|
|
struct trns_header h; |
|
|
|
|
|
struct ctl_stmt ctl; /* Nesting control info. */ |
|
|
|
|
|
int flags; /* Types of limits on loop execution. */ |
|
61 |
int pass; /* Number of passes thru the loop so far. */ |
int pass; /* Number of passes thru the loop so far. */ |
62 |
|
|
63 |
struct variable *index; /* Index variable. */ |
/* a=a TO b [BY c]. */ |
64 |
double curr; /* Current index. */ |
struct variable *index_var; /* Index variable. */ |
65 |
double incr; /* Increment. */ |
struct expression *first_expr; /* Starting index. */ |
66 |
double term; /* Terminal index. */ |
struct expression *by_expr; /* Index increment (default 1.0 if null). */ |
67 |
|
struct expression *last_expr; /* Terminal index. */ |
68 |
struct expression *cond; /* Optional IF condition when non-NULL. */ |
double cur, by, last; /* Current value, increment, last value. */ |
69 |
|
|
70 |
int loop_term; /* 1+(t_trns[] index of transformation 3); |
/* IF condition for LOOP or END LOOP. */ |
71 |
backpatched in by END LOOP. */ |
struct expression *loop_condition; |
72 |
|
struct expression *end_loop_condition; |
73 |
|
|
74 |
|
/* Transformation indexes. */ |
75 |
|
int past_LOOP_index; /* Just past LOOP transformation. */ |
76 |
|
int past_END_LOOP_index; /* Just past END LOOP transformation. */ |
77 |
}; |
}; |
78 |
|
|
79 |
/* LOOP transformation 3. (Actually output by END LOOP.) */ |
static struct ctl_class loop_class; |
|
struct loop_3_trns |
|
|
{ |
|
|
struct trns_header h; |
|
|
|
|
|
struct expression *cond; /* Optional IF condition when non-NULL. */ |
|
80 |
|
|
81 |
int loop_start; /* t_trns[] index of transformation 2. */ |
static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc; |
82 |
}; |
static trns_free_func loop_trns_free; |
83 |
|
|
84 |
/* LOOP transformations being created. */ |
static struct loop_trns *create_loop_trns (void); |
85 |
static struct loop_1_trns *one; |
static bool parse_if_clause (struct loop_trns *, struct expression **); |
86 |
static struct loop_2_trns *two; |
static bool parse_index_clause (struct loop_trns *, char index_var_name[]); |
87 |
static struct loop_3_trns *thr; |
static void close_loop (void *); |
|
|
|
|
static int internal_cmd_loop (void); |
|
|
static int internal_cmd_end_loop (void); |
|
|
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); |
|
88 |
|
|
89 |
/* LOOP. */ |
/* LOOP. */ |
90 |
|
|
91 |
/* Parses a LOOP command. Passes the real work off to |
/* Parses LOOP. */ |
|
internal_cmd_loop(). */ |
|
92 |
int |
int |
93 |
cmd_loop (void) |
cmd_loop (void) |
94 |
{ |
{ |
95 |
if (!internal_cmd_loop ()) |
struct loop_trns *loop; |
96 |
|
char index_var_name[LONG_NAME_LEN + 1]; |
97 |
|
bool ok = true; |
98 |
|
|
99 |
|
loop = create_loop_trns (); |
100 |
|
while (token != '.' && ok) |
101 |
{ |
{ |
102 |
loop_1_trns_free ((struct trns_header *) one); |
if (lex_match_id ("IF")) |
103 |
loop_2_trns_free ((struct trns_header *) two); |
ok = parse_if_clause (loop, &loop->loop_condition); |
104 |
return CMD_FAILURE; |
else |
105 |
|
ok = parse_index_clause (loop, index_var_name); |
106 |
} |
} |
107 |
|
|
108 |
return CMD_SUCCESS; |
/* Find index variable and create if necessary. */ |
109 |
|
if (ok && index_var_name[0] != '\0') |
110 |
|
{ |
111 |
|
loop->index_var = dict_lookup_var (default_dict, index_var_name); |
112 |
|
if (loop->index_var == NULL) |
113 |
|
loop->index_var = dict_create_var (default_dict, index_var_name, 0); |
114 |
|
} |
115 |
|
|
116 |
|
if (!ok) |
117 |
|
loop->max_pass_count = 0; |
118 |
|
return ok ? CMD_SUCCESS : CMD_PART_SUCCESS; |
119 |
} |
} |
120 |
|
|
121 |
/* Parses a LOOP command, returns success. */ |
/* Parses END LOOP. */ |
122 |
static int |
int |
123 |
internal_cmd_loop (void) |
cmd_end_loop (void) |
124 |
{ |
{ |
125 |
/* Name of indexing variable if applicable. */ |
struct loop_trns *loop; |
126 |
char name[LONG_NAME_LEN + 1]; |
bool ok = true; |
|
|
|
|
/* Create and initialize transformations to facilitate |
|
|
error-handling. */ |
|
|
two = xmalloc (sizeof *two); |
|
|
two->h.proc = loop_2_trns_proc; |
|
|
two->h.free = loop_2_trns_free; |
|
|
two->cond = NULL; |
|
|
two->flags = 0; |
|
|
|
|
|
one = xmalloc (sizeof *one); |
|
|
one->h.proc = loop_1_trns_proc; |
|
|
one->h.free = loop_1_trns_free; |
|
|
one->init = one->incr = one->term = NULL; |
|
|
one->two = two; |
|
|
|
|
|
/* Parse indexing clause. */ |
|
|
if (token == T_ID && lex_look_ahead () == '=') |
|
|
{ |
|
|
struct variable *v = dict_lookup_var (default_dict, tokid); |
|
|
|
|
|
two->flags |= LPC_INDEX; |
|
|
|
|
|
if (v && v->type == ALPHA) |
|
|
{ |
|
|
msg (SE, _("The index variable may not be a string variable.")); |
|
|
return 0; |
|
|
} |
|
|
strcpy (name, tokid); |
|
|
|
|
|
lex_get (); |
|
|
assert (token == '='); |
|
|
lex_get (); |
|
|
|
|
|
one->init = expr_parse (default_dict, EXPR_NUMBER); |
|
|
if (!one->init) |
|
|
return 0; |
|
|
|
|
|
if (!lex_force_match (T_TO)) |
|
|
{ |
|
|
expr_free (one->init); |
|
|
return 0; |
|
|
} |
|
|
one->term = expr_parse (default_dict, EXPR_NUMBER); |
|
|
if (!one->term) |
|
|
{ |
|
|
expr_free (one->init); |
|
|
return 0; |
|
|
} |
|
|
|
|
|
if (lex_match (T_BY)) |
|
|
{ |
|
|
one->incr = expr_parse (default_dict, EXPR_NUMBER); |
|
|
if (!one->incr) |
|
|
return 0; |
|
|
} |
|
|
} |
|
|
else |
|
|
name[0] = '\0'; |
|
127 |
|
|
128 |
/* Parse IF clause. */ |
loop = ctl_stack_top (&loop_class); |
129 |
|
if (loop == NULL) |
130 |
|
return CMD_FAILURE; |
131 |
|
|
132 |
|
/* Parse syntax. */ |
133 |
if (lex_match_id ("IF")) |
if (lex_match_id ("IF")) |
134 |
{ |
ok = parse_if_clause (loop, &loop->end_loop_condition); |
135 |
two->flags |= LPC_COND; |
if (ok) |
136 |
|
ok = lex_end_of_command () == CMD_SUCCESS; |
|
two->cond = expr_parse (default_dict, EXPR_BOOLEAN); |
|
|
if (!two->cond) |
|
|
return 0; |
|
|
} |
|
137 |
|
|
138 |
if (token != '.') |
if (!ok) |
139 |
{ |
loop->max_pass_count = 0; |
|
lex_error (_("expecting end of command")); |
|
|
return 0; |
|
|
} |
|
140 |
|
|
141 |
/* Find variable; create if necessary. */ |
ctl_stack_pop (loop); |
|
if (name[0] != '\0') |
|
|
{ |
|
|
two->index = dict_lookup_var (default_dict, name); |
|
|
if (!two->index) |
|
|
two->index = dict_create_var (default_dict, name, 0); |
|
|
} |
|
142 |
|
|
143 |
/* Push on control stack. */ |
return ok ? CMD_SUCCESS : CMD_PART_SUCCESS; |
|
two->ctl.down = ctl_stack; |
|
|
two->ctl.type = CST_LOOP; |
|
|
two->ctl.trns = (struct trns_header *) two; |
|
|
two->ctl.brk = NULL; |
|
|
ctl_stack = &two->ctl; |
|
|
|
|
|
/* Dump out the transformations. */ |
|
|
add_transformation ((struct trns_header *) one); |
|
|
add_transformation ((struct trns_header *) two); |
|
|
|
|
|
return 1; |
|
144 |
} |
} |
145 |
|
|
146 |
/* Parses the END LOOP command by passing the buck off to |
/* Parses BREAK. */ |
|
cmd_internal_end_loop(). */ |
|
147 |
int |
int |
148 |
cmd_end_loop (void) |
cmd_break (void) |
149 |
{ |
{ |
150 |
if (!internal_cmd_end_loop ()) |
struct ctl_stmt *loop = ctl_stack_search (&loop_class); |
151 |
{ |
if (loop == NULL) |
152 |
loop_3_trns_free ((struct trns_header *) thr); |
return CMD_FAILURE; |
153 |
if (ctl_stack && ctl_stack->type == CST_LOOP) |
|
154 |
pop_ctl_stack (); |
add_transformation (break_trns_proc, NULL, loop); |
|
return CMD_FAILURE; |
|
|
} |
|
155 |
|
|
156 |
return CMD_SUCCESS; |
return lex_end_of_command (); |
157 |
} |
} |
158 |
|
|
159 |
/* Parses the END LOOP command. */ |
/* Closes a LOOP construct by emitting the END LOOP |
160 |
int |
transformation and finalizing its members appropriately. */ |
161 |
internal_cmd_end_loop (void) |
static void |
162 |
|
close_loop (void *loop_) |
163 |
{ |
{ |
164 |
/* Backpatch pointer for BREAK commands. */ |
struct loop_trns *loop = loop_; |
165 |
struct break_trns *brk; |
|
166 |
|
add_transformation (end_loop_trns_proc, NULL, loop); |
167 |
|
loop->past_END_LOOP_index = next_transformation (); |
168 |
|
|
169 |
/* Allocate, initialize transformation to facilitate |
/* If there's nothing else limiting the number of loops, use |
170 |
error-handling. */ |
MXLOOPS as a limit. */ |
171 |
thr = xmalloc (sizeof *thr); |
if (loop->max_pass_count == -1 |
172 |
thr->h.proc = loop_3_trns_proc; |
&& loop->index_var == NULL |
173 |
thr->h.free = loop_3_trns_free; |
&& loop->loop_condition == NULL |
174 |
thr->cond = NULL; |
&& loop->end_loop_condition == NULL) |
175 |
|
loop->max_pass_count = get_mxloops (); |
176 |
|
} |
177 |
|
|
178 |
/* There must be a matching LOOP command. */ |
/* Parses an IF clause for LOOP or END LOOP and stores the |
179 |
if (!ctl_stack || ctl_stack->type != CST_LOOP) |
resulting expression to *CONDITION. |
180 |
{ |
Returns true if successful, false on failure. */ |
181 |
msg (SE, _("There is no LOOP command that corresponds to this " |
static bool |
182 |
"END LOOP.")); |
parse_if_clause (struct loop_trns *loop, struct expression **condition) |
183 |
return 0; |
{ |
184 |
} |
*condition = expr_parse_pool (loop->pool, default_dict, EXPR_BOOLEAN); |
185 |
thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index; |
return *condition != NULL; |
186 |
|
} |
187 |
|
|
188 |
/* Parse the expression if any. */ |
/* Parses an indexing clause into LOOP. |
189 |
if (lex_match_id ("IF")) |
Stores the index variable's name in INDEX_VAR_NAME[]. |
190 |
|
Returns true if successful, false on failure. */ |
191 |
|
static bool |
192 |
|
parse_index_clause (struct loop_trns *loop, char index_var_name[]) |
193 |
|
{ |
194 |
|
if (token != T_ID) |
195 |
{ |
{ |
196 |
thr->cond = expr_parse (default_dict, EXPR_BOOLEAN); |
lex_error (NULL); |
197 |
if (!thr->cond) |
return false; |
|
return 0; |
|
198 |
} |
} |
199 |
|
strcpy (index_var_name, tokid); |
200 |
|
lex_get (); |
201 |
|
|
202 |
add_transformation ((struct trns_header *) thr); |
if (!lex_force_match ('=')) |
203 |
|
return false; |
|
/* Backpatch. */ |
|
|
((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns; |
|
|
for (brk = ctl_stack->brk; brk; brk = brk->next) |
|
|
brk->loop_term = n_trns; |
|
204 |
|
|
205 |
/* Pop off the top of stack. */ |
loop->first_expr = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER); |
206 |
ctl_stack = ctl_stack->down; |
if (loop->first_expr == NULL) |
207 |
|
return false; |
|
return 1; |
|
|
} |
|
|
|
|
|
/* Performs transformation 1. */ |
|
|
static int |
|
|
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; |
|
208 |
|
|
209 |
two->pass = -1; |
for (;;) |
|
if (two->flags & LPC_INDEX) |
|
210 |
{ |
{ |
211 |
double t1, t2, t3; |
struct expression **e; |
212 |
|
if (lex_match (T_TO)) |
213 |
t1 = expr_evaluate_num (one->init, c, case_num); |
e = &loop->last_expr; |
214 |
if (one->incr) |
else if (lex_match (T_BY)) |
215 |
t2 = expr_evaluate_num (one->incr, c, case_num); |
e = &loop->by_expr; |
216 |
else |
else |
217 |
t2 = 1.0; |
break; |
|
t3 = expr_evaluate_num (one->term, c, case_num); |
|
218 |
|
|
219 |
/* Even if the loop is never entered, force the index variable |
if (*e != NULL) |
220 |
to assume the initial value. */ |
{ |
221 |
case_data_rw (c, two->index->fv)->f = t1; |
lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY"); |
222 |
|
return false; |
223 |
/* Throw out various pathological cases. */ |
} |
224 |
if (!finite (t1) || !finite (t2) || !finite (t3) || t2 == 0.0) |
*e = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER); |
225 |
return two->loop_term; |
if (*e == NULL) |
226 |
debug_printf (("LOOP %s=%g TO %g BY %g.\n", two->index->name, |
return false; |
227 |
t1, t3, t2)); |
} |
228 |
if (t2 > 0.0) |
if (loop->last_expr == NULL) |
229 |
{ |
{ |
230 |
/* Loop counts upward: I=1 TO 5 BY 1. */ |
lex_sbc_missing ("TO"); |
231 |
two->flags &= ~LPC_RINDEX; |
return false; |
|
|
|
|
/* incr>0 but init>term */ |
|
|
if (t1 > t3) |
|
|
return two->loop_term; |
|
|
} |
|
|
else |
|
|
{ |
|
|
/* Loop counts downward: I=5 TO 1 BY -1. */ |
|
|
two->flags |= LPC_RINDEX; |
|
|
|
|
|
/* incr<0 but init<term */ |
|
|
if (t1 < t3) |
|
|
return two->loop_term; |
|
|
} |
|
|
|
|
|
two->curr = t1; |
|
|
two->incr = t2; |
|
|
two->term = t3; |
|
232 |
} |
} |
233 |
|
if (loop->by_expr == NULL) |
234 |
|
loop->by = 1.0; |
235 |
|
|
236 |
return -1; |
return true; |
237 |
} |
} |
238 |
|
|
239 |
/* Frees transformation 1. */ |
/* Creates, initializes, and returns a new loop_trns. */ |
240 |
static void |
static struct loop_trns * |
241 |
loop_1_trns_free (struct trns_header * trns) |
create_loop_trns (void) |
242 |
{ |
{ |
243 |
struct loop_1_trns *one = (struct loop_1_trns *) trns; |
struct loop_trns *loop = pool_create_container (struct loop_trns, pool); |
244 |
|
loop->max_pass_count = -1; |
245 |
|
loop->pass = 0; |
246 |
|
loop->index_var = NULL; |
247 |
|
loop->first_expr = loop->by_expr = loop->last_expr = NULL; |
248 |
|
loop->loop_condition = loop->end_loop_condition = NULL; |
249 |
|
|
250 |
|
add_transformation (loop_trns_proc, loop_trns_free, loop); |
251 |
|
loop->past_LOOP_index = next_transformation (); |
252 |
|
|
253 |
|
ctl_stack_push (&loop_class, loop); |
254 |
|
|
255 |
expr_free (one->init); |
return loop; |
|
expr_free (one->incr); |
|
|
expr_free (one->term); |
|
256 |
} |
} |
257 |
|
|
258 |
/* Performs transformation 2. */ |
/* Sets up LOOP for the first pass. */ |
259 |
static int |
static int |
260 |
loop_2_trns_proc (struct trns_header * trns, struct ccase * c, |
loop_trns_proc (void *loop_, struct ccase *c, int case_num) |
|
int case_num UNUSED) |
|
261 |
{ |
{ |
262 |
struct loop_2_trns *two = (struct loop_2_trns *) trns; |
struct loop_trns *loop = loop_; |
263 |
|
|
264 |
/* MXLOOPS limiter. */ |
if (loop->index_var != NULL) |
|
if (two->flags == 0) |
|
265 |
{ |
{ |
266 |
two->pass++; |
/* Evaluate loop index expressions. */ |
267 |
if (two->pass > get_mxloops() ) |
loop->cur = expr_evaluate_num (loop->first_expr, c, case_num); |
268 |
return two->loop_term; |
if (loop->by_expr != NULL) |
269 |
} |
loop->by = expr_evaluate_num (loop->by_expr, c, case_num); |
270 |
|
loop->last = expr_evaluate_num (loop->last_expr, c, case_num); |
271 |
|
|
272 |
/* Indexing clause limiter: counting downward. */ |
/* Even if the loop is never entered, set the index |
273 |
if (two->flags & LPC_RINDEX) |
variable to the initial value. */ |
274 |
{ |
case_data_rw (c, loop->index_var->fv)->f = loop->cur; |
|
/* Test if we're at the end of the looping. */ |
|
|
if (two->curr < two->term) |
|
|
return two->loop_term; |
|
275 |
|
|
276 |
/* Set the current value into the case. */ |
/* Throw out pathological cases. */ |
277 |
case_data_rw (c, two->index->fv)->f = two->curr; |
if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last) |
278 |
|
|| loop->by == 0.0 |
279 |
/* Decrement the current value. */ |
|| (loop->by > 0.0 && loop->cur > loop->last) |
280 |
two->curr += two->incr; |
|| (loop->by < 0.0 && loop->cur < loop->last)) |
281 |
|
goto zero_pass; |
282 |
} |
} |
|
/* Indexing clause limiter: counting upward. */ |
|
|
else if (two->flags & LPC_INDEX) |
|
|
{ |
|
|
/* Test if we're at the end of the looping. */ |
|
|
if (two->curr > two->term) |
|
|
return two->loop_term; |
|
283 |
|
|
284 |
/* Set the current value into the case. */ |
/* Initialize pass count. */ |
285 |
case_data_rw (c, two->index->fv)->f = two->curr; |
loop->pass = 0; |
286 |
|
if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count) |
287 |
|
goto zero_pass; |
288 |
|
|
289 |
/* Increment the current value. */ |
/* Check condition. */ |
290 |
two->curr += two->incr; |
if (loop->loop_condition != NULL |
291 |
} |
&& expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0) |
292 |
|
goto zero_pass; |
293 |
|
|
294 |
/* Conditional clause limiter. */ |
return loop->past_LOOP_index; |
|
if ((two->flags & LPC_COND) |
|
|
&& expr_evaluate_num (two->cond, c, case_num) != 1.0) |
|
|
return two->loop_term; |
|
295 |
|
|
296 |
return -1; |
zero_pass: |
297 |
|
return loop->past_END_LOOP_index; |
298 |
} |
} |
299 |
|
|
300 |
/* Frees transformation 2. */ |
/* Frees LOOP. */ |
301 |
static void |
static void |
302 |
loop_2_trns_free (struct trns_header * trns) |
loop_trns_free (void *loop_) |
303 |
{ |
{ |
304 |
struct loop_2_trns *two = (struct loop_2_trns *) trns; |
struct loop_trns *loop = loop_; |
305 |
|
|
306 |
expr_free (two->cond); |
pool_destroy (loop->pool); |
307 |
} |
} |
308 |
|
|
309 |
/* Performs transformation 3. */ |
/* Finishes a pass through the loop and starts the next. */ |
310 |
static int |
static int |
311 |
loop_3_trns_proc (struct trns_header * trns, struct ccase * c, |
end_loop_trns_proc (void *loop_, struct ccase *c, int case_num UNUSED) |
|
int case_num) |
|
312 |
{ |
{ |
313 |
struct loop_3_trns *thr = (struct loop_3_trns *) trns; |
struct loop_trns *loop = loop_; |
314 |
|
|
315 |
/* Note that it breaks out of the loop if the expression is true *or |
if (loop->end_loop_condition != NULL |
316 |
missing*. This is conformant. */ |
&& expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0) |
317 |
if (thr->cond && expr_evaluate_num (two->cond, c, case_num) != 0.0) |
goto break_out; |
|
return -1; |
|
318 |
|
|
319 |
return thr->loop_start; |
/* MXLOOPS limiter. */ |
320 |
} |
if (loop->max_pass_count >= 0) |
321 |
|
{ |
322 |
/* Frees transformation 3. */ |
if (loop->pass >= loop->max_pass_count) |
323 |
static void |
goto break_out; |
324 |
loop_3_trns_free (struct trns_header * trns) |
loop->pass++; |
325 |
{ |
} |
|
struct loop_3_trns *thr = (struct loop_3_trns *) trns; |
|
|
|
|
|
expr_free (thr->cond); |
|
|
} |
|
|
|
|
|
/* BREAK. */ |
|
|
|
|
|
/* Parses the BREAK command. */ |
|
|
int |
|
|
cmd_break (void) |
|
|
{ |
|
|
/* Climbs down the stack to find a LOOP. */ |
|
|
struct ctl_stmt *loop; |
|
|
|
|
|
/* New transformation. */ |
|
|
struct break_trns *t; |
|
326 |
|
|
327 |
for (loop = ctl_stack; loop; loop = loop->down) |
/* Indexing clause limiter: counting downward. */ |
328 |
if (loop->type == CST_LOOP) |
if (loop->index_var != NULL) |
|
break; |
|
|
if (!loop) |
|
329 |
{ |
{ |
330 |
msg (SE, _("This command may only appear enclosed in a LOOP/" |
loop->cur += loop->by; |
331 |
"END LOOP control structure.")); |
if ((loop->by > 0.0 && loop->cur > loop->last) |
332 |
return CMD_FAILURE; |
|| (loop->by < 0.0 && loop->cur < loop->last)) |
333 |
|
goto break_out; |
334 |
|
case_data_rw (c, loop->index_var->fv)->f = loop->cur; |
335 |
} |
} |
|
|
|
|
if (ctl_stack->type != CST_DO_IF) |
|
|
msg (SW, _("BREAK not enclosed in DO IF structure.")); |
|
336 |
|
|
337 |
t = xmalloc (sizeof *t); |
if (loop->loop_condition != NULL |
338 |
t->h.proc = break_trns_proc; |
&& expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0) |
339 |
t->h.free = NULL; |
goto break_out; |
|
t->next = loop->brk; |
|
|
loop->brk = t; |
|
|
add_transformation ((struct trns_header *) t); |
|
340 |
|
|
341 |
return lex_end_of_command (); |
return loop->past_LOOP_index; |
342 |
|
|
343 |
|
break_out: |
344 |
|
return loop->past_END_LOOP_index; |
345 |
} |
} |
346 |
|
|
347 |
|
/* Executes BREAK. */ |
348 |
static int |
static int |
349 |
break_trns_proc (struct trns_header * trns, struct ccase * c UNUSED, |
break_trns_proc (void *loop_, struct ccase *c UNUSED, int case_num UNUSED) |
|
int case_num UNUSED) |
|
350 |
{ |
{ |
351 |
return ((struct break_trns *) trns)->loop_term; |
struct loop_trns *loop = loop_; |
|
} |
|
|
|
|
|
/* Control stack operations. */ |
|
352 |
|
|
353 |
/* Pops the top of stack element off of ctl_stack. Does not |
return loop->past_END_LOOP_index; |
|
check that ctl_stack is indeed non-NULL. */ |
|
|
static void |
|
|
pop_ctl_stack (void) |
|
|
{ |
|
|
switch (ctl_stack->type) |
|
|
{ |
|
|
case CST_LOOP: |
|
|
{ |
|
|
/* Pointer for chasing down and backpatching BREAKs. */ |
|
|
struct break_trns *brk; |
|
|
|
|
|
/* Terminate the loop. */ |
|
|
thr = xmalloc (sizeof *thr); |
|
|
thr->h.proc = loop_3_trns_proc; |
|
|
thr->h.free = loop_3_trns_free; |
|
|
thr->cond = NULL; |
|
|
thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index; |
|
|
add_transformation ((struct trns_header *) thr); |
|
|
|
|
|
/* Backpatch. */ |
|
|
((struct loop_2_trns *) ctl_stack->trns)->loop_term = n_trns; |
|
|
for (brk = ctl_stack->brk; brk; brk = brk->next) |
|
|
brk->loop_term = n_trns; |
|
|
} |
|
|
break; |
|
|
case CST_DO_IF: |
|
|
{ |
|
|
/* List iterator. */ |
|
|
struct do_if_trns *iter; |
|
|
|
|
|
iter = ((struct do_if_trns *) ctl_stack->trns); |
|
|
for (;;) |
|
|
{ |
|
|
if (iter->brk) |
|
|
iter->brk->dest = n_trns; |
|
|
iter->missing_jump = n_trns; |
|
|
if (iter->next) |
|
|
iter = iter->next; |
|
|
else |
|
|
break; |
|
|
} |
|
|
iter->false_jump = n_trns; |
|
|
} |
|
|
break; |
|
|
default: |
|
|
assert (0); |
|
|
} |
|
|
ctl_stack = ctl_stack->down; |
|
354 |
} |
} |
355 |
|
|
356 |
/* Checks for unclosed LOOPs and DO IFs and closes them out. */ |
/* LOOP control structure class definition. */ |
357 |
void |
static struct ctl_class loop_class = |
358 |
discard_ctl_stack (void) |
{ |
359 |
{ |
"LOOP", |
360 |
if (!ctl_stack) |
"END LOOP", |
361 |
return; |
close_loop, |
362 |
msg (SE, _("%s without %s."), ctl_stack->type == CST_LOOP ? "LOOP" : "DO IF", |
}; |
|
ctl_stack->type == CST_LOOP ? "END LOOP" : "END IF"); |
|
|
while (ctl_stack) |
|
|
pop_ctl_stack (); |
|
|
ctl_stack = NULL; |
|
|
} |
|