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

Diff for /gforth/prim between versions 1.41 and 1.45

version 1.41, 1999/12/03 18:24:22 version 1.45, 2000/05/16 09:51:21
Line 496  if (n<0) Line 496  if (n<0)
 else if (n>0)  else if (n>0)
   n = 1;    n = 1;
 :  :
  rot 2dup - >r min swap -text dup   rot 2dup swap - >r min swap -text dup
  IF    rdrop   IF  rdrop  ELSE  drop r> sgn  THEN ;
  ELSE  drop r@ 0>  : sgn ( n -- -1/0/1 )
        IF    rdrop -1   dup 0= IF EXIT THEN  0< 2* 1+ ;
        ELSE  r> 1 and  
        THEN  
  THEN ;  
   
 -text           c_addr1 u c_addr2 -- n  new     dash_text  -text           c_addr1 u c_addr2 -- n  new     dash_text
 n = memcmp(c_addr1, c_addr2, u);  n = memcmp(c_addr1, c_addr2, u);
Line 514  else if (n>0) Line 511  else if (n>0)
  swap bounds   swap bounds
  ?DO  dup c@ I c@ = WHILE  1+  LOOP  drop 0   ?DO  dup c@ I c@ = WHILE  1+  LOOP  drop 0
  ELSE  c@ I c@ - unloop  THEN  -text-flag ;   ELSE  c@ I c@ - unloop  THEN  -text-flag ;
 : -text-flag ( n -- -1/0/1 )  : sgn ( n -- -1/0/1 )
  dup 0< IF  drop -1  ELSE  0>  1 and  THEN  ;   dup 0= IF EXIT THEN  0< 2* 1+ ;
   
 toupper c1 -- c2        gforth  toupper c1 -- c2        gforth
 ""If @i{c1} is a lower-case character (in the current locale), @i{c2}  ""If @i{c1} is a lower-case character (in the current locale), @i{c2}
Line 1499  wretval = pclose((FILE *)wfileid); Line 1496  wretval = pclose((FILE *)wfileid);
 wior = IOR(wretval==-1);  wior = IOR(wretval==-1);
   
 time&date       -- nsec nmin nhour nday nmonth nyear    facility-ext    time_and_date  time&date       -- nsec nmin nhour nday nmonth nyear    facility-ext    time_and_date
   ""Report the current time of day. Seconds, minutes and hours are numbered from 0.
   Months are numbered from 1.""
 struct timeval time1;  struct timeval time1;
 struct timezone zone1;  struct timezone zone1;
 struct tm *ltime;  struct tm *ltime;
Line 1512  nmin  =ltime->tm_min; Line 1511  nmin  =ltime->tm_min;
 nsec  =ltime->tm_sec;  nsec  =ltime->tm_sec;
   
 ms      n --    facility-ext  ms      n --    facility-ext
   ""Wait at least @i{n} milli-second.""
 struct timeval timeout;  struct timeval timeout;
 timeout.tv_sec=n/1000;  timeout.tv_sec=n/1000;
 timeout.tv_usec=1000*(n%1000);  timeout.tv_usec=1000*(n%1000);
Line 1636  if (wior) Line 1636  if (wior)
   clearerr((FILE *)wfileid);    clearerr((FILE *)wfileid);
   
 read-line       c_addr u1 wfileid -- u2 flag wior       file    read_line  read-line       c_addr u1 wfileid -- u2 flag wior       file    read_line
 /*  #if 1
 Cell c;  Cell c;
 flag=-1;  flag=-1;
 for(u2=0; u2<u1; u2++)  for(u2=0; u2<u1; u2++)
 {  {
    *c_addr++ = (Char)(c = getc((FILE *)wfileid));     c = getc((FILE *)wfileid);
    if(c=='\n') break;     if (c=='\n') break;
    if(c==EOF)     if (c=='\r') {
      {       if ((c = getc((FILE *)wfileid))!='\n')
          ungetc(c,(FILE *)wfileid);
        break;
      }
      if (c==EOF) {
         flag=FLAG(u2!=0);          flag=FLAG(u2!=0);
         break;          break;
      }       }
      c_addr[u2] = (Char)c;
 }  }
 wior=FILEIO(ferror((FILE *)wfileid));  wior=FILEIO(ferror((FILE *)wfileid));
 */  #else
 if ((flag=FLAG(!feof((FILE *)wfileid) &&  if ((flag=FLAG(!feof((FILE *)wfileid) &&
                fgets(c_addr,u1+1,(FILE *)wfileid) != NULL))) {                 fgets(c_addr,u1+1,(FILE *)wfileid) != NULL))) {
   wior=FILEIO(ferror((FILE *)wfileid)!=0); /* !! ior? */    wior=FILEIO(ferror((FILE *)wfileid)!=0); /* !! ior? */
Line 1663  else { Line 1668  else {
   wior=0;    wior=0;
   u2=0;    u2=0;
 }  }
   #endif
   
 \+  \+
   
Line 1869  and represents the floating-point number Line 1875  and represents the floating-point number
 Float r;  Float r;
 char *number=cstr(c_addr, u, 1);  char *number=cstr(c_addr, u, 1);
 char *endconv;  char *endconv;
   int sign = 0;
   if(number[0]=='-') {
      sign = 1;
      number++;
      u--;
   }
 while(isspace((unsigned)(number[--u])) && u>0);  while(isspace((unsigned)(number[--u])) && u>0);
 switch(number[u])  switch(number[u])
 {  {
Line 1884  if((flag=FLAG(!(Cell)*endconv))) Line 1896  if((flag=FLAG(!(Cell)*endconv)))
 {  {
    IF_FTOS(fp[0] = FTOS);     IF_FTOS(fp[0] = FTOS);
    fp += -1;     fp += -1;
    FTOS = r;     FTOS = sign ? -r : r;
 }  }
 else if(*endconv=='d' || *endconv=='D')  else if(*endconv=='d' || *endconv=='D')
 {  {
Line 1894  else if(*endconv=='d' || *endconv=='D') Line 1906  else if(*endconv=='d' || *endconv=='D')
      {       {
         IF_FTOS(fp[0] = FTOS);          IF_FTOS(fp[0] = FTOS);
         fp += -1;          fp += -1;
         FTOS = r;          FTOS = sign ? -r : r;
      }       }
 }  }
   
Line 2191  fp=FP; Line 2203  fp=FP;
 IF_TOS(TOS=sp[0];)  IF_TOS(TOS=sp[0];)
 IF_FTOS(FTOS=fp[0]);  IF_FTOS(FTOS=fp[0]);
   
   newline -- c_addr u     gforth
   ""String containing the newline sequence of the host OS""
   char newline[] = {
   #ifdef unix
   '\n'
   #else
   '\r','\n'
   #endif
   };
   c_addr=newline;
   u=sizeof(newline);
Removed from v.1.41  
changed lines
  Added in v.1.45

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