Return to ans-report.fs CVS log

Up to [gforth] / gforth

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

1.1     ! anton       1: \ report words used from the various wordsets
        !             2: 
        !             3: \ Copyright (C) 1996 Free Software Foundation, Inc.
        !             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: 
        !            40: vocabulary ans-report-words ans-report-words definitions
        !            41: 
        !            42: : wordset ( "name" -- )
        !            43:     lastxt >body
        !            44:     create
        !            45:     0 , \ link to next wordset
        !            46:     0 0 2, \ array of nfas
        !            47:     ( lastlinkp ) last @ swap ! \ set link ptr of last wordset
        !            48: ;
        !            49: 
        !            50: wordlist constant wordsets wordsets set-current
        !            51: create CORE 0 , 0 0 2,
        !            52: wordset CORE-EXT
        !            53: wordset BLOCK
        !            54: wordset BLOCK-EXT
        !            55: wordset DOUBLE
        !            56: wordset DOUBLE-EXT
        !            57: wordset EXCEPTION
        !            58: wordset EXCEPTION-EXT
        !            59: wordset FACILITY
        !            60: wordset FACILITY-EXT
        !            61: wordset FILE
        !            62: wordset FILE-EXT
        !            63: wordset FLOAT
        !            64: wordset FLOAT-EXT
        !            65: wordset LOCAL
        !            66: wordset LOCAL-EXT
        !            67: wordset MEMORY
        !            68: wordset SEARCH
        !            69: wordset SEARCH-EXT
        !            70: wordset STRING
        !            71: wordset TOOLS
        !            72: wordset TOOLS-EXT
        !            73: wordset non-ANS
        !            74: ans-report-words definitions
        !            75: 
        !            76: : answord ( "name wordset pronounciation" -- )
        !            77:     \ check the documentaion of an ans word
        !            78:     name { D: wordname }
        !            79:     name { D: wordset }
        !            80:     name { D: pronounciation }
        !            81:     wordname find-name
        !            82:     ?dup-if
        !            83:        sp@ cell nextname create drop
        !            84:        wordset wordsets search-wordlist 0= abort" wordlist unknown" ,
        !            85:     endif ;
        !            86: 
        !            87: table constant answords answords set-current
        !            88: warnings @ warnings off
        !            89: include answords.fs
        !            90: warnings !
        !            91: ans-report-words definitions
        !            92: 
        !            93: : add-unless-present ( nt addr -- )
        !            94:     \ add nt to array described by addr 2@, unless it contains nt
        !            95:     >r ( nt )
        !            96:     r@ 2@ bounds
        !            97:     u+do ( nt )
        !            98:        dup i @ =
        !            99:        if
        !           100:            drop rdrop UNLOOP EXIT
        !           101:        endif
        !           102:        cell
        !           103:     +loop
        !           104:     r@ 2@ cell extend-mem r> 2!
        !           105:     ( nt addr ) ! ;
        !           106: 
        !           107: 
        !           108: : note-name ( nt -- )
        !           109:     \ remember name in the appropriate wordset, unless already there
        !           110:     \ or the word is defined in the checked program
        !           111:     dup [ here ] literal >                  \ word defined by the application
        !           112:     over locals-buffer dup 1000 + within or  \ or a local
        !           113:     if
        !           114:        drop EXIT
        !           115:     endif
        !           116:     sp@ cell answords search-wordlist ( nt xt true | nt false )
        !           117:     if \ ans word
        !           118:        >body @ >body
        !           119:     else \ non-ans word
        !           120:        [ get-order wordsets swap 1+ set-order ] non-ANS [ previous ]
        !           121:     endif
        !           122:     ( nt wordset ) cell+ add-unless-present ;
        !           123: 
        !           124: : find&note-name ( c-addr u -- nt/0 )
        !           125:     \ find-name replacement. Takes note of all the words used.
        !           126:     lookup @ (search-wordlist) dup
        !           127:     if
        !           128:        dup note-name
        !           129:     endif ;
        !           130: 
        !           131: : replace-word ( xt cfa -- )
        !           132:     \ replace word at cfa with xt. !! This is quite general-purpose
        !           133:     \ and should migrate elsewhere.
        !           134:     dodefer: over code-address!
        !           135:     >body ! ;
        !           136: 
        !           137: forth definitions
        !           138: ans-report-words
        !           139: 
        !           140: : print-ans-report ( -- )
        !           141:     cr
        !           142:     ." The program uses the following words" cr
        !           143:     [ get-order wordsets swap 1+ set-order ] [(')] core [ previous ]
        !           144:     begin
        !           145:        dup 0<>
        !           146:     while
        !           147:        dup >r name>int >body dup @ swap cell+ 2@ dup
        !           148:        if
        !           149:            ." from " r@ .name ." :" cr
        !           150:            bounds
        !           151:            u+do
        !           152:                i @ .name
        !           153:                cell
        !           154:            +loop
        !           155:            cr
        !           156:        else
        !           157:            2drop
        !           158:        endif
        !           159:        rdrop
        !           160:     repeat
        !           161:     drop ;
        !           162:        
        !           163: \ the following sequence "' replace-word forth execute" is necessary
        !           164: \ to restore the default search order without effect on the "used
        !           165: \ word" lists
        !           166: ' find&note-name ' find-name ' replace-word forth execute