You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
- 02111-1307, USA. */
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ 02110-1301, USA. */
-/* AIX requires this to be the first thing in the file. */
-#include <config.h>
-#if __GNUC__
-#define alloca __builtin_alloca
-#else
-#if HAVE_ALLOCA_H
-#include <alloca.h>
-#else
-#ifdef _AIX
-#pragma alloca
-#else
-#ifndef alloca /* predefined by HP cc +Olibcalls */
-char *alloca ();
-#endif
-#endif
-#endif
-#endif
+/* FIXME: seems like a lot of code duplication with data-list.c. */
-#include <assert.h>
+#include <config.h>
+#include "error.h"
#include <stdlib.h>
#include "alloc.h"
+#include "case.h"
#include "command.h"
-#include "dfm.h"
+#include "dfm-write.h"
#include "error.h"
-#include "expr.h"
+#include "expressions/public.h"
#include "file-handle.h"
#include "lexer.h"
#include "misc.h"
#include "tab.h"
#include "var.h"
-#undef DEBUGGING
-/*#define DEBUGGING 1*/
-#include "debug-print.h"
+#include "gettext.h"
+#define _(msgid) gettext (msgid)
/* Describes what to do when an output field is encountered. */
enum
PRT_CMD_MASK = 1, /* Command type mask. */
PRT_PRINT = 0, /* PRINT transformation identifier. */
PRT_WRITE = 1, /* WRITE transformation identifier. */
- PRT_EJECT = 002 /* Can be combined with CMD_PRINT only. */
+ PRT_EJECT = 002, /* Can be combined with CMD_PRINT only. */
+ PRT_BINARY = 004 /* File is binary, omit newlines. */
};
/* PRINT, PRINT EJECT, WRITE private data structure. */
struct print_trns
{
- struct trns_header h;
- struct file_handle *handle; /* Output file, NULL=listing file. */
+ struct dfm_writer *writer; /* Output file, NULL=listing file. */
int options; /* PRT_* bitmapped field. */
struct prt_out_spec *spec; /* Output specifications. */
int max_width; /* Maximum line width including null. */
-#if !PAGED_STACK
char *line; /* Buffer for sticking lines in. */
-#endif
};
/* PRT_PRINT or PRT_WRITE. */
static int nrec;
static int internal_cmd_print (int flags);
-static int print_trns_proc (struct trns_header *, struct ccase *);
-static void print_trns_free (struct trns_header *);
+static trns_proc_func print_trns_proc;
+static trns_free_func print_trns_free;
static int parse_specs (void);
-static void dump_table (void);
-static void append_var_spec (struct prt_out_spec *spec);
+static void dump_table (const struct file_handle *);
+static void append_var_spec (struct prt_out_spec *);
static void alloc_line (void);
-
-#if DEBUGGING
-void debug_print (void);
-#endif
\f
/* Basic parsing. */
int
cmd_print (void)
{
- lex_match_id ("PRINT");
return internal_cmd_print (PRT_PRINT);
}
int
cmd_print_eject (void)
{
- lex_match_id ("EJECT");
return internal_cmd_print (PRT_PRINT | PRT_EJECT);
}
int
cmd_write (void)
{
- lex_match_id ("WRITE");
return internal_cmd_print (PRT_WRITE);
}
static int
internal_cmd_print (int f)
{
- /* 0=print no table, 1=print table. (TABLE subcommand.) */
- int table = 0;
-
- /* malloc()'d transformation. */
- struct print_trns *trns;
+ int table = 0; /* Print table? */
+ struct print_trns *trns; /* malloc()'d transformation. */
+ struct file_handle *fh = NULL;
/* Fill in prt to facilitate error-handling. */
- prt.h.proc = print_trns_proc;
- prt.h.free = print_trns_free;
- prt.handle = NULL;
+ prt.writer = NULL;
prt.options = f;
prt.spec = NULL;
-#if !PAGED_STACK
prt.line = NULL;
-#endif
next = NULL;
nrec = 0;
{
lex_match ('=');
- prt.handle = fh_parse_file_handle ();
- if (!prt.handle)
- goto lossage;
+ fh = fh_parse (FH_REF_FILE);
+ if (fh == NULL)
+ goto error;
}
else if (lex_match_id ("RECORDS"))
{
lex_match ('=');
lex_match ('(');
if (!lex_force_int ())
- goto lossage;
+ goto error;
nrec = lex_integer ();
lex_get ();
lex_match (')');
else
{
lex_error (_("expecting a valid subcommand"));
- goto lossage;
+ goto error;
}
}
/* Parse variables and strings. */
if (!parse_specs ())
- goto lossage;
-
+ goto error;
+
+ if (fh != NULL)
+ {
+ prt.writer = dfm_open_writer (fh);
+ if (prt.writer == NULL)
+ goto error;
+
+ if (fh_get_mode (fh) == FH_MODE_BINARY)
+ prt.options |= PRT_BINARY;
+ }
+
/* Output the variable table if requested. */
if (table)
- dump_table ();
+ dump_table (fh);
/* Count the maximum line width. Allocate linebuffer if
applicable. */
/* Put the transformation in the queue. */
trns = xmalloc (sizeof *trns);
memcpy (trns, &prt, sizeof *trns);
- add_transformation ((struct trns_header *) trns);
-
-#if DEBUGGING
- debug_print ();
-#endif
+ add_transformation (print_trns_proc, print_trns_free, trns);
return CMD_SUCCESS;
- lossage:
- print_trns_free ((struct trns_header *) & prt);
+ error:
+ print_trns_free (&prt);
return CMD_FAILURE;
}
static struct
{
struct variable **v; /* variable list */
- int nv; /* number of variables in list */
- int cv; /* number of variables from list used up so far
+ size_t nv; /* number of variables in list */
+ size_t cv; /* number of variables from list used up so far
by the FORTRAN-like format specifiers */
int recno; /* current 1-based record number */
int prev_recno = fx.recno;
fx.recno++;
- if (token == T_NUM)
+ if (lex_is_number ())
{
if (!lex_force_int ())
return 0;
{
fx.spec.type = PRT_CONST;
fx.spec.fc = fx.sc - 1;
- fx.spec.u.c = xstrdup (ds_value (&tokstr));
+ fx.spec.u.c = xstrdup (ds_c_str (&tokstr));
lex_get ();
/* Parse the included column range. */
- if (token == T_NUM)
+ if (lex_is_number ())
{
/* Width of column range in characters. */
int c_len;
/* 1-based index of last column in range. */
int lc;
- if (!lex_integer_p () || lex_integer () <= 0)
+ if (!lex_is_integer () || lex_integer () <= 0)
{
msg (SE, _("%g is not a valid column location."), tokval);
goto fail;
lex_negative_to_dash ();
if (lex_match ('-'))
{
- if (!lex_integer_p ())
+ if (!lex_is_integer ())
{
msg (SE, _("Column location expected following `%d-'."),
fx.spec.fc + 1);
static int
parse_variable_argument (void)
{
- if (!parse_variables (NULL, &fx.v, &fx.nv, PV_DUPLICATE))
+ if (!parse_variables (default_dict, &fx.v, &fx.nv, PV_DUPLICATE))
return 0;
- if (token == T_NUM)
+ if (lex_is_number ())
{
if (!fixed_parse_compatible ())
goto fail;
else
{
/* User wants dictionary format specifiers. */
- int i;
+ size_t i;
lex_match ('*');
for (i = 0; i < fx.nv; i++)
return 0;
}
+/* Verifies that FORMAT doesn't need a variable wider than WIDTH.
+ Returns true iff that is the case. */
+static bool
+check_string_width (const struct fmt_spec *format, const struct variable *v)
+{
+ if (get_format_var_width (format) > v->width)
+ {
+ msg (SE, _("Variable %s has width %d so it cannot be output "
+ "as format %s."),
+ v->name, v->width, fmt_to_string (format));
+ return false;
+ }
+ return true;
+}
+
/* Parses a column specification for parse_specs(). */
static int
fixed_parse_compatible (void)
{
- int dividend;
+ int individual_var_width;
int type;
- int i;
+ size_t i;
type = fx.v[0]->type;
for (i = 1; i < fx.nv; i++)
else
fx.spec.u.v.f.type = FMT_F;
- if (token == T_NUM)
+ if (lex_is_number ())
{
if (!lex_force_int ())
return 0;
if ((fx.lc - fx.fc + 1) % fx.nv)
{
- msg (SE, _("The %d columns %d-%d can't be evenly divided into %d "
- "fields."), fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, fx.nv);
+ msg (SE, _("The %d columns %d-%d can't be evenly divided into %u "
+ "fields."),
+ fx.lc - fx.fc + 1, fx.fc + 1, fx.lc + 1, (unsigned) fx.nv);
return 0;
}
- dividend = (fx.lc - fx.fc + 1) / fx.nv;
- fx.spec.u.v.f.w = dividend;
- if (!check_output_specifier (&fx.spec.u.v.f))
+ individual_var_width = (fx.lc - fx.fc + 1) / fx.nv;
+ fx.spec.u.v.f.w = individual_var_width;
+ if (!check_output_specifier (&fx.spec.u.v.f, true)
+ || !check_specifier_type (&fx.spec.u.v.f, type, true))
return 0;
- if ((type == ALPHA) ^ (formats[fx.spec.u.v.f.type].cat & FCAT_STRING))
- {
- msg (SE, _("%s variables cannot be displayed with format %s."),
- type == ALPHA ? _("String") : _("Numeric"),
- fmt_to_string (&fx.spec.u.v.f));
- return 0;
- }
-
- /* Check that, for string variables, the user didn't specify a width
- longer than an actual string width. */
if (type == ALPHA)
{
- /* Minimum width of all the string variables specified. */
- int min_len = fx.v[0]->width;
-
- for (i = 1; i < fx.nv; i++)
- min_len = min (min_len, fx.v[i]->width);
- if (!check_string_specifier (&fx.spec.u.v.f, min_len))
- return 0;
+ for (i = 0; i < fx.nv; i++)
+ if (!check_string_width (&fx.spec.u.v.f, fx.v[i]))
+ return false;
}
fx.spec.type = PRT_VAR;
for (i = 0; i < fx.nv; i++)
{
- fx.spec.fc = fx.fc + dividend * i;
+ fx.spec.fc = fx.fc + individual_var_width * i;
fx.spec.u.v.v = fx.v[i];
append_var_spec (&fx.spec);
}
/* Destroy a format list and, optionally, all its sublists. */
static void
-destroy_fmt_list (struct fmt_list * f, int recurse)
+destroy_fmt_list (struct fmt_list *f, int recurse)
{
struct fmt_list *next;
FORTRAN-like format specifications, like 4(F10,2X)) into the
structure prt. */
static int
-dump_fmt_list (struct fmt_list * f)
+dump_fmt_list (struct fmt_list *f)
{
int i;
}
v = fx.v[fx.cv++];
- if ((v->type == ALPHA) ^ (formats[f->f.type].cat & FCAT_STRING))
- {
- msg (SE, _("Display format %s may not be used with a "
- "%s variable."), fmt_to_string (&f->f),
- v->type == ALPHA ? _("string") : _("numeric"));
- return 0;
- }
- if (!check_string_specifier (&f->f, v->width))
- return 0;
+ if (!check_output_specifier (&f->f, true)
+ || !check_specifier_type (&f->f, v->type, true)
+ || !check_string_width (&f->f, v))
+ return false;
fx.spec.type = PRT_VAR;
fx.spec.u.v.v = v;
static struct fmt_list *
fixed_parse_fortran (void)
{
- struct fmt_list *head;
+ struct fmt_list *head = NULL;
struct fmt_list *fl = NULL;
lex_get (); /* skip opening parenthesis */
else
head = fl = xmalloc (sizeof *fl);
- if (token == T_NUM)
+ if (lex_is_number ())
{
- if (!lex_integer_p ())
+ if (!lex_is_integer ())
goto fail;
fl->count = lex_integer ();
lex_get ();
}
else if (lex_match ('/'))
fl->f.type = FMT_NEWREC;
- else if (!parse_format_specifier (&fl->f, 1)
- || !check_output_specifier (&fl->f))
+ else if (!parse_format_specifier (&fl->f, FMTP_ALLOW_XT)
+ || !check_output_specifier (&fl->f, 1))
goto fail;
lex_match (',');
/* Prints the table produced by the TABLE subcommand to the listing
file. */
static void
-dump_table (void)
+dump_table (const struct file_handle *fh)
{
struct prt_out_spec *spec;
- const char *filename;
struct tab_table *t;
int recno;
int nspec;
assert (0);
}
- filename = fh_handle_name (prt.handle);
- tab_title (t, 1, (prt.handle != NULL
- ? _("Writing %3d records to file %s.")
- : _("Writing %3d records to the listing file.")),
- recno, filename);
+ if (fh != NULL)
+ tab_title (t, 1, ngettext ("Writing %d record to %s.",
+ "Writing %d records to %s.", recno),
+ recno, fh_get_name (fh));
+ else
+ tab_title (t, 1, ngettext ("Writing %d record.",
+ "Writing %d records.", recno), recno);
tab_submit (t);
- fh_handle_name (NULL);
}
/* PORTME: The number of characters in a line terminator. */
-#if __MSDOS__
+#ifdef __MSDOS__
#define LINE_END_WIDTH 2 /* \r\n */
#else
#define LINE_END_WIDTH 1 /* \n */
#endif
/* Calculates the maximum possible line width and allocates a buffer
- big enough to contain it, if necessary (otherwise sets max_width).
- (The action taken depends on compiler & OS as detected by pref.h.) */
+ big enough to contain it */
static void
alloc_line (void)
{
pot_w = i->fc + 1;
break;
case PRT_ERROR:
+ default:
assert (0);
- break;
+ abort ();
}
if (pot_w > w)
w = pot_w;
}
prt.max_width = w + LINE_END_WIDTH + 1;
-#if !PAGED_STACK
prt.line = xmalloc (prt.max_width);
-#endif
}
\f
/* Transformation. */
/* Performs the transformation inside print_trns T on case C. */
static int
-print_trns_proc (struct trns_header * trns, struct ccase * c)
+print_trns_proc (void *trns_, struct ccase *c, int case_num UNUSED)
{
/* Transformation. */
- struct print_trns *t = (struct print_trns *) trns;
+ struct print_trns *t = trns_;
/* Iterator. */
struct prt_out_spec *i;
/* Line buffer. */
-#if PAGED_STACK
-#if __GNUC__ && !__STRICT_ANSI__
- char buf[t->max_width];
-#else /* !__GNUC__ */
- char *buf = alloca (t->max_width);
-#endif /* !__GNUC__ */
-#else /* !PAGED_STACK */
char *buf = t->line;
-#endif /* !PAGED_STACK */
/* Length of the line in buf. */
int len = 0;
if (t->options & PRT_EJECT)
som_eject_page ();
- /* Note that a field written to a place where a field has already
- been written truncates the record. `PRINT /A B (T10,F8,T1,F8).'
- only outputs B. This is an example of bug-for-bug compatibility,
- in the author's opinion. */
+ /* Note that a field written to a place where a field has
+ already been written truncates the record. `PRINT /A B
+ (T10,F8,T1,F8).' only outputs B. */
for (i = t->spec; i; i = i->next)
switch (i->type)
{
case PRT_NEWLINE:
- if (t->handle == NULL)
+ if (t->writer == NULL)
{
buf[len] = 0;
tab_output_text (TAT_FIX | TAT_NOWRAP, buf);
else
{
if ((t->options & PRT_CMD_MASK) == PRT_PRINT
- || t->handle->mode != FH_MD_BINARY)
+ || !(t->options & PRT_BINARY))
{
/* PORTME: Line ends. */
-#if __MSDOS__
+#ifdef __MSDOS__
buf[len++] = '\r';
#endif
buf[len++] = '\n';
}
- dfm_put_record (t->handle, buf, len);
+ dfm_put_record (t->writer, buf, len);
}
memset (buf, ' ', t->max_width);
break;
case PRT_VAR:
- if (i->u.v.v->type == NUMERIC)
- data_out (&buf[i->fc], &i->u.v.f, &c->data[i->u.v.v->fv]);
- else
- {
- union value t;
- t.c = c->data[i->u.v.v->fv].s;
- data_out (&buf[i->fc], &i->u.v.f, &t);
- }
+ data_out (&buf[i->fc], &i->u.v.f, case_data (c, i->u.v.v->fv));
len = i->fc + i->u.v.f.w;
break;
/* Frees all the data inside print_trns T. Does not free T. */
static void
-print_trns_free (struct trns_header * t)
+print_trns_free (void *prt_)
{
+ struct print_trns *prt = prt_;
struct prt_out_spec *i, *n;
- for (i = ((struct print_trns *) t)->spec; i; i = n)
+ for (i = prt->spec; i; i = n)
{
switch (i->type)
{
n = i->next;
free (i);
}
-#if !PAGED_STACK
- free (((struct print_trns *) t)->line);
-#endif
+ if (prt->writer != NULL)
+ dfm_close_writer (prt->writer);
+ free (prt->line);
+ free (prt);
}
\f
/* PRINT SPACE. */
/* PRINT SPACE transformation. */
struct print_space_trns
{
- struct trns_header h;
-
- struct file_handle *handle; /* Output file, NULL=listing file. */
+ struct dfm_writer *writer; /* Output data file. */
struct expression *e; /* Number of lines; NULL=1. */
}
print_space_trns;
-static int print_space_trns_proc (struct trns_header *, struct ccase *);
-static void print_space_trns_free (struct trns_header *);
+static trns_proc_func print_space_trns_proc;
+static trns_free_func print_space_trns_free;
int
cmd_print_space (void)
{
struct print_space_trns *t;
- struct file_handle *handle;
+ struct file_handle *fh;
struct expression *e;
+ struct dfm_writer *writer;
- lex_match_id ("SPACE");
if (lex_match_id ("OUTFILE"))
{
lex_match ('=');
- if (token == T_ID)
- handle = fh_get_handle_by_name (tokid);
- else if (token == T_STRING)
- handle = fh_get_handle_by_filename (tokid);
- else
- {
- msg (SE, _("A file name or handle was expected in the "
- "OUTFILE subcommand."));
- return CMD_FAILURE;
- }
-
- if (!handle)
+ fh = fh_parse (FH_REF_FILE);
+ if (fh == NULL)
return CMD_FAILURE;
lex_get ();
}
else
- handle = NULL;
+ fh = NULL;
if (token != '.')
{
- e = expr_parse (PXP_NUMERIC);
+ e = expr_parse (default_dict, EXPR_NUMBER);
if (token != '.')
{
expr_free (e);
else
e = NULL;
- t = xmalloc (sizeof *t);
- t->h.proc = print_space_trns_proc;
- if (e)
- t->h.free = print_space_trns_free;
+ if (fh != NULL)
+ {
+ writer = dfm_open_writer (fh);
+ if (writer == NULL)
+ {
+ expr_free (e);
+ return CMD_FAILURE;
+ }
+ }
else
- t->h.free = NULL;
- t->handle = handle;
+ writer = NULL;
+
+ t = xmalloc (sizeof *t);
+ t->writer = writer;
t->e = e;
- add_transformation ((struct trns_header *) t);
+ add_transformation (print_space_trns_proc, print_space_trns_free, t);
return CMD_SUCCESS;
}
static int
-print_space_trns_proc (struct trns_header * trns, struct ccase * c)
+print_space_trns_proc (void *t_, struct ccase *c,
+ int case_num UNUSED)
{
- struct print_space_trns *t = (struct print_space_trns *) trns;
- int n;
+ struct print_space_trns *t = t_;
+ double n = 1.;
if (t->e)
{
- union value v;
-
- expr_evaluate (t->e, c, &v);
- n = v.f;
- if (n < 0)
- {
- msg (SW, _("The expression on PRINT SPACE evaluated to %d. It's "
- "not possible to PRINT SPACE a negative number of "
- "lines."),
- n);
- n = 1;
- }
+ n = expr_evaluate_num (t->e, c, case_num);
+ if (n == SYSMIS)
+ msg (SW, _("The expression on PRINT SPACE evaluated to the "
+ "system-missing value."));
+ else if (n < 0)
+ msg (SW, _("The expression on PRINT SPACE evaluated to %g."), n);
+ n = 1.;
}
- else
- n = 1;
- if (t->handle == NULL)
+ if (t->writer == NULL)
while (n--)
som_blank_line ();
else
char buf[LINE_END_WIDTH];
/* PORTME: Line ends. */
-#if __MSDOS__
+#ifdef __MSDOS__
buf[0] = '\r';
buf[1] = '\n';
#else
buf[0] = '\n';
#endif
while (n--)
- dfm_put_record (t->handle, buf, LINE_END_WIDTH);
+ dfm_put_record (t->writer, buf, LINE_END_WIDTH);
}
return -1;
}
static void
-print_space_trns_free (struct trns_header * trns)
+print_space_trns_free (void *trns_)
{
- expr_free (((struct print_space_trns *) trns)->e);
-}
-\f
-/* Debugging code. */
-
-#if DEBUGGING
-void
-debug_print (void)
-{
- struct prt_out_spec *p;
-
- if (prt.handle == NULL)
- {
- printf ("PRINT");
- if (prt.eject)
- printf (" EJECT");
- }
- else
- printf ("WRITE OUTFILE=%s", handle_name (prt.handle));
- printf (" MAX_WIDTH=%d", prt.max_width);
- printf (" /");
- for (p = prt.spec; p; p = p->next)
- switch (p->type)
- {
- case PRT_ERROR:
- printf (_("<ERROR>"));
- break;
- case PRT_NEWLINE:
- printf ("\n /");
- break;
- case PRT_CONST:
- printf (" \"%s\" %d-%d", p->u.c, p->fc + 1, p->fc + strlen (p->u.c));
- break;
- case PRT_VAR:
- printf (" %s %d %d-%d (%s)", p->u.v.v->name, p->u.v.v->fv, p->fc + 1,
- p->fc + p->u.v.v->print.w, fmt_to_string (&p->u.v.v->print));
- break;
- case PRT_SPACE:
- printf (" \" \" %d", p->fc + 1);
- break;
- }
- printf (".\n");
+ struct print_space_trns *trns = trns_;
+ expr_free (trns->e);
+ free (trns);
}
-#endif /* DEBUGGING */