version 1.206, 2007/02/09 17:53:54
|
version 1.211, 2007/04/01 21:30:26
|
Line 209 goto *next_code;
|
Line 209 goto *next_code;
|
a_retaddr = next_code; |
a_retaddr = next_code; |
a_body = PFA(CFA); |
a_body = PFA(CFA); |
INST_TAIL; |
INST_TAIL; |
|
#ifdef DEBUG |
|
fprintf(stderr, "dodoes to %x, push %x\n", a_retaddr, a_body); |
|
#endif |
goto **(Label *)DOES_CODE1(CFA); |
goto **(Label *)DOES_CODE1(CFA); |
#else /* !defined(NO_IP) */ |
#else /* !defined(NO_IP) */ |
a_retaddr = (Cell *)IP; |
a_retaddr = (Cell *)IP; |
a_body = PFA(CFA); |
a_body = PFA(CFA); |
|
#ifdef DEBUG |
|
fprintf(stderr, "dodoes to %x, push %x\n", a_retaddr, a_body); |
|
#endif |
SET_IP(DOES_CODE1(CFA)); |
SET_IP(DOES_CODE1(CFA)); |
#endif /* !defined(NO_IP) */ |
#endif /* !defined(NO_IP) */ |
|
|
Line 248 SET_IP((Xt *)a_callee);
|
Line 254 SET_IP((Xt *)a_callee);
|
|
|
execute ( xt -- ) core |
execute ( xt -- ) core |
""Perform the semantics represented by the execution token, @i{xt}."" |
""Perform the semantics represented by the execution token, @i{xt}."" |
|
#ifdef DEBUG |
|
fprintf(stderr, "execute %08x\n", xt); |
|
#endif |
#ifndef NO_IP |
#ifndef NO_IP |
ip=IP; |
ip=IP; |
#endif |
#endif |
Line 748 n = n1+n2;
|
Line 757 n = n1+n2;
|
\ lit+ / lit_plus = lit + |
\ lit+ / lit_plus = lit + |
|
|
lit+ ( n1 #n2 -- n ) new lit_plus |
lit+ ( n1 #n2 -- n ) new lit_plus |
|
#ifdef DEBUG |
|
fprintf(stderr, "lit+ %08x\n", n2); |
|
#endif |
n=n1+n2; |
n=n1+n2; |
|
|
\ PFE-0.9.14 has it differently, but the next release will have it as follows |
\ PFE-0.9.14 has it differently, but the next release will have it as follows |
Line 851 DCell d = (DCell)n1 * (DCell)n2;
|
Line 863 DCell d = (DCell)n1 * (DCell)n2;
|
#endif |
#endif |
#ifdef ASM_SM_SLASH_REM |
#ifdef ASM_SM_SLASH_REM |
ASM_SM_SLASH_REM(DLO(d), DHI(d), n3, n4, n5); |
ASM_SM_SLASH_REM(DLO(d), DHI(d), n3, n4, n5); |
if (((DHI(d)^n3)<0) && n4!=0) { |
if (FLOORED_DIV && ((DHI(d)^n3)<0) && n4!=0) { |
if (CHECK_DIVISION && n5 == CELL_MIN) |
if (CHECK_DIVISION && n5 == CELL_MIN) |
throw(BALL_RESULTRANGE); |
throw(BALL_RESULTRANGE); |
n5--; |
n5--; |
n4+=n3; |
n4+=n3; |
} |
} |
#else |
#else |
DCell r = fmdiv(d,n3); |
DCell r = FLOORED_DIV ? fmdiv(d,n3) : smdiv(d,n3); |
n4=DHI(r); |
n4=DHI(r); |
n5=DLO(r); |
n5=DLO(r); |
#endif |
#endif |
Line 875 DCell d = (DCell)n1 * (DCell)n2;
|
Line 887 DCell d = (DCell)n1 * (DCell)n2;
|
#ifdef ASM_SM_SLASH_REM |
#ifdef ASM_SM_SLASH_REM |
Cell remainder; |
Cell remainder; |
ASM_SM_SLASH_REM(DLO(d), DHI(d), n3, remainder, n4); |
ASM_SM_SLASH_REM(DLO(d), DHI(d), n3, remainder, n4); |
if (((DHI(d)^n3)<0) && remainder!=0) { |
if (FLOORED_DIV && ((DHI(d)^n3)<0) && remainder!=0) { |
if (CHECK_DIVISION && n4 == CELL_MIN) |
if (CHECK_DIVISION && n4 == CELL_MIN) |
throw(BALL_RESULTRANGE); |
throw(BALL_RESULTRANGE); |
n4--; |
n4--; |
} |
} |
#else |
#else |
DCell r = fmdiv(d,n3); |
DCell r = FLOORED_DIV ? fmdiv(d,n3) : smdiv(d,n3); |
n4=DLO(r); |
n4=DLO(r); |
#endif |
#endif |
: |
: |
Line 1487 for (; f83name1 != NULL; f83name1 = (str
|
Line 1499 for (; f83name1 != NULL; f83name1 = (str
|
memcasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */) |
memcasecmp(c_addr, f83name1->name, u)== 0 /* or inline? */) |
break; |
break; |
f83name2=f83name1; |
f83name2=f83name1; |
|
#ifdef DEBUG |
|
fprintf(stderr, "F83find "); |
|
fwrite(c_addr, u, 1, stderr); |
|
fprintf(stderr, " found %08x\n", f83name2); |
|
#endif |
: |
: |
BEGIN dup WHILE (find-samelen) dup WHILE |
BEGIN dup WHILE (find-samelen) dup WHILE |
>r 2dup r@ cell+ char+ capscomp 0= |
>r 2dup r@ cell+ char+ capscomp 0= |
Line 1642 f = key_query((FILE*)wfileid);
|
Line 1659 f = key_query((FILE*)wfileid);
|
f = key_query(stdin); |
f = key_query(stdin); |
#endif |
#endif |
|
|
\+os |
|
|
|
stdin ( -- wfileid ) gforth |
stdin ( -- wfileid ) gforth |
""The standard input file of the Gforth process."" |
""The standard input file of the Gforth process."" |
wfileid = (Cell)stdin; |
wfileid = (Cell)stdin; |
Line 1656 stderr ( -- wfileid ) gforth
|
Line 1671 stderr ( -- wfileid ) gforth
|
""The standard error output file of the Gforth process."" |
""The standard error output file of the Gforth process."" |
wfileid = (Cell)stderr; |
wfileid = (Cell)stderr; |
|
|
|
\+os |
|
|
form ( -- urows ucols ) gforth |
form ( -- urows ucols ) gforth |
""The number of lines and columns in the terminal. These numbers may change |
""The number of lines and columns in the terminal. These numbers may |
with the window size."" |
change with the window size. Note that it depends on the OS whether |
|
this reflects the actual size and changes with the window size |
|
(currently only on Unix-like OSs). On other OSs you just get a |
|
default, and can tell Gforth the terminal size by setting the |
|
environment variables @code{COLUMNS} and @code{LINES} before starting |
|
Gforth."" |
/* we could block SIGWINCH here to get a consistent size, but I don't |
/* we could block SIGWINCH here to get a consistent size, but I don't |
think this is necessary or always beneficial */ |
think this is necessary or always beneficial */ |
urows=rows; |
urows=rows; |