Added coefficient-handling routines
[pspp-builds.git] / src / get.c
index 0f571d90468dcb62b634af6b428a5d1934d9423d..e47850c364919c2d4d01481112a443ab1f8b9da2 100644 (file)
--- a/src/get.c
+++ b/src/get.c
@@ -14,8 +14,8 @@
 
    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 "error.h"
@@ -40,6 +40,9 @@
 #include "vfm.h"
 #include "vfmP.h"
 
+#include "gettext.h"
+#define _(msgid) gettext (msgid)
+
 #include "debug-print.h"
 
 /* Rearranging and reducing a dictionary. */
@@ -57,8 +60,7 @@ enum operation
     OP_EXPORT   /* EXPORT. */
   };
 
-static bool trim_dictionary (struct dictionary *,
-                             enum operation, int *compress);
+static bool parse_dict_trim (struct dictionary *);
 \f
 /* GET input program. */
 struct get_pgm 
@@ -98,8 +100,14 @@ cmd_get (void)
   case_create (&pgm->bounce, dict_get_next_value_idx (dict));
 
   start_case_map (dict);
-  if (!trim_dictionary (dict, OP_READ, NULL))
-    goto error;
+  while (lex_match ('/'))
+    if (!parse_dict_trim (dict))
+      goto error;
+
+  if (!lex_end_of_command ())
+    return false;
+
+  dict_compact_values (dict);
   pgm->map = finish_case_map (dict);
 
   dict_destroy (default_dict);
@@ -111,7 +119,7 @@ cmd_get (void)
 
  error:
   get_pgm_free (pgm);
-  if (dict != NULL)
+  if (dict != NULL) 
     dict_destroy (dict);
   return CMD_FAILURE;
 }
@@ -172,298 +180,391 @@ const struct case_source_class get_source_class =
     get_source_destroy,
   };
 \f
-/* XSAVE transformation and SAVE procedure. */
-struct save_trns
+/* Type of output file. */
+enum writer_type
   {
-    struct trns_header h;
-    struct sfm_writer *writer;  /* System file writer. */
-    struct case_map *map;       /* Map from active file to system file dict. */
-    struct ccase bounce;        /* Bounce buffer. */
+    SYSFILE_WRITER,     /* System file. */
+    PORFILE_WRITER      /* Portable file. */
+  };
+
+/* Type of a command. */
+enum command_type 
+  {
+    XFORM_CMD,          /* Transformation. */
+    PROC_CMD            /* Procedure. */
   };
 
-static int save_write_case_func (struct ccase *, void *);
-static trns_proc_func save_trns_proc;
-static trns_free_func save_trns_free;
+/* Portable or system file writer plus a case map. */
+struct any_writer
+  {
+    enum writer_type writer_type;
+    void *writer;
+    struct case_map *map;       /* Map to output file dictionary
+                                   (null pointer for identity mapping). */
+    struct ccase bounce;        /* Bounce buffer for mapping (if needed). */
+  };
 
-/* Parses the SAVE or XSAVE command
-   and returns the parsed transformation. */
-static struct save_trns *
-cmd_save_internal (void)
+/* Destroys AW. */
+static void
+any_writer_destroy (struct any_writer *aw)
 {
-  struct file_handle *fh = NULL;
-  struct dictionary *dict = NULL;
-  struct save_trns *t = NULL;
-  int compress = get_scompression ();
-  const int default_version = 3;
-  int version = default_version;
-  short no_name_table = 0;
-
-  t = xmalloc (sizeof *t);
-  t->h.proc = save_trns_proc;
-  t->h.free = save_trns_free;
-  t->writer = NULL;
-  t->map = NULL;
-  case_nullify (&t->bounce);
-  
+  if (aw != NULL) 
+    {
+      switch (aw->writer_type) 
+        {
+        case PORFILE_WRITER:
+          pfm_close_writer (aw->writer);
+          break;
+        case SYSFILE_WRITER:
+          sfm_close_writer (aw->writer);
+          break;
+        }
+      destroy_case_map (aw->map);
+      case_destroy (&aw->bounce);
+      free (aw);
+    }
+}
+
+/* Parses SAVE or XSAVE or EXPORT or XEXPORT command.
+   WRITER_TYPE identifies the type of file to write,
+   and COMMAND_TYPE identifies the type of command.
+
+   On success, returns a writer.
+   For procedures only, sets *RETAIN_UNSELECTED to true if cases
+   that would otherwise be excluded by FILTER or USE should be
+   included.
+
+   On failure, returns a null pointer. */
+static struct any_writer *
+parse_write_command (enum writer_type writer_type,
+                     enum command_type command_type,
+                     bool *retain_unselected)
+{
+  /* Common data. */
+  struct file_handle *handle; /* Output file. */
+  struct dictionary *dict;    /* Dictionary for output file. */
+  struct any_writer *aw;      /* Writer. */  
+
+  /* Common options. */
+  bool print_map;             /* Print map?  TODO. */
+  bool print_short_names;     /* Print long-to-short name map.  TODO. */
+  struct sfm_write_options sysfile_opts;
+  struct pfm_write_options porfile_opts;
+
+  assert (writer_type == SYSFILE_WRITER || writer_type == PORFILE_WRITER);
+  assert (command_type == XFORM_CMD || command_type == PROC_CMD);
+  assert ((retain_unselected != NULL) == (command_type == PROC_CMD));
+
+  if (command_type == PROC_CMD)
+    *retain_unselected = true;
+
+  handle = NULL;
+  dict = dict_clone (default_dict);
+  aw = xmalloc (sizeof *aw);
+  aw->writer_type = writer_type;
+  aw->writer = NULL;
+  aw->map = NULL;
+  case_nullify (&aw->bounce);
+  print_map = false;
+  print_short_names = false;
+  sysfile_opts = sfm_writer_default_options ();
+  porfile_opts = pfm_writer_default_options ();
+
+  start_case_map (dict);
+  dict_delete_scratch_vars (dict);
 
-  /* Read most of the subcommands. */
+  lex_match ('/');
   for (;;)
     {
-      if (lex_match_id ("VERSION"))
+      if (lex_match_id ("OUTFILE"))
        {
+          if (handle != NULL) 
+            {
+              lex_sbc_only_once ("OUTFILE");
+              goto error; 
+            }
+          
          lex_match ('=');
-         if ( lex_force_num() ) 
-           {
-             lex_get();
-             version = tokval;
-             
-             if ( 0 == strncasecmp (tokid,"x", 1) ) 
-               {
-                 lex_get();
-                 no_name_table = 1;
-               }
-
-           }
+      
+         handle = fh_parse ();
+         if (handle == NULL)
+           goto error;
        }
-      else if (lex_match_id ("OUTFILE"))
+      else if (lex_match_id ("NAMES"))
+        print_short_names = true;
+      else if (lex_match_id ("PERMISSIONS")) 
+        {
+          bool cw;
+          
+          lex_match ('=');
+          if (lex_match_id ("READONLY"))
+            cw = false;
+          else if (lex_match_id ("WRITEABLE"))
+            cw = true;
+          else
+            {
+              lex_error (_("expecting %s or %s"), "READONLY", "WRITEABLE");
+              goto error;
+            }
+          sysfile_opts.create_writeable = porfile_opts.create_writeable = cw;
+        }
+      else if (command_type == PROC_CMD && lex_match_id ("UNSELECTED")) 
+        {
+          lex_match ('=');
+          if (lex_match_id ("RETAIN"))
+            *retain_unselected = true;
+          else if (lex_match_id ("DELETE"))
+            *retain_unselected = false;
+          else
+            {
+              lex_error (_("expecting %s or %s"), "RETAIN", "DELETE");
+              goto error;
+            }
+        }
+      else if (writer_type == SYSFILE_WRITER && lex_match_id ("COMPRESSED"))
+       sysfile_opts.compress = true;
+      else if (writer_type == SYSFILE_WRITER && lex_match_id ("UNCOMPRESSED"))
+       sysfile_opts.compress = false;
+      else if (writer_type == SYSFILE_WRITER && lex_match_id ("VERSION"))
        {
          lex_match ('=');
-      
-         fh = fh_parse ();
-         if (fh == NULL)
-           goto error;
-
+         if (!lex_force_int ())
+            goto error;
+          sysfile_opts.version = lex_integer ();
+          lex_get ();
        }
-      if ( ! lex_match('/')  ) 
+      else if (writer_type == PORFILE_WRITER && lex_match_id ("TYPE")) 
+        {
+          lex_match ('=');
+          if (lex_match_id ("COMMUNICATIONS"))
+            porfile_opts.type = PFM_COMM;
+          else if (lex_match_id ("TAPE"))
+            porfile_opts.type = PFM_TAPE;
+          else
+            {
+              lex_error (_("expecting %s or %s"), "COMM", "TAPE");
+              goto error;
+            }
+        }
+      else if (writer_type == PORFILE_WRITER && lex_match_id ("DIGITS")) 
+        {
+          lex_match ('=');
+          if (!lex_force_int ())
+            goto error;
+          porfile_opts.digits = lex_integer ();
+          lex_get ();
+        }
+      else if (!parse_dict_trim (dict))
+        goto error;
+      
+      if (!lex_match ('/'))
        break;
-
     }
+  if (lex_end_of_command () != CMD_SUCCESS)
+    goto error;
 
-  if (token != '.')
+  if (handle == NULL) 
     {
-      lex_error (_("expecting end of command"));
+      lex_sbc_missing ("OUTFILE");
       goto error;
     }
 
-  if ( fh == NULL ) 
-    {
-      msg ( ME, _("The required %s subcommand was not present"), "OUTFILE");
-      goto error;
-    }
+  dict_compact_values (dict);
+  aw->map = finish_case_map (dict);
+  if (aw->map != NULL)
+    case_create (&aw->bounce, dict_get_next_value_idx (dict));
 
-  if ( version != default_version )
+  switch (writer_type) 
     {
-      msg (MW, _("Unsupported sysfile version: %d. Using version %d instead."),
-          version, default_version);
-
-      version = default_version;
+    case SYSFILE_WRITER:
+      aw->writer = sfm_open_writer (handle, dict, sysfile_opts);
+      break;
+    case PORFILE_WRITER:
+      aw->writer = pfm_open_writer (handle, dict, porfile_opts);
+      break;
     }
 
-  dict = dict_clone (default_dict);
-  start_case_map (dict);
-  if (!trim_dictionary (dict, OP_SAVE, &compress))
-    goto error;
-  t->map = finish_case_map (dict);
-  if (t->map != NULL)
-    case_create (&t->bounce, dict_get_next_value_idx (dict));
-
-  t->writer = sfm_open_writer (fh, dict, compress, no_name_table);
-  if (t->writer == NULL)
-    goto error;
-
   dict_destroy (dict);
-
-  return t;
+  
+  return aw;
 
  error:
-  assert (t != NULL);
+  any_writer_destroy (aw);
   dict_destroy (dict);
-  save_trns_free (&t->h);
   return NULL;
 }
 
-/* Parses and performs the SAVE procedure. */
-int
-cmd_save (void)
+/* Writes case C to writer AW. */
+static void
+any_writer_write_case (struct any_writer *aw, struct ccase *c) 
 {
-  struct save_trns *t = cmd_save_internal ();
-  if (t != NULL) 
+  if (aw->map != NULL) 
     {
-      procedure (save_write_case_func, t);
-      save_trns_free (&t->h);
-      free(t);
-      return CMD_SUCCESS;
+      map_case (aw->map, c, &aw->bounce);
+      c = &aw->bounce; 
     }
-  else
+  
+  switch (aw->writer_type) 
+    {
+    case SYSFILE_WRITER:
+      sfm_write_case (aw->writer, c);
+      break;
+    case PORFILE_WRITER:
+      pfm_write_case (aw->writer, c);
+      break;
+    }
+}
+\f
+/* SAVE and EXPORT. */
+
+static int output_proc (struct ccase *, void *);
+
+/* Parses and performs the SAVE or EXPORT procedure. */
+static int
+parse_output_proc (enum writer_type writer_type)
+{
+  bool retain_unselected;
+  struct variable *saved_filter_variable;
+  struct any_writer *aw;
+
+  aw = parse_write_command (writer_type, PROC_CMD, &retain_unselected);
+  if (aw == NULL) 
     return CMD_FAILURE;
+
+  saved_filter_variable = dict_get_filter (default_dict);
+  if (retain_unselected) 
+    dict_set_filter (default_dict, NULL);
+  procedure (output_proc, aw);
+  dict_set_filter (default_dict, saved_filter_variable);
+
+  any_writer_destroy (aw);
+  return CMD_SUCCESS;
+}
+
+/* Writes case C to file. */
+static int
+output_proc (struct ccase *c, void *aw_) 
+{
+  struct any_writer *aw = aw_;
+  any_writer_write_case (aw, c);
+  return 0;
 }
 
-/* Parses the XSAVE transformation command. */
 int
-cmd_xsave (void)
+cmd_save (void) 
 {
-  struct save_trns *t = cmd_save_internal ();
-  if (t != NULL) 
-    {
-      add_transformation (&t->h);
-      return CMD_SUCCESS; 
-    }
-  else
-    return CMD_FAILURE;
+  return parse_output_proc (SYSFILE_WRITER);
 }
 
-/* Writes the given C to the file specified by T. */
-static void
-do_write_case (struct save_trns *t, struct ccase *c) 
+int
+cmd_export (void) 
 {
-  if (t->map == NULL)
-    sfm_write_case (t->writer, c);
-  else 
-    {
-      map_case (t->map, c, &t->bounce);
-      sfm_write_case (t->writer, &t->bounce);
-    }
+  return parse_output_proc (PORFILE_WRITER);
 }
+\f
+/* XSAVE and XEXPORT. */
+
+/* Transformation. */
+struct output_trns 
+  {
+    struct any_writer *aw;      /* Writer. */
+  };
+
+static trns_proc_func output_trns_proc;
+static trns_free_func output_trns_free;
 
-/* Writes case C to the system file specified on SAVE. */
+/* Parses the XSAVE or XEXPORT transformation command. */
 static int
-save_write_case_func (struct ccase *c, void *aux UNUSED)
+parse_output_trns (enum writer_type writer_type) 
 {
-  do_write_case (aux, c);
-  return 1;
+  struct output_trns *t = xmalloc (sizeof *t);
+  t->aw = parse_write_command (writer_type, XFORM_CMD, NULL);
+  if (t->aw == NULL) 
+    {
+      free (t);
+      return CMD_FAILURE;
+    }
+
+  add_transformation (output_trns_proc, output_trns_free, t);
+  return CMD_SUCCESS;
 }
 
-/* Writes case C to the system file specified on XSAVE. */
+/* Writes case C to the system file specified on XSAVE or XEXPORT. */
 static int
-save_trns_proc (struct trns_header *h, struct ccase *c, int case_num UNUSED)
+output_trns_proc (void *trns_, struct ccase *c, int case_num UNUSED)
 {
-  struct save_trns *t = (struct save_trns *) h;
-  do_write_case (t, c);
+  struct output_trns *t = trns_;
+  any_writer_write_case (t->aw, c);
   return -1;
 }
 
-/* Frees a SAVE transformation. */
+/* Frees an XSAVE or XEXPORT transformation. */
 static void
-save_trns_free (struct trns_header *t_)
+output_trns_free (void *trns_)
 {
-  struct save_trns *t = (struct save_trns *) t_;
+  struct output_trns *t = trns_;
 
-  if (t != NULL) 
+  if (t != NULL)
     {
-      sfm_close_writer (t->writer);
-      destroy_case_map (t->map);
-      case_destroy (&t->bounce);
+      any_writer_destroy (t->aw);
+      free (t);
     }
 }
 
-static int rename_variables (struct dictionary *dict);
+/* XSAVE command. */
+int
+cmd_xsave (void) 
+{
+  return parse_output_trns (SYSFILE_WRITER);
+}
+
+/* XEXPORT command. */
+int
+cmd_xexport (void) 
+{
+  return parse_output_trns (PORFILE_WRITER);
+}
+\f
+static bool rename_variables (struct dictionary *dict);
+static bool drop_variables (struct dictionary *dict);
+static bool keep_variables (struct dictionary *dict);
 
 /* Commands that read and write system files share a great deal
    of common syntactic structure for rearranging and dropping
    variables.  This function parses this syntax and modifies DICT
-   appropriately.
-
-   OP is the operation being performed.  For operations that
-   write a system file, *COMPRESS is set to 1 if the system file
-   should be compressed, 0 otherwise.
-   
-   Returns true on success, false on failure. */
+   appropriately.  Returns true on success, false on failure. */
 static bool
-trim_dictionary (struct dictionary *dict, enum operation op, int *compress)
+parse_dict_trim (struct dictionary *dict)
 {
-  assert ((compress != NULL) == (op == OP_SAVE));
-  if (get_scompression())
-    *compress = 1;
-
-  if (op == OP_SAVE || op == OP_EXPORT)
+  if (lex_match_id ("MAP")) 
     {
-      /* Delete all the scratch variables. */
-      struct variable **v;
-      size_t nv;
-      size_t i;
-
-      v = xmalloc (sizeof *v * dict_get_var_cnt (dict));
-      nv = 0;
-      for (i = 0; i < dict_get_var_cnt (dict); i++) 
-        if (dict_class_from_id (dict_get_var (dict, i)->name) == DC_SCRATCH)
-          v[nv++] = dict_get_var (dict, i);
-      dict_delete_vars (dict, v, nv);
-      free (v);
+      /* FIXME. */
+      return true;
     }
-  
-  while (lex_match ('/'))
+  else if (lex_match_id ("DROP"))
+    return drop_variables (dict);
+  else if (lex_match_id ("KEEP"))
+    return keep_variables (dict);
+  else if (lex_match_id ("RENAME"))
+    return rename_variables (dict);
+  else
     {
-      if (op == OP_SAVE && lex_match_id ("COMPRESSED"))
-       *compress = 1;
-      else if (op == OP_SAVE && lex_match_id ("UNCOMPRESSED"))
-       *compress = 0;
-      else if (lex_match_id ("DROP"))
-       {
-         struct variable **v;
-         int nv;
-
-         lex_match ('=');
-         if (!parse_variables (dict, &v, &nv, PV_NONE))
-           return false;
-          dict_delete_vars (dict, v, nv);
-          free (v);
-       }
-      else if (lex_match_id ("KEEP"))
-       {
-         struct variable **v;
-         int nv;
-          int i;
-
-         lex_match ('=');
-         if (!parse_variables (dict, &v, &nv, PV_NONE))
-           return false;
-
-          /* Move the specified variables to the beginning. */
-          dict_reorder_vars (dict, v, nv);
-          
-          /* Delete the remaining variables. */
-          v = xrealloc (v, (dict_get_var_cnt (dict) - nv) * sizeof *v);
-          for (i = nv; i < dict_get_var_cnt (dict); i++)
-            v[i - nv] = dict_get_var (dict, i);
-          dict_delete_vars (dict, v, dict_get_var_cnt (dict) - nv);
-          free (v);
-       }
-      else if (lex_match_id ("RENAME"))
-       {
-         if (!rename_variables (dict))
-           return false;
-       }
-      else
-       {
-         lex_error (_("while expecting a valid subcommand"));
-         return false;
-       }
-
-      if (dict_get_var_cnt (dict) == 0)
-       {
-         msg (SE, _("All variables deleted from system file dictionary."));
-         return false;
-       }
+      lex_error (_("expecting a valid subcommand"));
+      return false;
     }
-
-  if (!lex_end_of_command ())
-    return false;
-
-  dict_compact_values (dict);
-  return true;
 }
 
 /* Parses and performs the RENAME subcommand of GET and SAVE. */
-static int
+static bool
 rename_variables (struct dictionary *dict)
 {
-  int i;
+  size_t i;
 
   int success = 0;
 
   struct variable **v;
   char **new_names;
-  int nv, nn;
+  size_t nv, nn;
   char *err_name;
 
   int group;
@@ -479,8 +580,6 @@ rename_variables (struct dictionary *dict)
       if (!lex_force_match ('=')
          || !lex_force_id ())
        return 0;
-      if (!strncmp (tokid, v->name, SHORT_NAME_LEN))
-       return 1;
       if (dict_lookup_var (dict, tokid) != NULL)
        {
          msg (SE, _("Cannot rename %s as %s because there already exists "
@@ -502,7 +601,7 @@ rename_variables (struct dictionary *dict)
   group = 1;
   while (lex_match ('('))
     {
-      int old_nv = nv;
+      size_t old_nv = nv;
 
       if (!parse_variables (dict, &v, &nv, PV_NO_DUPLICATE | PV_APPEND))
        goto done;
@@ -516,9 +615,9 @@ rename_variables (struct dictionary *dict)
       if (nn != nv)
        {
          msg (SE, _("Number of variables on left side of `=' (%d) does not "
-              "match number of variables on right side (%d), in "
-              "parenthesized group %d of RENAME subcommand."),
-              nv - old_nv, nn - old_nv, group);
+                     "match number of variables on right side (%d), in "
+                     "parenthesized group %d of RENAME subcommand."),
+              (unsigned) (nv - old_nv), (unsigned) (nn - old_nv), group);
          goto done;
        }
       if (!lex_force_match (')'))
@@ -533,7 +632,7 @@ rename_variables (struct dictionary *dict)
     }
   success = 1;
 
-done:
+ done:
   for (i = 0; i < nn; i++)
     free (new_names[i]);
   free (new_names);
@@ -541,90 +640,53 @@ done:
 
   return success;
 }
-\f
-/* EXPORT procedure. */
-struct export_proc 
-  {
-    struct pfm_writer *writer;  /* System file writer. */
-    struct case_map *map;       /* Map from active file to system file dict. */
-    struct ccase bounce;        /* Bounce buffer. */
-  };
 
-static int export_write_case_func (struct ccase *, void *);
-static void export_proc_free (struct export_proc *);
-     
-/* Parses the EXPORT command.  */
-/* FIXME: same as cmd_save_internal(). */
-int
-cmd_export (void)
+/* Parses and performs the DROP subcommand of GET and SAVE.
+   Returns true if successful, false on failure.*/
+static bool
+drop_variables (struct dictionary *dict)
 {
-  struct file_handle *fh;
-  struct dictionary *dict;
-  struct export_proc *proc;
-
-  proc = xmalloc (sizeof *proc);
-  proc->writer = NULL;
-  proc->map = NULL;
-  case_nullify (&proc->bounce);
-
-  lex_match ('/');
-  if (lex_match_id ("OUTFILE"))
-    lex_match ('=');
-  fh = fh_parse ();
-  if (fh == NULL)
-    return CMD_FAILURE;
-
-  dict = dict_clone (default_dict);
-  start_case_map (dict);
-  if (!trim_dictionary (dict, OP_EXPORT, NULL))
-    goto error;
-  proc->map = finish_case_map (dict);
-  if (proc->map != NULL)
-    case_create (&proc->bounce, dict_get_next_value_idx (dict));
-
-  proc->writer = pfm_open_writer (fh, dict);
-  if (proc->writer == NULL)
-    goto error;
-  
-  dict_destroy (dict);
-
-  procedure (export_write_case_func, proc);
-  export_proc_free (proc);
-  free (proc);
-
-  return CMD_SUCCESS;
+  struct variable **v;
+  size_t nv;
 
- error:
-  dict_destroy (dict);
-  export_proc_free (proc);
-  free (proc);
-  return CMD_FAILURE;
-}
+  lex_match ('=');
+  if (!parse_variables (dict, &v, &nv, PV_NONE))
+    return false;
+  dict_delete_vars (dict, v, nv);
+  free (v);
 
-/* Writes case C to the EXPORT file. */
-static int
-export_write_case_func (struct ccase *c, void *aux) 
-{
-  struct export_proc *proc = aux;
-  if (proc->map == NULL)
-    pfm_write_case (proc->writer, c);
-  else 
+  if (dict_get_var_cnt (dict) == 0)
     {
-      map_case (proc->map, c, &proc->bounce);
-      pfm_write_case (proc->writer, &proc->bounce);
+      msg (SE, _("Cannot DROP all variables from dictionary."));
+      return false;
     }
-  return 1;
+  return true;
 }
 
-static void
-export_proc_free (struct export_proc *proc) 
+/* Parses and performs the KEEP subcommand of GET and SAVE.
+   Returns true if successful, false on failure.*/
+static bool
+keep_variables (struct dictionary *dict)
 {
-  if (proc != NULL) 
-    {
-      pfm_close_writer (proc->writer);
-      destroy_case_map (proc->map);
-      case_destroy (&proc->bounce);
-    }
+  struct variable **v;
+  size_t nv;
+  size_t i;
+
+  lex_match ('=');
+  if (!parse_variables (dict, &v, &nv, PV_NONE))
+    return false;
+
+  /* Move the specified variables to the beginning. */
+  dict_reorder_vars (dict, v, nv);
+          
+  /* Delete the remaining variables. */
+  v = xnrealloc (v, dict_get_var_cnt (dict) - nv, sizeof *v);
+  for (i = nv; i < dict_get_var_cnt (dict); i++)
+    v[i - nv] = dict_get_var (dict, i);
+  dict_delete_vars (dict, v, dict_get_var_cnt (dict) - nv);
+  free (v);
+
+  return true;
 }
 \f
 /* MATCH FILES. */
@@ -641,8 +703,7 @@ enum
 /* One of the files on MATCH FILES. */
 struct mtf_file
   {
-    struct mtf_file *next, *prev;
-                               /* Next, previous in the list of files. */
+    struct mtf_file *next, *prev; /* Next, previous in the list of files. */
     struct mtf_file *next_min; /* Next in the chain of minimums. */
     
     int type;                  /* One of MTF_*. */
@@ -650,7 +711,10 @@ struct mtf_file
     struct file_handle *handle; /* File handle. */
     struct sfm_reader *reader;  /* System file reader. */
     struct dictionary *dict;   /* Dictionary from system file. */
-    char in[SHORT_NAME_LEN + 1]; /* Name of the variable from IN=. */
+
+    /* IN subcommand. */
+    char *in_name;              /* Variable name. */
+    struct variable *in_var;    /* Variable (in master dictionary). */
 
     struct ccase input;         /* Input record. */
   };
@@ -664,7 +728,7 @@ struct mtf_proc
     size_t by_cnt;              /* Number of variables on BY subcommand. */
 
     /* Names of FIRST, LAST variables. */
-    char first[SHORT_NAME_LEN + 1], last[SHORT_NAME_LEN + 1];
+    char first[LONG_NAME_LEN + 1], last[LONG_NAME_LEN + 1];
     
     struct dictionary *dict;    /* Dictionary of output file. */
     struct case_sink *sink;     /* Sink to receive output. */
@@ -694,9 +758,11 @@ cmd_match_files (void)
 {
   struct mtf_proc mtf;
   struct mtf_file *first_table = NULL;
+  struct mtf_file *iter;
   
   bool used_active_file = false;
   bool saw_table = false;
+  bool saw_in = false;
   
   mtf.head = mtf.tail = NULL;
   mtf.by_cnt = 0;
@@ -710,7 +776,8 @@ cmd_match_files (void)
   dict_set_case_limit (mtf.dict, dict_get_case_limit (default_dict));
 
   lex_match ('/');
-  while (lex_id_match ("FILE", tokid) || lex_id_match ("TABLE", tokid)) 
+  while (token == T_ID
+         && (lex_id_match ("FILE", tokid) || lex_id_match ("TABLE", tokid)))
     {
       struct mtf_file *file = xmalloc (sizeof *file);
 
@@ -723,12 +790,14 @@ cmd_match_files (void)
         }
       else
         assert (0);
+      lex_match ('=');
 
       file->by = NULL;
       file->handle = NULL;
       file->reader = NULL;
       file->dict = NULL;
-      file->in[0] = '\0';
+      file->in_name = NULL;
+      file->in_var = NULL;
       case_nullify (&file->input);
 
       /* FILEs go first, then TABLEs. */
@@ -755,9 +824,7 @@ cmd_match_files (void)
             mtf.head = file;
           first_table->prev = file;
         }
-         
-      lex_match ('=');
-         
+
       if (lex_match ('*'))
         {
           file->handle = NULL;
@@ -818,25 +885,25 @@ cmd_match_files (void)
                 goto error;
               }
 
-            if (file->in[0])
+            if (file->in_name != NULL)
               {
                 msg (SE, _("Multiple IN subcommands for a single FILE or "
                            "TABLE."));
                 goto error;
               }
-            strcpy (file->in, tokid);
+            file->in_name = xstrdup (tokid);
             lex_get ();
+            saw_in = true;
           }
 
       mtf_merge_dictionary (mtf.dict, file);
     }
-      
+  
   while (token != '.')
     {
       if (lex_match (T_BY))
        {
           struct variable **by;
-          struct mtf_file *iter;
           
          if (mtf.by_cnt)
            {
@@ -851,9 +918,9 @@ cmd_match_files (void)
 
           for (iter = mtf.head; iter != NULL; iter = iter->next)
             {
-              int i;
+              size_t i;
          
-              iter->by = xmalloc (sizeof *iter->by * mtf.by_cnt);
+              iter->by = xnmalloc (mtf.by_cnt, sizeof *iter->by);
 
               for (i = 0; i < mtf.by_cnt; i++)
                 {
@@ -868,6 +935,7 @@ cmd_match_files (void)
                     }
                 }
             }
+          free (by);
        }
       else if (lex_match_id ("FIRST")) 
         {
@@ -901,6 +969,16 @@ cmd_match_files (void)
        {
          /* FIXME. */
        }
+      else if (lex_match_id ("DROP")) 
+        {
+          if (!drop_variables (mtf.dict))
+            goto error;
+        }
+      else if (lex_match_id ("KEEP")) 
+        {
+          if (!keep_variables (mtf.dict))
+            goto error;
+        }
       else
        {
          lex_error (NULL);
@@ -914,12 +992,52 @@ cmd_match_files (void)
         }
     }
 
-  if (mtf.by_cnt == 0 && saw_table)
+  if (mtf.by_cnt == 0)
     {
-      msg (SE, _("BY is required when TABLE is specified."));
-      goto error;
+      if (saw_table)
+        {
+          msg (SE, _("BY is required when TABLE is specified."));
+          goto error;
+        }
+      if (saw_in)
+        {
+          msg (SE, _("BY is required when IN is specified."));
+          goto error;
+        }
+    }
+
+  /* Set up mapping from each file's variables to master
+     variables. */
+  for (iter = mtf.head; iter != NULL; iter = iter->next)
+    {
+      struct dictionary *d = iter->dict;
+      int i;
+
+      for (i = 0; i < dict_get_var_cnt (d); i++)
+        {
+          struct variable *v = dict_get_var (d, i);
+          struct variable *mv = dict_lookup_var (mtf.dict, v->name);
+          if (mv != NULL)
+            set_master (v, mv);
+        }
     }
 
+  /* Add IN variables to master dictionary. */
+  for (iter = mtf.head; iter != NULL; iter = iter->next) 
+    if (iter->in_name != NULL)
+      {
+        iter->in_var = dict_create_var (mtf.dict, iter->in_name, 0);
+        if (iter->in_var == NULL)
+          {
+            msg (SE, _("IN variable name %s duplicates an "
+                       "existing variable name."),
+                 iter->in_var->name);
+            goto error;
+          }
+        iter->in_var->print = iter->in_var->write
+          = make_output_format (FMT_F, 1, 0);
+      }
+    
   /* MATCH FILES performs an n-way merge on all its input files.
      Abstract algorithm:
 
@@ -927,29 +1045,27 @@ cmd_match_files (void)
 
      2. If no FILEs are left, stop.  Otherwise, proceed to step 3.
 
-     3. Find the FILE input record with minimum BY values.  Store all
-     the values from this input record into the output record.
-
-     4. Find all the FILE input records with BY values identical to
-     the minimums.  Store all the values from these input records into
+     3. Find the FILE input record(s) that have minimum BY
+     values.  Store all the values from these input records into
      the output record.
 
-     5. For every TABLE, read another record as long as the BY values
+     4. For every TABLE, read another record as long as the BY values
      on the TABLE's input record are less than the FILEs' BY values.
      If an exact match is found, store all the values from the TABLE
      input record into the output record.
 
-     6. Write the output record.
+     5. Write the output record.
 
-     7. Read another record from each input file FILE and TABLE that
+     6. Read another record from each input file FILE and TABLE that
      we stored values from above.  If we come to the end of one of the
      input files, remove it from the list of input files.
 
-     8. Repeat from step 2.
+     7. Repeat from step 2.
 
-     Unfortunately, this algorithm can't be directly implemented
-     because there's no function to read a record from the active
-     file; instead, it has to be done using callbacks.
+     Unfortunately, this algorithm can't be implemented in a
+     straightforward way because there's no function to read a
+     record from the active file.  Instead, it has to be written
+     as a state machine.
 
      FIXME: For merging large numbers of files (more than 10?) a
      better algorithm would use a heap for finding minimum
@@ -958,13 +1074,12 @@ cmd_match_files (void)
   if (!used_active_file)
     discard_variables ();
 
+  dict_compact_values (mtf.dict);
   mtf.sink = create_case_sink (&storage_sink_class, mtf.dict, NULL);
   if (mtf.sink->class->open != NULL)
     mtf.sink->class->open (mtf.sink);
 
-  mtf.seq_nums = xmalloc (dict_get_var_cnt (mtf.dict) * sizeof *mtf.seq_nums);
-  memset (mtf.seq_nums, 0,
-          dict_get_var_cnt (mtf.dict) * sizeof *mtf.seq_nums);
+  mtf.seq_nums = xcalloc (dict_get_var_cnt (mtf.dict), sizeof *mtf.seq_nums);
   case_create (&mtf.mtf_case, dict_get_next_value_idx (mtf.dict));
 
   mtf_read_nonactive_records (&mtf);
@@ -972,6 +1087,9 @@ cmd_match_files (void)
     procedure (mtf_processing, &mtf);
   mtf_processing_finish (&mtf);
 
+  free_case_source (vfm_source);
+  vfm_source = NULL;
+
   dict_destroy (default_dict);
   default_dict = mtf.dict;
   mtf.dict = NULL;
@@ -981,12 +1099,12 @@ cmd_match_files (void)
   mtf_free (&mtf);
   return CMD_SUCCESS;
   
-error:
+ error:
   mtf_free (&mtf);
   return CMD_FAILURE;
 }
 
-/* Repeats 2...8 an arbitrary number of times. */
+/* Repeats 2...7 an arbitrary number of times. */
 static void
 mtf_processing_finish (void *mtf_)
 {
@@ -1037,6 +1155,7 @@ mtf_free_file (struct mtf_file *file)
   if (file->dict != default_dict)
     dict_destroy (file->dict);
   case_destroy (&file->input);
+  free (file->in_name);
   free (file);
 }
 
@@ -1049,7 +1168,6 @@ mtf_free (struct mtf_proc *mtf)
   for (iter = mtf->head; iter; iter = next)
     {
       next = iter->next;
-
       mtf_free_file (iter);
     }
   
@@ -1065,6 +1183,7 @@ static void
 mtf_delete_file_in_place (struct mtf_proc *mtf, struct mtf_file **file)
 {
   struct mtf_file *f = *file;
+  int i;
 
   if (f->prev)
     f->prev->next = f->next;
@@ -1076,20 +1195,22 @@ mtf_delete_file_in_place (struct mtf_proc *mtf, struct mtf_file **file)
     mtf->tail = f->prev;
   *file = f->next;
 
-  {
-    int i;
-
-    for (i = 0; i < dict_get_var_cnt (f->dict); i++)
-      {
-       struct variable *v = dict_get_var (f->dict, i);
-        union value *out = case_data_rw (&mtf->mtf_case, get_master (v)->fv);
+  if (f->in_var != NULL)
+    case_data_rw (&mtf->mtf_case, f->in_var->fv)->f = 0.;
+  for (i = 0; i < dict_get_var_cnt (f->dict); i++)
+    {
+      struct variable *v = dict_get_var (f->dict, i);
+      struct variable *mv = get_master (v);
+      if (mv != NULL) 
+        {
+          union value *out = case_data_rw (&mtf->mtf_case, mv->fv);
          
-       if (v->type == NUMERIC)
-          out->f = SYSMIS;
-       else
-         memset (out->s, ' ', v->width);
-      }
-  }
+          if (v->type == NUMERIC)
+            out->f = SYSMIS;
+          else
+            memset (out->s, ' ', v->width);
+        } 
+    }
 
   mtf_free_file (f);
 }
@@ -1099,19 +1220,13 @@ static void
 mtf_read_nonactive_records (void *mtf_)
 {
   struct mtf_proc *mtf = mtf_;
-  struct mtf_file *iter;
+  struct mtf_file *iter, *next;
 
-  for (iter = mtf->head; iter)
+  for (iter = mtf->head; iter != NULL; iter = next)
     {
-      if (iter->handle)
-       {
-         if (!sfm_read_case (iter->reader, &iter->input))
-           mtf_delete_file_in_place (mtf, &iter);
-         else
-           iter = iter->next;
-       }
-      else
-        iter = iter->next;
+      next = iter->next;
+      if (iter->handle && !sfm_read_case (iter->reader, &iter->input))
+        mtf_delete_file_in_place (mtf, &iter);
     }
 }
 
@@ -1122,42 +1237,10 @@ mtf_compare_BY_values (struct mtf_proc *mtf,
                        struct mtf_file *a, struct mtf_file *b,
                        struct ccase *c)
 {
-  struct ccase *a_input, *b_input;
-  int i;
-
+  struct ccase *ca = case_is_null (&a->input) ? c : &a->input;
+  struct ccase *cb = case_is_null (&b->input) ? c : &b->input;
   assert ((a == NULL) + (b == NULL) + (c == NULL) <= 1);
-  a_input = case_is_null (&a->input) ? c : &a->input;
-  b_input = case_is_null (&b->input) ? c : &b->input;
-  for (i = 0; i < mtf->by_cnt; i++)
-    {
-      assert (a->by[i]->type == b->by[i]->type);
-      assert (a->by[i]->width == b->by[i]->width);
-      
-      if (a->by[i]->type == NUMERIC)
-       {
-         double af = case_num (a_input, a->by[i]->fv);
-         double bf = case_num (b_input, b->by[i]->fv);
-
-         if (af < bf)
-           return -1;
-         else if (af > bf)
-           return 1;
-       }
-      else 
-       {
-         int result;
-         
-         assert (a->by[i]->type == ALPHA);
-         result = memcmp (case_str (a_input, a->by[i]->fv),
-                          case_str (b_input, b->by[i]->fv),
-                          a->by[i]->width);
-         if (result < 0)
-           return -1;
-         else if (result > 0)
-           return 1;
-       }
-    }
-  return 0;
+  return case_compare_2dict (ca, cb, a->by, b->by, mtf->by_cnt);
 }
 
 /* Perform one iteration of steps 3...7 above. */
@@ -1165,105 +1248,92 @@ static int
 mtf_processing (struct ccase *c, void *mtf_)
 {
   struct mtf_proc *mtf = mtf_;
-  struct mtf_file *min_head, *min_tail; /* Files with minimum BY values. */
-  struct mtf_file *max_head, *max_tail; /* Files with non-minimum BY values. */
-  struct mtf_file *iter;                /* Iterator. */
 
-  for (;;)
+  /* Do we need another record from the active file? */
+  bool read_active_file;
+
+  assert (mtf->head != NULL);
+  if (mtf->head->type == MTF_TABLE)
+    return 1;
+  
+  do
     {
-      /* If the active file doesn't have the minimum BY values, don't
-        return because that would cause a record to be skipped. */
-      bool advance = true;
+      struct mtf_file *min_head, *min_tail; /* Files with minimum BY values. */
+      struct mtf_file *max_head, *max_tail; /* Files with non-minimum BYs. */
+      struct mtf_file *iter, *next;
 
-      if (mtf->head->type == MTF_TABLE)
-       return 0;
+      read_active_file = false;
       
-      /* 3. Find the FILE input record with minimum BY values.  Store
-        all the values from this input record into the output record.
-
-        4. Find all the FILE input records with BY values identical
-        to the minimums.  Store all the values from these input
-        records into the output record. */
+      /* 3. Find the FILE input record(s) that have minimum BY
+         values.  Store all the values from these input records into
+         the output record. */
       min_head = min_tail = mtf->head;
       max_head = max_tail = NULL;
       for (iter = mtf->head->next; iter && iter->type == MTF_FILE;
-          iter = iter->next)
-       switch (mtf_compare_BY_values (mtf, min_head, iter, c))
-         {
-         case -1:
-           if (max_head)
-             max_tail = max_tail->next_min = iter;
-           else
-             max_head = max_tail = iter;
-           break;
-
-         case 0:
+          iter = iter->next) 
+        {
+          int cmp = mtf_compare_BY_values (mtf, min_head, iter, c);
+          if (cmp < 0) 
+            {
+              if (max_head)
+                max_tail = max_tail->next_min = iter;
+              else
+                max_head = max_tail = iter;
+            }
+          else if (cmp == 0) 
            min_tail = min_tail->next_min = iter;
-           break;
-
-         case 1:
-           if (max_head)
-             {
-               max_tail->next_min = min_head;
-               max_tail = min_tail;
-             }
-           else
-             {
-               max_head = min_head;
-               max_tail = min_tail;
-             }
-           min_head = min_tail = iter;
-           break;
-
-         default:
-           assert (0);
-         }
-
-      /* 5. For every TABLE, read another record as long as the BY
+          else /* cmp > 0 */
+            {
+              if (max_head)
+                {
+                  max_tail->next_min = min_head;
+                  max_tail = min_tail;
+                }
+              else
+                {
+                  max_head = min_head;
+                  max_tail = min_tail;
+                }
+              min_head = min_tail = iter;
+            }
+        }
+      
+      /* 4. For every TABLE, read another record as long as the BY
         values on the TABLE's input record are less than the FILEs'
         BY values.  If an exact match is found, store all the values
         from the TABLE input record into the output record. */
-      while (iter)
+      for (; iter != NULL; iter = next)
        {
-         struct mtf_file *next = iter->next;
-         
          assert (iter->type == MTF_TABLE);
       
-         if (iter->handle == NULL)
-           advance = false;
-
-       again:
-         switch (mtf_compare_BY_values (mtf, min_head, iter, c))
-           {
-           case -1:
-             if (max_head)
-               max_tail = max_tail->next_min = iter;
-             else
-               max_head = max_tail = iter;
-             break;
-
-           case 0:
-             min_tail = min_tail->next_min = iter;
-             break;
-
-           case 1:
-             if (iter->handle == NULL)
-               return 1;
-             if (sfm_read_case (iter->reader, &iter->input))
-               goto again;
-             mtf_delete_file_in_place (mtf, &iter);
-             break;
-
-           default:
-             assert (0);
-           }
-
-         iter = next;
+         next = iter->next;
+          for (;;) 
+            {
+              int cmp = mtf_compare_BY_values (mtf, min_head, iter, c);
+              if (cmp < 0) 
+                {
+                  if (max_head)
+                    max_tail = max_tail->next_min = iter;
+                  else
+                    max_head = max_tail = iter;
+                }
+              else if (cmp == 0)
+                min_tail = min_tail->next_min = iter;
+              else /* cmp > 0 */
+                {
+                  if (iter->handle == NULL)
+                    return 1;
+                  if (sfm_read_case (iter->reader, &iter->input))
+                    continue;
+                  mtf_delete_file_in_place (mtf, &iter);
+                }
+              break;
+            }
        }
 
       /* Next sequence number. */
       mtf->seq_num++;
-  
+
       /* Store data to all the records we are using. */
       if (min_tail)
        min_tail->next_min = NULL;
@@ -1276,7 +1346,7 @@ mtf_processing (struct ccase *c, void *mtf_)
              struct variable *v = dict_get_var (iter->dict, i);
               struct variable *mv = get_master (v);
          
-             if (mtf->seq_nums[mv->index] != mtf->seq_num) 
+             if (mv != NULL && mtf->seq_nums[mv->index] != mtf->seq_num) 
                 {
                   struct ccase *record
                     = case_is_null (&iter->input) ? c : &iter->input;
@@ -1289,9 +1359,15 @@ mtf_processing (struct ccase *c, void *mtf_)
                     memcpy (out->s, case_str (record, v->fv), v->width);
                 } 
             }
+          if (iter->in_var != NULL)
+            case_data_rw (&mtf->mtf_case, iter->in_var->fv)->f = 1.;
+
+          if (iter->type == MTF_FILE && iter->handle == NULL)
+            read_active_file = true;
        }
 
-      /* Store missing values to all the records we're not using. */
+      /* Store missing values to all the records we're not
+         using. */
       if (max_tail)
        max_tail->next_min = NULL;
       for (iter = max_head; iter; iter = iter->next_min)
@@ -1302,8 +1378,8 @@ mtf_processing (struct ccase *c, void *mtf_)
            {
              struct variable *v = dict_get_var (iter->dict, i);
               struct variable *mv = get_master (v);
-         
-             if (mtf->seq_nums[mv->index] != mtf->seq_num) 
+
+             if (mv != NULL && mtf->seq_nums[mv->index] != mtf->seq_num) 
                 {
                   union value *out = case_data_rw (&mtf->mtf_case, mv->fv);
                   mtf->seq_nums[mv->index] = mtf->seq_num;
@@ -1314,36 +1390,29 @@ mtf_processing (struct ccase *c, void *mtf_)
                     memset (out->s, ' ', v->width);
                 }
             }
-
-         if (iter->handle == NULL)
-           advance = false;
+          if (iter->in_var != NULL)
+            case_data_rw (&mtf->mtf_case, iter->in_var->fv)->f = 0.;
        }
 
-      /* 6. Write the output record. */
+      /* 5. Write the output record. */
       mtf->sink->class->write (mtf->sink, &mtf->mtf_case);
 
-      /* 7. Read another record from each input file FILE and TABLE
+      /* 6. Read another record from each input file FILE and TABLE
         that we stored values from above.  If we come to the end of
         one of the input files, remove it from the list of input
         files. */
-      for (iter = min_head; iter && iter->type == MTF_FILE; )
+      for (iter = min_head; iter && iter->type == MTF_FILE; iter = next)
        {
-         struct mtf_file *next = iter->next_min;
-         
-         if (iter->reader != NULL)
-           {
-             if (!sfm_read_case (iter->reader, &iter->input))
-               mtf_delete_file_in_place (mtf, &iter);
-           }
-
-         iter = next;
+         next = iter->next_min;
+         if (iter->reader != NULL
+              && !sfm_read_case (iter->reader, &iter->input))
+            mtf_delete_file_in_place (mtf, &iter);
        }
-      
-      if (advance)
-       break;
     }
+  while (!read_active_file
+         && mtf->head != NULL && mtf->head->type == MTF_FILE);
 
-  return (mtf->head && mtf->head->type != MTF_TABLE);
+  return mtf->head != NULL && mtf->head->type == MTF_FILE;
 }
 
 /* Merge the dictionary for file F into master dictionary M. */
@@ -1377,13 +1446,14 @@ mtf_merge_dictionary (struct dictionary *const m, struct mtf_file *f)
         }
     }
   
-  dict_compact_values (d);
-
   for (i = 0; i < dict_get_var_cnt (d); i++)
     {
       struct variable *dv = dict_get_var (d, i);
       struct variable *mv = dict_lookup_var (m, dv->name);
 
+      if (dict_class_from_id (dv->name) == DC_SCRATCH)
+        continue;
+
       if (mv != NULL)
         {
           if (mv->width != dv->width) 
@@ -1401,21 +1471,15 @@ mtf_merge_dictionary (struct dictionary *const m, struct mtf_file *f)
               if (val_labs_count (dv->val_labs)
                   && !val_labs_count (mv->val_labs))
                 mv->val_labs = val_labs_copy (dv->val_labs);
-              if (dv->miss_type != MISSING_NONE
-                  && mv->miss_type == MISSING_NONE)
-                copy_missing_values (mv, dv);
+              if (!mv_is_empty (&dv->miss) && mv_is_empty (&mv->miss))
+                mv_copy (&mv->miss, &dv->miss);
             }
 
           if (dv->label && !mv->label)
             mv->label = xstrdup (dv->label);
         }
       else
-        {
-          mv = dict_clone_var (m, dv, dv->name, dv->longname);
-          assert (mv != NULL);
-        }
-        
-      set_master (dv, mv);
+        mv = dict_clone_var_assert (m, dv, dv->name);
     }
 
   return 1;
@@ -1433,7 +1497,6 @@ set_master (struct variable *v, struct variable *master)
 static struct variable *
 get_master (struct variable *v) 
 {
-  assert (v->aux != NULL);
   return v->aux;
 }
 \f
@@ -1456,26 +1519,20 @@ cmd_import (void)
   struct import_pgm *pgm = NULL;
   struct file_handle *fh = NULL;
   struct dictionary *dict = NULL;
-  int type;
-
-  pgm = xmalloc (sizeof *pgm);
-  pgm->reader = NULL;
-  pgm->map = NULL;
-  case_nullify (&pgm->bounce);
+  enum pfm_type type;
 
+  lex_match ('/');
   for (;;)
     {
-      lex_match ('/');
-      
-      if (lex_match_id ("FILE") || token == T_STRING)
+      if (pgm == NULL && (lex_match_id ("FILE") || token == T_STRING))
        {
          lex_match ('=');
 
          fh = fh_parse ();
          if (fh == NULL)
-           return CMD_FAILURE;
+            goto error;
        }
-      else if (lex_match_id ("TYPE"))
+      else if (pgm == NULL && lex_match_id ("TYPE"))
        {
          lex_match ('=');
 
@@ -1486,27 +1543,48 @@ cmd_import (void)
          else
            {
              lex_error (_("expecting COMM or TAPE"));
-             return CMD_FAILURE;
+              goto error;
            }
        }
-      else break;
+      else 
+        {
+          if (pgm == NULL) 
+            {
+              if (fh == NULL) 
+                {
+                  lex_sbc_missing ("FILE");
+                  goto error;
+                }
+              
+              discard_variables ();
+
+              pgm = xmalloc (sizeof *pgm);
+              pgm->reader = pfm_open_reader (fh, &dict, NULL);
+              pgm->map = NULL;
+              case_nullify (&pgm->bounce);
+              if (pgm->reader == NULL)
+                goto error;
+
+              case_create (&pgm->bounce, dict_get_next_value_idx (dict));
+  
+              start_case_map (dict);
+            }
+
+          if (token == '.')
+            break;
+          
+          if (!parse_dict_trim (dict))
+            goto error;
+        }
+
+      lex_match ('/');
     }
-  if (!lex_match ('/') && token != '.')
+  if (pgm == NULL) 
     {
       lex_error (NULL);
-      return CMD_FAILURE;
+      goto error;
     }
 
-  discard_variables ();
-
-  pgm->reader = pfm_open_reader (fh, &dict, NULL);
-  if (pgm->reader == NULL)
-    return CMD_FAILURE;
-  case_create (&pgm->bounce, dict_get_next_value_idx (dict));
-  
-  start_case_map (dict);
-  if (!trim_dictionary (dict, OP_READ, NULL))
-    goto error;
   pgm->map = finish_case_map (dict);
   
   dict_destroy (default_dict);
@@ -1601,7 +1679,7 @@ struct case_map
    at will before using finish_case_map() to produce the case
    map.
 
-   Uses D's aux members, which may not otherwise be in use. */
+   Uses D's aux members, which must otherwise not be in use. */
 static void
 start_case_map (struct dictionary *d) 
 {
@@ -1635,7 +1713,7 @@ finish_case_map (struct dictionary *d)
 
   map = xmalloc (sizeof *map);
   map->value_cnt = dict_get_next_value_idx (d);
-  map->map = xmalloc (sizeof *map->map * map->value_cnt);
+  map->map = xnmalloc (map->value_cnt, sizeof *map->map);
   for (i = 0; i < map->value_cnt; i++)
     map->map[i] = -1;