[gforth] / gforth / ans-report.fs  

gforth: gforth/ans-report.fs

1 : anton 1.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
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help