version 1.66, 2010/04/11 15:37:22
|
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 293 VARIABLE C-Pass
|
Line 294 VARIABLE C-Pass
|
\ here docon: , docol: , dovar: , douser: , dodefer: , dofield: , |
\ here docon: , docol: , dovar: , douser: , dodefer: , dofield: , |
\ here over - 2constant doers |
\ here over - 2constant doers |
|
|
|
[IFDEF] !does |
|
: c-does> \ end of create part |
|
Display? IF S" DOES> " Com# .string THEN ; |
|
\ maxaligned /does-handler + ; \ !! no longer needed for non-cross stuff |
|
[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 |
|
endif |
|
over 4 cells + over = if |
|
over 1 cells + @ decompile-prim ['] call xt>threaded = >r |
|
over 3 cells + @ decompile-prim ['] ;S xt>threaded = |
|
r> and if |
|
over 2 cells + @ ['] !does >body = if drop |
|
S" DOES> " Com# ?.string 4 cells + EXIT 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 ) |
Line 529 VARIABLE C-Pass
|
Line 551 VARIABLE C-Pass
|
ELSE 2drop |
ELSE 2drop |
THEN ; |
THEN ; |
|
|
[IFDEF] (does>) |
|
: c-does> \ end of create part |
|
Display? IF S" DOES> " Com# .string THEN ; |
|
\ maxaligned /does-handler + ; \ !! no longer needed for non-cross stuff |
|
[THEN] |
|
|
|
[IFDEF] (compile) |
[IFDEF] (compile) |
: c-(compile) |
: c-(compile) |
Display? |
Display? |
Line 576 CREATE C-Table
|
Line 592 CREATE C-Table
|
[IFDEF] (abort") ' (abort") A, ' c-abort" A, [THEN] |
[IFDEF] (abort") ' (abort") A, ' c-abort" A, [THEN] |
\ only defined if compiler is loaded |
\ only defined if compiler is loaded |
[IFDEF] (compile) ' (compile) A, ' c-(compile) A, [THEN] |
[IFDEF] (compile) ' (compile) A, ' c-(compile) A, [THEN] |
[IFDEF] (does>) ' (does>) A, ' c-does> A, [THEN] |
|
0 , here 0 , |
0 , here 0 , |
|
|
avariable c-extender |
avariable c-extender |
Line 657 Defer xt-see-xt ( xt -- )
|
Line 672 Defer xt-see-xt ( xt -- )
|
space ; |
space ; |
|
|
Defer discode ( addr u -- ) \ gforth |
Defer discode ( addr u -- ) \ gforth |
\G hook for the disassembler: disassemble code at addr of length u |
\G hook for the disassembler: disassemble u bytes of code at addr |
' dump IS discode |
' dump IS discode |
|
|
: next-head ( addr1 -- addr2 ) \ gforth |
: next-head ( addr1 -- addr2 ) \ gforth |
Line 706 Defer discode ( addr u -- ) \ gforth
|
Line 721 Defer discode ( addr u -- ) \ gforth
|
then |
then |
over - discode |
over - discode |
." end-code" cr ; |
." end-code" cr ; |
|
: seeabicode ( xt -- ) |
|
dup s" ABI-Code" .defname |
|
>body dup dup next-head |
|
swap - discode |
|
." end-code" cr ; |
: seevar ( xt -- ) |
: seevar ( xt -- ) |
s" Variable" .defname cr ; |
s" Variable" .defname cr ; |
: seeuser ( xt -- ) |
: seeuser ( xt -- ) |
Line 771 Defer discode ( addr u -- ) \ gforth
|
Line 791 Defer discode ( addr u -- ) \ gforth
|
[IFDEF] dofield: |
[IFDEF] dofield: |
dofield: of seefield endof |
dofield: of seefield endof |
[THEN] |
[THEN] |
|
[IFDEF] doabicode: |
|
doabicode: of seeabicode endof |
|
[THEN] |
over of seecode endof \ direct threaded code words |
over of seecode endof \ direct threaded code words |
over >body of seecode endof \ indirect threaded code words |
over >body of seecode endof \ indirect threaded code words |
2drop abort" unknown word type" |
2drop abort" unknown word type" |