1 /* q2c - parser generator for PSPP procedures.
2 Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
3 Written by Ben Pfaff <blp@gnu.org>.
5 This program is free software; you can redistribute it and/or
6 modify it under the terms of the GNU General Public License as
7 published by the Free Software Foundation; either version 2 of the
8 License, or (at your option) any later version.
10 This program is distributed in the hope that it will be useful, but
11 WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
30 #include <libpspp/compiler.h>
31 #include <libpspp/str.h>
36 #define EXIT_SUCCESS 0
40 #define EXIT_FAILURE 1
44 /* Max length of an input line. */
45 #define MAX_LINE_LEN 1024
47 /* Max token length. */
48 #define MAX_TOK_LEN 1024
53 /* Have the input and output files been opened yet? */
56 /* Input, output files. */
59 /* Input, output file names. */
62 /* Input, output file line number. */
65 /* Input line buffer, current position. */
71 T_STRING = 256, /* String literal. */
72 T_ID = 257 /* Identifier. */
75 /* Current token: either one of the above, or a single character. */
78 /* Token string value. */
81 /* Utility functions. */
85 /* Close all open files and delete the output file, on failure. */
94 if (remove (ofn) == -1)
95 fprintf (stderr, "%s: %s: remove: %s\n", program_name, ofn, strerror (errno));
98 void hcf (void) NO_RETURN;
100 /* Terminate unsuccessfully. */
108 int fail (const char *, ...) PRINTF_FORMAT (1, 2);
109 int error (const char *, ...) PRINTF_FORMAT (1, 2);
111 /* Output an error message and terminate unsuccessfully. */
113 fail (const char *format, ...)
117 va_start (args, format);
118 fprintf (stderr, "%s: ", program_name);
119 vfprintf (stderr, format, args);
120 fprintf (stderr, "\n");
126 /* Output a context-dependent error message and terminate
129 error (const char *format,...)
133 va_start (args, format);
134 fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
135 vfprintf (stderr, format, args);
136 fprintf (stderr, "\n");
142 #define VME "virtual memory exhausted"
144 /* Allocate a block of SIZE bytes and return a pointer to its
147 xmalloc (size_t size)
156 fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
161 /* Make a dynamically allocated copy of string S and return a pointer
162 to the first character. */
164 xstrdup (const char *s)
170 size = strlen (s) + 1;
174 fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
180 /* Returns a pointer to one of 8 static buffers. The buffers are used
185 static char b[8][256];
194 /* Copies a string to a static buffer, converting it to lowercase in
195 the process, and returns a pointer to the static buffer. */
197 st_lower (const char *s)
201 p = cp = get_buffer ();
203 *cp++ = tolower ((unsigned char) (*s++));
209 /* Copies a string to a static buffer, converting it to uppercase in
210 the process, and returns a pointer to the static buffer. */
212 st_upper (const char *s)
216 p = cp = get_buffer ();
218 *cp++ = toupper ((unsigned char) (*s++));
224 /* Returns the address of the first non-whitespace character in S, or
225 the address of the null terminator if none. */
227 skip_ws (const char *s)
229 while (isspace ((unsigned char) *s))
234 /* Read one line from the input file into buf. Lines having special
235 formats are handled specially. */
240 if (0 == fgets (buf, MAX_LINE_LEN, in))
243 fail ("%s: fgets: %s", ifn, strerror (errno));
247 cp = strchr (buf, '\n');
255 /* Symbol table manager. */
257 /* Symbol table entry. */
258 typedef struct symbol symbol;
261 symbol *next; /* Next symbol in symbol table. */
262 char *name; /* Symbol name. */
263 int unique; /* 1=Name must be unique in this file. */
264 int ln; /* Line number of definition. */
265 int value; /* Symbol value. */
271 /* Add a symbol to the symbol table having name NAME, uniqueness
272 UNIQUE, and value VALUE. If a symbol having the same name is found
273 in the symbol table, its sequence number is returned and the symbol
274 table is not modified. Otherwise, the symbol is added and the next
275 available sequence number is returned. */
277 add_symbol (const char *name, int unique, int value)
282 sym = xmalloc (sizeof *sym);
283 sym->name = xstrdup (name);
284 sym->unique = unique;
297 if (!strcmp (iter->name, name))
301 fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
303 fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
320 /* Finds the symbol having given sequence number X within the symbol
321 table, and returns the associated symbol structure. */
328 while (x > 1 && iter)
338 /* Writes a printable representation of the current token to
346 printf ("STRING\t\"%s\"\n", tokstr);
349 printf ("ID\t%s\n", tokstr);
352 printf ("PUNCT\t%c\n", token);
355 #endif /* DUMP_TOKENS */
357 /* Reads a token from the input file. */
361 /* Skip whitespace and check for end of file. */
369 fail ("%s: Unexpected end of file.", ifn);
377 while (*cp != '"' && *cp)
383 error ("Unterminated string literal.");
391 error ("Unterminated string literal.");
394 else if (*cp == '_' || isalnum ((unsigned char) *cp))
398 while (*cp == '_' || isalnum ((unsigned char) *cp))
399 *dest++ = toupper ((unsigned char) (*cp++));
412 /* Force the current token to be an identifier token. */
417 error ("Identifier expected.");
420 /* Force the current token to be a string token. */
424 if (token != T_STRING)
425 error ("String expected.");
428 /* Checks whether the current token is the identifier S; if so, skips
429 the token and returns 1; otherwise, returns 0. */
431 match_id (const char *s)
433 if (token == T_ID && !strcmp (tokstr, s))
441 /* Checks whether the current token is T. If so, skips the token and
442 returns 1; otherwise, returns 0. */
454 /* Force the current token to be T, and skip it. */
459 error ("`%c' expected.", t);
465 /* Some specifiers have associated values. */
468 VAL_NONE, /* No value. */
469 VAL_INT, /* Integer value. */
470 VAL_DBL /* Floating point value. */
473 /* For those specifiers with values, the syntax of those values. */
476 VT_PLAIN, /* Unadorned value. */
477 VT_PAREN /* Value must be enclosed in parentheses. */
480 /* Forward definition. */
481 typedef struct specifier specifier;
483 /* A single setting. */
484 typedef struct setting setting;
487 specifier *parent; /* Owning specifier. */
488 setting *next; /* Next in the chain. */
489 char *specname; /* Name of the setting. */
490 int con; /* Sequence number. */
493 int valtype; /* One of VT_*. */
494 int value; /* One of VAL_*. */
495 int optvalue; /* 1=value is optional, 0=value is required. */
496 char *valname; /* Variable name for the value. */
497 char *restriction; /* !=NULL: expression specifying valid values. */
500 /* A single specifier. */
503 specifier *next; /* Next in the chain. */
504 char *varname; /* Variable name. */
505 setting *s; /* Associated settings. */
507 setting *def; /* Default setting. */
508 setting *omit_kw; /* Setting for which the keyword can be omitted. */
510 int index; /* Next array index. */
513 /* Subcommand types. */
516 SBC_PLAIN, /* The usual case. */
517 SBC_VARLIST, /* Variable list. */
518 SBC_INT, /* Integer value. */
519 SBC_PINT, /* Integer inside parentheses. */
520 SBC_DBL, /* Floating point value. */
521 SBC_INT_LIST, /* List of integers (?). */
522 SBC_DBL_LIST, /* List of floating points (?). */
523 SBC_CUSTOM, /* Custom. */
524 SBC_ARRAY, /* Array of boolean values. */
525 SBC_STRING, /* String value. */
526 SBC_VAR /* Single variable name. */
532 ARITY_ONCE_EXACTLY, /* must occur exactly once */
533 ARITY_ONCE_ONLY, /* zero or once */
534 ARITY_MANY /* 0, 1, ... , inf */
537 /* A single subcommand. */
538 typedef struct subcommand subcommand;
541 subcommand *next; /* Next in the chain. */
542 char *name; /* Subcommand name. */
543 subcommand_type type; /* One of SBC_*. */
544 subcommand_arity arity; /* How many times should the subcommand occur*/
545 int narray; /* Index of next array element. */
546 const char *prefix; /* Prefix for variable and constant names. */
547 specifier *spec; /* Array of specifiers. */
549 /* SBC_STRING and SBC_INT only. */
550 char *restriction; /* Expression restricting string length. */
551 char *message; /* Error message. */
552 int translatable; /* Error message is translatable */
555 /* Name of the command; i.e., DESCRIPTIVES. */
558 /* Short prefix for the command; i.e., `dsc_'. */
561 /* List of subcommands. */
562 subcommand *subcommands;
564 /* Default subcommand if any, or NULL. */
569 void parse_subcommands (void);
571 /* Parse an entire specification. */
575 /* Get the command name and prefix. */
576 if (token != T_STRING && token != T_ID)
577 error ("Command name expected.");
578 cmdname = xstrdup (tokstr);
582 prefix = xstrdup (tokstr);
587 /* Read all the subcommands. */
590 parse_subcommands ();
593 /* Parses a single setting into S, given subcommand information SBC
594 and specifier information SPEC. */
596 parse_setting (setting *s, specifier *spec)
600 if (match_token ('*'))
603 error ("Cannot have two settings with omittable keywords.");
608 if (match_token ('!'))
611 error ("Cannot have two default settings.");
617 s->specname = xstrdup (tokstr);
618 s->con = add_symbol (s->specname, 0, 0);
623 /* Parse setting value info if necessary. */
624 if (token != '/' && token != ';' && token != '.' && token != ',')
628 s->valtype = VT_PAREN;
632 s->valtype = VT_PLAIN;
634 s->optvalue = match_token ('*');
638 else if (match_id ("D"))
641 error ("`n' or `d' expected.");
646 s->valname = xstrdup (tokstr);
653 s->restriction = xstrdup (tokstr);
657 s->restriction = NULL;
659 if (s->valtype == VT_PAREN)
664 /* Parse a single specifier into SPEC, given subcommand information
667 parse_specifier (specifier *spec, subcommand *sbc)
672 spec->omit_kw = NULL;
673 spec->varname = NULL;
677 spec->varname = xstrdup (st_lower (tokstr));
681 /* Handle array elements. */
684 spec->index = sbc->narray;
685 if (sbc->type == SBC_ARRAY)
697 if ( sbc->type == SBC_ARRAY && token == T_ID )
699 spec->varname = xstrdup (st_lower (tokstr));
700 spec->index = sbc->narray;
706 /* Parse all the settings. */
708 setting **s = &spec->s;
712 *s = xmalloc (sizeof **s);
713 parse_setting (*s, spec);
714 if (token == ',' || token == ';' || token == '.')
723 /* Parse a list of specifiers for subcommand SBC. */
725 parse_specifiers (subcommand *sbc)
727 specifier **spec = &sbc->spec;
729 if (token == ';' || token == '.')
737 *spec = xmalloc (sizeof **spec);
738 parse_specifier (*spec, sbc);
739 if (token == ';' || token == '.')
742 spec = &(*spec)->next;
744 (*spec)->next = NULL;
747 /* Parse a subcommand into SBC. */
749 parse_subcommand (subcommand *sbc)
751 sbc->arity = ARITY_MANY;
753 if (match_token ('*'))
756 error ("Multiple default subcommands.");
760 if ( match_token('+'))
761 sbc->arity = ARITY_ONCE_ONLY ;
762 else if (match_token('^'))
763 sbc->arity = ARITY_ONCE_EXACTLY ;
767 sbc->name = xstrdup (tokstr);
771 sbc->type = SBC_PLAIN;
773 sbc->translatable = 0;
775 if (match_token ('['))
778 sbc->prefix = xstrdup (st_lower (tokstr));
784 sbc->type = SBC_ARRAY;
785 parse_specifiers (sbc);
790 if (match_token ('('))
793 sbc->prefix = xstrdup (st_lower (tokstr));
803 if (match_id ("VAR"))
805 if (match_id ("VARLIST"))
807 if (match_token ('('))
810 sbc->message = xstrdup (tokstr);
815 else sbc->message = NULL;
817 sbc->type = SBC_VARLIST;
819 else if (match_id ("INTEGER"))
821 sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
822 if ( token == T_STRING)
824 sbc->restriction = xstrdup (tokstr);
826 if ( match_id("N_") )
832 sbc->translatable = 1;
838 sbc->message = xstrdup (tokstr);
841 sbc->restriction = NULL;
843 else if (match_id ("PINT"))
844 sbc->type = SBC_PINT;
845 else if (match_id ("DOUBLE"))
847 if ( match_id ("LIST") )
848 sbc->type = SBC_DBL_LIST;
852 else if (match_id ("STRING"))
854 sbc->type = SBC_STRING;
855 if (token == T_STRING)
857 sbc->restriction = xstrdup (tokstr);
860 sbc->message = xstrdup (tokstr);
864 sbc->restriction = NULL;
866 else if (match_id ("CUSTOM"))
867 sbc->type = SBC_CUSTOM;
869 parse_specifiers (sbc);
873 /* Parse all the subcommands. */
875 parse_subcommands (void)
877 subcommand **sbc = &subcommands;
881 *sbc = xmalloc (sizeof **sbc);
884 parse_subcommand (*sbc);
896 #define BASE_INDENT 2 /* Starting indent. */
897 #define INC_INDENT 2 /* Indent increment. */
899 /* Increment the indent. */
900 #define indent() indent += INC_INDENT
901 #define outdent() indent -= INC_INDENT
903 /* Size of the indent from the left margin. */
906 void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
908 /* Write line FORMAT to the output file, formatted as with printf,
909 indented `indent' characters from the left margin. If INDENTION is
910 greater than 0, indents BASE_INDENT * INDENTION characters after
911 writing the line; if INDENTION is less than 0, dedents BASE_INDENT
912 * INDENTION characters _before_ writing the line. */
914 dump (int indention, const char *format, ...)
920 indent += BASE_INDENT * indention;
923 va_start (args, format);
924 for (i = 0; i < indent; i++)
926 vfprintf (out, format, args);
931 indent += BASE_INDENT * indention;
934 /* Write the structure members for specifier SPEC to the output file.
935 SBC is the including subcommand. */
937 dump_specifier_vars (const specifier *spec, const subcommand *sbc)
940 dump (0, "long %s%s;", sbc->prefix, spec->varname);
945 for (s = spec->s; s; s = s->next)
947 if (s->value != VAL_NONE)
949 const char *typename;
951 assert (s->value == VAL_INT || s->value == VAL_DBL);
952 typename = s->value == VAL_INT ? "long" : "double";
954 dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
960 /* Returns 1 if string T is a PSPP keyword, 0 otherwise. */
962 is_keyword (const char *t)
964 static const char *kw[] =
966 "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
967 "NE", "ALL", "BY", "TO", "WITH", 0,
971 for (cp = kw; *cp; cp++)
972 if (!strcmp (t, *cp))
977 /* Transforms a string NAME into a valid C identifier: makes
978 everything lowercase and maps nonalphabetic characters to
979 underscores. Returns a pointer to a static buffer. */
981 make_identifier (const char *name)
983 char *p = get_buffer ();
986 for (cp = p; *name; name++)
987 if (isalpha ((unsigned char) *name))
988 *cp++ = tolower ((unsigned char) (*name));
996 /* Writes the struct and enum declarations for the parser. */
998 dump_declarations (void)
1002 /* Write out enums for all the identifiers in the symbol table. */
1008 /* Note the squirmings necessary to make sure that the last enum
1009 is not followed by a comma, as mandated by ANSI C89. */
1010 for (sym = symtab, f = k = 0; sym; sym = sym->next)
1011 if (!sym->unique && !is_keyword (sym->name))
1015 dump (0, "/* Settings for subcommand specifiers. */");
1022 buf = xmalloc (1024);
1027 sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
1031 sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
1036 buf[strlen (buf) - 1] = 0;
1047 /* Write out some type definitions */
1049 dump (0, "#define MAXLISTS 10");
1053 /* For every array subcommand, write out the associated enumerated
1058 for (sbc = subcommands; sbc; sbc = sbc->next)
1059 if (sbc->type == SBC_ARRAY && sbc->narray)
1061 dump (0, "/* Array indices for %s subcommand. */", sbc->name);
1069 for (spec = sbc->spec; spec; spec = spec->next)
1070 dump (0, "%s%s%s = %d,",
1071 st_upper (prefix), st_upper (sbc->prefix),
1072 st_upper (spec->varname), spec->index);
1074 dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
1082 /* Write out structure declaration. */
1086 dump (0, "/* %s structure. */", cmdname);
1087 dump (1, "struct cmd_%s", make_identifier (cmdname));
1089 for (sbc = subcommands; sbc; sbc = sbc->next)
1093 if (sbc != subcommands)
1096 dump (0, "/* %s subcommand. */", sbc->name);
1097 dump (0, "int sbc_%s;", st_lower (sbc->name));
1106 for (spec = sbc->spec; spec; spec = spec->next)
1110 if (sbc->type == SBC_PLAIN)
1111 dump (0, "long int %s%s;", st_lower (sbc->prefix),
1115 dump (0, "int a_%s[%s%scount];",
1116 st_lower (sbc->name),
1118 st_upper (sbc->prefix)
1125 dump_specifier_vars (spec, sbc);
1131 dump (0, "size_t %sn_%s;", st_lower (sbc->prefix),
1132 st_lower (sbc->name));
1133 dump (0, "struct variable **%sv_%s;", st_lower (sbc->prefix),
1134 st_lower (sbc->name));
1138 dump (0, "struct variable *%sv_%s;", st_lower (sbc->prefix),
1139 st_lower (sbc->name));
1143 dump (0, "char *s_%s;", st_lower (sbc->name));
1148 dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
1152 dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
1156 dump (0, "subc_list_double dl_%s[MAXLISTS];",
1157 st_lower(sbc->name));
1161 dump (0, "subc_list_int il_%s[MAXLISTS];",
1162 st_lower(sbc->name));
1175 /* Write out prototypes for custom_*() functions as necessary. */
1180 for (sbc = subcommands; sbc; sbc = sbc->next)
1181 if (sbc->type == SBC_CUSTOM)
1186 dump (0, "/* Prototype for custom subcommands of %s. */",
1189 dump (0, "static int %scustom_%s (struct cmd_%s *);",
1190 st_lower (prefix), st_lower (sbc->name),
1191 make_identifier (cmdname));
1198 /* Prototypes for parsing and freeing functions. */
1200 dump (0, "/* Command parsing functions. */");
1201 dump (0, "static int parse_%s (struct cmd_%s *);",
1202 make_identifier (cmdname), make_identifier (cmdname));
1203 dump (0, "static void free_%s (struct cmd_%s *);",
1204 make_identifier (cmdname), make_identifier (cmdname));
1209 /* Writes out code to initialize all the variables that need
1210 initialization for particular specifier SPEC inside subcommand SBC. */
1212 dump_specifier_init (const specifier *spec, const subcommand *sbc)
1220 st_upper (prefix), find_symbol (spec->def->con)->name);
1223 dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
1229 for (s = spec->s; s; s = s->next)
1231 if (s->value != VAL_NONE)
1235 assert (s->value == VAL_INT || s->value == VAL_DBL);
1236 init = s->value == VAL_INT ? "NOT_LONG" : "SYSMIS";
1238 dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
1244 /* Write code to initialize all variables. */
1246 dump_vars_init (int persistent)
1248 /* Loop through all the subcommands. */
1252 for (sbc = subcommands; sbc; sbc = sbc->next)
1256 dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
1267 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1268 dump (0, "subc_list_double_create(&p->dl_%s[i]) ;",
1269 st_lower (sbc->name)
1277 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1278 dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
1291 for (spec = sbc->spec; spec; spec = spec->next)
1292 if (spec->s == NULL)
1294 if (sbc->type == SBC_PLAIN)
1295 dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
1298 dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
1299 st_lower (sbc->name), st_lower (sbc->name));
1304 dump_specifier_init (spec, sbc);
1309 dump (0, "p->%sn_%s = 0;",
1310 st_lower (sbc->prefix), st_lower (sbc->name));
1311 dump (0, "p->%sv_%s = NULL;",
1312 st_lower (sbc->prefix), st_lower (sbc->name));
1316 dump (0, "p->%sv_%s = NULL;",
1317 st_lower (sbc->prefix), st_lower (sbc->name));
1321 dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
1328 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1329 dump (0, "p->n_%s[i] = NOT_LONG;", st_lower (sbc->name));
1341 /* Return a pointer to a static buffer containing an expression that
1342 will match token T. */
1344 make_match (const char *t)
1354 sprintf (s, "lex_match (T_%s)", t);
1355 else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
1356 strcpy (s, "(lex_match_id (\"ON\") || lex_match_id (\"YES\") "
1357 "|| lex_match_id (\"TRUE\"))");
1358 else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
1359 strcpy (s, "(lex_match_id (\"OFF\") || lex_match_id (\"NO\") "
1360 "|| lex_match_id (\"FALSE\"))");
1361 else if (isdigit ((unsigned char) t[0]))
1362 sprintf (s, "lex_match_int (%s)", t);
1364 sprintf (s, "lex_match_id (\"%s\")", t);
1369 /* Write out the parsing code for specifier SPEC within subcommand
1372 dump_specifier_parse (const specifier *spec, const subcommand *sbc)
1376 if (spec->omit_kw && spec->omit_kw->next)
1377 error ("Omittable setting is not last setting in `%s' specifier.",
1379 if (spec->omit_kw && spec->omit_kw->parent->next)
1380 error ("Default specifier is not in last specifier in `%s' "
1381 "subcommand.", sbc->name);
1383 for (s = spec->s; s; s = s->next)
1385 int first = spec == sbc->spec && s == spec->s;
1387 /* Match the setting's keyword. */
1388 if (spec->omit_kw == s)
1395 dump (1, "%s;", make_match (s->specname));
1398 dump (1, "%sif (%s)", first ? "" : "else ",
1399 make_match (s->specname));
1402 /* Handle values. */
1403 if (s->value == VAL_NONE)
1404 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1405 st_upper (prefix), find_symbol (s->con)->name);
1408 if (spec->omit_kw != s)
1413 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1414 st_upper (prefix), find_symbol (s->con)->name);
1416 if ( sbc->type == SBC_ARRAY )
1417 dump (0, "p->a_%s[%s%s%s] = 1;",
1418 st_lower (sbc->name),
1419 st_upper (prefix), st_upper (sbc->prefix),
1420 st_upper (spec->varname));
1424 if (s->valtype == VT_PAREN)
1428 dump (1, "if (lex_match ('('))");
1433 dump (1, "if (!lex_match ('('))");
1435 dump (0, "msg (SE, _(\"`(' expected after %s "
1436 "specifier of %s subcommand.\"));",
1437 s->specname, sbc->name);
1438 dump (0, "goto lossage;");
1444 if (s->value == VAL_INT)
1446 dump (1, "if (!lex_is_integer ())");
1448 dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1449 "requires an integer argument.\"));",
1450 s->specname, sbc->name);
1451 dump (0, "goto lossage;");
1453 dump (-1, "p->%s%s = lex_integer ();",
1454 sbc->prefix, st_lower (s->valname));
1458 dump (1, "if (!lex_is_number ())");
1460 dump (0, "msg (SE, _(\"Number expected after %s "
1461 "specifier of %s subcommand.\"));",
1462 s->specname, sbc->name);
1463 dump (0, "goto lossage;");
1465 dump (-1, "p->%s%s = tokval;", sbc->prefix,
1466 st_lower (s->valname));
1473 str = xmalloc (MAX_TOK_LEN);
1474 str2 = xmalloc (MAX_TOK_LEN);
1475 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1476 sprintf (str, s->restriction, str2, str2, str2, str2,
1477 str2, str2, str2, str2);
1478 dump (1, "if (!(%s))", str);
1484 dump (0, "msg (SE, _(\"Bad argument for %s "
1485 "specifier of %s subcommand.\"));",
1486 s->specname, sbc->name);
1487 dump (0, "goto lossage;");
1492 dump (0, "lex_get ();");
1494 if (s->valtype == VT_PAREN)
1496 dump (1, "if (!lex_match (')'))");
1498 dump (0, "msg (SE, _(\"`)' expected after argument for "
1499 "%s specifier of %s.\"));",
1500 s->specname, sbc->name);
1501 dump (0, "goto lossage;");
1511 if (s != spec->omit_kw)
1515 if (s == spec->omit_kw)
1524 /* Write out the code to parse subcommand SBC. */
1526 dump_subcommand (const subcommand *sbc)
1528 if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1532 dump (1, "while (token != '/' && token != '.')");
1538 for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1541 dump_specifier_parse (spec, sbc);
1545 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1546 make_match (st_upper (spec->varname)));
1547 if (sbc->type == SBC_PLAIN)
1548 dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1551 dump (0, "p->a_%s[%s%s%s] = 1;",
1552 st_lower (sbc->name),
1553 st_upper (prefix), st_upper (sbc->prefix),
1554 st_upper (spec->varname));
1564 /* This code first finds the last specifier in sbc. Then it
1565 finds the last setting within that last specifier. Either
1566 or both might be NULL. */
1579 if (spec && (!spec->s || !spec->omit_kw))
1583 dump (0, "lex_error (NULL);");
1584 dump (0, "goto lossage;");
1590 dump (0, "lex_match (',');");
1594 else if (sbc->type == SBC_VARLIST)
1596 dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1598 st_lower (sbc->prefix), st_lower (sbc->name),
1599 st_lower (sbc->prefix), st_lower (sbc->name),
1600 sbc->message ? " |" : "",
1601 sbc->message ? sbc->message : "");
1602 dump (0, "goto lossage;");
1605 else if (sbc->type == SBC_VAR)
1607 dump (0, "p->%sv_%s = parse_variable ();",
1608 st_lower (sbc->prefix), st_lower (sbc->name));
1609 dump (1, "if (!p->%sv_%s)",
1610 st_lower (sbc->prefix), st_lower (sbc->name));
1611 dump (0, "goto lossage;");
1614 else if (sbc->type == SBC_STRING)
1616 if (sbc->restriction)
1621 dump (1, "if (!lex_force_string ())");
1622 dump (0, "return 0;");
1624 if (sbc->restriction)
1626 dump (0, "x = ds_length (&tokstr);");
1627 dump (1, "if (!(%s))", sbc->restriction);
1629 dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1630 sbc->name, sbc->message);
1631 dump (0, "goto lossage;");
1635 dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1636 dump (0, "p->s_%s = xstrdup (ds_c_str (&tokstr));",
1637 st_lower (sbc->name));
1638 dump (0, "lex_get ();");
1639 if (sbc->restriction)
1642 else if (sbc->type == SBC_DBL)
1644 dump (1, "if (!lex_force_num ())");
1645 dump (0, "goto lossage;");
1646 dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number ();",
1647 st_lower (sbc->name), st_lower (sbc->name) );
1648 dump (0, "lex_get();");
1650 else if (sbc->type == SBC_INT)
1654 dump (1, "if (!lex_force_int ())");
1655 dump (0, "goto lossage;");
1656 dump (-1, "x = lex_integer ();");
1657 dump (0, "lex_get();");
1658 if (sbc->restriction)
1661 dump (1, "if (!(%s))", sbc->restriction);
1663 sprintf(buf,sbc->message,sbc->name);
1664 if ( sbc->translatable )
1665 dump (0, "msg (SE, gettext(\"%s\"));",buf);
1667 dump (0, "msg (SE, \"%s\");",buf);
1668 dump (0, "goto lossage;");
1671 dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
1674 else if (sbc->type == SBC_PINT)
1676 dump (0, "lex_match ('(');");
1677 dump (1, "if (!lex_force_int ())");
1678 dump (0, "goto lossage;");
1679 dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
1680 dump (0, "lex_match (')');");
1682 else if (sbc->type == SBC_DBL_LIST)
1684 dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1686 dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
1687 dump (0, "goto lossage;");
1690 dump (1, "while (token != '/' && token != '.')");
1692 dump (0, "lex_match(',');");
1693 dump (0, "if (!lex_force_num ())");
1695 dump (0, "goto lossage;");
1698 dump (0, "subc_list_double_push(&p->dl_%s[p->sbc_%s-1],lex_number ());",
1699 st_lower (sbc->name),st_lower (sbc->name)
1702 dump (0, "lex_get();");
1706 else if (sbc->type == SBC_CUSTOM)
1708 dump (1, "switch (%scustom_%s (p))",
1709 st_lower (prefix), st_lower (sbc->name));
1711 dump (1, "case 0:");
1712 dump (0, "goto lossage;");
1713 dump (-1, "case 1:");
1716 dump (-1, "case 2:");
1718 dump (0, "lex_error (NULL);");
1719 dump (0, "goto lossage;");
1720 dump (-1, "default:");
1722 dump (0, "assert (0);");
1728 /* Write out entire parser. */
1730 dump_parser (int persistent)
1736 dump (0, "static int");
1737 dump (0, "parse_%s (struct cmd_%s *p)", make_identifier (cmdname),
1738 make_identifier (cmdname));
1741 dump_vars_init (persistent);
1743 dump (1, "for (;;)");
1747 if (def && (def->type == SBC_VARLIST))
1749 if (def->type == SBC_VARLIST)
1750 dump (1, "if (token == T_ID "
1751 "&& dict_lookup_var (default_dict, tokid) != NULL "
1752 "&& lex_look_ahead () != '=')");
1755 dump (0, "if ((token == T_ID "
1756 "&& dict_lookup_var (default_dict, tokid) "
1757 "&& lex_look_ahead () != '=')");
1758 dump (1, " || token == T_ALL)");
1761 dump (0, "p->sbc_%s++;", st_lower (def->name));
1762 dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1764 st_lower (def->prefix), st_lower (def->name),
1765 st_lower (def->prefix), st_lower (def->name));
1766 dump (0, "goto lossage;");
1771 else if (def && def->type == SBC_CUSTOM)
1773 dump (1, "switch (%scustom_%s (p))",
1774 st_lower (prefix), st_lower (def->name));
1776 dump (1, "case 0:");
1777 dump (0, "goto lossage;");
1778 dump (-1, "case 1:");
1780 dump (0, "p->sbc_%s++;", st_lower (def->name));
1781 dump (0, "continue;");
1782 dump (-1, "case 2:");
1785 dump (-1, "default:");
1787 dump (0, "assert (0);");
1795 for (sbc = subcommands; sbc; sbc = sbc->next)
1797 dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1801 dump (0, "lex_match ('=');");
1802 dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1803 if (sbc->arity != ARITY_MANY)
1805 dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1807 dump (0, "msg (SE, _(\"%s subcommand may be given only once.\"));",
1809 dump (0, "goto lossage;");
1813 dump_subcommand (sbc);
1820 /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1821 dump(1,"else if ( get_syntax() != COMPATIBLE && lex_match_id(\"ALGORITHM\"))");
1824 dump (0, "lex_match ('=');");
1826 dump(1,"if (lex_match_id(\"COMPATIBLE\"))");
1827 dump(0,"set_cmd_algorithm(COMPATIBLE);");
1829 dump(1,"else if (lex_match_id(\"ENHANCED\"))");
1830 dump(0,"set_cmd_algorithm(ENHANCED);");
1837 dump (1, "if (!lex_match ('/'))");
1842 dump (1, "if (token != '.')");
1844 dump (0, "lex_error (_(\"expecting end of command\"));");
1845 dump (0, "goto lossage;");
1852 /* Check that mandatory subcommands have been specified */
1855 for (sbc = subcommands; sbc; sbc = sbc->next)
1858 if ( sbc->arity == ARITY_ONCE_EXACTLY )
1860 dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
1862 dump (0, "msg (SE, _(\"%s subcommand must be given.\"));",
1864 dump (0, "goto lossage;");
1871 dump (-1, "return 1;");
1873 dump (-1, "lossage:");
1875 dump (0, "free_%s (p);", make_identifier (cmdname));
1876 dump (0, "return 0;");
1882 /* Write the output file header. */
1891 curtime = time (NULL);
1892 loctime = localtime (&curtime);
1893 timep = asctime (loctime);
1894 timep[strlen (timep) - 1] = 0;
1895 dump (0, "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1897 dump (0, " Generated by q2c from %s on %s.", ifn, timep);
1898 dump (0, " Do not modify!");
1902 /* Write out commands to free variable state. */
1904 dump_free (int persistent)
1914 for (sbc = subcommands; sbc; sbc = sbc->next)
1916 if (sbc->type == SBC_STRING)
1918 if (sbc->type == SBC_DBL_LIST)
1924 dump (0, "static void");
1925 dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1926 make_identifier (cmdname), used ? "" : " UNUSED");
1932 for (sbc = subcommands; sbc; sbc = sbc->next)
1937 dump (0, "free (p->v_%s);", st_lower (sbc->name));
1940 dump (0, "free (p->s_%s);", st_lower (sbc->name));
1944 dump (1, "for(i = 0; i < MAXLISTS ; ++i)");
1945 dump (0, "subc_list_double_destroy(&p->dl_%s[i]);", st_lower (sbc->name));
1960 /* Returns the name of a directive found on the current input line, if
1961 any, or a null pointer if none found. */
1963 recognize_directive (void)
1965 static char directive[16];
1969 if (strncmp (sp, "/*", 2))
1971 sp = skip_ws (sp + 2);
1976 ep = strchr (sp, ')');
1982 memcpy (directive, sp, ep - sp);
1983 directive[ep - sp] = '\0';
1988 main (int argc, char *argv[])
1990 program_name = argv[0];
1992 fail ("Syntax: q2c input.q output.c");
1995 in = fopen (ifn, "r");
1997 fail ("%s: open: %s.", ifn, strerror (errno));
2000 out = fopen (ofn, "w");
2002 fail ("%s: open: %s.", ofn, strerror (errno));
2005 buf = xmalloc (MAX_LINE_LEN);
2006 tokstr = xmalloc (MAX_TOK_LEN);
2012 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2015 const char *directive = recognize_directive ();
2016 if (directive == NULL)
2018 dump (0, "%s", buf);
2022 dump (0, "#line %d \"%s\"", oln + 1, ofn);
2023 if (!strcmp (directive, "specification"))
2025 /* Skip leading slash-star line. */
2031 /* Skip trailing star-slash line. */
2034 else if (!strcmp (directive, "headers"))
2038 dump (0, "#include <stdlib.h>");
2039 dump (0, "#include <libpspp/alloc.h>");
2040 dump (0, "#include <libpspp/message.h>");
2041 dump (0, "#include <language/lexer/lexer.h>");
2042 dump (0, "#include <data/settings.h>");
2043 dump (0, "#include <libpspp/str.h>");
2044 dump (0, "#include <language/lexer/subcommand-list.h>");
2045 dump (0, "#include <data/variable.h>");
2048 dump (0, "#include \"gettext.h\"");
2049 dump (0, "#define _(msgid) gettext (msgid)");
2052 else if (!strcmp (directive, "declarations"))
2053 dump_declarations ();
2054 else if (!strcmp (directive, "functions"))
2059 else if (!strcmp (directive, "_functions"))
2065 error ("unknown directive `%s'", directive);
2067 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2072 return EXIT_SUCCESS;