static mlval decimal_rep (mlval arg) { int dec; int sign; char * digits; mlval result; digits = dtoa (GETREAL(arg),0,100,&dec,&sign,NULL); root = allocate_string (strlen(digits) + 1); strcpy (CSTRING(root),digits); freedtoa (digits); result = allocate_record (3); FIELD (result,0) = root; FIELD (result,1) = MLINT (dec); FIELD (result,2) = sign ? MLTRUE : MLFALSE; return (result); }
g__fmt(char *b, char *s, char *se, int decpt, ULong sign, size_t blen) #endif { int i, j, k; char *be, *s0; size_t len; #ifdef USE_LOCALE #ifdef NO_LOCALE_CACHE char *decimalpoint = localeconv()->decimal_point; size_t dlen = strlen(decimalpoint); #else char *decimalpoint; static char *decimalpoint_cache; static size_t dlen; if (!(s0 = decimalpoint_cache)) { s0 = localeconv()->decimal_point; dlen = strlen(s0); if ((decimalpoint_cache = (char*)MALLOC(strlen(s0) + 1))) { strcpy(decimalpoint_cache, s0); s0 = decimalpoint_cache; } } decimalpoint = s0; #endif #else #define dlen 0 #endif s0 = s; len = (se-s) + dlen + 6; /* 6 = sign + e+dd + trailing null */ if (blen < len) goto ret0; be = b + blen - 1; if (sign) *b++ = '-'; if (decpt <= -4 || decpt > se - s + 5) { *b++ = *s++; if (*s) { #ifdef USE_LOCALE while((*b = *decimalpoint++)) ++b; #else *b++ = '.'; #endif while((*b = *s++) !=0) b++; } *b++ = 'e'; /* sprintf(b, "%+.2d", decpt - 1); */ if (--decpt < 0) { *b++ = '-'; decpt = -decpt; } else *b++ = '+'; for(j = 2, k = 10; 10*k <= decpt; j++, k *= 10){} for(;;) { i = decpt / k; if (b >= be) goto ret0; *b++ = i + '0'; if (--j <= 0) break; decpt -= i*k; decpt *= 10; } *b = 0; } else if (decpt <= 0) { #ifdef USE_LOCALE while((*b = *decimalpoint++)) ++b; #else *b++ = '.'; #endif if (be < b - decpt + (se - s)) goto ret0; for(; decpt < 0; decpt++) *b++ = '0'; while((*b = *s++) != 0) b++; } else { while((*b = *s++) != 0) { b++; if (--decpt == 0 && *s) { #ifdef USE_LOCALE while(*b = *decimalpoint++) ++b; #else *b++ = '.'; #endif } } if (b + decpt > be) { ret0: b = 0; goto ret; } for(; decpt > 0; decpt--) *b++ = '0'; *b = 0; } ret: freedtoa(s0); return b; }
char * g_fmt(register char *b, double x) { register int i, k; register char *s; int decpt, j, sign; char *b0, *s0, *se; b0 = b; #ifdef IGNORE_ZERO_SIGN if (!x) { *b++ = '0'; *b = 0; goto done; } #endif s = s0 = dtoa(x, 0, 0, &decpt, &sign, &se); if (sign) *b++ = '-'; if (decpt == 9999) { // Infinity or Nan while(*b++ = *s++); goto done0; } if (decpt <= -4 || decpt > se - s + 5) { *b++ = *s++; if (*s) { *b++ = '.'; while(*b = *s++) b++; } *b++ = 'e'; // sprintf(b, "%+.2d", decpt - 1); if (--decpt < 0) { *b++ = '-'; decpt = -decpt; } else *b++ = '+'; for(j = 2, k = 10; 10*k <= decpt; j++, k *= 10); for(;;) { i = decpt / k; *b++ = i + '0'; if (--j <= 0) break; decpt -= i*k; decpt *= 10; } *b = 0; } else if (decpt <= 0) { *b++ = '.'; for(; decpt < 0; decpt++) *b++ = '0'; while(*b++ = *s++); } else { while(*b = *s++) { b++; if (--decpt == 0 && *s) *b++ = '.'; } for(; decpt > 0; decpt--) *b++ = '0'; *b = 0; } done0: freedtoa(s0); done: return b0; }
char * format_float(double f, char *buf) { char *end, *o=buf; int decpt, sign; char *s = dtoa(f, 0, 30, &decpt, &sign, &end); DEBUG(2, Sdprintf("decpt=%d, sign=%d, len = %d, '%s'\n", decpt, sign, end-s, s)); if ( sign ) *o++ = '-'; if ( decpt <= 0 ) /* decimal dot before */ { if ( decpt <= -4 ) { *o++ = s[0]; *o++ = '.'; if ( end-s > 1 ) { memcpy(o, s+1, end-s-1); o += end-s-1; } else *o++ = '0'; sprintf(o, "e%d", decpt-1); } else { int i; *o++ = '0'; *o++ = '.'; for(i=0; i < -decpt; i++) *o++ = '0'; memcpy(o, s, end-s); o[end-s] = 0; } } else if ( end-s > decpt ) /* decimal dot inside */ { memcpy(o, s, decpt); o += decpt; *o++ = '.'; memcpy(o, s+decpt, end-s-decpt); o[end-s-decpt] = 0; } else /* decimal dot after */ { int i; int trailing = decpt-(int)(end-s); if ( decpt > 15 ) /* over precision: use eE */ { *o++ = s[0]; *o++ = '.'; if ( end-s > 1 ) { trailing += (int)(end-s)-1; memcpy(o, s+1, end-s-1); o += end-s-1; } else *o++ = '0'; sprintf(o, "e+%d", trailing); } else /* within precision trail with .0 */ { memcpy(o, s, end-s); o += end-s; for(i=(int)(end-s); i<decpt; i++) *o++ = '0'; *o++ = '.'; *o++ = '0'; *o = 0; } } freedtoa(s); return buf; }
int fpconv_g_fmt(char *b, double x, int precision) { register int i, k; register char *s; int decpt, j, sign; char *b0, *s0, *se; b0 = b; #ifdef IGNORE_ZERO_SIGN if (!x) { *b++ = '0'; *b = 0; goto done; } #endif s = s0 = dtoa(x, 2, precision, &decpt, &sign, &se); if (sign) *b++ = '-'; if (decpt == 9999) /* Infinity or Nan */ { while((*b++ = *s++)); /* "b" is used to calculate the return length. Decrement to exclude the * Null terminator from the length */ b--; goto done0; } if (decpt <= -4 || decpt > precision) { *b++ = *s++; if (*s) { *b++ = '.'; while((*b = *s++)) b++; } *b++ = 'e'; /* sprintf(b, "%+.2d", decpt - 1); */ if (--decpt < 0) { *b++ = '-'; decpt = -decpt; } else *b++ = '+'; for(j = 2, k = 10; 10*k <= decpt; j++, k *= 10); for(;;) { i = decpt / k; *b++ = i + '0'; if (--j <= 0) break; decpt -= i*k; decpt *= 10; } *b = 0; } else if (decpt <= 0) { *b++ = '0'; *b++ = '.'; for(; decpt < 0; decpt++) *b++ = '0'; while((*b++ = *s++)); b--; } else { while((*b = *s++)) { b++; if (--decpt == 0 && *s) *b++ = '.'; } for(; decpt > 0; decpt--) *b++ = '0'; *b = 0; } done0: freedtoa(s0); #ifdef IGNORE_ZERO_SIGN done: #endif return b - b0; }
int __printf_render_float(struct __printf_io* io, const struct printf_info* pi, const void* const* arg) { int prec; /* precision from format; <0 for N/A */ char* dtoaresult; /* buffer allocated by dtoa */ char expchar; /* exponent character: [eEpP\0] */ char* cp; int expt; /* integer value of exponent */ int signflag; /* true if float is negative */ char* dtoaend; /* pointer to end of converted digits */ char sign; /* sign prefix (' ', '+', '-', or \0) */ int size; /* size of converted field or string */ int ndig; /* actual number of digits returned by dtoa */ int expsize; /* character count for expstr */ char expstr[MAXEXPDIG + 2]; /* buffer for exponent string: e+ZZZ */ int nseps; /* number of group separators with ' */ int nrepeats; /* number of repeats of the last group */ const char* grouping; /* locale specific numeric grouping rules */ int lead; /* sig figs before decimal or group sep */ long double ld; double d; int realsz; /* field size expanded by dprec, sign, etc */ int dprec; /* a copy of prec if [diouxX], 0 otherwise */ char ox[2]; /* space for 0x; ox[1] is either x, X, or \0 */ int prsize; /* max size of printed field */ int ret; /* return value accumulator */ char* decimal_point; /* locale specific decimal point */ int n2; /* XXX: for PRINTANDPAD */ char thousands_sep; /* locale specific thousands separator */ char buf[BUF]; /* buffer with space for digits of uintmax_t */ const char* xdigs; int flag; prec = pi->prec; ox[1] = '\0'; sign = pi->showsign; flag = 0; ret = 0; thousands_sep = *(localeconv()->thousands_sep); grouping = NULL; if (pi->alt) { grouping = localeconv()->grouping; } decimal_point = localeconv()->decimal_point; dprec = -1; switch (pi->spec) { case 'a': case 'A': if (pi->spec == 'a') { ox[1] = 'x'; xdigs = __lowercase_hex; expchar = 'p'; } else { ox[1] = 'X'; xdigs = __uppercase_hex; expchar = 'P'; } if (prec >= 0) { prec++; } if (pi->is_long_double) { ld = *((long double*)arg[0]); dtoaresult = cp = __hldtoa(ld, xdigs, prec, &expt, &signflag, &dtoaend); } else { d = *((double*)arg[0]); dtoaresult = cp = __hdtoa(d, xdigs, prec, &expt, &signflag, &dtoaend); } if (prec < 0) { prec = dtoaend - cp; } if (expt == INT_MAX) { ox[1] = '\0'; } goto fp_common; case 'e': case 'E': expchar = pi->spec; if (prec < 0) { /* account for digit before decpt */ prec = DEFPREC + 1; } else { prec++; } break; case 'f': case 'F': expchar = '\0'; break; case 'g': case 'G': expchar = pi->spec - ('g' - 'e'); if (prec == 0) { prec = 1; } break; default: assert(pi->spec == 'f'); } if (prec < 0) { prec = DEFPREC; } if (pi->is_long_double) { ld = *((long double*)arg[0]); dtoaresult = cp = __ldtoa(&ld, expchar ? 2 : 3, prec, &expt, &signflag, &dtoaend); } else { d = *((double*)arg[0]); dtoaresult = cp = dtoa(d, expchar ? 2 : 3, prec, &expt, &signflag, &dtoaend); if (expt == 9999) { expt = INT_MAX; } } fp_common: if (signflag) { sign = '-'; } if (expt == INT_MAX) { /* inf or nan */ if (*cp == 'N') { cp = (pi->spec >= 'a') ? "nan" : "NAN"; sign = '\0'; } else { cp = (pi->spec >= 'a') ? "inf" : "INF"; } size = 3; flag = 1; goto here; } ndig = dtoaend - cp; if (pi->spec == 'g' || pi->spec == 'G') { if (expt > -4 && expt <= prec) { /* Make %[gG] smell like %[fF] */ expchar = '\0'; if (pi->alt) { prec -= expt; } else { prec = ndig - expt; } if (prec < 0) { prec = 0; } } else { /* * Make %[gG] smell like %[eE], but * trim trailing zeroes if no # flag. */ if (!pi->alt) { prec = ndig; } } } if (expchar) { expsize = exponent(expstr, expt - 1, expchar); size = expsize + prec; if (prec > 1 || pi->alt) { ++size; } } else { /* space for digits before decimal point */ if (expt > 0) { size = expt; } else { /* "0" */ size = 1; } /* space for decimal pt and following digits */ if (prec || pi->alt) { size += prec + 1; } if (grouping && expt > 0) { /* space for thousands' grouping */ nseps = nrepeats = 0; lead = expt; while (*grouping != CHAR_MAX) { if (lead <= *grouping) { break; } lead -= *grouping; if (*(grouping + 1)) { nseps++; grouping++; } else { nrepeats++; } } size += nseps + nrepeats; } else { lead = expt; } } here: /* * All reasonable formats wind up here. At this point, `cp' * points to a string which (if not flags&LADJUST) should be * padded out to `width' places. If flags&ZEROPAD, it should * first be prefixed by any sign or other prefix; otherwise, * it should be blank padded before the prefix is emitted. * After any left-hand padding and prefixing, emit zeroes * required by a decimal [diouxX] precision, then print the * string proper, then emit zeroes required by any leftover * floating precision; finally, if LADJUST, pad with blanks. * * Compute actual size, so we know how much to pad. * size excludes decimal prec; realsz includes it. */ realsz = dprec > size ? dprec : size; if (sign) { realsz++; } if (ox[1]) { realsz += 2; } prsize = pi->width > realsz ? pi->width : realsz; /* right-adjusting blank padding */ if (pi->pad != '0' && pi->left == 0) { ret += __printf_pad(io, pi->width - realsz, 0); } /* prefix */ if (sign) { ret += __printf_puts(io, &sign, 1); } if (ox[1]) { /* ox[1] is either x, X, or \0 */ ox[0] = '0'; ret += __printf_puts(io, ox, 2); } /* right-adjusting zero padding */ if (pi->pad == '0' && pi->left == 0) { ret += __printf_pad(io, pi->width - realsz, 1); } /* leading zeroes from decimal precision */ ret += __printf_pad(io, dprec - size, 1); if (flag) { ret += __printf_puts(io, cp, size); } else { /* glue together f_p fragments */ if (!expchar) { /* %[fF] or sufficiently short %[gG] */ if (expt <= 0) { ret += __printf_puts(io, "0", 1); if (prec || pi->alt) { ret += __printf_puts(io, decimal_point, 1); } ret += __printf_pad(io, -expt, 1); /* already handled initial 0's */ prec += expt; } else { PRINTANDPAD(cp, dtoaend, lead, 1); cp += lead; if (grouping) { while (nseps > 0 || nrepeats > 0) { if (nrepeats > 0) { nrepeats--; } else { grouping--; nseps--; } ret += __printf_puts(io, &thousands_sep, 1); PRINTANDPAD(cp, dtoaend, *grouping, 1); cp += *grouping; } if (cp > dtoaend) { cp = dtoaend; } } if (prec || pi->alt) { ret += __printf_puts(io, decimal_point, 1); } } PRINTANDPAD(cp, dtoaend, prec, 1); } else { /* %[eE] or sufficiently long %[gG] */ if (prec > 1 || pi->alt) { buf[0] = *cp++; buf[1] = *decimal_point; ret += __printf_puts(io, buf, 2); ret += __printf_puts(io, cp, ndig - 1); ret += __printf_pad(io, prec - ndig, 1); } else { /* XeYYY */ ret += __printf_puts(io, cp, 1); } ret += __printf_puts(io, expstr, expsize); } } /* left-adjusting padding (always blank) */ if (pi->left) { ret += __printf_pad(io, pi->width - realsz, 0); } __printf_flush(io); if (dtoaresult != NULL) { freedtoa(dtoaresult); } return (ret); }
void SEE_freedtoa(char *s) { freedtoa(s); }
static mlval fmt (mlval arg) { char buffer[40]; size_t length; mlval string; mlval format = FIELD (arg, 0); double x = GETREAL (FIELD (arg,1)); int prec = 0; /* Check the precision first */ if (format != EXACT_FORMAT) { int format_type = CINT (FIELD (format, 0)); int min_prec = 0; /* Minimum precision is 0 for SCI and FIX, 1 for GEN. */ if (format_type == GEN_FORMAT) min_prec = 1; if (FIELD (format,1) == MLINT (0)) { /* Argument is NONE => Default precision. */ prec = -1; } else { prec = CINT (FIELD (FIELD (format,1),1)); if (prec < min_prec) exn_raise(perv_exn_ref_size); } } if (isnan (x)) strcpy (buffer,"nan"); else if (is_infinity (x)) if (x > 0.0) strcpy (buffer,"+inf"); else strcpy (buffer,"-inf"); else if (format == EXACT_FORMAT) { /* EXACT conversion required */ /* Note that this doesn't do the right thing with NaN's, but */ /* this should be taken care of on the ML side of things */ int dec; int sign; char * ptr = buffer; char * digits = dtoa (x,0,100,&dec,&sign,NULL); char * dptr = digits; if (sign) *ptr++ = '~'; *ptr++ = '0'; *ptr++ = '.'; /* Don't copy null byte here */ while (*dptr) *ptr++=*dptr++; if (dec != 0){ *ptr++ = 'E'; if (dec < 0) { dec = -dec; *ptr++ = '~'; } /* Now add the exponent */ sprintf (ptr,"%d",dec); ptr += strlen (ptr); } *ptr++ = '\000'; freedtoa (digits); } else { /* Now we have to decipher the format */ size_t i, plus = 0; int point = 0; int format_type = CINT (FIELD (format,0)); if (format_type == FIX_FORMAT) /* FIX */ sprintf (buffer, "%.*f", prec < 0 ? 6 : prec, x); else if (format_type == GEN_FORMAT) /* GEN */ sprintf (buffer, "%.*G", prec < 0 ? 12 : prec,x); else if (format_type == SCI_FORMAT) /* SCI */ sprintf (buffer, "%.*E", prec < 0 ? 6 : prec, x); else sprintf(buffer, "%.18G", x); length = strlen(buffer); /* Now check for correct printing of negative zeroes */ if (x == 0.0) { switch (check_neg_zero(&x)) { case 2: /* -0.0 */ /* May need to modify the output here */ if (*buffer != '-') { /* Yes, we do need to modify */ if (*buffer == '+') { *buffer = '-'; } else { for (i = length+1; i > 0; i--) { buffer[i] = buffer[i-1]; /* Move the characters along the buffer */ }; length++; *buffer = '-'; } } case 0: /* Not actually 0.0 at all */ case 1: /* +0.0 */ default: /* This shouldn't happen */ /* No action required here */ break; } } for(i=0; i<length; ++i) { char c = buffer[i]; if(c == '-') buffer[i] = '~'; else if(c == '.' || c == 'E') point = i; else if(c == '+') plus = i; } /* Win32 screws up G format by printing too many digits */ /* in the exponent. So we contract that part if necessary */ if (point && buffer[point] == 'E') { char c = buffer[point+1]; if (c == '+' || c == '~') point++; if (buffer[point+1] == '0' && isdigit(buffer[point+2]) && isdigit(buffer[point+3])) { buffer[point+1] = buffer[point+2]; buffer[point+2] = buffer[point+3]; buffer[point+3] = '\0'; } } if(plus) { for(i=plus; i<length; ++i) buffer[i] = buffer[i+1]; length--; } if(!point && (format_type != GEN_FORMAT) && !(format_type == FIX_FORMAT && prec == 0)) { buffer[length++] = '.'; buffer[length++] = '0'; buffer[length] = '\0'; } } length = strlen (buffer); string = allocate_string(length+1); strcpy(CSTRING(string), buffer); return(string); }