File:  [gforth] / gforth / Attic / ecvt.c
Revision 1.5: download - view: text, annotated - select for diffs
Fri Apr 14 18:56:54 1995 UTC (25 years, 9 months ago) by anton
Branches: MAIN
CVS tags: gforth-0_1beta, HEAD
Put pow10 in a separate file (it is used by ecvt and engine) and
adjusted configure accordingly.
script? is now also set during processing --evaluate arguments. This
avoids getting a newline from "gforth -e bye".

    1: /* cheap ecvt replacement */
    2: 
    3: #include <math.h>
    4: extern double floor(double);
    5: extern double pow10(double);
    6: 
    7: #define MAXCONV 0x40
    8: char scratch[MAXCONV];
    9: 
   10: char* ecvt(double x, int len, int* exp, int* sign)
   11: {
   12:    int i, j;
   13:    double z;
   14:    
   15:    if(len > (MAXCONV-1)) len = MAXCONV-1;
   16:    
   17:    if(x<0)
   18:      {
   19: 	*sign = 1;
   20: 	x = -x;
   21:      }
   22:    else
   23:      {
   24: 	*sign = 0;
   25:      }
   26: 
   27:    if(x==0)
   28: 	*exp=-1;
   29:    else
   30:      *exp=(int)floor(log10(x));
   31:    x = x / pow10((double)*exp);
   32:    
   33:    *exp += 1;
   34:    
   35:    for(i=0; i < len; i++)
   36:      {
   37: 	z=floor(x);
   38: 	scratch[i]='0'+(char)((int)z);
   39: 	x = (x-z)*10;
   40:      }
   41:    
   42:    if((x >= 5) && i)
   43:      {
   44: 	for(j=i-1; j>=0; j--)
   45: 	  {
   46: 	     if(scratch[j]!='9')
   47: 	       {
   48: 		  scratch[j]+=1; break;
   49: 	       }
   50: 	     else
   51: 	       {
   52: 		  scratch[j]='0';
   53: 	       }
   54: 	  }
   55: 	if(j==0)
   56: 	  {
   57: 	     scratch[0]='1';
   58: 	     *exp += 1;
   59: 	  }
   60:      }
   61:    
   62:    scratch[i]='\0';
   63:    
   64:    return scratch;
   65: }
   66: 
   67: #ifdef TEST
   68: int main(int argc, char ** argv)
   69: {
   70:    int a, b;
   71:    char * conv=ecvt(PI*1e10,20,&a,&b);
   72:    
   73:    printf("ecvt Test: %f -> %s, %d, %d\n",PI,conv,a,b);
   74: }
   75: #endif

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>