version 1.63, 2000/09/23 15:46:58
|
version 1.64, 2000/11/10 10:04:20
|
Line 117 INC_IP(1);
|
Line 117 INC_IP(1);
|
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}."" |
ip=IP; |
ip=IP; |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
EXEC(xt); |
EXEC(xt); |
|
|
perform ( a_addr -- ) gforth |
perform ( a_addr -- ) gforth |
""@code{@@ execute}."" |
""@code{@@ execute}."" |
/* and pfe */ |
/* and pfe */ |
ip=IP; |
ip=IP; |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
EXEC(*(Xt *)a_addr); |
EXEC(*(Xt *)a_addr); |
: |
: |
@ execute ; |
@ execute ; |
Line 170 else
|
Line 170 else
|
|
|
condbranch(?branch,( f -- ) f83 question_branch, |
condbranch(?branch,( f -- ) f83 question_branch, |
if (f==0) { |
if (f==0) { |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
,: |
,: |
0= dup \ !f !f |
0= dup \ !f !f |
r> dup @ \ !f !f IP branchoffset |
r> dup @ \ !f !f IP branchoffset |
Line 187 if (f==0) {
|
Line 187 if (f==0) {
|
""The run-time procedure compiled by @code{?DUP-IF}."" |
""The run-time procedure compiled by @code{?DUP-IF}."" |
if (f==0) { |
if (f==0) { |
sp++; |
sp++; |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
SET_IP((Xt *)(((Cell)IP)+(Cell)NEXT_INST)); |
SET_IP((Xt *)(((Cell)IP)+(Cell)NEXT_INST)); |
NEXT; |
NEXT; |
} |
} |
Line 241 if ((olddiff^(olddiff+n))>=0 /* the li
|
Line 241 if ((olddiff^(olddiff+n))>=0 /* the li
|
#else |
#else |
*rp = index + n; |
*rp = index + n; |
#endif |
#endif |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
,: |
,: |
r> swap |
r> swap |
r> r> 2dup - >r |
r> r> 2dup - >r |
Line 262 if (olddiff>u) {
|
Line 262 if (olddiff>u) {
|
#else |
#else |
*rp = index - u; |
*rp = index - u; |
#endif |
#endif |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
,) |
,) |
|
|
condbranch((s+loop),( n -- ) gforth paren_symmetric_plus_loop, |
condbranch((s+loop),( n -- ) gforth paren_symmetric_plus_loop, |
Line 283 if (diff>=0 || newdiff<0) {
|
Line 283 if (diff>=0 || newdiff<0) {
|
#else |
#else |
*rp = index + n; |
*rp = index + n; |
#endif |
#endif |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
,) |
,) |
|
|
\+ |
\+ |
Line 311 rp += 2;
|
Line 311 rp += 2;
|
*--rp = nlimit; |
*--rp = nlimit; |
*--rp = nstart; |
*--rp = nstart; |
if (nstart == nlimit) { |
if (nstart == nlimit) { |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
goto branch; |
goto branch; |
} |
} |
else { |
else { |
Line 331 else {
|
Line 331 else {
|
*--rp = nlimit; |
*--rp = nlimit; |
*--rp = nstart; |
*--rp = nstart; |
if (nstart >= nlimit) { |
if (nstart >= nlimit) { |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
goto branch; |
goto branch; |
} |
} |
else { |
else { |
Line 351 else {
|
Line 351 else {
|
*--rp = ulimit; |
*--rp = ulimit; |
*--rp = ustart; |
*--rp = ustart; |
if (ustart >= ulimit) { |
if (ustart >= ulimit) { |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
goto branch; |
goto branch; |
} |
} |
else { |
else { |
Line 371 else {
|
Line 371 else {
|
*--rp = nlimit; |
*--rp = nlimit; |
*--rp = nstart; |
*--rp = nstart; |
if (nstart <= nlimit) { |
if (nstart <= nlimit) { |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
goto branch; |
goto branch; |
} |
} |
else { |
else { |
Line 391 else {
|
Line 391 else {
|
*--rp = ulimit; |
*--rp = ulimit; |
*--rp = ustart; |
*--rp = ustart; |
if (ustart <= ulimit) { |
if (ustart <= ulimit) { |
IF_TOS(TOS = sp[0]); |
IF_spTOS(spTOS = sp[0]); |
goto branch; |
goto branch; |
} |
} |
else { |
else { |
Line 955 a_addr = sp+1;
|
Line 955 a_addr = sp+1;
|
|
|
sp! ( a_addr -- ) gforth sp_store |
sp! ( a_addr -- ) gforth sp_store |
sp = a_addr; |
sp = a_addr; |
/* works with and without TOS caching */ |
/* works with and without spTOS caching */ |
|
|
rp@ ( -- a_addr ) gforth rp_fetch |
rp@ ( -- a_addr ) gforth rp_fetch |
a_addr = rp; |
a_addr = rp; |
Line 1066 tuck ( w1 w2 -- w2 w1 w2 ) core-ext
|
Line 1066 tuck ( w1 w2 -- w2 w1 w2 ) core-ext
|
""Actually the stack effect is: @code{( w -- 0 | w w )}. It performs a |
""Actually the stack effect is: @code{( w -- 0 | w w )}. It performs a |
@code{dup} if w is nonzero."" |
@code{dup} if w is nonzero."" |
if (w!=0) { |
if (w!=0) { |
IF_TOS(*sp-- = w;) |
IF_spTOS(*sp-- = w;) |
#ifndef USE_TOS |
#ifndef USE_TOS |
*--sp = w; |
*--sp = w; |
#endif |
#endif |
Line 1584 access the stack itself. The stack point
|
Line 1584 access the stack itself. The stack point
|
variables @code{SP} and @code{FP}."" |
variables @code{SP} and @code{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 */ |
IF_FTOS(fp[0]=FTOS); |
IF_fpTOS(fp[0]=fpTOS); |
FP=fp; |
FP=fp; |
SP=sp; |
SP=sp; |
((void (*)())w)(); |
((void (*)())w)(); |
sp=SP; |
sp=SP; |
fp=FP; |
fp=FP; |
IF_TOS(TOS=sp[0]); |
IF_spTOS(spTOS=sp[0]); |
IF_FTOS(FTOS=fp[0]); |
IF_fpTOS(fpTOS=fp[0]); |
|
|
\+ |
\+ |
\+file |
\+file |
Line 1892 number[u]='\0';
|
Line 1892 number[u]='\0';
|
r=strtod(number,&endconv); |
r=strtod(number,&endconv); |
if((flag=FLAG(!(Cell)*endconv))) |
if((flag=FLAG(!(Cell)*endconv))) |
{ |
{ |
IF_FTOS(fp[0] = FTOS); |
IF_fpTOS(fp[0] = fpTOS); |
fp += -1; |
fp += -1; |
FTOS = sign ? -r : r; |
fpTOS = sign ? -r : r; |
} |
} |
else if(*endconv=='d' || *endconv=='D') |
else if(*endconv=='d' || *endconv=='D') |
{ |
{ |
Line 1902 else if(*endconv=='d' || *endconv=='D')
|
Line 1902 else if(*endconv=='d' || *endconv=='D')
|
r=strtod(number,&endconv); |
r=strtod(number,&endconv); |
if((flag=FLAG(!(Cell)*endconv))) |
if((flag=FLAG(!(Cell)*endconv))) |
{ |
{ |
IF_FTOS(fp[0] = FTOS); |
IF_fpTOS(fp[0] = fpTOS); |
fp += -1; |
fp += -1; |
FTOS = sign ? -r : r; |
fpTOS = sign ? -r : r; |
} |
} |
} |
} |
|
|
Line 2196 UP=up=(char *)a_addr;
|
Line 2196 UP=up=(char *)a_addr;
|
Variable UP |
Variable UP |
|
|
wcall ( u -- ) gforth |
wcall ( u -- ) gforth |
IF_FTOS(fp[0]=FTOS); |
IF_fpTOS(fp[0]=fpTOS); |
FP=fp; |
FP=fp; |
sp=(SYSCALL(Cell(*)(Cell *, void *))u)(sp, &FP); |
sp=(SYSCALL(Cell(*)(Cell *, void *))u)(sp, &FP); |
fp=FP; |
fp=FP; |
IF_TOS(TOS=sp[0];) |
IF_spTOS(spTOS=sp[0];) |
IF_FTOS(FTOS=fp[0]); |
IF_fpTOS(fpTOS=fp[0]); |
|
|
\+file |
\+file |
|
|