d54ebd1f0d43ec5fb1eafbc70606e157190ab011
[pspp-builds.git] / src / data-out.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 #include <config.h>
21 #include <assert.h>
22 #include <ctype.h>
23 #include <math.h>
24 #include <float.h>
25 #include <stdlib.h>
26 #include <time.h>
27 #include "approx.h"
28 #include "error.h"
29 #include "format.h"
30 #include "julcal/julcal.h"
31 #include "magic.h"
32 #include "misc.h"
33 #include "misc.h"
34 #include "settings.h"
35 #include "str.h"
36 #include "var.h"
37
38 #undef DEBUGGING
39 /*#define DEBUGGING 1*/
40 #include "debug-print.h"
41
42 /* In older versions, numbers got their trailing zeros stripped.
43    Newer versions leave them on when there's room.  Comment this next
44    line out for retro styling. */
45 #define NEW_STYLE 1
46 \f
47 /* Public functions. */
48
49 typedef int convert_func (char *, const struct fmt_spec *,
50                           const union value *);
51
52 static convert_func convert_F, convert_N, convert_E, convert_F_plus;
53 static convert_func convert_Z, convert_A, convert_AHEX, convert_IB;
54 static convert_func convert_P, convert_PIB, convert_PIBHEX, convert_PK;
55 static convert_func convert_RB, convert_RBHEX, convert_CCx, convert_date;
56 static convert_func convert_time, convert_WKDAY, convert_MONTH;
57 static convert_func try_F;
58
59 /* Converts binary value V into printable form in string S according
60    to format specification FP.  The string as written has exactly
61    FP->W characters.  It is not null-terminated.  Returns 1 on
62    success, 0 on failure. */
63 int
64 data_out (char *s, const struct fmt_spec *fp, const union value *v)
65 {
66   union value tmp_val;
67   
68   {
69     int cat = formats[fp->type].cat;
70     if ((cat & FCAT_BLANKS_SYSMIS) && v->f == SYSMIS)
71       {
72         memset (s, ' ', fp->w);
73         s[fp->w - fp->d - 1] = '.';
74         return 1;
75       }
76     if ((cat & FCAT_SHIFT_DECIMAL) && v->f != SYSMIS && fp->d)
77       {
78         tmp_val.f = v->f * pow (10.0, fp->d);
79         v = &tmp_val;
80       }
81   }
82   
83   {
84     static convert_func *const handlers[FMT_NUMBER_OF_FORMATS] =
85       {
86         convert_F, convert_N, convert_E, convert_F_plus,
87         convert_F_plus, convert_F_plus, convert_F_plus,
88         convert_Z, convert_A, convert_AHEX, convert_IB, convert_P, convert_PIB,
89         convert_PIBHEX, convert_PK, convert_RB, convert_RBHEX,
90         convert_CCx, convert_CCx, convert_CCx, convert_CCx, convert_CCx,
91         convert_date, convert_date, convert_date, convert_date, convert_date,
92         convert_date, convert_date, convert_date, convert_date,
93         convert_time, convert_time,
94         convert_WKDAY, convert_MONTH,
95       };
96
97     return handlers[fp->type] (s, fp, v);
98   }
99 }
100
101 /* Converts V into S in F format with width W and D decimal places,
102    then deletes trailing zeros.  S is not null-terminated. */
103 void
104 num_to_string (double v, char *s, int w, int d)
105 {
106   /* Dummies to pass to convert_F. */
107   union value val;
108   struct fmt_spec f;
109
110 #if !NEW_STYLE
111   /* Pointer to `.' in S. */
112   char *decp;
113
114   /* Pointer to `E' in S. */
115   char *expp;
116
117   /* Number of characters to delete. */
118   int n = 0;
119 #endif
120
121   f.w = w;
122   f.d = d;
123   val.f = v;
124
125   /* Cut out the jokers. */
126   if (!finite (v))
127     {
128       char temp[9];
129       int len;
130
131       if (isnan (v))
132         {
133           memcpy (temp, "NaN", 3);
134           len = 3;
135         }
136       else if (isinf (v))
137         {
138           memcpy (temp, "+Infinity", 9);
139           if (v < 0)
140             temp[0] = '-';
141           len = 9;
142         }
143       else
144         {
145           memcpy (temp, _("Unknown"), 7);
146           len = 7;
147         }
148       if (w > len)
149         {
150           int pad = w - len;
151           memset (s, ' ', pad);
152           s += pad;
153           w -= pad;
154         }
155       memcpy (s, temp, w);
156       return;
157     }
158
159   try_F (s, &f, &val);
160
161 #if !NEW_STYLE
162   decp = memchr (s, set_decimal, w);
163   if (!decp)
164     return;
165
166   /* If there's an `E' we can only delete 0s before the E. */
167   expp = memchr (s, 'E', w);
168   if (expp)
169     {
170       while (expp[-n - 1] == '0')
171         n++;
172       if (expp[-n - 1] == set_decimal)
173         n++;
174       memmove (&s[n], s, expp - s - n);
175       memset (s, ' ', n);
176       return;
177     }
178
179   /* Otherwise delete all trailing 0s. */
180   n++;
181   while (s[w - n] == '0')
182     n++;
183   if (s[w - n] != set_decimal)
184     {
185       /* Avoid stripping `.0' to `'. */
186       if (w == n || !isdigit ((unsigned char) s[w - n - 1]))
187         n -= 2;
188     }
189   else
190     n--;
191   memmove (&s[n], s, w - n);
192   memset (s, ' ', n);
193 #endif
194 }
195 \f
196 /* Main conversion functions. */
197
198 static void insert_commas (char *dst, const char *src,
199                            const struct fmt_spec *fp);
200 static int year4 (int year);
201 static int try_CCx (char *s, const struct fmt_spec *fp, double v);
202
203 #if FLT_RADIX!=2
204 #error Write your own floating-point output routines.
205 #endif
206
207 /* PORTME:
208
209    Some of the routines in this file are likely very specific to
210    base-2 representation of floating-point numbers, most notably the
211    routines that use frexp() or ldexp().  These attempt to extract
212    individual digits by setting the base-2 exponent and
213    multiplying/dividing by powers of 2.  In base-2 numeration systems,
214    this just nudges the exponent up or down, but in base-10 floating
215    point, such multiplications/division can cause catastrophic loss of
216    precision.
217
218    The author has never personally used a machine that didn't use
219    binary floating point formats, so he is unwilling, and perhaps
220    unable, to code around this "problem".  */
221
222 /* Converts a number between 0 and 15 inclusive to a `hexit'
223    [0-9A-F]. */
224 #define MAKE_HEXIT(X) ("0123456789ABCDEF"[X])
225
226 /* Table of powers of 10. */
227 static const double power10[] =
228   {
229     0,  /* Not used. */
230     1e01, 1e02, 1e03, 1e04, 1e05, 1e06, 1e07, 1e08, 1e09, 1e10,
231     1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19, 1e20,
232     1e21, 1e22, 1e23, 1e24, 1e25, 1e26, 1e27, 1e28, 1e29, 1e30,
233     1e31, 1e32, 1e33, 1e34, 1e35, 1e36, 1e37, 1e38, 1e39, 1e40,
234   };
235
236 /* Handles F format. */
237 static int
238 convert_F (char *dst, const struct fmt_spec *fp, const union value *v)
239 {
240   if (!try_F (dst, fp, v))
241     convert_E (dst, fp, v);
242   return 1;
243 }
244
245 /* Handles N format. */
246 static int
247 convert_N (char *dst, const struct fmt_spec *fp, const union value *v)
248 {
249   double d = floor (v->f);
250
251   if (d < 0 || d == SYSMIS)
252     {
253       msg (ME, _("The N output format cannot be used to output a "
254                  "negative number or the system-missing value."));
255       return 0;
256     }
257   
258   if (d < power10[fp->w])
259     {
260       char buf[128];
261       sprintf (buf, "%0*.0f", fp->w, v->f);
262       memcpy (dst, buf, fp->w);
263     }
264   else
265     memset (dst, '*', fp->w);
266
267   return 1;
268 }
269
270 /* Handles E format.  Also operates as fallback for some other
271    formats. */
272 static int
273 convert_E (char *dst, const struct fmt_spec *fp, const union value *v)
274 {
275   /* Temporary buffer. */
276   char buf[128];
277   
278   /* Ranged number of decimal places. */
279   int d;
280
281   /* Check that the format is width enough.
282      Although PSPP generally checks this, convert_E() can be called as
283      a fallback from other formats which do not check. */
284   if (fp->w < 6)
285     {
286       memset (dst, '*', fp->w);
287       return 1;
288     }
289
290   /* Put decimal places in usable range. */
291   d = min (fp->d, fp->w - 6);
292   if (v->f < 0)
293     d--;
294   if (d < 0)
295     d = 0;
296   sprintf (buf, "%*.*E", fp->w, d, v->f);
297
298   /* What we do here is force the exponent part to have four
299      characters whenever possible.  That is, 1.00E+99 is okay (`E+99')
300      but 1.00E+100 (`E+100') must be coerced to 1.00+100 (`+100').  On
301      the other hand, 1.00E1000 (`E+100') cannot be canonicalized.
302      Note that ANSI C guarantees at least two digits in the
303      exponent. */
304   if (fabs (v->f) > 1e99)
305     {
306       /* Pointer to the `E' in buf. */
307       char *cp;
308
309       cp = strchr (buf, 'E');
310       if (cp)
311         {
312           /* Exponent better not be bigger than an int. */
313           int exp = atoi (cp + 1); 
314
315           if (abs (exp) > 99 && abs (exp) < 1000)
316             {
317               /* Shift everything left one place: 1.00e+100 -> 1.00+100. */
318               cp[0] = cp[1];
319               cp[1] = cp[2];
320               cp[2] = cp[3];
321               cp[3] = cp[4];
322             }
323           else if (abs (exp) >= 1000)
324             memset (buf, '*', fp->w);
325         }
326     }
327
328   /* The C locale always uses a period `.' as a decimal point.
329      Translate to comma if necessary. */
330   if ((set_decimal == ',' && fp->type != FMT_DOT)
331       || (set_decimal == '.' && fp->type == FMT_DOT))
332     {
333       char *cp = strchr (buf, '.');
334       if (cp)
335         *cp = ',';
336     }
337
338   memcpy (dst, buf, fp->w);
339   return 1;
340 }
341
342 /* Handles COMMA, DOT, DOLLAR, and PCT formats. */
343 static int
344 convert_F_plus (char *dst, const struct fmt_spec *fp, const union value *v)
345 {
346   char buf[40];
347   
348   if (try_F (buf, fp, v))
349     insert_commas (dst, buf, fp);
350   else
351     convert_E (dst, fp, v);
352
353   return 1;
354 }
355
356 static int
357 convert_Z (char *dst, const struct fmt_spec *fp, const union value *v)
358 {
359   static int warned = 0;
360
361   if (!warned)
362     {
363       msg (MW, _("Quality of zoned decimal (Z) output format code is "
364                  "suspect.  Check your results, report bugs to author."));
365       warned = 1;
366     }
367
368   if (v->f == SYSMIS)
369     {
370       msg (ME, _("The system-missing value cannot be output as a zoned "
371                  "decimal number."));
372       return 0;
373     }
374   
375   {
376     char buf[41];
377     double d;
378     int i;
379     
380     d = fabs (floor (v->f));
381     if (d >= power10[fp->w])
382       {
383         msg (ME, _("Number %g too big to fit in field with format Z%d.%d."),
384              v->f, fp->w, fp->d);
385         return 0;
386       }
387
388     sprintf (buf, "%*.0f", fp->w, v->f);
389     for (i = 0; i < fp->w; i++)
390       dst[i] = (buf[i] - '0') | 0xf0;
391     if (v->f < 0)
392       dst[fp->w - 1] &= 0xdf;
393   }
394
395   return 1;
396 }
397
398 static int
399 convert_A (char *dst, const struct fmt_spec *fp, const union value *v)
400 {
401   memcpy (dst, v->c, fp->w);
402   return 1;
403 }
404
405 static int
406 convert_AHEX (char *dst, const struct fmt_spec *fp, const union value *v)
407 {
408   int i;
409
410   for (i = 0; i < fp->w / 2; i++)
411     {
412       ((unsigned char *) dst)[i * 2] = MAKE_HEXIT ((v->c[i]) >> 4);
413       ((unsigned char *) dst)[i * 2 + 1] = MAKE_HEXIT ((v->c[i]) & 0xf);
414     }
415
416   return 1;
417 }
418
419 static int
420 convert_IB (char *dst, const struct fmt_spec *fp, const union value *v)
421 {
422   /* Strategy: Basically the same as convert_PIBHEX() but with base
423      256. Then it's necessary to negate the two's-complement result if
424      v->f is negative. */
425
426   /* Used for constructing the two's-complement result. */
427   unsigned temp[8];
428
429   /* Fraction (mantissa). */
430   double frac;
431
432   /* Exponent. */
433   int exp;
434
435   /* Difference between exponent and (-8*fp->w-1). */
436   int diff;
437
438   /* Counter. */
439   int i;
440
441   /* Make the exponent (-8*fp->w-1). */
442   frac = frexp (fabs (v->f), &exp);
443   diff = exp - (-8 * fp->w - 1);
444   exp -= diff;
445   frac *= ldexp (1.0, diff);
446
447   /* Extract each base-256 digit. */
448   for (i = 0; i < fp->w; i++)
449     {
450       modf (frac, &frac);
451       frac *= 256.0;
452       temp[i] = floor (frac);
453     }
454
455   /* Perform two's-complement negation if v->f is negative. */
456   if (v->f < 0)
457     {
458       /* Perform NOT operation. */
459       for (i = 0; i < fp->w; i++)
460         temp[i] = ~temp[i];
461       /* Add 1 to the whole number. */
462       for (i = fp->w - 1; i >= 0; i--)
463         {
464           temp[i]++;
465           if (temp[i])
466             break;
467         }
468     }
469   memcpy (dst, temp, fp->w);
470 #ifndef WORDS_BIGENDIAN
471   mm_reverse (dst, fp->w);
472 #endif
473
474   return 1;
475 }
476
477 static int
478 convert_P (char *dst, const struct fmt_spec *fp, const union value *v)
479 {
480   /* Buffer for v->f*2-1 characters + a decimal point if library is
481      not quite compliant + a null. */
482   char buf[17];
483
484   /* Counter. */
485   int i;
486
487   /* Main extraction. */
488   sprintf (buf, "%0*.0f", fp->w * 2 - 1, floor (fabs (v->f)));
489
490   for (i = 0; i < fp->w; i++)
491     ((unsigned char *) dst)[i]
492       = ((buf[i * 2] - '0') << 4) + buf[i * 2 + 1] - '0';
493
494   /* Set sign. */
495   dst[fp->w - 1] &= 0xf0;
496   if (v->f >= 0.0)
497     dst[fp->w - 1] |= 0xf;
498   else
499     dst[fp->w - 1] |= 0xd;
500
501   return 1;
502 }
503
504 static int
505 convert_PIB (char *dst, const struct fmt_spec *fp, const union value *v)
506 {
507   /* Strategy: Basically the same as convert_IB(). */
508
509   /* Fraction (mantissa). */
510   double frac;
511
512   /* Exponent. */
513   int exp;
514
515   /* Difference between exponent and (-8*fp->w). */
516   int diff;
517
518   /* Counter. */
519   int i;
520
521   /* Make the exponent (-8*fp->w). */
522   frac = frexp (fabs (v->f), &exp);
523   diff = exp - (-8 * fp->w);
524   exp -= diff;
525   frac *= ldexp (1.0, diff);
526
527   /* Extract each base-256 digit. */
528   for (i = 0; i < fp->w; i++)
529     {
530       modf (frac, &frac);
531       frac *= 256.0;
532       ((unsigned char *) dst)[i] = floor (frac);
533     }
534 #ifndef WORDS_BIGENDIAN
535   mm_reverse (dst, fp->w);
536 #endif
537
538   return 1;
539 }
540
541 static int
542 convert_PIBHEX (char *dst, const struct fmt_spec *fp, const union value *v)
543 {
544   /* Strategy: Use frexp() to create a normalized result (but mostly
545      to find the base-2 exponent), then change the base-2 exponent to
546      (-4*fp->w) using multiplication and division by powers of two.
547      Extract each hexit by multiplying by 16. */
548
549   /* Fraction (mantissa). */
550   double frac;
551
552   /* Exponent. */
553   int exp;
554
555   /* Difference between exponent and (-4*fp->w). */
556   int diff;
557
558   /* Counter. */
559   int i;
560
561   /* Make the exponent (-4*fp->w). */
562   frac = frexp (fabs (v->f), &exp);
563   diff = exp - (-4 * fp->w);
564   exp -= diff;
565   frac *= ldexp (1.0, diff);
566
567   /* Extract each hexit. */
568   for (i = 0; i < fp->w; i++)
569     {
570       modf (frac, &frac);
571       frac *= 16.0;
572       *dst++ = MAKE_HEXIT ((int) floor (frac));
573     }
574
575   return 1;
576 }
577
578 static int
579 convert_PK (char *dst, const struct fmt_spec *fp, const union value *v)
580 {
581   /* Buffer for v->f*2 characters + a decimal point if library is not
582      quite compliant + a null. */
583   char buf[18];
584
585   /* Counter. */
586   int i;
587
588   /* Main extraction. */
589   sprintf (buf, "%0*.0f", fp->w * 2, floor (fabs (v->f)));
590
591   for (i = 0; i < fp->w; i++)
592     ((unsigned char *) dst)[i]
593       = ((buf[i * 2] - '0') << 4) + buf[i * 2 + 1] - '0';
594
595   return 1;
596 }
597
598 static int
599 convert_RB (char *dst, const struct fmt_spec *fp, const union value *v)
600 {
601   union
602     {
603       double d;
604       char c[8];
605     }
606   u;
607
608   u.d = v->f;
609   memcpy (dst, u.c, fp->w);
610
611   return 1;
612 }
613
614 static int
615 convert_RBHEX (char *dst, const struct fmt_spec *fp, const union value *v)
616 {
617   union
618   {
619     double d;
620     char c[8];
621   }
622   u;
623
624   int i;
625
626   u.d = v->f;
627   for (i = 0; i < fp->w / 2; i++)
628     {
629       *dst++ = MAKE_HEXIT (u.c[i] >> 4);
630       *dst++ = MAKE_HEXIT (u.c[i] & 15);
631     }
632
633   return 1;
634 }
635
636 static int
637 convert_CCx (char *dst, const struct fmt_spec *fp, const union value *v)
638 {
639   if (try_CCx (dst, fp, v->f))
640     return 1;
641   else
642     {
643       struct fmt_spec f;
644       
645       f.type = FMT_COMMA;
646       f.w = fp->w;
647       f.d = fp->d;
648   
649       return convert_F (dst, &f, v);
650     }
651 }
652
653 static int
654 convert_date (char *dst, const struct fmt_spec *fp, const union value *v)
655 {
656   static const char *months[12] =
657     {
658       "JAN", "FEB", "MAR", "APR", "MAY", "JUN",
659       "JUL", "AUG", "SEP", "OCT", "NOV", "DEC",
660     };
661
662   char buf[64] = {0};
663   int month, day, year;
664
665   julian_to_calendar (v->f / 86400., &year, &month, &day);
666   switch (fp->type)
667     {
668     case FMT_DATE:
669       if (fp->w >= 11)
670         sprintf (buf, "%02d-%s-%04d", day, months[month - 1], year);
671       else
672         sprintf (buf, "%02d-%s-%02d", day, months[month - 1], year % 100);
673       break;
674     case FMT_EDATE:
675       if (fp->w >= 10)
676         sprintf (buf, "%02d.%02d.%04d", day, month, year);
677       else
678         sprintf (buf, "%02d.%02d.%02d", day, month, year % 100);
679       break;
680     case FMT_SDATE:
681       if (fp->w >= 10)
682         sprintf (buf, "%04d/%02d/%02d", year, month, day);
683       else
684         sprintf (buf, "%02d/%02d/%02d", year % 100, month, day);
685       break;
686     case FMT_ADATE:
687       if (fp->w >= 10)
688         sprintf (buf, "%02d/%02d/%04d", month, day, year);
689       else
690         sprintf (buf, "%02d/%02d/%02d", month, day, year % 100);
691       break;
692     case FMT_JDATE:
693       {
694         int yday = (v->f / 86400.) - calendar_to_julian (year, 1, 1) + 1;
695         
696         if (fp->w >= 7)
697           {
698             if (year4 (year))
699               sprintf (buf, "%04d%03d", year, yday);
700           }
701         else
702           sprintf (buf, "%02d%03d", year % 100, yday);
703         break;
704       }
705     case FMT_QYR:
706       if (fp->w >= 8)
707         sprintf (buf, "%d Q% 04d", (month - 1) / 3 + 1, year);
708       else
709         sprintf (buf, "%d Q% 02d", (month - 1) / 3 + 1, year % 100);
710       break;
711     case FMT_MOYR:
712       if (fp->w >= 8)
713         sprintf (buf, "%s% 04d", months[month - 1], year);
714       else
715         sprintf (buf, "%s% 02d", months[month - 1], year % 100);
716       break;
717     case FMT_WKYR:
718       {
719         int yday = (v->f / 86400.) - calendar_to_julian (year, 1, 1) + 1;
720         
721         if (fp->w >= 10)
722           sprintf (buf, "%02d WK% 04d", (yday - 1) / 7 + 1, year);
723         else
724           sprintf (buf, "%02d WK% 02d", (yday - 1) / 7 + 1, year % 100);
725       }
726       break;
727     case FMT_DATETIME:
728       {
729         char *cp;
730
731         cp = spprintf (buf, "%02d-%s-%04d %02d:%02d",
732                        day, months[month - 1], year,
733                        (int) fmod (floor (v->f / 60. / 60.), 24.),
734                        (int) fmod (floor (v->f / 60.), 60.));
735         if (fp->w >= 20)
736           {
737             int w, d;
738
739             if (fp->w >= 22 && fp->d > 0)
740               {
741                 d = min (fp->d, fp->w - 21);
742                 w = 3 + d;
743               }
744             else
745               {
746                 w = 2;
747                 d = 0;
748               }
749
750             cp = spprintf (cp, ":%0*.*f", w, d, fmod (v->f, 60.));
751           }
752       }
753       break;
754     default:
755       assert (0);
756     }
757
758   if (buf[0] == 0)
759     return 0;
760   st_bare_pad_copy (dst, buf, fp->w);
761   return 1;
762 }
763
764 static int
765 convert_time (char *dst, const struct fmt_spec *fp, const union value *v)
766 {
767   char temp_buf[40];
768   char *cp;
769
770   double time;
771   int width;
772
773   if (fabs (v->f) > 1e20)
774     {
775       msg (ME, _("Time value %g too large in magnitude to convert to "
776            "alphanumeric time."), v->f);
777       return 0;
778     }
779
780   time = v->f;
781   width = fp->w;
782   cp = temp_buf;
783   if (time < 0)
784     *cp++ = '-', time = -time;
785   if (fp->type == FMT_DTIME)
786     {
787       double days = floor (time / 60. / 60. / 24.);
788       cp = spprintf (temp_buf, "%02.0f ", days);
789       time = time - days * 60. * 60. * 24.;
790       width -= 3;
791     }
792   else
793     cp = temp_buf;
794
795   cp = spprintf (cp, "%02.0f:%02.0f",
796                  fmod (floor (time / 60. / 60.), 24.),
797                  fmod (floor (time / 60.), 60.));
798
799   if (width >= 8)
800     {
801       int w, d;
802
803       if (width >= 10 && fp->d >= 0 && fp->d != 0)
804         d = min (fp->d, width - 9), w = 3 + d;
805       else
806         w = 2, d = 0;
807
808       cp = spprintf (cp, ":%0*.*f", w, d, fmod (time, 60.));
809     }
810   st_bare_pad_copy (dst, temp_buf, fp->w);
811
812   return 1;
813 }
814
815 static int
816 convert_WKDAY (char *dst, const struct fmt_spec *fp, const union value *v)
817 {
818   static const char *weekdays[7] =
819     {
820       "SUNDAY", "MONDAY", "TUESDAY", "WEDNESDAY",
821       "THURSDAY", "FRIDAY", "SATURDAY",
822     };
823
824   int x = v->f;
825
826   if (x < 1 || x > 7)
827     {
828       msg (ME, _("Weekday index %d does not lie between 1 and 7."), x);
829       return 0;
830     }
831   st_bare_pad_copy (dst, weekdays[x - 1], fp->w);
832
833   return 1;
834 }
835
836 static int
837 convert_MONTH (char *dst, const struct fmt_spec *fp, const union value *v)
838 {
839   static const char *months[12] =
840     {
841       "JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE",
842       "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER",
843     };
844
845   int x = v->f;
846
847   if (x < 1 || x > 12)
848     {
849       msg (ME, _("Month index %d does not lie between 1 and 12."), x);
850       return 0;
851     }
852   
853   st_bare_pad_copy (dst, months[x - 1], fp->w);
854
855   return 1;
856 }
857 \f
858 /* Helper functions. */
859
860 /* Copies SRC to DST, inserting commas and dollar signs as appropriate
861    for format spec *FP.  */
862 static void
863 insert_commas (char *dst, const char *src, const struct fmt_spec *fp)
864 {
865   /* Number of leading spaces in the number.  This is the amount of
866      room we have for inserting commas and dollar signs. */
867   int n_spaces;
868
869   /* Number of digits before the decimal point.  This is used to
870      determine the Number of commas to insert. */
871   int n_digits;
872
873   /* Number of commas to insert. */
874   int n_commas;
875
876   /* Number of items ,%$ to insert. */
877   int n_items;
878
879   /* Number of n_items items not to use for commas. */
880   int n_reserved;
881
882   /* Digit iterator. */
883   int i;
884
885   /* Source pointer. */
886   const char *sp;
887
888   /* Count spaces and digits. */
889   sp = src;
890   while (sp < src + fp->w && *sp == ' ')
891     sp++;
892   n_spaces = sp - src;
893   sp = src + n_spaces;
894   if (*sp == '-')
895     sp++;
896   n_digits = 0;
897   while (sp + n_digits < src + fp->w && isdigit ((unsigned char) sp[n_digits]))
898     n_digits++;
899   n_commas = (n_digits - 1) / 3;
900   n_items = n_commas + (fp->type == FMT_DOLLAR || fp->type == FMT_PCT);
901
902   /* Check whether we have enough space to do insertions. */
903   if (!n_spaces || !n_items)
904     {
905       memcpy (dst, src, fp->w);
906       return;
907     }
908   if (n_items > n_spaces)
909     {
910       n_items -= n_commas;
911       if (!n_items)
912         {
913           memcpy (dst, src, fp->w);
914           return;
915         }
916     }
917
918   /* Put spaces at the beginning if there's extra room. */
919   if (n_spaces > n_items)
920     {
921       memset (dst, ' ', n_spaces - n_items);
922       dst += n_spaces - n_items;
923     }
924
925   /* Insert $ and reserve space for %. */
926   n_reserved = 0;
927   if (fp->type == FMT_DOLLAR)
928     {
929       *dst++ = '$';
930       n_items--;
931     }
932   else if (fp->type == FMT_PCT)
933     n_reserved = 1;
934
935   /* Copy negative sign and digits, inserting commas. */
936   if (sp - src > n_spaces)
937     *dst++ = '-';
938   for (i = n_digits; i; i--)
939     {
940       if (i % 3 == 0 && n_digits > i && n_items > n_reserved)
941         {
942           n_items--;
943           *dst++ = fp->type == FMT_COMMA ? set_grouping : set_decimal;
944         }
945       *dst++ = *sp++;
946     }
947
948   /* Copy decimal places and insert % if necessary. */
949   memcpy (dst, sp, fp->w - (sp - src));
950   if (fp->type == FMT_PCT && n_items > 0)
951     dst[fp->w - (sp - src)] = '%';
952 }
953
954 /* Returns 1 if YEAR (i.e., 1987) can be represented in four digits, 0
955    otherwise. */
956 static int
957 year4 (int year)
958 {
959   if (year >= 1 && year <= 9999)
960     return 1;
961   msg (ME, _("Year %d cannot be represented in four digits for "
962              "output formatting purposes."), year);
963   return 0;
964 }
965
966 static int
967 try_CCx (char *dst, const struct fmt_spec *fp, double v)
968 {
969   struct set_cust_currency *cc = &set_cc[fp->type - FMT_CCA];
970
971   struct fmt_spec f;
972
973   char buf[64];
974   char buf2[64];
975   char *cp;
976
977   /* Determine length available, decimal character for number
978      proper. */
979   f.type = cc->decimal == set_decimal ? FMT_COMMA : FMT_DOT;
980   f.w = fp->w - strlen (cc->prefix) - strlen (cc->suffix);
981   if (v < 0)
982     f.w -= strlen (cc->neg_prefix) + strlen (cc->neg_suffix) - 1;
983   else
984     /* Convert -0 to +0. */
985     v = fabs (v);
986   f.d = fp->d;
987
988   if (f.w <= 0)
989     return 0;
990
991   /* There's room for all that currency crap.  Let's do the F
992      conversion first. */
993   if (!convert_F (buf, &f, (union value *) &v) || *buf == '*')
994     return 0;
995   insert_commas (buf2, buf, &f);
996
997   /* Postprocess back into buf. */
998   cp = buf;
999   if (v < 0)
1000     cp = stpcpy (cp, cc->neg_prefix);
1001   cp = stpcpy (cp, cc->prefix);
1002   {
1003     char *bp = buf2;
1004     while (*bp == ' ')
1005       bp++;
1006
1007     assert ((v >= 0) ^ (*bp == '-'));
1008     if (v < 0)
1009       bp++;
1010
1011     memcpy (cp, bp, f.w - (bp - buf2));
1012     cp += f.w - (bp - buf2);
1013   }
1014   cp = stpcpy (cp, cc->suffix);
1015   if (v < 0)
1016     cp = stpcpy (cp, cc->neg_suffix);
1017
1018   /* Copy into dst. */
1019   assert (cp - buf <= fp->w);
1020   if (cp - buf < fp->w)
1021     {
1022       memcpy (&dst[fp->w - (cp - buf)], buf, cp - buf);
1023       memset (dst, ' ', fp->w - (cp - buf));
1024     }
1025   else
1026     memcpy (dst, buf, fp->w);
1027
1028   return 1;
1029 }
1030
1031 /* This routine relies on the underlying implementation of sprintf:
1032
1033    If the number has a magnitude 1e40 or greater, then we needn't
1034    bother with it, since it's guaranteed to need processing in
1035    scientific notation.
1036
1037    Otherwise, do a binary search for the base-10 magnitude of the
1038    thing.  log10() is not accurate enough, and the alternatives are
1039    frightful.  Besides, we never need as many as 6 (pairs of)
1040    comparisons.  The algorithm used for searching is Knuth's Algorithm
1041    6.2.1C (Uniform binary search).
1042
1043    DON'T CHANGE ANYTHING HERE UNLESS YOU'VE THOUGHT ABOUT IT FOR A
1044    LONG TIME!  The rest of the program is heavily dependent on
1045    specific properties of this routine's output.  LOG ALL CHANGES! */
1046 static int
1047 try_F (char *dst, const struct fmt_spec *fp, const union value *value)
1048 {
1049   /* This is the DELTA array from Knuth.
1050      DELTA[j] = floor((40+2**(j-1))/(2**j)). */
1051   static const int delta[8] =
1052   {
1053     0, (40 + 1) / 2, (40 + 2) / 4, (40 + 4) / 8, (40 + 8) / 16,
1054     (40 + 16) / 32, (40 + 32) / 64, (40 + 64) / 128,
1055   };
1056
1057   /* The number of digits in floor(v), including sign.  This is `i'
1058      from Knuth. */
1059   int n_int = (40 + 1) / 2;
1060
1061   /* Used to step through delta[].  This is `j' from Knuth. */
1062   int j = 2;
1063
1064   /* Value. */
1065   double v = value->f;
1066
1067   /* Magnitude of v.  This is `K' from Knuth. */
1068   double mag;
1069
1070   /* Number of characters for the fractional part, including the
1071      decimal point. */
1072   int n_dec;
1073
1074   /* Pointer into buf used for formatting. */
1075   char *cp;
1076
1077   /* Used to count characters formatted by nsprintf(). */
1078   int n;
1079
1080   /* Temporary buffer. */
1081   char buf[128];
1082
1083   /* First check for infinities and NaNs.  12/13/96. */
1084   if (!finite (v))
1085     {
1086       n = nsprintf (buf, "%f", v);
1087       if (n > fp->w)
1088         memset (buf, '*', fp->w);
1089       else if (n < fp->w)
1090         {
1091           memmove (&buf[fp->w - n], buf, n);
1092           memset (buf, ' ', fp->w - n);
1093         }
1094       memcpy (dst, buf, fp->w);
1095       return 1;
1096     }
1097
1098   /* Then check for radically out-of-range values. */
1099   mag = fabs (v);
1100   if (mag >= power10[fp->w])
1101     return 0;
1102
1103   if (mag < 1.0)
1104     {
1105       n_int = 0;
1106
1107       /* Avoid printing `-.000'. 7/6/96. */
1108       if (approx_eq (v, 0.0))
1109         v = 0.0;
1110     }
1111   else
1112     /* Now perform a `uniform binary search' based on the tables
1113        power10[] and delta[].  After this step, nint is the number of
1114        digits in floor(v), including any sign.  */
1115     for (;;)
1116       {
1117         if (mag >= power10[n_int])      /* Should this be approx_ge()? */
1118           {
1119             assert (delta[j]);
1120             n_int += delta[j++];
1121           }
1122         else if (mag < power10[n_int - 1])
1123           {
1124             assert (delta[j]);
1125             n_int -= delta[j++];
1126           }
1127         else
1128           break;
1129       }
1130
1131   /* If we have any decimal places, then there is a decimal point,
1132      too. */
1133   n_dec = fp->d;
1134   if (n_dec)
1135     n_dec++;
1136
1137   /* 1/10/96: If there aren't any digits at all, add one.  This occurs
1138      only when fabs(v) < 1.0. */
1139   if (n_int + n_dec == 0)
1140     n_int++;
1141
1142   /* Give space for a minus sign.  Moved 1/10/96. */
1143   if (v < 0)
1144     n_int++;
1145
1146   /* Normally we only go through the loop once; occasionally twice.
1147      Three times or more indicates a very serious bug somewhere. */
1148   for (;;)
1149     {
1150       /* Check out the total length of the string. */
1151       cp = buf;
1152       if (n_int + n_dec > fp->w)
1153         {
1154           /* The string is too long.  Let's see what can be done. */
1155           if (n_int <= fp->w)
1156             /* If we can, just reduce the number of decimal places. */
1157             n_dec = fp->w - n_int;
1158           else
1159             return 0;
1160         }
1161       else if (n_int + n_dec < fp->w)
1162         {
1163           /* The string is too short.  Left-pad with spaces. */
1164           int n_spaces = fp->w - n_int - n_dec;
1165           memset (cp, ' ', n_spaces);
1166           cp += n_spaces;
1167         }
1168
1169       /* Finally, format the number. */
1170       if (n_dec)
1171         n = nsprintf (cp, "%.*f", n_dec - 1, v);
1172       else
1173         n = nsprintf (cp, "%.0f", v);
1174
1175       /* If v is positive and its magnitude is less than 1...  */
1176       if (n_int == 0)
1177         {
1178           if (*cp == '0')
1179             {
1180               /* The value rounds to `.###'. */
1181               memmove (cp, &cp[1], n - 1);
1182               n--;
1183             }
1184           else
1185             {
1186               /* The value rounds to `1.###'. */
1187               n_int = 1;
1188               continue;
1189             }
1190         }
1191       /* Else if v is negative and its magnitude is less than 1...  */
1192       else if (v < 0 && n_int == 1)
1193         {
1194           if (cp[1] == '0')
1195             {
1196               /* The value rounds to `-.###'. */
1197               memmove (&cp[1], &cp[2], n - 2);
1198               n--;
1199             }
1200           else
1201             {
1202               /* The value rounds to `-1.###'. */
1203               n_int = 2;
1204               continue;
1205             }
1206         }
1207
1208       /* Check for a correct number of digits & decimal places & stuff.
1209          This is just a desperation check.  Hopefully it won't fail too
1210          often, because then we have to run through the whole loop again:
1211          sprintf() is not a fast operation with floating-points! */
1212       if (n == n_int + n_dec)
1213         {
1214           /* Convert periods `.' to commas `,' for our foreign friends. */
1215           if ((set_decimal == ',' && fp->type != FMT_DOT)
1216               || (set_decimal == '.' && fp->type == FMT_DOT))
1217             {
1218               cp = strchr (cp, '.');
1219               if (cp)
1220                 *cp = ',';
1221             }
1222
1223           memcpy (dst, buf, fp->w);
1224           return 1;
1225         }
1226
1227       n_int = n - n_dec; /* FIXME?  Need an idiot check on resulting n_int? */
1228     }
1229 }