[Pspp-cvs] Changes to pspp/src/loop.c

[Ben Pfaff]

Index: pspp/src/loop.c
diff -u pspp/src/loop.c:1.20 pspp/src/loop.c:1.21
--- pspp/src/loop.c:1.20        Sun Jul 31 21:42:46 2005
+++ pspp/src/loop.c     Thu Nov  3 06:21:46 2005
@@ -23,11 +23,12 @@
 #include "case.h"
 #include "command.h"
 #include "dictionary.h"
-#include "do-ifP.h"
+#include "ctl-stack.h"
 #include "error.h"
 #include "expressions/public.h"
 #include "lexer.h"
 #include "misc.h"
+#include "pool.h"
 #include "settings.h"
 #include "str.h"
 #include "var.h"
@@ -35,552 +36,327 @@
 #include "gettext.h"
 #define _(msgid) gettext (msgid)
 
-#include "debug-print.h"
+/* LOOP outputs a transformation that is executed only on the
+   first pass through the loop.  On this trip, it initializes for
+   the first pass by resetting the pass number, setting up the
+   indexing clause, and testing the LOOP IF clause.  If the loop
+   is not to be entered at all, it jumps forward just past the
+   END LOOP transformation; otherwise, it continues to the
+   transformation following LOOP.
+
+   END LOOP outputs a transformation that executes at the end of
+   each trip through the loop.  It checks the END LOOP IF clause,
+   then updates the pass number, increments the indexing clause,
+   and tests the LOOP IF clause.  If another pass through the
+   loop is due, it jumps backward to just after the LOOP
+   transformation; otherwise, it continues to the transformation
+   following END LOOP. */
 
-/* LOOP strategy:
-
-   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
+struct loop_trns
   {
-    struct trns_header h;
+    struct pool *pool;
 
-    struct loop_2_trns *two;   /* Allows modification of associated
-                                  second transformation. */
-
-    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. */
+    /* Iteration limit. */
+    int max_pass_count;         /* Maximum number of passes (-1=unlimited). */
     int pass;                  /* Number of passes thru the loop so far. */
 
-    struct variable *index;    /* Index variable. */
-    double curr;               /* Current index. */
-    double incr;               /* Increment. */
-    double term;               /* Terminal index. */
-
-    struct expression *cond;   /* Optional IF condition when non-NULL. */
-
-    int loop_term;             /* 1+(t_trns[] index of transformation 3);
-                                  backpatched in by END LOOP. */
+    /* a=a TO b [BY c]. */
+    struct variable *index_var; /* Index variable. */
+    struct expression *first_expr; /* Starting index. */
+    struct expression *by_expr;        /* Index increment (default 1.0 if 
null). */
+    struct expression *last_expr; /* Terminal index. */
+    double cur, by, last;       /* Current value, increment, last value. */
+
+    /* IF condition for LOOP or END LOOP. */
+    struct expression *loop_condition;
+    struct expression *end_loop_condition;
+
+    /* Transformation indexes. */
+    int past_LOOP_index;        /* Just past LOOP transformation. */
+    int past_END_LOOP_index;    /* Just past END LOOP transformation. */
   };
 
-/* LOOP transformation 3.  (Actually output by END LOOP.)  */
-struct loop_3_trns
-  {
-    struct trns_header h;
-
-    struct expression *cond;   /* Optional IF condition when non-NULL. */
+static struct ctl_class loop_class;
 
-    int loop_start;            /* t_trns[] index of transformation 2. */
-  };
+static trns_proc_func loop_trns_proc, end_loop_trns_proc, break_trns_proc;
+static trns_free_func loop_trns_free;
 
-/* LOOP transformations being created. */
-static struct loop_1_trns *one;
-static struct loop_2_trns *two;
-static struct loop_3_trns *thr;
-
-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);
+static struct loop_trns *create_loop_trns (void);
+static bool parse_if_clause (struct loop_trns *, struct expression **);
+static bool parse_index_clause (struct loop_trns *, char index_var_name[]);
+static void close_loop (void *);
 
 /* LOOP. */
 
-/* Parses a LOOP command.  Passes the real work off to
-   internal_cmd_loop(). */
+/* Parses LOOP. */
 int
 cmd_loop (void)
 {
-  if (!internal_cmd_loop ())
+  struct loop_trns *loop;
+  char index_var_name[LONG_NAME_LEN + 1];
+  bool ok = true;
+
+  loop = create_loop_trns ();
+  while (token != '.' && ok) 
     {
-      loop_1_trns_free ((struct trns_header *) one);
-      loop_2_trns_free ((struct trns_header *) two);
-      return CMD_FAILURE;
+      if (lex_match_id ("IF")) 
+        ok = parse_if_clause (loop, &loop->loop_condition);
+      else
+        ok = parse_index_clause (loop, index_var_name);
     }
 
-  return CMD_SUCCESS;
+  /* Find index variable and create if necessary. */
+  if (ok && index_var_name[0] != '\0')
+    {
+      loop->index_var = dict_lookup_var (default_dict, index_var_name);
+      if (loop->index_var == NULL)
+        loop->index_var = dict_create_var (default_dict, index_var_name, 0);
+    }
+  
+  if (!ok)
+    loop->max_pass_count = 0;
+  return ok ? CMD_SUCCESS : CMD_PART_SUCCESS;
 }
 
-/* Parses a LOOP command, returns success. */
-static int
-internal_cmd_loop (void)
+/* Parses END LOOP. */
+int
+cmd_end_loop (void)
 {
-  /* Name of indexing variable if applicable. */
-  char name[LONG_NAME_LEN + 1];
-
-  /* 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';
+  struct loop_trns *loop;
+  bool ok = true;
 
-  /* Parse IF clause. */
+  loop = ctl_stack_top (&loop_class);
+  if (loop == NULL)
+    return CMD_FAILURE;
+  
+  /* Parse syntax. */
   if (lex_match_id ("IF"))
-    {
-      two->flags |= LPC_COND;
-
-      two->cond = expr_parse (default_dict, EXPR_BOOLEAN);
-      if (!two->cond)
-       return 0;
-    }
+    ok = parse_if_clause (loop, &loop->end_loop_condition);
+  if (ok)
+    ok = lex_end_of_command () == CMD_SUCCESS;
 
-  if (token != '.')
-    {
-      lex_error (_("expecting end of command"));
-      return 0;
-    }
+  if (!ok)
+    loop->max_pass_count = 0;
 
-  /* Find variable; create if necessary. */
-  if (name[0] != '\0')
-    {
-      two->index = dict_lookup_var (default_dict, name);
-      if (!two->index)
-        two->index = dict_create_var (default_dict, name, 0);
-    }
+  ctl_stack_pop (loop);
   
-  /* Push on control stack. */
-  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;
+  return ok ? CMD_SUCCESS : CMD_PART_SUCCESS;
 }
 
-/* Parses the END LOOP command by passing the buck off to
-   cmd_internal_end_loop(). */
+/* Parses BREAK. */
 int
-cmd_end_loop (void)
+cmd_break (void)
 {
-  if (!internal_cmd_end_loop ())
-    {
-      loop_3_trns_free ((struct trns_header *) thr);
-      if (ctl_stack && ctl_stack->type == CST_LOOP)
-       pop_ctl_stack ();
-      return CMD_FAILURE;
-    }
+  struct ctl_stmt *loop = ctl_stack_search (&loop_class);
+  if (loop == NULL)
+    return CMD_FAILURE;
+
+  add_transformation (break_trns_proc, NULL, loop);
 
-  return CMD_SUCCESS;
+  return lex_end_of_command ();
 }
 
-/* Parses the END LOOP command. */
-int
-internal_cmd_end_loop (void)
+/* Closes a LOOP construct by emitting the END LOOP
+   transformation and finalizing its members appropriately. */
+static void
+close_loop (void *loop_)
 {
-  /* Backpatch pointer for BREAK commands. */
-  struct break_trns *brk;
+  struct loop_trns *loop = loop_;
+  
+  add_transformation (end_loop_trns_proc, NULL, loop);
+  loop->past_END_LOOP_index = next_transformation ();
 
-  /* Allocate, initialize transformation to facilitate
-     error-handling. */
-  thr = xmalloc (sizeof *thr);
-  thr->h.proc = loop_3_trns_proc;
-  thr->h.free = loop_3_trns_free;
-  thr->cond = NULL;
+  /* If there's nothing else limiting the number of loops, use
+     MXLOOPS as a limit. */
+  if (loop->max_pass_count == -1
+      && loop->index_var == NULL
+      && loop->loop_condition == NULL
+      && loop->end_loop_condition == NULL)
+    loop->max_pass_count = get_mxloops ();
+}
 
-  /* There must be a matching LOOP command. */
-  if (!ctl_stack || ctl_stack->type != CST_LOOP)
-    {
-      msg (SE, _("There is no LOOP command that corresponds to this "
-                "END LOOP."));
-      return 0;
-    }
-  thr->loop_start = ((struct loop_2_trns *) ctl_stack->trns)->h.index;
+/* Parses an IF clause for LOOP or END LOOP and stores the
+   resulting expression to *CONDITION.
+   Returns true if successful, false on failure. */
+static bool
+parse_if_clause (struct loop_trns *loop, struct expression **condition) 
+{
+  *condition = expr_parse_pool (loop->pool, default_dict, EXPR_BOOLEAN);
+  return *condition != NULL;
+}
 
-  /* Parse the expression if any. */
-  if (lex_match_id ("IF"))
+/* Parses an indexing clause into LOOP.
+   Stores the index variable's name in INDEX_VAR_NAME[].
+   Returns true if successful, false on failure. */
+static bool
+parse_index_clause (struct loop_trns *loop, char index_var_name[]) 
+{
+  if (token != T_ID) 
     {
-      thr->cond = expr_parse (default_dict, EXPR_BOOLEAN);
-      if (!thr->cond)
-       return 0;
+      lex_error (NULL);
+      return false;
     }
+  strcpy (index_var_name, tokid);
+  lex_get ();
 
-  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;
+  if (!lex_force_match ('='))
+    return false;
 
-  /* Pop off the top of stack. */
-  ctl_stack = ctl_stack->down;
-
-  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;
+  loop->first_expr = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
+  if (loop->first_expr == NULL)
+    return false;
 
-  two->pass = -1;
-  if (two->flags & LPC_INDEX)
+  for (;;)
     {
-      double t1, t2, t3;
-
-      t1 = expr_evaluate_num (one->init, c, case_num);
-      if (one->incr)
-       t2 = expr_evaluate_num (one->incr, c, case_num);
+      struct expression **e;
+      if (lex_match (T_TO)) 
+        e = &loop->last_expr;
+      else if (lex_match (T_BY)) 
+        e = &loop->by_expr;
       else
-       t2 = 1.0;
-      t3 = expr_evaluate_num (one->term, c, case_num);
+        break;
 
-      /* Even if the loop is never entered, force the index variable
-         to assume the initial value. */
-      case_data_rw (c, two->index->fv)->f = t1;
-
-      /* Throw out various pathological cases. */
-      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, 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 (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;
+      if (*e != NULL) 
+        {
+          lex_sbc_only_once (e == &loop->last_expr ? "TO" : "BY");
+          return false;
+        }
+      *e = expr_parse_pool (loop->pool, default_dict, EXPR_NUMBER);
+      if (*e == NULL)
+        return false;
+    }
+  if (loop->last_expr == NULL) 
+    {
+      lex_sbc_missing ("TO");
+      return false;
     }
+  if (loop->by_expr == NULL)
+    loop->by = 1.0;
 
-  return -1;
+  return true;
 }
 
-/* Frees transformation 1. */
-static void
-loop_1_trns_free (struct trns_header * trns)
+/* Creates, initializes, and returns a new loop_trns. */
+static struct loop_trns *
+create_loop_trns (void) 
 {
-  struct loop_1_trns *one = (struct loop_1_trns *) trns;
+  struct loop_trns *loop = pool_create_container (struct loop_trns, pool);
+  loop->max_pass_count = -1;
+  loop->pass = 0;
+  loop->index_var = NULL;
+  loop->first_expr = loop->by_expr = loop->last_expr = NULL;
+  loop->loop_condition = loop->end_loop_condition = NULL;
+
+  add_transformation (loop_trns_proc, loop_trns_free, loop);
+  loop->past_LOOP_index = next_transformation ();
+
+  ctl_stack_push (&loop_class, loop);
 
-  expr_free (one->init);
-  expr_free (one->incr);
-  expr_free (one->term);
+  return loop;
 }
 
-/* Performs transformation 2. */
+/* Sets up LOOP for the first pass. */
 static int
-loop_2_trns_proc (struct trns_header * trns, struct ccase * c,
-                  int case_num UNUSED)
+loop_trns_proc (void *loop_, struct ccase *c, int case_num)
 {
-  struct loop_2_trns *two = (struct loop_2_trns *) trns;
+  struct loop_trns *loop = loop_;
 
-  /* MXLOOPS limiter. */
-  if (two->flags == 0)
+  if (loop->index_var != NULL)
     {
-      two->pass++;
-      if (two->pass > get_mxloops() )
-         return two->loop_term;
-    }
+      /* Evaluate loop index expressions. */
+      loop->cur = expr_evaluate_num (loop->first_expr, c, case_num);
+      if (loop->by_expr != NULL)
+       loop->by = expr_evaluate_num (loop->by_expr, c, case_num);
+      loop->last = expr_evaluate_num (loop->last_expr, c, case_num);
 
-  /* Indexing clause limiter: counting downward. */
-  if (two->flags & LPC_RINDEX)
-    {
-      /* Test if we're at the end of the looping. */
-      if (two->curr < two->term)
-       return two->loop_term;
+      /* Even if the loop is never entered, set the index
+         variable to the initial value. */
+      case_data_rw (c, loop->index_var->fv)->f = loop->cur;
 
-      /* Set the current value into the case. */
-      case_data_rw (c, two->index->fv)->f = two->curr;
-
-      /* Decrement the current value. */
-      two->curr += two->incr;
+      /* Throw out pathological cases. */
+      if (!finite (loop->cur) || !finite (loop->by) || !finite (loop->last)
+          || loop->by == 0.0
+          || (loop->by > 0.0 && loop->cur > loop->last)
+          || (loop->by < 0.0 && loop->cur < loop->last))
+        goto zero_pass;
     }
-  /* 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;
 
-      /* Set the current value into the case. */
-      case_data_rw (c, two->index->fv)->f = two->curr;
+  /* Initialize pass count. */
+  loop->pass = 0;
+  if (loop->max_pass_count >= 0 && loop->pass >= loop->max_pass_count)
+    goto zero_pass;
 
-      /* Increment the current value. */
-      two->curr += two->incr;
-    }
+  /* Check condition. */
+  if (loop->loop_condition != NULL
+      && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
+    goto zero_pass;
 
-  /* Conditional clause limiter. */
-  if ((two->flags & LPC_COND)
-      && expr_evaluate_num (two->cond, c, case_num) != 1.0)
-    return two->loop_term;
+  return loop->past_LOOP_index;
 
-  return -1;
+ zero_pass:
+  return loop->past_END_LOOP_index;
 }
 
-/* Frees transformation 2. */
+/* Frees LOOP. */
 static void
-loop_2_trns_free (struct trns_header * trns)
+loop_trns_free (void *loop_)
 {
-  struct loop_2_trns *two = (struct loop_2_trns *) trns;
+  struct loop_trns *loop = loop_;
 
-  expr_free (two->cond);
+  pool_destroy (loop->pool);
 }
 
-/* Performs transformation 3. */
+/* Finishes a pass through the loop and starts the next. */
 static int
-loop_3_trns_proc (struct trns_header * trns, struct ccase * c,
-                  int case_num)
+end_loop_trns_proc (void *loop_, struct ccase *c, int case_num UNUSED)
 {
-  struct loop_3_trns *thr = (struct loop_3_trns *) trns;
+  struct loop_trns *loop = loop_;
 
-  /* Note that it breaks out of the loop if the expression is true *or
-     missing*.  This is conformant. */
-  if (thr->cond && expr_evaluate_num (two->cond, c, case_num) != 0.0)
-    return -1;
+  if (loop->end_loop_condition != NULL
+      && expr_evaluate_num (loop->end_loop_condition, c, case_num) != 1.0)
+    goto break_out;
 
-  return thr->loop_start;
-}
-
-/* Frees transformation 3. */
-static void
-loop_3_trns_free (struct trns_header * trns)
-{
-  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;
+  /* MXLOOPS limiter. */
+  if (loop->max_pass_count >= 0)
+    {
+      if (loop->pass >= loop->max_pass_count)
+        goto break_out;
+      loop->pass++;
+    }
 
-  for (loop = ctl_stack; loop; loop = loop->down)
-    if (loop->type == CST_LOOP)
-      break;
-  if (!loop)
+  /* Indexing clause limiter: counting downward. */
+  if (loop->index_var != NULL) 
     {
-      msg (SE, _("This command may only appear enclosed in a LOOP/"
-                "END LOOP control structure."));
-      return CMD_FAILURE;
+      loop->cur += loop->by;
+      if ((loop->by > 0.0 && loop->cur > loop->last)
+          || (loop->by < 0.0 && loop->cur < loop->last))
+        goto break_out;
+      case_data_rw (c, loop->index_var->fv)->f = loop->cur;
     }
-  
-  if (ctl_stack->type != CST_DO_IF)
-    msg (SW, _("BREAK not enclosed in DO IF structure."));
 
-  t = xmalloc (sizeof *t);
-  t->h.proc = break_trns_proc;
-  t->h.free = NULL;
-  t->next = loop->brk;
-  loop->brk = t;
-  add_transformation ((struct trns_header *) t);
+  if (loop->loop_condition != NULL
+      && expr_evaluate_num (loop->loop_condition, c, case_num) != 1.0)
+    goto break_out;
 
-  return lex_end_of_command ();
+  return loop->past_LOOP_index;
+
+ break_out:
+  return loop->past_END_LOOP_index;
 }
 
+/* Executes BREAK. */
 static int
-break_trns_proc (struct trns_header * trns, struct ccase * c UNUSED,
-                 int case_num UNUSED)
+break_trns_proc (void *loop_, struct ccase *c UNUSED, int case_num UNUSED)
 {
-  return ((struct break_trns *) trns)->loop_term;
-}
-
-/* Control stack operations. */
+  struct loop_trns *loop = loop_;
 
-/* Pops the top of stack element off of ctl_stack.  Does not
-   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;
+  return loop->past_END_LOOP_index;
 }
 
-/* Checks for unclosed LOOPs and DO IFs and closes them out. */
-void
-discard_ctl_stack (void)
-{
-  if (!ctl_stack)
-    return;
-  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;
-}
+/* LOOP control structure class definition. */
+static struct ctl_class loop_class =
+  {
+    "LOOP",
+    "END LOOP",
+    close_loop,
+  };