version 1.31, 1999/05/10 12:52:06
|
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} |
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 1340 f_addr = (Float *)((((Cell)c_addr)+(size
|
Line 1349 f_addr = (Float *)((((Cell)c_addr)+(size
|
[ 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)."" |
a_addr = PFA(xt); |
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 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 1653 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 |
\+ |
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 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 1851 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; |
char *number=cstr(c_addr, u, 1); |
char *number=cstr(c_addr, u, 1); |
Line 2169 UP=up=(char *)a_addr;
|
Line 2182 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]); |
|
|