FreeBASIC  0.91.0
io_printusg.c
Go to the documentation of this file.
1 /* print using function */
2 
3 #include "fb.h"
4 #include <math.h>
5 
6 typedef struct {
7  int chars;
8  char *ptr;
11 
12 #define BUFFERLEN 2048
13 #define MIN_EXPDIGS 3
14 #define MAX_EXPDIGS 5
15 #define MAX_DIGS (BUFFERLEN \
16  - 2 /* '%' char(s) */ \
17  - 1 /* +/- sign */ \
18  - 1 /* dollar sign */ \
19  - 1 /* decimal point */ \
20  - MAX_EXPDIGS /* exp digits */ \
21  - (MIN_EXPDIGS - 1) /* stray carets */ \
22  )
23 
24 
25 #define CHAR_ZERO '0'
26 #define CHAR_DOT '.'
27 #define CHAR_COMMA ','
28 #define CHAR_TOOBIG '%'
29 #define CHAR_PLUS '+'
30 #define CHAR_MINUS '-'
31 #define CHAR_STAR '*'
32 #define CHAR_DOLLAR '$'
33 #define CHAR_SPACE ' '
34 #define CHAR_WTF '!'
35 #define CHAR_EXP_SINGLE 'E'
36 #if 0
37 #define CHAR_EXP_DOUBLE 'D'
38 #endif
39 
40 #define SNG_AUTODIGS 7
41 #define DBL_AUTODIGS 15
42 #define DBL_MAXDIGS 16
43 
44 #define CHARS_NAN ('#' << 24 | 'N' << 16 | 'A' << 8 | 'N')
45 #define CHARS_INF ('#' << 24 | 'I' << 16 | 'N' << 8 | 'F')
46 #define CHARS_IND ('#' << 24 | 'I' << 16 | 'N' << 8 | 'D')
47 #define CHARS_TRUNC ('$' << 24 | '0' << 16 | '0' << 8 | '0') /* QB glitch: truncation "rounds up" the text chars */
48 
49 #define ADD_CHAR( c ) \
50  do { \
51  DBG_ASSERT( p >= buffer ); \
52  if( p >= buffer ) \
53  *(p--) = (char)(c); \
54  else if( p == buffer ) \
55  *p = CHAR_WTF; \
56  } while (0)
57 
58 
59 /*-------------------------------------------------------------*/
60 /* Checks for Infinity/NaN *
61  * (assumes IEEE-754 floating-point format) *
62  * TODO: use a proper implementation: most/all platforms *
63  * have specific functions built-in for this */
64 
65 static long long hDoubleToLongBits(double d)
66 {
67  union{ double d; unsigned long long ll; } dtoll;
68  dtoll.d = d;
69  return dtoll.ll;
70 }
71 
72 static int hIsNeg(double d)
73 {
74  return hDoubleToLongBits(d) < 0ll;
75 }
76 
77 static int hIsZero(double d)
78 {
79  return (hDoubleToLongBits(d) & 0x7fffffffffffffffll) == 0ll;
80 }
81 
82 static int hIsFinite(double d)
83 {
84  return (hDoubleToLongBits(d) & 0x7ff0000000000000ll) < 0x7ff0000000000000ll;
85 }
86 
87 static int hIsInf(double d)
88 {
89  return (hDoubleToLongBits(d) & 0x7fffffffffffffffll) == 0x7ff0000000000000ll;
90 }
91 
92 static int hIsInd(double d)
93 {
94  return hDoubleToLongBits(d) == 0xfff8000000000000ll;
95 }
96 
97 static int hIsNan(double d)
98 {
99  return !(hIsFinite(d) || hIsInf(d) || hIsInd(d));
100 }
101 
102 
103 
104 /*-------------------------------------------------------------*/
105 
106 #define VAL_ISNEG 0x1
107 #define VAL_ISINF 0x2
108 #define VAL_ISIND 0x4
109 #define VAL_ISNAN 0x8
110 
111 #define VAL_ISFLOAT 0x10
112 #define VAL_ISSNG 0x20
113 
114 
115 static int fb_PrintUsingFmtStr( int fnum );
116 
118 {
120 
121  FB_LOCK();
122 
123  ctx = FB_TLSGETCTX( PRINTUSG );
124 
125  fb_StrAssign( (void *)&ctx->fmtstr, -1, fmtstr, -1, 0 );
126  ctx->ptr = ctx->fmtstr.data;
127  ctx->chars = FB_STRSIZE( &ctx->fmtstr );
128 
129  FB_UNLOCK();
130 
131  return fb_ErrorSetNum( FB_RTERROR_OK );
132 }
133 
134 FBCALL int fb_PrintUsingEnd( int fnum )
135 {
137 
138  fb_PrintUsingFmtStr( fnum );
139 
140  FB_LOCK();
141 
142  ctx = FB_TLSGETCTX( PRINTUSG );
143 
144  fb_StrDelete( &ctx->fmtstr );
145  ctx->ptr = 0;
146  ctx->chars = 0;
147 
148  FB_UNLOCK();
149 
150  return fb_ErrorSetNum( FB_RTERROR_OK );
151 }
152 
153 static unsigned long long hPow10_ULL( int n )
154 {
155 
156  DBG_ASSERT( n >= 0 && n <= 19 );
157 
158  unsigned long long ret = 1, a = 10;
159  while( n > 0 )
160  {
161  if( n & 1 ) ret *= a;
162  a *= a;
163  n >>= 1;
164  }
165 
166  return ret;
167 }
168 
169 static int hLog10_ULL( unsigned long long a )
170 {
171  int ret = 0;
172  int a32;
173  unsigned long long a64;
174 
175  a64 = a;
176  while( a64 >= (int)1.E+8 )
177  {
178  a64 /= (int)1.E+8;
179  ret += 8;
180  }
181  a32 = a64;
182  if( a32 >= (int)1.E+4 ) ret += 4; else a32 *= (int)1.E+4;
183  if( a32 >= (int)1.E+6 ) ret += 2; else a32 *= (int)1.E+2;
184  if( a32 >= (int)1.E+7 ) ret += 1;
185 
186  if( a == 0 )
187  DBG_ASSERT( ret == 0 );
188  else
189  DBG_ASSERT( hPow10_ULL( ret ) <= a && hPow10_ULL( ret ) > a / 10 );
190 
191  return ret;
192 }
193 
194 static int hNumDigits( unsigned long long a )
195 {
196  return hLog10_ULL( a ) + 1;
197 }
198 
199 static unsigned long long hDivPow10_ULL( unsigned long long a, int n )
200 {
201  unsigned long long b, ret;
202 
203  DBG_ASSERT( n >= 0 );
204 
205  if( n > 19 ) return 0;
206 
207  b = hPow10_ULL( n );
208  ret = a / b;
209 
210  if( (a % b) >= (b + 1) / 2 )
211  ret += 1; /* round up */
212 
213  return ret;
214 }
215 
216 static int fb_PrintUsingFmtStr( int fnum )
217 {
219  char buffer[BUFFERLEN+1];
220  int c, nc, nnc, len, doexit;
221 
222  ctx = FB_TLSGETCTX( PRINTUSG );
223 
224  len = 0;
225  if( ctx->ptr == NULL )
226  ctx->chars = 0;
227 
228  while( (ctx->chars > 0) && (len < BUFFERLEN) )
229  {
230  c = *ctx->ptr;
231  nc = ( ctx->chars > 1? ctx->ptr[1] : -1 );
232  nnc = ( ctx->chars > 2? ctx->ptr[2] : -1 );
233 
234  doexit = FALSE;
235  switch( c )
236  {
237  case '*':
238  /* "**..." number format (includes "**$...") */
239  if( nc == '*' )
240  doexit = TRUE;
241 
242  break;
243 
244  case '$':
245  /* "$$..." number format */
246  if( nc == '$' )
247  doexit = TRUE;
248 
249  break;
250 
251  case '+':
252  /* "+#...", "+$$...", "+**...", "+.#..." */
253  if( (nc == '#') ||
254  ((nc == '$') && (nnc == '$')) ||
255  ((nc == '*') && (nnc == '*')) ||
256  ((nc == '.') && (nnc == '#')) )
257 
258  doexit = TRUE;
259  break;
260 
261  case '!':
262  case '\\':
263  case '&':
264  case '#':
265  /* "!", "\ ... \", "&" string formats, "#..." number format */
266  doexit = TRUE;
267  break;
268 
269  case '.':
270  /* ".#[...]" number format */
271  if( nc == '#' )
272  doexit = TRUE;
273 
274  break;
275 
276  case '_':
277  /* escape next char if there is one, otherwise just print '_' */
278  if( ctx->chars > 1 )
279  {
280  c = nc;
281  ++ctx->ptr;
282  --ctx->chars;
283  }
284  }
285 
286  if( doexit )
287  break;
288 
289  buffer[len++] = (char)c;
290 
291  ++ctx->ptr;
292  --ctx->chars;
293  }
294 
295  /* flush */
296  if( len > 0 )
297  {
298  buffer[len] = '\0';
299  fb_PrintFixString( fnum, buffer, 0 );
300  }
301 
302  return fb_ErrorSetNum( FB_RTERROR_OK );
303 }
304 
305 FBCALL int fb_PrintUsingStr( int fnum, FBSTRING *s, int mask )
306 {
308  char buffer[BUFFERLEN+1];
309  int c, nc, strchars, doexit, i;
310 
311  ctx = FB_TLSGETCTX( PRINTUSG );
312 
313  /* restart if needed */
314  if( ctx->chars == 0 )
315  {
316  ctx->ptr = ctx->fmtstr.data;
317  ctx->chars = FB_STRSIZE( &ctx->fmtstr );
318  }
319 
320  /* any text first */
321  fb_PrintUsingFmtStr( fnum );
322 
323  strchars = -1;
324 
325  if( ctx->ptr == NULL )
326  ctx->chars = 0;
327 
328  while( ctx->chars > 0 )
329  {
330  c = *ctx->ptr;
331  nc = ( ctx->chars > 1? ctx->ptr[1] : -1 );
332 
333  doexit = TRUE;
334  switch( c )
335  {
336  case '!':
337  if( FB_STRSIZE( s ) >= 1 )
338  buffer[0] = s->data[0];
339  else
340  buffer[0] = ' ';
341 
342  buffer[1] = '\0';
343  fb_PrintFixString( fnum, buffer, 0 );
344 
345  ++ctx->ptr;
346  --ctx->chars;
347  break;
348 
349  case '&':
350  fb_PrintFixString( fnum, s->data, 0 );
351 
352  ++ctx->ptr;
353  --ctx->chars;
354  break;
355 
356  case '\\':
357  if( (strchars != -1) || (nc == ' ') || (nc == '\\') )
358  {
359  if( strchars > 0 )
360  {
361  ++strchars;
362 
363  if( FB_STRSIZE( s ) < strchars )
364  {
365  fb_PrintFixString( fnum, s->data, 0 );
366 
367  strchars -= FB_STRSIZE( s );
368  for( i = 0; i < strchars; i++ )
369  buffer[i] = ' ';
370  buffer[i] = '\0';
371  }
372  else
373  {
374  memcpy( buffer, s->data, strchars );
375  buffer[strchars] = '\0';
376  }
377 
378  /* replace null-terminators by spaces */
379  for( i = 0; i < strchars; i++ )
380  if( buffer[i] == '\0' )
381  buffer[i] = ' ';
382 
383  fb_PrintFixString( fnum, buffer, 0 );
384 
385  ++ctx->ptr;
386  --ctx->chars;
387  }
388  else
389  {
390  strchars = 1;
391  doexit = FALSE;
392  }
393  }
394  break;
395 
396  case ' ':
397  if( strchars > -1 )
398  {
399  ++strchars;
400  doexit = FALSE;
401  }
402  break;
403  }
404 
405  if( doexit )
406  break;
407 
408  ++ctx->ptr;
409  --ctx->chars;
410  }
411 
412  /* any text */
413  fb_PrintUsingFmtStr( fnum );
414 
415 
416  if( mask & FB_PRINT_ISLAST )
417  {
418  if( mask & FB_PRINT_NEWLINE )
419  fb_PrintVoid( fnum, FB_PRINT_NEWLINE );
420 
421  fb_StrDelete( &ctx->fmtstr );
422 
423  }
424 
425  /* del if temp */
426  fb_hStrDelTemp( s );
427 
428  return fb_ErrorSetNum( FB_RTERROR_OK );
429 }
430 
431 FBCALL int fb_PrintUsingWstr( int fnum, FB_WCHAR *s, int mask )
432 {
435  int c, nc, strchars, doexit, i, length;
436 
437  ctx = FB_TLSGETCTX( PRINTUSG );
438 
439  /* restart if needed */
440  if( ctx->chars == 0 ) {
441  ctx->ptr = ctx->fmtstr.data;
442  ctx->chars = FB_STRSIZE( &ctx->fmtstr );
443  }
444 
445  /* any text first */
446  fb_PrintUsingFmtStr( fnum );
447 
448  strchars = -1;
449  length = fb_wstr_Len( s );
450 
451  if( ctx->ptr == NULL )
452  ctx->chars = 0;
453 
454  while( ctx->chars > 0 ) {
455  c = *ctx->ptr;
456  nc = ctx->chars > 1 ? ctx->ptr[1] : -1;
457 
458  doexit = TRUE;
459  switch( c ) {
460  case '!':
461  if( length >= 1 )
462  buffer[0] = s[0];
463  else
464  buffer[0] = L' ';
465 
466  buffer[1] = L'\0';
467  fb_PrintWstr( fnum, buffer, 0 );
468 
469  ++ctx->ptr;
470  --ctx->chars;
471  break;
472 
473  case '&':
474  fb_PrintWstr( fnum, s, 0 );
475 
476  ++ctx->ptr;
477  --ctx->chars;
478  break;
479 
480  case '\\':
481  if( (strchars != -1) || (nc == ' ') || (nc == '\\') ) {
482  if( strchars > 0 ) {
483  ++strchars;
484 
485  if( length < strchars ) {
486  fb_PrintWstr( fnum, s, 0 );
487 
488  strchars -= length;
489  for( i = 0; i < strchars; i++ )
490  buffer[i] = L' ';
491  buffer[i] = L'\0';
492  } else {
493  fb_wstr_Copy( buffer, s, strchars );
494  }
495 
496  /* replace null-terminators by spaces */
497  for( i = 0; i < strchars; i++ )
498  if( buffer[i] == '\0' )
499  buffer[i] = ' ';
500 
501  fb_PrintWstr( fnum, buffer, 0 );
502 
503  ++ctx->ptr;
504  --ctx->chars;
505  } else {
506  strchars = 1;
507  doexit = FALSE;
508  }
509  }
510  break;
511 
512  case ' ':
513  if( strchars > -1 ) {
514  ++strchars;
515  doexit = FALSE;
516  }
517  break;
518  }
519 
520  if( doexit )
521  break;
522 
523  ++ctx->ptr;
524  --ctx->chars;
525  }
526 
527  /* any text */
528  fb_PrintUsingFmtStr( fnum );
529 
530 
531  if( mask & FB_PRINT_ISLAST ) {
532  if( mask & FB_PRINT_NEWLINE )
533  fb_PrintVoid( fnum, FB_PRINT_NEWLINE );
534  fb_StrDelete( &ctx->fmtstr );
535  }
536 
537  return fb_ErrorSetNum( FB_RTERROR_OK );
538 }
539 
540 static int hPrintNumber
541  (
542  int fnum,
543  unsigned long long val, int val_exp, int flags,
544  int mask
545  )
546 {
548  char buffer[BUFFERLEN+1], *p;
549  int val_digs, val_zdigs;
550  unsigned long long val0;
551  int val_digs0, val_exp0;
552  int val_isneg, val_isfloat, val_issng;
553  int c, lc;
554 #ifdef DEBUG
555  int nc; /* used for sanity checks */
556 #endif
557  int doexit, padchar, intdigs, decdigs, expdigs;
558  int adddollar, addcommas, signatend, signatstart, plussign, toobig;
559  int intdigs2, expsignchar, totdigs, decpoint;
560  int isamp;
561  int i;
562  uint32_t chars = 0;
563 
564  ctx = FB_TLSGETCTX( PRINTUSG );
565 
566  /* restart if needed */
567  if( ctx->chars == 0 )
568  {
569  ctx->ptr = ctx->fmtstr.data;
570  ctx->chars = FB_STRSIZE( &ctx->fmtstr );
571  }
572 
573  /* any text first */
574  fb_PrintUsingFmtStr( fnum );
575 
576 
577  padchar = CHAR_SPACE;
578  intdigs = 0;
579  decdigs = -1;
580  expdigs = 0;
581  adddollar = FALSE;
582  addcommas = FALSE;
583  signatend = FALSE;
584  signatstart = FALSE;
585  plussign = FALSE;
586  toobig = 0;
587  isamp = FALSE;
588 
589  lc = -1;
590 
591  if( ctx->ptr == NULL )
592  {
593  ctx->chars = 0;
594  }
595 
596  while( ctx->chars > 0 )
597  {
598  /* exit if just parsed end '+'/'-' sign, or '&' sign */
599  if( signatend || isamp )
600  {
601  break;
602  }
603 
604  c = *ctx->ptr;
605 #ifdef DEBUG
606  nc = ( ctx->chars > 1? *(ctx->ptr+1): -1 );
607 #endif
608  doexit = FALSE;
609  switch( c )
610  {
611  case '#':
612  /* increment intdigs or decdigs if in int/dec part, else exit */
613  if( expdigs != 0 )
614  {
615  doexit = TRUE;
616  }
617  else if( decdigs != -1 )
618  {
619  ++decdigs;
620  }
621  else
622  {
623  ++intdigs;
624  }
625  break;
626 
627  case '.':
628  /* add decimal point if still in integer part, else exit */
629  if( decdigs != -1 || expdigs != 0 )
630  {
631  doexit = TRUE;
632  }
633  else
634  {
635  decdigs = 0;
636  }
637  break;
638 
639  case '*':
640  /* if first two characters, change padding to asterisks, else exit */
641  if( (intdigs == 0 && decdigs == -1) )
642  { /* first asterisk */
643  DBG_ASSERT( nc == '*' ); /* must be two at start, otherwise we're not parsing a format string and shouldn't have been brought here! */
644  padchar = CHAR_STAR;
645  ++intdigs;
646  }
647  else if( intdigs == 1 && lc == '*' )
648  { /* second asterisk */
649  ++intdigs;
650  }
651  else
652  doexit = TRUE;
653  break;
654 
655  case '$':
656  /* at beginning ("$..."), or after two '*'s ("**$..."): prepend a dollar sign to number */
657 
658  /* did it follow a '*'? (Will have been the two at the start, else would have exited by now */
659  if( lc == '*' )
660  {
661  adddollar = TRUE;
662  }
663  /* two at start of number, before integer part? */
664  else if( intdigs == 0 && decdigs == -1 )
665  {
666  if( !adddollar )
667  { /* first dollar */
668  DBG_ASSERT( nc == '$' ); /* otherwise we're not parsing a format string and shouldn't have been brought here! */
669  adddollar = TRUE;
670  }
671  else
672  { /* second dollar */
673  DBG_ASSERT( lc == '$' );
674  ++intdigs;
675  }
676  }
677  else
678  {
679  doexit = TRUE;
680  }
681  break;
682 
683  case ',':
684  /* if parsing integer part, enable commas and increment intdigs */
685  if( decdigs != -1 || expdigs != 0 )
686  {
687  doexit = TRUE;
688  }
689  else
690  {
691  addcommas = TRUE;
692  ++intdigs;
693  }
694  break;
695 
696  case '+':
697  case '-':
698  /* '+' at start/end: explicit '+'/'-' sign
699  '-' at end: explicit '-' sign, if negative */
700 
701  /* one already at start? */
702  if( signatstart )
703  {
704  doexit = TRUE;
705  }
706  /* found one before integer part? */
707  else if( intdigs == 0 && decdigs == -1 )
708  {
709  DBG_ASSERT( c != '-' ); /* explicit '-' sign isn't checked for at start */
710  if( c == '+' )
711  {
712  plussign = TRUE;
713  }
714  signatstart = TRUE;
715  }
716  /* otherwise it's at the end, as long as there are enough expdigs for an
717  exponent (or none at all), otherwise they are all normal printable characters */
718  else if( expdigs == 0 || expdigs >= MIN_EXPDIGS )
719  {
720  if( c == '+' )
721  {
722  plussign = TRUE;
723  }
724  signatend = TRUE;
725  }
726  else
727  {
728  doexit = TRUE;
729  }
730  break;
731 
732  case '^':
733  /* exponent digits (there must be at least MIN_EXPDIGS of them,
734  otherwise they will just be appended as printable chars */
735 
736  /* Too many? Leave the rest as printable chars */
737  if( expdigs < MAX_EXPDIGS )
738  {
739  ++expdigs;
740  }
741  else
742  {
743  doexit = TRUE;
744  }
745  break;
746 
747  case '&':
748  /* string format '&'
749  print number in most natural form - similar to STR */
750  if( intdigs == 0 && decdigs == -1 && !signatstart )
751  {
752  DBG_ASSERT( expdigs == 0 );
753  isamp = TRUE;
754  }
755  else
756  {
757  doexit = TRUE;
758  }
759  break;
760 
761  default:
762  doexit = TRUE;
763  }
764 
765  if( doexit )
766  {
767  break;
768  }
769 
770  ++ctx->ptr;
771  --ctx->chars;
772 
773  lc = c;
774  }
775 
776  /* ------------------------------------------------------ */
777 
778  /* check flags */
779  val_isneg = ( (flags & VAL_ISNEG) != 0 );
780  val_isfloat = ( (flags & VAL_ISFLOAT) != 0 );
781  val_issng = ( (flags & VAL_ISSNG) != 0 );
782 
783  if( (flags & (VAL_ISINF | VAL_ISIND | VAL_ISNAN)) != 0)
784  {
785  if( (flags & VAL_ISINF) != 0 )
786  {
787  chars = CHARS_INF;
788  }
789  else if( (flags & VAL_ISIND) != 0 )
790  {
791  chars = CHARS_IND;
792  }
793  else if( (flags & VAL_ISNAN) != 0 )
794  {
795  chars = CHARS_NAN;
796  }
797  else
798  {
799  DBG_ASSERT( 0 );
800  }
801 
802  /* Set value to 1.1234 (placeholder for "1.#XYZ") */
803  val = 11234;
804  val_exp = -4;
805  }
806 
807  if( val != 0 )
808  {
809  val_digs = hNumDigits( val );
810  }
811  else
812  {
813  val_digs = 0;
814  }
815  val_zdigs = 0;
816 
817  /* Special '&' format? */
818  if( isamp )
819  {
820  if( val_issng )
821  { /* crop to 7-digit precision */
822  if( val_digs > SNG_AUTODIGS )
823  {
824  val = hDivPow10_ULL( val, val_digs - SNG_AUTODIGS );
825  val_exp += val_digs - SNG_AUTODIGS;
826  val_digs = SNG_AUTODIGS;
827  }
828 
829  if( val == 0 )
830  { /* val has been scaled down to zero */
831  val_digs = 0;
832  val_exp = -decdigs;
833  }
834  else if( val == hPow10_ULL( val_digs ) )
835  { /* rounding up took val to next power of 10:
836  set value to 1, put val_digs zeroes onto val_exp */
837  val = 1;
838  val_exp += val_digs;
839  val_digs = 1;
840  }
841  }
842 
843  if( val_isfloat )
844  { /* remove trailing zeroes in float digits */
845  while( val_digs > 1 && (val % 10) == 0 )
846  {
847  val /= 10;
848  --val_digs;
849  ++val_exp;
850  }
851  }
852 
853  /* set digits for fixed-point */
854  if( val_digs + val_exp > 0 )
855  {
856  intdigs = val_digs + val_exp;
857  }
858  else
859  {
860  intdigs = 1;
861  }
862 
863  if( val_exp < 0 )
864  {
865  decdigs = -val_exp;
866  }
867 
868  if( val_isfloat )
869  { /* scientific notation? e.g. 3.1E+42 */
870  if( intdigs > 16 || (val_issng && intdigs > 7) ||
871  val_digs + val_exp - 1 < -MIN_EXPDIGS )
872  {
873  intdigs = 1;
874  decdigs = val_digs - 1;
875 
876  expdigs = 2 + hNumDigits( abs(val_digs + val_exp - 1) );
877  if( expdigs < MIN_EXPDIGS + 1 )
878  expdigs = MIN_EXPDIGS;
879  }
880  }
881 
882  if( val_isneg )
883  {
884  signatstart = TRUE;
885  }
886  }
887 
888  /* crop number of digits */
889  if( intdigs + 1 + decdigs > MAX_DIGS )
890  {
891  decdigs -= ((intdigs + 1 + decdigs) - MAX_DIGS);
892  if( decdigs < -1 )
893  {
894  intdigs -= (-1 - decdigs);
895  decdigs = -1;
896  }
897  }
898 
899  /* decimal point if decdigs >= 0 */
900  if( decdigs <= -1 )
901  {
902  decpoint = FALSE;
903  decdigs = 0;
904  }
905  else
906  {
907  decpoint = TRUE;
908  }
909 
910  /* ------------------------------------------------------ */
911 
912  p = &buffer[BUFFERLEN];
913  ADD_CHAR( '\0' );
914 
915  if( signatend )
916  { /* put sign at end */
917  if( val_isneg )
918  {
919  ADD_CHAR( CHAR_MINUS );
920  }
921  else
922  {
923  ADD_CHAR( plussign? CHAR_PLUS : CHAR_SPACE );
924  }
925  }
926  else if( val_isneg && !signatstart )
927  { /* implicit negative sign at start */
928  signatstart = TRUE;
929  --intdigs;
930  }
931 
932  /* fixed-point format? */
933  if( expdigs < MIN_EXPDIGS )
934  {
935  /* append any trailing carets */
936  for( ; expdigs > 0; --expdigs )
937  {
938  ADD_CHAR( '^' );
939  }
940 
941  /* backup unscaled value */
942  val0 = val;
943  val_digs0 = val_digs;
944  val_exp0 = val_exp;
945 
946  /* check range */
947  if( val_exp < -decdigs )
948  { /* scale and round integer value to get val_exp equal to -decdigs */
949  val_exp += (-decdigs - val_exp0);
950  val_digs -= (-decdigs - val_exp0);
951  val = hDivPow10_ULL( val, -decdigs - val_exp0 );
952 
953  if( val == 0 )
954  { /* val is/has been scaled down to zero */
955  val_digs = 0;
956  val_exp = -decdigs;
957  }
958  else if( val == hPow10_ULL( val_digs ) )
959  { /* rounding up took val to next power of 10:
960  set value to 1, put val_digs zeroes onto val_exp */
961  val = 1;
962  val_exp += val_digs;
963  val_digs = 1;
964  }
965  }
966 
967  intdigs2 = val_digs + val_exp;
968  if( intdigs2 < 0 ) intdigs2 = 0;
969  if( addcommas )
970  {
971  intdigs2 += (intdigs2 - 1) / 3;
972  }
973 
974  /* compare fixed/floating point representations,
975  and use the one that needs fewest digits */
976  if( intdigs2 > intdigs + MIN_EXPDIGS )
977  { /* too many digits in number for fixed point:
978  switch to floating-point */
979 
980  expdigs = MIN_EXPDIGS; /* add three digits for exp notation (was four in QB) */
981  toobig = 1; /* add '%' sign */
982 
983  /* restore unscaled value */
984  val = val0;
985  val_digs = val_digs0;
986  val_exp = val_exp0;
987 
988  val_zdigs = 0;
989  }
990  else
991  { /* keep fixed point */
992 
993  if( intdigs2 > intdigs )
994  { /* slightly too many digits in number */
995  intdigs = intdigs2; /* extend intdigs */
996  toobig = 1; /* add '%' sign */
997  }
998 
999  if( val_exp > -decdigs)
1000  { /* put excess trailing zeroes from val_exp into val_zdigs */
1001  val_zdigs = val_exp - -decdigs;
1002  val_exp = -decdigs;
1003  }
1004  }
1005  }
1006 
1007 
1008  /* floating-point format */
1009  if( expdigs > 0 )
1010  {
1011  addcommas = FALSE; /* commas unused in f-p format */
1012 
1013  if( intdigs == -1 || (intdigs == 0 && decdigs == 0) )
1014  { /* add [another] '%' sign */
1015  ++intdigs;
1016 #if 0
1017  ++toobig; /* QB could prepend two independent '%'s */
1018 #else
1019  toobig = 1; /* We'll just stick with one */
1020 #endif
1021  }
1022 
1023  totdigs = intdigs + decdigs; /* treat intdigs and decdigs the same */
1024  val_exp += decdigs; /* move decimal position to end */
1025 
1026  /* blank first digit if positive and no explicit sign
1027  (pos/neg numbers should be formatted the same where
1028  possible, as in QB) */
1029  if( !isamp && !val_isneg && !(signatstart || signatend) )
1030  {
1031  if( intdigs >= 1 && totdigs > 1 )
1032  {
1033  --totdigs;
1034  }
1035  }
1036 
1037  if( val == 0 )
1038  {
1039  val_exp = 0; /* ensure exponent is printed as 0 */
1040  val_zdigs = decdigs; /* enough trailing zeroes to fill dec part */
1041  }
1042  else if( val_digs < totdigs )
1043  { /* add "zeroes" to the end of val:
1044  subtract from val_exp and put into val_zdigs */
1045  val_zdigs = totdigs - val_digs ;
1046  val_exp -= val_zdigs;
1047  }
1048  else if( val_digs > totdigs )
1049  { /* scale down value */
1050  val = hDivPow10_ULL( val, val_digs - totdigs );
1051  val_exp += (val_digs - totdigs);
1052  val_digs = totdigs;
1053  val_zdigs = 0;
1054 
1055  if( val >= hPow10_ULL( val_digs ) )
1056  { /* rounding up brought val to the next power of 10:
1057  add the extra digit onto val_exp */
1058  val /= 10;
1059  ++val_exp;
1060  }
1061  }
1062  else
1063  {
1064  val_zdigs = 0;
1065  }
1066 
1067 
1068  /* output exp part */
1069 
1070  if( val_exp < 0 )
1071  {
1072  expsignchar = CHAR_MINUS;
1073  val_exp = -val_exp;
1074  }
1075  else
1076  {
1077  expsignchar = CHAR_PLUS;
1078  }
1079 
1080  /* expdigs > 3 */
1081  for( ; expdigs > 3; --expdigs )
1082  {
1083  ADD_CHAR( CHAR_ZERO + (val_exp % 10) );
1084  val_exp /= 10;
1085  }
1086 
1087  /* expdigs == 3 */
1088  if( val_exp > 9 ) /* too many exp digits? */
1089  {
1090 #if 1 /* Add remaining digits (QB would just crop these) */
1091  do {
1092  ADD_CHAR( CHAR_ZERO + (val_exp % 10) );
1093  val_exp /= 10;
1094  } while( val_exp > 9 );
1095  ADD_CHAR( CHAR_ZERO + val_exp );
1096 #endif
1097  ADD_CHAR( CHAR_TOOBIG ); /* add a '%' sign */
1098  }
1099  else
1100  {
1101  ADD_CHAR( CHAR_ZERO + val_exp );
1102  }
1103 
1104  expdigs -= 1;
1105 
1106  /* expdigs == 2 */
1107  ADD_CHAR( expsignchar );
1108  ADD_CHAR( CHAR_EXP_SINGLE ); /* QB would use 'D' for doubles */
1109 
1110  expdigs -= 2;
1111  }
1112 
1113 
1114  /* INF/IND/NAN: characters truncated? */
1115  if( chars != 0 && val_digs < 5 )
1116  {
1117  /* QB wouldn't add the '%'. But otherwise "#" will result in
1118  an innocent-looking "1". Also, QB corrupts the string data
1119  when truncated, so some deviation is desirable anyway) */
1120  toobig = 1;
1121 
1122  if ( val_digs > 1 )
1123  {
1124  chars = CHARS_TRUNC >> (8 * (5 - val_digs));
1125  }
1126  else
1127  {
1128  chars = 0;
1129  }
1130  }
1131 
1132 
1133  /* output dec part */
1134  if( decpoint )
1135  {
1136  for( ; decdigs > 0; --decdigs )
1137  {
1138  if( val_zdigs > 0 )
1139  {
1140  ADD_CHAR( CHAR_ZERO );
1141  --val_zdigs;
1142  }
1143  else if( val_digs > 0 )
1144  {
1145  DBG_ASSERT( val > 0 );
1146  if( chars != 0 )
1147  {
1148  ADD_CHAR( chars & 0xff );
1149  chars >>= 8;
1150  }
1151  else
1152  {
1153  ADD_CHAR( CHAR_ZERO + (val % 10) );
1154  }
1155  val /= 10;
1156  --val_digs;
1157  }
1158  else
1159  {
1160  ADD_CHAR( CHAR_ZERO );
1161  }
1162  }
1163  ADD_CHAR( CHAR_DOT );
1164  }
1165 
1166 
1167  /* output int part */
1168  i = 0;
1169  for( ;; )
1170  {
1171  if( addcommas && (i & 3) == 3 && val_digs > 0 )
1172  { /* insert comma */
1173  ADD_CHAR( CHAR_COMMA );
1174  }
1175  else if( val_zdigs > 0 )
1176  {
1177  ADD_CHAR( CHAR_ZERO );
1178  --val_zdigs;
1179  }
1180  else if( val_digs > 0 )
1181  {
1182  DBG_ASSERT( val > 0 );
1183  if( chars != 0 )
1184  {
1185  ADD_CHAR( chars & 0xff );
1186  chars >>= 8;
1187  }
1188  else
1189  {
1190  ADD_CHAR( CHAR_ZERO + (val % 10) );
1191  }
1192  val /= 10;
1193  --val_digs;
1194  }
1195  else
1196  {
1197  if( i == 0 && intdigs > 0 )
1198  {
1199  ADD_CHAR( CHAR_ZERO );
1200  }
1201  else
1202  {
1203  break;
1204  }
1205  }
1206  DBG_ASSERT( intdigs > 0 );
1207  ++i;
1208  --intdigs;
1209  }
1210 
1211  DBG_ASSERT( val == 0 );
1212  DBG_ASSERT( val_digs == 0 );
1213  DBG_ASSERT( val_zdigs == 0 );
1214 
1215  DBG_ASSERT( decdigs == 0 );
1216  DBG_ASSERT( expdigs == 0 );
1217  DBG_ASSERT( intdigs >= 0 );
1218 
1219  /* output dollar sign? */
1220  if( adddollar )
1221  {
1222  ADD_CHAR( CHAR_DOLLAR );
1223  }
1224 
1225  /* output sign? */
1226  if( signatstart )
1227  {
1228  if( val_isneg )
1229  {
1230  ADD_CHAR( CHAR_MINUS );
1231  }
1232  else
1233  {
1234  ADD_CHAR( plussign? CHAR_PLUS : padchar );
1235  }
1236  }
1237 
1238  /* output padding for any remaining intdigs */
1239  for( ; intdigs > 0; --intdigs )
1240  {
1241  ADD_CHAR( padchar );
1242  }
1243 
1244  /* output '%' sign(s)? */
1245  for( ; toobig > 0; --toobig )
1246  {
1247  ADD_CHAR( CHAR_TOOBIG );
1248  }
1249 
1250 
1251 
1252  ++p;
1253  fb_PrintFixString( fnum, p, 0 );
1254 
1255  /* ------------------------------------------------------ */
1256 
1257  /* any text */
1258  fb_PrintUsingFmtStr( fnum );
1259 
1260 
1261  if( mask & (FB_PRINT_NEWLINE | FB_PRINT_PAD) )
1262  {
1263  fb_PrintVoid( fnum, mask & (FB_PRINT_NEWLINE | FB_PRINT_PAD) );
1264  }
1265 
1266  if( mask & FB_PRINT_ISLAST )
1267  {
1268  fb_StrDelete( &ctx->fmtstr );
1269  }
1270 
1271  return fb_ErrorSetNum( FB_RTERROR_OK );
1272 }
1273 
1274 static unsigned long long hScaleDoubleToULL( double value, int *pval_exp )
1275 {
1276  DBG_ASSERT( value >= 0.0 );
1277 
1278 #if 0
1279  /* scale down to a 16-digit number, plus base-10 exponent */
1280 
1281  if( value == 0.0 )
1282  {
1283  *pval_exp = 0;
1284  return 0;
1285  }
1286  long double val_ld = value;
1287  unsigned long long val_ull;
1288  int val_exp;
1289 
1290  /* find number of digits in double (approximation, may be 1 lower) */
1291 
1292  val_exp = 1 + (int)floor( log10( val_ld ) - 0.5 );
1293 
1294  /* scale down to 16..17 digits (use long doubles to prevent inaccuracy/overflow in pow) */
1295  val_exp -= 16;
1296  val_ld /= pow( (long double)10.0, val_exp );
1297  if( val_ld >= (long double)1.E+16 )
1298  {
1299  val_ld /= (long double)10.0;
1300  ++val_exp;
1301  }
1302 
1303  /* convert to ULL */
1304  val_ull = (unsigned long long)(val_ld + 0.5);
1305  DBG_ASSERT( val_ull >= (unsigned long long)1.E+15 || val_ull == 0 );
1306  DBG_ASSERT( val_ull <= (unsigned long long)1.E+16 );
1307 
1308  *pval_exp = val_exp;
1309  return val_ull;
1310 #else
1311 
1312  /*(assumes x86 endian, IEEE-754 floating-point format) */
1313 
1314  unsigned long long val_ull;
1315  int digs;
1316  int pow2, pow10;
1317 
1318  val_ull = hDoubleToLongBits( value );
1319  pow2 = (val_ull >> 52) - 1023;
1320  val_ull &= (1ull << 52)-1;
1321 
1322  if( pow2 > -1023 )
1323  { /* normalized */
1324  val_ull |= (1ull << 52);
1325  }
1326  else
1327  { /* denormed */
1328  pow2 += 1;
1329  }
1330  pow2 -= 52; /* 52 (+1?) integer bits in val_ull */
1331 
1332  pow10 = 0;
1333 
1334  while( pow2 > 0 )
1335  {
1336  /* essentially, val_ull*=2, --pow2,
1337  * dividing by 5 when necessary to keep within 64 bits) */
1338  if( val_ull < (1ull << 63) )
1339  {
1340  val_ull *= 2;
1341  --pow2;
1342  }
1343  else
1344  {
1345  /* divide by 5, rounding to nearest
1346  * (val_ull will be much bigger than 3 so no underflow) */
1347  val_ull = (val_ull - 3) / 5 + 1;
1348  ++pow10;
1349  --pow2;
1350  }
1351  }
1352 
1353  while( pow2 < 0 )
1354  {
1355  /* essentially, val_ull/=2, ++pow2,
1356  * multiplying by 5 when possible to keep precision high */
1357  if( val_ull <= 0x3333333333333333ull )
1358  { /* multiply by 5 (max 0xffffffffffffffff) */
1359  val_ull *= 5;
1360  --pow10;
1361  ++pow2;
1362  }
1363  else
1364  { /* divide by 2, rounding to even */
1365  val_ull = val_ull / 2 + (val_ull & (val_ull / 2) & 1);
1366  ++pow2;
1367  }
1368  }
1369 
1370  digs = hNumDigits( val_ull );
1371  if( digs > DBL_MAXDIGS )
1372  { /* scale to 16 digits */
1373 
1374  int scale = digs - DBL_MAXDIGS;
1375  val_ull = hDivPow10_ULL( val_ull, scale );
1376  pow10 += scale;
1377 
1378  DBG_ASSERT( val_ull <= hPow10_ULL( DBL_MAXDIGS ) );
1379  }
1380 
1381  *pval_exp = pow10;
1382  return val_ull;
1383 
1384 #endif
1385 }
1386 
1387 FBCALL int fb_PrintUsingDouble( int fnum, double value, int mask )
1388 {
1389  int val_exp = 0;
1390  int flags;
1391  unsigned long long val_ull = 1;
1392 
1393  flags = VAL_ISFLOAT;
1394 
1395  if( hIsNeg( value ) )
1396  flags |= VAL_ISNEG;
1397 
1398  if( hIsZero( value ) )
1399  {
1400  val_ull = 0;
1401  val_exp = 0;
1402  }
1403  else if( hIsFinite( value ) )
1404  {
1405  value = fabs( value );
1406  val_ull = hScaleDoubleToULL( value, &val_exp );
1407  }
1408  else
1409  {
1410  if( hIsInf( value ) )
1411  flags |= VAL_ISINF;
1412  else if( hIsInd( value ) )
1413  flags |= VAL_ISIND;
1414  else if( hIsNan( value ) )
1415  flags |= VAL_ISNAN;
1416  else
1417  DBG_ASSERT( 0 );
1418  }
1419 
1420  return hPrintNumber( fnum, val_ull, val_exp, flags, mask );
1421 }
1422 
1423 FBCALL int fb_PrintUsingSingle( int fnum, float value_f, int mask )
1424 {
1425  int val_exp = 0;
1426  int flags;
1427  unsigned long long val_ull = 1;
1428 
1429  flags = VAL_ISFLOAT | VAL_ISSNG;
1430 
1431  if( hIsNeg( value_f ) )
1432  flags |= VAL_ISNEG;
1433 
1434  if( hIsZero( value_f ) )
1435  {
1436  val_ull = 0;
1437  val_exp = 0;
1438  }
1439  else if( hIsFinite( value_f ) )
1440  {
1441  value_f = fabs( value_f );
1442  val_ull = hScaleDoubleToULL( value_f, &val_exp );
1443  }
1444  else
1445  {
1446  if( hIsInf( value_f ) )
1447  flags |= VAL_ISINF;
1448  else if( hIsInd( value_f ) )
1449  flags |= VAL_ISIND;
1450  else if( hIsNan( value_f ) )
1451  flags |= VAL_ISNAN;
1452  else
1453  DBG_ASSERT( 0 );
1454  }
1455 
1456  return hPrintNumber( fnum, val_ull, val_exp, flags, mask );
1457 }
1458 
1459 FBCALL int fb_PrintUsingULongint( int fnum, unsigned long long value_ull, int mask )
1460 {
1461  return hPrintNumber( fnum, value_ull, 0, 0, mask );
1462 }
1463 
1464 FBCALL int fb_PrintUsingLongint( int fnum, long long val_ll, int mask )
1465 {
1466  int flags;
1467  unsigned long long val_ull;
1468 
1469  if( val_ll < 0 )
1470  {
1471  flags = VAL_ISNEG;
1472  val_ull = -val_ll;
1473  }
1474  else
1475  {
1476  flags = 0;
1477  val_ull = val_ll;
1478  }
1479 
1480  return hPrintNumber( fnum, val_ull, 0, flags, mask );
1481 }