Diff for /gforth/prim between versions 1.32 and 1.40

version 1.32, 1999/05/15 20:00:21 version 1.40, 1999/11/08 22:01:09
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}
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}
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];
:  :
[ 1 floats 1- ] Literal + [ -1 floats ] Literal and ;   [ 1 floats 1- ] Literal + [ -1 floats ] Literal and ;

>body           xt -- a_addr    core    to_body  >body           xt -- a_addr    core    to_body
"" Get the address of the body of the word represented by @i{xt} (the address
of the word's data field).""
:  :
2 cells + ;      2 cells + ;

\+standardthreading  \ threading stuff is currently only interesting if we have a compiler
\fhas? standardthreading has? compiler and [IF]

Line 1414  n=1; Line 1418  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 1661  else { Line 1665  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
#endif

emit-file       c wfileid -- wior       gforth  emit_file  emit-file       c wfileid -- wior       gforth  emit_file
#ifdef HAS_FILE  #ifdef HAS_FILE
Line 1680  wior = FILEIO(putc(c, (FILE *)wfileid)== Line 1685  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 1859  internal floating-point representation. Line 1864  internal floating-point representation.
represents a valid floating-point number @i{r} is placed  represents a valid floating-point number @i{r} is placed
on the floating-point stack and @i{flag} is true. Otherwise,  on the floating-point stack and @i{flag} is true. Otherwise,
@i{flag} is false. A string of blanks is a special case  @i{flag} is false. A string of blanks is a special case
and represents the flotaing-point number 0.""  and represents the floating-point number 0.""
/* real signature: c_addr u -- r t / f */  /* real signature: c_addr u -- r t / f */
Float r;  Float r;
:  :
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.32 changed lines Added in v.1.40

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