Diff for /gforth/prim between versions 1.31 and 1.39

version 1.31, 1999/05/10 12:52:06 version 1.39, 1999/08/29 21:44:46
Line 445  n = rp[4]; Line 445  n = rp[4];
 \ digit is high-level: 0/0%  \ digit is high-level: 0/0%
   
 move    c_from c_to ucount --           core  move    c_from c_to ucount --           core
 "" If @i{ucount}>0, copy the contents of @i{ucount} address units  ""Copy the contents of @i{ucount} address units at @i{c-from} to
 at @i{c-from} to @i{c-to}. @code{move} chooses its copy direction  @i{c-to}. @code{move} works correctly even if the two areas overlap.""
 to avoid problems when @i{c-from}, @i{c-to} overlap.""  
 memmove(c_to,c_from,ucount);  memmove(c_to,c_from,ucount);
 /* make an Ifdef for bsd and others? */  /* make an Ifdef for bsd and others? */
 :  :
  >r 2dup u< IF r> cmove> ELSE r> cmove THEN ;   >r 2dup u< IF r> cmove> ELSE r> cmove THEN ;
   
 cmove   c_from c_to u --        string  cmove   c_from c_to u --        string
 "" If @i{u}>0, copy the contents of @i{ucount} characters from  ""Copy the contents of @i{ucount} characters from data space at
 data space at @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}  @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}
 from low address to high address.""  from low address to high address; i.e., for overlapping areas it is
   safe if @i{c-to}=<@i{c-from}.""
 while (u-- > 0)  while (u-- > 0)
   *c_to++ = *c_from++;    *c_to++ = *c_from++;
 :  :
  bounds ?DO  dup c@ I c! 1+  LOOP  drop ;   bounds ?DO  dup c@ I c! 1+  LOOP  drop ;
   
 cmove>  c_from c_to u --        string  c_move_up  cmove>  c_from c_to u --        string  c_move_up
 "" If @i{u}>0, copy the contents of @i{ucount} characters from  ""Copy the contents of @i{ucount} characters from data space at
 data space at @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}  @i{c-from} to @i{c-to}. The copy proceeds @code{char}-by-@code{char}
 from high address to low address.""  from high address to low address; i.e., for overlapping areas it is
   safe if @i{c-to}>=@i{c-from}.""
 while (u-- > 0)  while (u-- > 0)
   c_to[u] = c_from[u];    c_to[u] = c_from[u];
 :  :
Line 718  ud = (UDCell)u1 * (UDCell)u2; Line 719  ud = (UDCell)u1 * (UDCell)u2;
    and >r >r 2dup d+ swap r> + swap r> ;     and >r >r 2dup d+ swap r> + swap r> ;
   
 um/mod  ud u1 -- u2 u3          core    u_m_slash_mod  um/mod  ud u1 -- u2 u3          core    u_m_slash_mod
   ""ud=u3*u1+u2, u1>u2>=0""
 #ifdef BUGGY_LONG_LONG  #ifdef BUGGY_LONG_LONG
 UDCell r = umdiv(ud,u1);  UDCell r = umdiv(ud,u1);
 u2=r.hi;  u2=r.hi;
Line 933  dcomparisons(du, ud1 ud2, d_u_, ud1, ud2 Line 935  dcomparisons(du, ud1 ud2, d_u_, ud1, ud2
 \+  \+
   
 within  u1 u2 u3 -- f           core-ext  within  u1 u2 u3 -- f           core-ext
   ""u2=<u1<u3 or: u3=<u2 and u1 is not in [u3,u2).  This works for
   unsigned and signed numbers (but not a mixture).  Another way to think
   about this word is to consider the numbers as a circle (wrapping
   around from @code{max-u} to 0 for unsigned, and from @code{max-n} to
   min-n for signed numbers); now consider the range from u2 towards
   increasing numbers up to and excluding u3 (giving an empty range if
   u2=u3; if u1 is in this range, @code{within} returns true.""
 f = FLAG(u1-u2 < u3-u2);  f = FLAG(u1-u2 < u3-u2);
 :  :
  over - >r - r> u< ;   over - >r - r> u< ;
Line 1344  a_addr = PFA(xt); Line 1353  a_addr = PFA(xt);
 :  :
     2 cells + ;      2 cells + ;
   
 \+standardthreading  \ threading stuff is currently only interesting if we have a compiler
   \fhas? standardthreading has? compiler and [IF]
   
 >code-address           xt -- c_addr            gforth  to_code_address  >code-address           xt -- c_addr            gforth  to_code_address
 ""@i{c-addr} is the code address of the word @i{xt}.""  ""@i{c-addr} is the code address of the word @i{xt}.""
Line 1406  n=1; Line 1416  n=1;
 :  :
  1 ;   1 ;
   
 \+  \f[THEN]
   
 key-file        wfileid -- n            gforth  paren_key_file  key-file        wfileid -- n            gforth  paren_key_file
 #ifdef HAS_FILE  #ifdef HAS_FILE
Line 1653  else { Line 1663  else {
 }  }
   
 \+  \+
 \+file  
   
 write-file      c_addr u1 wfileid -- wior       file    write_file  write-file      c_addr u1 wfileid -- wior       file    write_file
 /* !! fwrite does not guarantee enough */  /* !! fwrite does not guarantee enough */
   #ifdef HAS_FILE
 {  {
   UCell u2 = fwrite(c_addr, sizeof(Char), u1, (FILE *)wfileid);    UCell u2 = fwrite(c_addr, sizeof(Char), u1, (FILE *)wfileid);
   wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));    wior = FILEIO(u2<u1 && ferror((FILE *)wfileid));
   if (wior)    if (wior)
     clearerr((FILE *)wfileid);      clearerr((FILE *)wfileid);
 }  }
   #else
 \+  TYPE(c_addr, u1);
   #endif
   
 emit-file       c wfileid -- wior       gforth  emit_file  emit-file       c wfileid -- wior       gforth  emit_file
 #ifdef HAS_FILE  #ifdef HAS_FILE
Line 1672  wior = FILEIO(putc(c, (FILE *)wfileid)== Line 1683  wior = FILEIO(putc(c, (FILE *)wfileid)==
 if (wior)  if (wior)
   clearerr((FILE *)wfileid);    clearerr((FILE *)wfileid);
 #else  #else
 putc(c, stdout);  PUTC(c);
 #endif  #endif
   
 \+file  \+file
Line 2169  UP=up=(char *)a_addr; Line 2180  UP=up=(char *)a_addr;
 :  :
  up ! ;   up ! ;
 Variable UP  Variable UP
   
   wcall   u --    gforth
   IF_FTOS(fp[0]=FTOS);
   FP=fp;
   sp=(SYSCALL(Cell(*)(Cell *, void *))u)(sp, &FP);
   fp=FP;
   IF_TOS(TOS=sp[0];)
   IF_FTOS(FTOS=fp[0]);
   

Removed from v.1.31  
changed lines
  Added in v.1.39


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