Diff for /gforth/Attic/primitives between versions 1.41 and 1.42

version 1.41, 1995/10/07 17:38:18 version 1.42, 1995/10/11 19:39:35
Line 89  lit -- w  fig Line 89  lit -- w  fig
 w = (Cell)NEXT_INST;  w = (Cell)NEXT_INST;
 INC_IP(1);  INC_IP(1);
   
 execute         xt --           core,fig  execute         xt --           core
 ip=IP;  ip=IP;
 cfa = xt;  cfa = xt;
 IF_TOS(TOS = sp[0]);  IF_TOS(TOS = sp[0]);
Line 143  if (index != limit) { Line 143  if (index != limit) {
     *rp = index;      *rp = index;
 )  )
   
 condbranch((+loop),n --         fig     paren_plus_loop,  condbranch((+loop),n --         gforth  paren_plus_loop,
 /* !! check this thoroughly */  /* !! check this thoroughly */
 Cell index = *rp;  Cell index = *rp;
 /* 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) */
Line 166  if(((olddiff^MAXINT) >= n) ^ ((olddiff+n Line 166  if(((olddiff^MAXINT) >= n) ^ ((olddiff+n
     IF_TOS(TOS = sp[0]);      IF_TOS(TOS = sp[0]);
 )  )
   
 condbranch((-loop),u --         new     paren_minus_loop,  condbranch((-loop),u --         gforth  paren_minus_loop,
 /* !! check this thoroughly */  /* !! check this thoroughly */
 Cell index = *rp;  Cell index = *rp;
 /* 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) */
Line 177  if (olddiff>u) { Line 177  if (olddiff>u) {
     IF_TOS(TOS = sp[0]);      IF_TOS(TOS = sp[0]);
 )  )
   
 condbranch((s+loop),n --                new     paren_symmetric_plus_loop,  condbranch((s+loop),n --                gforth  paren_symmetric_plus_loop,
 ""The run-time procedure compiled by S+LOOP. It loops until the index  ""The run-time procedure compiled by S+LOOP. It loops until the index
 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).""
Line 272  else { Line 272  else {
     INC_IP(1);      INC_IP(1);
 }  }
   
 i       -- n            core,fig  i       -- n            core
 n = *rp;  n = *rp;
   
 j       -- n            core  j       -- n            core
Line 284  n = rp[2]; Line 284  n = rp[2];
 putchar(c);  putchar(c);
 emitcounter++;  emitcounter++;
   
 (type)  c_addr n --     fig     paren_type  (type)  c_addr n --     gforth  paren_type
 fwrite(c_addr,sizeof(Char),n,stdout);  fwrite(c_addr,sizeof(Char),n,stdout);
 emitcounter += n;  emitcounter += n;
   
Line 293  fflush(stdout); Line 293  fflush(stdout);
 /* !! noecho */  /* !! noecho */
 n = key();  n = key();
   
 key?    -- n            fig     key_q  key?    -- n            facility        key_q
 fflush(stdout);  fflush(stdout);
 n = key_query;  n = key_query;
   
 cr      --              fig  cr      --              core
 puts("");  puts("");
 :  :
  $0A emit ;   $0A emit ;
Line 399  u2 = u1-n; Line 399  u2 = u1-n;
 :  :
  tuck - >r + r> dup 0< IF  - 0  THEN ;   tuck - >r + r> dup 0< IF  - 0  THEN ;
   
 +       n1 n2 -- n              core,fig        plus  +       n1 n2 -- n              core    plus
 n = n1+n2;  n = n1+n2;
   
 -       n1 n2 -- n              core,fig        minus  -       n1 n2 -- n              core    minus
 n = n1-n2;  n = n1-n2;
 :  :
  negate + ;   negate + ;
   
 negate  n1 -- n2                core,fig  negate  n1 -- n2                core
 /* use minus as alias */  /* use minus as alias */
 n2 = -n1;  n2 = -n1;
 :  :
Line 447  else Line 447  else
 :  :
  dup 0< IF negate THEN ;   dup 0< IF negate THEN ;
   
 *       n1 n2 -- n              core,fig        star  *       n1 n2 -- n              core    star
 n = n1*n2;  n = n1*n2;
 :  :
  um* drop ;   um* drop ;
   
 /       n1 n2 -- n              core,fig        slash  /       n1 n2 -- n              core    slash
 n = n1/n2;  n = n1/n2;
 :  :
  /mod nip ;   /mod nip ;
Line 533  d2 = d1+n; Line 533  d2 = d1+n;
 :  :
  s>d d+ ;   s>d d+ ;
   
 d+      d1 d2 -- d              double,fig      d_plus  d+      d1 d2 -- d              double  d_plus
 d = d1+d2;  d = d1+d2;
 :  :
  >r swap >r over 2/ over 2/ + >r over 1 and over 1 and + 2/   >r swap >r over 2/ over 2/ + >r over 1 and over 1 and + 2/
Line 592  n = d; Line 592  n = d;
 :  :
  drop ;   drop ;
   
 and     w1 w2 -- w              core,fig  and     w1 w2 -- w              core
 w = w1&w2;  w = w1&w2;
   
 or      w1 w2 -- w              core,fig  or      w1 w2 -- w              core
 w = w1|w2;  w = w1|w2;
   
 xor     w1 w2 -- w              core,fig  xor     w1 w2 -- w              core
 w = w1^w2;  w = w1^w2;
   
 invert  w1 -- w2                core  invert  w1 -- w2                core
Line 670  fp = f_addr; Line 670  fp = f_addr;
 ip = (Xt *)(*rp++);  ip = (Xt *)(*rp++);
 NEXT_P0;  NEXT_P0;
   
 >r      w --            core,fig        to_r  >r      w --            core    to_r
 *--rp = w;  *--rp = w;
   
 r>      -- w            core,fig        r_from  r>      -- w            core    r_from
 w = *rp++;  w = *rp++;
   
 r@      -- w            core,fig        r_fetch  r@      -- w            core    r_fetch
 /* use r as alias */  /* use r as alias */
 /* make r@ an alias for i */  /* make r@ an alias for i */
 w = *rp;  w = *rp;
   
 rdrop   --              fig  rdrop   --              gforth
 rp++;  rp++;
   
 i'      -- w            fig             i_tick  i'      -- w            gforth          i_tick
 w=rp[1];  w=rp[1];
   
 2>r     w1 w2 --        core-ext        two_to_r  2>r     w1 w2 --        core-ext        two_to_r
Line 699  w1 = *rp++; Line 699  w1 = *rp++;
 w2 = rp[0];  w2 = rp[0];
 w1 = rp[1];  w1 = rp[1];
   
 2rdrop  --              new     two_r_drop  2rdrop  --              gforth  two_r_drop
 rp+=2;  rp+=2;
   
 over    w1 w2 -- w1 w2 w1               core,fig  over    w1 w2 -- w1 w2 w1               core
   
 drop    w --            core,fig  drop    w --            core
   
 swap    w1 w2 -- w2 w1          core,fig  swap    w1 w2 -- w2 w1          core
   
 dup     w -- w w                core,fig  dup     w -- w w                core
   
 rot     w1 w2 w3 -- w2 w3 w1    core    rote  rot     w1 w2 w3 -- w2 w3 w1    core    rote
   
 -rot    w1 w2 w3 -- w3 w1 w2    fig     not_rote  -rot    w1 w2 w3 -- w3 w1 w2    gforth  not_rote
 :  :
  rot rot ;   rot rot ;
   
Line 759  w = sp[u+1]; Line 759  w = sp[u+1];
 :  :
  >r >r 2swap r> r> 2swap ;   >r >r 2swap r> r> 2swap ;
   
   2nip    w1 w2 w3 w4 -- w3 w4    gforth  two_nip
   :
    2swap 2drop ;
   
   2tuck   w1 w2 w3 w4 -- w3 w4 w1 w2 w3 w4        gforth  two_tuck
   :
    2swap 2over ;
   
 \ toggle is high-level: 0.11/0.42%  \ toggle is high-level: 0.11/0.42%
   
 @       a_addr -- w             fig     fetch  @       a_addr -- w             core    fetch
 w = *a_addr;  w = *a_addr;
   
 !       w a_addr --             core,fig        store  !       w a_addr --             core    store
 *a_addr = w;  *a_addr = w;
   
 +!      n a_addr --             core,fig        plus_store  +!      n a_addr --             core    plus_store
 *a_addr += n;  *a_addr += n;
   
 c@      c_addr -- c             fig     cfetch  c@      c_addr -- c             core    cfetch
 c = *c_addr;  c = *c_addr;
   
 c!      c c_addr --             fig     cstore  c!      c c_addr --             core    cstore
 *c_addr = c;  *c_addr = c;
   
 2!      w1 w2 a_addr --         core    two_store  2!      w1 w2 a_addr --         core    two_store
Line 826  c_addr2 = c_addr1+1; Line 834  c_addr2 = c_addr1+1;
 :  :
  dup 1+ swap c@ ;   dup 1+ swap c@ ;
   
 (bye)   n --    toolkit-ext     paren_bye  (bye)   n --    gforth  paren_bye
 return (Label *)n;  return (Label *)n;
   
 system  c_addr u -- n   own  system  c_addr u -- n   gforth
 n=system(cstr(c_addr,u,1)); /* ~ expansion on first part of string? */  n=system(cstr(c_addr,u,1)); /* ~ expansion on first part of string? */
   
 getenv  c_addr1 u1 -- c_addr2 u2        new  getenv  c_addr1 u1 -- c_addr2 u2        gforth
 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 1161  fover  r1 r2 -- r1 r2 r1 float Line 1169  fover  r1 r2 -- r1 r2 r1 float
   
 frot            r1 r2 r3 -- r2 r3 r1    float  frot            r1 r2 r3 -- r2 r3 r1    float
   
   fnip            r1 r2 -- r2     gforth
   
   ftuck           r1 r2 -- r2 r1 r2       gforth
   
 float+          f_addr1 -- f_addr2      float   float_plus  float+          f_addr1 -- f_addr2      float   float_plus
 f_addr2 = f_addr1+1;  f_addr2 = f_addr1+1;
   
Line 1476  IF_FTOS(FTOS=fp[0]); Line 1488  IF_FTOS(FTOS=fp[0]);
 strerror        n -- c_addr u   new  strerror        n -- c_addr u   new
 c_addr = strerror(n);  c_addr = strerror(n);
 u = strlen(c_addr);  u = strlen(c_addr);
   
   strsignal       n -- c_addr u   new
   c_addr = strsignal(n);
   u = strlen(c_addr);

Removed from v.1.41  
changed lines
  Added in v.1.42


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