--- gforth/see.fs 2010/04/18 06:18:36 1.67 +++ gforth/see.fs 2010/08/28 09:48:53 1.73 @@ -254,6 +254,7 @@ VARIABLE C-Pass : Scan? ( -- flag ) C-Pass @ 0= ; : Display? ( -- flag ) C-Pass @ 1 = ; : Debug? ( -- flag ) C-Pass @ 2 = ; +: ?.string ( c-addr u n -- ) Display? if .string else 2drop drop then ; : back? ( addr target -- addr flag ) over u< ; @@ -293,17 +294,38 @@ VARIABLE C-Pass \ here docon: , docol: , dovar: , douser: , dodefer: , dofield: , \ 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 ) - Display? IF - dup @ dup body> dup cfaligned over = swap in-dictionary? and if - ( addr1 addr1@ ) - dup body> @ dovar: = if - drop c-call EXIT - endif + dup @ dup body> dup cfaligned over = swap in-dictionary? and if + ( addr1 addr1@ ) + dup body> @ dovar: = if + drop c-call EXIT 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 "['] ..." dup abs 0 <# #S rot sign #> 0 .string bl cemit - endif + else drop then cell+ ; : c-lit+ ( addr1 -- addr2 ) @@ -529,12 +551,6 @@ VARIABLE C-Pass ELSE 2drop 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) : c-(compile) Display? @@ -576,7 +592,6 @@ CREATE C-Table [IFDEF] (abort") ' (abort") A, ' c-abort" A, [THEN] \ only defined if compiler is loaded [IFDEF] (compile) ' (compile) A, ' c-(compile) A, [THEN] -[IFDEF] !does ' !does A, ' c-does> A, [THEN] 0 , here 0 , avariable c-extender @@ -657,7 +672,7 @@ Defer xt-see-xt ( xt -- ) space ; 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 : next-head ( addr1 -- addr2 ) \ gforth @@ -706,6 +721,11 @@ Defer discode ( addr u -- ) \ gforth then over - discode ." end-code" cr ; +: seeabicode ( xt -- ) + dup s" ABI-Code" .defname + >body dup dup next-head + swap - discode + ." end-code" cr ; : seevar ( xt -- ) s" Variable" .defname cr ; : seeuser ( xt -- ) @@ -771,6 +791,9 @@ Defer discode ( addr u -- ) \ gforth [IFDEF] dofield: dofield: of seefield endof [THEN] +[IFDEF] doabicode: + doabicode: of seeabicode endof +[THEN] over of seecode endof \ direct threaded code words over >body of seecode endof \ indirect threaded code words 2drop abort" unknown word type"