[gforth] / gforth / Attic / primitives  

gforth: gforth/Attic/primitives

Diff for /gforth/Attic/primitives between version 1.35 and 1.36

version 1.35, Wed Feb 22 18:40:17 1995 UTC version 1.36, Thu Apr 6 16:56:13 1995 UTC
Line 786 
Line 786 
 wfileid=(Cell)popen(cstr(c_addr,u,1),mode[n]);  wfileid=(Cell)popen(cstr(c_addr,u,1),mode[n]);
   
 pclose  wfileid -- wior own  pclose  wfileid -- wior own
 wior=pclose((FILE *)wfileid);  wior=pclose((FILE *)wfileid); /* !! what to do with the result */
   
 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
 struct timeval time1;  struct timeval time1;
Line 809 
Line 809 
   
 allocate        u -- a_addr wior        memory  allocate        u -- a_addr wior        memory
 a_addr = (Cell *)malloc(u);  a_addr = (Cell *)malloc(u);
 wior = a_addr==NULL;    /* !! Define a return code */  wior = IOR(a_addr==NULL);
   
 free            a_addr -- wior          memory  free            a_addr -- wior          memory
 free(a_addr);  free(a_addr);
 wior = 0;  wior = 0;
   
 resize          a_addr1 u -- a_addr2 wior       memory  resize          a_addr1 u -- a_addr2 wior       memory
 a_addr2 = realloc(a_addr1, u);  ""Change the size of the allocated area at @i{a_addr1} to @i{u}
 wior = a_addr2==NULL;   /* !! Define a return code */  address units, possibly moving the contents to a different
   area. @i{a_addr2} is the address of the resulting area. If
   @code{a_addr2} is 0, gforth's (but not the standard) @code{resize}
   @code{allocate}s @i{u} address units.""
   /* the following check is not necessary on most OSs, but it is needed
      on SunOS 4.1.2. */
   if (a_addr1==NULL)
     a_addr2 = (Cell *)malloc(u);
   else
     a_addr2 = (Cell *)realloc(a_addr1, u);
   wior = IOR(a_addr2==NULL);      /* !! Define a return code */
   
 (f83find)       c_addr u f83name1 -- f83name2   new     paren_f83find  (f83find)       c_addr u f83name1 -- f83name2   new     paren_f83find
 for (; f83name1 != NULL; f83name1 = f83name1->next)  for (; f83name1 != NULL; f83name1 = f83name1->next)
Line 910 
Line 920 
  REPEAT  THEN  nip - ;   REPEAT  THEN  nip - ;
   
 close-file      wfileid -- wior file    close_file  close-file      wfileid -- wior file    close_file
 wior = FILEIO(fclose((FILE *)wfileid)==EOF);  wior = IOR(fclose((FILE *)wfileid)==EOF);
   
 open-file       c_addr u ntype -- w2 wior       file    open_file  open-file       c_addr u ntype -- w2 wior       file    open_file
 w2 = (Cell)fopen(cstr(c_addr, u, 1), fileattr[ntype]);  w2 = (Cell)fopen(cstr(c_addr, u, 1), fileattr[ntype]);
 wior =  FILEEXIST(w2 == NULL);  wior =  IOR(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;  Cell    fd;
 fd = open(cstr(c_addr, u, 1), O_CREAT|O_RDWR|O_TRUNC, 0666);  fd = open(cstr(c_addr, u, 1), O_CREAT|O_RDWR|O_TRUNC, 0666);
 if (fd > -1) {  if (fd != -1) {
   w2 = (Cell)fdopen(fd, fileattr[ntype]);    w2 = (Cell)fdopen(fd, fileattr[ntype]);
   assert(w2 != NULL);    wior = IOR(w2==NULL);
   wior = 0;  
 } else {  } else {
   assert(fd == -1);  
   wior = FILEIO(fd);  
   w2 = 0;    w2 = 0;
     wior = IOR(1);
 }  }
   
 delete-file     c_addr u -- wior                file    delete_file  delete-file     c_addr u -- wior                file    delete_file
 wior = FILEEXIST(unlink(cstr(c_addr, u, 1)));  wior = IOR(unlink(cstr(c_addr, u, 1))==-1);
   
 rename-file     c_addr1 u1 c_addr2 u2 -- wior   file-ext        rename_file  rename-file     c_addr1 u1 c_addr2 u2 -- wior   file-ext        rename_file
 char *s1=cstr(c_addr2, u2, 1);  char *s1=cstr(c_addr2, u2, 1);
 wior = FILEEXIST(rename(cstr(c_addr1, u1, 0), s1));  wior = IOR(rename(cstr(c_addr1, u1, 0), s1)==-1);
   
 file-position   wfileid -- ud wior      file    file_position  file-position   wfileid -- ud wior      file    file_position
 /* !! use tell and lseek? */  /* !! use tell and lseek? */
 ud = ftell((FILE *)wfileid);  ud = ftell((FILE *)wfileid);
 wior = 0; /* !! or wior = FLAG(ud<0) */  wior = IOR(ud==-1);
   
 reposition-file ud wfileid -- wior      file    reposition_file  reposition-file ud wfileid -- wior      file    reposition_file
 wior = FILEIO(fseek((FILE *)wfileid, (long)ud, SEEK_SET));  wior = IOR(fseek((FILE *)wfileid, (long)ud, SEEK_SET)==-1);
   
 file-size       wfileid -- ud wior      file    file_size  file-size       wfileid -- ud wior      file    file_size
 struct stat buf;  struct stat buf;
 wior = FILEEXIST(fstat(fileno((FILE *)wfileid), &buf));  wior = IOR(fstat(fileno((FILE *)wfileid), &buf)==-1);
 ud = buf.st_size;  ud = buf.st_size;
   
 resize-file     ud wfileid -- wior      file    resize_file  resize-file     ud wfileid -- wior      file    resize_file
 wior = FILEIO(ftruncate(fileno((FILE *)wfileid), (Cell)ud));  wior = IOR(ftruncate(fileno((FILE *)wfileid), (Cell)ud)==-1);
   
 read-file       c_addr u1 wfileid -- u2 wior    file    read_file  read-file       c_addr u1 wfileid -- u2 wior    file    read_file
 /* !! fread does not guarantee enough */  /* !! fread does not guarantee enough */
 u2 = fread(c_addr, sizeof(Char), u1, (FILE *)wfileid);  u2 = fread(c_addr, sizeof(Char), u1, (FILE *)wfileid);
 wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));  wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));
 /* !! who performs clearerr((FILE *)wfileid); ? */  /* !! is the value of ferror errno-compatible? */
   if (wior)
     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
 /*  /*
Line 976 
Line 986 
 */  */
 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));    wior=FILEIO(ferror((FILE *)wfileid)); /* !! ior? */
     if (wior)
       clearerr((FILE *)wfileid);
   u2 = strlen(c_addr);    u2 = strlen(c_addr);
   u2-=((u2>0) && (c_addr[u2-1]==NEWLINE));    u2-=((u2>0) && (c_addr[u2-1]==NEWLINE));
 }  }
Line 990 
Line 1002 
 {  {
   Cell u2 = fwrite(c_addr, sizeof(Char), u1, (FILE *)wfileid);    Cell u2 = fwrite(c_addr, sizeof(Char), u1, (FILE *)wfileid);
   wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));    wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));
     if (wior)
       clearerr((FILE *)wfileid);
 }  }
   
 flush-file      wfileid -- wior         file-ext        flush_file  flush-file      wfileid -- wior         file-ext        flush_file
 wior = FILEIO(fflush((FILE *) wfileid));  wior = IOR(fflush((FILE *) wfileid)==EOF);
   
 comparisons(f, r1 r2, f_, r1, r2, new, new, float, new)  comparisons(f, r1 r2, f_, r1, r2, new, new, float, new)
 comparisons(f0, r, f_zero_, r, 0., float, new, float, new)  comparisons(f0, r, f_zero_, r, 0., float, new, float, new)
Line 1359 
Line 1373 
   
 up!     a_addr --       new     up_store  up!     a_addr --       new     up_store
 up0=up=(char *)a_addr;  up0=up=(char *)a_addr;
   
   call-c  w --    new     call_c
   ""Call the C function pointed to by @i{w}. The C function has to
   access the stack itself. The stack pointers are exported in the gloabl
   variables @code{SP} and @code{FP}.""
   /* This is a first attempt at support for calls to C. This may change in
      the future */
   IF_FTOS(fp[0]=FTOS);
   FP=fp;
   SP=sp;
   ((void (*)())w)();
   sp=SP;
   fp=FP;
   IF_TOS(TOS=sp[0]);
   IF_FTOS(FTOS=fp[0]);
   
   strerror        n -- c_addr u   new
   c_addr = strerror(n);
   u = strlen(c_addr);

Generate output suitable for use with a patch program
Legend:
Removed from v.1.35  
changed lines
  Added in v.1.36
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help