X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=src%2Fq2c.c;h=7af81865ad663b4808aea707976b7b4223979156;hb=304c185799902df1dd96a8ff2d13d279005a82e5;hp=707cf2728bc09028e627f3ba159858ad2546ecc7;hpb=721f67e477ee5050961020ed5afd8e0daf42bf2d;p=pspp-builds.git

diff --git a/src/q2c.c b/src/q2c.c
index 707cf272..7af81865 100644
--- a/src/q2c.c
+++ b/src/q2c.c
@@ -30,6 +30,7 @@
 #endif
 #include "str.h"
 
+
 /* Brokenness. */
 #ifndef EXIT_SUCCESS
 #define EXIT_SUCCESS 0
@@ -534,6 +535,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
@@ -541,7 +549,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. */
@@ -704,6 +712,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;
@@ -749,6 +766,8 @@ parse_specifiers (subcommand *sbc)
 static void
 parse_subcommand (subcommand *sbc)
 {
+  sbc->arity = ARITY_MANY;
+
   if (match_token ('*'))
     {
       if (def)
@@ -756,7 +775,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);
@@ -778,6 +801,7 @@ parse_subcommand (subcommand *sbc)
       
       sbc->type = SBC_ARRAY;
       parse_specifiers (sbc);
+
     }
   else
     {
@@ -837,7 +861,12 @@ parse_subcommand (subcommand *sbc)
       else if (match_id ("PINT"))
 	sbc->type = SBC_PINT;
       else if (match_id ("DOUBLE"))
-	sbc->type = match_id ("LIST") ? SBC_DBL_LIST : SBC_DBL;
+	{
+	  if ( match_id ("LIST") )
+	    sbc->type = SBC_DBL_LIST;
+	  else
+	    sbc->type = SBC_DBL;
+	}
       else if (match_id ("STRING"))
 	{
 	  sbc->type = SBC_STRING;
@@ -1033,6 +1062,12 @@ dump_declarations (void)
       }
   }
 
+  /* Write out some type definitions */
+  {
+    dump (0, "#define MAXLISTS 10");
+  }
+
+
   /* For every array subcommand, write out the associated enumerated
      values. */
   {
@@ -1050,7 +1085,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);
@@ -1096,8 +1130,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;
 			}
 		    }
@@ -1125,13 +1163,24 @@ dump_declarations (void)
 
 	  case SBC_INT:
 	  case SBC_PINT:
-	    dump (0, "long n_%s;", st_lower (sbc->name));
+	    dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
 	    break;
 
 	  case SBC_DBL:
-	    dump (0, "double n_%s;", st_lower (sbc->name));
+	    dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
+	    break;
+
+	  case SBC_DBL_LIST:
+	    dump (0, "subc_list_double dl_%s[MAXLISTS];",
+		  st_lower(sbc->name));
+	    break;
+
+	  case SBC_INT_LIST:
+	    dump (0, "subc_list_int il_%s[MAXLISTS];",
+		  st_lower(sbc->name));
 	    break;
 
+
 	  default:;
 	    /* nothing */
 	  }
@@ -1227,9 +1276,27 @@ dump_vars_init (int persistent)
 	  {
 	    switch (sbc->type)
 	      {
-	      case SBC_DBL:
 	      case SBC_INT_LIST:
+		break;
+
 	      case SBC_DBL_LIST:
+		dump (1, "{");
+		dump (0, "int i;");
+		dump (1, "for (i = 0; i < MAXLISTS; ++i)");
+		dump (0, "subc_list_double_create(&p->dl_%s[i]) ;",
+		      st_lower (sbc->name)
+		      );
+		dump (-2, "}");
+		break;
+
+	      case SBC_DBL:
+		dump (1, "{");
+		dump (0, "int i;");
+		dump (1, "for (i = 0; i < MAXLISTS; ++i)");
+		dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
+		dump (-2, "}");
+		break;
+
 	      case SBC_CUSTOM:
 		/* nothing */
 		break;
@@ -1274,7 +1341,11 @@ dump_vars_init (int persistent)
 
 	      case SBC_INT:
 	      case SBC_PINT:
-		dump (0, "p->n_%s = NOT_LONG;", st_lower (sbc->name));
+		dump (1, "{");
+		dump (0, "int i;");
+		dump (1, "for (i = 0; i < MAXLISTS; ++i)");
+		dump (0, "p->n_%s[i] = NOT_LONG;", st_lower (sbc->name));
+		dump (-2, "}");
 		break;
 
 	      default:
@@ -1345,6 +1416,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,
@@ -1355,9 +1427,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)
@@ -1380,7 +1461,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.\"));",
@@ -1392,7 +1473,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.\"));",
@@ -1543,7 +1624,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 ();
@@ -1570,7 +1651,7 @@ dump_subcommand (const subcommand *sbc)
 	  outdent ();
 	}
       dump (0, "free(p->s_%s);", st_lower(sbc->name) );
-      dump (0, "p->s_%s = xstrdup (ds_value (&tokstr));",
+      dump (0, "p->s_%s = xstrdup (ds_c_str (&tokstr));",
 	    st_lower (sbc->name));
       dump (0, "lex_get ();");
       if (sbc->restriction)
@@ -1580,7 +1661,8 @@ dump_subcommand (const subcommand *sbc)
     {
       dump (1, "if (!lex_force_num ())");
       dump (0, "goto lossage;");
-      dump (-1, "p->n_%s = lex_double ();", st_lower (sbc->name));
+      dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number ();", 
+	    st_lower (sbc->name), st_lower (sbc->name) );
       dump (0, "lex_get();");
     }
   else if (sbc->type == SBC_INT)
@@ -1595,7 +1677,7 @@ dump_subcommand (const subcommand *sbc)
        {
 	  char buf[1024];
 	  dump (1, "if (!(%s))", sbc->restriction);
-	  dump (1, "{");
+	  dump (1, "{"); 
           sprintf(buf,sbc->message,sbc->name);
 	  if ( sbc->translatable ) 
 		  dump (0, "msg (SE, gettext(\"%s\"));",buf);
@@ -1604,7 +1686,7 @@ dump_subcommand (const subcommand *sbc)
 	  dump (0, "goto lossage;");
 	  dump (-1, "}");
       }
-      dump (-1, "p->n_%s = x;", st_lower (sbc->name));
+      dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
       dump (-1,"}");
     }
   else if (sbc->type == SBC_PINT)
@@ -1615,6 +1697,30 @@ dump_subcommand (const subcommand *sbc)
       dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
       dump (0, "lex_match (')');");
     }
+  else if (sbc->type == SBC_DBL_LIST)
+    {
+      dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
+      dump (1, "{");
+      dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
+      dump (0, "goto lossage;");
+      dump (-1,"}");
+
+      dump (1, "while (token != '/' && token != '.')");
+      dump (1, "{");
+      dump (0, "lex_match(',');");
+      dump (0, "if (!lex_force_num ())");
+      dump (1, "{");
+      dump (0, "goto lossage;");
+      dump (-1,"}");
+
+      dump (0, "subc_list_double_push(&p->dl_%s[p->sbc_%s-1],lex_number ());", 
+	    st_lower (sbc->name),st_lower (sbc->name)
+	    );
+
+      dump (0, "lex_get();");
+      dump (-1,"}");
+
+    }
   else if (sbc->type == SBC_CUSTOM)
     {
       dump (1, "switch (%scustom_%s (p))",
@@ -1712,7 +1818,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, "{");
@@ -1727,6 +1833,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,"{");
@@ -1742,6 +1850,7 @@ dump_parser (int persistent)
   dump (-1, "}");
   outdent ();
 
+
   
   dump (1, "if (!lex_match ('/'))");
   dump (0, "break;");
@@ -1754,6 +1863,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:");
@@ -1790,7 +1922,12 @@ dump_aux_subcommand (const subcommand *sbc)
     }
   else if (sbc->type == SBC_INT)
     {
-      dump (0, "msg(MM,\"%s is %%ld\",p->n_%s);", sbc->name,st_lower(sbc->name) ); 
+      dump (1, "{");
+      dump (0, "int i;");
+      dump (1, "for (i = 0; i < MAXLISTS; ++i)");
+      dump (0, "msg(MM,\"%s is %%ld\",p->n_%s[i]);", sbc->name,st_lower(sbc->name) ); 
+      outdent();
+      dump (-1, "}");
     }
   else if (sbc->type == SBC_CUSTOM)
     {
@@ -1924,10 +2061,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, nullstr);
 }
 
 /* Write out commands to free variable state. */
@@ -1943,8 +2076,13 @@ dump_free (int persistent)
   if ( ! persistent ) 
     {
       for (sbc = subcommands; sbc; sbc = sbc->next)
+	{
 	if (sbc->type == SBC_STRING)
 	  used = 1;
+	if (sbc->type == SBC_DBL_LIST)
+	  used = 1;
+	}
+
     }
 
   dump (0, "static void");
@@ -1956,8 +2094,25 @@ dump_free (int persistent)
     {
 
       for (sbc = subcommands; sbc; sbc = sbc->next)
-	if (sbc->type == SBC_STRING)
-	  dump (0, "free (p->s_%s);", st_lower (sbc->name));
+	{
+	  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, "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;
+	    }
+	}
     }
 
   dump (-1, "}");
@@ -2030,7 +2185,7 @@ main (int argc, char *argv[])
 	  continue;
 	}
       
-      dump (0, "#line %d \"%s\"", oln - 1, ofn);
+      dump (0, "#line %d \"%s\"", oln + 1, ofn);
       if (!strcmp (directive, "specification"))
 	{
 	  /* Skip leading slash-star line. */
@@ -2050,7 +2205,9 @@ 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);