| 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) */ |
| |
|
| |
|
| 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 |
| \ 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 |
| 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= |
| 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; |
| ""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; |
| nmin =ltime->tm_min; |
nmin =ltime->tm_min; |
| nsec =ltime->tm_sec; |
nsec =ltime->tm_sec; |
| |
|
| ms ( n -- ) facility-ext |
ms ( u -- ) facility-ext |
| ""Wait at least @i{n} milli-second."" |
""Wait at least @i{n} milli-second."" |
| struct timeval timeout; |
gforth_ms(u); |
| timeout.tv_sec=n/1000; |
|
| timeout.tv_usec=1000*(n%1000); |
|
| (void)select(0,0,0,0,&timeout); |
|
| |
|
| allocate ( u -- a_addr wior ) memory |
allocate ( u -- a_addr wior ) memory |
| ""Allocate @i{u} address units of contiguous data space. The initial |
""Allocate @i{u} address units of contiguous data space. The initial |
| call-c ( ... w -- ... ) gforth call_c |
call-c ( ... w -- ... ) gforth call_c |
| ""Call the C function pointed to by @i{w}. The C function has to |
""Call the C function pointed to by @i{w}. The C function has to |
| access the stack itself. The stack pointers are exported in the global |
access the stack itself. The stack pointers are exported in the global |
| variables @code{SP} and @code{FP}."" |
variables @code{gforth_SP} and @code{gforth_FP}."" |
| /* This is a first attempt at support for calls to C. This may change in |
/* This is a first attempt at support for calls to C. This may change in |
| the future */ |
the future */ |
| gforth_FP=fp; |
gforth_FP=fp; |
