[gforth] / gforth / Attic / primitives  

gforth: gforth/Attic/primitives

Diff for /gforth/Attic/primitives between version 1.14 and 1.15

version 1.14, Thu Aug 25 15:25:32 1994 UTC version 1.15, Wed Aug 31 19:42:50 1994 UTC
Line 125 
Line 125 
 condbranch((+loop),n --         fig     paren_plus_loop,  condbranch((+loop),n --         fig     paren_plus_loop,
 /* !! check this thoroughly */  /* !! check this thoroughly */
 int index = *rp;  int index = *rp;
 int olddiff = index-rp[1];  
 /* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */  /* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */
 /* dependent upon two's complement arithmetic */  /* dependent upon two's complement arithmetic */
   int olddiff = index-rp[1];
   #ifndef undefined
 if ((olddiff^(olddiff+n))>=0   /* the limit is not crossed */  if ((olddiff^(olddiff+n))>=0   /* the limit is not crossed */
     || (olddiff^n)>=0          /* it is a wrap-around effect */) {      || (olddiff^n)>=0          /* it is a wrap-around effect */) {
   #else
   #ifndef MAXINT
   #define MAXINT ((1<<(8*sizeof(Cell)-1))-1)
   #endif
   if(((olddiff^MAXINT) >= n) ? ((olddiff+n) >= 0) : ((olddiff+n) < 0)) {
   #endif
   #ifdef i386
       *rp += n;
   #else
     *rp = index+n;      *rp = index+n;
   #endif
     IF_TOS(TOS = sp[0]);      IF_TOS(TOS = sp[0]);
 )  )
   
Line 139 
Line 150 
 crosses the boundary between limit and limit-sign(n). I.e. a symmetric  crosses the boundary between limit and limit-sign(n). I.e. a symmetric
 version of (+LOOP).""  version of (+LOOP).""
 /* !! check this thoroughly */  /* !! check this thoroughly */
 int oldindex = *rp;  int index = *rp;
 int diff = oldindex-rp[1];  int diff = index-rp[1];
 int newdiff = diff+n;  int newdiff = diff+n;
 if (n<0) {  if (n<0) {
     diff = -diff;      diff = -diff;
     newdiff = - newdiff;      newdiff = - newdiff;
 }  }
 if (diff>=0 || newdiff<0) {  if (diff>=0 || newdiff<0) {
     *rp = oldindex+n;  #ifdef i386
       *rp += n;
   #else
       *rp = index + n;
   #endif
     IF_TOS(TOS = sp[0]);      IF_TOS(TOS = sp[0]);
 )  )
   
Line 193 
Line 208 
 fwrite(c_addr,sizeof(Char),n,stdout);  fwrite(c_addr,sizeof(Char),n,stdout);
 emitcounter += n;  emitcounter += n;
   
 key     -- n            fig  (key)   -- n            fig     paren_key
 fflush(stdout);  fflush(stdout);
 /* !! noecho */  /* !! noecho */
 n = key();  n = key();
Line 450 
Line 465 
 f = FLAG(u1-u2 < u3-u2);  f = FLAG(u1-u2 < u3-u2);
   
 sp@     -- a_addr               fig             spat  sp@     -- a_addr               fig             spat
 a_addr = sp;  a_addr = sp+1;
   
 sp!     a_addr --               fig             spstore  sp!     a_addr --               fig             spstore
 sp = a_addr+1;  sp = a_addr;
 /* works with and without TOS caching */  /* works with and without TOS caching */
   
 rp@     -- a_addr               fig             rpat  rp@     -- a_addr               fig             rpat
Line 590 
Line 605 
   
 (bye)   n --    toolkit-ext     paren_bye  (bye)   n --    toolkit-ext     paren_bye
 deprep_terminal();  deprep_terminal();
 exit(n);  return (Label *)n;
   
 system  c_addr u -- n   own  system  c_addr u -- n   own
 char pname[u+1];  n=system(cstr(c_addr,u));
 cstr(pname,c_addr,u);  
 n=system(pname);  
   
 popen   c_addr u n -- wfileid   own  popen   c_addr u n -- wfileid   own
 char pname[u+1];  
 static char* mode[2]={"r","w"};  static char* mode[2]={"r","w"};
 cstr(pname,c_addr,u);  wfileid=(Cell)popen(cstr(c_addr,u),mode[n]);
 wfileid=(Cell)popen(pname,mode[n]);  
   
 pclose  wfileid -- wior own  pclose  wfileid -- wior own
 wior=pclose((FILE *)wfileid);  wior=pclose((FILE *)wfileid);
Line 698 
Line 709 
 wior = FILEIO(fclose((FILE *)wfileid)==EOF);  wior = FILEIO(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
 char fname[u+1];  w2 = (Cell)fopen(cstr(c_addr, u), fileattr[ntype]);
 cstr(fname, c_addr, u);  
 w2 = (Cell)fopen(fname, fileattr[ntype]);  
 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
 int     fd;  int     fd;
 char fname[u+1];  fd = creat(cstr(c_addr, u), 0644);
 cstr(fname, c_addr, u);  
 fd = creat(fname, 0666);  
 if (fd > -1) {  if (fd > -1) {
   w2 = (Cell)fdopen(fd, fileattr[ntype]);    w2 = (Cell)fdopen(fd, fileattr[ntype]);
   assert(w2 != NULL);    assert(w2 != NULL);
Line 719 
Line 726 
 }  }
   
 delete-file     c_addr u -- wior                file    delete_file  delete-file     c_addr u -- wior                file    delete_file
 char fname[u+1];  wior = FILEEXIST(unlink(cstr(c_addr, u)));
 cstr(fname, c_addr, u);  
 wior = FILEEXIST(unlink(fname));  
   
 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 fname1[u1+1];  wior = FILEEXIST(rename(cstr1(c_addr1, u1), cstr(c_addr2, u2)));
 char fname2[u2+1];  
 cstr(fname1, c_addr1, u1);  
 cstr(fname2, c_addr2, u2);  
 wior = FILEEXIST(rename(fname1, fname2));  
   
 file-position   wfileid -- ud wior      file    file_position  file-position   wfileid -- ud wior      file    file_position
 /* !! use tell and lseek? */  /* !! use tell and lseek? */
Line 900 
Line 901 
 >float  c_addr u -- flag        float   to_float  >float  c_addr u -- flag        float   to_float
 /* real signature: c_addr u -- r t / f */  /* real signature: c_addr u -- r t / f */
 Float r;  Float r;
 char number[u+1];  char *number=cstr(c_addr, u);
 char *endconv;  char *endconv;
 cstr(number, c_addr, u);  
 r=strtod(number,&endconv);  r=strtod(number,&endconv);
 if((flag=FLAG(!(int)*endconv)))  if((flag=FLAG(!(int)*endconv)))
 {  {

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help