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, "lex_error_expecting (lexer, \"`('\", "
1505 dump (0, "goto lossage;");
1511 if (s->value == VAL_INT)
1513 dump (1, "if (!lex_force_int (lexer))");
1514 dump (0, "goto lossage;");
1515 dump (-1, "p->%s%s = lex_integer (lexer);",
1516 sbc->prefix, st_lower (s->valname));
1518 else if (s->value == VAL_DBL)
1520 dump (1, "if (!lex_force_num (lexer))");
1521 dump (0, "goto lossage;");
1522 dump (-1, "p->%s%s = lex_tokval (lexer);", sbc->prefix,
1523 st_lower (s->valname));
1525 else if (s->value == VAL_STRING)
1527 dump (1, "if (!lex_force_string_or_id (lexer))");
1528 dump (0, "goto lossage;");
1529 dump (-1, "free (p->%s%s);", sbc->prefix, st_lower (s->valname));
1530 dump (0, "p->%s%s = ss_xstrdup (ss_tokss (lexer));",
1531 sbc->prefix, st_lower (s->valname));
1540 str = xmalloc (MAX_TOK_LEN);
1541 str2 = xmalloc (MAX_TOK_LEN);
1542 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1543 sprintf (str, s->restriction, str2, str2, str2, str2,
1544 str2, str2, str2, str2);
1545 dump (1, "if (!(%s))", str);
1551 dump (0, "msg (SE, _(\"Bad argument for %s "
1552 "specifier of %s subcommand.\"));",
1553 s->specname, sbc->name);
1554 dump (0, "goto lossage;");
1559 dump (0, "lex_get (lexer);");
1561 if (s->valtype == VT_PAREN)
1563 dump (1, "if (!lex_force_match (lexer, T_RPAREN))");
1564 dump (0, "goto lossage;");
1573 if (s != spec->omit_kw)
1577 if (s == spec->omit_kw)
1586 /* Write out the code to parse subcommand SBC. */
1588 dump_subcommand (const subcommand *sbc)
1590 if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1594 dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1600 for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1603 dump_specifier_parse (spec, sbc);
1607 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1608 make_match (st_upper (spec->varname)));
1609 if (sbc->type == SBC_PLAIN)
1610 dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1613 dump (0, "p->a_%s[%s%s%s] = 1;",
1614 st_lower (sbc->name),
1615 st_upper (prefix), st_upper (sbc->prefix),
1616 st_upper (spec->varname));
1626 /* This code first finds the last specifier in sbc. Then it
1627 finds the last setting within that last specifier. Either
1628 or both might be NULL. */
1641 if (spec && (!spec->s || !spec->omit_kw))
1645 dump (0, "lex_error (lexer, NULL);");
1646 dump (0, "goto lossage;");
1652 dump (0, "lex_match (lexer, T_COMMA);");
1656 else if (sbc->type == SBC_VARLIST)
1658 dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1660 st_lower (sbc->prefix), st_lower (sbc->name),
1661 st_lower (sbc->prefix), st_lower (sbc->name),
1662 sbc->message ? " |" : "",
1663 sbc->message ? sbc->message : "");
1664 dump (0, "goto lossage;");
1667 else if (sbc->type == SBC_VAR)
1669 dump (0, "p->%sv_%s = parse_variable (lexer, dataset_dict (ds));",
1670 st_lower (sbc->prefix), st_lower (sbc->name));
1671 dump (1, "if (!p->%sv_%s)",
1672 st_lower (sbc->prefix), st_lower (sbc->name));
1673 dump (0, "goto lossage;");
1676 else if (sbc->type == SBC_STRING)
1678 if (sbc->restriction)
1683 dump (1, "if (!lex_force_string (lexer))");
1684 dump (0, "return false;");
1686 if (sbc->restriction)
1688 dump (0, "x = ss_length (lex_tokss (lexer));");
1689 dump (1, "if (!(%s))", sbc->restriction);
1691 dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1692 sbc->name, sbc->message);
1693 dump (0, "goto lossage;");
1697 dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1698 dump (0, "p->s_%s = ss_xstrdup (lex_tokss (lexer));",
1699 st_lower (sbc->name));
1700 dump (0, "lex_get (lexer);");
1701 if (sbc->restriction)
1704 else if (sbc->type == SBC_DBL)
1706 dump (1, "if (!lex_force_num (lexer))");
1707 dump (0, "goto lossage;");
1708 dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number (lexer);",
1709 st_lower (sbc->name), st_lower (sbc->name) );
1710 dump (0, "lex_get(lexer);");
1712 else if (sbc->type == SBC_INT)
1716 dump (1, "if (!lex_force_int (lexer))");
1717 dump (0, "goto lossage;");
1718 dump (-1, "x = lex_integer (lexer);");
1719 dump (0, "lex_get(lexer);");
1720 if (sbc->restriction)
1723 dump (1, "if (!(%s))", sbc->restriction);
1725 sprintf(buf,sbc->message,sbc->name);
1726 if ( sbc->translatable )
1727 dump (0, "msg (SE, gettext(\"%s\"));",buf);
1729 dump (0, "msg (SE, \"%s\");",buf);
1730 dump (0, "goto lossage;");
1733 dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
1736 else if (sbc->type == SBC_PINT)
1738 dump (0, "lex_match (lexer, T_LPAREN);");
1739 dump (1, "if (!lex_force_int (lexer))");
1740 dump (0, "goto lossage;");
1741 dump (-1, "p->n_%s = lex_integer (lexer);", st_lower (sbc->name));
1742 dump (0, "lex_match (lexer, T_RPAREN);");
1744 else if (sbc->type == SBC_DBL_LIST || sbc->type == SBC_INT_LIST)
1746 dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1748 dump (0, "subc_list_error (lexer, \"%s\", MAXLISTS);",
1749 st_lower(sbc->name));
1750 dump (0, "goto lossage;");
1753 dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1755 dump (0, "lex_match (lexer, T_COMMA);");
1756 dump (0, "if (!lex_force_num (lexer))");
1758 dump (0, "goto lossage;");
1761 dump (0, "subc_list_%s_push (&p->%cl_%s[p->sbc_%s-1], lex_number (lexer));",
1762 sbc->type == SBC_INT_LIST ? "int" : "double",
1763 sbc->type == SBC_INT_LIST ? 'i' : 'd',
1764 st_lower (sbc->name), st_lower (sbc->name));
1766 dump (0, "lex_get (lexer);");
1770 else if (sbc->type == SBC_CUSTOM)
1772 dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1773 st_lower (prefix), st_lower (sbc->name));
1775 dump (1, "case 0:");
1776 dump (0, "goto lossage;");
1777 dump (-1, "case 1:");
1780 dump (-1, "case 2:");
1782 dump (0, "lex_error (lexer, NULL);");
1783 dump (0, "goto lossage;");
1784 dump (-1, "default:");
1786 dump (0, "NOT_REACHED ();");
1792 /* Write out entire parser. */
1794 dump_parser (int persistent)
1800 dump (0, "static int");
1801 dump (0, "parse_%s (struct lexer *lexer, struct dataset *ds%s, struct cmd_%s *p, void *aux UNUSED)",
1802 make_identifier (cmdname),
1803 (def && ( def->type == SBC_VARLIST && def->type == SBC_CUSTOM))?"":" UNUSED",
1804 make_identifier (cmdname));
1807 dump_vars_init (persistent);
1809 dump (1, "for (;;)");
1813 if (def && (def->type == SBC_VARLIST))
1815 if (def->type == SBC_VARLIST)
1816 dump (1, "if (lex_token (lexer) == T_ID "
1817 "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) != NULL "
1818 "&& lex_next_token (lexer, 1) != T_EQUALS)");
1821 dump (0, "if ((lex_token (lexer) == T_ID "
1822 "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) "
1823 "&& lex_next_token (lexer, 1) != T_EQUALS)");
1824 dump (1, " || token == T_ALL)");
1827 dump (0, "p->sbc_%s++;", st_lower (def->name));
1828 dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1830 st_lower (def->prefix), st_lower (def->name),
1831 st_lower (def->prefix), st_lower (def->name));
1832 dump (0, "goto lossage;");
1837 else if (def && def->type == SBC_CUSTOM)
1839 dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1840 st_lower (prefix), st_lower (def->name));
1842 dump (1, "case 0:");
1843 dump (0, "goto lossage;");
1844 dump (-1, "case 1:");
1846 dump (0, "p->sbc_%s++;", st_lower (def->name));
1847 dump (0, "continue;");
1848 dump (-1, "case 2:");
1851 dump (-1, "default:");
1853 dump (0, "NOT_REACHED ();");
1861 for (sbc = subcommands; sbc; sbc = sbc->next)
1863 dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1867 dump (0, "lex_match (lexer, T_EQUALS);");
1868 dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1869 if (sbc->arity != ARITY_MANY)
1871 dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1873 dump (0, "lex_sbc_only_once (\"%s\");", sbc->name);
1874 dump (0, "goto lossage;");
1878 dump_subcommand (sbc);
1885 /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1886 dump(1,"else if ( settings_get_syntax () != COMPATIBLE && lex_match_id(lexer, \"ALGORITHM\"))");
1889 dump (0, "lex_match (lexer, T_EQUALS);");
1891 dump(1,"if (lex_match_id(lexer, \"COMPATIBLE\"))");
1892 dump(0,"settings_set_cmd_algorithm (COMPATIBLE);");
1894 dump(1,"else if (lex_match_id(lexer, \"ENHANCED\"))");
1895 dump(0,"settings_set_cmd_algorithm (ENHANCED);");
1902 dump (1, "if (!lex_match (lexer, T_SLASH))");
1906 dump_blank_line (0);
1907 dump (1, "if (lex_token (lexer) != T_ENDCMD)");
1909 dump (0, "lex_error (lexer, _(\"expecting end of command\"));");
1910 dump (0, "goto lossage;");
1912 dump_blank_line (0);
1917 /* Check that mandatory subcommands have been specified */
1920 for (sbc = subcommands; sbc; sbc = sbc->next)
1923 if ( sbc->arity == ARITY_ONCE_EXACTLY )
1925 dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
1927 dump (0, "lex_sbc_missing (\"%s\");", sbc->name);
1928 dump (0, "goto lossage;");
1930 dump_blank_line (0);
1935 dump (-1, "return true;");
1936 dump_blank_line (0);
1937 dump (-1, "lossage:");
1939 dump (0, "free_%s (p);", make_identifier (cmdname));
1940 dump (0, "return false;");
1942 dump_blank_line (0);
1946 /* Write the output file header. */
1951 dump (0, "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1952 dump_blank_line (0);
1953 dump (0, " Generated by q2c from %s.", ifn);
1954 dump (0, " Do not modify!");
1958 /* Write out commands to free variable state. */
1960 dump_free (int persistent)
1970 for (sbc = subcommands; sbc; sbc = sbc->next)
1971 used = (sbc->type == SBC_STRING
1972 || sbc->type == SBC_DBL_LIST
1973 || sbc->type == SBC_INT_LIST);
1976 dump (0, "static void");
1977 dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1978 make_identifier (cmdname), used ? "" : " UNUSED");
1984 for (sbc = subcommands; sbc; sbc = sbc->next)
1989 dump (0, "free (p->v_%s);", st_lower (sbc->name));
1992 dump (0, "free (p->s_%s);", st_lower (sbc->name));
1998 dump (2, "for(i = 0; i < MAXLISTS ; ++i)");
1999 dump (1, "subc_list_%s_destroy(&p->%cl_%s[i]);",
2000 sbc->type == SBC_INT_LIST ? "int" : "double",
2001 sbc->type == SBC_INT_LIST ? 'i' : 'd',
2002 st_lower (sbc->name));
2011 for (spec = sbc->spec; spec; spec = spec->next)
2012 for (s = spec->s; s; s = s->next)
2013 if (s->value == VAL_STRING)
2014 dump (0, "free (p->%s%s);",
2015 sbc->prefix, st_lower (s->valname));
2029 /* Returns the name of a directive found on the current input line, if
2030 any, or a null pointer if none found. */
2032 recognize_directive (void)
2034 static char directive[16];
2038 if (strncmp (sp, "/*", 2))
2040 sp = skip_ws (sp + 2);
2045 ep = strchr (sp, ')');
2051 memcpy (directive, sp, ep - sp);
2052 directive[ep - sp] = '\0';
2057 main (int argc, char *argv[])
2059 program_name = argv[0];
2061 fail ("Syntax: q2c input.q output.c");
2064 in = fopen (ifn, "r");
2066 fail ("%s: open: %s.", ifn, strerror (errno));
2069 out = fopen (ofn, "w");
2071 fail ("%s: open: %s.", ofn, strerror (errno));
2074 buf = xmalloc (MAX_LINE_LEN);
2075 tokstr = xmalloc (MAX_TOK_LEN);
2081 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2084 const char *directive = recognize_directive ();
2085 if (directive == NULL)
2087 dump (0, "%s", buf);
2091 dump (0, "#line %d \"%s\"", oln + 1, ofn);
2092 if (!strcmp (directive, "specification"))
2094 /* Skip leading slash-star line. */
2100 /* Skip trailing star-slash line. */
2103 else if (!strcmp (directive, "headers"))
2107 dump (0, "#include <stdlib.h>");
2108 dump_blank_line (0);
2110 dump (0, "#include \"data/settings.h\"");
2111 dump (0, "#include \"data/variable.h\"");
2112 dump (0, "#include \"language/lexer/lexer.h\"");
2113 dump (0, "#include \"language/lexer/subcommand-list.h\"");
2114 dump (0, "#include \"language/lexer/variable-parser.h\"");
2115 dump (0, "#include \"libpspp/assertion.h\"");
2116 dump (0, "#include \"libpspp/message.h\"");
2117 dump (0, "#include \"libpspp/str.h\"");
2118 dump_blank_line (0);
2120 dump (0, "#include \"gl/xalloc.h\"");
2121 dump_blank_line (0);
2123 dump (0, "#include \"gettext.h\"");
2124 dump (0, "#define _(msgid) gettext (msgid)");
2125 dump_blank_line (0);
2127 else if (!strcmp (directive, "declarations"))
2128 dump_declarations ();
2129 else if (!strcmp (directive, "functions"))
2134 else if (!strcmp (directive, "_functions"))
2140 error ("unknown directive `%s'", directive);
2142 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2145 return EXIT_SUCCESS;