[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