[BACK]Return to primitives CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/Attic/primitives between versions 1.31 and 1.32

version 1.31, 1995/01/19 19:43:48 version 1.32, 1995/01/24 17:31:23
Line 911  w2 = (Cell)fopen(cstr(c_addr, u, 1), fil Line 911  w2 = (Cell)fopen(cstr(c_addr, u, 1), fil
 wior =  FILEEXIST(w2 == NULL);  wior =  FILEEXIST(w2 == NULL);
   
 create-file     c_addr u ntype -- w2 wior       file    create_file  create-file     c_addr u ntype -- w2 wior       file    create_file
 Cell    fd;  int     fd;
 fd = creat(cstr(c_addr, u, 1), 0644);  fd = creat(cstr(c_addr, u, 1), 0644);
 if (fd > -1) {  if (fd > -1) {
 #ifdef __osf__  #ifdef __osf__
Line 1102  else Line 1102  else
   
 represent               r c_addr u -- n f1 f2   float  represent               r c_addr u -- n f1 f2   float
 char *sig;  char *sig;
 Cell flag;  int flag;
 Cell decpt;  int decpt;
 sig=ecvt(r, u, &decpt, &flag);  sig=ecvt(r, u, &decpt, &flag);
 n=decpt;  n=(Cell)(r==0 ? 1 : decpt);
 f1=FLAG(flag!=0);  f1=FLAG(flag!=0);
 f2=FLAG(isdigit(sig[0])!=0);  f2=FLAG(isdigit(sig[0])!=0);
 memmove(c_addr,sig,u);  memmove(c_addr,sig,u);
Line 1115  memmove(c_addr,sig,u); Line 1115  memmove(c_addr,sig,u);
 Float r;  Float r;
 char *number=cstr(c_addr, u, 1);  char *number=cstr(c_addr, u, 1);
 char *endconv;  char *endconv;
 while(isspace(number[u-1])) u--;  while(isspace(number[--u]) && u>0);
 switch(number[u-1])  switch(number[u])
 {  {
         case 'd':     case 'd':
         case 'D':     case 'D':
         case 'e':     case 'e':
         case 'E': u--; break;     case 'E':  break;
         default: break;     default :  u++; break;
 }  }
 number[u]='\0';  number[u]='\0';
 r=strtod(number,&endconv);  r=strtod(number,&endconv);
 if((flag=FLAG(!(Cell)*endconv)))  if((flag=FLAG(!(Cell)*endconv)))
 {  {
         IF_FTOS(fp[0] = FTOS);     IF_FTOS(fp[0] = FTOS);
         fp += -1;     fp += -1;
         FTOS = r;     FTOS = r;
 }  }
 else if(*endconv=='d' || *endconv=='D')  else if(*endconv=='d' || *endconv=='D')
 {  {
         *endconv='E';     *endconv='E';
         r=strtod(number,&endconv);     r=strtod(number,&endconv);
         if((flag=FLAG(!(Cell)*endconv)))     if((flag=FLAG(!(Cell)*endconv)))
         {       {
                 IF_FTOS(fp[0] = FTOS);          IF_FTOS(fp[0] = FTOS);
                 fp += -1;          fp += -1;
                 FTOS = r;          FTOS = r;
         }       }
 }  }
   
 fabs            r1 -- r2        float-ext  fabs            r1 -- r2        float-ext
Line 1217  r2 = sqrt(r1); Line 1217  r2 = sqrt(r1);
   
 ftan            r1 -- r2        float-ext  ftan            r1 -- r2        float-ext
 r2 = tan(r1);  r2 = tan(r1);
   :
    fsincos f/ ;
   
 fsinh           r1 -- r2        float-ext  fsinh           r1 -- r2        float-ext
 r2 = sinh(r1);  r2 = sinh(r1);
   :
    fexpm1 fdup fdup 1. d>f f+ f/ f+ f2/ ;
   
 fcosh           r1 -- r2        float-ext  fcosh           r1 -- r2        float-ext
 r2 = cosh(r1);  r2 = cosh(r1);
   :
    fexp fdup 1/f f+ f2/ ;
   
 ftanh           r1 -- r2        float-ext  ftanh           r1 -- r2        float-ext
 r2 = tanh(r1);  r2 = tanh(r1);
   :
    f2* fexpm1 fdup 2. d>f f+ f/ ;
   
 fasinh          r1 -- r2        float-ext  fasinh          r1 -- r2        float-ext
 r2 = asinh(r1);  r2 = asinh(r1);
   :
    fdup fdup f* 1. d>f f+ fsqrt f/ fatanh ;
   
 facosh          r1 -- r2        float-ext  facosh          r1 -- r2        float-ext
 r2 = acosh(r1);  r2 = acosh(r1);
   :
    fdup fdup f* 1. d>f f- fsqrt f+ fln ;
   
 fatanh          r1 -- r2        float-ext  fatanh          r1 -- r2        float-ext
 r2 = atanh(r1);  r2 = atanh(r1);
   :
    fdup f0< >r fabs 1. d>f fover f- f/  f2* flnp1 f2/
    r> IF  fnegate  THEN ;
   
 \ The following words access machine/OS/installation-dependent ANSI  \ The following words access machine/OS/installation-dependent ANSI
 \   figForth internals  \   figForth internals
Removed from v.1.31  
changed lines
  Added in v.1.32

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