--- gforth/ans-report.fs 1996/11/11 16:59:15 1.1 +++ gforth/ans-report.fs 2006/12/31 13:39:11 1.16 @@ -1,6 +1,6 @@ \ report words used from the various wordsets -\ Copyright (C) 1996 Free Software Foundation, Inc. +\ Copyright (C) 1996,1998,1999,2003,2005,2006 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: @@ -37,19 +37,22 @@ \ This program uses Gforth internals and won't be easy to port \ to other systems. +\ !! ignore struct-voc stuff (dummy, [then] etc.). + 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 create CORE 0 , 0 0 2, wordset CORE-EXT +wordset CORE-EXT-obsolescent wordset BLOCK wordset BLOCK-EXT wordset DOUBLE @@ -70,23 +73,39 @@ wordset SEARCH-EXT wordset STRING wordset TOOLS wordset TOOLS-EXT +wordset TOOLS-EXT-obsolescent + +\ www.forth200x.org CfV extension names +wordset X:deferred +wordset X:extension-query +wordset X:parse-name +wordset X:defined +wordset X:required +wordset X:ekeys +wordset X:fp-stack + wordset non-ANS + ans-report-words definitions -: answord ( "name wordset pronounciation" -- ) - \ check the documentaion of an ans word - name { D: wordname } - name { D: wordset } - name { D: pronounciation } +: standardword { D: wordname D: wordset -- } wordname find-name ?dup-if sp@ cell nextname create drop - wordset wordsets search-wordlist 0= abort" wordlist unknown" , + wordset wordsets search-wordlist 0= abort" wordset unknown" , endif ; + +: answord ( "name wordset pronounciation" -- ) + \ check the documentation of an ans word + parse-name parse-name parse-name 2drop standardword ; + +: xword ( "name wordset" ) + parse-name parse-name standardword ; table constant answords answords set-current warnings @ warnings off -include answords.fs +include ./answords.fs +include ./xwords.fs warnings ! ans-report-words definitions @@ -131,8 +150,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 @@ -147,12 +182,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