1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2000, 2012, 2013, 2015 Thomas Mertes */
5 /* 2021 Thomas Mertes */
6 /* */
7 /* This program is free software; you can redistribute it and/or */
8 /* modify it under the terms of the GNU General Public License as */
9 /* published by the Free Software Foundation; either version 2 of */
10 /* 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 */
18 /* License along with this program; if not, write to the */
19 /* Free Software Foundation, Inc., 51 Franklin Street, */
20 /* Fifth Floor, Boston, MA 02110-1301, USA. */
21 /* */
22 /* Module: Analyzer */
23 /* File: seed7/src/findid.c */
24 /* Changes: 1991 - 1994, 2012, 2013, 2015, 2021 Thomas Mertes */
25 /* Content: Procedures to maintain the identifier table. */
26 /* */
27 /********************************************************************/
28
29 #define LOG_FUNCTIONS 0
30 #define VERBOSE_EXCEPTIONS 0
31
32 #include "version.h"
33
34 #include "stdlib.h"
35 #include "stdio.h"
36 #include "string.h"
37
38 #include "common.h"
39 #include "data.h"
40 #include "heaputl.h"
41 #include "flistutl.h"
42 #include "datautl.h"
43 #include "chclsutl.h"
44 #include "identutl.h"
45 #include "entutl.h"
46 #include "traceutl.h"
47 #include "token.h"
48 #include "fatal.h"
49 #include "stat.h"
50 #include "symbol.h"
51 #include "object.h"
52 #include "error.h"
53 #include "infile.h"
54
55 #undef EXTERN
56 #define EXTERN
57 #include "findid.h"
58
59
60
id_generation(ustriType name,sySizeType length)61 static inline identType id_generation (ustriType name, sySizeType length)
62
63 {
64 register identType created_ident;
65
66 /* id_generation */
67 logFunction(printf("id_generation\n"););
68 if ((created_ident = new_ident(name, length)) == NULL) {
69 fatal_memory_error(SOURCE_POSITION(2041));
70 } /* if */
71 logFunction(printf("id_generation -->\n"););
72 return created_ident;
73 } /* id_generation */
74
75
76
find_normal_ident(sySizeType length)77 void find_normal_ident (sySizeType length)
78
79 { /* 0.62% */
80 register identType search_ident;
81 register int comparison;
82
83 /* find_normal_ident */
84 logFunction(printf("find_normal_ident\n"););
85 if ((search_ident = IDENT_TABLE(prog, symbol.name, length)) != NULL) { /* 1.49% */
86 if ((comparison = strcmp((cstriType) symbol.name,
87 (cstriType) search_ident->name)) != 0) { /* 0.73% */
88 do {
89 if (comparison < 0) { /* 0.07% */
90 if (search_ident->next1 == NULL) { /* 0.08% */
91 search_ident->next1 = id_generation(symbol.name, length);
92 search_ident = search_ident->next1;
93 current_ident = search_ident;
94 return;
95 /* The following statement can be used instead of the */
96 /* above two statements to avoid middle function returns. */
97 #ifdef OUT_OF_ORDER
98 comparison = 0;
99 #endif
100 } else {
101 search_ident = search_ident->next1; /* 0.02% */
102 comparison = strcmp((cstriType) symbol.name,
103 (cstriType) search_ident->name); /* 0.09% */
104 } /* if */
105 } else { /* 0.02% */
106 if (search_ident->next2 == NULL) { /* 0.06% */
107 search_ident->next2 = id_generation(symbol.name, length); /* 0.01% */
108 search_ident = search_ident->next2;
109 current_ident = search_ident;
110 return;
111 /* The following statement can be used instead of the */
112 /* above two statements to avoid middle function returns. */
113 #ifdef OUT_OF_ORDER
114 comparison = 0;
115 #endif
116 } else {
117 search_ident = search_ident->next2; /* 0.01% */
118 comparison = strcmp((cstriType) symbol.name,
119 (cstriType) search_ident->name); /* 0.07% */
120 } /* if */
121 } /* if */
122 } while (comparison != 0); /* 0.07% */
123 } /* if */
124 current_ident = search_ident; /* 0.12% */
125 } else {
126 current_ident = id_generation(symbol.name, length); /* 0.01% */
127 IDENT_TABLE(prog, symbol.name, length) = current_ident; /* 0.02% */
128 } /* if */
129 logFunction(printf("find_normal_ident -->\n"););
130 } /* find_normal_ident */ /* 0.62% */
131
132
133
put_ident(progType aProgram,const_cstriType stri,errInfoType * err_info)134 static identType put_ident (progType aProgram, const_cstriType stri,
135 errInfoType *err_info)
136
137 {
138 register identType ident_found;
139
140 /* put_ident */
141 logFunction(printf("put_ident\n"););
142 if ((ident_found = get_ident(aProgram, (const_ustriType) stri)) == NULL) {
143 *err_info = MEMORY_ERROR;
144 } /* if */
145 logFunction(printf("put_ident -->\n"););
146 return ident_found;
147 } /* put_ident */
148
149
150
check_list_of_syntax_elements(const_listType elem_list)151 void check_list_of_syntax_elements (const_listType elem_list)
152
153 { /* check_list_of_syntax_elements */
154 logFunction(printf("check_list_of_syntax_elements\n"););
155 while (elem_list != NULL) {
156 if (!HAS_ENTITY(elem_list->obj)) {
157 if (CATEGORY_OF_OBJ(elem_list->obj) != EXPROBJECT) {
158 err_object(IDENT_EXPECTED, elem_list->obj);
159 } /* if */
160 } /* if */
161 #ifdef OUT_OF_ORDER
162 if (GET_ENTITY(elem_list->obj) == prog->entity.literal) {
163 if (CATEGORY_OF_OBJ(elem_list->obj) != EXPROBJECT) {
164 err_object(IDENT_EXPECTED, elem_list->obj);
165 } /* if */
166 } /* if */
167 #endif
168 elem_list = elem_list->next;
169 } /* while */
170 logFunction(printf("check_list_of_syntax_elements -->\n"););
171 } /* check_list_of_syntax_elements */
172
173
174
clean_ident_tree(identType actual_ident)175 static void clean_ident_tree (identType actual_ident)
176
177 { /* clean_ident_tree */
178 logFunction(printf("clean_ident_tree\n"););
179 if (actual_ident != NULL) {
180 clean_ident_tree(actual_ident->next1);
181 free_tokens(actual_ident->prefix_token);
182 actual_ident->prefix_token = NULL;
183 free_tokens(actual_ident->infix_token);
184 actual_ident->infix_token = NULL;
185 clean_ident_tree(actual_ident->next2);
186 } /* if */
187 logFunction(printf("clean_ident_tree -->\n"););
188 } /* clean_ident_tree */
189
190
191
clean_idents(progType currentProg)192 void clean_idents (progType currentProg)
193
194 {
195 int position;
196 int character;
197 identType actual_ident;
198
199 /* clean_idents */
200 logFunction(printf("clean_idents\n"););
201 for (position = 0; position < ID_TABLE_SIZE; position++) {
202 clean_ident_tree(currentProg->ident.table[position]);
203 } /* for */
204 for (character = '!'; character <= '~'; character++) {
205 if (op_character(character) ||
206 char_class(character) == LEFTPARENCHAR ||
207 char_class(character) == PARENCHAR) {
208 actual_ident = currentProg->ident.table1[character];
209 if (actual_ident != NULL) {
210 free_tokens(actual_ident->prefix_token);
211 actual_ident->prefix_token = NULL;
212 free_tokens(actual_ident->infix_token);
213 actual_ident->infix_token = NULL;
214 } /* if */
215 } /* if */
216 } /* for */
217 logFunction(printf("clean_idents -->\n"););
218 } /* clean_idents */
219
220
221
wri_binary_ident_tree(const_identType actual_ident)222 static void wri_binary_ident_tree (const_identType actual_ident)
223
224 { /* wri_binary_ident_tree */
225 logFunction(printf("wri_binary_ident_tree\n"););
226 if (actual_ident != NULL) {
227 wri_binary_ident_tree(actual_ident->next1);
228 prot_cstri8(id_string(actual_ident));
229 prot_cstri(" ");
230 if (actual_ident->entity != NULL &&
231 actual_ident->entity->syobject != NULL) {
232 if (CATEGORY_OF_OBJ(actual_ident->entity->syobject) == SYMBOLOBJECT) {
233 prot_cstri(" ");
234 prot_string(get_file_name(GET_POS_FILE_NUM(actual_ident->entity->syobject)));
235 prot_cstri("(");
236 prot_int((intType) GET_POS_LINE_NUM(actual_ident->entity->syobject));
237 prot_cstri(")");
238 } /* if */
239 } /* if */
240 prot_nl();
241 wri_binary_ident_tree(actual_ident->next2);
242 } /* if */
243 logFunction(printf("wri_binary_ident_tree -->\n"););
244 } /* wri_binary_ident_tree */
245
246
247
write_idents(progType currentProg)248 void write_idents (progType currentProg)
249
250 {
251 int position;
252 int character;
253 identType actual_ident;
254
255 /* write_idents */
256 logFunction(printf("write_idents\n"););
257 for (position = 0; position < ID_TABLE_SIZE; position++) {
258 prot_cstri(" ====== ");
259 prot_int((intType) position);
260 prot_cstri(" ======\n");
261 wri_binary_ident_tree(currentProg->ident.table[position]);
262 } /* for */
263 for (character = '!'; character <= '~'; character++) {
264 if (op_character(character) ||
265 char_class(character) == LEFTPARENCHAR ||
266 char_class(character) == PARENCHAR) {
267 actual_ident = currentProg->ident.table1[character];
268 if (actual_ident != NULL) {
269 prot_cstri8(id_string(actual_ident));
270 prot_cstri(" ");
271 if (actual_ident->entity != NULL &&
272 actual_ident->entity->syobject != NULL) {
273 if (CATEGORY_OF_OBJ(actual_ident->entity->syobject) == SYMBOLOBJECT) {
274 prot_cstri(" ");
275 prot_string(get_file_name(GET_POS_FILE_NUM(actual_ident->entity->syobject)));
276 prot_cstri("(");
277 prot_int((intType) GET_POS_LINE_NUM(actual_ident->entity->syobject));
278 prot_cstri(")");
279 } /* if */
280 } /* if */
281 prot_nl();
282 } /* if */
283 } /* if */
284 } /* for */
285 logFunction(printf("write_idents -->\n"););
286 } /* write_idents */
287
288
289
init_findid(progType aProg,errInfoType * err_info)290 void init_findid (progType aProg, errInfoType *err_info)
291
292 { /* init_findid */
293 logFunction(printf("init_findid\n"););
294 aProg->id_for.lparen = put_ident(aProg, "(", err_info);
295 aProg->id_for.lbrack = put_ident(aProg, "[", err_info);
296 aProg->id_for.lbrace = put_ident(aProg, "{", err_info);
297 aProg->id_for.rparen = put_ident(aProg, ")", err_info);
298 aProg->id_for.rbrack = put_ident(aProg, "]", err_info);
299 aProg->id_for.rbrace = put_ident(aProg, "}", err_info);
300 aProg->id_for.dot = put_ident(aProg, ".", err_info);
301 aProg->id_for.colon = put_ident(aProg, ":", err_info);
302 aProg->id_for.comma = put_ident(aProg, ",", err_info);
303 aProg->id_for.semicolon = put_ident(aProg, ";", err_info);
304 aProg->id_for.dollar = put_ident(aProg, "$", err_info);
305 aProg->id_for.r_arrow = put_ident(aProg, "->", err_info);
306 aProg->id_for.l_arrow = put_ident(aProg, "<-", err_info);
307 aProg->id_for.out_arrow = put_ident(aProg, "<->", err_info);
308 aProg->id_for.in_arrow = put_ident(aProg, "-><-", err_info);
309 aProg->id_for.type = put_ident(aProg, "type", err_info);
310 aProg->id_for.constant = put_ident(aProg, "const", err_info);
311 aProg->id_for.ref = put_ident(aProg, "ref", err_info);
312 aProg->id_for.syntax = put_ident(aProg, "syntax", err_info);
313 aProg->id_for.system = put_ident(aProg, "system", err_info);
314 aProg->id_for.include = put_ident(aProg, "include", err_info);
315 aProg->id_for.is = put_ident(aProg, "is", err_info);
316 aProg->id_for.func = put_ident(aProg, "func", err_info);
317 aProg->id_for.param = put_ident(aProg, "param", err_info);
318 aProg->id_for.enumlit = put_ident(aProg, "enumlit", err_info);
319 aProg->id_for.subtype = put_ident(aProg, "subtype", err_info);
320 aProg->id_for.newtype = put_ident(aProg, "newtype", err_info);
321 aProg->id_for.action = put_ident(aProg, "action", err_info);
322 logFunction(printf("init_findid -->\n"););
323 } /* init_findid */
324