Change license from GPLv2+ to GPLv3+.
[pspp-builds.git] / src / data / sys-file-writer.c
1 /* PSPP - a program for statistical analysis.
2    Copyright (C) 1997-9, 2000, 2006 Free Software Foundation, Inc.
3
4    This program is free software: you can redistribute it and/or modify
5    it under the terms of the GNU General Public License as published by
6    the Free Software Foundation, either version 3 of the License, or
7    (at your option) any later version.
8
9    This program is distributed in the hope that it will be useful,
10    but WITHOUT ANY WARRANTY; without even the implied warranty of
11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12    GNU General Public License for more details.
13
14    You should have received a copy of the GNU General Public License
15    along with this program.  If not, see <http://www.gnu.org/licenses/>. */
16
17 #include <config.h>
18
19 #include "sys-file-writer.h"
20 #include "sys-file-private.h"
21
22 #include <ctype.h>
23 #include <errno.h>
24 #include <fcntl.h>
25 #include <stdlib.h>
26 #include <sys/stat.h>
27 #include <time.h>
28 #include <unistd.h>
29
30 #include <libpspp/alloc.h>
31 #include <libpspp/hash.h>
32 #include <libpspp/magic.h>
33 #include <libpspp/message.h>
34 #include <libpspp/misc.h>
35 #include <libpspp/str.h>
36 #include <libpspp/version.h>
37
38 #include <data/case.h>
39 #include <data/casewriter-provider.h>
40 #include <data/casewriter.h>
41 #include <data/dictionary.h>
42 #include <data/file-handle-def.h>
43 #include <data/format.h>
44 #include <data/missing-values.h>
45 #include <data/settings.h>
46 #include <data/value-labels.h>
47 #include <data/variable.h>
48
49 #include "minmax.h"
50
51 #include "gettext.h"
52 #define _(msgid) gettext (msgid)
53
54 /* Find 64-bit floating-point type. */
55 #if SIZEOF_FLOAT == 8
56   #define flt64 float
57   #define FLT64_MAX FLT_MAX
58 #elif SIZEOF_DOUBLE == 8
59   #define flt64 double
60   #define FLT64_MAX DBL_MAX
61 #elif SIZEOF_LONG_DOUBLE == 8
62   #define flt64 long double
63   #define FLT64_MAX LDBL_MAX
64 #else
65   #error Which one of your basic types is 64-bit floating point?
66 #endif
67
68 /* Figure out SYSMIS value for flt64. */
69 #include <libpspp/magic.h>
70 #if SIZEOF_DOUBLE == 8
71 #define second_lowest_flt64 second_lowest_value
72 #else
73 #error Must define second_lowest_flt64 for your architecture.
74 #endif
75
76 /* Record Type 1: General Information. */
77 struct sysfile_header
78   {
79     char rec_type[4] ;          /* 00: Record-type code, "$FL2". */
80     char prod_name[60] ;        /* 04: Product identification. */
81     int32_t layout_code ;       /* 40: 2. */
82     int32_t nominal_case_size ; /* 44: Number of `value's per case.
83                                    Note: some systems set this to -1 */
84     int32_t compress ;          /* 48: 1=compressed, 0=not compressed. */
85     int32_t weight_idx ;         /* 4c: 1-based index of weighting var, or 0. */
86     int32_t case_cnt ;          /* 50: Number of cases, -1 if unknown. */
87     flt64 bias ;                /* 54: Compression bias (100.0). */
88     char creation_date[9] ;     /* 5c: `dd mmm yy' creation date of file. */
89     char creation_time[8] ;     /* 65: `hh:mm:ss' 24-hour creation time. */
90     char file_label[64] ;       /* 6d: File label. */
91     char padding[3] ;           /* ad: Ignored padding. */
92   } ATTRIBUTE((packed)) ;
93
94 /* Record Type 2: Variable. */
95 struct sysfile_variable
96   {
97     int32_t rec_type ;          /* 2. */
98     int32_t type ;              /* 0=numeric, 1-255=string width,
99                                    -1=continued string. */
100     int32_t has_var_label ;     /* 1=has a variable label, 0=doesn't. */
101     int32_t n_missing_values ;  /* Missing value code of -3,-2,0,1,2, or 3. */
102     int32_t print ;             /* Print format. */
103     int32_t write ;             /* Write format. */
104     char name[SHORT_NAME_LEN] ; /* Variable name. */
105     /* The rest of the structure varies. */
106   } ATTRIBUTE((packed)) ;
107
108 /* Compression bias used by PSPP.  Values between (1 -
109    COMPRESSION_BIAS) and (251 - COMPRESSION_BIAS) inclusive can be
110    compressed. */
111 #define COMPRESSION_BIAS 100
112
113 /* System file writer. */
114 struct sfm_writer
115   {
116     struct file_handle *fh;     /* File handle. */
117     FILE *file;                 /* File stream. */
118
119     int needs_translation;      /* 0=use fast path, 1=translation needed. */
120     int compress;               /* 1=compressed, 0=not compressed. */
121     int case_cnt;               /* Number of cases written so far. */
122     size_t flt64_cnt;           /* Number of flt64 elements in case. */
123     bool has_vls;               /* Does the dict have very long strings? */
124
125     /* Compression buffering. */
126     flt64 *buf;                 /* Buffered data. */
127     flt64 *end;                 /* Buffer end. */
128     flt64 *ptr;                 /* Current location in buffer. */
129     unsigned char *x;           /* Location in current instruction octet. */
130     unsigned char *y;           /* End of instruction octet. */
131
132     /* Variables. */
133     struct sfm_var *vars;       /* Variables. */
134     size_t var_cnt;             /* Number of variables. */
135     size_t var_cnt_vls;         /* Number of variables including
136                                    very long string components. */
137   };
138
139 /* A variable in a system file. */
140 struct sfm_var
141   {
142     int width;                  /* 0=numeric, otherwise string width. */
143     int fv;                     /* Index into case. */
144     size_t flt64_cnt;           /* Number of flt64 elements. */
145   };
146
147 static struct casewriter_class sys_file_casewriter_class;
148
149 static char *append_string_max (char *, const char *, const char *);
150 static void write_header (struct sfm_writer *, const struct dictionary *);
151 static void buf_write (struct sfm_writer *, const void *, size_t);
152 static void write_variable (struct sfm_writer *, const struct variable *);
153 static void write_value_labels (struct sfm_writer *,
154                                 struct variable *, int idx);
155 static void write_rec_7_34 (struct sfm_writer *);
156
157 static void write_longvar_table (struct sfm_writer *w,
158                                  const struct dictionary *dict);
159
160 static void write_vls_length_table (struct sfm_writer *w,
161                               const struct dictionary *dict);
162
163
164 static void write_variable_display_parameters (struct sfm_writer *w,
165                                                const struct dictionary *dict);
166
167 static void write_documents (struct sfm_writer *, const struct dictionary *);
168
169 bool write_error (const struct sfm_writer *);
170 bool close_writer (struct sfm_writer *);
171
172 static inline int
173 var_flt64_cnt (const struct variable *v)
174 {
175   assert(sizeof(flt64) == MAX_SHORT_STRING);
176   return sfm_width_to_bytes(var_get_width (v)) / MAX_SHORT_STRING ;
177 }
178
179 static inline int
180 var_flt64_cnt_nom (const struct variable *v)
181 {
182   return (var_is_numeric (v)
183           ? 1 : DIV_RND_UP (var_get_width (v), sizeof (flt64)));
184 }
185
186
187 /* Returns default options for writing a system file. */
188 struct sfm_write_options
189 sfm_writer_default_options (void)
190 {
191   struct sfm_write_options opts;
192   opts.create_writeable = true;
193   opts.compress = get_scompression ();
194   opts.version = 3;
195   return opts;
196 }
197
198
199 /* Return a short variable name to be used as the continuation of the
200    variable with the short name SN.
201
202    FIXME: Need to resolve clashes somehow.
203
204  */
205 static const char *
206 cont_var_name(const char *sn, int idx)
207 {
208   static char s[SHORT_NAME_LEN + 1];
209
210   char abb[SHORT_NAME_LEN + 1 - 3]= {0};
211
212   strncpy(abb, sn, SHORT_NAME_LEN - 3);
213
214   snprintf(s, SHORT_NAME_LEN + 1, "%s%03d", abb, idx);
215
216   return s;
217 }
218
219
220 /* Opens the system file designated by file handle FH for writing
221    cases from dictionary D according to the given OPTS.  If
222    COMPRESS is nonzero, the system file will be compressed.
223
224    No reference to D is retained, so it may be modified or
225    destroyed at will after this function returns.  D is not
226    modified by this function, except to assign short names. */
227 struct casewriter *
228 sfm_open_writer (struct file_handle *fh, struct dictionary *d,
229                  struct sfm_write_options opts)
230 {
231   struct sfm_writer *w = NULL;
232   mode_t mode;
233   int fd;
234   int idx;
235   int i;
236
237   /* Check version. */
238   if (opts.version != 2 && opts.version != 3)
239     {
240       msg (ME, _("Unknown system file version %d. Treating as version %d."),
241            opts.version, 3);
242       opts.version = 3;
243     }
244
245   /* Create file. */
246   mode = S_IRUSR | S_IRGRP | S_IROTH;
247   if (opts.create_writeable)
248     mode |= S_IWUSR | S_IWGRP | S_IWOTH;
249   fd = open (fh_get_file_name (fh), O_WRONLY | O_CREAT | O_TRUNC, mode);
250   if (fd < 0)
251     goto open_error;
252
253   /* Open file handle. */
254   if (!fh_open (fh, FH_REF_FILE, "system file", "we"))
255     goto error;
256
257   /* Create and initialize writer. */
258   w = xmalloc (sizeof *w);
259   w->fh = fh;
260   w->file = fdopen (fd, "w");
261
262   w->needs_translation = dict_compacting_would_change (d);
263   w->compress = opts.compress;
264   w->case_cnt = 0;
265   w->flt64_cnt = 0;
266   w->has_vls = false;
267
268   w->buf = w->end = w->ptr = NULL;
269   w->x = w->y = NULL;
270
271   w->var_cnt = dict_get_var_cnt (d);
272   w->var_cnt_vls = w->var_cnt;
273   w->vars = xnmalloc (w->var_cnt, sizeof *w->vars);
274   for (i = 0; i < w->var_cnt; i++)
275     {
276       const struct variable *dv = dict_get_var (d, i);
277       struct sfm_var *sv = &w->vars[i];
278       sv->width = var_get_width (dv);
279       /* spss compatibility nonsense */
280       if ( var_get_width (dv) >= MIN_VERY_LONG_STRING )
281           w->has_vls = true;
282
283       sv->fv = var_get_case_index (dv);
284       sv->flt64_cnt = var_flt64_cnt (dv);
285     }
286
287   /* Check that file create succeeded. */
288   if (w->file == NULL)
289     {
290       close (fd);
291       goto open_error;
292     }
293
294   /* Write the file header. */
295   write_header (w, d);
296
297   /* Write basic variable info. */
298   dict_assign_short_names (d);
299   for (i = 0; i < dict_get_var_cnt (d); i++)
300     {
301       int count = 0;
302       const struct variable *v = dict_get_var(d, i);
303       int wcount = var_get_width (v);
304
305       do {
306         struct variable *var_cont = var_clone (v);
307         var_set_short_name (var_cont, var_get_short_name (v));
308         if ( var_is_alpha (v))
309           {
310             if ( 0 != count )
311               {
312                 var_clear_missing_values (var_cont);
313                 var_set_short_name (var_cont,
314                                     cont_var_name (var_get_short_name (v),
315                                                    count));
316                 var_clear_label (var_cont);
317                 w->var_cnt_vls++;
318               }
319             count++;
320             if ( wcount >= MIN_VERY_LONG_STRING )
321               {
322                 var_set_width (var_cont, MIN_VERY_LONG_STRING - 1);
323                 wcount -= EFFECTIVE_LONG_STRING_LENGTH;
324               }
325             else
326               {
327                 var_set_width (var_cont, wcount);
328                 wcount -= var_get_width (var_cont);
329               }
330           }
331
332         write_variable (w, var_cont);
333         var_destroy (var_cont);
334       } while(wcount > 0);
335     }
336
337   /* Write out value labels. */
338   for (idx = i = 0; i < dict_get_var_cnt (d); i++)
339     {
340       struct variable *v = dict_get_var (d, i);
341
342       write_value_labels (w, v, idx);
343       idx += var_flt64_cnt (v);
344     }
345
346   if (dict_get_documents (d) != NULL)
347     write_documents (w, d);
348
349   write_rec_7_34 (w);
350
351   write_variable_display_parameters (w, d);
352
353   if (opts.version >= 3)
354     write_longvar_table (w, d);
355
356   write_vls_length_table(w, d);
357
358   /* Write end-of-headers record. */
359   {
360     struct
361       {
362         int32_t rec_type ;
363         int32_t filler ;
364     } ATTRIBUTE((packed))
365     rec_999;
366
367     rec_999.rec_type = 999;
368     rec_999.filler = 0;
369
370     buf_write (w, &rec_999, sizeof rec_999);
371   }
372
373   if (w->compress)
374     {
375       w->buf = xnmalloc (128, sizeof *w->buf);
376       w->ptr = w->buf;
377       w->end = &w->buf[128];
378       w->x = (unsigned char *) w->ptr++;
379       w->y = (unsigned char *) w->ptr;
380     }
381
382   if (write_error (w))
383     goto error;
384
385   return casewriter_create (&sys_file_casewriter_class, w);
386
387  error:
388   close_writer (w);
389   return NULL;
390
391  open_error:
392   msg (ME, _("Error opening \"%s\" for writing as a system file: %s."),
393        fh_get_file_name (fh), strerror (errno));
394   goto error;
395 }
396
397 /* Returns value of X truncated to two least-significant digits. */
398 static int
399 rerange (int x)
400 {
401   if (x < 0)
402     x = -x;
403   if (x >= 100)
404     x %= 100;
405   return x;
406 }
407
408 /* Write the sysfile_header header to system file W. */
409 static void
410 write_header (struct sfm_writer *w, const struct dictionary *d)
411 {
412   struct sysfile_header hdr;
413   char *p;
414   int i;
415
416   time_t t;
417
418   memcpy (hdr.rec_type, "$FL2", 4);
419
420   p = stpcpy (hdr.prod_name, "@(#) SPSS DATA FILE ");
421   p = append_string_max (p, version, &hdr.prod_name[60]);
422   p = append_string_max (p, " - ", &hdr.prod_name[60]);
423   p = append_string_max (p, host_system, &hdr.prod_name[60]);
424   memset (p, ' ', &hdr.prod_name[60] - p);
425
426   hdr.layout_code = 2;
427
428   w->flt64_cnt = 0;
429   for (i = 0; i < dict_get_var_cnt (d); i++)
430     {
431       w->flt64_cnt += var_flt64_cnt (dict_get_var (d, i));
432     }
433   hdr.nominal_case_size = w->flt64_cnt;
434
435   hdr.compress = w->compress;
436
437   if (dict_get_weight (d) != NULL)
438     {
439       const struct variable *weight_var;
440       int recalc_weight_idx = 1;
441       int i;
442
443       weight_var = dict_get_weight (d);
444       for (i = 0; ; i++)
445         {
446           struct variable *v = dict_get_var (d, i);
447           if (v == weight_var)
448             break;
449           recalc_weight_idx += var_flt64_cnt (v);
450         }
451       hdr.weight_idx = recalc_weight_idx;
452     }
453   else
454     hdr.weight_idx = 0;
455
456   hdr.case_cnt = -1;
457   hdr.bias = COMPRESSION_BIAS;
458
459   if (time (&t) == (time_t) -1)
460     {
461       memcpy (hdr.creation_date, "01 Jan 70", 9);
462       memcpy (hdr.creation_time, "00:00:00", 8);
463     }
464   else
465     {
466       static const char *month_name[12] =
467         {
468           "Jan", "Feb", "Mar", "Apr", "May", "Jun",
469           "Jul", "Aug", "Sep", "Oct", "Nov", "Dec",
470         };
471       struct tm *tmp = localtime (&t);
472       int day = rerange (tmp->tm_mday);
473       int mon = rerange (tmp->tm_mon + 1);
474       int year = rerange (tmp->tm_year);
475       int hour = rerange (tmp->tm_hour + 1);
476       int min = rerange (tmp->tm_min + 1);
477       int sec = rerange (tmp->tm_sec + 1);
478       char buf[10];
479
480       sprintf (buf, "%02d %s %02d", day, month_name[mon - 1], year);
481       memcpy (hdr.creation_date, buf, sizeof hdr.creation_date);
482       sprintf (buf, "%02d:%02d:%02d", hour - 1, min - 1, sec - 1);
483       memcpy (hdr.creation_time, buf, sizeof hdr.creation_time);
484     }
485
486   {
487     const char *label = dict_get_label (d);
488     if (label == NULL)
489       label = "";
490
491     buf_copy_str_rpad (hdr.file_label, sizeof hdr.file_label, label);
492   }
493
494   memset (hdr.padding, 0, sizeof hdr.padding);
495
496   buf_write (w, &hdr, sizeof hdr);
497 }
498
499 /* Translates format spec from internal form in SRC to system file
500    format in DEST. */
501 static inline void
502 write_format_spec (const struct fmt_spec *src, int32_t *dest)
503 {
504   assert (fmt_check_output (src));
505   *dest = (fmt_to_io (src->type) << 16) | (src->w << 8) | src->d;
506 }
507
508 /* Write the variable record(s) for primary variable P and secondary
509    variable S to system file W. */
510 static void
511 write_variable (struct sfm_writer *w, const struct variable *v)
512 {
513   struct sysfile_variable sv;
514
515   /* Missing values. */
516   struct missing_values mv;
517   flt64 m[3];           /* Missing value values. */
518   int nm;               /* Number of missing values, possibly negative. */
519   const char *label = var_get_label (v);
520
521   sv.rec_type = 2;
522   sv.type = MIN (var_get_width (v), MIN_VERY_LONG_STRING - 1);
523   sv.has_var_label = label != NULL;
524
525   mv_copy (&mv, var_get_missing_values (v));
526   nm = 0;
527   if (mv_has_range (&mv))
528     {
529       double x, y;
530       mv_pop_range (&mv, &x, &y);
531       m[nm++] = x == LOWEST ? second_lowest_flt64 : x;
532       m[nm++] = y == HIGHEST ? FLT64_MAX : y;
533     }
534   while (mv_has_value (&mv))
535     {
536       union value value;
537       mv_pop_value (&mv, &value);
538       if (var_is_numeric (v))
539         m[nm] = value.f;
540       else
541         buf_copy_rpad ((char *) &m[nm], sizeof m[nm], value.s,
542                        var_get_width (v));
543       nm++;
544     }
545   if (mv_has_range (var_get_missing_values (v)))
546     nm = -nm;
547
548   sv.n_missing_values = nm;
549   write_format_spec (var_get_print_format (v), &sv.print);
550   write_format_spec (var_get_write_format (v), &sv.write);
551   buf_copy_str_rpad (sv.name, sizeof sv.name, var_get_short_name (v));
552   buf_write (w, &sv, sizeof sv);
553
554   if (label != NULL)
555     {
556       struct label
557         {
558           int32_t label_len ;
559           char label[255] ;
560       } ATTRIBUTE((packed))
561       l;
562
563       int ext_len;
564
565       l.label_len = MIN (strlen (label), 255);
566       ext_len = ROUND_UP (l.label_len, sizeof l.label_len);
567       memcpy (l.label, label, l.label_len);
568       memset (&l.label[l.label_len], ' ', ext_len - l.label_len);
569
570       buf_write (w, &l, offsetof (struct label, label) + ext_len);
571     }
572
573   if (nm)
574     buf_write (w, m, sizeof *m * abs (nm));
575
576   if (var_is_alpha (v) && var_get_width (v) > (int) sizeof (flt64))
577     {
578       int i;
579       int pad_count;
580
581       sv.type = -1;
582       sv.has_var_label = 0;
583       sv.n_missing_values = 0;
584       memset (&sv.print, 0, sizeof sv.print);
585       memset (&sv.write, 0, sizeof sv.write);
586       memset (&sv.name, 0, sizeof sv.name);
587
588       pad_count = DIV_RND_UP (MIN(var_get_width (v), MIN_VERY_LONG_STRING - 1),
589                               (int) sizeof (flt64)) - 1;
590       for (i = 0; i < pad_count; i++)
591         buf_write (w, &sv, sizeof sv);
592     }
593 }
594
595 /* Writes the value labels for variable V having system file
596    variable index IDX to system file W. */
597 static void
598 write_value_labels (struct sfm_writer *w, struct variable *v, int idx)
599 {
600   struct value_label_rec
601     {
602       int32_t rec_type ;
603       int32_t n_labels ;
604       flt64 labels[1] ;
605     } ATTRIBUTE((packed));
606
607   struct var_idx_rec
608     {
609       int32_t rec_type ;
610       int32_t n_vars ;
611       int32_t vars[1] ;
612     } ATTRIBUTE((packed));
613
614   const struct val_labs *val_labs;
615   struct val_labs_iterator *i;
616   struct value_label_rec *vlr;
617   struct var_idx_rec vir;
618   struct val_lab *vl;
619   size_t vlr_size;
620   flt64 *loc;
621
622   val_labs = var_get_value_labels (v);
623   if (val_labs == NULL)
624     return;
625
626   /* Pass 1: Count bytes. */
627   vlr_size = (sizeof (struct value_label_rec)
628               + sizeof (flt64) * (val_labs_count (val_labs) - 1));
629   for (vl = val_labs_first (val_labs, &i); vl != NULL;
630        vl = val_labs_next (val_labs, &i))
631     vlr_size += ROUND_UP (strlen (vl->label) + 1, sizeof (flt64));
632
633   /* Pass 2: Copy bytes. */
634   vlr = xmalloc (vlr_size);
635   vlr->rec_type = 3;
636   vlr->n_labels = val_labs_count (val_labs);
637   loc = vlr->labels;
638   for (vl = val_labs_first_sorted (val_labs, &i); vl != NULL;
639        vl = val_labs_next (val_labs, &i))
640     {
641       size_t len = strlen (vl->label);
642
643       *loc++ = vl->value.f;
644       *(unsigned char *) loc = len;
645       memcpy (&((char *) loc)[1], vl->label, len);
646       memset (&((char *) loc)[1 + len], ' ',
647               REM_RND_UP (len + 1, sizeof (flt64)));
648       loc += DIV_RND_UP (len + 1, sizeof (flt64));
649     }
650
651   buf_write (w, vlr, vlr_size);
652   free (vlr);
653
654   vir.rec_type = 4;
655   vir.n_vars = 1;
656   vir.vars[0] = idx + 1;
657   buf_write (w, &vir, sizeof vir);
658 }
659
660 /* Writes record type 6, document record. */
661 static void
662 write_documents (struct sfm_writer *w, const struct dictionary *d)
663 {
664   struct
665   {
666     int32_t rec_type ;          /* Always 6. */
667     int32_t n_lines ;           /* Number of lines of documents. */
668   } ATTRIBUTE((packed)) rec_6;
669
670   const char * documents = dict_get_documents (d);
671   size_t doc_bytes = strlen (documents);
672
673   assert (doc_bytes % 80 == 0);
674
675   rec_6.rec_type = 6;
676   rec_6.n_lines = doc_bytes / 80;
677   buf_write (w, &rec_6, sizeof rec_6);
678   buf_write (w, documents, 80 * rec_6.n_lines);
679 }
680
681 /* Write the alignment, width and scale values */
682 static void
683 write_variable_display_parameters (struct sfm_writer *w,
684                                    const struct dictionary *dict)
685 {
686   int i;
687
688   struct
689   {
690     int32_t rec_type ;
691     int32_t subtype ;
692     int32_t elem_size ;
693     int32_t n_elem ;
694   } ATTRIBUTE((packed)) vdp_hdr;
695
696   vdp_hdr.rec_type = 7;
697   vdp_hdr.subtype = 11;
698   vdp_hdr.elem_size = 4;
699   vdp_hdr.n_elem = w->var_cnt_vls * 3;
700
701   buf_write (w, &vdp_hdr, sizeof vdp_hdr);
702
703   for ( i = 0 ; i < w->var_cnt ; ++i )
704     {
705       struct variable *v;
706       struct
707       {
708         int32_t measure ;
709         int32_t width ;
710         int32_t align ;
711       } ATTRIBUTE((packed)) params;
712
713       v = dict_get_var(dict, i);
714
715       params.measure = (var_get_measure (v) == MEASURE_NOMINAL ? 1
716                         : var_get_measure (v) == MEASURE_ORDINAL ? 2
717                         : 3);
718       params.width = var_get_display_width (v);
719       params.align = (var_get_alignment (v) == ALIGN_LEFT ? 0
720                       : var_get_alignment (v) == ALIGN_RIGHT ? 1
721                       : 2);
722
723       buf_write (w, &params, sizeof(params));
724
725       if (var_is_long_string (v))
726         {
727           int wcount = var_get_width (v) - EFFECTIVE_LONG_STRING_LENGTH ;
728
729           while (wcount > 0)
730             {
731               params.width = wcount >= MIN_VERY_LONG_STRING ? 32 : wcount;
732
733               buf_write (w, &params, sizeof(params));
734
735               wcount -= EFFECTIVE_LONG_STRING_LENGTH ;
736             }
737         }
738     }
739 }
740
741 /* Writes the table of lengths for Very Long String Variables */
742 static void
743 write_vls_length_table (struct sfm_writer *w,
744                         const struct dictionary *dict)
745 {
746   int i;
747   struct
748   {
749     int32_t rec_type ;
750     int32_t subtype ;
751     int32_t elem_size ;
752     int32_t n_elem ;
753   } ATTRIBUTE((packed)) vls_hdr;
754
755   struct string vls_length_map;
756
757   ds_init_empty (&vls_length_map);
758
759   vls_hdr.rec_type = 7;
760   vls_hdr.subtype = 14;
761   vls_hdr.elem_size = 1;
762
763
764   for (i = 0; i < dict_get_var_cnt (dict); ++i)
765     {
766       const struct variable *v = dict_get_var (dict, i);
767
768       if ( var_get_width (v) < MIN_VERY_LONG_STRING )
769         continue;
770
771       ds_put_format (&vls_length_map, "%s=%05d",
772                      var_get_short_name (v), var_get_width (v));
773       ds_put_char (&vls_length_map, '\0');
774       ds_put_char (&vls_length_map, '\t');
775     }
776
777   vls_hdr.n_elem = ds_length (&vls_length_map);
778
779   if ( vls_hdr.n_elem > 0 )
780     {
781       buf_write (w, &vls_hdr, sizeof vls_hdr);
782       buf_write (w, ds_data (&vls_length_map), ds_length (&vls_length_map));
783     }
784
785   ds_destroy (&vls_length_map);
786 }
787
788 /* Writes the long variable name table */
789 static void
790 write_longvar_table (struct sfm_writer *w, const struct dictionary *dict)
791 {
792   struct
793     {
794       int32_t rec_type ;
795       int32_t subtype ;
796       int32_t elem_size ;
797       int32_t n_elem ;
798   } ATTRIBUTE((packed)) lv_hdr;
799
800   struct string long_name_map;
801   size_t i;
802
803   ds_init_empty (&long_name_map);
804   for (i = 0; i < dict_get_var_cnt (dict); i++)
805     {
806       struct variable *v = dict_get_var (dict, i);
807
808       if (i)
809         ds_put_char (&long_name_map, '\t');
810       ds_put_format (&long_name_map, "%s=%s",
811                      var_get_short_name (v), var_get_name (v));
812     }
813
814   lv_hdr.rec_type = 7;
815   lv_hdr.subtype = 13;
816   lv_hdr.elem_size = 1;
817   lv_hdr.n_elem = ds_length (&long_name_map);
818
819   buf_write (w, &lv_hdr, sizeof lv_hdr);
820   buf_write (w, ds_data (&long_name_map), ds_length (&long_name_map));
821
822   ds_destroy (&long_name_map);
823 }
824
825 /* Writes record type 7, subtypes 3 and 4. */
826 static void
827 write_rec_7_34 (struct sfm_writer *w)
828 {
829   struct
830     {
831       int32_t rec_type_3 ;
832       int32_t subtype_3 ;
833       int32_t data_type_3 ;
834       int32_t n_elem_3 ;
835       int32_t elem_3[8] ;
836       int32_t rec_type_4 ;
837       int32_t subtype_4 ;
838       int32_t data_type_4 ;
839       int32_t n_elem_4 ;
840       flt64 elem_4[3] ;
841   } ATTRIBUTE((packed)) rec_7;
842
843   /* Components of the version number, from major to minor. */
844   int version_component[3];
845
846   /* Used to step through the version string. */
847   char *p;
848
849   /* Parses the version string, which is assumed to be of the form
850      #.#x, where each # is a string of digits, and x is a single
851      letter. */
852   version_component[0] = strtol (bare_version, &p, 10);
853   if (*p == '.')
854     p++;
855   version_component[1] = strtol (bare_version, &p, 10);
856   version_component[2] = (isalpha ((unsigned char) *p)
857                           ? tolower ((unsigned char) *p) - 'a' : 0);
858
859   rec_7.rec_type_3 = 7;
860   rec_7.subtype_3 = 3;
861   rec_7.data_type_3 = sizeof (int32_t);
862   rec_7.n_elem_3 = 8;
863   rec_7.elem_3[0] = version_component[0];
864   rec_7.elem_3[1] = version_component[1];
865   rec_7.elem_3[2] = version_component[2];
866   rec_7.elem_3[3] = -1;
867
868   /* PORTME: 1=IEEE754, 2=IBM 370, 3=DEC VAX E. */
869 #ifdef FPREP_IEEE754
870   rec_7.elem_3[4] = 1;
871 #endif
872
873   rec_7.elem_3[5] = 1;
874
875   /* PORTME: 1=big-endian, 2=little-endian. */
876 #if WORDS_BIGENDIAN
877   rec_7.elem_3[6] = 1;
878 #else
879   rec_7.elem_3[6] = 2;
880 #endif
881
882   /* PORTME: 1=EBCDIC, 2=7-bit ASCII, 3=8-bit ASCII, 4=DEC Kanji. */
883   rec_7.elem_3[7] = 2;
884
885   rec_7.rec_type_4 = 7;
886   rec_7.subtype_4 = 4;
887   rec_7.data_type_4 = sizeof (flt64);
888   rec_7.n_elem_4 = 3;
889   rec_7.elem_4[0] = -FLT64_MAX;
890   rec_7.elem_4[1] = FLT64_MAX;
891   rec_7.elem_4[2] = second_lowest_flt64;
892
893   buf_write (w, &rec_7, sizeof rec_7);
894 }
895
896 /* Write NBYTES starting at BUF to the system file represented by
897    H. */
898 static void
899 buf_write (struct sfm_writer *w, const void *buf, size_t nbytes)
900 {
901   assert (buf != NULL);
902   fwrite (buf, nbytes, 1, w->file);
903 }
904
905 /* Copies string DEST to SRC with the proviso that DEST does not reach
906    byte END; no null terminator is copied.  Returns a pointer to the
907    byte after the last byte copied. */
908 static char *
909 append_string_max (char *dest, const char *src, const char *end)
910 {
911   int nbytes = MIN (end - dest, (int) strlen (src));
912   memcpy (dest, src, nbytes);
913   return dest + nbytes;
914 }
915
916 /* Makes certain that the compression buffer of H has room for another
917    element.  If there's not room, pads out the current instruction
918    octet with zero and dumps out the buffer. */
919 static void
920 ensure_buf_space (struct sfm_writer *w)
921 {
922   if (w->ptr >= w->end)
923     {
924       memset (w->x, 0, w->y - w->x);
925       w->x = w->y;
926       w->ptr = w->buf;
927       buf_write (w, w->buf, sizeof *w->buf * 128);
928     }
929 }
930
931 static void write_compressed_data (struct sfm_writer *w, const flt64 *elem);
932
933 /* Writes case C to system file W. */
934 static void
935 sys_file_casewriter_write (struct casewriter *writer, void *w_,
936                            struct ccase *c)
937 {
938   struct sfm_writer *w = w_;
939   if (ferror (w->file))
940     {
941       casewriter_force_error (writer);
942       case_destroy (c);
943       return;
944     }
945
946   w->case_cnt++;
947
948   if (!w->needs_translation && !w->compress
949       && sizeof (flt64) == sizeof (union value) && ! w->has_vls )
950     {
951       /* Fast path: external and internal representations are the
952          same and the dictionary is properly ordered.  Write
953          directly to file. */
954       buf_write (w, case_data_all (c), sizeof (union value) * w->flt64_cnt);
955     }
956   else
957     {
958       /* Slow path: internal and external representations differ.
959          Write into a bounce buffer, then write to W. */
960       flt64 *bounce;
961       flt64 *bounce_cur;
962       flt64 *bounce_end;
963       size_t bounce_size;
964       size_t i;
965
966       bounce_size = sizeof *bounce * w->flt64_cnt;
967       bounce = bounce_cur = local_alloc (bounce_size);
968       bounce_end = bounce + bounce_size;
969
970       for (i = 0; i < w->var_cnt; i++)
971         {
972           struct sfm_var *v = &w->vars[i];
973
974           memset(bounce_cur, ' ', v->flt64_cnt * sizeof (flt64));
975
976           if (v->width == 0)
977             {
978               *bounce_cur = case_num_idx (c, v->fv);
979               bounce_cur += v->flt64_cnt;
980             }
981           else
982             { int ofs = 0;
983             while (ofs < v->width)
984               {
985                 int chunk = MIN (MIN_VERY_LONG_STRING - 1, v->width - ofs);
986                 int nv = DIV_RND_UP (chunk, sizeof (flt64));
987                 buf_copy_rpad ((char *) bounce_cur, nv * sizeof (flt64),
988                                case_data_idx (c, v->fv)->s + ofs, chunk);
989                 bounce_cur += nv;
990                 ofs += chunk;
991               }
992             }
993
994         }
995
996       if (!w->compress)
997         buf_write (w, bounce, bounce_size);
998       else
999         write_compressed_data (w, bounce);
1000
1001       local_free (bounce);
1002     }
1003
1004   case_destroy (c);
1005 }
1006
1007 static void
1008 sys_file_casewriter_destroy (struct casewriter *writer, void *w_)
1009 {
1010   struct sfm_writer *w = w_;
1011   if (!close_writer (w))
1012     casewriter_force_error (writer);
1013 }
1014
1015 static void
1016 put_instruction (struct sfm_writer *w, unsigned char instruction)
1017 {
1018   if (w->x >= w->y)
1019     {
1020       ensure_buf_space (w);
1021       w->x = (unsigned char *) w->ptr++;
1022       w->y = (unsigned char *) w->ptr;
1023     }
1024   *w->x++ = instruction;
1025 }
1026
1027 static void
1028 put_element (struct sfm_writer *w, const flt64 *elem)
1029 {
1030   ensure_buf_space (w);
1031   memcpy (w->ptr++, elem, sizeof *elem);
1032 }
1033
1034 static void
1035 write_compressed_data (struct sfm_writer *w, const flt64 *elem)
1036 {
1037   size_t i;
1038
1039   for (i = 0; i < w->var_cnt; i++)
1040     {
1041       struct sfm_var *v = &w->vars[i];
1042
1043       if (v->width == 0)
1044         {
1045           if (*elem == -FLT64_MAX)
1046             put_instruction (w, 255);
1047           else if (*elem >= 1 - COMPRESSION_BIAS
1048                    && *elem <= 251 - COMPRESSION_BIAS
1049                    && *elem == (int) *elem)
1050             put_instruction (w, (int) *elem + COMPRESSION_BIAS);
1051           else
1052             {
1053               put_instruction (w, 253);
1054               put_element (w, elem);
1055             }
1056           elem++;
1057         }
1058       else
1059         {
1060           size_t j;
1061
1062           for (j = 0; j < v->flt64_cnt; j++, elem++)
1063             {
1064               if (!memcmp (elem, "        ", sizeof (flt64)))
1065                 put_instruction (w, 254);
1066               else
1067                 {
1068                   put_instruction (w, 253);
1069                   put_element (w, elem);
1070                 }
1071             }
1072         }
1073     }
1074 }
1075
1076 /* Returns true if an I/O error has occurred on WRITER, false otherwise. */
1077 bool
1078 write_error (const struct sfm_writer *writer)
1079 {
1080   return ferror (writer->file);
1081 }
1082
1083 /* Closes a system file after we're done with it.
1084    Returns true if successful, false if an I/O error occurred. */
1085 bool
1086 close_writer (struct sfm_writer *w)
1087 {
1088   bool ok;
1089
1090   if (w == NULL)
1091     return true;
1092
1093   ok = true;
1094   if (w->file != NULL)
1095     {
1096       /* Flush buffer. */
1097       if (w->buf != NULL && w->ptr > w->buf)
1098         {
1099           memset (w->x, 0, w->y - w->x);
1100           buf_write (w, w->buf, (w->ptr - w->buf) * sizeof *w->buf);
1101         }
1102       fflush (w->file);
1103
1104       ok = !write_error (w);
1105
1106       /* Seek back to the beginning and update the number of cases.
1107          This is just a courtesy to later readers, so there's no need
1108          to check return values or report errors. */
1109       if (ok && !fseek (w->file, offsetof (struct sysfile_header, case_cnt),
1110                         SEEK_SET))
1111         {
1112           int32_t case_cnt = w->case_cnt;
1113           fwrite (&case_cnt, sizeof case_cnt, 1, w->file);
1114           clearerr (w->file);
1115         }
1116
1117       if (fclose (w->file) == EOF)
1118         ok = false;
1119
1120       if (!ok)
1121         msg (ME, _("An I/O error occurred writing system file \"%s\"."),
1122              fh_get_file_name (w->fh));
1123     }
1124
1125   fh_close (w->fh, "system file", "we");
1126
1127   free (w->buf);
1128   free (w->vars);
1129   free (w);
1130
1131   return ok;
1132 }
1133 \f
1134 static struct casewriter_class sys_file_casewriter_class =
1135   {
1136     sys_file_casewriter_write,
1137     sys_file_casewriter_destroy,
1138     NULL,
1139   };