Diff for /gforth/prim between versions 1.76 and 1.83

version 1.76, 2001/02/27 21:17:10 version 1.83, 2001/06/16 22:53:36
Line 74 Line 74
 \ xt.*          XT  \ xt.*          XT
 \ f83name.*     F83Name *  \ f83name.*     F83Name *
   
   \E stack data-stack   sp Cell
   \E stack fp-stack     fp Float
   \E stack return-stack rp Cell
   \E
 \E get-current prefixes set-current  \E get-current prefixes set-current
 \E   \E 
 \E s" Bool"             single data-stack type-prefix f  \E s" Bool"             single data-stack type-prefix f
Line 126 Line 130
 \ these m4 macros would collide with identifiers  \ these m4 macros would collide with identifiers
 undefine(`index')  undefine(`index')
 undefine(`shift')  undefine(`shift')
   undefine(`symbols')
   
   \g control
   
 noop    ( -- )          gforth  noop    ( -- )          gforth
 :  :
Line 404  k ( R:n R:d1 R:d2 -- n R:n R:d1 R:d2 ) Line 411  k ( R:n R:d1 R:d2 -- n R:n R:d1 R:d2 )
   
 \ digit is high-level: 0/0%  \ digit is high-level: 0/0%
   
   \g strings
   
 move    ( c_from c_to ucount -- )               core  move    ( c_from c_to ucount -- )               core
 ""Copy the contents of @i{ucount} aus at @i{c-from} to  ""Copy the contents of @i{ucount} aus at @i{c-from} to
 @i{c-to}. @code{move} works correctly even if the two areas overlap.""  @i{c-to}. @code{move} works correctly even if the two areas overlap.""
Line 513  u2 = u1-n; Line 522  u2 = u1-n;
 :  :
  tuck - >r + r> dup 0< IF  - 0  THEN ;   tuck - >r + r> dup 0< IF  - 0  THEN ;
   
   \g arith
   
 +       ( n1 n2 -- n )          core    plus  +       ( n1 n2 -- n )          core    plus
 n = n1+n2;  n = n1+n2;
   
Line 910  f = FLAG(u1-u2 < u3-u2); Line 921  f = FLAG(u1-u2 < u3-u2);
 :  :
  over - >r - r> u< ;   over - >r - r> u< ;
   
   \g internal
   
 sp@     ( -- a_addr )           gforth          sp_fetch  sp@     ( -- a_addr )           gforth          sp_fetch
 a_addr = sp+1;  a_addr = sp+1;
   
Line 937  fp = f_addr; Line 950  fp = f_addr;
 ""The primitive compiled by @code{EXIT}.""  ""The primitive compiled by @code{EXIT}.""
 SET_IP((Xt *)w);  SET_IP((Xt *)w);
   
   \g stack
   
 >r      ( w -- R:w )            core    to_r  >r      ( w -- R:w )            core    to_r
 :  :
  (>r) ;   (>r) ;
Line 1376  n=1; Line 1391  n=1;
   
 \f[THEN]  \f[THEN]
   
   \g hostos
   
 key-file        ( wfileid -- n )                gforth  paren_key_file  key-file        ( wfileid -- n )                gforth  paren_key_file
 #ifdef HAS_FILE  #ifdef HAS_FILE
 fflush(stdout);  fflush(stdout);
Line 1424  cache."" Line 1441  cache.""
 FLUSH_ICACHE(c_addr,u);  FLUSH_ICACHE(c_addr,u);
   
 (bye)   ( n -- )        gforth  paren_bye  (bye)   ( n -- )        gforth  paren_bye
   SUPER_END;
 return (Label *)n;  return (Label *)n;
   
 (system)        ( c_addr u -- wretval wior )    gforth  peren_system  (system)        ( c_addr u -- wretval wior )    gforth  peren_system
Line 1666  else { Line 1684  else {
 \+  \+
 \+floating  \+floating
   
   \g floating
   
 comparisons(f, r1 r2, f_, r1, r2, gforth, gforth, float, gforth)  comparisons(f, r1 r2, f_, r1, r2, gforth, gforth, float, gforth)
 comparisons(f0, r, f_zero_, r, 0., float, gforth, float, gforth)  comparisons(f0, r, f_zero_, r, 0., float, gforth, float, gforth)
   
Line 2137  Variable UP Line 2157  Variable UP
 wcall   ( u -- )        gforth  wcall   ( u -- )        gforth
 IF_fpTOS(fp[0]=fpTOS);  IF_fpTOS(fp[0]=fpTOS);
 FP=fp;  FP=fp;
 sp=(SYSCALL(Cell(*)(Cell *, void *))u)(sp, &FP);  sp=(Cell*)(SYSCALL(Cell(*)(Cell *, void *))u)(sp, &FP);
 fp=FP;  fp=FP;
 IF_spTOS(spTOS=sp[0];)  IF_spTOS(spTOS=sp[0];)
 IF_fpTOS(fpTOS=fp[0]);  IF_fpTOS(fpTOS=fp[0]);
Line 2345  while(a_addr != NULL) Line 2365  while(a_addr != NULL)
   
 \+  \+
   
   \+peephole
   
   \g peephole
   
 primtable       ( -- wprimtable )       new  primtable       ( -- wprimtable )       new
 ""wprimtable is a table containing the xts of the primitives indexed  ""wprimtable is a table containing the xts of the primitives indexed
 by sequence-number in prim (for use in prepare-peephole-table).""  by sequence-number in prim (for use in prepare-peephole-table).""
Line 2361  peephole-opt ( xt1 xt2 wpeeptable -- xt Line 2385  peephole-opt ( xt1 xt2 wpeeptable -- xt
 they cannot be combined, xt is 0.""  they cannot be combined, xt is 0.""
 xt = peephole_opt(xt1, xt2, wpeeptable);  xt = peephole_opt(xt1, xt2, wpeeptable);
   
 lit_plus = lit +  
   
 call    ( #a_callee -- R:a_retaddr )  call    ( #a_callee -- R:a_retaddr )
 ""Call callee (a variant of docol with inline argument).""  ""Call callee (a variant of docol with inline argument).""
 a_retaddr = (Cell *)IP;  a_retaddr = (Cell *)IP;
Line 2371  SET_IP((Xt *)a_callee); Line 2393  SET_IP((Xt *)a_callee);
 useraddr        ( #u -- a_addr )  useraddr        ( #u -- a_addr )
 a_addr = (Cell *)(up+u);  a_addr = (Cell *)(up+u);
   
   include(peeprules.vmg)
   
   \+

Removed from v.1.76  
changed lines
  Added in v.1.83


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