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_token (lexer) != T_ID "
1528 "&& !lex_is_string (lexer))");
1530 dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1531 "requires a string argument.\"));",
1532 s->specname, sbc->name);
1533 dump (0, "goto lossage;");
1535 dump (-1, "free (p->%s%s);", sbc->prefix, st_lower (s->valname));
1536 dump (0, "p->%s%s = ss_xstrdup (ss_tokss (lexer));",
1537 sbc->prefix, st_lower (s->valname));
1546 str = xmalloc (MAX_TOK_LEN);
1547 str2 = xmalloc (MAX_TOK_LEN);
1548 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1549 sprintf (str, s->restriction, str2, str2, str2, str2,
1550 str2, str2, str2, str2);
1551 dump (1, "if (!(%s))", str);
1557 dump (0, "msg (SE, _(\"Bad argument for %s "
1558 "specifier of %s subcommand.\"));",
1559 s->specname, sbc->name);
1560 dump (0, "goto lossage;");
1565 dump (0, "lex_get (lexer);");
1567 if (s->valtype == VT_PAREN)
1569 dump (1, "if (!lex_force_match (lexer, T_RPAREN))");
1570 dump (0, "goto lossage;");
1579 if (s != spec->omit_kw)
1583 if (s == spec->omit_kw)
1592 /* Write out the code to parse subcommand SBC. */
1594 dump_subcommand (const subcommand *sbc)
1596 if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1600 dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1606 for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1609 dump_specifier_parse (spec, sbc);
1613 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1614 make_match (st_upper (spec->varname)));
1615 if (sbc->type == SBC_PLAIN)
1616 dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1619 dump (0, "p->a_%s[%s%s%s] = 1;",
1620 st_lower (sbc->name),
1621 st_upper (prefix), st_upper (sbc->prefix),
1622 st_upper (spec->varname));
1632 /* This code first finds the last specifier in sbc. Then it
1633 finds the last setting within that last specifier. Either
1634 or both might be NULL. */
1647 if (spec && (!spec->s || !spec->omit_kw))
1651 dump (0, "lex_error (lexer, NULL);");
1652 dump (0, "goto lossage;");
1658 dump (0, "lex_match (lexer, T_COMMA);");
1662 else if (sbc->type == SBC_VARLIST)
1664 dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1666 st_lower (sbc->prefix), st_lower (sbc->name),
1667 st_lower (sbc->prefix), st_lower (sbc->name),
1668 sbc->message ? " |" : "",
1669 sbc->message ? sbc->message : "");
1670 dump (0, "goto lossage;");
1673 else if (sbc->type == SBC_VAR)
1675 dump (0, "p->%sv_%s = parse_variable (lexer, dataset_dict (ds));",
1676 st_lower (sbc->prefix), st_lower (sbc->name));
1677 dump (1, "if (!p->%sv_%s)",
1678 st_lower (sbc->prefix), st_lower (sbc->name));
1679 dump (0, "goto lossage;");
1682 else if (sbc->type == SBC_STRING)
1684 if (sbc->restriction)
1689 dump (1, "if (!lex_force_string (lexer))");
1690 dump (0, "return false;");
1692 if (sbc->restriction)
1694 dump (0, "x = ss_length (lex_tokss (lexer));");
1695 dump (1, "if (!(%s))", sbc->restriction);
1697 dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1698 sbc->name, sbc->message);
1699 dump (0, "goto lossage;");
1703 dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1704 dump (0, "p->s_%s = ss_xstrdup (lex_tokss (lexer));",
1705 st_lower (sbc->name));
1706 dump (0, "lex_get (lexer);");
1707 if (sbc->restriction)
1710 else if (sbc->type == SBC_DBL)
1712 dump (1, "if (!lex_force_num (lexer))");
1713 dump (0, "goto lossage;");
1714 dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number (lexer);",
1715 st_lower (sbc->name), st_lower (sbc->name) );
1716 dump (0, "lex_get(lexer);");
1718 else if (sbc->type == SBC_INT)
1722 dump (1, "if (!lex_force_int (lexer))");
1723 dump (0, "goto lossage;");
1724 dump (-1, "x = lex_integer (lexer);");
1725 dump (0, "lex_get(lexer);");
1726 if (sbc->restriction)
1729 dump (1, "if (!(%s))", sbc->restriction);
1731 sprintf(buf,sbc->message,sbc->name);
1732 if ( sbc->translatable )
1733 dump (0, "msg (SE, gettext(\"%s\"));",buf);
1735 dump (0, "msg (SE, \"%s\");",buf);
1736 dump (0, "goto lossage;");
1739 dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
1742 else if (sbc->type == SBC_PINT)
1744 dump (0, "lex_match (lexer, T_LPAREN);");
1745 dump (1, "if (!lex_force_int (lexer))");
1746 dump (0, "goto lossage;");
1747 dump (-1, "p->n_%s = lex_integer (lexer);", st_lower (sbc->name));
1748 dump (0, "lex_match (lexer, T_RPAREN);");
1750 else if (sbc->type == SBC_DBL_LIST || sbc->type == SBC_INT_LIST)
1752 dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1754 dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
1755 dump (0, "goto lossage;");
1758 dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1760 dump (0, "lex_match (lexer, T_COMMA);");
1761 dump (0, "if (!lex_force_num (lexer))");
1763 dump (0, "goto lossage;");
1766 dump (0, "subc_list_%s_push (&p->%cl_%s[p->sbc_%s-1], lex_number (lexer));",
1767 sbc->type == SBC_INT_LIST ? "int" : "double",
1768 sbc->type == SBC_INT_LIST ? 'i' : 'd',
1769 st_lower (sbc->name), st_lower (sbc->name));
1771 dump (0, "lex_get (lexer);");
1775 else if (sbc->type == SBC_CUSTOM)
1777 dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1778 st_lower (prefix), st_lower (sbc->name));
1780 dump (1, "case 0:");
1781 dump (0, "goto lossage;");
1782 dump (-1, "case 1:");
1785 dump (-1, "case 2:");
1787 dump (0, "lex_error (lexer, NULL);");
1788 dump (0, "goto lossage;");
1789 dump (-1, "default:");
1791 dump (0, "NOT_REACHED ();");
1797 /* Write out entire parser. */
1799 dump_parser (int persistent)
1805 dump (0, "static int");
1806 dump (0, "parse_%s (struct lexer *lexer, struct dataset *ds%s, struct cmd_%s *p, void *aux UNUSED)",
1807 make_identifier (cmdname),
1808 (def && ( def->type == SBC_VARLIST && def->type == SBC_CUSTOM))?"":" UNUSED",
1809 make_identifier (cmdname));
1812 dump_vars_init (persistent);
1814 dump (1, "for (;;)");
1818 if (def && (def->type == SBC_VARLIST))
1820 if (def->type == SBC_VARLIST)
1821 dump (1, "if (lex_token (lexer) == T_ID "
1822 "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) != NULL "
1823 "&& lex_next_token (lexer, 1) != T_EQUALS)");
1826 dump (0, "if ((lex_token (lexer) == T_ID "
1827 "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) "
1828 "&& lex_next_token (lexer, 1) != T_EQUALS)");
1829 dump (1, " || token == T_ALL)");
1832 dump (0, "p->sbc_%s++;", st_lower (def->name));
1833 dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1835 st_lower (def->prefix), st_lower (def->name),
1836 st_lower (def->prefix), st_lower (def->name));
1837 dump (0, "goto lossage;");
1842 else if (def && def->type == SBC_CUSTOM)
1844 dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1845 st_lower (prefix), st_lower (def->name));
1847 dump (1, "case 0:");
1848 dump (0, "goto lossage;");
1849 dump (-1, "case 1:");
1851 dump (0, "p->sbc_%s++;", st_lower (def->name));
1852 dump (0, "continue;");
1853 dump (-1, "case 2:");
1856 dump (-1, "default:");
1858 dump (0, "NOT_REACHED ();");
1866 for (sbc = subcommands; sbc; sbc = sbc->next)
1868 dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1872 dump (0, "lex_match (lexer, T_EQUALS);");
1873 dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1874 if (sbc->arity != ARITY_MANY)
1876 dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1878 dump (0, "lex_sbc_only_once (\"%s\");", sbc->name);
1879 dump (0, "goto lossage;");
1883 dump_subcommand (sbc);
1890 /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1891 dump(1,"else if ( settings_get_syntax () != COMPATIBLE && lex_match_id(lexer, \"ALGORITHM\"))");
1894 dump (0, "lex_match (lexer, T_EQUALS);");
1896 dump(1,"if (lex_match_id(lexer, \"COMPATIBLE\"))");
1897 dump(0,"settings_set_cmd_algorithm (COMPATIBLE);");
1899 dump(1,"else if (lex_match_id(lexer, \"ENHANCED\"))");
1900 dump(0,"settings_set_cmd_algorithm (ENHANCED);");
1907 dump (1, "if (!lex_match (lexer, T_SLASH))");
1911 dump_blank_line (0);
1912 dump (1, "if (lex_token (lexer) != T_ENDCMD)");
1914 dump (0, "lex_error (lexer, _(\"expecting end of command\"));");
1915 dump (0, "goto lossage;");
1917 dump_blank_line (0);
1922 /* Check that mandatory subcommands have been specified */
1925 for (sbc = subcommands; sbc; sbc = sbc->next)
1928 if ( sbc->arity == ARITY_ONCE_EXACTLY )
1930 dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
1932 dump (0, "lex_sbc_missing (\"%s\");", sbc->name);
1933 dump (0, "goto lossage;");
1935 dump_blank_line (0);
1940 dump (-1, "return true;");
1941 dump_blank_line (0);
1942 dump (-1, "lossage:");
1944 dump (0, "free_%s (p);", make_identifier (cmdname));
1945 dump (0, "return false;");
1947 dump_blank_line (0);
1951 /* Write the output file header. */
1956 dump (0, "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1957 dump_blank_line (0);
1958 dump (0, " Generated by q2c from %s.", ifn);
1959 dump (0, " Do not modify!");
1963 /* Write out commands to free variable state. */
1965 dump_free (int persistent)
1975 for (sbc = subcommands; sbc; sbc = sbc->next)
1976 used = (sbc->type == SBC_STRING
1977 || sbc->type == SBC_DBL_LIST
1978 || sbc->type == SBC_INT_LIST);
1981 dump (0, "static void");
1982 dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1983 make_identifier (cmdname), used ? "" : " UNUSED");
1989 for (sbc = subcommands; sbc; sbc = sbc->next)
1994 dump (0, "free (p->v_%s);", st_lower (sbc->name));
1997 dump (0, "free (p->s_%s);", st_lower (sbc->name));
2003 dump (2, "for(i = 0; i < MAXLISTS ; ++i)");
2004 dump (1, "subc_list_%s_destroy(&p->%cl_%s[i]);",
2005 sbc->type == SBC_INT_LIST ? "int" : "double",
2006 sbc->type == SBC_INT_LIST ? 'i' : 'd',
2007 st_lower (sbc->name));
2016 for (spec = sbc->spec; spec; spec = spec->next)
2017 for (s = spec->s; s; s = s->next)
2018 if (s->value == VAL_STRING)
2019 dump (0, "free (p->%s%s);",
2020 sbc->prefix, st_lower (s->valname));
2034 /* Returns the name of a directive found on the current input line, if
2035 any, or a null pointer if none found. */
2037 recognize_directive (void)
2039 static char directive[16];
2043 if (strncmp (sp, "/*", 2))
2045 sp = skip_ws (sp + 2);
2050 ep = strchr (sp, ')');
2056 memcpy (directive, sp, ep - sp);
2057 directive[ep - sp] = '\0';
2062 main (int argc, char *argv[])
2064 program_name = argv[0];
2066 fail ("Syntax: q2c input.q output.c");
2069 in = fopen (ifn, "r");
2071 fail ("%s: open: %s.", ifn, strerror (errno));
2074 out = fopen (ofn, "w");
2076 fail ("%s: open: %s.", ofn, strerror (errno));
2079 buf = xmalloc (MAX_LINE_LEN);
2080 tokstr = xmalloc (MAX_TOK_LEN);
2086 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2089 const char *directive = recognize_directive ();
2090 if (directive == NULL)
2092 dump (0, "%s", buf);
2096 dump (0, "#line %d \"%s\"", oln + 1, ofn);
2097 if (!strcmp (directive, "specification"))
2099 /* Skip leading slash-star line. */
2105 /* Skip trailing star-slash line. */
2108 else if (!strcmp (directive, "headers"))
2112 dump (0, "#include <stdlib.h>");
2113 dump_blank_line (0);
2115 dump (0, "#include \"data/settings.h\"");
2116 dump (0, "#include \"data/variable.h\"");
2117 dump (0, "#include \"language/lexer/lexer.h\"");
2118 dump (0, "#include \"language/lexer/subcommand-list.h\"");
2119 dump (0, "#include \"language/lexer/variable-parser.h\"");
2120 dump (0, "#include \"libpspp/assertion.h\"");
2121 dump (0, "#include \"libpspp/message.h\"");
2122 dump (0, "#include \"libpspp/str.h\"");
2123 dump_blank_line (0);
2125 dump (0, "#include \"gl/xalloc.h\"");
2126 dump_blank_line (0);
2128 dump (0, "#include \"gettext.h\"");
2129 dump (0, "#define _(msgid) gettext (msgid)");
2130 dump_blank_line (0);
2132 else if (!strcmp (directive, "declarations"))
2133 dump_declarations ();
2134 else if (!strcmp (directive, "functions"))
2139 else if (!strcmp (directive, "_functions"))
2145 error ("unknown directive `%s'", directive);
2147 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2150 return EXIT_SUCCESS;