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>