1 /* PSPP - a program for statistical analysis.
2 Copyright (C) 1997-9, 2000, 2008 Free Software Foundation, Inc.
4 This program is free software: you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation, either version 3 of the License, or
7 (at your option) any later version.
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
14 You should have received a copy of the GNU General Public License
15 along with this program. If not, see <http://www.gnu.org/licenses/>. */
27 /* GNU C allows the programmer to declare that certain functions take
28 printf-like arguments, never return, etc. Conditionalize these
29 declarations on whether gcc is in use. */
31 #define ATTRIBUTE(X) __attribute__ (X)
36 /* Marks a function argument as possibly not used. */
37 #define UNUSED ATTRIBUTE ((unused))
39 /* Marks a function that will never return. */
40 #define NO_RETURN ATTRIBUTE ((noreturn))
42 /* Mark a function as taking a printf- or scanf-like format
43 string as its FMT'th argument and that the FIRST'th argument
44 is the first one to be checked against the format string. */
45 #define PRINTF_FORMAT(FMT, FIRST) ATTRIBUTE ((format (__printf__, FMT, FIRST)))
47 /* Max length of an input line. */
48 #define MAX_LINE_LEN 1024
50 /* Max token length. */
51 #define MAX_TOK_LEN 1024
54 static char *program_name;
56 /* Have the input and output files been opened yet? */
59 /* Input, output files. */
60 static FILE *in, *out;
62 /* Input, output file names. */
63 static char *ifn, *ofn;
65 /* Input, output file line number. */
66 static int ln, oln = 1;
68 /* Input line buffer, current position. */
69 static char *buf, *cp;
74 T_STRING = 256, /* String literal. */
75 T_ID = 257 /* Identifier. */
78 /* Current token: either one of the above, or a single character. */
81 /* Token string value. */
84 /* Utility functions. */
86 static char nullstr[] = "";
88 /* Close all open files and delete the output file, on failure. */
97 if (remove (ofn) == -1)
98 fprintf (stderr, "%s: %s: remove: %s\n", program_name, ofn, strerror (errno));
101 void hcf (void) NO_RETURN;
103 /* Terminate unsuccessfully. */
111 int fail (const char *, ...) PRINTF_FORMAT (1, 2);
112 int error (const char *, ...) PRINTF_FORMAT (1, 2);
114 /* Output an error message and terminate unsuccessfully. */
116 fail (const char *format, ...)
120 va_start (args, format);
121 fprintf (stderr, "%s: ", program_name);
122 vfprintf (stderr, format, args);
123 fprintf (stderr, "\n");
129 /* Output a context-dependent error message and terminate
132 error (const char *format,...)
136 va_start (args, format);
137 fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
138 vfprintf (stderr, format, args);
139 fprintf (stderr, "\n");
145 #define VME "virtual memory exhausted"
147 /* Allocate a block of SIZE bytes and return a pointer to its
150 xmalloc (size_t size)
159 fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
164 /* Make a dynamically allocated copy of string S and return a pointer
165 to the first character. */
167 xstrdup (const char *s)
173 size = strlen (s) + 1;
177 fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
183 /* Returns a pointer to one of 8 static buffers. The buffers are used
188 static char b[8][256];
197 /* Copies a string to a static buffer, converting it to lowercase in
198 the process, and returns a pointer to the static buffer. */
200 st_lower (const char *s)
204 p = cp = get_buffer ();
206 *cp++ = tolower ((unsigned char) (*s++));
212 /* Copies a string to a static buffer, converting it to uppercase in
213 the process, and returns a pointer to the static buffer. */
215 st_upper (const char *s)
219 p = cp = get_buffer ();
221 *cp++ = toupper ((unsigned char) (*s++));
227 /* Returns the address of the first non-whitespace character in S, or
228 the address of the null terminator if none. */
230 skip_ws (const char *s)
232 while (isspace ((unsigned char) *s))
237 /* Read one line from the input file into buf. Lines having special
238 formats are handled specially. */
243 if (0 == fgets (buf, MAX_LINE_LEN, in))
246 fail ("%s: fgets: %s", ifn, strerror (errno));
250 cp = strchr (buf, '\n');
258 /* Symbol table manager. */
260 /* Symbol table entry. */
261 typedef struct symbol symbol;
264 symbol *next; /* Next symbol in symbol table. */
265 char *name; /* Symbol name. */
266 int unique; /* 1=Name must be unique in this file. */
267 int ln; /* Line number of definition. */
268 int value; /* Symbol value. */
274 /* Add a symbol to the symbol table having name NAME, uniqueness
275 UNIQUE, and value VALUE. If a symbol having the same name is found
276 in the symbol table, its sequence number is returned and the symbol
277 table is not modified. Otherwise, the symbol is added and the next
278 available sequence number is returned. */
280 add_symbol (const char *name, int unique, int value)
285 sym = xmalloc (sizeof *sym);
286 sym->name = xstrdup (name);
287 sym->unique = unique;
300 if (!strcmp (iter->name, name))
304 fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
306 fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
323 /* Finds the symbol having given sequence number X within the symbol
324 table, and returns the associated symbol structure. */
331 while (x > 1 && iter)
341 /* Writes a printable representation of the current token to
349 printf ("STRING\t\"%s\"\n", tokstr);
352 printf ("ID\t%s\n", tokstr);
355 printf ("PUNCT\t%c\n", token);
358 #endif /* DUMP_TOKENS */
361 const char hyphen_proxy = '_';
369 while (*src == '_' || *src == '-' || isalnum ((unsigned char) *src))
371 *dest++ = *src == '-' ? hyphen_proxy :toupper ((unsigned char) (*src));
380 unmunge (const char *s)
382 char *dest = xmalloc (strlen (s));
387 if (*s == hyphen_proxy)
398 /* Reads a token from the input file. */
402 /* Skip whitespace and check for end of file. */
410 fail ("%s: Unexpected end of file.", ifn);
418 while (*cp != '"' && *cp)
424 error ("Unterminated string literal.");
432 error ("Unterminated string literal.");
435 else if (*cp == '_' || isalnum ((unsigned char) *cp))
452 /* Force the current token to be an identifier token. */
457 error ("Identifier expected.");
460 /* Force the current token to be a string token. */
464 if (token != T_STRING)
465 error ("String expected.");
468 /* Checks whether the current token is the identifier S; if so, skips
469 the token and returns true; otherwise, returns false. */
471 match_id (const char *s)
473 if (token == T_ID && !strcmp (tokstr, s))
481 /* Checks whether the current token is T. If so, skips the token and
482 returns true; otherwise, returns false. */
494 /* Force the current token to be T, and skip it. */
499 error ("`%c' expected.", t);
505 /* Some specifiers have associated values. */
508 VAL_NONE, /* No value. */
509 VAL_INT, /* Integer value. */
510 VAL_DBL, /* Floating point value. */
511 VAL_STRING /* String value. */
514 /* For those specifiers with values, the syntax of those values. */
517 VT_PLAIN, /* Unadorned value. */
518 VT_PAREN /* Value must be enclosed in parentheses. */
521 /* Forward definition. */
522 typedef struct specifier specifier;
524 /* A single setting. */
525 typedef struct setting setting;
528 specifier *parent; /* Owning specifier. */
529 setting *next; /* Next in the chain. */
530 char *specname; /* Name of the setting. */
531 int con; /* Sequence number. */
534 int valtype; /* One of VT_*. */
535 int value; /* One of VAL_*. */
536 int optvalue; /* 1=value is optional, 0=value is required. */
537 char *valname; /* Variable name for the value. */
538 char *restriction; /* !=NULL: expression specifying valid values. */
541 /* A single specifier. */
544 specifier *next; /* Next in the chain. */
545 char *varname; /* Variable name. */
546 setting *s; /* Associated settings. */
548 setting *def; /* Default setting. */
549 setting *omit_kw; /* Setting for which the keyword can be omitted. */
551 int index; /* Next array index. */
554 /* Subcommand types. */
557 SBC_PLAIN, /* The usual case. */
558 SBC_VARLIST, /* Variable list. */
559 SBC_INT, /* Integer value. */
560 SBC_PINT, /* Integer inside parentheses. */
561 SBC_DBL, /* Floating point value. */
562 SBC_INT_LIST, /* List of integers (?). */
563 SBC_DBL_LIST, /* List of floating points (?). */
564 SBC_CUSTOM, /* Custom. */
565 SBC_ARRAY, /* Array of boolean values. */
566 SBC_STRING, /* String value. */
567 SBC_VAR /* Single variable name. */
573 ARITY_ONCE_EXACTLY, /* must occur exactly once */
574 ARITY_ONCE_ONLY, /* zero or once */
575 ARITY_MANY /* 0, 1, ... , inf */
578 /* A single subcommand. */
579 typedef struct subcommand subcommand;
582 subcommand *next; /* Next in the chain. */
583 char *name; /* Subcommand name. */
584 subcommand_type type; /* One of SBC_*. */
585 subcommand_arity arity; /* How many times should the subcommand occur*/
586 int narray; /* Index of next array element. */
587 const char *prefix; /* Prefix for variable and constant names. */
588 specifier *spec; /* Array of specifiers. */
590 /* SBC_STRING and SBC_INT only. */
591 char *restriction; /* Expression restricting string length. */
592 char *message; /* Error message. */
593 int translatable; /* Error message is translatable */
596 /* Name of the command; i.e., DESCRIPTIVES. */
599 /* Short prefix for the command; i.e., `dsc_'. */
602 /* List of subcommands. */
603 subcommand *subcommands;
605 /* Default subcommand if any, or NULL. */
610 void parse_subcommands (void);
612 /* Parse an entire specification. */
616 /* Get the command name and prefix. */
617 if (token != T_STRING && token != T_ID)
618 error ("Command name expected.");
619 cmdname = xstrdup (tokstr);
623 prefix = xstrdup (tokstr);
628 /* Read all the subcommands. */
631 parse_subcommands ();
634 /* Parses a single setting into S, given subcommand information SBC
635 and specifier information SPEC. */
637 parse_setting (setting *s, specifier *spec)
641 if (match_token ('*'))
644 error ("Cannot have two settings with omittable keywords.");
649 if (match_token ('!'))
652 error ("Cannot have two default settings.");
658 s->specname = xstrdup (tokstr);
659 s->con = add_symbol (s->specname, 0, 0);
664 /* Parse setting value info if necessary. */
665 if (token != '/' && token != ';' && token != '.' && token != ',')
669 s->valtype = VT_PAREN;
673 s->valtype = VT_PLAIN;
675 s->optvalue = match_token ('*');
679 else if (match_id ("D"))
681 else if (match_id ("S"))
682 s->value = VAL_STRING;
684 error ("`n', `d', or `s' expected.");
689 s->valname = xstrdup (tokstr);
696 s->restriction = xstrdup (tokstr);
700 s->restriction = NULL;
702 if (s->valtype == VT_PAREN)
707 /* Parse a single specifier into SPEC, given subcommand information
710 parse_specifier (specifier *spec, subcommand *sbc)
715 spec->omit_kw = NULL;
716 spec->varname = NULL;
720 spec->varname = xstrdup (st_lower (tokstr));
724 /* Handle array elements. */
727 spec->index = sbc->narray;
728 if (sbc->type == SBC_ARRAY)
740 if ( sbc->type == SBC_ARRAY && token == T_ID )
742 spec->varname = xstrdup (st_lower (tokstr));
743 spec->index = sbc->narray;
749 /* Parse all the settings. */
751 setting **s = &spec->s;
755 *s = xmalloc (sizeof **s);
756 parse_setting (*s, spec);
757 if (token == ',' || token == ';' || token == '.')
766 /* Parse a list of specifiers for subcommand SBC. */
768 parse_specifiers (subcommand *sbc)
770 specifier **spec = &sbc->spec;
772 if (token == ';' || token == '.')
780 *spec = xmalloc (sizeof **spec);
781 parse_specifier (*spec, sbc);
782 if (token == ';' || token == '.')
785 spec = &(*spec)->next;
787 (*spec)->next = NULL;
790 /* Parse a subcommand into SBC. */
792 parse_subcommand (subcommand *sbc)
794 if (match_token ('*'))
797 error ("Multiple default subcommands.");
801 sbc->arity = ARITY_ONCE_ONLY;
802 if ( match_token('+'))
803 sbc->arity = ARITY_MANY;
804 else if (match_token('^'))
805 sbc->arity = ARITY_ONCE_EXACTLY ;
809 sbc->name = xstrdup (tokstr);
813 sbc->type = SBC_PLAIN;
815 sbc->translatable = 0;
817 if (match_token ('['))
820 sbc->prefix = xstrdup (st_lower (tokstr));
826 sbc->type = SBC_ARRAY;
827 parse_specifiers (sbc);
832 if (match_token ('('))
835 sbc->prefix = xstrdup (st_lower (tokstr));
845 if (match_id ("VAR"))
847 if (match_id ("VARLIST"))
849 if (match_token ('('))
852 sbc->message = xstrdup (tokstr);
857 else sbc->message = NULL;
859 sbc->type = SBC_VARLIST;
861 else if (match_id ("INTEGER"))
863 sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
864 if ( token == T_STRING)
866 sbc->restriction = xstrdup (tokstr);
868 if ( match_id("N_") )
874 sbc->translatable = 1;
880 sbc->message = xstrdup (tokstr);
883 sbc->restriction = NULL;
885 else if (match_id ("PINT"))
886 sbc->type = SBC_PINT;
887 else if (match_id ("DOUBLE"))
889 if ( match_id ("LIST") )
890 sbc->type = SBC_DBL_LIST;
894 else if (match_id ("STRING"))
896 sbc->type = SBC_STRING;
897 if (token == T_STRING)
899 sbc->restriction = xstrdup (tokstr);
902 sbc->message = xstrdup (tokstr);
906 sbc->restriction = NULL;
908 else if (match_id ("CUSTOM"))
909 sbc->type = SBC_CUSTOM;
911 parse_specifiers (sbc);
915 /* Parse all the subcommands. */
917 parse_subcommands (void)
919 subcommand **sbc = &subcommands;
923 *sbc = xmalloc (sizeof **sbc);
926 parse_subcommand (*sbc);
938 #define BASE_INDENT 2 /* Starting indent. */
939 #define INC_INDENT 2 /* Indent increment. */
941 /* Increment the indent. */
942 #define indent() indent += INC_INDENT
943 #define outdent() indent -= INC_INDENT
945 /* Size of the indent from the left margin. */
948 void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
950 /* Write line FORMAT to the output file, formatted as with printf,
951 indented `indent' characters from the left margin. If INDENTION is
952 greater than 0, indents BASE_INDENT * INDENTION characters after
953 writing the line; if INDENTION is less than 0, dedents BASE_INDENT
954 * INDENTION characters _before_ writing the line. */
956 dump (int indention, const char *format, ...)
962 indent += BASE_INDENT * indention;
965 va_start (args, format);
966 for (i = 0; i < indent; i++)
968 vfprintf (out, format, args);
973 indent += BASE_INDENT * indention;
976 /* Write the structure members for specifier SPEC to the output file.
977 SBC is the including subcommand. */
979 dump_specifier_vars (const specifier *spec, const subcommand *sbc)
982 dump (0, "long %s%s;", sbc->prefix, spec->varname);
987 for (s = spec->s; s; s = s->next)
989 if (s->value != VAL_NONE)
991 const char *typename;
993 assert (s->value == VAL_INT || s->value == VAL_DBL
994 || s->value == VAL_STRING);
995 typename = (s->value == VAL_INT ? "long"
996 : s->value == VAL_DBL ? "double"
999 dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
1005 /* Returns true if string T is a PSPP keyword, false otherwise. */
1007 is_keyword (const char *t)
1009 static const char *kw[] =
1011 "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
1012 "NE", "ALL", "BY", "TO", "WITH", 0,
1016 for (cp = kw; *cp; cp++)
1017 if (!strcmp (t, *cp))
1022 /* Transforms a string NAME into a valid C identifier: makes
1023 everything lowercase and maps nonalphabetic characters to
1024 underscores. Returns a pointer to a static buffer. */
1026 make_identifier (const char *name)
1028 char *p = get_buffer ();
1031 for (cp = p; *name; name++)
1032 if (isalpha ((unsigned char) *name))
1033 *cp++ = tolower ((unsigned char) (*name));
1041 /* Writes the struct and enum declarations for the parser. */
1043 dump_declarations (void)
1047 dump (0, "struct dataset;");
1049 /* Write out enums for all the identifiers in the symbol table. */
1055 /* Note the squirmings necessary to make sure that the last enum
1056 is not followed by a comma, as mandated by ANSI C89. */
1057 for (sym = symtab, f = k = 0; sym; sym = sym->next)
1058 if (!sym->unique && !is_keyword (sym->name))
1062 dump (0, "/* Settings for subcommand specifiers. */");
1069 buf = xmalloc (1024);
1074 sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
1078 sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
1083 buf[strlen (buf) - 1] = 0;
1094 /* Write out some type definitions */
1096 dump (0, "#define MAXLISTS 10");
1100 /* For every array subcommand, write out the associated enumerated
1105 for (sbc = subcommands; sbc; sbc = sbc->next)
1106 if (sbc->type == SBC_ARRAY && sbc->narray)
1108 dump (0, "/* Array indices for %s subcommand. */", sbc->name);
1116 for (spec = sbc->spec; spec; spec = spec->next)
1117 dump (0, "%s%s%s = %d,",
1118 st_upper (prefix), st_upper (sbc->prefix),
1119 st_upper (spec->varname), spec->index);
1121 dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
1129 /* Write out structure declaration. */
1133 dump (0, "/* %s structure. */", cmdname);
1134 dump (1, "struct cmd_%s", make_identifier (cmdname));
1136 for (sbc = subcommands; sbc; sbc = sbc->next)
1140 if (sbc != subcommands)
1143 dump (0, "/* %s subcommand. */", sbc->name);
1144 dump (0, "int sbc_%s;", st_lower (sbc->name));
1153 for (spec = sbc->spec; spec; spec = spec->next)
1157 if (sbc->type == SBC_PLAIN)
1158 dump (0, "long int %s%s;", st_lower (sbc->prefix),
1162 dump (0, "int a_%s[%s%scount];",
1163 st_lower (sbc->name),
1165 st_upper (sbc->prefix)
1172 dump_specifier_vars (spec, sbc);
1178 dump (0, "size_t %sn_%s;", st_lower (sbc->prefix),
1179 st_lower (sbc->name));
1180 dump (0, "const struct variable **%sv_%s;", st_lower (sbc->prefix),
1181 st_lower (sbc->name));
1185 dump (0, "const struct variable *%sv_%s;", st_lower (sbc->prefix),
1186 st_lower (sbc->name));
1190 dump (0, "char *s_%s;", st_lower (sbc->name));
1195 dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
1199 dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
1203 dump (0, "subc_list_double dl_%s[MAXLISTS];",
1204 st_lower(sbc->name));
1208 dump (0, "subc_list_int il_%s[MAXLISTS];",
1209 st_lower(sbc->name));
1222 /* Write out prototypes for custom_*() functions as necessary. */
1227 for (sbc = subcommands; sbc; sbc = sbc->next)
1228 if (sbc->type == SBC_CUSTOM)
1233 dump (0, "/* Prototype for custom subcommands of %s. */",
1236 dump (0, "static int %scustom_%s (struct lexer *, struct dataset *, struct cmd_%s *, void *);",
1237 st_lower (prefix), st_lower (sbc->name),
1238 make_identifier (cmdname));
1245 /* Prototypes for parsing and freeing functions. */
1247 dump (0, "/* Command parsing functions. */");
1248 dump (0, "static int parse_%s (struct lexer *, struct dataset *, struct cmd_%s *, void *);",
1249 make_identifier (cmdname), make_identifier (cmdname));
1250 dump (0, "static void free_%s (struct cmd_%s *);",
1251 make_identifier (cmdname), make_identifier (cmdname));
1256 /* Writes out code to initialize all the variables that need
1257 initialization for particular specifier SPEC inside subcommand SBC. */
1259 dump_specifier_init (const specifier *spec, const subcommand *sbc)
1267 st_upper (prefix), find_symbol (spec->def->con)->name);
1270 dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
1276 for (s = spec->s; s; s = s->next)
1278 if (s->value != VAL_NONE)
1282 assert (s->value == VAL_INT || s->value == VAL_DBL
1283 || s->value == VAL_STRING);
1284 init = (s->value == VAL_INT ? "LONG_MIN"
1285 : s->value == VAL_DBL ? "SYSMIS"
1288 dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
1294 /* Write code to initialize all variables. */
1296 dump_vars_init (int persistent)
1298 /* Loop through all the subcommands. */
1302 for (sbc = subcommands; sbc; sbc = sbc->next)
1306 dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
1315 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1316 dump (0, "subc_list_%s_create(&p->%cl_%s[i]) ;",
1317 sbc->type == SBC_INT_LIST ? "int" : "double",
1318 sbc->type == SBC_INT_LIST ? 'i' : 'd',
1319 st_lower (sbc->name)
1327 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1328 dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
1341 for (spec = sbc->spec; spec; spec = spec->next)
1342 if (spec->s == NULL)
1344 if (sbc->type == SBC_PLAIN)
1345 dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
1348 dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
1349 st_lower (sbc->name), st_lower (sbc->name));
1354 dump_specifier_init (spec, sbc);
1359 dump (0, "p->%sn_%s = 0;",
1360 st_lower (sbc->prefix), st_lower (sbc->name));
1361 dump (0, "p->%sv_%s = NULL;",
1362 st_lower (sbc->prefix), st_lower (sbc->name));
1366 dump (0, "p->%sv_%s = NULL;",
1367 st_lower (sbc->prefix), st_lower (sbc->name));
1371 dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
1378 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1379 dump (0, "p->n_%s[i] = LONG_MIN;", st_lower (sbc->name));
1391 /* Return a pointer to a static buffer containing an expression that
1392 will match token T. */
1394 make_match (const char *t)
1404 sprintf (s, "lex_match (lexer, T_%s)", t);
1405 else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
1406 strcpy (s, "(lex_match_id (lexer, \"ON\") || lex_match_id (lexer, \"YES\") "
1407 "|| lex_match_id (lexer, \"TRUE\"))");
1408 else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
1409 strcpy (s, "(lex_match_id (lexer, \"OFF\") || lex_match_id (lexer, \"NO\") "
1410 "|| lex_match_id (lexer, \"FALSE\"))");
1411 else if (isdigit ((unsigned char) t[0]))
1412 sprintf (s, "lex_match_int (lexer, %s)", t);
1415 char *c = unmunge (t);
1416 sprintf (s, "lex_match_hyphenated_word (lexer, \"%s\")", c);
1423 /* Write out the parsing code for specifier SPEC within subcommand
1426 dump_specifier_parse (const specifier *spec, const subcommand *sbc)
1430 if (spec->omit_kw && spec->omit_kw->next)
1431 error ("Omittable setting is not last setting in `%s' specifier.",
1433 if (spec->omit_kw && spec->omit_kw->parent->next)
1434 error ("Default specifier is not in last specifier in `%s' "
1435 "subcommand.", sbc->name);
1437 for (s = spec->s; s; s = s->next)
1439 int first = spec == sbc->spec && s == spec->s;
1441 /* Match the setting's keyword. */
1442 if (spec->omit_kw == s)
1449 dump (1, "%s;", make_match (s->specname));
1452 dump (1, "%sif (%s)", first ? "" : "else ",
1453 make_match (s->specname));
1456 /* Handle values. */
1457 if (s->value == VAL_NONE)
1458 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1459 st_upper (prefix), find_symbol (s->con)->name);
1462 if (spec->omit_kw != s)
1467 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1468 st_upper (prefix), find_symbol (s->con)->name);
1470 if ( sbc->type == SBC_ARRAY )
1471 dump (0, "p->a_%s[%s%s%s] = 1;",
1472 st_lower (sbc->name),
1473 st_upper (prefix), st_upper (sbc->prefix),
1474 st_upper (spec->varname));
1478 if (s->valtype == VT_PAREN)
1482 dump (1, "if (lex_match (lexer, '('))");
1487 dump (1, "if (!lex_match (lexer, '('))");
1489 dump (0, "msg (SE, _(\"`(' expected after %s "
1490 "specifier of %s subcommand.\"));",
1491 s->specname, sbc->name);
1492 dump (0, "goto lossage;");
1498 if (s->value == VAL_INT)
1500 dump (1, "if (!lex_is_integer (lexer))");
1502 dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1503 "requires an integer argument.\"));",
1504 s->specname, sbc->name);
1505 dump (0, "goto lossage;");
1507 dump (-1, "p->%s%s = lex_integer (lexer);",
1508 sbc->prefix, st_lower (s->valname));
1510 else if (s->value == VAL_DBL)
1512 dump (1, "if (!lex_is_number (lexer))");
1514 dump (0, "msg (SE, _(\"Number expected after %s "
1515 "specifier of %s subcommand.\"));",
1516 s->specname, sbc->name);
1517 dump (0, "goto lossage;");
1519 dump (-1, "p->%s%s = lex_tokval (lexer);", sbc->prefix,
1520 st_lower (s->valname));
1522 else if (s->value == VAL_STRING)
1524 dump (1, "if (lex_token (lexer) != T_ID "
1525 "&& lex_token (lexer) != T_STRING)");
1527 dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1528 "requires a string argument.\"));",
1529 s->specname, sbc->name);
1530 dump (0, "goto lossage;");
1532 dump (-1, "free (p->%s%s);", sbc->prefix, st_lower (s->valname));
1533 dump (0, "p->%s%s = xstrdup (ds_cstr (lex_tokstr (lexer)));",
1534 sbc->prefix, st_lower (s->valname));
1543 str = xmalloc (MAX_TOK_LEN);
1544 str2 = xmalloc (MAX_TOK_LEN);
1545 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1546 sprintf (str, s->restriction, str2, str2, str2, str2,
1547 str2, str2, str2, str2);
1548 dump (1, "if (!(%s))", str);
1554 dump (0, "msg (SE, _(\"Bad argument for %s "
1555 "specifier of %s subcommand.\"));",
1556 s->specname, sbc->name);
1557 dump (0, "goto lossage;");
1562 dump (0, "lex_get (lexer);");
1564 if (s->valtype == VT_PAREN)
1566 dump (1, "if (!lex_match (lexer, ')'))");
1568 dump (0, "msg (SE, _(\"`)' expected after argument for "
1569 "%s specifier of %s.\"));",
1570 s->specname, sbc->name);
1571 dump (0, "goto lossage;");
1581 if (s != spec->omit_kw)
1585 if (s == spec->omit_kw)
1594 /* Write out the code to parse subcommand SBC. */
1596 dump_subcommand (const subcommand *sbc)
1598 if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1602 dump (1, "while (lex_token (lexer) != '/' && lex_token (lexer) != '.')");
1608 for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1611 dump_specifier_parse (spec, sbc);
1615 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1616 make_match (st_upper (spec->varname)));
1617 if (sbc->type == SBC_PLAIN)
1618 dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1621 dump (0, "p->a_%s[%s%s%s] = 1;",
1622 st_lower (sbc->name),
1623 st_upper (prefix), st_upper (sbc->prefix),
1624 st_upper (spec->varname));
1634 /* This code first finds the last specifier in sbc. Then it
1635 finds the last setting within that last specifier. Either
1636 or both might be NULL. */
1649 if (spec && (!spec->s || !spec->omit_kw))
1653 dump (0, "lex_error (lexer, NULL);");
1654 dump (0, "goto lossage;");
1660 dump (0, "lex_match (lexer, ',');");
1664 else if (sbc->type == SBC_VARLIST)
1666 dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1668 st_lower (sbc->prefix), st_lower (sbc->name),
1669 st_lower (sbc->prefix), st_lower (sbc->name),
1670 sbc->message ? " |" : "",
1671 sbc->message ? sbc->message : "");
1672 dump (0, "goto lossage;");
1675 else if (sbc->type == SBC_VAR)
1677 dump (0, "p->%sv_%s = parse_variable (lexer, dataset_dict (ds));",
1678 st_lower (sbc->prefix), st_lower (sbc->name));
1679 dump (1, "if (!p->%sv_%s)",
1680 st_lower (sbc->prefix), st_lower (sbc->name));
1681 dump (0, "goto lossage;");
1684 else if (sbc->type == SBC_STRING)
1686 if (sbc->restriction)
1691 dump (1, "if (!lex_force_string (lexer))");
1692 dump (0, "return false;");
1694 if (sbc->restriction)
1696 dump (0, "x = ds_length (lex_tokstr (lexer));");
1697 dump (1, "if (!(%s))", sbc->restriction);
1699 dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1700 sbc->name, sbc->message);
1701 dump (0, "goto lossage;");
1705 dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1706 dump (0, "p->s_%s = ds_xstrdup (lex_tokstr (lexer));",
1707 st_lower (sbc->name));
1708 dump (0, "lex_get (lexer);");
1709 if (sbc->restriction)
1712 else if (sbc->type == SBC_DBL)
1714 dump (1, "if (!lex_force_num (lexer))");
1715 dump (0, "goto lossage;");
1716 dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number (lexer);",
1717 st_lower (sbc->name), st_lower (sbc->name) );
1718 dump (0, "lex_get(lexer);");
1720 else if (sbc->type == SBC_INT)
1724 dump (1, "if (!lex_force_int (lexer))");
1725 dump (0, "goto lossage;");
1726 dump (-1, "x = lex_integer (lexer);");
1727 dump (0, "lex_get(lexer);");
1728 if (sbc->restriction)
1731 dump (1, "if (!(%s))", sbc->restriction);
1733 sprintf(buf,sbc->message,sbc->name);
1734 if ( sbc->translatable )
1735 dump (0, "msg (SE, gettext(\"%s\"));",buf);
1737 dump (0, "msg (SE, \"%s\");",buf);
1738 dump (0, "goto lossage;");
1741 dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
1744 else if (sbc->type == SBC_PINT)
1746 dump (0, "lex_match (lexer, '(');");
1747 dump (1, "if (!lex_force_int (lexer))");
1748 dump (0, "goto lossage;");
1749 dump (-1, "p->n_%s = lex_integer (lexer);", st_lower (sbc->name));
1750 dump (0, "lex_match (lexer, ')');");
1752 else if (sbc->type == SBC_DBL_LIST || sbc->type == SBC_INT_LIST)
1754 dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1756 dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
1757 dump (0, "goto lossage;");
1760 dump (1, "while (lex_token (lexer) != '/' && lex_token (lexer) != '.')");
1762 dump (0, "lex_match (lexer, ',');");
1763 dump (0, "if (!lex_force_num (lexer))");
1765 dump (0, "goto lossage;");
1768 dump (0, "subc_list_%s_push (&p->%cl_%s[p->sbc_%s-1], lex_number (lexer));",
1769 sbc->type == SBC_INT_LIST ? "int" : "double",
1770 sbc->type == SBC_INT_LIST ? 'i' : 'd',
1771 st_lower (sbc->name), st_lower (sbc->name));
1773 dump (0, "lex_get (lexer);");
1777 else if (sbc->type == SBC_CUSTOM)
1779 dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1780 st_lower (prefix), st_lower (sbc->name));
1782 dump (1, "case 0:");
1783 dump (0, "goto lossage;");
1784 dump (-1, "case 1:");
1787 dump (-1, "case 2:");
1789 dump (0, "lex_error (lexer, NULL);");
1790 dump (0, "goto lossage;");
1791 dump (-1, "default:");
1793 dump (0, "NOT_REACHED ();");
1799 /* Write out entire parser. */
1801 dump_parser (int persistent)
1807 dump (0, "static int");
1808 dump (0, "parse_%s (struct lexer *lexer, struct dataset *ds%s, struct cmd_%s *p, void *aux UNUSED)",
1809 make_identifier (cmdname),
1810 (def && ( def->type == SBC_VARLIST && def->type == SBC_CUSTOM))?"":" UNUSED",
1811 make_identifier (cmdname));
1814 dump_vars_init (persistent);
1816 dump (1, "for (;;)");
1820 if (def && (def->type == SBC_VARLIST))
1822 if (def->type == SBC_VARLIST)
1823 dump (1, "if (lex_token (lexer) == T_ID "
1824 "&& dict_lookup_var (dataset_dict (ds), lex_tokid (lexer)) != NULL "
1825 "&& lex_look_ahead (lexer) != '=')");
1828 dump (0, "if ((lex_token (lexer) == T_ID "
1829 "&& dict_lookup_var (dataset_dict (ds), lex_tokid (lexer)) "
1830 "&& lex_look_ahead () != '=')");
1831 dump (1, " || token == T_ALL)");
1834 dump (0, "p->sbc_%s++;", st_lower (def->name));
1835 dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1837 st_lower (def->prefix), st_lower (def->name),
1838 st_lower (def->prefix), st_lower (def->name));
1839 dump (0, "goto lossage;");
1844 else if (def && def->type == SBC_CUSTOM)
1846 dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1847 st_lower (prefix), st_lower (def->name));
1849 dump (1, "case 0:");
1850 dump (0, "goto lossage;");
1851 dump (-1, "case 1:");
1853 dump (0, "p->sbc_%s++;", st_lower (def->name));
1854 dump (0, "continue;");
1855 dump (-1, "case 2:");
1858 dump (-1, "default:");
1860 dump (0, "NOT_REACHED ();");
1868 for (sbc = subcommands; sbc; sbc = sbc->next)
1870 dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1874 dump (0, "lex_match (lexer, '=');");
1875 dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1876 if (sbc->arity != ARITY_MANY)
1878 dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1880 dump (0, "msg (SE, _(\"%s subcommand may be given only once.\"));",
1882 dump (0, "goto lossage;");
1886 dump_subcommand (sbc);
1893 /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1894 dump(1,"else if ( settings_get_syntax () != COMPATIBLE && lex_match_id(lexer, \"ALGORITHM\"))");
1897 dump (0, "lex_match (lexer, '=');");
1899 dump(1,"if (lex_match_id(lexer, \"COMPATIBLE\"))");
1900 dump(0,"settings_set_cmd_algorithm (COMPATIBLE);");
1902 dump(1,"else if (lex_match_id(lexer, \"ENHANCED\"))");
1903 dump(0,"settings_set_cmd_algorithm (ENHANCED);");
1910 dump (1, "if (!lex_match (lexer, '/'))");
1915 dump (1, "if (lex_token (lexer) != '.')");
1917 dump (0, "lex_error (lexer, _(\"expecting end of command\"));");
1918 dump (0, "goto lossage;");
1925 /* Check that mandatory subcommands have been specified */
1928 for (sbc = subcommands; sbc; sbc = sbc->next)
1931 if ( sbc->arity == ARITY_ONCE_EXACTLY )
1933 dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
1935 dump (0, "msg (SE, _(\"%s subcommand must be given.\"));",
1937 dump (0, "goto lossage;");
1944 dump (-1, "return true;");
1946 dump (-1, "lossage:");
1948 dump (0, "free_%s (p);", make_identifier (cmdname));
1949 dump (0, "return false;");
1955 /* Write the output file header. */
1960 dump (0, "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1962 dump (0, " Generated by q2c from %s.", ifn);
1963 dump (0, " Do not modify!");
1967 /* Write out commands to free variable state. */
1969 dump_free (int persistent)
1979 for (sbc = subcommands; sbc; sbc = sbc->next)
1980 used = (sbc->type == SBC_STRING
1981 || sbc->type == SBC_DBL_LIST
1982 || sbc->type == SBC_INT_LIST);
1985 dump (0, "static void");
1986 dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1987 make_identifier (cmdname), used ? "" : " UNUSED");
1993 for (sbc = subcommands; sbc; sbc = sbc->next)
1998 dump (0, "free (p->v_%s);", st_lower (sbc->name));
2001 dump (0, "free (p->s_%s);", st_lower (sbc->name));
2007 dump (2, "for(i = 0; i < MAXLISTS ; ++i)");
2008 dump (1, "subc_list_%s_destroy(&p->%cl_%s[i]);",
2009 sbc->type == SBC_INT_LIST ? "int" : "double",
2010 sbc->type == SBC_INT_LIST ? 'i' : 'd',
2011 st_lower (sbc->name));
2020 for (spec = sbc->spec; spec; spec = spec->next)
2021 for (s = spec->s; s; s = s->next)
2022 if (s->value == VAL_STRING)
2023 dump (0, "free (p->%s%s);",
2024 sbc->prefix, st_lower (s->valname));
2038 /* Returns the name of a directive found on the current input line, if
2039 any, or a null pointer if none found. */
2041 recognize_directive (void)
2043 static char directive[16];
2047 if (strncmp (sp, "/*", 2))
2049 sp = skip_ws (sp + 2);
2054 ep = strchr (sp, ')');
2060 memcpy (directive, sp, ep - sp);
2061 directive[ep - sp] = '\0';
2066 main (int argc, char *argv[])
2068 program_name = argv[0];
2070 fail ("Syntax: q2c input.q output.c");
2073 in = fopen (ifn, "r");
2075 fail ("%s: open: %s.", ifn, strerror (errno));
2078 out = fopen (ofn, "w");
2080 fail ("%s: open: %s.", ofn, strerror (errno));
2083 buf = xmalloc (MAX_LINE_LEN);
2084 tokstr = xmalloc (MAX_TOK_LEN);
2090 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2093 const char *directive = recognize_directive ();
2094 if (directive == NULL)
2096 dump (0, "%s", buf);
2100 dump (0, "#line %d \"%s\"", oln + 1, ofn);
2101 if (!strcmp (directive, "specification"))
2103 /* Skip leading slash-star line. */
2109 /* Skip trailing star-slash line. */
2112 else if (!strcmp (directive, "headers"))
2116 dump (0, "#include <stdlib.h>");
2117 dump (0, "#include <libpspp/assertion.h>");
2118 dump (0, "#include <libpspp/message.h>");
2119 dump (0, "#include <language/lexer/lexer.h>");
2120 dump (0, "#include <language/lexer/variable-parser.h>");
2121 dump (0, "#include <data/settings.h>");
2122 dump (0, "#include <libpspp/str.h>");
2123 dump (0, "#include <language/lexer/subcommand-list.h>");
2124 dump (0, "#include <data/variable.h>");
2127 dump (0, "#include \"xalloc.h\"");
2130 dump (0, "#include \"gettext.h\"");
2131 dump (0, "#define _(msgid) gettext (msgid)");
2134 else if (!strcmp (directive, "declarations"))
2135 dump_declarations ();
2136 else if (!strcmp (directive, "functions"))
2141 else if (!strcmp (directive, "_functions"))
2147 error ("unknown directive `%s'", directive);
2149 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2152 return EXIT_SUCCESS;