1 /* PSPP - a program for statistical analysis.
2 Copyright (C) 1997-9, 2000, 2008, 2010, 2011 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 /* Close all open files and delete the output file, on failure. */
95 if (remove (ofn) == -1)
96 fprintf (stderr, "%s: %s: remove: %s\n", program_name, ofn, strerror (errno));
99 void hcf (void) NO_RETURN;
101 /* Terminate unsuccessfully. */
109 int fail (const char *, ...) PRINTF_FORMAT (1, 2) NO_RETURN;
110 int error (const char *, ...) PRINTF_FORMAT (1, 2) NO_RETURN;
112 /* Output an error message and terminate unsuccessfully. */
114 fail (const char *format, ...)
118 va_start (args, format);
119 fprintf (stderr, "%s: ", program_name);
120 vfprintf (stderr, format, args);
121 fprintf (stderr, "\n");
127 /* Output a context-dependent error message and terminate
130 error (const char *format,...)
134 va_start (args, format);
135 fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
136 vfprintf (stderr, format, args);
137 fprintf (stderr, "\n");
143 #define VME "virtual memory exhausted"
145 /* Allocate a block of SIZE bytes and return a pointer to its
148 xmalloc (size_t size)
157 fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
162 /* Make a dynamically allocated copy of string S and return a pointer
163 to the first character. */
165 xstrdup (const char *s)
171 size = strlen (s) + 1;
175 fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
181 /* Returns a pointer to one of 8 static buffers. The buffers are used
186 static char b[8][256];
195 /* Copies a string to a static buffer, converting it to lowercase in
196 the process, and returns a pointer to the static buffer. */
198 st_lower (const char *s)
202 p = cp = get_buffer ();
204 *cp++ = tolower ((unsigned char) (*s++));
210 /* Copies a string to a static buffer, converting it to uppercase in
211 the process, and returns a pointer to the static buffer. */
213 st_upper (const char *s)
217 p = cp = get_buffer ();
219 *cp++ = toupper ((unsigned char) (*s++));
225 /* Returns the address of the first non-whitespace character in S, or
226 the address of the null terminator if none. */
230 while (isspace ((unsigned char) *s))
235 /* Read one line from the input file into buf. Lines having special
236 formats are handled specially. */
241 if (0 == fgets (buf, MAX_LINE_LEN, in))
244 fail ("%s: fgets: %s", ifn, strerror (errno));
248 cp = strchr (buf, '\n');
256 /* Symbol table manager. */
258 /* Symbol table entry. */
259 typedef struct symbol symbol;
262 symbol *next; /* Next symbol in symbol table. */
263 char *name; /* Symbol name. */
264 int unique; /* 1=Name must be unique in this file. */
265 int ln; /* Line number of definition. */
266 int value; /* Symbol value. */
272 /* Add a symbol to the symbol table having name NAME, uniqueness
273 UNIQUE, and value VALUE. If a symbol having the same name is found
274 in the symbol table, its sequence number is returned and the symbol
275 table is not modified. Otherwise, the symbol is added and the next
276 available sequence number is returned. */
278 add_symbol (const char *name, int unique, int value)
283 sym = xmalloc (sizeof *sym);
284 sym->name = xstrdup (name);
285 sym->unique = unique;
298 if (!strcmp (iter->name, name))
302 fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
304 fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
321 /* Finds the symbol having given sequence number X within the symbol
322 table, and returns the associated symbol structure. */
329 while (x > 1 && iter)
339 /* Writes a printable representation of the current token to
347 printf ("STRING\t\"%s\"\n", tokstr);
350 printf ("ID\t%s\n", tokstr);
353 printf ("PUNCT\t%c\n", token);
356 #endif /* DUMP_TOKENS */
359 const char hyphen_proxy = '_';
367 while (*src == '_' || *src == '-' || isalnum ((unsigned char) *src))
369 *dest++ = *src == '-' ? hyphen_proxy :toupper ((unsigned char) (*src));
378 unmunge (const char *s)
380 char *dest = xmalloc (strlen (s) + 1);
385 if (*s == hyphen_proxy)
397 /* Reads a token from the input file. */
401 /* Skip whitespace and check for end of file. */
409 fail ("%s: Unexpected end of file.", ifn);
417 while (*cp != '"' && *cp)
423 error ("Unterminated string literal.");
431 error ("Unterminated string literal.");
434 else if (*cp == '_' || isalnum ((unsigned char) *cp))
451 /* Force the current token to be an identifier token. */
456 error ("Identifier expected.");
459 /* Force the current token to be a string token. */
463 if (token != T_STRING)
464 error ("String expected.");
467 /* Checks whether the current token is the identifier S; if so, skips
468 the token and returns true; otherwise, returns false. */
470 match_id (const char *s)
472 if (token == T_ID && !strcmp (tokstr, s))
480 /* Checks whether the current token is T. If so, skips the token and
481 returns true; otherwise, returns false. */
493 /* Force the current token to be T, and skip it. */
498 error ("`%c' expected.", t);
504 /* Some specifiers have associated values. */
507 VAL_NONE, /* No value. */
508 VAL_INT, /* Integer value. */
509 VAL_DBL, /* Floating point value. */
510 VAL_STRING /* String value. */
513 /* For those specifiers with values, the syntax of those values. */
516 VT_PLAIN, /* Unadorned value. */
517 VT_PAREN /* Value must be enclosed in parentheses. */
520 /* Forward definition. */
521 typedef struct specifier specifier;
523 /* A single setting. */
524 typedef struct setting setting;
527 specifier *parent; /* Owning specifier. */
528 setting *next; /* Next in the chain. */
529 char *specname; /* Name of the setting. */
530 int con; /* Sequence number. */
533 int valtype; /* One of VT_*. */
534 int value; /* One of VAL_*. */
535 int optvalue; /* 1=value is optional, 0=value is required. */
536 char *valname; /* Variable name for the value. */
537 char *restriction; /* !=NULL: expression specifying valid values. */
540 /* A single specifier. */
543 specifier *next; /* Next in the chain. */
544 char *varname; /* Variable name. */
545 setting *s; /* Associated settings. */
547 setting *def; /* Default setting. */
548 setting *omit_kw; /* Setting for which the keyword can be omitted. */
550 int index; /* Next array index. */
553 /* Subcommand types. */
556 SBC_PLAIN, /* The usual case. */
557 SBC_VARLIST, /* Variable list. */
558 SBC_INT, /* Integer value. */
559 SBC_PINT, /* Integer inside parentheses. */
560 SBC_DBL, /* Floating point value. */
561 SBC_INT_LIST, /* List of integers (?). */
562 SBC_DBL_LIST, /* List of floating points (?). */
563 SBC_CUSTOM, /* Custom. */
564 SBC_ARRAY, /* Array of boolean values. */
565 SBC_STRING, /* String value. */
566 SBC_VAR /* Single variable name. */
572 ARITY_ONCE_EXACTLY, /* must occur exactly once */
573 ARITY_ONCE_ONLY, /* zero or once */
574 ARITY_MANY /* 0, 1, ... , inf */
577 /* A single subcommand. */
578 typedef struct subcommand subcommand;
581 subcommand *next; /* Next in the chain. */
582 char *name; /* Subcommand name. */
583 subcommand_type type; /* One of SBC_*. */
584 subcommand_arity arity; /* How many times should the subcommand occur*/
585 int narray; /* Index of next array element. */
586 const char *prefix; /* Prefix for variable and constant names. */
587 specifier *spec; /* Array of specifiers. */
589 /* SBC_STRING and SBC_INT only. */
590 char *restriction; /* Expression restricting string length. */
591 char *message; /* Error message. */
592 int translatable; /* Error message is translatable */
595 /* Name of the command; i.e., DESCRIPTIVES. */
598 /* Short prefix for the command; i.e., `dsc_'. */
601 /* List of subcommands. */
602 subcommand *subcommands;
604 /* Default subcommand if any, or NULL. */
609 void parse_subcommands (void);
611 /* Parse an entire specification. */
615 /* Get the command name and prefix. */
616 if (token != T_STRING && token != T_ID)
617 error ("Command name expected.");
618 cmdname = xstrdup (tokstr);
622 prefix = xstrdup (tokstr);
627 /* Read all the subcommands. */
630 parse_subcommands ();
633 /* Parses a single setting into S, given subcommand information SBC
634 and specifier information SPEC. */
636 parse_setting (setting *s, specifier *spec)
640 if (match_token ('*'))
643 error ("Cannot have two settings with omittable keywords.");
648 if (match_token ('!'))
651 error ("Cannot have two default settings.");
657 s->specname = xstrdup (tokstr);
658 s->con = add_symbol (s->specname, 0, 0);
663 /* Parse setting value info if necessary. */
664 if (token != '/' && token != ';' && token != '.' && token != ',')
668 s->valtype = VT_PAREN;
672 s->valtype = VT_PLAIN;
674 s->optvalue = match_token ('*');
678 else if (match_id ("D"))
680 else if (match_id ("S"))
681 s->value = VAL_STRING;
683 error ("`n', `d', or `s' expected.");
688 s->valname = xstrdup (tokstr);
695 s->restriction = xstrdup (tokstr);
699 s->restriction = NULL;
701 if (s->valtype == VT_PAREN)
706 /* Parse a single specifier into SPEC, given subcommand information
709 parse_specifier (specifier *spec, subcommand *sbc)
714 spec->omit_kw = NULL;
715 spec->varname = NULL;
719 spec->varname = xstrdup (st_lower (tokstr));
723 /* Handle array elements. */
726 spec->index = sbc->narray;
727 if (sbc->type == SBC_ARRAY)
739 if ( sbc->type == SBC_ARRAY && token == T_ID )
741 spec->varname = xstrdup (st_lower (tokstr));
742 spec->index = sbc->narray;
748 /* Parse all the settings. */
750 setting **s = &spec->s;
754 *s = xmalloc (sizeof **s);
755 parse_setting (*s, spec);
756 if (token == ',' || token == ';' || token == '.')
765 /* Parse a list of specifiers for subcommand SBC. */
767 parse_specifiers (subcommand *sbc)
769 specifier **spec = &sbc->spec;
771 if (token == ';' || token == '.')
779 *spec = xmalloc (sizeof **spec);
780 parse_specifier (*spec, sbc);
781 if (token == ';' || token == '.')
784 spec = &(*spec)->next;
786 (*spec)->next = NULL;
789 /* Parse a subcommand into SBC. */
791 parse_subcommand (subcommand *sbc)
793 if (match_token ('*'))
796 error ("Multiple default subcommands.");
800 sbc->arity = ARITY_ONCE_ONLY;
801 if ( match_token('+'))
802 sbc->arity = ARITY_MANY;
803 else if (match_token('^'))
804 sbc->arity = ARITY_ONCE_EXACTLY ;
808 sbc->name = xstrdup (tokstr);
812 sbc->type = SBC_PLAIN;
814 sbc->translatable = 0;
816 if (match_token ('['))
819 sbc->prefix = xstrdup (st_lower (tokstr));
825 sbc->type = SBC_ARRAY;
826 parse_specifiers (sbc);
831 if (match_token ('('))
834 sbc->prefix = xstrdup (st_lower (tokstr));
844 if (match_id ("VAR"))
846 if (match_id ("VARLIST"))
848 if (match_token ('('))
851 sbc->message = xstrdup (tokstr);
856 else sbc->message = NULL;
858 sbc->type = SBC_VARLIST;
860 else if (match_id ("INTEGER"))
862 sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
863 if ( token == T_STRING)
865 sbc->restriction = xstrdup (tokstr);
867 if ( match_id("N_") )
873 sbc->translatable = 1;
879 sbc->message = xstrdup (tokstr);
882 sbc->restriction = NULL;
884 else if (match_id ("PINT"))
885 sbc->type = SBC_PINT;
886 else if (match_id ("DOUBLE"))
888 if ( match_id ("LIST") )
889 sbc->type = SBC_DBL_LIST;
893 else if (match_id ("STRING"))
895 sbc->type = SBC_STRING;
896 if (token == T_STRING)
898 sbc->restriction = xstrdup (tokstr);
901 sbc->message = xstrdup (tokstr);
905 sbc->restriction = NULL;
907 else if (match_id ("CUSTOM"))
908 sbc->type = SBC_CUSTOM;
910 parse_specifiers (sbc);
914 /* Parse all the subcommands. */
916 parse_subcommands (void)
918 subcommand **sbc = &subcommands;
922 *sbc = xmalloc (sizeof **sbc);
925 parse_subcommand (*sbc);
937 #define BASE_INDENT 2 /* Starting indent. */
938 #define INC_INDENT 2 /* Indent increment. */
940 /* Increment the indent. */
941 #define indent() indent += INC_INDENT
942 #define outdent() indent -= INC_INDENT
944 /* Size of the indent from the left margin. */
947 void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
949 /* Write line FORMAT to the output file, formatted as with printf,
950 indented `indent' characters from the left margin. If INDENTION is
951 greater than 0, indents BASE_INDENT * INDENTION characters after
952 writing the line; if INDENTION is less than 0, dedents BASE_INDENT
953 * INDENTION characters _before_ writing the line. */
955 dump (int indention, const char *format, ...)
961 indent += BASE_INDENT * indention;
964 va_start (args, format);
965 for (i = 0; i < indent; i++)
967 vfprintf (out, format, args);
972 indent += BASE_INDENT * indention;
975 /* Writes a blank line to the output file and adjusts 'indent' by BASE_INDENT
976 * INDENTION characters.
978 (This is only useful because GCC complains about using "" as a format
979 string, for whatever reason.) */
981 dump_blank_line (int indention)
984 indent += BASE_INDENT * indention;
988 /* Write the structure members for specifier SPEC to the output file.
989 SBC is the including subcommand. */
991 dump_specifier_vars (const specifier *spec, const subcommand *sbc)
994 dump (0, "long %s%s;", sbc->prefix, spec->varname);
999 for (s = spec->s; s; s = s->next)
1001 if (s->value != VAL_NONE)
1003 const char *typename;
1005 assert (s->value == VAL_INT || s->value == VAL_DBL
1006 || s->value == VAL_STRING);
1007 typename = (s->value == VAL_INT ? "long"
1008 : s->value == VAL_DBL ? "double"
1011 dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
1017 /* Returns true if string T is a PSPP keyword, false otherwise. */
1019 is_keyword (const char *t)
1021 static const char *kw[] =
1023 "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
1024 "NE", "ALL", "BY", "TO", "WITH", 0,
1028 for (cp = kw; *cp; cp++)
1029 if (!strcmp (t, *cp))
1034 /* Transforms a string NAME into a valid C identifier: makes
1035 everything lowercase and maps nonalphabetic characters to
1036 underscores. Returns a pointer to a static buffer. */
1038 make_identifier (const char *name)
1040 char *p = get_buffer ();
1043 for (cp = p; *name; name++)
1044 if (isalpha ((unsigned char) *name))
1045 *cp++ = tolower ((unsigned char) (*name));
1053 /* Writes the struct and enum declarations for the parser. */
1055 dump_declarations (void)
1059 dump (0, "struct dataset;");
1061 /* Write out enums for all the identifiers in the symbol table. */
1067 /* Note the squirmings necessary to make sure that the last enum
1068 is not followed by a comma, as mandated by ANSI C89. */
1069 for (sym = symtab, f = k = 0; sym; sym = sym->next)
1070 if (!sym->unique && !is_keyword (sym->name))
1074 dump (0, "/* Settings for subcommand specifiers. */");
1081 buf = xmalloc (1024);
1083 dump (0, "%s", buf);
1086 sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
1090 sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
1095 buf[strlen (buf) - 1] = 0;
1096 dump (0, "%s", buf);
1102 dump_blank_line (-1);
1106 /* Write out some type definitions */
1108 dump (0, "#define MAXLISTS 10");
1112 /* For every array subcommand, write out the associated enumerated
1117 for (sbc = subcommands; sbc; sbc = sbc->next)
1118 if (sbc->type == SBC_ARRAY && sbc->narray)
1120 dump (0, "/* Array indices for %s subcommand. */", sbc->name);
1128 for (spec = sbc->spec; spec; spec = spec->next)
1129 dump (0, "%s%s%s = %d,",
1130 st_upper (prefix), st_upper (sbc->prefix),
1131 st_upper (spec->varname), spec->index);
1133 dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
1136 dump_blank_line (-1);
1141 /* Write out structure declaration. */
1145 dump (0, "/* %s structure. */", cmdname);
1146 dump (1, "struct cmd_%s", make_identifier (cmdname));
1148 for (sbc = subcommands; sbc; sbc = sbc->next)
1152 if (sbc != subcommands)
1153 dump_blank_line (0);
1155 dump (0, "/* %s subcommand. */", sbc->name);
1156 dump (0, "int sbc_%s;", st_lower (sbc->name));
1165 for (spec = sbc->spec; spec; spec = spec->next)
1169 if (sbc->type == SBC_PLAIN)
1170 dump (0, "long int %s%s;", st_lower (sbc->prefix),
1174 dump (0, "int a_%s[%s%scount];",
1175 st_lower (sbc->name),
1177 st_upper (sbc->prefix)
1184 dump_specifier_vars (spec, sbc);
1190 dump (0, "size_t %sn_%s;", st_lower (sbc->prefix),
1191 st_lower (sbc->name));
1192 dump (0, "const struct variable **%sv_%s;", st_lower (sbc->prefix),
1193 st_lower (sbc->name));
1197 dump (0, "const struct variable *%sv_%s;", st_lower (sbc->prefix),
1198 st_lower (sbc->name));
1202 dump (0, "char *s_%s;", st_lower (sbc->name));
1207 dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
1211 dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
1215 dump (0, "subc_list_double dl_%s[MAXLISTS];",
1216 st_lower(sbc->name));
1220 dump (0, "subc_list_int il_%s[MAXLISTS];",
1221 st_lower(sbc->name));
1231 dump_blank_line (-1);
1234 /* Write out prototypes for custom_*() functions as necessary. */
1239 for (sbc = subcommands; sbc; sbc = sbc->next)
1240 if (sbc->type == SBC_CUSTOM)
1245 dump (0, "/* Prototype for custom subcommands of %s. */",
1248 dump (0, "static int %scustom_%s (struct lexer *, struct dataset *, struct cmd_%s *, void *);",
1249 st_lower (prefix), st_lower (sbc->name),
1250 make_identifier (cmdname));
1254 dump_blank_line (0);
1257 /* Prototypes for parsing and freeing functions. */
1259 dump (0, "/* Command parsing functions. */");
1260 dump (0, "static int parse_%s (struct lexer *, struct dataset *, struct cmd_%s *, void *);",
1261 make_identifier (cmdname), make_identifier (cmdname));
1262 dump (0, "static void free_%s (struct cmd_%s *);",
1263 make_identifier (cmdname), make_identifier (cmdname));
1264 dump_blank_line (0);
1268 /* Writes out code to initialize all the variables that need
1269 initialization for particular specifier SPEC inside subcommand SBC. */
1271 dump_specifier_init (const specifier *spec, const subcommand *sbc)
1279 st_upper (prefix), find_symbol (spec->def->con)->name);
1282 dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
1288 for (s = spec->s; s; s = s->next)
1290 if (s->value != VAL_NONE)
1294 assert (s->value == VAL_INT || s->value == VAL_DBL
1295 || s->value == VAL_STRING);
1296 init = (s->value == VAL_INT ? "LONG_MIN"
1297 : s->value == VAL_DBL ? "SYSMIS"
1300 dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
1306 /* Write code to initialize all variables. */
1308 dump_vars_init (int persistent)
1310 /* Loop through all the subcommands. */
1314 for (sbc = subcommands; sbc; sbc = sbc->next)
1318 dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
1327 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1328 dump (0, "subc_list_%s_create(&p->%cl_%s[i]) ;",
1329 sbc->type == SBC_INT_LIST ? "int" : "double",
1330 sbc->type == SBC_INT_LIST ? 'i' : 'd',
1331 st_lower (sbc->name)
1339 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1340 dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
1353 for (spec = sbc->spec; spec; spec = spec->next)
1354 if (spec->s == NULL)
1356 if (sbc->type == SBC_PLAIN)
1357 dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
1360 dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
1361 st_lower (sbc->name), st_lower (sbc->name));
1366 dump_specifier_init (spec, sbc);
1371 dump (0, "p->%sn_%s = 0;",
1372 st_lower (sbc->prefix), st_lower (sbc->name));
1373 dump (0, "p->%sv_%s = NULL;",
1374 st_lower (sbc->prefix), st_lower (sbc->name));
1378 dump (0, "p->%sv_%s = NULL;",
1379 st_lower (sbc->prefix), st_lower (sbc->name));
1383 dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
1390 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1391 dump (0, "p->n_%s[i] = LONG_MIN;", st_lower (sbc->name));
1403 /* Return a pointer to a static buffer containing an expression that
1404 will match token T. */
1406 make_match (const char *t)
1416 sprintf (s, "lex_match (lexer, T_%s)", t);
1417 else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
1418 strcpy (s, "(lex_match_id (lexer, \"ON\") || lex_match_id (lexer, \"YES\") "
1419 "|| lex_match_id (lexer, \"TRUE\"))");
1420 else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
1421 strcpy (s, "(lex_match_id (lexer, \"OFF\") || lex_match_id (lexer, \"NO\") "
1422 "|| lex_match_id (lexer, \"FALSE\"))");
1423 else if (isdigit ((unsigned char) t[0]))
1424 sprintf (s, "lex_match_int (lexer, %s)", t);
1425 else if (strchr (t, hyphen_proxy))
1427 char *c = unmunge (t);
1428 sprintf (s, "lex_match_phrase (lexer, \"%s\")", c);
1432 sprintf (s, "lex_match_id (lexer, \"%s\")", t);
1437 /* Write out the parsing code for specifier SPEC within subcommand
1440 dump_specifier_parse (const specifier *spec, const subcommand *sbc)
1444 if (spec->omit_kw && spec->omit_kw->next)
1445 error ("Omittable setting is not last setting in `%s' specifier.",
1447 if (spec->omit_kw && spec->omit_kw->parent->next)
1448 error ("Default specifier is not in last specifier in `%s' "
1449 "subcommand.", sbc->name);
1451 for (s = spec->s; s; s = s->next)
1453 int first = spec == sbc->spec && s == spec->s;
1455 /* Match the setting's keyword. */
1456 if (spec->omit_kw == s)
1463 dump (1, "%s;", make_match (s->specname));
1466 dump (1, "%sif (%s)", first ? "" : "else ",
1467 make_match (s->specname));
1470 /* Handle values. */
1471 if (s->value == VAL_NONE)
1472 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1473 st_upper (prefix), find_symbol (s->con)->name);
1476 if (spec->omit_kw != s)
1481 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1482 st_upper (prefix), find_symbol (s->con)->name);
1484 if ( sbc->type == SBC_ARRAY )
1485 dump (0, "p->a_%s[%s%s%s] = 1;",
1486 st_lower (sbc->name),
1487 st_upper (prefix), st_upper (sbc->prefix),
1488 st_upper (spec->varname));
1492 if (s->valtype == VT_PAREN)
1496 dump (1, "if (lex_match (lexer, T_LPAREN))");
1501 dump (1, "if (!lex_match (lexer, T_LPAREN))");
1503 dump (0, "msg (SE, _(\"`(' expected after %s "
1504 "specifier of %s subcommand.\"));",
1505 s->specname, sbc->name);
1506 dump (0, "goto lossage;");
1512 if (s->value == VAL_INT)
1514 dump (1, "if (!lex_is_integer (lexer))");
1516 dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1517 "requires an integer argument.\"));",
1518 s->specname, sbc->name);
1519 dump (0, "goto lossage;");
1521 dump (-1, "p->%s%s = lex_integer (lexer);",
1522 sbc->prefix, st_lower (s->valname));
1524 else if (s->value == VAL_DBL)
1526 dump (1, "if (!lex_is_number (lexer))");
1528 dump (0, "msg (SE, _(\"Number expected after %s "
1529 "specifier of %s subcommand.\"));",
1530 s->specname, sbc->name);
1531 dump (0, "goto lossage;");
1533 dump (-1, "p->%s%s = lex_tokval (lexer);", sbc->prefix,
1534 st_lower (s->valname));
1536 else if (s->value == VAL_STRING)
1538 dump (1, "if (lex_token (lexer) != T_ID "
1539 "&& !lex_is_string (lexer))");
1541 dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1542 "requires a string argument.\"));",
1543 s->specname, sbc->name);
1544 dump (0, "goto lossage;");
1546 dump (-1, "free (p->%s%s);", sbc->prefix, st_lower (s->valname));
1547 dump (0, "p->%s%s = ss_xstrdup (ss_tokss (lexer));",
1548 sbc->prefix, st_lower (s->valname));
1557 str = xmalloc (MAX_TOK_LEN);
1558 str2 = xmalloc (MAX_TOK_LEN);
1559 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1560 sprintf (str, s->restriction, str2, str2, str2, str2,
1561 str2, str2, str2, str2);
1562 dump (1, "if (!(%s))", str);
1568 dump (0, "msg (SE, _(\"Bad argument for %s "
1569 "specifier of %s subcommand.\"));",
1570 s->specname, sbc->name);
1571 dump (0, "goto lossage;");
1576 dump (0, "lex_get (lexer);");
1578 if (s->valtype == VT_PAREN)
1580 dump (1, "if (!lex_match (lexer, T_RPAREN))");
1582 dump (0, "msg (SE, _(\"`)' expected after argument for "
1583 "%s specifier of %s.\"));",
1584 s->specname, sbc->name);
1585 dump (0, "goto lossage;");
1595 if (s != spec->omit_kw)
1599 if (s == spec->omit_kw)
1608 /* Write out the code to parse subcommand SBC. */
1610 dump_subcommand (const subcommand *sbc)
1612 if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1616 dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1622 for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1625 dump_specifier_parse (spec, sbc);
1629 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1630 make_match (st_upper (spec->varname)));
1631 if (sbc->type == SBC_PLAIN)
1632 dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1635 dump (0, "p->a_%s[%s%s%s] = 1;",
1636 st_lower (sbc->name),
1637 st_upper (prefix), st_upper (sbc->prefix),
1638 st_upper (spec->varname));
1648 /* This code first finds the last specifier in sbc. Then it
1649 finds the last setting within that last specifier. Either
1650 or both might be NULL. */
1663 if (spec && (!spec->s || !spec->omit_kw))
1667 dump (0, "lex_error (lexer, NULL);");
1668 dump (0, "goto lossage;");
1674 dump (0, "lex_match (lexer, T_COMMA);");
1678 else if (sbc->type == SBC_VARLIST)
1680 dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1682 st_lower (sbc->prefix), st_lower (sbc->name),
1683 st_lower (sbc->prefix), st_lower (sbc->name),
1684 sbc->message ? " |" : "",
1685 sbc->message ? sbc->message : "");
1686 dump (0, "goto lossage;");
1689 else if (sbc->type == SBC_VAR)
1691 dump (0, "p->%sv_%s = parse_variable (lexer, dataset_dict (ds));",
1692 st_lower (sbc->prefix), st_lower (sbc->name));
1693 dump (1, "if (!p->%sv_%s)",
1694 st_lower (sbc->prefix), st_lower (sbc->name));
1695 dump (0, "goto lossage;");
1698 else if (sbc->type == SBC_STRING)
1700 if (sbc->restriction)
1705 dump (1, "if (!lex_force_string (lexer))");
1706 dump (0, "return false;");
1708 if (sbc->restriction)
1710 dump (0, "x = ss_length (lex_tokss (lexer));");
1711 dump (1, "if (!(%s))", sbc->restriction);
1713 dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1714 sbc->name, sbc->message);
1715 dump (0, "goto lossage;");
1719 dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1720 dump (0, "p->s_%s = ss_xstrdup (lex_tokss (lexer));",
1721 st_lower (sbc->name));
1722 dump (0, "lex_get (lexer);");
1723 if (sbc->restriction)
1726 else if (sbc->type == SBC_DBL)
1728 dump (1, "if (!lex_force_num (lexer))");
1729 dump (0, "goto lossage;");
1730 dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number (lexer);",
1731 st_lower (sbc->name), st_lower (sbc->name) );
1732 dump (0, "lex_get(lexer);");
1734 else if (sbc->type == SBC_INT)
1738 dump (1, "if (!lex_force_int (lexer))");
1739 dump (0, "goto lossage;");
1740 dump (-1, "x = lex_integer (lexer);");
1741 dump (0, "lex_get(lexer);");
1742 if (sbc->restriction)
1745 dump (1, "if (!(%s))", sbc->restriction);
1747 sprintf(buf,sbc->message,sbc->name);
1748 if ( sbc->translatable )
1749 dump (0, "msg (SE, gettext(\"%s\"));",buf);
1751 dump (0, "msg (SE, \"%s\");",buf);
1752 dump (0, "goto lossage;");
1755 dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
1758 else if (sbc->type == SBC_PINT)
1760 dump (0, "lex_match (lexer, T_LPAREN);");
1761 dump (1, "if (!lex_force_int (lexer))");
1762 dump (0, "goto lossage;");
1763 dump (-1, "p->n_%s = lex_integer (lexer);", st_lower (sbc->name));
1764 dump (0, "lex_match (lexer, T_RPAREN);");
1766 else if (sbc->type == SBC_DBL_LIST || sbc->type == SBC_INT_LIST)
1768 dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1770 dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
1771 dump (0, "goto lossage;");
1774 dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1776 dump (0, "lex_match (lexer, T_COMMA);");
1777 dump (0, "if (!lex_force_num (lexer))");
1779 dump (0, "goto lossage;");
1782 dump (0, "subc_list_%s_push (&p->%cl_%s[p->sbc_%s-1], lex_number (lexer));",
1783 sbc->type == SBC_INT_LIST ? "int" : "double",
1784 sbc->type == SBC_INT_LIST ? 'i' : 'd',
1785 st_lower (sbc->name), st_lower (sbc->name));
1787 dump (0, "lex_get (lexer);");
1791 else if (sbc->type == SBC_CUSTOM)
1793 dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1794 st_lower (prefix), st_lower (sbc->name));
1796 dump (1, "case 0:");
1797 dump (0, "goto lossage;");
1798 dump (-1, "case 1:");
1801 dump (-1, "case 2:");
1803 dump (0, "lex_error (lexer, NULL);");
1804 dump (0, "goto lossage;");
1805 dump (-1, "default:");
1807 dump (0, "NOT_REACHED ();");
1813 /* Write out entire parser. */
1815 dump_parser (int persistent)
1821 dump (0, "static int");
1822 dump (0, "parse_%s (struct lexer *lexer, struct dataset *ds%s, struct cmd_%s *p, void *aux UNUSED)",
1823 make_identifier (cmdname),
1824 (def && ( def->type == SBC_VARLIST && def->type == SBC_CUSTOM))?"":" UNUSED",
1825 make_identifier (cmdname));
1828 dump_vars_init (persistent);
1830 dump (1, "for (;;)");
1834 if (def && (def->type == SBC_VARLIST))
1836 if (def->type == SBC_VARLIST)
1837 dump (1, "if (lex_token (lexer) == T_ID "
1838 "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) != NULL "
1839 "&& lex_next_token (lexer, 1) != T_EQUALS)");
1842 dump (0, "if ((lex_token (lexer) == T_ID "
1843 "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) "
1844 "&& lex_next_token (lexer, 1) != T_EQUALS)");
1845 dump (1, " || token == T_ALL)");
1848 dump (0, "p->sbc_%s++;", st_lower (def->name));
1849 dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1851 st_lower (def->prefix), st_lower (def->name),
1852 st_lower (def->prefix), st_lower (def->name));
1853 dump (0, "goto lossage;");
1858 else if (def && def->type == SBC_CUSTOM)
1860 dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1861 st_lower (prefix), st_lower (def->name));
1863 dump (1, "case 0:");
1864 dump (0, "goto lossage;");
1865 dump (-1, "case 1:");
1867 dump (0, "p->sbc_%s++;", st_lower (def->name));
1868 dump (0, "continue;");
1869 dump (-1, "case 2:");
1872 dump (-1, "default:");
1874 dump (0, "NOT_REACHED ();");
1882 for (sbc = subcommands; sbc; sbc = sbc->next)
1884 dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1888 dump (0, "lex_match (lexer, T_EQUALS);");
1889 dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1890 if (sbc->arity != ARITY_MANY)
1892 dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1894 dump (0, "msg (SE, _(\"%s subcommand may be given only once.\"));",
1896 dump (0, "goto lossage;");
1900 dump_subcommand (sbc);
1907 /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1908 dump(1,"else if ( settings_get_syntax () != COMPATIBLE && lex_match_id(lexer, \"ALGORITHM\"))");
1911 dump (0, "lex_match (lexer, T_EQUALS);");
1913 dump(1,"if (lex_match_id(lexer, \"COMPATIBLE\"))");
1914 dump(0,"settings_set_cmd_algorithm (COMPATIBLE);");
1916 dump(1,"else if (lex_match_id(lexer, \"ENHANCED\"))");
1917 dump(0,"settings_set_cmd_algorithm (ENHANCED);");
1924 dump (1, "if (!lex_match (lexer, T_SLASH))");
1928 dump_blank_line (0);
1929 dump (1, "if (lex_token (lexer) != T_ENDCMD)");
1931 dump (0, "lex_error (lexer, _(\"expecting end of command\"));");
1932 dump (0, "goto lossage;");
1934 dump_blank_line (0);
1939 /* Check that mandatory subcommands have been specified */
1942 for (sbc = subcommands; sbc; sbc = sbc->next)
1945 if ( sbc->arity == ARITY_ONCE_EXACTLY )
1947 dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
1949 dump (0, "msg (SE, _(\"%s subcommand must be given.\"));",
1951 dump (0, "goto lossage;");
1953 dump_blank_line (0);
1958 dump (-1, "return true;");
1959 dump_blank_line (0);
1960 dump (-1, "lossage:");
1962 dump (0, "free_%s (p);", make_identifier (cmdname));
1963 dump (0, "return false;");
1965 dump_blank_line (0);
1969 /* Write the output file header. */
1974 dump (0, "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1975 dump_blank_line (0);
1976 dump (0, " Generated by q2c from %s.", ifn);
1977 dump (0, " Do not modify!");
1981 /* Write out commands to free variable state. */
1983 dump_free (int persistent)
1993 for (sbc = subcommands; sbc; sbc = sbc->next)
1994 used = (sbc->type == SBC_STRING
1995 || sbc->type == SBC_DBL_LIST
1996 || sbc->type == SBC_INT_LIST);
1999 dump (0, "static void");
2000 dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
2001 make_identifier (cmdname), used ? "" : " UNUSED");
2007 for (sbc = subcommands; sbc; sbc = sbc->next)
2012 dump (0, "free (p->v_%s);", st_lower (sbc->name));
2015 dump (0, "free (p->s_%s);", st_lower (sbc->name));
2021 dump (2, "for(i = 0; i < MAXLISTS ; ++i)");
2022 dump (1, "subc_list_%s_destroy(&p->%cl_%s[i]);",
2023 sbc->type == SBC_INT_LIST ? "int" : "double",
2024 sbc->type == SBC_INT_LIST ? 'i' : 'd',
2025 st_lower (sbc->name));
2034 for (spec = sbc->spec; spec; spec = spec->next)
2035 for (s = spec->s; s; s = s->next)
2036 if (s->value == VAL_STRING)
2037 dump (0, "free (p->%s%s);",
2038 sbc->prefix, st_lower (s->valname));
2052 /* Returns the name of a directive found on the current input line, if
2053 any, or a null pointer if none found. */
2055 recognize_directive (void)
2057 static char directive[16];
2061 if (strncmp (sp, "/*", 2))
2063 sp = skip_ws (sp + 2);
2068 ep = strchr (sp, ')');
2074 memcpy (directive, sp, ep - sp);
2075 directive[ep - sp] = '\0';
2080 main (int argc, char *argv[])
2082 program_name = argv[0];
2084 fail ("Syntax: q2c input.q output.c");
2087 in = fopen (ifn, "r");
2089 fail ("%s: open: %s.", ifn, strerror (errno));
2092 out = fopen (ofn, "w");
2094 fail ("%s: open: %s.", ofn, strerror (errno));
2097 buf = xmalloc (MAX_LINE_LEN);
2098 tokstr = xmalloc (MAX_TOK_LEN);
2104 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2107 const char *directive = recognize_directive ();
2108 if (directive == NULL)
2110 dump (0, "%s", buf);
2114 dump (0, "#line %d \"%s\"", oln + 1, ofn);
2115 if (!strcmp (directive, "specification"))
2117 /* Skip leading slash-star line. */
2123 /* Skip trailing star-slash line. */
2126 else if (!strcmp (directive, "headers"))
2130 dump (0, "#include <stdlib.h>");
2131 dump_blank_line (0);
2133 dump (0, "#include \"data/settings.h\"");
2134 dump (0, "#include \"data/variable.h\"");
2135 dump (0, "#include \"language/lexer/lexer.h\"");
2136 dump (0, "#include \"language/lexer/subcommand-list.h\"");
2137 dump (0, "#include \"language/lexer/variable-parser.h\"");
2138 dump (0, "#include \"libpspp/assertion.h\"");
2139 dump (0, "#include \"libpspp/message.h\"");
2140 dump (0, "#include \"libpspp/str.h\"");
2141 dump_blank_line (0);
2143 dump (0, "#include \"gl/xalloc.h\"");
2144 dump_blank_line (0);
2146 dump (0, "#include \"gettext.h\"");
2147 dump (0, "#define _(msgid) gettext (msgid)");
2148 dump_blank_line (0);
2150 else if (!strcmp (directive, "declarations"))
2151 dump_declarations ();
2152 else if (!strcmp (directive, "functions"))
2157 else if (!strcmp (directive, "_functions"))
2163 error ("unknown directive `%s'", directive);
2165 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2168 return EXIT_SUCCESS;