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

Diff for /gforth/prim between versions 1.44 and 1.46

version 1.44, 2000/03/17 21:32:03 version 1.46, 2000/05/31 14:37:40
Line 488  the first string is smaller, @i{n} is -1 Line 488  the first string is smaller, @i{n} is -1
 is 1. Currently this is based on the machine's character  is 1. Currently this is based on the machine's character
 comparison. In the future, this may change to consider the current  comparison. In the future, this may change to consider the current
 locale and its collation order.""  locale and its collation order.""
   /* close ' to keep fontify happy */ 
 n = memcmp(c_addr1, c_addr2, u1<u2 ? u1 : u2);  n = memcmp(c_addr1, c_addr2, u1<u2 ? u1 : u2);
 if (n==0)  if (n==0)
   n = u1-u2;    n = u1-u2;
Line 1484  getenv c_addr1 u1 -- c_addr2 u2 gforth Line 1485  getenv c_addr1 u1 -- c_addr2 u2 gforth
 is the host operating system's expansion of that environment variable. If the  is the host operating system's expansion of that environment variable. If the
 environment variable does not exist, @i{c-addr2 u2} specifies a string 0 characters  environment variable does not exist, @i{c-addr2 u2} specifies a string 0 characters
 in length.""  in length.""
   /* close ' to keep fontify happy */
 c_addr2 = getenv(cstr(c_addr1,u1,1));  c_addr2 = getenv(cstr(c_addr1,u1,1));
 u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2));  u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2));
   
Line 1545  I/O result code. If @i{a-addr1} is 0, Gf Line 1547  I/O result code. If @i{a-addr1} is 0, Gf
 @code{resize} @code{allocate}s @i{u} address units.""  @code{resize} @code{allocate}s @i{u} address units.""
 /* the following check is not necessary on most OSs, but it is needed  /* the following check is not necessary on most OSs, but it is needed
    on SunOS 4.1.2. */     on SunOS 4.1.2. */
   /* close ' to keep fontify happy */
 if (a_addr1==NULL)  if (a_addr1==NULL)
   a_addr2 = (Cell *)malloc(u);    a_addr2 = (Cell *)malloc(u);
 else  else
Line 1636  if (wior) Line 1639  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 1671  else {
   wior=0;    wior=0;
   u2=0;    u2=0;
 }  }
   #endif
   
 \+  \+
   
Line 2148  rret = (SYSCALL(Float(*)(argdlist($1)))u Line 2157  rret = (SYSCALL(Float(*)(argdlist($1)))u
   
 ')  ')
   
   \ close ' to keep fontify happy
   
 open-lib        c_addr1 u1 -- u2        gforth  open_lib  open-lib        c_addr1 u1 -- u2        gforth  open_lib
 #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)  #if defined(HAVE_LIBDL) || defined(HAVE_DLOPEN)
Line 2197  fp=FP; Line 2207  fp=FP;
 IF_TOS(TOS=sp[0];)  IF_TOS(TOS=sp[0];)
 IF_FTOS(FTOS=fp[0]);  IF_FTOS(FTOS=fp[0]);
   
   \+file
   
   open-dir        c_addr u -- wdirid wior gforth  open_dir
   wdirid = (Cell)opendir(tilde_cstr(c_addr, u, 1));
   wior =  IOR(wdirid == 0);
   
   read-dir        c_addr u1 wdirid -- u2 flag wior        gforth  read_dir
   struct dirent * dent;
   dent = readdir((DIR *)wdirid);
   wior = 0;
   flag = -1;
   if(dent == NULL) {
     u2 = 0;
     flag = 0;
   } else {
     u2 = strlen(dent->d_name);
     if(u2 > u1)
       u2 = u1;
     memmove(c_addr, dent->d_name, u2);
   }
   
   close-dir       wdirid -- wior  gforth  close_dir
   wior = IOR(closedir((DIR *)wdirid));
   
   filename-match  c_addr1 u1 c_addr2 u2 -- flag   gforth  match_file
   char * string = cstr(c_addr1, u1, 1);
   char * pattern = cstr(c_addr2, u2, 0);
   flag = FLAG(!fnmatch(pattern, string, 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.44  
changed lines
  Added in v.1.46

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