Annotation of gforth/ans-report.fs, revision 1.4

1.1       anton       1: \ report words used from the various wordsets
                      2: 
1.3       anton       3: \ Copyright (C) 1996,1998 Free Software Foundation, Inc.
1.1       anton       4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
                      9: \ as published by the Free Software Foundation; either version 2
                     10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
                     18: \ along with this program; if not, write to the Free Software
                     19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                     20: 
                     21: 
                     22: \ Use this program like this:
                     23: \ include it, then the program you want to check; then say print-ans-report
                     24: \ e.g., start it with
                     25: \  gforth ans-report.fs myprog.fs -e "print-ans-report bye"
                     26: 
                     27: \ Caveats:
                     28: 
                     29: \ Note that this program just checks which words are used, not whether
                     30: \ they are used in an ANS Forth conforming way!
                     31: 
                     32: \ Some words are defined in several wordsets in the standard. This
                     33: \ program reports them for only one of the wordsets, and not
                     34: \ necessarily the one you expect.
                     35: 
                     36: 
                     37: \ This program uses Gforth internals and won't be easy to port
                     38: \ to other systems.
                     39: 
1.2       anton      40: \ !! ignore struct-voc stuff (dummy, [then] etc.).
                     41: 
1.1       anton      42: vocabulary ans-report-words ans-report-words definitions
                     43: 
                     44: : wordset ( "name" -- )
                     45:     lastxt >body
                     46:     create
                     47:     0 , \ link to next wordset
                     48:     0 0 2, \ array of nfas
                     49:     ( lastlinkp ) last @ swap ! \ set link ptr of last wordset
                     50: ;
                     51: 
                     52: wordlist constant wordsets wordsets set-current
                     53: create CORE 0 , 0 0 2,
                     54: wordset CORE-EXT
                     55: wordset BLOCK
                     56: wordset BLOCK-EXT
                     57: wordset DOUBLE
                     58: wordset DOUBLE-EXT
                     59: wordset EXCEPTION
                     60: wordset EXCEPTION-EXT
                     61: wordset FACILITY
                     62: wordset FACILITY-EXT
                     63: wordset FILE
                     64: wordset FILE-EXT
                     65: wordset FLOAT
                     66: wordset FLOAT-EXT
                     67: wordset LOCAL
                     68: wordset LOCAL-EXT
                     69: wordset MEMORY
                     70: wordset SEARCH
                     71: wordset SEARCH-EXT
                     72: wordset STRING
                     73: wordset TOOLS
                     74: wordset TOOLS-EXT
                     75: wordset non-ANS
                     76: ans-report-words definitions
                     77: 
                     78: : answord ( "name wordset pronounciation" -- )
                     79:     \ check the documentaion of an ans word
                     80:     name { D: wordname }
                     81:     name { D: wordset }
                     82:     name { D: pronounciation }
                     83:     wordname find-name
                     84:     ?dup-if
                     85:        sp@ cell nextname create drop
                     86:        wordset wordsets search-wordlist 0= abort" wordlist unknown" ,
                     87:     endif ;
                     88: 
                     89: table constant answords answords set-current
                     90: warnings @ warnings off
1.4     ! jwilke     91: include ./answords.fs
1.1       anton      92: warnings !
                     93: ans-report-words definitions
                     94: 
                     95: : add-unless-present ( nt addr -- )
                     96:     \ add nt to array described by addr 2@, unless it contains nt
                     97:     >r ( nt )
                     98:     r@ 2@ bounds
                     99:     u+do ( nt )
                    100:        dup i @ =
                    101:        if
                    102:            drop rdrop UNLOOP EXIT
                    103:        endif
                    104:        cell
                    105:     +loop
                    106:     r@ 2@ cell extend-mem r> 2!
                    107:     ( nt addr ) ! ;
                    108: 
                    109: 
                    110: : note-name ( nt -- )
                    111:     \ remember name in the appropriate wordset, unless already there
                    112:     \ or the word is defined in the checked program
                    113:     dup [ here ] literal >                  \ word defined by the application
                    114:     over locals-buffer dup 1000 + within or  \ or a local
                    115:     if
                    116:        drop EXIT
                    117:     endif
                    118:     sp@ cell answords search-wordlist ( nt xt true | nt false )
                    119:     if \ ans word
                    120:        >body @ >body
                    121:     else \ non-ans word
                    122:        [ get-order wordsets swap 1+ set-order ] non-ANS [ previous ]
                    123:     endif
                    124:     ( nt wordset ) cell+ add-unless-present ;
                    125: 
                    126: : find&note-name ( c-addr u -- nt/0 )
                    127:     \ find-name replacement. Takes note of all the words used.
                    128:     lookup @ (search-wordlist) dup
                    129:     if
                    130:        dup note-name
                    131:     endif ;
                    132: 
                    133: : replace-word ( xt cfa -- )
                    134:     \ replace word at cfa with xt. !! This is quite general-purpose
                    135:     \ and should migrate elsewhere.
                    136:     dodefer: over code-address!
                    137:     >body ! ;
                    138: 
                    139: forth definitions
                    140: ans-report-words
                    141: 
                    142: : print-ans-report ( -- )
                    143:     cr
                    144:     ." The program uses the following words" cr
                    145:     [ get-order wordsets swap 1+ set-order ] [(')] core [ previous ]
                    146:     begin
                    147:        dup 0<>
                    148:     while
                    149:        dup >r name>int >body dup @ swap cell+ 2@ dup
                    150:        if
                    151:            ." from " r@ .name ." :" cr
                    152:            bounds
                    153:            u+do
                    154:                i @ .name
                    155:                cell
                    156:            +loop
                    157:            cr
                    158:        else
                    159:            2drop
                    160:        endif
                    161:        rdrop
                    162:     repeat
                    163:     drop ;
                    164:        
                    165: \ the following sequence "' replace-word forth execute" is necessary
                    166: \ to restore the default search order without effect on the "used
                    167: \ word" lists
                    168: ' find&note-name ' find-name ' replace-word forth execute

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>