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