Diff for /gforth/prim between versions 1.81 and 1.86

version 1.81, 2001/04/08 13:48:12 version 1.86, 2001/12/24 20:39:29
Line 132  undefine(`index') Line 132  undefine(`index')
 undefine(`shift')  undefine(`shift')
 undefine(`symbols')  undefine(`symbols')
   
   \g control
   
 noop    ( -- )          gforth  noop    ( -- )          gforth
 :  :
  ;   ;
Line 409  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 518  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 915  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 942  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 1381  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 1454  c_addr2 = getenv(cstr(c_addr1,u1,1)); Line 1466  c_addr2 = getenv(cstr(c_addr1,u1,1));
 u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2));  u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2));
   
 open-pipe       ( c_addr u wfam -- wfileid wior )       gforth  open_pipe  open-pipe       ( c_addr u wfam -- wfileid wior )       gforth  open_pipe
 wfileid=(Cell)popen(cstr(c_addr,u,1),fileattr[wfam]); /* ~ expansion of 1st arg? */  wfileid=(Cell)popen(cstr(c_addr,u,1),pfileattr[wfam]); /* ~ expansion of 1st arg? */
 wior = IOR(wfileid==0); /* !! the man page says that errno is not set reliably */  wior = IOR(wfileid==0); /* !! the man page says that errno is not set reliably */
   
 close-pipe      ( wfileid -- wretval wior )             gforth  close_pipe  close-pipe      ( wfileid -- wretval wior )             gforth  close_pipe
Line 1596  if (wior) Line 1608  if (wior)
   clearerr((FILE *)wfileid);    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
 ""this is only for backward compatibility""  /* this may one day be replaced with : read-line (read-line) nip ; */
 Cell c;  Cell c;
 flag=-1;  flag=-1;
 for(u2=0; u2<u1; u2++)  for(u2=0; u2<u1; u2++)
Line 1672  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 2353  while(a_addr != NULL) Line 2367  while(a_addr != NULL)
   
 \+peephole  \+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 2369  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 )    new
   
 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;
 SET_IP((Xt *)a_callee);  SET_IP((Xt *)a_callee);
   
 useraddr        ( #u -- a_addr )  useraddr        ( #u -- a_addr )        new
 a_addr = (Cell *)(up+u);  a_addr = (Cell *)(up+u);
   
   compile-prim ( xt1 -- xt2 )     new     compile_prim
   xt2 = (Xt)compile_prim((Label)xt1);
   
   include(peeprules.vmg)
   
 \+  \+

Removed from v.1.81  
changed lines
  Added in v.1.86


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