version 1.10, 1994/10/24 19:16:06
|
version 1.12, 1995/02/02 18:13:10
|
Line 21
|
Line 21
|
|
|
warnings off |
warnings off |
|
|
[IFUNDEF] vocabulary include search-order.fs [THEN] |
[IFUNDEF] vocabulary include search-order.fs [THEN] |
|
[IFUNDEF] environment? include environ.fs [THEN] |
include gray.fs |
include gray.fs |
|
|
100 constant max-effect \ number of things on one side of a stack effect |
100 constant max-effect \ number of things on one side of a stack effect |
Line 462 set-current
|
Line 463 set-current
|
|
|
: flush-tos ( -- ) |
: flush-tos ( -- ) |
effect-in-size 2@ effect-out-size 2@ |
effect-in-size 2@ effect-out-size 2@ |
|
rot - swap rot - ( -f-diff -d-diff ) >r >r |
|
effect-in-size 2@ effect-out-size 2@ |
0<> rot 0= and |
0<> rot 0= and |
if |
if |
." IF_FTOS(fp[0] = FTOS);" cr |
." IF_FTOS(fp[" r@ 0 .r ." ] = FTOS);" cr |
endif |
endif rdrop |
0<> swap 0= and |
0<> swap 0= and |
if |
if |
." IF_TOS(sp[0] = TOS);" cr |
." IF_TOS(sp[" r@ 0 .r ." ] = TOS);" cr |
endif ; |
endif rdrop ; |
|
|
: fill-tos ( -- ) |
: fill-tos ( -- ) |
effect-in-size 2@ effect-out-size 2@ |
effect-in-size 2@ effect-out-size 2@ |
Line 518 set-current
|
Line 521 set-current
|
." DEF_CA" cr |
." DEF_CA" cr |
declarations |
declarations |
compute-offsets \ for everything else |
compute-offsets \ for everything else |
flush-tos |
|
fetches |
fetches |
stack-pointer-updates cr |
stack-pointer-updates cr |
." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging |
." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging |
Line 526 set-current
|
Line 528 set-current
|
c-code 2@ type |
c-code 2@ type |
." }" cr |
." }" cr |
." NEXT_P1;" cr |
." NEXT_P1;" cr |
|
flush-tos |
stores |
stores |
fill-tos |
fill-tos |
." NEXT_P2;" cr |
." NEXT_P2;" cr |