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
28 #include "file-handle.h"
35 #include "debug-print.h"
37 /* Describes what to do when an output field is encountered. */
40 PRT_ERROR, /* Invalid value. */
41 PRT_NEWLINE, /* Newline. */
42 PRT_CONST, /* Constant string. */
43 PRT_VAR, /* Variable. */
44 PRT_SPACE /* A single space. */
47 /* Describes how to output one field. */
50 struct prt_out_spec *next;
51 int type; /* PRT_* constant. */
52 int fc; /* 0-based first column. */
55 char *c; /* PRT_CONST: Associated string. */
58 struct variable *v; /* PRT_VAR: Associated variable. */
59 struct fmt_spec f; /* PRT_VAR: Output spec. */
66 /* Enums for use with print_trns's `options' field. */
69 PRT_CMD_MASK = 1, /* Command type mask. */
70 PRT_PRINT = 0, /* PRINT transformation identifier. */
71 PRT_WRITE = 1, /* WRITE transformation identifier. */
72 PRT_EJECT = 002 /* Can be combined with CMD_PRINT only. */
75 /* PRINT, PRINT EJECT, WRITE private data structure. */
79 struct file_handle *handle; /* Output file, NULL=listing file. */
80 int options; /* PRT_* bitmapped field. */
81 struct prt_out_spec *spec; /* Output specifications. */
82 int max_width; /* Maximum line width including null. */
84 char *line; /* Buffer for sticking lines in. */
88 /* PRT_PRINT or PRT_WRITE. */
91 /* Holds information on parsing the data file. */
92 static struct print_trns prt;
94 /* Last prt_out_spec in the chain. Used for building the linked-list. */
95 static struct prt_out_spec *next;
97 /* Number of records. */
100 static int internal_cmd_print (int flags);
101 static int print_trns_proc (struct trns_header *, struct ccase *);
102 static void print_trns_free (struct trns_header *);
103 static int parse_specs (void);
104 static void dump_table (void);
105 static void append_var_spec (struct prt_out_spec *spec);
106 static void alloc_line (void);
109 void debug_print (void);
114 /* Parses PRINT command. */
118 lex_match_id ("PRINT");
119 return internal_cmd_print (PRT_PRINT);
122 /* Parses PRINT EJECT command. */
124 cmd_print_eject (void)
126 lex_match_id ("EJECT");
127 return internal_cmd_print (PRT_PRINT | PRT_EJECT);
130 /* Parses WRITE command. */
134 lex_match_id ("WRITE");
135 return internal_cmd_print (PRT_WRITE);
138 /* Parses the output commands. F is PRT_PRINT, PRT_WRITE, or
139 PRT_PRINT|PRT_EJECT. */
141 internal_cmd_print (int f)
143 /* 0=print no table, 1=print table. (TABLE subcommand.) */
146 /* malloc()'d transformation. */
147 struct print_trns *trns;
149 /* Fill in prt to facilitate error-handling. */
150 prt.h.proc = print_trns_proc;
151 prt.h.free = print_trns_free;
161 which_cmd = f & PRT_CMD_MASK;
163 /* Parse the command options. */
164 while (!lex_match ('/'))
166 if (lex_match_id ("OUTFILE"))
170 prt.handle = fh_parse_file_handle ();
174 else if (lex_match_id ("RECORDS"))
178 if (!lex_force_int ())
180 nrec = lex_integer ();
184 else if (lex_match_id ("TABLE"))
186 else if (lex_match_id ("NOTABLE"))
190 lex_error (_("expecting a valid subcommand"));
195 /* Parse variables and strings. */
199 /* Output the variable table if requested. */
203 /* Count the maximum line width. Allocate linebuffer if
207 /* Put the transformation in the queue. */
208 trns = xmalloc (sizeof *trns);
209 memcpy (trns, &prt, sizeof *trns);
210 add_transformation ((struct trns_header *) trns);
219 print_trns_free ((struct trns_header *) & prt);
223 /* Appends the field output specification SPEC to the list maintained
226 append_var_spec (struct prt_out_spec *spec)
229 prt.spec = next = xmalloc (sizeof *spec);
231 next = next->next = xmalloc (sizeof *spec);
233 memcpy (next, spec, sizeof *spec);
237 /* Field parsing. Mostly stolen from data-list.c. */
239 /* Used for chaining together fortran-like format specifiers. */
242 struct fmt_list *next;
245 struct fmt_list *down;
248 /* Used as "local" variables among the fixed-format parsing funcs. If
249 it were guaranteed that PSPP were going to be compiled by gcc,
250 I'd make all these functions a single set of nested functions. */
253 struct variable **v; /* variable list */
254 int nv; /* number of variables in list */
255 int cv; /* number of variables from list used up so far
256 by the FORTRAN-like format specifiers */
258 int recno; /* current 1-based record number */
259 int sc; /* 1-based starting column for next variable */
261 struct prt_out_spec spec; /* next format spec to append to list */
262 int fc, lc; /* first, last 1-based column number of current
265 int level; /* recursion level for FORTRAN-like format
270 static int fixed_parse_compatible (void);
271 static struct fmt_list *fixed_parse_fortran (void);
273 static int parse_string_argument (void);
274 static int parse_variable_argument (void);
276 /* Parses all the variable and string specifications on a single
277 PRINT, PRINT EJECT, or WRITE command into the prt structure.
282 /* Return code from called function. */
290 while (lex_match ('/'))
292 int prev_recno = fx.recno;
297 if (!lex_force_int ())
299 if (lex_integer () < fx.recno)
301 msg (SE, _("The record number specified, %ld, is "
302 "before the previous record, %d. Data "
303 "fields must be listed in order of "
304 "increasing record number."),
305 lex_integer (), fx.recno - 1);
308 fx.recno = lex_integer ();
312 fx.spec.type = PRT_NEWLINE;
313 while (prev_recno++ < fx.recno)
314 append_var_spec (&fx.spec);
319 if (token == T_STRING)
320 code = parse_string_argument ();
322 code = parse_variable_argument ();
326 fx.spec.type = PRT_NEWLINE;
327 append_var_spec (&fx.spec);
331 else if (fx.recno > nrec)
333 msg (SE, _("Variables are specified on records that "
334 "should not exist according to RECORDS subcommand."));
340 lex_error (_("expecting end of command"));
347 /* Parses a string argument to the PRINT commands. Returns success. */
349 parse_string_argument (void)
351 fx.spec.type = PRT_CONST;
352 fx.spec.fc = fx.sc - 1;
353 fx.spec.u.c = xstrdup (ds_value (&tokstr));
356 /* Parse the included column range. */
359 /* Width of column range in characters. */
362 /* Width of constant string in characters. */
365 /* 1-based index of last column in range. */
368 if (!lex_integer_p () || lex_integer () <= 0)
370 msg (SE, _("%g is not a valid column location."), tokval);
373 fx.spec.fc = lex_integer () - 1;
376 lex_negative_to_dash ();
379 if (!lex_integer_p ())
381 msg (SE, _("Column location expected following `%d-'."),
385 if (lex_integer () <= 0)
387 msg (SE, _("%g is not a valid column location."), tokval);
390 if (lex_integer () < fx.spec.fc + 1)
392 msg (SE, _("%d-%ld is not a valid column range. The second "
393 "column must be greater than or equal to the first."),
394 fx.spec.fc + 1, lex_integer ());
397 lc = lex_integer () - 1;
402 /* If only a starting location is specified then the field is
403 the width of the provided string. */
404 lc = fx.spec.fc + strlen (fx.spec.u.c) - 1;
406 /* Apply the range. */
407 c_len = lc - fx.spec.fc + 1;
408 s_len = strlen (fx.spec.u.c);
410 fx.spec.u.c[c_len] = 0;
411 else if (s_len < c_len)
413 fx.spec.u.c = xrealloc (fx.spec.u.c, c_len + 1);
414 memset (&fx.spec.u.c[s_len], ' ', c_len - s_len);
415 fx.spec.u.c[c_len] = 0;
421 /* If nothing is provided then the field is the width of the
423 fx.sc += strlen (fx.spec.u.c);
425 append_var_spec (&fx.spec);
433 /* Parses a variable argument to the PRINT commands by passing it off
434 to fixed_parse_compatible() or fixed_parse_fortran() as appropriate.
437 parse_variable_argument (void)
439 if (!parse_variables (default_dict, &fx.v, &fx.nv, PV_DUPLICATE))
444 if (!fixed_parse_compatible ())
447 else if (token == '(')
451 if (!fixed_parse_fortran ())
456 /* User wants dictionary format specifiers. */
460 for (i = 0; i < fx.nv; i++)
463 fx.spec.type = PRT_VAR;
464 fx.spec.fc = fx.sc - 1;
465 fx.spec.u.v.v = fx.v[i];
466 fx.spec.u.v.f = fx.v[i]->print;
467 append_var_spec (&fx.spec);
468 fx.sc += fx.v[i]->print.w;
471 fx.spec.type = PRT_SPACE;
472 fx.spec.fc = fx.sc - 1;
473 append_var_spec (&fx.spec);
486 /* Parses a column specification for parse_specs(). */
488 fixed_parse_compatible (void)
494 type = fx.v[0]->type;
495 for (i = 1; i < fx.nv; i++)
496 if (type != fx.v[i]->type)
498 msg (SE, _("%s is not of the same type as %s. To specify "
499 "variables of different types in the same variable "
500 "list, use a FORTRAN-like format specifier."),
501 fx.v[i]->name, fx.v[0]->name);
505 if (!lex_force_int ())
507 fx.fc = lex_integer () - 1;
510 msg (SE, _("Column positions for fields must be positive."));
515 lex_negative_to_dash ();
518 if (!lex_force_int ())
520 fx.lc = lex_integer () - 1;
523 msg (SE, _("Column positions for fields must be positive."));
526 else if (fx.lc < fx.fc)
528 msg (SE, _("The ending column for a field must not "
529 "be less than the starting column."));
537 fx.spec.u.v.f.w = fx.lc - fx.fc + 1;
540 struct fmt_desc *fdp;
546 fx.spec.u.v.f.type = parse_format_specifier_name (&cp, 0);
547 if (fx.spec.u.v.f.type == -1)
551 msg (SE, _("A format specifier on this line "
552 "has extra characters on the end."));
559 fx.spec.u.v.f.type = FMT_F;
563 if (!lex_force_int ())
565 if (lex_integer () < 1)
567 msg (SE, _("The value for number of decimal places "
568 "must be at least 1."));
571 fx.spec.u.v.f.d = lex_integer ();
577 fdp = &formats[fx.spec.u.v.f.type];
578 if (fdp->n_args < 2 && fx.spec.u.v.f.d)
580 msg (SE, _("Input format %s doesn't accept decimal places."),
584 if (fx.spec.u.v.f.d > 16)
585 fx.spec.u.v.f.d = 16;
587 if (!lex_force_match (')'))
592 fx.spec.u.v.f.type = FMT_F;
598 if ((fx.lc - fx.fc + 1) % fx.nv)
600 msg (SE, _("The %d columns %d-%d can't be evenly divided into %d "
601 "fields."), fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, fx.nv);
605 dividend = (fx.lc - fx.fc + 1) / fx.nv;
606 fx.spec.u.v.f.w = dividend;
607 if (!check_output_specifier (&fx.spec.u.v.f))
609 if ((type == ALPHA) ^ (formats[fx.spec.u.v.f.type].cat & FCAT_STRING))
611 msg (SE, _("%s variables cannot be displayed with format %s."),
612 type == ALPHA ? _("String") : _("Numeric"),
613 fmt_to_string (&fx.spec.u.v.f));
617 /* Check that, for string variables, the user didn't specify a width
618 longer than an actual string width. */
621 /* Minimum width of all the string variables specified. */
622 int min_len = fx.v[0]->width;
624 for (i = 1; i < fx.nv; i++)
625 min_len = min (min_len, fx.v[i]->width);
626 if (!check_string_specifier (&fx.spec.u.v.f, min_len))
630 fx.spec.type = PRT_VAR;
631 for (i = 0; i < fx.nv; i++)
633 fx.spec.fc = fx.fc + dividend * i;
634 fx.spec.u.v.v = fx.v[i];
635 append_var_spec (&fx.spec);
640 /* Destroy a format list and, optionally, all its sublists. */
642 destroy_fmt_list (struct fmt_list * f, int recurse)
644 struct fmt_list *next;
649 if (recurse && f->f.type == FMT_DESCEND)
650 destroy_fmt_list (f->down, 1);
655 /* Recursively puts the format list F (which represents a set of
656 FORTRAN-like format specifications, like 4(F10,2X)) into the
659 dump_fmt_list (struct fmt_list * f)
663 for (; f; f = f->next)
664 if (f->f.type == FMT_X)
666 else if (f->f.type == FMT_T)
668 else if (f->f.type == FMT_NEWREC)
670 fx.recno += f->count;
672 fx.spec.type = PRT_NEWLINE;
673 for (i = 0; i < f->count; i++)
674 append_var_spec (&fx.spec);
677 for (i = 0; i < f->count; i++)
678 if (f->f.type == FMT_DESCEND)
680 if (!dump_fmt_list (f->down))
689 msg (SE, _("The number of format "
690 "specifications exceeds the number of variable "
696 if ((v->type == ALPHA) ^ (formats[f->f.type].cat & FCAT_STRING))
698 msg (SE, _("Display format %s may not be used with a "
699 "%s variable."), fmt_to_string (&f->f),
700 v->type == ALPHA ? _("string") : _("numeric"));
703 if (!check_string_specifier (&f->f, v->width))
706 fx.spec.type = PRT_VAR;
708 fx.spec.u.v.f = f->f;
709 fx.spec.fc = fx.sc - 1;
710 append_var_spec (&fx.spec);
717 /* Recursively parses a list of FORTRAN-like format specifiers. Calls
718 itself to parse nested levels of parentheses. Returns to its
719 original caller NULL, to indicate error, non-NULL, but nothing
720 useful, to indicate success (it returns a free()'d block). */
721 static struct fmt_list *
722 fixed_parse_fortran (void)
724 struct fmt_list *head;
725 struct fmt_list *fl = NULL;
727 lex_get (); /* skip opening parenthesis */
731 fl = fl->next = xmalloc (sizeof *fl);
733 head = fl = xmalloc (sizeof *fl);
737 if (!lex_integer_p ())
739 fl->count = lex_integer ();
747 fl->f.type = FMT_DESCEND;
749 fl->down = fixed_parse_fortran ();
754 else if (lex_match ('/'))
755 fl->f.type = FMT_NEWREC;
756 else if (!parse_format_specifier (&fl->f, 1)
757 || !check_output_specifier (&fl->f))
769 dump_fmt_list (head);
770 destroy_fmt_list (head, 1);
773 msg (SE, _("There aren't enough format specifications "
774 "to match the number of variable names given."));
781 destroy_fmt_list (head, 0);
786 /* Prints the table produced by the TABLE subcommand to the listing
791 struct prt_out_spec *spec;
792 const char *filename;
797 for (nspec = 0, spec = prt.spec; spec; spec = spec->next)
798 if (spec->type == PRT_CONST || spec->type == PRT_VAR)
800 t = tab_create (4, nspec + 1, 0);
801 tab_columns (t, TAB_COL_DOWN, 1);
802 tab_box (t, TAL_1, TAL_1, TAL_0, TAL_1, 0, 0, 3, nspec);
803 tab_hline (t, TAL_2, 0, 3, 1);
804 tab_headers (t, 0, 0, 1, 0);
805 tab_text (t, 0, 0, TAB_CENTER | TAT_TITLE, _("Variable"));
806 tab_text (t, 1, 0, TAB_CENTER | TAT_TITLE, _("Record"));
807 tab_text (t, 2, 0, TAB_CENTER | TAT_TITLE, _("Columns"));
808 tab_text (t, 3, 0, TAB_CENTER | TAT_TITLE, _("Format"));
809 tab_dim (t, tab_natural_dimensions);
810 for (nspec = recno = 0, spec = prt.spec; spec; spec = spec->next)
818 int len = strlen (spec->u.c);
820 tab_text (t, 0, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
821 "\"%s\"", spec->u.c);
822 tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
823 tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
824 spec->fc + 1, spec->fc + len);
825 tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX | TAT_PRINTF,
832 tab_text (t, 0, nspec, TAB_LEFT, spec->u.v.v->name);
833 tab_text (t, 1, nspec, TAT_PRINTF, "%d", recno + 1);
834 tab_text (t, 2, nspec, TAT_PRINTF, "%3d-%3d",
835 spec->fc + 1, spec->fc + spec->u.v.f.w);
836 tab_text (t, 3, nspec, TAB_LEFT | TAT_FIX,
837 fmt_to_string (&spec->u.v.f));
846 filename = fh_handle_name (prt.handle);
847 tab_title (t, 1, (prt.handle != NULL
848 ? _("Writing %3d records to file %s.")
849 : _("Writing %3d records to the listing file.")),
852 fh_handle_name (NULL);
855 /* PORTME: The number of characters in a line terminator. */
857 #define LINE_END_WIDTH 2 /* \r\n */
859 #define LINE_END_WIDTH 1 /* \n */
862 /* Calculates the maximum possible line width and allocates a buffer
863 big enough to contain it, if necessary (otherwise sets max_width).
864 (The action taken depends on compiler & OS as detected by pref.h.) */
868 /* Cumulative maximum line width (excluding null terminator) so far. */
871 /* Width required by current this prt_out_spec. */
872 int pot_w; /* Potential w. */
875 struct prt_out_spec *i;
877 for (i = prt.spec; i; i = i->next)
885 pot_w = i->fc + strlen (i->u.c);
888 pot_w = i->fc + i->u.v.f.w;
900 prt.max_width = w + LINE_END_WIDTH + 1;
902 prt.line = xmalloc (prt.max_width);
906 /* Transformation. */
908 /* Performs the transformation inside print_trns T on case C. */
910 print_trns_proc (struct trns_header * trns, struct ccase * c)
912 /* Transformation. */
913 struct print_trns *t = (struct print_trns *) trns;
916 struct prt_out_spec *i;
920 #if __GNUC__ && !__STRICT_ANSI__
921 char buf[t->max_width];
922 #else /* !__GNUC__ */
923 char *buf = alloca (t->max_width);
924 #endif /* !__GNUC__ */
925 #else /* !PAGED_STACK */
927 #endif /* !PAGED_STACK */
929 /* Length of the line in buf. */
931 memset (buf, ' ', t->max_width);
933 if (t->options & PRT_EJECT)
936 /* Note that a field written to a place where a field has already
937 been written truncates the record. `PRINT /A B (T10,F8,T1,F8).'
938 only outputs B. This is an example of bug-for-bug compatibility,
939 in the author's opinion. */
940 for (i = t->spec; i; i = i->next)
944 if (t->handle == NULL)
947 tab_output_text (TAT_FIX | TAT_NOWRAP, buf);
951 if ((t->options & PRT_CMD_MASK) == PRT_PRINT
952 || t->handle->mode != FH_MD_BINARY)
954 /* PORTME: Line ends. */
961 dfm_put_record (t->handle, buf, len);
964 memset (buf, ' ', t->max_width);
969 /* FIXME: Should be revised to keep track of the string's
970 length outside the loop, probably in i->u.c[0]. */
971 memcpy (&buf[i->fc], i->u.c, strlen (i->u.c));
972 len = i->fc + strlen (i->u.c);
976 if (i->u.v.v->type == NUMERIC)
977 data_out (&buf[i->fc], &i->u.v.f, &c->data[i->u.v.v->fv]);
981 t.c = c->data[i->u.v.v->fv].s;
982 data_out (&buf[i->fc], &i->u.v.f, &t);
984 len = i->fc + i->u.v.f.w;
988 /* PRT_SPACE always immediately follows PRT_VAR. */
1000 /* Frees all the data inside print_trns T. Does not free T. */
1002 print_trns_free (struct trns_header * t)
1004 struct prt_out_spec *i, *n;
1006 for (i = ((struct print_trns *) t)->spec; i; i = n)
1026 free (((struct print_trns *) t)->line);
1032 /* PRINT SPACE transformation. */
1033 struct print_space_trns
1035 struct trns_header h;
1037 struct file_handle *handle; /* Output file, NULL=listing file. */
1038 struct expression *e; /* Number of lines; NULL=1. */
1042 static int print_space_trns_proc (struct trns_header *, struct ccase *);
1043 static void print_space_trns_free (struct trns_header *);
1046 cmd_print_space (void)
1048 struct print_space_trns *t;
1049 struct file_handle *handle;
1050 struct expression *e;
1052 lex_match_id ("SPACE");
1053 if (lex_match_id ("OUTFILE"))
1058 handle = fh_get_handle_by_name (tokid);
1059 else if (token == T_STRING)
1060 handle = fh_get_handle_by_filename (tokid);
1063 msg (SE, _("A file name or handle was expected in the "
1064 "OUTFILE subcommand."));
1077 e = expr_parse (PXP_NUMERIC);
1081 lex_error (_("expecting end of command"));
1088 t = xmalloc (sizeof *t);
1089 t->h.proc = print_space_trns_proc;
1091 t->h.free = print_space_trns_free;
1097 add_transformation ((struct trns_header *) t);
1102 print_space_trns_proc (struct trns_header * trns, struct ccase * c)
1104 struct print_space_trns *t = (struct print_space_trns *) trns;
1111 expr_evaluate (t->e, c, &v);
1115 msg (SW, _("The expression on PRINT SPACE evaluated to %d. It's "
1116 "not possible to PRINT SPACE a negative number of "
1125 if (t->handle == NULL)
1130 char buf[LINE_END_WIDTH];
1132 /* PORTME: Line ends. */
1140 dfm_put_record (t->handle, buf, LINE_END_WIDTH);
1147 print_space_trns_free (struct trns_header * trns)
1149 expr_free (((struct print_space_trns *) trns)->e);
1152 /* Debugging code. */
1158 struct prt_out_spec *p;
1160 if (prt.handle == NULL)
1167 printf ("WRITE OUTFILE=%s", handle_name (prt.handle));
1168 printf (" MAX_WIDTH=%d", prt.max_width);
1170 for (p = prt.spec; p; p = p->next)
1174 printf (_("<ERROR>"));
1180 printf (" \"%s\" %d-%d", p->u.c, p->fc + 1, p->fc + strlen (p->u.c));
1183 printf (" %s %d %d-%d (%s)", p->u.v.v->name, p->u.v.v->fv, p->fc + 1,
1184 p->fc + p->u.v.v->print.w, fmt_to_string (&p->u.v.v->print));
1187 printf (" \" \" %d", p->fc + 1);
1192 #endif /* DEBUGGING */