--- gforth/see.fs 2007/12/31 18:40:24 1.63 +++ gforth/see.fs 2010/05/02 16:58:02 1.72 @@ -1,6 +1,6 @@ \ SEE.FS highend SEE for ANSforth 16may93jaw -\ Copyright (C) 1995,2000,2003,2004,2006,2007 Free Software Foundation, Inc. +\ Copyright (C) 1995,2000,2003,2004,2006,2007,2008 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -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 -- ) @@ -757,18 +773,23 @@ Defer discode ( addr u -- ) \ gforth dup >code-address CASE docon: of seecon endof - dovalue: of seevalue endof +[IFDEF] dovalue: + dovalue: of seevalue endof +[THEN] docol: of seecol endof dovar: of seevar endof -[ [IFDEF] douser: ] +[IFDEF] douser: douser: of seeuser endof -[ [THEN] ] -[ [IFDEF] dodefer: ] +[THEN] +[IFDEF] dodefer: dodefer: of seedefer endof -[ [THEN] ] -[ [IFDEF] dofield: ] +[THEN] +[IFDEF] dofield: dofield: of seefield endof -[ [THEN] ] +[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"