version 1.72, 2010/05/02 16:58:02
|
version 1.73, 2010/08/28 09:48:53
|
Line 254 VARIABLE C-Pass
|
Line 254 VARIABLE C-Pass
|
: Scan? ( -- flag ) C-Pass @ 0= ; |
: Scan? ( -- flag ) C-Pass @ 0= ; |
: Display? ( -- flag ) C-Pass @ 1 = ; |
: Display? ( -- flag ) C-Pass @ 1 = ; |
: Debug? ( -- flag ) C-Pass @ 2 = ; |
: Debug? ( -- flag ) C-Pass @ 2 = ; |
|
: ?.string ( c-addr u n -- ) Display? if .string else 2drop drop then ; |
|
|
: back? ( addr target -- addr flag ) |
: back? ( addr target -- addr flag ) |
over u< ; |
over u< ; |
Line 300 VARIABLE C-Pass
|
Line 301 VARIABLE C-Pass
|
[THEN] |
[THEN] |
|
|
: c-lit ( addr1 -- addr2 ) |
: c-lit ( addr1 -- addr2 ) |
Display? IF |
dup @ dup body> dup cfaligned over = swap in-dictionary? and if |
dup @ dup body> dup cfaligned over = swap in-dictionary? and if |
( addr1 addr1@ ) |
( addr1 addr1@ ) |
dup body> @ dovar: = if |
dup body> @ dovar: = if |
drop c-call EXIT |
drop c-call EXIT |
|
endif |
|
endif |
endif |
over 4 cells + over = if |
endif |
over 1 cells + @ decompile-prim ['] call xt>threaded = >r |
over 4 cells + over = if |
over 3 cells + @ decompile-prim ['] ;S xt>threaded = |
over 1 cells + @ decompile-prim ['] call xt>threaded = >r |
r> and if |
over 3 cells + @ decompile-prim ['] ;S xt>threaded = |
|
r> and if |
over 2 cells + @ ['] !does >body = if drop |
over 2 cells + @ ['] !does >body = if drop |
S" DOES> " Com# .string 4 cells + EXIT endif |
S" DOES> " Com# ?.string 4 cells + EXIT endif |
[IFDEF] !;abi-code |
|
over 2 cells + @ ['] !;abi-code >body = if drop |
|
S" ;abi-code " Com# .string 4 cells + EXIT endif |
|
[THEN] |
|
endif |
|
endif |
endif |
|
[IFDEF] !;abi-code |
|
over 2 cells + @ ['] !;abi-code >body = if drop |
|
S" ;abi-code " Com# ?.string 4 cells + |
|
c-stop on |
|
EXIT |
|
endif |
|
[THEN] |
|
endif |
|
Display? if |
\ !! test for cfa here, and print "['] ..." |
\ !! test for cfa here, and print "['] ..." |
dup abs 0 <# #S rot sign #> 0 .string bl cemit |
dup abs 0 <# #S rot sign #> 0 .string bl cemit |
endif |
else drop then |
cell+ ; |
cell+ ; |
|
|
: c-lit+ ( addr1 -- addr2 ) |
: c-lit+ ( addr1 -- addr2 ) |