1 /* PSPP - computes sample statistics.
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., 59 Temple Place - Suite 330, Boston, MA
20 /* AIX requires this to be the first thing in the file. */
23 #define alloca __builtin_alloca
31 #ifndef alloca /* predefined by HP cc +Olibcalls */
45 #include "file-handle.h"
52 #include "debug-print.h"
54 /* Describes what to do when an output field is encountered. */
57 PRT_ERROR, /* Invalid value. */
58 PRT_NEWLINE, /* Newline. */
59 PRT_CONST, /* Constant string. */
60 PRT_VAR, /* Variable. */
61 PRT_SPACE /* A single space. */
64 /* Describes how to output one field. */
67 struct prt_out_spec *next;
68 int type; /* PRT_* constant. */
69 int fc; /* 0-based first column. */
72 char *c; /* PRT_CONST: Associated string. */
75 struct variable *v; /* PRT_VAR: Associated variable. */
76 struct fmt_spec f; /* PRT_VAR: Output spec. */
83 /* Enums for use with print_trns's `options' field. */
86 PRT_CMD_MASK = 1, /* Command type mask. */
87 PRT_PRINT = 0, /* PRINT transformation identifier. */
88 PRT_WRITE = 1, /* WRITE transformation identifier. */
89 PRT_EJECT = 002 /* Can be combined with CMD_PRINT only. */
92 /* PRINT, PRINT EJECT, WRITE private data structure. */
96 struct file_handle *handle; /* Output file, NULL=listing file. */
97 int options; /* PRT_* bitmapped field. */
98 struct prt_out_spec *spec; /* Output specifications. */
99 int max_width; /* Maximum line width including null. */
101 char *line; /* Buffer for sticking lines in. */
105 /* PRT_PRINT or PRT_WRITE. */
108 /* Holds information on parsing the data file. */
109 static struct print_trns prt;
111 /* Last prt_out_spec in the chain. Used for building the linked-list. */
112 static struct prt_out_spec *next;
114 /* Number of records. */
117 static int internal_cmd_print (int flags);
118 static int print_trns_proc (struct trns_header *, struct ccase *);
119 static void print_trns_free (struct trns_header *);
120 static int parse_specs (void);
121 static void dump_table (void);
122 static void append_var_spec (struct prt_out_spec *spec);
123 static void alloc_line (void);
126 void debug_print (void);
131 /* Parses PRINT command. */
135 lex_match_id ("PRINT");
136 return internal_cmd_print (PRT_PRINT);
139 /* Parses PRINT EJECT command. */
141 cmd_print_eject (void)
143 lex_match_id ("EJECT");
144 return internal_cmd_print (PRT_PRINT | PRT_EJECT);
147 /* Parses WRITE command. */
151 lex_match_id ("WRITE");
152 return internal_cmd_print (PRT_WRITE);
155 /* Parses the output commands. F is PRT_PRINT, PRT_WRITE, or
156 PRT_PRINT|PRT_EJECT. */
158 internal_cmd_print (int f)
160 /* 0=print no table, 1=print table. (TABLE subcommand.) */
163 /* malloc()'d transformation. */
164 struct print_trns *trns;
166 /* Fill in prt to facilitate error-handling. */
167 prt.h.proc = print_trns_proc;
168 prt.h.free = print_trns_free;
178 which_cmd = f & PRT_CMD_MASK;
180 /* Parse the command options. */
181 while (!lex_match ('/'))
183 if (lex_match_id ("OUTFILE"))
187 prt.handle = fh_parse_file_handle ();
191 else if (lex_match_id ("RECORDS"))
195 if (!lex_force_int ())
197 nrec = lex_integer ();
201 else if (lex_match_id ("TABLE"))
203 else if (lex_match_id ("NOTABLE"))
207 lex_error (_("expecting a valid subcommand"));
212 /* Parse variables and strings. */
216 /* Output the variable table if requested. */
220 /* Count the maximum line width. Allocate linebuffer if
224 /* Put the transformation in the queue. */
225 trns = xmalloc (sizeof *trns);
226 memcpy (trns, &prt, sizeof *trns);
227 add_transformation ((struct trns_header *) trns);
236 print_trns_free ((struct trns_header *) & prt);
240 /* Appends the field output specification SPEC to the list maintained
243 append_var_spec (struct prt_out_spec *spec)
246 prt.spec = next = xmalloc (sizeof *spec);
248 next = next->next = xmalloc (sizeof *spec);
250 memcpy (next, spec, sizeof *spec);
254 /* Field parsing. Mostly stolen from data-list.c. */
256 /* Used for chaining together fortran-like format specifiers. */
259 struct fmt_list *next;
262 struct fmt_list *down;
265 /* Used as "local" variables among the fixed-format parsing funcs. If
266 it were guaranteed that PSPP were going to be compiled by gcc,
267 I'd make all these functions a single set of nested functions. */
270 struct variable **v; /* variable list */
271 int nv; /* number of variables in list */
272 int cv; /* number of variables from list used up so far
273 by the FORTRAN-like format specifiers */
275 int recno; /* current 1-based record number */
276 int sc; /* 1-based starting column for next variable */
278 struct prt_out_spec spec; /* next format spec to append to list */
279 int fc, lc; /* first, last 1-based column number of current
282 int level; /* recursion level for FORTRAN-like format
287 static int fixed_parse_compatible (void);
288 static struct fmt_list *fixed_parse_fortran (void);
290 static int parse_string_argument (void);
291 static int parse_variable_argument (void);
293 /* Parses all the variable and string specifications on a single
294 PRINT, PRINT EJECT, or WRITE command into the prt structure.
299 /* Return code from called function. */
307 while (lex_match ('/'))
309 int prev_recno = fx.recno;
314 if (!lex_force_int ())
316 if (lex_integer () < fx.recno)
318 msg (SE, _("The record number specified, %ld, is "
319 "before the previous record, %d. Data "
320 "fields must be listed in order of "
321 "increasing record number."),
322 lex_integer (), fx.recno - 1);
325 fx.recno = lex_integer ();
329 fx.spec.type = PRT_NEWLINE;
330 while (prev_recno++ < fx.recno)
331 append_var_spec (&fx.spec);
336 if (token == T_STRING)
337 code = parse_string_argument ();
339 code = parse_variable_argument ();
343 fx.spec.type = PRT_NEWLINE;
344 append_var_spec (&fx.spec);
348 else if (fx.recno > nrec)
350 msg (SE, _("Variables are specified on records that "
351 "should not exist according to RECORDS subcommand."));
357 lex_error (_("expecting end of command"));
364 /* Parses a string argument to the PRINT commands. Returns success. */
366 parse_string_argument (void)
368 fx.spec.type = PRT_CONST;
369 fx.spec.fc = fx.sc - 1;
370 fx.spec.u.c = xstrdup (ds_value (&tokstr));
373 /* Parse the included column range. */
376 /* Width of column range in characters. */
379 /* Width of constant string in characters. */
382 /* 1-based index of last column in range. */
385 if (!lex_integer_p () || lex_integer () <= 0)
387 msg (SE, _("%g is not a valid column location."), tokval);
390 fx.spec.fc = lex_integer () - 1;
393 lex_negative_to_dash ();
396 if (!lex_integer_p ())
398 msg (SE, _("Column location expected following `%d-'."),
402 if (lex_integer () <= 0)
404 msg (SE, _("%g is not a valid column location."), tokval);
407 if (lex_integer () < fx.spec.fc + 1)
409 msg (SE, _("%d-%ld is not a valid column range. The second "
410 "column must be greater than or equal to the first."),
411 fx.spec.fc + 1, lex_integer ());
414 lc = lex_integer () - 1;
419 /* If only a starting location is specified then the field is
420 the width of the provided string. */
421 lc = fx.spec.fc + strlen (fx.spec.u.c) - 1;
423 /* Apply the range. */
424 c_len = lc - fx.spec.fc + 1;
425 s_len = strlen (fx.spec.u.c);
427 fx.spec.u.c[c_len] = 0;
428 else if (s_len < c_len)
430 fx.spec.u.c = xrealloc (fx.spec.u.c, c_len + 1);
431 memset (&fx.spec.u.c[s_len], ' ', c_len - s_len);
432 fx.spec.u.c[c_len] = 0;
438 /* If nothing is provided then the field is the width of the
440 fx.sc += strlen (fx.spec.u.c);
442 append_var_spec (&fx.spec);
450 /* Parses a variable argument to the PRINT commands by passing it off
451 to fixed_parse_compatible() or fixed_parse_fortran() as appropriate.
454 parse_variable_argument (void)
456 if (!parse_variables (default_dict, &fx.v, &fx.nv, PV_DUPLICATE))
461 if (!fixed_parse_compatible ())
464 else if (token == '(')
468 if (!fixed_parse_fortran ())
473 /* User wants dictionary format specifiers. */
477 for (i = 0; i < fx.nv; i++)
480 fx.spec.type = PRT_VAR;
481 fx.spec.fc = fx.sc - 1;
482 fx.spec.u.v.v = fx.v[i];
483 fx.spec.u.v.f = fx.v[i]->print;
484 append_var_spec (&fx.spec);
485 fx.sc += fx.v[i]->print.w;
488 fx.spec.type = PRT_SPACE;
489 fx.spec.fc = fx.sc - 1;
490 append_var_spec (&fx.spec);
503 /* Parses a column specification for parse_specs(). */
505 fixed_parse_compatible (void)
511 type = fx.v[0]->type;
512 for (i = 1; i < fx.nv; i++)
513 if (type != fx.v[i]->type)
515 msg (SE, _("%s is not of the same type as %s. To specify "
516 "variables of different types in the same variable "
517 "list, use a FORTRAN-like format specifier."),
518 fx.v[i]->name, fx.v[0]->name);
522 if (!lex_force_int ())
524 fx.fc = lex_integer () - 1;
527 msg (SE, _("Column positions for fields must be positive."));
532 lex_negative_to_dash ();
535 if (!lex_force_int ())
537 fx.lc = lex_integer () - 1;
540 msg (SE, _("Column positions for fields must be positive."));
543 else if (fx.lc < fx.fc)
545 msg (SE, _("The ending column for a field must not "
546 "be less than the starting column."));
554 fx.spec.u.v.f.w = fx.lc - fx.fc + 1;
557 struct fmt_desc *fdp;
563 fx.spec.u.v.f.type = parse_format_specifier_name (&cp, 0);
564 if (fx.spec.u.v.f.type == -1)
568 msg (SE, _("A format specifier on this line "
569 "has extra characters on the end."));
576 fx.spec.u.v.f.type = FMT_F;
580 if (!lex_force_int ())
582 if (lex_integer () < 1)
584 msg (SE, _("The value for number of decimal places "
585 "must be at least 1."));
588 fx.spec.u.v.f.d = lex_integer ();
594 fdp = &formats[fx.spec.u.v.f.type];
595 if (fdp->n_args < 2 && fx.spec.u.v.f.d)
597 msg (SE, _("Input format %s doesn't accept decimal places."),
601 if (fx.spec.u.v.f.d > 16)
602 fx.spec.u.v.f.d = 16;
604 if (!lex_force_match (')'))
609 fx.spec.u.v.f.type = FMT_F;
615 if ((fx.lc - fx.fc + 1) % fx.nv)
617 msg (SE, _("The %d columns %d-%d can't be evenly divided into %d "
618 "fields."), fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, fx.nv);
622 dividend = (fx.lc - fx.fc + 1) / fx.nv;
623 fx.spec.u.v.f.w = dividend;
624 if (!check_output_specifier (&fx.spec.u.v.f))
626 if ((type == ALPHA) ^ (formats[fx.spec.u.v.f.type].cat & FCAT_STRING))
628 msg (SE, _("%s variables cannot be displayed with format %s."),
629 type == ALPHA ? _("String") : _("Numeric"),
630 fmt_to_string (&fx.spec.u.v.f));
634 /* Check that, for string variables, the user didn't specify a width
635 longer than an actual string width. */
638 /* Minimum width of all the string variables specified. */
639 int min_len = fx.v[0]->width;
641 for (i = 1; i < fx.nv; i++)
642 min_len = min (min_len, fx.v[i]->width);
643 if (!check_string_specifier (&fx.spec.u.v.f, min_len))
647 fx.spec.type = PRT_VAR;
648 for (i = 0; i < fx.nv; i++)
650 fx.spec.fc = fx.fc + dividend * i;
651 fx.spec.u.v.v = fx.v[i];
652 append_var_spec (&fx.spec);
657 /* Destroy a format list and, optionally, all its sublists. */
659 destroy_fmt_list (struct fmt_list * f, int recurse)
661 struct fmt_list *next;
666 if (recurse && f->f.type == FMT_DESCEND)
667 destroy_fmt_list (f->down, 1);
672 /* Recursively puts the format list F (which represents a set of
673 FORTRAN-like format specifications, like 4(F10,2X)) into the
676 dump_fmt_list (struct fmt_list * f)
680 for (; f; f = f->next)
681 if (f->f.type == FMT_X)
683 else if (f->f.type == FMT_T)
685 else if (f->f.type == FMT_NEWREC)
687 fx.recno += f->count;
689 fx.spec.type = PRT_NEWLINE;
690 for (i = 0; i < f->count; i++)
691 append_var_spec (&fx.spec);
694 for (i = 0; i < f->count; i++)
695 if (f->f.type == FMT_DESCEND)
697 if (!dump_fmt_list (f->down))
706 msg (SE, _("The number of format "
707 "specifications exceeds the number of variable "
713 if ((v->type == ALPHA) ^ (formats[f->f.type].cat & FCAT_STRING))
715 msg (SE, _("Display format %s may not be used with a "
716 "%s variable."), fmt_to_string (&f->f),
717 v->type == ALPHA ? _("string") : _("numeric"));
720 if (!check_string_specifier (&f->f, v->width))
723 fx.spec.type = PRT_VAR;
725 fx.spec.u.v.f = f->f;
726 fx.spec.fc = fx.sc - 1;
727 append_var_spec (&fx.spec);
734 /* Recursively parses a list of FORTRAN-like format specifiers. Calls
735 itself to parse nested levels of parentheses. Returns to its
736 original caller NULL, to indicate error, non-NULL, but nothing
737 useful, to indicate success (it returns a free()'d block). */
738 static struct fmt_list *
739 fixed_parse_fortran (void)
741 struct fmt_list *head;
742 struct fmt_list *fl = NULL;
744 lex_get (); /* skip opening parenthesis */
748 fl = fl->next = xmalloc (sizeof *fl);
750 head = fl = xmalloc (sizeof *fl);
754 if (!lex_integer_p ())
756 fl->count = lex_integer ();
764 fl->f.type = FMT_DESCEND;
766 fl->down = fixed_parse_fortran ();
771 else if (lex_match ('/'))
772 fl->f.type = FMT_NEWREC;
773 else if (!parse_format_specifier (&fl->f, 1)
774 || !check_output_specifier (&fl->f))
786 dump_fmt_list (head);
787 destroy_fmt_list (head, 1);
790 msg (SE, _("There aren't enough format specifications "
791 "to match the number of variable names given."));
798 destroy_fmt_list (head, 0);
803 /* Prints the table produced by the TABLE subcommand to the listing
808 struct prt_out_spec *spec;
809 const char *filename;
814 for (nspec = 0, spec = prt.spec; spec; spec = spec->next)
815 if (spec->type == PRT_CONST || spec->type == PRT_VAR)
817 t = tab_create (4, nspec + 1, 0);
818 tab_columns (t, TAB_COL_DOWN, 1);
819 tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, nspec);
820 tab_hline (t, TAL_2, 0, 3, 1);
821 tab_headers (t, 0, 0, 1, 0);
822 tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
823 tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
824 tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
825 tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
826 tab_dim (t, tab_natural_dimensions);
827 for (nspec = recno = 0, spec = prt.spec; spec; spec = spec->next)
835 int len = strlen (spec->u.c);
837 tab_text (t, 0, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
838 "\"%s\"", spec->u.c);
839 tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
840 tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
841 spec->fc + 1, spec->fc + len);
842 tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
849 tab_text (t, 0, nspec, TAB_LEFT, spec->u.v.v->name);
850 tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
851 tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
852 spec->fc + 1, spec->fc + spec->u.v.f.w);
853 tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX,
854 fmt_to_string (&spec->u.v.f));
863 filename = fh_handle_name (prt.handle);
864 tab_title (t, 1, (prt.handle != NULL
865 ? _("Writing %3d records to file %s.")
866 : _("Writing %3d records to the listing file.")),
869 fh_handle_name (NULL);
872 /* PORTME: The number of characters in a line terminator. */
874 #define LINE_END_WIDTH 2 /* \r\n */
876 #define LINE_END_WIDTH 1 /* \n */
879 /* Calculates the maximum possible line width and allocates a buffer
880 big enough to contain it, if necessary (otherwise sets max_width).
881 (The action taken depends on compiler & OS as detected by pref.h.) */
885 /* Cumulative maximum line width (excluding null terminator) so far. */
888 /* Width required by current this prt_out_spec. */
889 int pot_w; /* Potential w. */
892 struct prt_out_spec *i;
894 for (i = prt.spec; i; i = i->next)
902 pot_w = i->fc + strlen (i->u.c);
905 pot_w = i->fc + i->u.v.f.w;
917 prt.max_width = w + LINE_END_WIDTH + 1;
919 prt.line = xmalloc (prt.max_width);
923 /* Transformation. */
925 /* Performs the transformation inside print_trns T on case C. */
927 print_trns_proc (struct trns_header * trns, struct ccase * c)
929 /* Transformation. */
930 struct print_trns *t = (struct print_trns *) trns;
933 struct prt_out_spec *i;
937 #if __GNUC__ && !__STRICT_ANSI__
938 char buf[t->max_width];
939 #else /* !__GNUC__ */
940 char *buf = alloca (t->max_width);
941 #endif /* !__GNUC__ */
942 #else /* !PAGED_STACK */
944 #endif /* !PAGED_STACK */
946 /* Length of the line in buf. */
948 memset (buf, ' ', t->max_width);
950 if (t->options & PRT_EJECT)
953 /* Note that a field written to a place where a field has already
954 been written truncates the record. `PRINT /A B (T10,F8,T1,F8).'
955 only outputs B. This is an example of bug-for-bug compatibility,
956 in the author's opinion. */
957 for (i = t->spec; i; i = i->next)
961 if (t->handle == NULL)
964 tab_output_text (TAT_FIX | TAT_NOWRAP, buf);
968 if ((t->options & PRT_CMD_MASK) == PRT_PRINT
969 || t->handle->mode != FH_MD_BINARY)
971 /* PORTME: Line ends. */
978 dfm_put_record (t->handle, buf, len);
981 memset (buf, ' ', t->max_width);
986 /* FIXME: Should be revised to keep track of the string's
987 length outside the loop, probably in i->u.c[0]. */
988 memcpy (&buf[i->fc], i->u.c, strlen (i->u.c));
989 len = i->fc + strlen (i->u.c);
993 if (i->u.v.v->type == NUMERIC)
994 data_out (&buf[i->fc], &i->u.v.f, &c->data[i->u.v.v->fv]);
998 t.c = c->data[i->u.v.v->fv].s;
999 data_out (&buf[i->fc], &i->u.v.f, &t);
1001 len = i->fc + i->u.v.f.w;
1005 /* PRT_SPACE always immediately follows PRT_VAR. */
1017 /* Frees all the data inside print_trns T. Does not free T. */
1019 print_trns_free (struct trns_header * t)
1021 struct prt_out_spec *i, *n;
1023 for (i = ((struct print_trns *) t)->spec; i; i = n)
1043 free (((struct print_trns *) t)->line);
1049 /* PRINT SPACE transformation. */
1050 struct print_space_trns
1052 struct trns_header h;
1054 struct file_handle *handle; /* Output file, NULL=listing file. */
1055 struct expression *e; /* Number of lines; NULL=1. */
1059 static int print_space_trns_proc (struct trns_header *, struct ccase *);
1060 static void print_space_trns_free (struct trns_header *);
1063 cmd_print_space (void)
1065 struct print_space_trns *t;
1066 struct file_handle *handle;
1067 struct expression *e;
1069 lex_match_id ("SPACE");
1070 if (lex_match_id ("OUTFILE"))
1075 handle = fh_get_handle_by_name (tokid);
1076 else if (token == T_STRING)
1077 handle = fh_get_handle_by_filename (tokid);
1080 msg (SE, _("A file name or handle was expected in the "
1081 "OUTFILE subcommand."));
1094 e = expr_parse (PXP_NUMERIC);
1098 lex_error (_("expecting end of command"));
1105 t = xmalloc (sizeof *t);
1106 t->h.proc = print_space_trns_proc;
1108 t->h.free = print_space_trns_free;
1114 add_transformation ((struct trns_header *) t);
1119 print_space_trns_proc (struct trns_header * trns, struct ccase * c)
1121 struct print_space_trns *t = (struct print_space_trns *) trns;
1128 expr_evaluate (t->e, c, &v);
1132 msg (SW, _("The expression on PRINT SPACE evaluated to %d. It's "
1133 "not possible to PRINT SPACE a negative number of "
1142 if (t->handle == NULL)
1147 char buf[LINE_END_WIDTH];
1149 /* PORTME: Line ends. */
1157 dfm_put_record (t->handle, buf, LINE_END_WIDTH);
1164 print_space_trns_free (struct trns_header * trns)
1166 expr_free (((struct print_space_trns *) trns)->e);
1169 /* Debugging code. */
1175 struct prt_out_spec *p;
1177 if (prt.handle == NULL)
1184 printf ("WRITE OUTFILE=%s", handle_name (prt.handle));
1185 printf (" MAX_WIDTH=%d", prt.max_width);
1187 for (p = prt.spec; p; p = p->next)
1191 printf (_("<ERROR>"));
1197 printf (" \"%s\" %d-%d", p->u.c, p->fc + 1, p->fc + strlen (p->u.c));
1200 printf (" %s %d %d-%d (%s)", p->u.v.v->name, p->u.v.v->fv, p->fc + 1,
1201 p->fc + p->u.v.v->print.w, fmt_to_string (&p->u.v.v->print));
1204 printf (" \" \" %d", p->fc + 1);
1209 #endif /* DEBUGGING */