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¬e-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¬e-name ' find-name ' replace-word forth execute
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>