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