Remove "Written by Ben Pfaff <blp@gnu.org>" lines everywhere.
[pspp-builds.git] / src / language / utilities / set.q
index 25f09eb7d9d4d19392bb47ff345527bfdd762fe3..4fdcc578f7dff5bc4dcee7c178f0519bafde5d4e 100644 (file)
@@ -1,6 +1,5 @@
 /* PSPP - computes sample statistics.
    Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
-   Written by Ben Pfaff <blp@gnu.org>.
 
    This program is free software; you can redistribute it and/or
    modify it under the terms of the GNU General Public License as
 #include <stdlib.h>
 #include <time.h>
 
+#include <data/data-in.h>
+#include <data/data-out.h>
 #include <data/dictionary.h>
 #include <data/format.h>
 #include <data/procedure.h>
 #include <data/settings.h>
+#include <data/value.h>
 #include <data/variable.h>
 #include <language/command.h>
 #include <language/lexer/format-parser.h>
 #include <language/lexer/lexer.h>
-#include <language/line-buffer.h>
+#include <language/prompt.h>
 #include <libpspp/alloc.h>
 #include <libpspp/compiler.h>
 #include <libpspp/copyleft.h>
+#include <libpspp/float-format.h>
+#include <libpspp/integer-format.h>
 #include <libpspp/magic.h>
 #include <libpspp/message.h>
 #include <math/random.h>
@@ -74,7 +78,7 @@ int tgetnum (const char *);
      endcmd=string "x==1" "one character long";
      epoch=custom;
      errorbreak=errbrk:on/off;
-     errors=errors:on/off/terminal/listing/both/none;
+     errors=errors:terminal/listing/both/on/none/off;
      format=custom;
      headers=headers:no/yes/blank;
      highres=hires:on/off;
@@ -86,7 +90,7 @@ int tgetnum (const char *);
      lowres=lores:auto/on/off;
      lpi=integer "x>0" "%s must be greater than 0";
      menus=menus:standard/extended;
-     messages=messages:on/off/terminal/listing/both/none;
+     messages=messages:on/off/terminal/listing/both/on/none/off;
      mexpand=mexp:on/off;
      miterate=integer "x>0" "%s must be greater than 0";
      mnest=integer "x>0" "%s must be greater than 0";
@@ -98,7 +102,9 @@ int tgetnum (const char *);
      nulline=null:on/off;
      printback=prtbck:on/off;
      prompt=string;
-     results=res:on/off/terminal/listing/both/none;
+     results=res:on/off/terminal/listing/both/on/none/off;
+     rib=rib:msbfirst/lsbfirst/vax/native;
+     rrb=rrb:native/isl/isb/idl/idb/vf/vd/vg/zs/zl;
      safer=safe:on;
      scompression=scompress:on/off;
      scripttab=string "x==1" "one character long";
@@ -106,6 +112,8 @@ int tgetnum (const char *);
      tb1=string "x==3 || x==11" "3 or 11 characters long";
      tbfonts=string;
      undefined=undef:warn/nowarn;
+     wib=wib:msbfirst/lsbfirst/vax/native;
+     wrb=wrb:native/isl/isb/idl/idb/vf/vd/vg/zs/zl;
      width=custom;
      workspace=integer "x>=1024" "%s must be at least 1 MB";
      xsort=xsort:yes/no.
@@ -118,14 +126,19 @@ int tgetnum (const char *);
 /* (functions) */
 
 static bool do_cc (const char *cc_string, enum fmt_type);
+static enum integer_format stc_to_integer_format (int stc);
+static enum float_format stc_to_float_format (int stc);
 
 int
-cmd_set (struct dataset *ds)
+cmd_set (struct lexer *lexer, struct dataset *ds)
 {
   struct cmd_set cmd;
 
-  if (!parse_set (ds, &cmd, NULL))
-    return CMD_FAILURE;
+  if (!parse_set (lexer, ds, &cmd, NULL))
+    {
+      free_set (&cmd);
+      return CMD_FAILURE;
+    }
 
   if (cmd.sbc_cca)
     do_cc (cmd.s_cca, FMT_CCA);
@@ -139,11 +152,11 @@ cmd_set (struct dataset *ds)
     do_cc (cmd.s_cce, FMT_CCE);
 
   if (cmd.sbc_prompt)
-    getl_set_prompt (GETL_PROMPT_FIRST, cmd.s_prompt);
+    prompt_set (PROMPT_FIRST, cmd.s_prompt);
   if (cmd.sbc_cprompt)
-    getl_set_prompt (GETL_PROMPT_LATER, cmd.s_cprompt);
+    prompt_set (PROMPT_LATER, cmd.s_cprompt);
   if (cmd.sbc_dprompt)
-    getl_set_prompt (GETL_PROMPT_DATA, cmd.s_dprompt);
+    prompt_set (PROMPT_DATA, cmd.s_dprompt);
 
   if (cmd.sbc_decimal)
     fmt_set_decimal (cmd.dec == STC_DOT ? '.' : ',');
@@ -153,6 +166,12 @@ cmd_set (struct dataset *ds)
     set_endcmd (cmd.s_endcmd[0]);
   if (cmd.sbc_errorbreak)
     set_errorbreak (cmd.errbrk == STC_ON);
+  if (cmd.sbc_errors)
+    {
+      bool both = cmd.errors == STC_BOTH || cmd.errors == STC_ON;
+      set_error_routing_to_terminal (cmd.errors == STC_TERMINAL || both);
+      set_error_routing_to_listing (cmd.errors == STC_LISTING || both);
+    }
   if (cmd.sbc_include)
     set_include (cmd.inc == STC_ON);
   if (cmd.sbc_mxerrs)
@@ -161,12 +180,20 @@ cmd_set (struct dataset *ds)
     set_mxwarns (cmd.n_mxwarns[0]);
   if (cmd.sbc_nulline)
     set_nulline (cmd.null == STC_ON);
+  if (cmd.sbc_rib)
+    data_in_set_integer_format (stc_to_integer_format (cmd.rib));
+  if (cmd.sbc_rrb)
+    data_in_set_float_format (stc_to_float_format (cmd.rrb));
   if (cmd.sbc_safer)
     set_safer_mode ();
   if (cmd.sbc_scompression)
     set_scompression (cmd.scompress == STC_ON);
   if (cmd.sbc_undefined)
     set_undefined (cmd.undef == STC_WARN);
+  if (cmd.sbc_wib)
+    data_out_set_integer_format (stc_to_integer_format (cmd.wib));
+  if (cmd.sbc_wrb)
+    data_out_set_float_format (stc_to_float_format (cmd.wrb));
   if (cmd.sbc_workspace)
     set_workspace (cmd.n_workspace[0] * 1024L);
 
@@ -195,9 +222,57 @@ cmd_set (struct dataset *ds)
   if (cmd.sbc_compression)
     msg (SW, _("Active file compression is not implemented."));
 
+  free_set (&cmd);
+
   return CMD_SUCCESS;
 }
 
+/* Returns the integer_format value corresponding to STC,
+   which should be the value of cmd.rib or cmd.wib. */
+static enum integer_format
+stc_to_integer_format (int stc) 
+{
+  return (stc == STC_MSBFIRST ? INTEGER_MSB_FIRST
+          : stc == STC_LSBFIRST ? INTEGER_LSB_FIRST
+          : stc == STC_VAX ? INTEGER_VAX
+          : INTEGER_NATIVE);
+}
+
+/* Returns the float_format value corresponding to STC,
+   which should be the value of cmd.rrb or cmd.wrb. */
+static enum float_format
+stc_to_float_format (int stc) 
+{
+  switch (stc) 
+    {
+    case STC_NATIVE:
+      return FLOAT_NATIVE_DOUBLE;
+
+    case STC_ISL:
+      return FLOAT_IEEE_SINGLE_LE;
+    case STC_ISB:
+      return FLOAT_IEEE_SINGLE_BE;
+    case STC_IDL:
+      return FLOAT_IEEE_DOUBLE_LE;
+    case STC_IDB:
+      return FLOAT_IEEE_DOUBLE_BE;
+
+    case STC_VF:
+      return FLOAT_VAX_F;
+    case STC_VD:
+      return FLOAT_VAX_D;
+    case STC_VG:
+      return FLOAT_VAX_G;
+
+    case STC_ZS:
+      return FLOAT_Z_SHORT;
+    case STC_ZL:
+      return FLOAT_Z_LONG;
+    }
+
+  NOT_REACHED ();
+}
+
 /* Find the grouping characters in CC_STRING and set CC's
    grouping and decimal members appropriately.  Returns true if
    successful, false otherwise. */
@@ -289,20 +364,22 @@ do_cc (const char *cc_string, enum fmt_type type)
    completely blank fields in numeric data imply.  X, Wnd: Syntax is
    SYSMIS or a numeric value. */
 static int
-stc_custom_blanks (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
+stc_custom_blanks (struct lexer *lexer, 
+                  struct dataset *ds UNUSED, 
+                  struct cmd_set *cmd UNUSED, void *aux UNUSED)
 {
-  lex_match ('=');
-  if ((token == T_ID && lex_id_match ("SYSMIS", tokid)))
+  lex_match (lexer, '=');
+  if (lex_match_id (lexer, "SYSMIS"))
     {
-      lex_get ();
+      lex_get (lexer);
       set_blanks (SYSMIS);
     }
   else
     {
-      if (!lex_force_num ())
+      if (!lex_force_num (lexer))
        return 0;
-      set_blanks (lex_number ());
-      lex_get ();
+      set_blanks (lex_number (lexer));
+      lex_get (lexer);
     }
   return 1;
 }
@@ -310,15 +387,17 @@ stc_custom_blanks (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *
 /* Parses the EPOCH subcommand, which controls the epoch used for
    parsing 2-digit years. */
 static int
-stc_custom_epoch (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED) 
+stc_custom_epoch (struct lexer *lexer, 
+                 struct dataset *ds UNUSED, 
+                 struct cmd_set *cmd UNUSED, void *aux UNUSED) 
 {
-  lex_match ('=');
-  if (lex_match_id ("AUTOMATIC"))
+  lex_match (lexer, '=');
+  if (lex_match_id (lexer, "AUTOMATIC"))
     set_epoch (-1);
-  else if (lex_is_integer ()) 
+  else if (lex_is_integer (lexer)) 
     {
-      int new_epoch = lex_integer ();
-      lex_get ();
+      int new_epoch = lex_integer (lexer);
+      lex_get (lexer);
       if (new_epoch < 1500) 
         {
           msg (SE, _("EPOCH must be 1500 or later."));
@@ -328,7 +407,7 @@ stc_custom_epoch (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *a
     }
   else 
     {
-      lex_error (_("expecting AUTOMATIC or year"));
+      lex_error (lexer, _("expecting AUTOMATIC or year"));
       return 0;
     }
 
@@ -336,24 +415,24 @@ stc_custom_epoch (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *a
 }
 
 static int
-stc_custom_length (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
+stc_custom_length (struct lexer *lexer, struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
 {
   int page_length;
 
-  lex_match ('=');
-  if (lex_match_id ("NONE"))
+  lex_match (lexer, '=');
+  if (lex_match_id (lexer, "NONE"))
     page_length = -1;
   else
     {
-      if (!lex_force_int ())
+      if (!lex_force_int (lexer))
        return 0;
-      if (lex_integer () < 1)
+      if (lex_integer (lexer) < 1)
        {
          msg (SE, _("LENGTH must be at least 1."));
          return 0;
        }
-      page_length = lex_integer ();
-      lex_get ();
+      page_length = lex_integer (lexer);
+      lex_get (lexer);
     }
 
   if (page_length != -1) 
@@ -363,41 +442,41 @@ stc_custom_length (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *
 }
 
 static int
-stc_custom_seed (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
+stc_custom_seed (struct lexer *lexer, struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
 {
-  lex_match ('=');
-  if (lex_match_id ("RANDOM"))
+  lex_match (lexer, '=');
+  if (lex_match_id (lexer, "RANDOM"))
     set_rng (time (0));
   else
     {
-      if (!lex_force_num ())
+      if (!lex_force_num (lexer))
        return 0;
-      set_rng (lex_number ());
-      lex_get ();
+      set_rng (lex_number (lexer));
+      lex_get (lexer);
     }
 
   return 1;
 }
 
 static int
-stc_custom_width (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
+stc_custom_width (struct lexer *lexer, struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
 {
-  lex_match ('=');
-  if (lex_match_id ("NARROW"))
+  lex_match (lexer, '=');
+  if (lex_match_id (lexer, "NARROW"))
     set_viewwidth (79);
-  else if (lex_match_id ("WIDE"))
+  else if (lex_match_id (lexer, "WIDE"))
     set_viewwidth (131);
   else
     {
-      if (!lex_force_int ())
+      if (!lex_force_int (lexer))
        return 0;
-      if (lex_integer () < 40)
+      if (lex_integer (lexer) < 40)
        {
          msg (SE, _("WIDTH must be at least 40."));
          return 0;
        }
-      set_viewwidth (lex_integer ());
-      lex_get ();
+      set_viewwidth (lex_integer (lexer));
+      lex_get (lexer);
     }
 
   return 1;
@@ -406,12 +485,12 @@ stc_custom_width (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *a
 /* Parses FORMAT subcommand, which consists of a numeric format
    specifier. */
 static int
-stc_custom_format (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
+stc_custom_format (struct lexer *lexer, struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
 {
   struct fmt_spec fmt;
 
-  lex_match ('=');
-  if (!parse_format_specifier (&fmt))
+  lex_match (lexer, '=');
+  if (!parse_format_specifier (lexer, &fmt))
     return 0;
   if (fmt_is_string (fmt.type))
     {
@@ -427,16 +506,16 @@ stc_custom_format (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *
 }
 
 static int
-stc_custom_journal (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
+stc_custom_journal (struct lexer *lexer, struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
 {
-  lex_match ('=');
-  if (!lex_match_id ("ON") && !lex_match_id ("OFF")) 
+  lex_match (lexer, '=');
+  if (!lex_match_id (lexer, "ON") && !lex_match_id (lexer, "OFF")) 
     {
-      if (token == T_STRING)
-        lex_get ();
+      if (lex_token (lexer) == T_STRING)
+        lex_get (lexer);
       else
         {
-          lex_error (NULL);
+          lex_error (lexer, NULL);
           return 0;
         }
     }
@@ -444,14 +523,14 @@ stc_custom_journal (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void
 }
 
 static int
-stc_custom_listing (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
+stc_custom_listing (struct lexer *lexer, struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void *aux UNUSED)
 {
   bool listing;
 
-  lex_match ('=');
-  if (lex_match_id ("ON") || lex_match_id ("YES"))
+  lex_match (lexer, '=');
+  if (lex_match_id (lexer, "ON") || lex_match_id (lexer, "YES"))
     listing = true;
-  else if (lex_match_id ("OFF") || lex_match_id ("NO"))
+  else if (lex_match_id (lexer, "OFF") || lex_match_id (lexer, "NO"))
     listing = false;
   else
     {
@@ -464,9 +543,9 @@ stc_custom_listing (struct dataset *ds UNUSED, struct cmd_set *cmd UNUSED, void
 }
 
 static int
-stc_custom_disk (struct dataset *ds, struct cmd_set *cmd UNUSED, void *aux)
+stc_custom_disk (struct lexer *lexer, struct dataset *ds, struct cmd_set *cmd UNUSED, void *aux)
 {
-  return stc_custom_listing (ds, cmd, aux);
+  return stc_custom_listing (lexer, ds, cmd, aux);
 }
 \f
 static void
@@ -555,6 +634,18 @@ show_endcmd (const struct dataset *ds UNUSED)
   msg (SN, _("ENDCMD is \"%c\"."), get_endcmd ());
 }
 
+static void
+show_errors (const struct dataset *ds UNUSED) 
+{
+  bool terminal = get_error_routing_to_terminal ();
+  bool listing = get_error_routing_to_listing ();
+  msg (SN, _("ERRORS is \"%s\"."),
+       terminal && listing ? "BOTH"
+       : terminal ? "TERMINAL"
+       : listing ? "LISTING"
+       : "NONE");
+}
+
 static void
 show_format (const struct dataset *ds UNUSED) 
 {
@@ -586,6 +677,78 @@ show_mxwarns (const struct dataset *ds UNUSED)
   msg (SN, _("MXWARNS is %d."), get_mxwarns ());
 }
 
+/* Outputs that SETTING has the given INTEGER_FORMAT value. */
+static void
+show_integer_format (const char *setting, enum integer_format integer_format) 
+{
+  msg (SN, _("%s is %s (%s)."),
+       setting,
+       (integer_format == INTEGER_MSB_FIRST ? "MSBFIRST"
+        : integer_format == INTEGER_LSB_FIRST ? "LSBFIRST"
+        : "VAX"),
+       integer_format == INTEGER_NATIVE ? "NATIVE" : "nonnative");
+}
+
+/* Outputs that SETTING has the given FLOAT_FORMAT value. */
+static void
+show_float_format (const char *setting, enum float_format float_format) 
+{
+  const char *format_name = "";
+  
+  switch (float_format)
+    {
+    case FLOAT_IEEE_SINGLE_LE:
+      format_name = "ISL (32-bit IEEE 754 single, little-endian)";
+      break;
+    case FLOAT_IEEE_SINGLE_BE:
+      format_name = "ISB (32-bit IEEE 754 single, big-endian)";
+      break;
+    case FLOAT_IEEE_DOUBLE_LE:
+      format_name = "IDL (64-bit IEEE 754 double, little-endian)";
+      break;
+    case FLOAT_IEEE_DOUBLE_BE:
+      format_name = "IDB (64-bit IEEE 754 double, big-endian)";
+      break;
+
+    case FLOAT_VAX_F:
+      format_name = "VF (32-bit VAX F, VAX-endian)";
+      break;
+    case FLOAT_VAX_D:
+      format_name = "VD (64-bit VAX D, VAX-endian)";
+      break;
+    case FLOAT_VAX_G:
+      format_name = "VG (64-bit VAX G, VAX-endian)";
+      break;
+
+    case FLOAT_Z_SHORT:
+      format_name = "ZS (32-bit IBM Z hexadecimal short, big-endian)";
+      break;
+    case FLOAT_Z_LONG:
+      format_name = "ZL (64-bit IBM Z hexadecimal long, big-endian)";
+      break;
+
+    case FLOAT_FP:
+    case FLOAT_HEX:
+      NOT_REACHED ();
+    }
+
+  msg (SN, _("%s is %s (%s)."),
+       setting, format_name,
+       float_format == FLOAT_NATIVE_DOUBLE ? "NATIVE" : "nonnative");
+}
+
+static void
+show_rib (const struct dataset *ds UNUSED) 
+{
+  show_integer_format ("RIB", data_in_get_integer_format ());
+}
+
+static void
+show_rrb (const struct dataset *ds UNUSED) 
+{
+  show_float_format ("RRB", data_in_get_float_format ());
+}
+
 static void
 show_scompression (const struct dataset *ds UNUSED) 
 {
@@ -611,7 +774,19 @@ show_weight (const struct dataset *ds)
   if (var == NULL)
     msg (SN, _("WEIGHT is off."));
   else
-    msg (SN, _("WEIGHT is variable %s."), var->name);
+    msg (SN, _("WEIGHT is variable %s."), var_get_name (var));
+}
+
+static void
+show_wib (const struct dataset *ds UNUSED) 
+{
+  show_integer_format ("WIB", data_out_get_integer_format ());
+}
+
+static void
+show_wrb (const struct dataset *ds UNUSED) 
+{
+  show_float_format ("WRB", data_out_get_float_format ());
 }
 
 static void
@@ -636,14 +811,19 @@ const struct show_sbc show_table[] =
     {"CCE", show_cce},
     {"DECIMALS", show_decimals},
     {"ENDCMD", show_endcmd},
+    {"ERRORS", show_errors},      
     {"FORMAT", show_format},
     {"LENGTH", show_length},
     {"MXERRS", show_mxerrs},
     {"MXLOOPS", show_mxloops},
     {"MXWARNS", show_mxwarns},
+    {"RIB", show_rib},
+    {"RRB", show_rrb},
     {"SCOMPRESSION", show_scompression},
     {"UNDEFINED", show_undefined},
     {"WEIGHT", show_weight},
+    {"WIB", show_wib},
+    {"WRB", show_wrb},
     {"WIDTH", show_width},
   };
 
@@ -678,9 +858,9 @@ show_copying (const struct dataset *ds UNUSED)
 }
 
 int
-cmd_show (struct dataset *ds) 
+cmd_show (struct lexer *lexer, struct dataset *ds) 
 {
-  if (token == '.') 
+  if (lex_token (lexer) == '.') 
     {
       show_all (ds);
       return CMD_SUCCESS;
@@ -688,38 +868,38 @@ cmd_show (struct dataset *ds)
 
   do 
     {
-      if (lex_match (T_ALL))
+      if (lex_match (lexer, T_ALL))
         show_all (ds);
-      else if (lex_match_id ("CC")) 
+      else if (lex_match_id (lexer, "CC")) 
         show_all_cc ();
-      else if (lex_match_id ("WARRANTY"))
+      else if (lex_match_id (lexer, "WARRANTY"))
         show_warranty (ds);
-      else if (lex_match_id ("COPYING"))
+      else if (lex_match_id (lexer, "COPYING"))
         show_copying (ds);
-      else if (token == T_ID)
+      else if (lex_token (lexer) == T_ID)
         {
           int i;
 
           for (i = 0; i < sizeof show_table / sizeof *show_table; i++)
-            if (lex_match_id (show_table[i].name)) 
+            if (lex_match_id (lexer, show_table[i].name)) 
               {
                 show_table[i].function (ds);
                 goto found;
               }
-          lex_error (NULL);
+          lex_error (lexer, NULL);
           return CMD_FAILURE;
 
         found: ;
         }
       else 
         {
-          lex_error (NULL);
+          lex_error (lexer, NULL);
           return CMD_FAILURE;
         }
 
-      lex_match ('/');
+      lex_match (lexer, '/');
     }
-  while (token != '.');
+  while (lex_token (lexer) != '.');
 
   return CMD_SUCCESS;
 }