Diff for /gforth/engine/support.c between versions 1.27 and 1.28

version 1.27, 2007/06/30 20:28:55 version 1.28, 2007/08/19 15:04:08
Line 27 Line 27
 #include <sys/time.h>  #include <sys/time.h>
 #include <unistd.h>  #include <unistd.h>
 #include <pwd.h>  #include <pwd.h>
   #include <assert.h>
 #ifndef STANDALONE  #ifndef STANDALONE
 #include <dirent.h>  #include <dirent.h>
 #include <math.h>  #include <math.h>
Line 361  struct Cellpair file_status(Char *c_addr Line 362  struct Cellpair file_status(Char *c_addr
   
 Cell to_float(Char *c_addr, UCell u, Float *rp)  Cell to_float(Char *c_addr, UCell u, Float *rp)
 {  {
   Float r;    /* convertible string := <significand>[<exponent>]
   Cell flag;       <significand> := [<sign>]{<digits>[.<digits0>] | .<digits> }
   char *number=cstr(c_addr, u, 1);       <exponent>    := <marker><digits0>
        <marker>      := {<e-form> | <sign-form>}
        <e-form>      := <e-char>[<sign-form>]
        <sign-form>   := { + | - }
        <e-char>      := { D | d | E | e }
     */
     Char *s = c_addr;
     Char c;
     Char *send = c_addr+u;
     UCell ndigits = 0;
     UCell ndots = 0;
     UCell edigits = 0;
     char cnum[u+3]; /* append at most "e0\0" */
     char *t=cnum;
   char *endconv;    char *endconv;
   int sign = 0;    Float r;
   if(number[0]==' ') {    
     UCell i;    if (s >= send) /* treat empty string as 0e */
     for (i=1; i<u; i++)      goto return0;
       if (number[i] != ' ')    switch ((c=*s)) {
         return 0;    case ' ':
     *rp = 0.0;      /* "A string of blanks should be treated as a special case
     return -1;         representing zero."*/
   }      for (s++; s<send; )
   if(number[0]=='-') {        if (*s++ != ' ')
     sign = 1;          goto error;
     number++;      goto return0;
     u--;    case '-':
     if (u==0)    case '+': *t++ = c; s++; goto aftersign;
       return 0;    }
   }    aftersign: 
   switch(number[u-1]) {    if (s >= send)
   case 'd':      goto exponent;
     switch (c=*s) {
     case '0' ... '9': *t++ = c; ndigits++; s++; goto aftersign;
     case '.':         *t++ = c; ndots++;   s++; goto aftersign;
     default:                                    goto exponent;
     }
    exponent:
     if (ndigits < 1 || ndots > 1)
       goto error;
     *t++ = 'E';
     if (s >= send)
       goto done;
     switch (c=*s) {
   case 'D':    case 'D':
   case 'e':    case 'd':
   case 'E':      case 'E':
     u--;    case 'e': s++; break;
     break;  
   }  
   number[u]='\0';  
   r=strtod(number,&endconv);  
   flag=FLAG((*endconv)=='\0');  
   if(flag) {  
     if (sign)  
       r = -r;  
   } else if(*endconv=='d' || *endconv=='D') {  
     *endconv='E';  
     r=strtod(number,&endconv);  
     flag=FLAG((*endconv)=='\0');  
     if (flag) {  
       if (sign)  
         r = -r;  
     }  
   }    }
     if (s >= send)
       goto done;
     switch (c=*s) {
     case '+':
     case '-': *t++ = c; s++; break;
     }
    edigits0:
     if (s >= send)
       goto done;
     switch (c=*s) {
     case '0' ... '9': *t++ = c; s++; edigits++; goto edigits0;
     default: goto error;
     }
    done:
     if (edigits == 0)
       *t++ = '0';
     *t++ = '\0';
     assert(t-cnum <= u+3);
     r = strtod(cnum, &endconv);
     assert(*endconv == '\0');
   *rp = r;    *rp = r;
   return flag;    return -1;
    return0:
     *rp = 0.0;
     return -1;
    error:
     *rp = 0.0;
     return 0;
 }  }
 #endif  #endif
   

Removed from v.1.27  
changed lines
  Added in v.1.28


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