--- gforth/see.fs 2008/07/15 16:11:49 1.65 +++ gforth/see.fs 2010/05/02 16:58:02 1.72 @@ -293,6 +293,12 @@ 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 @@ -301,6 +307,18 @@ VARIABLE C-Pass 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 + [IFDEF] !;abi-code + over 2 cells + @ ['] !;abi-code >body = if drop + S" ;abi-code " Com# .string 4 cells + EXIT endif + [THEN] + endif + endif \ !! test for cfa here, and print "['] ..." dup abs 0 <# #S rot sign #> 0 .string bl cemit endif @@ -529,12 +547,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 + ; -[THEN] - [IFDEF] (compile) : c-(compile) Display? @@ -576,7 +588,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 +668,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 +717,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 +787,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"