src/print.c

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
   3    Written by Ben Pfaff <blp@gnu.org>.
   4
   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.
   9
  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.
  14
  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
  18    02111-1307, USA. */
  19
  20 /* AIX requires this to be the first thing in the file.  */
  21 #include <config.h>
  22 #if __GNUC__
  23 #define alloca __builtin_alloca
  24 #else
  25 #if HAVE_ALLOCA_H
  26 #include <alloca.h>
  27 #else
  28 #ifdef _AIX
  29 #pragma alloca
  30 #else
  31 #ifndef alloca                  /* predefined by HP cc +Olibcalls */
  32 char *alloca ();
  33 #endif
  34 #endif
  35 #endif
  36 #endif
  37
  38 #include <assert.h>
  39 #include <stdlib.h>
  40 #include "alloc.h"
  41 #include "command.h"
  42 #include "dfm.h"
  43 #include "error.h"
  44 #include "expr.h"
  45 #include "file-handle.h"
  46 #include "lexer.h"
  47 #include "misc.h"
  48 #include "som.h"
  49 #include "tab.h"
  50 #include "var.h"
  51
  52 #include "debug-print.h"
  53
  54 /* Describes what to do when an output field is encountered. */
  55 enum
  56   {
  57     PRT_ERROR,                  /* Invalid value. */
  58     PRT_NEWLINE,                /* Newline. */
  59     PRT_CONST,                  /* Constant string. */
  60     PRT_VAR,                    /* Variable. */
  61     PRT_SPACE                   /* A single space. */
  62   };
  63
  64 /* Describes how to output one field. */
  65 struct prt_out_spec
  66   {
  67     struct prt_out_spec *next;
  68     int type;                   /* PRT_* constant. */
  69     int fc;                     /* 0-based first column. */
  70     union
  71       {
  72         char *c;                /* PRT_CONST: Associated string. */
  73         struct
  74           {
  75             struct variable *v; /* PRT_VAR: Associated variable. */
  76             struct fmt_spec f;  /* PRT_VAR: Output spec. */
  77           }
  78         v;
  79       }
  80     u;
  81   };
  82
  83 /* Enums for use with print_trns's `options' field. */
  84 enum
  85   {
  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. */
  90   };
  91
  92 /* PRINT, PRINT EJECT, WRITE private data structure. */
  93 struct print_trns
  94   {
  95     struct trns_header h;
  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. */
 100 #if !PAGED_STACK
 101     char *line;                 /* Buffer for sticking lines in. */
 102 #endif
 103   };
 104
 105 /* PRT_PRINT or PRT_WRITE. */
 106 int which_cmd;
 107
 108 /* Holds information on parsing the data file. */
 109 static struct print_trns prt;
 110
 111 /* Last prt_out_spec in the chain.  Used for building the linked-list. */
 112 static struct prt_out_spec *next;
 113
 114 /* Number of records. */
 115 static int nrec;
 116
 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);
 124
 125 #if DEBUGGING
 126 void debug_print (void);
 127 #endif
 128 \f
 129 /* Basic parsing. */
 130
 131 /* Parses PRINT command. */
 132 int
 133 cmd_print (void)
 134 {
 135   lex_match_id ("PRINT");
 136   return internal_cmd_print (PRT_PRINT);
 137 }
 138
 139 /* Parses PRINT EJECT command. */
 140 int
 141 cmd_print_eject (void)
 142 {
 143   lex_match_id ("EJECT");
 144   return internal_cmd_print (PRT_PRINT | PRT_EJECT);
 145 }
 146
 147 /* Parses WRITE command. */
 148 int
 149 cmd_write (void)
 150 {
 151   lex_match_id ("WRITE");
 152   return internal_cmd_print (PRT_WRITE);
 153 }
 154
 155 /* Parses the output commands.  F is PRT_PRINT, PRT_WRITE, or
 156    PRT_PRINT|PRT_EJECT. */
 157 static int
 158 internal_cmd_print (int f)
 159 {
 160   /* 0=print no table, 1=print table.  (TABLE subcommand.)  */
 161   int table = 0;
 162
 163   /* malloc()'d transformation. */
 164   struct print_trns *trns;
 165
 166   /* Fill in prt to facilitate error-handling. */
 167   prt.h.proc = print_trns_proc;
 168   prt.h.free = print_trns_free;
 169   prt.handle = NULL;
 170   prt.options = f;
 171   prt.spec = NULL;
 172 #if !PAGED_STACK
 173   prt.line = NULL;
 174 #endif
 175   next = NULL;
 176   nrec = 0;
 177
 178   which_cmd = f & PRT_CMD_MASK;
 179
 180   /* Parse the command options. */
 181   while (!lex_match ('/'))
 182     {
 183       if (lex_match_id ("OUTFILE"))
 184         {
 185           lex_match ('=');
 186
 187           prt.handle = fh_parse_file_handle ();
 188           if (!prt.handle)
 189             goto lossage;
 190         }
 191       else if (lex_match_id ("RECORDS"))
 192         {
 193           lex_match ('=');
 194           lex_match ('(');
 195           if (!lex_force_int ())
 196             goto lossage;
 197           nrec = lex_integer ();
 198           lex_get ();
 199           lex_match (')');
 200         }
 201       else if (lex_match_id ("TABLE"))
 202         table = 1;
 203       else if (lex_match_id ("NOTABLE"))
 204         table = 0;
 205       else
 206         {
 207           lex_error (_("expecting a valid subcommand"));
 208           goto lossage;
 209         }
 210     }
 211
 212   /* Parse variables and strings. */
 213   if (!parse_specs ())
 214     goto lossage;
 215
 216   /* Output the variable table if requested. */
 217   if (table)
 218     dump_table ();
 219
 220   /* Count the maximum line width.  Allocate linebuffer if
 221      applicable. */
 222   alloc_line ();
 223
 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);
 228
 229 #if 0 && DEBUGGING
 230   debug_print ();
 231 #endif
 232
 233   return CMD_SUCCESS;
 234
 235  lossage:
 236   print_trns_free ((struct trns_header *) & prt);
 237   return CMD_FAILURE;
 238 }
 239
 240 /* Appends the field output specification SPEC to the list maintained
 241    in prt. */
 242 static void
 243 append_var_spec (struct prt_out_spec *spec)
 244 {
 245   if (next == 0)
 246     prt.spec = next = xmalloc (sizeof *spec);
 247   else
 248     next = next->next = xmalloc (sizeof *spec);
 249
 250   memcpy (next, spec, sizeof *spec);
 251   next->next = NULL;
 252 }
 253 \f
 254 /* Field parsing.  Mostly stolen from data-list.c. */
 255
 256 /* Used for chaining together fortran-like format specifiers. */
 257 struct fmt_list
 258 {
 259   struct fmt_list *next;
 260   int count;
 261   struct fmt_spec f;
 262   struct fmt_list *down;
 263 };
 264
 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. */
 268 static struct
 269   {
 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 */
 274
 275     int recno;                  /* current 1-based record number */
 276     int sc;                     /* 1-based starting column for next variable */
 277
 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
 280                                    var */
 281
 282     int level;                  /* recursion level for FORTRAN-like format
 283                                    specifiers */
 284   }
 285 fx;
 286
 287 static int fixed_parse_compatible (void);
 288 static struct fmt_list *fixed_parse_fortran (void);
 289
 290 static int parse_string_argument (void);
 291 static int parse_variable_argument (void);
 292
 293 /* Parses all the variable and string specifications on a single
 294    PRINT, PRINT EJECT, or WRITE command into the prt structure.
 295    Returns success. */
 296 static int
 297 parse_specs (void)
 298 {
 299   /* Return code from called function. */
 300   int code;
 301
 302   fx.recno = 1;
 303   fx.sc = 1;
 304
 305   while (token != '.')
 306     {
 307       while (lex_match ('/'))
 308         {
 309           int prev_recno = fx.recno;
 310
 311           fx.recno++;
 312           if (token == T_NUM)
 313             {
 314               if (!lex_force_int ())
 315                 return 0;
 316               if (lex_integer () < fx.recno)
 317                 {
 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);
 323                   return 0;
 324                 }
 325               fx.recno = lex_integer ();
 326               lex_get ();
 327             }
 328
 329           fx.spec.type = PRT_NEWLINE;
 330           while (prev_recno++ < fx.recno)
 331             append_var_spec (&fx.spec);
 332
 333           fx.sc = 1;
 334         }
 335
 336       if (token == T_STRING)
 337         code = parse_string_argument ();
 338       else
 339         code = parse_variable_argument ();
 340       if (!code)
 341         return 0;
 342     }
 343   fx.spec.type = PRT_NEWLINE;
 344   append_var_spec (&fx.spec);
 345
 346   if (!nrec)
 347     nrec = fx.recno;
 348   else if (fx.recno > nrec)
 349     {
 350       msg (SE, _("Variables are specified on records that "
 351                  "should not exist according to RECORDS subcommand."));
 352       return 0;
 353     }
 354
 355   if (token != '.')
 356     {
 357       lex_error (_("expecting end of command"));
 358       return 0;
 359     }
 360
 361   return 1;
 362 }
 363
 364 /* Parses a string argument to the PRINT commands.  Returns success. */
 365 static int
 366 parse_string_argument (void)
 367 {
 368   fx.spec.type = PRT_CONST;
 369   fx.spec.fc = fx.sc - 1;
 370   fx.spec.u.c = xstrdup (ds_value (&tokstr));
 371   lex_get ();
 372
 373   /* Parse the included column range. */
 374   if (token == T_NUM)
 375     {
 376       /* Width of column range in characters. */
 377       int c_len;
 378
 379       /* Width of constant string in characters. */
 380       int s_len;
 381
 382       /* 1-based index of last column in range. */
 383       int lc;
 384
 385       if (!lex_integer_p () || lex_integer () <= 0)
 386         {
 387           msg (SE, _("%g is not a valid column location."), tokval);
 388           goto fail;
 389         }
 390       fx.spec.fc = lex_integer () - 1;
 391
 392       lex_get ();
 393       lex_negative_to_dash ();
 394       if (lex_match ('-'))
 395         {
 396           if (!lex_integer_p ())
 397             {
 398               msg (SE, _("Column location expected following `%d-'."),
 399                    fx.spec.fc + 1);
 400               goto fail;
 401             }
 402           if (lex_integer () <= 0)
 403             {
 404               msg (SE, _("%g is not a valid column location."), tokval);
 405               goto fail;
 406             }
 407           if (lex_integer () < fx.spec.fc + 1)
 408             {
 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 ());
 412               goto fail;
 413             }
 414           lc = lex_integer () - 1;
 415
 416           lex_get ();
 417         }
 418       else
 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;
 422
 423       /* Apply the range. */
 424       c_len = lc - fx.spec.fc + 1;
 425       s_len = strlen (fx.spec.u.c);
 426       if (s_len > c_len)
 427         fx.spec.u.c[c_len] = 0;
 428       else if (s_len < c_len)
 429         {
 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;
 433         }
 434
 435       fx.sc = lc + 1;
 436     }
 437   else
 438     /* If nothing is provided then the field is the width of the
 439        provided string. */
 440     fx.sc += strlen (fx.spec.u.c);
 441
 442   append_var_spec (&fx.spec);
 443   return 1;
 444
 445 fail:
 446   free (fx.spec.u.c);
 447   return 0;
 448 }
 449
 450 /* Parses a variable argument to the PRINT commands by passing it off
 451    to fixed_parse_compatible() or fixed_parse_fortran() as appropriate.
 452    Returns success. */
 453 static int
 454 parse_variable_argument (void)
 455 {
 456   if (!parse_variables (NULL, &fx.v, &fx.nv, PV_DUPLICATE))
 457     return 0;
 458
 459   if (token == T_NUM)
 460     {
 461       if (!fixed_parse_compatible ())
 462         goto fail;
 463     }
 464   else if (token == '(')
 465     {
 466       fx.level = 0;
 467       fx.cv = 0;
 468       if (!fixed_parse_fortran ())
 469         goto fail;
 470     }
 471   else
 472     {
 473       /* User wants dictionary format specifiers. */
 474       int i;
 475
 476       lex_match ('*');
 477       for (i = 0; i < fx.nv; i++)
 478         {
 479           /* Variable. */
 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;
 486
 487           /* Space. */
 488           fx.spec.type = PRT_SPACE;
 489           fx.spec.fc = fx.sc - 1;
 490           append_var_spec (&fx.spec);
 491           fx.sc++;
 492         }
 493     }
 494
 495   free (fx.v);
 496   return 1;
 497
 498 fail:
 499   free (fx.v);
 500   return 0;
 501 }
 502
 503 /* Parses a column specification for parse_specs(). */
 504 static int
 505 fixed_parse_compatible (void)
 506 {
 507   int dividend;
 508   int type;
 509   int i;
 510
 511   type = fx.v[0]->type;
 512   for (i = 1; i < fx.nv; i++)
 513     if (type != fx.v[i]->type)
 514       {
 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);
 519         return 0;
 520       }
 521
 522   if (!lex_force_int ())
 523     return 0;
 524   fx.fc = lex_integer () - 1;
 525   if (fx.fc < 0)
 526     {
 527       msg (SE, _("Column positions for fields must be positive."));
 528       return 0;
 529     }
 530   lex_get ();
 531
 532   lex_negative_to_dash ();
 533   if (lex_match ('-'))
 534     {
 535       if (!lex_force_int ())
 536         return 0;
 537       fx.lc = lex_integer () - 1;
 538       if (fx.lc < 0)
 539         {
 540           msg (SE, _("Column positions for fields must be positive."));
 541           return 0;
 542         }
 543       else if (fx.lc < fx.fc)
 544         {
 545           msg (SE, _("The ending column for a field must not "
 546                      "be less than the starting column."));
 547           return 0;
 548         }
 549       lex_get ();
 550     }
 551   else
 552     fx.lc = fx.fc;
 553
 554   fx.spec.u.v.f.w = fx.lc - fx.fc + 1;
 555   if (lex_match ('('))
 556     {
 557       struct fmt_desc *fdp;
 558
 559       if (token == T_ID)
 560         {
 561           const char *cp;
 562
 563           fx.spec.u.v.f.type = parse_format_specifier_name (&cp, 0);
 564           if (fx.spec.u.v.f.type == -1)
 565             return 0;
 566           if (*cp)
 567             {
 568               msg (SE, _("A format specifier on this line "
 569                          "has extra characters on the end."));
 570               return 0;
 571             }
 572           lex_get ();
 573           lex_match (',');
 574         }
 575       else
 576         fx.spec.u.v.f.type = FMT_F;
 577
 578       if (token == T_NUM)
 579         {
 580           if (!lex_force_int ())
 581             return 0;
 582           if (lex_integer () < 1)
 583             {
 584               msg (SE, _("The value for number of decimal places "
 585                          "must be at least 1."));
 586               return 0;
 587             }
 588           fx.spec.u.v.f.d = lex_integer ();
 589           lex_get ();
 590         }
 591       else
 592         fx.spec.u.v.f.d = 0;
 593
 594       fdp = &formats[fx.spec.u.v.f.type];
 595       if (fdp->n_args < 2 && fx.spec.u.v.f.d)
 596         {
 597           msg (SE, _("Input format %s doesn't accept decimal places."),
 598                fdp->name);
 599           return 0;
 600         }
 601       if (fx.spec.u.v.f.d > 16)
 602         fx.spec.u.v.f.d = 16;
 603
 604       if (!lex_force_match (')'))
 605         return 0;
 606     }
 607   else
 608     {
 609       fx.spec.u.v.f.type = FMT_F;
 610       fx.spec.u.v.f.d = 0;
 611     }
 612
 613   fx.sc = fx.lc + 1;
 614
 615   if ((fx.lc - fx.fc + 1) % fx.nv)
 616     {
 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);
 619       return 0;
 620     }
 621
 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))
 625     return 0;
 626   if ((type == ALPHA) ^ (formats[fx.spec.u.v.f.type].cat & FCAT_STRING))
 627     {
 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));
 631       return 0;
 632     }
 633
 634   /* Check that, for string variables, the user didn't specify a width
 635      longer than an actual string width. */
 636   if (type == ALPHA)
 637     {
 638       /* Minimum width of all the string variables specified. */
 639       int min_len = fx.v[0]->width;
 640
 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))
 644         return 0;
 645     }
 646
 647   fx.spec.type = PRT_VAR;
 648   for (i = 0; i < fx.nv; i++)
 649     {
 650       fx.spec.fc = fx.fc + dividend * i;
 651       fx.spec.u.v.v = fx.v[i];
 652       append_var_spec (&fx.spec);
 653     }
 654   return 1;
 655 }
 656
 657 /* Destroy a format list and, optionally, all its sublists. */
 658 static void
 659 destroy_fmt_list (struct fmt_list * f, int recurse)
 660 {
 661   struct fmt_list *next;
 662
 663   for (; f; f = next)
 664     {
 665       next = f->next;
 666       if (recurse && f->f.type == FMT_DESCEND)
 667         destroy_fmt_list (f->down, 1);
 668       free (f);
 669     }
 670 }
 671
 672 /* Recursively puts the format list F (which represents a set of
 673    FORTRAN-like format specifications, like 4(F10,2X)) into the
 674    structure prt. */
 675 static int
 676 dump_fmt_list (struct fmt_list * f)
 677 {
 678   int i;
 679
 680   for (; f; f = f->next)
 681     if (f->f.type == FMT_X)
 682       fx.sc += f->count;
 683     else if (f->f.type == FMT_T)
 684       fx.sc = f->f.w;
 685     else if (f->f.type == FMT_NEWREC)
 686       {
 687         fx.recno += f->count;
 688         fx.sc = 1;
 689         fx.spec.type = PRT_NEWLINE;
 690         for (i = 0; i < f->count; i++)
 691           append_var_spec (&fx.spec);
 692       }
 693     else
 694       for (i = 0; i < f->count; i++)
 695         if (f->f.type == FMT_DESCEND)
 696           {
 697             if (!dump_fmt_list (f->down))
 698               return 0;
 699           }
 700         else
 701           {
 702             struct variable *v;
 703
 704             if (fx.cv >= fx.nv)
 705               {
 706                 msg (SE, _("The number of format "
 707                            "specifications exceeds the number of variable "
 708                            "names given."));
 709                 return 0;
 710               }
 711
 712             v = fx.v[fx.cv++];
 713             if ((v->type == ALPHA) ^ (formats[f->f.type].cat & FCAT_STRING))
 714               {
 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"));
 718                 return 0;
 719               }
 720             if (!check_string_specifier (&f->f, v->width))
 721               return 0;
 722
 723             fx.spec.type = PRT_VAR;
 724             fx.spec.u.v.v = v;
 725             fx.spec.u.v.f = f->f;
 726             fx.spec.fc = fx.sc - 1;
 727             append_var_spec (&fx.spec);
 728
 729             fx.sc += f->f.w;
 730           }
 731   return 1;
 732 }
 733
 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)
 740 {
 741   struct fmt_list *head;
 742   struct fmt_list *fl = NULL;
 743
 744   lex_get ();                   /* skip opening parenthesis */
 745   while (token != ')')
 746     {
 747       if (fl)
 748         fl = fl->next = xmalloc (sizeof *fl);
 749       else
 750         head = fl = xmalloc (sizeof *fl);
 751
 752       if (token == T_NUM)
 753         {
 754           if (!lex_integer_p ())
 755             goto fail;
 756           fl->count = lex_integer ();
 757           lex_get ();
 758         }
 759       else
 760         fl->count = 1;
 761
 762       if (token == '(')
 763         {
 764           fl->f.type = FMT_DESCEND;
 765           fx.level++;
 766           fl->down = fixed_parse_fortran ();
 767           fx.level--;
 768           if (!fl->down)
 769             goto fail;
 770         }
 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))
 775         goto fail;
 776
 777       lex_match (',');
 778     }
 779   fl->next = NULL;
 780   lex_get ();
 781
 782   if (fx.level)
 783     return head;
 784
 785   fl->next = NULL;
 786   dump_fmt_list (head);
 787   destroy_fmt_list (head, 1);
 788   if (fx.cv < fx.nv)
 789     {
 790       msg (SE, _("There aren't enough format specifications "
 791            "to match the number of variable names given."));
 792       goto fail;
 793     }
 794   return head;
 795
 796 fail:
 797   fl->next = NULL;
 798   destroy_fmt_list (head, 0);
 799
 800   return NULL;
 801 }
 802
 803 /* Prints the table produced by the TABLE subcommand to the listing
 804    file. */
 805 static void
 806 dump_table (void)
 807 {
 808   struct prt_out_spec *spec;
 809   const char *filename;
 810   struct tab_table *t;
 811   int recno;
 812   int nspec;
 813
 814   for (nspec = 0, spec = prt.spec; spec; spec = spec->next)
 815     if (spec->type == PRT_CONST || spec->type == PRT_VAR)
 816       nspec++;
 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)
 828     switch (spec->type)
 829       {
 830       case PRT_NEWLINE:
 831         recno++;
 832         break;
 833       case PRT_CONST:
 834         {
 835           int len = strlen (spec->u.c);
 836           nspec++;
 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,
 843                         "A%d", len);
 844           break;
 845         }
 846       case PRT_VAR:
 847         {
 848           nspec++;
 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));
 855           break;
 856         }
 857       case PRT_SPACE:
 858         break;
 859       case PRT_ERROR:
 860         assert (0);
 861       }
 862
 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.")),
 867              recno, filename);
 868   tab_submit (t);
 869   fh_handle_name (NULL);
 870 }
 871
 872 /* PORTME: The number of characters in a line terminator. */
 873 #if __MSDOS__
 874 #define LINE_END_WIDTH 2        /* \r\n */
 875 #else
 876 #define LINE_END_WIDTH 1        /* \n */
 877 #endif
 878
 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.) */
 882 static void
 883 alloc_line (void)
 884 {
 885   /* Cumulative maximum line width (excluding null terminator) so far. */
 886   int w = 0;
 887
 888   /* Width required by current this prt_out_spec. */
 889   int pot_w;                    /* Potential w. */
 890
 891   /* Iterator. */
 892   struct prt_out_spec *i;
 893
 894   for (i = prt.spec; i; i = i->next)
 895     {
 896       switch (i->type)
 897         {
 898         case PRT_NEWLINE:
 899           pot_w = 0;
 900           break;
 901         case PRT_CONST:
 902           pot_w = i->fc + strlen (i->u.c);
 903           break;
 904         case PRT_VAR:
 905           pot_w = i->fc + i->u.v.f.w;
 906           break;
 907         case PRT_SPACE:
 908           pot_w = i->fc + 1;
 909           break;
 910         case PRT_ERROR:
 911           assert (0);
 912           break;
 913         }
 914       if (pot_w > w)
 915         w = pot_w;
 916     }
 917   prt.max_width = w + LINE_END_WIDTH + 1;
 918 #if !PAGED_STACK
 919   prt.line = xmalloc (prt.max_width);
 920 #endif
 921 }
 922 \f
 923 /* Transformation. */
 924
 925 /* Performs the transformation inside print_trns T on case C. */
 926 static int
 927 print_trns_proc (struct trns_header * trns, struct ccase * c)
 928 {
 929   /* Transformation. */
 930   struct print_trns *t = (struct print_trns *) trns;
 931
 932   /* Iterator. */
 933   struct prt_out_spec *i;
 934
 935   /* Line buffer. */
 936 #if PAGED_STACK
 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 */
 943   char *buf = t->line;
 944 #endif /* !PAGED_STACK */
 945
 946   /* Length of the line in buf. */
 947   int len = 0;
 948   memset (buf, ' ', t->max_width);
 949
 950   if (t->options & PRT_EJECT)
 951     som_eject_page ();
 952
 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)
 958     switch (i->type)
 959       {
 960       case PRT_NEWLINE:
 961         if (t->handle == NULL)
 962           {
 963             buf[len] = 0;
 964             tab_output_text (TAT_FIX | TAT_NOWRAP, buf);
 965           }
 966         else
 967           {
 968             if ((t->options & PRT_CMD_MASK) == PRT_PRINT
 969                 || t->handle->mode != FH_MD_BINARY)
 970               {
 971                 /* PORTME: Line ends. */
 972 #if __MSDOS__
 973                 buf[len++] = '\r';
 974 #endif
 975                 buf[len++] = '\n';
 976               }
 977
 978             dfm_put_record (t->handle, buf, len);
 979           }
 980
 981         memset (buf, ' ', t->max_width);
 982         len = 0;
 983         break;
 984
 985       case PRT_CONST:
 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);
 990         break;
 991
 992       case PRT_VAR:
 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]);
 995         else
 996           {
 997             union value t;
 998             t.c = c->data[i->u.v.v->fv].s;
 999             data_out (&buf[i->fc], &i->u.v.f, &t);
1000           }
1001         len = i->fc + i->u.v.f.w;
1002         break;
1003
1004       case PRT_SPACE:
1005         /* PRT_SPACE always immediately follows PRT_VAR. */
1006         buf[len++] = ' ';
1007         break;
1008
1009       case PRT_ERROR:
1010         assert (0);
1011         break;
1012       }
1013
1014   return -1;
1015 }
1016
1017 /* Frees all the data inside print_trns T.  Does not free T. */
1018 static void
1019 print_trns_free (struct trns_header * t)
1020 {
1021   struct prt_out_spec *i, *n;
1022
1023   for (i = ((struct print_trns *) t)->spec; i; i = n)
1024     {
1025       switch (i->type)
1026         {
1027         case PRT_CONST:
1028           free (i->u.c);
1029           /* fall through */
1030         case PRT_NEWLINE:
1031         case PRT_VAR:
1032         case PRT_SPACE:
1033           /* nothing to do */
1034           break;
1035         case PRT_ERROR:
1036           assert (0);
1037           break;
1038         }
1039       n = i->next;
1040       free (i);
1041     }
1042 #if !PAGED_STACK
1043   free (((struct print_trns *) t)->line);
1044 #endif
1045 }
1046 \f
1047 /* PRINT SPACE. */
1048
1049 /* PRINT SPACE transformation. */
1050 struct print_space_trns
1051 {
1052   struct trns_header h;
1053
1054   struct file_handle *handle;   /* Output file, NULL=listing file. */
1055   struct expression *e;         /* Number of lines; NULL=1. */
1056 }
1057 print_space_trns;
1058
1059 static int print_space_trns_proc (struct trns_header *, struct ccase *);
1060 static void print_space_trns_free (struct trns_header *);
1061
1062 int
1063 cmd_print_space (void)
1064 {
1065   struct print_space_trns *t;
1066   struct file_handle *handle;
1067   struct expression *e;
1068
1069   lex_match_id ("SPACE");
1070   if (lex_match_id ("OUTFILE"))
1071     {
1072       lex_match ('=');
1073
1074       if (token == T_ID)
1075         handle = fh_get_handle_by_name (tokid);
1076       else if (token == T_STRING)
1077         handle = fh_get_handle_by_filename (tokid);
1078       else
1079         {
1080           msg (SE, _("A file name or handle was expected in the "
1081                      "OUTFILE subcommand."));
1082           return CMD_FAILURE;
1083         }
1084
1085       if (!handle)
1086         return CMD_FAILURE;
1087       lex_get ();
1088     }
1089   else
1090     handle = NULL;
1091
1092   if (token != '.')
1093     {
1094       e = expr_parse (PXP_NUMERIC);
1095       if (token != '.')
1096         {
1097           expr_free (e);
1098           lex_error (_("expecting end of command"));
1099           return CMD_FAILURE;
1100         }
1101     }
1102   else
1103     e = NULL;
1104
1105   t = xmalloc (sizeof *t);
1106   t->h.proc = print_space_trns_proc;
1107   if (e)
1108     t->h.free = print_space_trns_free;
1109   else
1110     t->h.free = NULL;
1111   t->handle = handle;
1112   t->e = e;
1113
1114   add_transformation ((struct trns_header *) t);
1115   return CMD_SUCCESS;
1116 }
1117
1118 static int
1119 print_space_trns_proc (struct trns_header * trns, struct ccase * c)
1120 {
1121   struct print_space_trns *t = (struct print_space_trns *) trns;
1122   int n;
1123
1124   if (t->e)
1125     {
1126       union value v;
1127
1128       expr_evaluate (t->e, c, &v);
1129       n = v.f;
1130       if (n < 0)
1131         {
1132           msg (SW, _("The expression on PRINT SPACE evaluated to %d.  It's "
1133                      "not possible to PRINT SPACE a negative number of "
1134                      "lines."),
1135                n);
1136           n = 1;
1137         }
1138     }
1139   else
1140     n = 1;
1141
1142   if (t->handle == NULL)
1143     while (n--)
1144       som_blank_line ();
1145   else
1146     {
1147       char buf[LINE_END_WIDTH];
1148
1149       /* PORTME: Line ends. */
1150 #if __MSDOS__
1151       buf[0] = '\r';
1152       buf[1] = '\n';
1153 #else
1154       buf[0] = '\n';
1155 #endif
1156       while (n--)
1157         dfm_put_record (t->handle, buf, LINE_END_WIDTH);
1158     }
1159
1160   return -1;
1161 }
1162
1163 static void
1164 print_space_trns_free (struct trns_header * trns)
1165 {
1166   expr_free (((struct print_space_trns *) trns)->e);
1167 }
1168 \f
1169 /* Debugging code. */
1170
1171 #if 0 && DEBUGGING
1172 void
1173 debug_print (void)
1174 {
1175   struct prt_out_spec *p;
1176
1177   if (prt.handle == NULL)
1178     {
1179       printf ("PRINT");
1180       if (prt.eject)
1181         printf (" EJECT");
1182     }
1183   else
1184     printf ("WRITE OUTFILE=%s", handle_name (prt.handle));
1185   printf (" MAX_WIDTH=%d", prt.max_width);
1186   printf (" /");
1187   for (p = prt.spec; p; p = p->next)
1188     switch (p->type)
1189       {
1190       case PRT_ERROR:
1191         printf (_("<ERROR>"));
1192         break;
1193       case PRT_NEWLINE:
1194         printf ("\n /");
1195         break;
1196       case PRT_CONST:
1197         printf (" \"%s\" %d-%d", p->u.c, p->fc + 1, p->fc + strlen (p->u.c));
1198         break;
1199       case PRT_VAR:
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));
1202         break;
1203       case PRT_SPACE:
1204         printf (" \" \" %d", p->fc + 1);
1205         break;
1206       }
1207   printf (".\n");
1208 }
1209 #endif /* DEBUGGING */