version 1.4, 1997/06/23 15:53:53
|
version 1.5, 1997/07/06 14:37:00
|
Line 171 else
|
Line 171 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_TOS(TOS = sp[0]); |
,) |
,: |
|
0= dup \ !f !f |
|
r> dup @ \ !f !f IP branchoffset |
|
rot and + \ !f IP|IP+branchoffset |
|
swap 0= cell and + \ IP'' |
|
>r ;) |
|
|
\ we don't need an lp_plus_store version of the ?dup-stuff, because it |
\ we don't need an lp_plus_store version of the ?dup-stuff, because it |
\ is only used in if's (yet) |
\ is only used in if's (yet) |
Line 404 else {
|
Line 409 else {
|
|
|
\+[THEN] |
\+[THEN] |
|
|
|
\ don't make any assumptions where the return stack is!! |
|
\ implement this in machine code if it should run quickly! |
|
|
i -- n core |
i -- n core |
n = *rp; |
n = *rp; |
: |
: |
rp@ cell+ @ ; |
\ rp@ cell+ @ ; |
|
r> r> tuck >r >r ; |
|
|
i' -- w gforth i_tick |
i' -- w gforth i_tick |
""loop end value"" |
""loop end value"" |
w = rp[1]; |
w = rp[1]; |
: |
: |
rp@ cell+ cell+ @ ; |
\ rp@ cell+ cell+ @ ; |
|
r> r> r> dup itmp ! >r >r >r itmp @ ; |
|
variable itmp |
|
|
j -- n core |
j -- n core |
n = rp[2]; |
n = rp[2]; |
: |
: |
rp@ cell+ cell+ cell+ @ ; |
\ rp@ cell+ cell+ cell+ @ ; |
|
r> r> r> r> dup itmp ! >r >r >r >r itmp @ ; |
|
[IFUNDEF] itmp variable itmp [THEN] |
|
|
k -- n gforth |
k -- n gforth |
n = rp[4]; |
n = rp[4]; |
: |
: |
rp@ [ 5 cells ] Literal + @ ; |
\ rp@ [ 5 cells ] Literal + @ ; |
|
r> r> r> r> r> r> dup itmp ! >r >r >r >r >r >r itmp @ ; |
|
[IFUNDEF] itmp variable itmp [THEN] |
|
|
\ digit is high-level: 0/0% |
\ digit is high-level: 0/0% |
|
|
Line 607 n2 = n1>>1;
|
Line 622 n2 = n1>>1;
|
: |
: |
dup MINI and IF 1 ELSE 0 THEN |
dup MINI and IF 1 ELSE 0 THEN |
[ bits/byte cell * 1- ] literal |
[ bits/byte cell * 1- ] literal |
0 DO 2* swap dup 2* >r U-HIGHBIT and |
0 DO 2* swap dup 2* >r MINI and |
IF 1 ELSE 0 THEN or r> swap |
IF 1 ELSE 0 THEN or r> swap |
LOOP nip ; |
LOOP nip ; |
|
|
Line 694 u2 = ud%u1;
|
Line 709 u2 = ud%u1;
|
#endif |
#endif |
: |
: |
0 swap [ 8 cells 1 + ] literal 0 |
0 swap [ 8 cells 1 + ] literal 0 |
?DO >r /modstep r> |
?DO /modstep |
LOOP drop swap 1 rshift or swap ; |
LOOP drop swap 1 rshift or swap ; |
: /modstep ( ud c R: u -- ud-?u c R: u ) |
: /modstep ( ud c R: u -- ud-?u c R: u ) |
over I' u< 0= or IF I' - 1 ELSE 0 THEN d2*+ ; |
>r over r@ u< 0= or IF r@ - 1 ELSE 0 THEN d2*+ r> ; |
: d2*+ ( ud n -- ud+n c ) |
: d2*+ ( ud n -- ud+n c ) |
over MINI |
over MINI |
and >r >r 2dup d+ swap r> + swap r> ; |
and >r >r 2dup d+ swap r> + swap r> ; |