--- gforth/ans-report.fs 1998/12/08 22:02:34 1.3 +++ gforth/ans-report.fs 2005/09/03 07:49:02 1.12 @@ -1,6 +1,6 @@ \ report words used from the various wordsets -\ Copyright (C) 1996,1998 Free Software Foundation, Inc. +\ Copyright (C) 1996,1998,1999,2003 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -16,7 +16,7 @@ \ 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., 675 Mass Ave, Cambridge, MA 02139, USA. +\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. \ Use this program like this: @@ -42,11 +42,11 @@ vocabulary ans-report-words ans-report-words definitions : wordset ( "name" -- ) - lastxt >body + latestxt >body create 0 , \ link to next wordset 0 0 2, \ array of nfas - ( lastlinkp ) last @ swap ! \ set link ptr of last wordset + ( lastlinkp ) latest swap ! \ set link ptr of last wordset ; wordlist constant wordsets wordsets set-current @@ -88,7 +88,7 @@ ans-report-words definitions table constant answords answords set-current warnings @ warnings off -include answords.fs +include ./answords.fs warnings ! ans-report-words definitions @@ -133,8 +133,24 @@ ans-report-words definitions : replace-word ( xt cfa -- ) \ replace word at cfa with xt. !! This is quite general-purpose \ and should migrate elsewhere. - dodefer: over code-address! - >body ! ; + \ the following no longer works with primitive-centric hybrid threading: + \ dodefer: over code-address! + \ >body ! ; + dup @ docol: <> -12 and throw \ for colon defs only + >body ['] branch xt>threaded over ! + cell+ >r >body r> ! ; + +: print-names ( endaddr startaddr -- ) + space 1 -rot + u+do ( pos ) + i @ name>string nip 1+ { len } + len + ( newpos ) + dup cols 4 - >= if + cr space drop len 1+ + endif + i @ .name + cell +loop + drop ; forth definitions ans-report-words @@ -149,12 +165,7 @@ ans-report-words dup >r name>int >body dup @ swap cell+ 2@ dup if ." from " r@ .name ." :" cr - bounds - u+do - i @ .name - cell - +loop - cr + bounds print-names cr else 2drop endif