- /* Create variables and var specs. */
- for (i = 0; i < fx->name_cnt; i++)
- {
- struct dls_var_spec *spec;
- struct variable *v;
-
- v = dict_create_var (default_dict, fx->name[i], width);
- if (v != NULL)
- {
- convert_fmt_ItoO (&input, &v->print);
- v->write = v->print;
- }
- else
- {
- v = dict_lookup_var_assert (default_dict, fx->name[i]);
- if (!in_input_program ())
- {
- msg (SE, _("%s is a duplicate variable name."), fx->name[i]);
- return 0;
- }
- if ((width != 0) != (v->width != 0))
- {
- msg (SE, _("There is already a variable %s of a "
- "different type."),
- fx->name[i]);
- return 0;
- }
- if (width != 0 && width != v->width)
- {
- msg (SE, _("There is already a string variable %s of a "
- "different width."), fx->name[i]);
- return 0;
- }
- }
-
- spec = xmalloc (sizeof *spec);
- spec->input = input;
- spec->v = v;
- spec->fv = v->fv;
- spec->rec = fx->recno;
- spec->fc = fc + input.w * i;
- spec->lc = spec->fc + input.w - 1;
- append_var_spec (first, last, spec);
- }
- return 1;
-}
-
-/* Destroy format list F and, if RECURSE is nonzero, all its
- sublists. */
-static void
-destroy_fmt_list (struct fmt_list *f, int recurse)
-{
- struct fmt_list *next;
-
- for (; f; f = next)
- {
- next = f->next;
- if (recurse && f->f.type == FMT_DESCEND)
- destroy_fmt_list (f->down, 1);
- free (f);
- }
-}
-
-/* Takes a hierarchically structured fmt_list F as constructed by
- fixed_parse_fortran(), and flattens it, adding the variable
- specifications to the linked list with head FIRST and tail
- LAST. NAME_IDX is used to take values from the list of names
- in FX; it should initially point to a value of 0. */
-static int
-dump_fmt_list (struct fixed_parsing_state *fx, struct fmt_list *f,
- struct dls_var_spec **first, struct dls_var_spec **last,
- int *name_idx)
-{
- int i;
-
- for (; f; f = f->next)
- if (f->f.type == FMT_X)
- fx->sc += f->count;
- else if (f->f.type == FMT_T)
- fx->sc = f->f.w;
- else if (f->f.type == FMT_NEWREC)
- {
- fx->recno += f->count;
- fx->sc = 1;
- }
- else
- for (i = 0; i < f->count; i++)
- if (f->f.type == FMT_DESCEND)
- {
- if (!dump_fmt_list (fx, f->down, first, last, name_idx))
- return 0;
- }
- else
- {
- struct dls_var_spec *spec;
- int width;
- struct variable *v;
-
- if (formats[f->f.type].cat & FCAT_STRING)
- width = f->f.w;
- else
- width = 0;
- if (*name_idx >= fx->name_cnt)
- {
- msg (SE, _("The number of format "
- "specifications exceeds the given number of "
- "variable names."));
- return 0;
- }
-
- v = dict_create_var (default_dict, fx->name[(*name_idx)++], width);
- if (!v)
- {
- msg (SE, _("%s is a duplicate variable name."), fx->name[i]);
- return 0;
- }
-
- spec = xmalloc (sizeof *spec);
- spec->v = v;
- spec->input = f->f;
- spec->fv = v->fv;
- spec->rec = fx->recno;
- spec->fc = fx->sc;
- spec->lc = fx->sc + f->f.w - 1;
- append_var_spec (first, last, spec);
-
- convert_fmt_ItoO (&spec->input, &v->print);
- v->write = v->print;
-
- fx->sc += f->f.w;
- }
- return 1;
-}
-
-/* Recursively parses a FORTRAN-like format specification into
- the linked list with head FIRST and tail TAIL. LEVEL is the
- level of recursion, starting from 0. Returns the parsed
- specification if successful, or a null pointer on failure. */
-static struct fmt_list *
-fixed_parse_fortran_internal (struct fixed_parsing_state *fx,
- struct dls_var_spec **first,
- struct dls_var_spec **last)
-{
- struct fmt_list *head = NULL;
- struct fmt_list *tail = NULL;
-
- lex_force_match ('(');
- while (token != ')')
- {
- /* New fmt_list. */
- struct fmt_list *new = xmalloc (sizeof *new);
- new->next = NULL;
-
- /* Append new to list. */
- if (head != NULL)
- tail->next = new;
- else
- head = new;
- tail = new;
-
- /* Parse count. */
- if (lex_is_integer ())
- {
- new->count = lex_integer ();
- lex_get ();
- }
- else
- new->count = 1;
-
- /* Parse format specifier. */
- if (token == '(')
- {
- new->f.type = FMT_DESCEND;
- new->down = fixed_parse_fortran_internal (fx, first, last);
- if (new->down == NULL)
- goto fail;
- }
- else if (lex_match ('/'))
- new->f.type = FMT_NEWREC;
- else if (!parse_format_specifier (&new->f, FMTP_ALLOW_XT)
- || !check_input_specifier (&new->f, 1))
- goto fail;
-
- lex_match (',');
- }
- lex_force_match (')');
-
- return head;
-
-fail:
- destroy_fmt_list (head, 0);
-
- return NULL;
-}
-
-/* Parses a FORTRAN-like format specification into the linked
- list with head FIRST and tail LAST. Returns nonzero if
- successful. */
-static int
-fixed_parse_fortran (struct fixed_parsing_state *fx,
- struct dls_var_spec **first, struct dls_var_spec **last)
-{
- struct fmt_list *list;
- int name_idx;
-
- list = fixed_parse_fortran_internal (fx, first, last);
- if (list == NULL)
- return 0;
-
- name_idx = 0;
- dump_fmt_list (fx, list, first, last, &name_idx);
- destroy_fmt_list (list, 1);
- if (name_idx < fx->name_cnt)
- {
- msg (SE, _("There aren't enough format specifications "
- "to match the number of variable names given."));
- return 0;
- }
-
- return 1;
projects / pspp-builds.git / blobdiff