| : |
: |
| @ execute ; |
@ execute ; |
| |
|
| |
\fhas? skipbranchprims 0= [IF] |
| \+glocals |
\+glocals |
| |
|
| branch-lp+!# -- gforth branch_lp_plus_store_number |
branch-lp+!# -- gforth branch_lp_plus_store_number |
| INC_IP(1); |
INC_IP(1); |
| |
|
| \+ |
\+ |
| |
\f[THEN] |
| |
\fhas? skiploopprims 0= [IF] |
| |
|
| condbranch((next),-- cmFORTH paren_next, |
condbranch((next),-- cmFORTH paren_next, |
| if ((*rp)--) { |
if ((*rp)--) { |
| r> r> r> r> r> r> dup itmp ! >r >r >r >r >r >r itmp @ ; |
r> r> r> r> r> r> dup itmp ! >r >r >r >r >r >r itmp @ ; |
| [IFUNDEF] itmp variable itmp [THEN] |
[IFUNDEF] itmp variable itmp [THEN] |
| |
|
| |
\f[THEN] |
| |
|
| \ 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]; |
| : |
: |
| 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; |
| \+ |
\+ |
| |
|
| 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< ; |
| : |
: |
| 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}."" |
| : |
: |
| 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 |
| */ |
*/ |
| if ((flag=FLAG(!feof((FILE *)wfileid) && |
if ((flag=FLAG(!feof((FILE *)wfileid) && |
| fgets(c_addr,u1+1,(FILE *)wfileid) != NULL))) { |
fgets(c_addr,u1+1,(FILE *)wfileid) != NULL))) { |
| wior=FILEIO(ferror((FILE *)wfileid)); /* !! ior? */ |
wior=FILEIO(ferror((FILE *)wfileid)!=0); /* !! ior? */ |
| if (wior) |
if (wior) |
| clearerr((FILE *)wfileid); |
clearerr((FILE *)wfileid); |
| u2 = strlen(c_addr); |
u2 = strlen(c_addr); |
| if (wior) |
if (wior) |
| clearerr((FILE *)wfileid); |
clearerr((FILE *)wfileid); |
| #else |
#else |
| putc(c, stdout); |
PUTC(c); |
| #endif |
#endif |
| |
|
| \+file |
\+file |
| : |
: |
| 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]); |
| |
|