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: \ !! ignore struct-voc stuff (dummy, [then] etc.).
41:
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
91: include answords.fs
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¬e-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¬e-name ' find-name ' replace-word forth execute
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>