]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* SymbolConversion.mod mapping between m2 symbols and gcc symbols. |
2 | ||
83ffe9cd | 3 | Copyright (C) 2001-2023 Free Software Foundation, Inc. |
1eee94d3 GM |
4 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | You should have received a copy of the GNU General Public License | |
19 | along with GNU Modula-2; see the file COPYING3. If not see | |
20 | <http://www.gnu.org/licenses/>. *) | |
21 | ||
22 | IMPLEMENTATION MODULE SymbolConversion ; | |
23 | ||
24 | FROM NameKey IMPORT Name ; | |
25 | ||
26 | FROM Indexing IMPORT Index, InitIndex, PutIndice, GetIndice, InBounds, | |
27 | DebugIndex ; | |
28 | ||
29 | FROM SymbolTable IMPORT IsConst, PopValue, IsValueSolved, GetSymName, | |
30 | GetType, SkipType ; | |
31 | ||
32 | FROM M2Error IMPORT InternalError ; | |
33 | FROM M2ALU IMPORT PushTypeOfTree ; | |
34 | FROM m2block IMPORT GetErrorNode, RememberConstant ; | |
35 | FROM m2tree IMPORT Tree ; | |
36 | FROM M2Printf IMPORT printf1 ; | |
37 | FROM Storage IMPORT ALLOCATE ; | |
38 | FROM SYSTEM IMPORT ADDRESS ; | |
39 | ||
40 | CONST | |
41 | USEPOISON = TRUE ; | |
42 | GGCPOISON = 0A5A5A5A5H ; (* poisoned memory contains this code *) | |
43 | ||
44 | TYPE | |
45 | PtrToCardinal = POINTER TO CARDINAL ; | |
46 | ||
47 | VAR | |
48 | mod2gcc : Index ; | |
49 | PoisonedSymbol: ADDRESS ; | |
50 | ||
51 | ||
52 | (* | |
53 | Mod2Gcc - given a modula-2 symbol, sym, return the gcc equivalent. | |
54 | *) | |
55 | ||
56 | PROCEDURE Mod2Gcc (sym: CARDINAL) : Tree ; | |
57 | VAR | |
58 | n : Name ; | |
59 | t : PtrToCardinal ; | |
60 | tr: Tree ; | |
61 | BEGIN | |
62 | IF USEPOISON | |
63 | THEN | |
64 | IF InBounds(mod2gcc, sym) | |
65 | THEN | |
66 | t := PtrToCardinal(GetIndice(mod2gcc, sym)) ; | |
67 | IF (t#NIL) AND (t^=GGCPOISON) | |
68 | THEN | |
69 | InternalError ('gcc symbol has been poisoned') | |
70 | END | |
71 | END | |
72 | END ; | |
73 | IF InBounds(mod2gcc, sym) | |
74 | THEN | |
75 | tr := Tree(GetIndice(mod2gcc, sym)) ; | |
76 | IF tr=PoisonedSymbol | |
77 | THEN | |
78 | n := GetSymName(sym) ; | |
79 | (* not poisoned by the garbage collector, but by the gm2 front end *) | |
80 | printf1('the gm2 front end poisoned this symbol (%a)\n', n) ; | |
81 | InternalError ('attempting to use a gcc symbol which is no longer in scope') | |
82 | END ; | |
83 | RETURN( tr ) | |
84 | ELSE | |
85 | RETURN( NIL ) | |
86 | END | |
87 | END Mod2Gcc ; | |
88 | ||
89 | ||
90 | (* | |
91 | AddModGcc - adds the tuple [ sym, gcc ] into the database. | |
92 | *) | |
93 | ||
94 | PROCEDURE AddModGcc (sym: CARDINAL; gcc: Tree) ; | |
95 | VAR | |
96 | old: Tree ; | |
97 | t : PtrToCardinal ; | |
98 | BEGIN | |
99 | IF gcc=GetErrorNode() | |
100 | THEN | |
101 | InternalError ('error node generated during symbol conversion') | |
102 | END ; | |
103 | ||
104 | IF USEPOISON | |
105 | THEN | |
106 | t := PtrToCardinal(gcc) ; | |
107 | IF (gcc#Tree(NIL)) AND (t^=GGCPOISON) | |
108 | THEN | |
109 | InternalError ('gcc symbol has been poisoned') | |
110 | END | |
111 | END ; | |
112 | ||
113 | old := Mod2Gcc(sym) ; | |
114 | IF old=Tree(NIL) | |
115 | THEN | |
116 | (* absent - add it *) | |
117 | PutIndice(mod2gcc, sym, gcc) ; | |
118 | IF GetIndice(mod2gcc, sym)#gcc | |
119 | THEN | |
120 | InternalError ('failed to add gcc <-> mod2 symbol') | |
121 | END ; | |
122 | gcc := RememberConstant(gcc) | |
123 | ELSIF old=gcc | |
124 | THEN | |
125 | (* do nothing, as it is already stored *) | |
126 | ELSIF old=GetErrorNode() | |
127 | THEN | |
128 | InternalError ('replacing a temporary symbol (currently unexpected)') | |
129 | ELSE | |
130 | InternalError ('should not be replacing a symbol') | |
131 | END ; | |
132 | ||
133 | IF IsConst(sym) AND (NOT IsValueSolved(sym)) | |
134 | THEN | |
135 | PushTypeOfTree(sym, gcc) ; | |
136 | PopValue(sym) | |
137 | END | |
138 | END AddModGcc ; | |
139 | ||
140 | ||
141 | (* | |
142 | RemoveMod2Gcc - removes the gcc symbol from the lookup table. | |
143 | *) | |
144 | ||
145 | PROCEDURE RemoveMod2Gcc (sym: CARDINAL) ; | |
146 | BEGIN | |
147 | PutIndice(mod2gcc, sym, NIL) | |
148 | END RemoveMod2Gcc ; | |
149 | ||
150 | ||
151 | (* | |
152 | GccKnowsAbout - returns TRUE if gcc knows about the symbol, sym. | |
153 | *) | |
154 | ||
155 | PROCEDURE GccKnowsAbout (sym: CARDINAL) : BOOLEAN ; | |
156 | BEGIN | |
157 | RETURN( InBounds(mod2gcc, sym) AND (GetIndice(mod2gcc, sym)#NIL) ) | |
158 | END GccKnowsAbout ; | |
159 | ||
160 | ||
161 | (* | |
162 | AddTemporaryKnown - adds a temporary gcc symbol against the modula-2 sym. | |
163 | *) | |
164 | ||
165 | PROCEDURE AddTemporaryKnown (sym: CARDINAL) ; | |
166 | BEGIN | |
167 | (* we add the error node against symbol, sym. We expect it to be retacted later. *) | |
168 | PutIndice (mod2gcc, sym, GetErrorNode ()) | |
169 | END AddTemporaryKnown ; | |
170 | ||
171 | ||
172 | (* | |
173 | RemoveTemporaryKnown - removes the temporary symbol. | |
174 | *) | |
175 | ||
176 | PROCEDURE RemoveTemporaryKnown (sym: CARDINAL) ; | |
177 | BEGIN | |
178 | IF Mod2Gcc(sym)=GetErrorNode() | |
179 | THEN | |
180 | PutIndice(mod2gcc, sym, NIL) | |
181 | ELSE | |
182 | InternalError ('attempting to remove a symbol which is not present in the tree') | |
183 | END | |
184 | END RemoveTemporaryKnown ; | |
185 | ||
186 | ||
187 | (* | |
188 | Mod2GccWithoutGCCPoison - given a modula-2 symbol, sym, return | |
189 | the gcc equivalent, it does not check to see | |
190 | whether the gcc symbol has been poisoned. | |
191 | *) | |
192 | ||
193 | PROCEDURE Mod2GccWithoutGCCPoison (sym: CARDINAL) : Tree ; | |
194 | VAR | |
195 | n : Name ; | |
196 | tr: Tree ; | |
197 | BEGIN | |
198 | IF InBounds(mod2gcc, sym) | |
199 | THEN | |
200 | tr := Tree(GetIndice(mod2gcc, sym)) ; | |
201 | IF tr=PoisonedSymbol | |
202 | THEN | |
203 | n := GetSymName(sym) ; | |
204 | (* not poisoned by the garbage collector, but by the gm2 front end. *) | |
205 | printf1 ('the gm2 front end poisoned this symbol (%a)\n', n) ; | |
206 | InternalError ('attempting to use a gcc symbol which is no longer in scope') | |
207 | END ; | |
208 | RETURN tr | |
209 | ELSE | |
210 | RETURN NIL | |
211 | END | |
212 | END Mod2GccWithoutGCCPoison ; | |
213 | ||
214 | ||
215 | (* | |
216 | Poison - poisons a symbol. | |
217 | *) | |
218 | ||
219 | PROCEDURE Poison (sym: WORD) ; | |
220 | VAR | |
221 | a: ADDRESS ; | |
222 | BEGIN | |
223 | IF NOT IsConst(sym) | |
224 | THEN | |
225 | a := Mod2GccWithoutGCCPoison(sym) ; | |
226 | IF a#NIL | |
227 | THEN | |
228 | PutIndice(mod2gcc, sym, PoisonedSymbol) | |
229 | END | |
230 | END | |
231 | END Poison ; | |
232 | ||
233 | ||
234 | (* | |
235 | Init - create both binary trees. | |
236 | *) | |
237 | ||
238 | PROCEDURE Init ; | |
239 | BEGIN | |
240 | mod2gcc := InitIndex(1) ; | |
241 | ALLOCATE(PoisonedSymbol, 1) | |
242 | END Init ; | |
243 | ||
244 | ||
245 | BEGIN | |
246 | Init | |
247 | END SymbolConversion. |