version 1.41, 1995/10/07 17:38:18
|
version 1.42, 1995/10/11 19:39:35
|
Line 89 lit -- w fig
|
Line 89 lit -- w fig
|
w = (Cell)NEXT_INST; |
w = (Cell)NEXT_INST; |
INC_IP(1); |
INC_IP(1); |
|
|
execute xt -- core,fig |
execute xt -- core |
ip=IP; |
ip=IP; |
cfa = xt; |
cfa = xt; |
IF_TOS(TOS = sp[0]); |
IF_TOS(TOS = sp[0]); |
Line 143 if (index != limit) {
|
Line 143 if (index != limit) {
|
*rp = index; |
*rp = index; |
) |
) |
|
|
condbranch((+loop),n -- fig paren_plus_loop, |
condbranch((+loop),n -- gforth paren_plus_loop, |
/* !! check this thoroughly */ |
/* !! check this thoroughly */ |
Cell index = *rp; |
Cell index = *rp; |
/* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */ |
/* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */ |
Line 166 if(((olddiff^MAXINT) >= n) ^ ((olddiff+n
|
Line 166 if(((olddiff^MAXINT) >= n) ^ ((olddiff+n
|
IF_TOS(TOS = sp[0]); |
IF_TOS(TOS = sp[0]); |
) |
) |
|
|
condbranch((-loop),u -- new paren_minus_loop, |
condbranch((-loop),u -- gforth paren_minus_loop, |
/* !! check this thoroughly */ |
/* !! check this thoroughly */ |
Cell index = *rp; |
Cell index = *rp; |
/* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */ |
/* sign bit manipulation and test: (x^y)<0 is equivalent to (x<0) != (y<0) */ |
Line 177 if (olddiff>u) {
|
Line 177 if (olddiff>u) {
|
IF_TOS(TOS = sp[0]); |
IF_TOS(TOS = sp[0]); |
) |
) |
|
|
condbranch((s+loop),n -- new paren_symmetric_plus_loop, |
condbranch((s+loop),n -- gforth paren_symmetric_plus_loop, |
""The run-time procedure compiled by S+LOOP. It loops until the index |
""The run-time procedure compiled by S+LOOP. It loops until the index |
crosses the boundary between limit and limit-sign(n). I.e. a symmetric |
crosses the boundary between limit and limit-sign(n). I.e. a symmetric |
version of (+LOOP)."" |
version of (+LOOP)."" |
Line 272 else {
|
Line 272 else {
|
INC_IP(1); |
INC_IP(1); |
} |
} |
|
|
i -- n core,fig |
i -- n core |
n = *rp; |
n = *rp; |
|
|
j -- n core |
j -- n core |
Line 284 n = rp[2];
|
Line 284 n = rp[2];
|
putchar(c); |
putchar(c); |
emitcounter++; |
emitcounter++; |
|
|
(type) c_addr n -- fig paren_type |
(type) c_addr n -- gforth paren_type |
fwrite(c_addr,sizeof(Char),n,stdout); |
fwrite(c_addr,sizeof(Char),n,stdout); |
emitcounter += n; |
emitcounter += n; |
|
|
Line 293 fflush(stdout);
|
Line 293 fflush(stdout);
|
/* !! noecho */ |
/* !! noecho */ |
n = key(); |
n = key(); |
|
|
key? -- n fig key_q |
key? -- n facility key_q |
fflush(stdout); |
fflush(stdout); |
n = key_query; |
n = key_query; |
|
|
cr -- fig |
cr -- core |
puts(""); |
puts(""); |
: |
: |
$0A emit ; |
$0A emit ; |
Line 399 u2 = u1-n;
|
Line 399 u2 = u1-n;
|
: |
: |
tuck - >r + r> dup 0< IF - 0 THEN ; |
tuck - >r + r> dup 0< IF - 0 THEN ; |
|
|
+ n1 n2 -- n core,fig plus |
+ n1 n2 -- n core plus |
n = n1+n2; |
n = n1+n2; |
|
|
- n1 n2 -- n core,fig minus |
- n1 n2 -- n core minus |
n = n1-n2; |
n = n1-n2; |
: |
: |
negate + ; |
negate + ; |
|
|
negate n1 -- n2 core,fig |
negate n1 -- n2 core |
/* use minus as alias */ |
/* use minus as alias */ |
n2 = -n1; |
n2 = -n1; |
: |
: |
Line 447 else
|
Line 447 else
|
: |
: |
dup 0< IF negate THEN ; |
dup 0< IF negate THEN ; |
|
|
* n1 n2 -- n core,fig star |
* n1 n2 -- n core star |
n = n1*n2; |
n = n1*n2; |
: |
: |
um* drop ; |
um* drop ; |
|
|
/ n1 n2 -- n core,fig slash |
/ n1 n2 -- n core slash |
n = n1/n2; |
n = n1/n2; |
: |
: |
/mod nip ; |
/mod nip ; |
Line 533 d2 = d1+n;
|
Line 533 d2 = d1+n;
|
: |
: |
s>d d+ ; |
s>d d+ ; |
|
|
d+ d1 d2 -- d double,fig d_plus |
d+ d1 d2 -- d double d_plus |
d = d1+d2; |
d = d1+d2; |
: |
: |
>r swap >r over 2/ over 2/ + >r over 1 and over 1 and + 2/ |
>r swap >r over 2/ over 2/ + >r over 1 and over 1 and + 2/ |
Line 592 n = d;
|
Line 592 n = d;
|
: |
: |
drop ; |
drop ; |
|
|
and w1 w2 -- w core,fig |
and w1 w2 -- w core |
w = w1&w2; |
w = w1&w2; |
|
|
or w1 w2 -- w core,fig |
or w1 w2 -- w core |
w = w1|w2; |
w = w1|w2; |
|
|
xor w1 w2 -- w core,fig |
xor w1 w2 -- w core |
w = w1^w2; |
w = w1^w2; |
|
|
invert w1 -- w2 core |
invert w1 -- w2 core |
Line 670 fp = f_addr;
|
Line 670 fp = f_addr;
|
ip = (Xt *)(*rp++); |
ip = (Xt *)(*rp++); |
NEXT_P0; |
NEXT_P0; |
|
|
>r w -- core,fig to_r |
>r w -- core to_r |
*--rp = w; |
*--rp = w; |
|
|
r> -- w core,fig r_from |
r> -- w core r_from |
w = *rp++; |
w = *rp++; |
|
|
r@ -- w core,fig r_fetch |
r@ -- w core r_fetch |
/* use r as alias */ |
/* use r as alias */ |
/* make r@ an alias for i */ |
/* make r@ an alias for i */ |
w = *rp; |
w = *rp; |
|
|
rdrop -- fig |
rdrop -- gforth |
rp++; |
rp++; |
|
|
i' -- w fig i_tick |
i' -- w gforth i_tick |
w=rp[1]; |
w=rp[1]; |
|
|
2>r w1 w2 -- core-ext two_to_r |
2>r w1 w2 -- core-ext two_to_r |
Line 699 w1 = *rp++;
|
Line 699 w1 = *rp++;
|
w2 = rp[0]; |
w2 = rp[0]; |
w1 = rp[1]; |
w1 = rp[1]; |
|
|
2rdrop -- new two_r_drop |
2rdrop -- gforth two_r_drop |
rp+=2; |
rp+=2; |
|
|
over w1 w2 -- w1 w2 w1 core,fig |
over w1 w2 -- w1 w2 w1 core |
|
|
drop w -- core,fig |
drop w -- core |
|
|
swap w1 w2 -- w2 w1 core,fig |
swap w1 w2 -- w2 w1 core |
|
|
dup w -- w w core,fig |
dup w -- w w core |
|
|
rot w1 w2 w3 -- w2 w3 w1 core rote |
rot w1 w2 w3 -- w2 w3 w1 core rote |
|
|
-rot w1 w2 w3 -- w3 w1 w2 fig not_rote |
-rot w1 w2 w3 -- w3 w1 w2 gforth not_rote |
: |
: |
rot rot ; |
rot rot ; |
|
|
Line 759 w = sp[u+1];
|
Line 759 w = sp[u+1];
|
: |
: |
>r >r 2swap r> r> 2swap ; |
>r >r 2swap r> r> 2swap ; |
|
|
|
2nip w1 w2 w3 w4 -- w3 w4 gforth two_nip |
|
: |
|
2swap 2drop ; |
|
|
|
2tuck w1 w2 w3 w4 -- w3 w4 w1 w2 w3 w4 gforth two_tuck |
|
: |
|
2swap 2over ; |
|
|
\ toggle is high-level: 0.11/0.42% |
\ toggle is high-level: 0.11/0.42% |
|
|
@ a_addr -- w fig fetch |
@ a_addr -- w core fetch |
w = *a_addr; |
w = *a_addr; |
|
|
! w a_addr -- core,fig store |
! w a_addr -- core store |
*a_addr = w; |
*a_addr = w; |
|
|
+! n a_addr -- core,fig plus_store |
+! n a_addr -- core plus_store |
*a_addr += n; |
*a_addr += n; |
|
|
c@ c_addr -- c fig cfetch |
c@ c_addr -- c core cfetch |
c = *c_addr; |
c = *c_addr; |
|
|
c! c c_addr -- fig cstore |
c! c c_addr -- core cstore |
*c_addr = c; |
*c_addr = c; |
|
|
2! w1 w2 a_addr -- core two_store |
2! w1 w2 a_addr -- core two_store |
Line 826 c_addr2 = c_addr1+1;
|
Line 834 c_addr2 = c_addr1+1;
|
: |
: |
dup 1+ swap c@ ; |
dup 1+ swap c@ ; |
|
|
(bye) n -- toolkit-ext paren_bye |
(bye) n -- gforth paren_bye |
return (Label *)n; |
return (Label *)n; |
|
|
system c_addr u -- n own |
system c_addr u -- n gforth |
n=system(cstr(c_addr,u,1)); /* ~ expansion on first part of string? */ |
n=system(cstr(c_addr,u,1)); /* ~ expansion on first part of string? */ |
|
|
getenv c_addr1 u1 -- c_addr2 u2 new |
getenv c_addr1 u1 -- c_addr2 u2 gforth |
c_addr2 = getenv(cstr(c_addr1,u1,1)); |
c_addr2 = getenv(cstr(c_addr1,u1,1)); |
u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2)); |
u2 = (c_addr2 == NULL ? 0 : strlen(c_addr2)); |
|
|
Line 1161 fover r1 r2 -- r1 r2 r1 float
|
Line 1169 fover r1 r2 -- r1 r2 r1 float
|
|
|
frot r1 r2 r3 -- r2 r3 r1 float |
frot r1 r2 r3 -- r2 r3 r1 float |
|
|
|
fnip r1 r2 -- r2 gforth |
|
|
|
ftuck r1 r2 -- r2 r1 r2 gforth |
|
|
float+ f_addr1 -- f_addr2 float float_plus |
float+ f_addr1 -- f_addr2 float float_plus |
f_addr2 = f_addr1+1; |
f_addr2 = f_addr1+1; |
|
|
Line 1476 IF_FTOS(FTOS=fp[0]);
|
Line 1488 IF_FTOS(FTOS=fp[0]);
|
strerror n -- c_addr u new |
strerror n -- c_addr u new |
c_addr = strerror(n); |
c_addr = strerror(n); |
u = strlen(c_addr); |
u = strlen(c_addr); |
|
|
|
strsignal n -- c_addr u new |
|
c_addr = strsignal(n); |
|
u = strlen(c_addr); |