--- gforth/see.fs 2006/12/31 13:39:13 1.59 +++ gforth/see.fs 2010/04/18 16:39:55 1.69 @@ -1,12 +1,12 @@ \ SEE.FS highend SEE for ANSforth 16may93jaw -\ Copyright (C) 1995,2000,2003,2004,2006 Free Software Foundation, Inc. +\ Copyright (C) 1995,2000,2003,2004,2006,2007,2008 Free Software Foundation, Inc. \ This file is part of Gforth. \ Gforth is free software; you can redistribute it and/or \ modify it under the terms of the GNU General Public License -\ as published by the Free Software Foundation; either version 2 +\ as published by the Free Software Foundation, either version 3 \ of the License, or (at your option) any later version. \ This program is distributed in the hope that it will be useful, @@ -15,8 +15,7 @@ \ GNU General Public License for more details. \ You should have received a copy of the GNU General Public License -\ along with this program; if not, write to the Free Software -\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. +\ along with this program. If not, see http://www.gnu.org/licenses/. \ May be cross-compiled @@ -120,9 +119,10 @@ VARIABLE Colors Colors on else base @ >r try 8 base ! 0 <<# # # # '\ hold #> ctype #>> 0 - recover + restore + r@ base ! endtry - r> base ! throw + rdrop throw endif endif 1 /string @@ -529,10 +529,10 @@ VARIABLE C-Pass ELSE 2drop THEN ; -[IFDEF] (does>) +[IFDEF] !does : c-does> \ end of create part - Display? IF S" DOES> " Com# .string THEN - maxaligned /does-handler + ; + Display? IF S" DOES> " Com# .string THEN ; +\ maxaligned /does-handler + ; \ !! no longer needed for non-cross stuff [THEN] [IFDEF] (compile) @@ -576,7 +576,7 @@ 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] +[IFDEF] !does ' !does A, ' c-does> A, [THEN] 0 , here 0 , avariable c-extender @@ -657,7 +657,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 +706,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,17 +762,23 @@ Defer discode ( addr u -- ) \ gforth dup >code-address CASE docon: of seecon 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"