Adopt use of gnulib for portability.

[pspp-builds.git] / src / q2c.c

diff --git a/src/q2c.c b/src/q2c.c
index 39a6cc4ec610d09152d3a6091a78f9e1fc3af790..545f26fe56cf2404008f8e76dc3929d307bb0544 100644 (file)
--- a/src/q2c.c
+++ b/src/q2c.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 <assert.h>
@@ -342,14 +342,11 @@ find_symbol (int x)
 #if DEBUGGING 
 /* Writes a printable representation of the current token to
    stdout. */
-void
+static void
 dump_token (void)
 {
   switch (token)
     {
-    case T_TSTRING:
-      printf ("TR_STRING\t\"%s\"\n", tokstr);
-      break;
     case T_STRING:
       printf ("STRING\t\"%s\"\n", tokstr);
       break;
@@ -535,6 +532,13 @@ typedef enum
   }
 subcommand_type;
 
+typedef enum
+  {
+    ARITY_ONCE_EXACTLY,  /* must occur exactly once */
+    ARITY_ONCE_ONLY,     /* zero or once */
+    ARITY_MANY           /* 0, 1, ... , inf */
+  }subcommand_arity;
+
 /* A single subcommand. */
 typedef struct subcommand subcommand;
 struct subcommand
@@ -542,7 +546,7 @@ struct subcommand
     subcommand *next;          /* Next in the chain. */
     char *name;                        /* Subcommand name. */
     subcommand_type type;      /* One of SBC_*. */
-    int once;                  /* 1=Subcommand may appear only once. */
+    subcommand_arity arity;    /* How many times should the subcommand occur*/
     int narray;                        /* Index of next array element. */
     const char *prefix;                /* Prefix for variable and constant names. */
     specifier *spec;           /* Array of specifiers. */
@@ -705,6 +709,15 @@ parse_specifier (specifier *spec, subcommand *sbc)
     }
   skip_token (':');
   
+  if ( sbc->type == SBC_ARRAY && token == T_ID ) 
+    {
+       spec->varname = xstrdup (st_lower (tokstr));
+       spec->index = sbc->narray;
+       sbc->narray++;
+    }
+    
+  
+  
   /* Parse all the settings. */
   {
     setting **s = &spec->s;
@@ -750,6 +763,8 @@ parse_specifiers (subcommand *sbc)
 static void
 parse_subcommand (subcommand *sbc)
 {
+  sbc->arity = ARITY_MANY;
+
   if (match_token ('*'))
     {
       if (def)
@@ -757,7 +772,11 @@ parse_subcommand (subcommand *sbc)
       def = sbc;
     }
 
-  sbc->once = match_token ('+');
+  if ( match_token('+'))
+    sbc->arity = ARITY_ONCE_ONLY ;
+  else if (match_token('^'))
+    sbc->arity = ARITY_ONCE_EXACTLY ;
+
 
   force_id ();
   sbc->name = xstrdup (tokstr);
@@ -779,6 +798,7 @@ parse_subcommand (subcommand *sbc)
       
       sbc->type = SBC_ARRAY;
       parse_specifiers (sbc);
+
     }
   else
     {
@@ -1062,7 +1082,6 @@ dump_declarations (void)
            specifier *spec;
 
            for (spec = sbc->spec; spec; spec = spec->next)
-             if (!spec->s)
                dump (0, "%s%s%s = %d,",
                      st_upper (prefix), st_upper (sbc->prefix),
                      st_upper (spec->varname), spec->index);
@@ -1108,8 +1127,12 @@ dump_declarations (void)
                              spec->varname);
                      else if (f == 0)
                        {
-                         dump (0, "int a_%s[%d];", 
-                               st_lower (sbc->name), sbc->narray);
+                         dump (0, "int a_%s[%s%scount];", 
+                               st_lower (sbc->name), 
+                               st_upper (prefix),
+                               st_upper (sbc->prefix)
+                               );
+
                          f = 1;
                        }
                    }
@@ -1390,6 +1413,7 @@ dump_specifier_parse (const specifier *spec, const subcommand *sbc)
        dump (1, "%sif (%s)", first ? "" : "else ",
              make_match (s->specname));
 
+
       /* Handle values. */
       if (s->value == VAL_NONE)
        dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
@@ -1400,9 +1424,18 @@ dump_specifier_parse (const specifier *spec, const subcommand *sbc)
            dump (1, "{");
          
          if (spec->varname)
-           dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
-                 st_upper (prefix), find_symbol (s->con)->name);
-         
+           {
+             dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
+                   st_upper (prefix), find_symbol (s->con)->name);
+
+             if ( sbc->type == SBC_ARRAY ) 
+               dump (0, "p->a_%s[%s%s%s] = 1;",
+                     st_lower (sbc->name),
+                     st_upper (prefix), st_upper (sbc->prefix),
+                     st_upper (spec->varname));
+           }
+
+
          if (s->valtype == VT_PAREN)
            {
              if (s->optvalue)
@@ -1425,7 +1458,7 @@ dump_specifier_parse (const specifier *spec, const subcommand *sbc)
 
          if (s->value == VAL_INT)
            {
-             dump (1, "if (!lex_integer_p ())");
+             dump (1, "if (!lex_is_integer ())");
              dump (1, "{");
              dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
                    "requires an integer argument.\"));",
@@ -1437,7 +1470,7 @@ dump_specifier_parse (const specifier *spec, const subcommand *sbc)
            }
          else
            {
-             dump (1, "if (token != T_NUM)");
+             dump (1, "if (!lex_is_number ())");
              dump (1, "{");
              dump (0, "msg (SE, _(\"Number expected after %s "
                    "specifier of %s subcommand.\"));",
@@ -1588,7 +1621,7 @@ dump_subcommand (const subcommand *sbc)
     {
       dump (0, "p->%sv_%s = parse_variable ();",
            st_lower (sbc->prefix), st_lower (sbc->name));
-      dump (1, "if (p->%sv_%s)",
+      dump (1, "if (!p->%sv_%s)",
            st_lower (sbc->prefix), st_lower (sbc->name));
       dump (0, "goto lossage;");
       outdent ();
@@ -1625,7 +1658,7 @@ dump_subcommand (const subcommand *sbc)
     {
       dump (1, "if (!lex_force_num ())");
       dump (0, "goto lossage;");
-      dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_double ();", 
+      dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number ();", 
            st_lower (sbc->name), st_lower (sbc->name) );
       dump (0, "lex_get();");
     }
@@ -1677,7 +1710,7 @@ dump_subcommand (const subcommand *sbc)
       dump (0, "goto lossage;");
       dump (-1,"}");
 
-      dump (0, "subc_list_double_push(&p->dl_%s[p->sbc_%s-1],lex_double ());", 
+      dump (0, "subc_list_double_push(&p->dl_%s[p->sbc_%s-1],lex_number ());", 
            st_lower (sbc->name),st_lower (sbc->name)
            );
 
@@ -1782,7 +1815,7 @@ dump_parser (int persistent)
 
        dump (0, "lex_match ('=');");
        dump (0, "p->sbc_%s++;", st_lower (sbc->name));
-       if (sbc->once)
+       if (sbc->arity != ARITY_MANY)
          {
            dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
            dump (1, "{");
@@ -1797,6 +1830,8 @@ dump_parser (int persistent)
        outdent ();
       }
   }
+
+
   /* Now deal with the /ALGORITHM subcommand implicit to all commands */
   dump(1,"else if ( get_syntax() != COMPATIBLE && lex_match_id(\"ALGORITHM\"))");
   dump(1,"{");
@@ -1812,6 +1847,7 @@ dump_parser (int persistent)
   dump (-1, "}");
   outdent ();
 
+
   
   dump (1, "if (!lex_match ('/'))");
   dump (0, "break;");
@@ -1824,6 +1860,29 @@ dump_parser (int persistent)
   dump (0, "goto lossage;");
   dump (-1, "}");
   dump (0, nullstr);
+
+  outdent ();
+
+  {
+    /*  Check that mandatory subcommands have been specified  */
+    subcommand *sbc;
+
+    for (sbc = subcommands; sbc; sbc = sbc->next)
+      {
+
+       if ( sbc->arity == ARITY_ONCE_EXACTLY ) 
+         {
+           dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
+           dump (1, "{");
+           dump (0, "msg (SE, _(\"%s subcommand must be given.\"));",
+                 sbc->name);
+           dump (0, "goto lossage;");
+           dump (-1, "}");
+           dump (0, nullstr);
+         }
+      }
+  }
+
   dump (-1, "return 1;");
   dump (0, nullstr);
   dump (-1, "lossage:");
@@ -1999,11 +2058,6 @@ dump_header (void)
   dump (0, "   Generated by q2c from %s on %s.", ifn, timep);
   dump (0, "   Do not modify!");
   dump (0, " */");
-
-  dump (0, nullstr);
-  dump (0, "#include \"settings.h\"");
-  dump (0, "#include \"subclist.h\"");
-  dump (0, nullstr);
 }
 
 /* Write out commands to free variable state. */
@@ -2040,11 +2094,17 @@ dump_free (int persistent)
        {
          switch (sbc->type) 
            {
+            case SBC_VARLIST:
+             dump (0, "free (p->v_variables);");
+              break;
            case SBC_STRING:
              dump (0, "free (p->s_%s);", st_lower (sbc->name));
              break;
            case SBC_DBL_LIST:
-             dump (0, "subc_list_double_destroy(p->dl_%s);", st_lower (sbc->name));
+             dump (0, "int i;");
+             dump (1, "for(i = 0; i < MAXLISTS ; ++i)");
+             dump (0, "subc_list_double_destroy(&p->dl_%s[i]);", st_lower (sbc->name));
+             outdent();
              break;
            default:
              break;
@@ -2142,9 +2202,14 @@ main (int argc, char *argv[])
          dump (0, "#include \"alloc.h\"");
          dump (0, "#include \"error.h\"");
          dump (0, "#include \"lexer.h\"");
+          dump (0, "#include \"settings.h\"");
          dump (0, "#include \"str.h\"");
+          dump (0, "#include \"subclist.h\"");
          dump (0, "#include \"var.h\"");
+         dump (0, nullstr);
 
+          dump (0, "#include \"gettext.h\"");
+          dump (0, "#define _(msgid) gettext (msgid)");
          dump (0, nullstr);
        }
       else if (!strcmp (directive, "declarations"))