1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2015, 2021 Thomas Mertes */
5 /* */
6 /* This program is free software; you can redistribute it and/or */
7 /* modify it under the terms of the GNU General Public License as */
8 /* published by the Free Software Foundation; either version 2 of */
9 /* the License, or (at your option) any later version. */
10 /* */
11 /* This program is distributed in the hope that it will be useful, */
12 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
13 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
14 /* GNU General Public License for more details. */
15 /* */
16 /* You should have received a copy of the GNU General Public */
17 /* License along with this program; if not, write to the */
18 /* Free Software Foundation, Inc., 51 Franklin Street, */
19 /* Fifth Floor, Boston, MA 02110-1301, USA. */
20 /* */
21 /* Module: General */
22 /* File: seed7/src/entutl.c */
23 /* Changes: 2000, 2013 - 2015, 2021 Thomas Mertes */
24 /* Content: Procedures to maintain objects of type entityType. */
25 /* */
26 /********************************************************************/
27
28 #define LOG_FUNCTIONS 0
29 #define VERBOSE_EXCEPTIONS 0
30
31 #include "version.h"
32
33 #include "stdlib.h"
34 #include "stdio.h"
35
36 #include "common.h"
37 #include "data.h"
38 #include "heaputl.h"
39 #include "flistutl.h"
40 #include "listutl.h"
41 #include "datautl.h"
42 #include "traceutl.h"
43
44 #undef EXTERN
45 #define EXTERN
46 #include "entutl.h"
47
48
49 /* The macro PTR_LESS is used to generate a less than comparison */
50 /* for pointers. Since the comparison is used to build a binary */
51 /* tree a true less operation would have the danger of */
52 /* degenerating the tree to a linear list. But a true less */
53 /* comparison works since I have used it for years at this place. */
54 /* If you want a true less comparison replace this macro by: */
55 /* */
56 /* #define PTR_LESS(P1,P2) ((P1) < (P2)) */
57 /* */
58 /* The K&R standard allows pointer comparisons only inside */
59 /* arrays. So the true less comparison does not conform to the */
60 /* standard. The macro below casts the pointers to unsigned long, */
61 /* so it is confoming to the standard. Taking only the lower bits */
62 /* for the comparison has a "random" effect for the binary tree. */
63 /* This speeds the tree up a measurable amount of time. */
64
65 #define PTR_LESS(P1,P2) (((memSizeType) (P1) & 0377L) < ((memSizeType) (P2) & 0377L))
66
67 /* #define PTR_LESS(P1,P2) (((memSizeType) (P1) & 0177400L) < ((memSizeType) (P2) & 0177400L)) */
68 /* #define PTR_LESS(P1,P2) ((P1) < (P2)) */
69
70
71
72 /**
73 * Frees all nodes below the root 'node'.
74 */
free_nodes(nodeType node)75 static void free_nodes (nodeType node)
76
77 { /* free_nodes */
78 logFunction(printf("free_nodes(");
79 printnodes(node);
80 printf(")\n"););
81 if (node != NULL) {
82 /* node->entity is not removed here */
83 free_nodes(node->next1);
84 free_nodes(node->next2);
85 free_nodes(node->symbol);
86 free_nodes(node->inout_param);
87 free_nodes(node->other_param);
88 free_nodes(node->attr);
89 FREE_NODE(node);
90 } /* if */
91 logFunction(printf("free_nodes -->\n"););
92 } /* free_nodes */
93
94
95
96 /**
97 * Create a new node with the given match_obj 'obj'.
98 * @return the new node or NULL, if a memory error occurred.
99 */
new_node(objectType obj)100 static nodeType new_node (objectType obj)
101
102 {
103 nodeType created_node;
104
105 /* new_node */
106 logFunction(printf("new_node(");
107 trace1(obj);
108 printf(")\n"););
109 if (ALLOC_NODE(created_node)) {
110 created_node->usage_count = 1;
111 created_node->match_obj = obj;
112 created_node->next1 = NULL;
113 created_node->next2 = NULL;
114 created_node->entity = NULL;
115 created_node->symbol = NULL;
116 created_node->inout_param = NULL;
117 created_node->other_param = NULL;
118 created_node->attr = NULL;
119 } /* if */
120 logFunction(printf("new_node --> ");
121 trace_node(created_node);
122 printf("\n"););
123 return created_node;
124 } /* new_node */
125
126
127
128 /**
129 * Searches node_tree for a node matching object_searched.
130 * If a node is found it is returned. If no matching node is
131 * found a new node is generated and entered into node_tree.
132 * In this case the new node is returned.
133 * @return the node found or the new generated node or
134 * NULL, if a memory error occurred.
135 */
get_node(nodeType * node_tree,register objectType object_searched)136 static nodeType get_node (nodeType *node_tree,
137 register objectType object_searched)
138
139 {
140 register nodeType search_node;
141 register boolType searching;
142 nodeType node_found;
143
144 /* get_node */
145 logFunction(printf("get_node({ ");
146 printnodes(*node_tree);
147 printf("}, ");
148 trace1(object_searched);
149 printf(")\n"););
150 if ((search_node = *node_tree) == NULL) {
151 node_found = new_node(object_searched);
152 *node_tree = node_found;
153 } else {
154 node_found = NULL;
155 searching = TRUE;
156 do {
157 if (PTR_LESS(object_searched, search_node->match_obj)) {
158 if (search_node->next1 == NULL) {
159 node_found = new_node(object_searched);
160 search_node->next1 = node_found;
161 searching = FALSE;
162 } else {
163 search_node = search_node->next1;
164 } /* if */
165 } else if (object_searched == search_node->match_obj) {
166 node_found = search_node;
167 node_found->usage_count++;
168 searching = FALSE;
169 } else { /* (object_searched > search_node->match_obj) */
170 if (search_node->next2 == NULL) {
171 node_found = new_node(object_searched);
172 search_node->next2 = node_found;
173 searching = FALSE;
174 } else {
175 search_node = search_node->next2;
176 } /* if */
177 } /* if */
178 } while (searching);
179 } /* if */
180 /* printf("get_node >%s<\n", object_searched->entity->ident->name); */
181 logFunction(printf("get_node --> ");
182 trace_node(node_found);
183 printf("\n"););
184 return node_found;
185 } /* get_node */
186
187
188
189 /**
190 * Searches node_tree for a node matching object_searched.
191 * @return the node found or NULL if no matching node is found.
192 */
find_node(register nodeType node_tree,register objectType object_searched)193 nodeType find_node (register nodeType node_tree,
194 register objectType object_searched)
195
196 {
197 nodeType node_found = NULL;
198
199 /* find_node */
200 logFunction(printf("find_node({ ");
201 printnodes(node_tree);
202 printf("}, ");
203 trace1(object_searched);
204 printf("=" FMT_U_MEM ")\n",
205 (memSizeType) object_searched););
206 while (node_tree != NULL) {
207 if (PTR_LESS(object_searched, node_tree->match_obj)) {
208 node_tree = node_tree->next1;
209 } else if (object_searched == node_tree->match_obj) {
210 if (node_tree->usage_count > 0) {
211 /* Just consider nodes that are in use now. */
212 node_found = node_tree;
213 } /* if */
214 node_tree = NULL;
215 } else { /* (object_searched > node_tree->match_obj) */
216 node_tree = node_tree->next2;
217 } /* if */
218 } /* while */
219 /* printf("%s\n", (node_found != NULL ? "found" : "not found")); */
220 logFunction(printf("find_node --> ");
221 if (node_found != NULL) {
222 trace1(node_found->match_obj);
223 printf("\n");
224 } else {
225 printf("*NULL_NODE*\n");
226 });
227 return node_found;
228 } /* find_node */
229
230
231
232 /**
233 * Search node_tree for object_searched and decrement node usage count.
234 * Searches node_tree for a node matching object_searched. If a node
235 * is found its usage_count is decremented. If the node is unused now
236 * it is kept, but its symbol, inout, other and attr subnode trees are
237 * removed and set to NULL. For an unused node the next1 and next2
238 * subnodes and the match_obj are kept intact and the function returns
239 * NULL. The function find_node() ignores nodes with usage_count zero
240 * and the function get_node() just reactivates such a node. If the
241 * node found is still in use it is returned. If no matching node is
242 * found NULL is returned.
243 * @return a node that is still in use after it has been popped, or
244 * NULL if the last usage of a node has been removed, or
245 * NULL if no matching node has been found.
246 */
pop_node(register nodeType node_tree,register objectType object_searched)247 static nodeType pop_node (register nodeType node_tree,
248 register objectType object_searched)
249
250 {
251 nodeType node_found = NULL;
252
253 /* pop_node */
254 logFunction(printf("pop_node({ ");
255 printnodes(node_tree);
256 printf("}, ");
257 trace1(object_searched);
258 printf("=" FMT_U_MEM ")\n",
259 (memSizeType) object_searched););
260 while (node_tree != NULL) {
261 if (PTR_LESS(object_searched, node_tree->match_obj)) {
262 node_tree = node_tree->next1;
263 } else if (object_searched == node_tree->match_obj) {
264 if (node_tree->usage_count > 0) {
265 /* Just consider nodes that are in use now. */
266 node_tree->usage_count--;
267 if (node_tree->usage_count == 0) {
268 node_tree->entity = NULL;
269 free_nodes(node_tree->symbol);
270 free_nodes(node_tree->inout_param);
271 free_nodes(node_tree->other_param);
272 free_nodes(node_tree->attr);
273 node_tree->symbol = NULL;
274 node_tree->inout_param = NULL;
275 node_tree->other_param = NULL;
276 node_tree->attr = NULL;
277 } else {
278 node_found = node_tree;
279 } /* if */
280 } /* if */
281 node_tree = NULL;
282 } else { /* (object_searched > node_tree->match_obj) */
283 node_tree = node_tree->next2;
284 } /* if */
285 } /* while */
286 /* printf("%s\n", (node_found != NULL ? "found" : "not found")); */
287 logFunction(printf("pop_node --> ");
288 if (node_found != NULL) {
289 trace1(node_found->match_obj);
290 printf("\n");
291 } else {
292 printf("*NULL_NODE*\n");
293 });
294 return node_found;
295 } /* pop_node */
296
297
298
init_declaration_root(progType currentProg,errInfoType * err_info)299 void init_declaration_root (progType currentProg, errInfoType *err_info)
300
301 { /* init_declaration_root */
302 logFunction(printf("init_declaration_root\n"););
303 currentProg->declaration_root = new_node(NULL);
304 if (currentProg->declaration_root == NULL) {
305 *err_info = MEMORY_ERROR;
306 } /* if */
307 logFunction(printf("init_declaration_root -->\n"););
308 } /* init_declaration_root */
309
310
311
close_declaration_root(progType currentProg)312 void close_declaration_root (progType currentProg)
313
314 { /* close_declaration_root */
315 logFunction(printf("close_declaration_root\n"););
316 free_nodes(currentProg->declaration_root);
317 currentProg->declaration_root = NULL;
318 logFunction(printf("close_declaration_root -->\n"););
319 } /* close_declaration_root */
320
321
322
free_entity(const_progType currentProg,entityType old_entity)323 void free_entity (const_progType currentProg, entityType old_entity)
324
325 {
326 listType name_elem;
327 objectType param_obj;
328
329 /* free_entity */
330 logFunction(printf("free_entity\n"););
331 if (old_entity != NULL) {
332 if (old_entity->syobject != NULL) {
333 if (HAS_PROPERTY(old_entity->syobject) &&
334 old_entity->syobject->descriptor.property != currentProg->property.literal) {
335 /* trace1(old_entity->syobject);
336 printf("\n"); */
337 FREE_RECORD(old_entity->syobject->descriptor.property, propertyRecord, count.property);
338 } /* if */
339 FREE_OBJECT(old_entity->syobject);
340 } /* if */
341 if (old_entity->fparam_list != NULL) {
342 name_elem = old_entity->fparam_list;
343 while (name_elem != NULL) {
344 if (CATEGORY_OF_OBJ(name_elem->obj) == FORMPARAMOBJECT) {
345 param_obj = name_elem->obj->value.objValue;
346 if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
347 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT) {
348 FREE_OBJECT(param_obj);
349 } /* if */
350 FREE_OBJECT(name_elem->obj);
351 } /* if */
352 name_elem = name_elem->next;
353 } /* if */
354 free_list(old_entity->fparam_list);
355 } /* if */
356 FREE_RECORD(old_entity, entityRecord, count.entity);
357 } /* if */
358 logFunction(printf("free_entity -->\n"););
359 } /* free_entity */
360
361
362
363 /**
364 * Create a new entity with the given 'id'.
365 * @return the new entity or NULL, if a memory error occurred.
366 */
new_entity(identType id)367 static entityType new_entity (identType id)
368
369 {
370 entityType created_entity;
371
372 /* new_entity */
373 logFunction(printf("new_entity\n"););
374 if (ALLOC_RECORD(created_entity, entityRecord, count.entity)) {
375 created_entity->ident = id;
376 created_entity->syobject = NULL;
377 created_entity->fparam_list = NULL;
378 created_entity->data.owner = NULL;
379 } /* if */
380 logFunction(printf("new_entity --> ");
381 prot_cstri8(id_string(created_entity->ident));
382 printf("\n"););
383 return created_entity;
384 } /* new_entity */
385
386
387
388 /**
389 * Copy formal value and reference parameter objects.
390 * The parameters are allocated first in a list and later assigned.
391 * This way everything can be cleaned up and name_list is unchanged,
392 * if a memory error occurs.
393 */
copy_params(listType name_list)394 static errInfoType copy_params (listType name_list)
395
396 {
397 listType name_elem;
398 objectType param_obj;
399 objectType copied_param;
400 listType copied_param_list = NULL;
401 listType *list_insert_place;
402 listType curr_param;
403 errInfoType err_info = OKAY_NO_ERROR;
404
405 /* copy_params */
406 logFunction(printf("copy_params\n"););
407 list_insert_place = &copied_param_list;
408 name_elem = name_list;
409 while (name_elem != NULL && err_info == OKAY_NO_ERROR) {
410 if (CATEGORY_OF_OBJ(name_elem->obj) == FORMPARAMOBJECT) {
411 param_obj = name_elem->obj->value.objValue;
412 if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
413 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT) {
414 if (ALLOC_OBJECT(copied_param)) {
415 INIT_CATEGORY_OF_OBJ(copied_param, CATEGORY_OF_OBJ(param_obj));
416 COPY_VAR_FLAG(copied_param, param_obj);
417 copied_param->type_of = param_obj->type_of;
418 copied_param->descriptor.property = NULL;
419 copied_param->value.objValue = NULL;
420 list_insert_place = append_element_to_list(list_insert_place,
421 copied_param, &err_info);
422 if (err_info != OKAY_NO_ERROR) {
423 FREE_OBJECT(copied_param);
424 } /* if */
425 } else {
426 err_info = MEMORY_ERROR;
427 } /* if */
428 } /* if */
429 } /* if */
430 name_elem = name_elem->next;
431 } /* while */
432 if (err_info == OKAY_NO_ERROR) {
433 curr_param = copied_param_list;
434 name_elem = name_list;
435 while (name_elem != NULL) {
436 if (CATEGORY_OF_OBJ(name_elem->obj) == FORMPARAMOBJECT) {
437 param_obj = name_elem->obj->value.objValue;
438 if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
439 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT) {
440 name_elem->obj->value.objValue = curr_param->obj;
441 curr_param = curr_param->next;
442 } /* if */
443 } /* if */
444 name_elem = name_elem->next;
445 } /* while */
446 } else {
447 curr_param = copied_param_list;
448 while (curr_param != NULL) {
449 FREE_OBJECT(curr_param->obj);
450 curr_param = curr_param->next;
451 } /* while */
452 } /* if */
453 free_list(copied_param_list);
454 logFunction(printf("copy_params --> %d\n", err_info););
455 return err_info;
456 } /* copy_params */
457
458
459
pop_name_list(nodeType declaration_base,listType name_list)460 static void pop_name_list (nodeType declaration_base, listType name_list)
461
462 {
463 listType name_elem;
464 objectType param_obj;
465 nodeType curr_node;
466
467 /* pop_name_list */
468 logFunction(printf("pop_name_list\n"););
469 name_elem = name_list;
470 curr_node = declaration_base;
471 while (name_elem != NULL && curr_node != NULL) {
472 if (CATEGORY_OF_OBJ(name_elem->obj) == FORMPARAMOBJECT) {
473 param_obj = name_elem->obj->value.objValue;
474 if (CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT && VAR_OBJECT(param_obj)) {
475 curr_node = pop_node(curr_node->inout_param, param_obj->type_of->match_obj);
476 } else if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
477 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT) {
478 curr_node = pop_node(curr_node->other_param, param_obj->type_of->match_obj);
479 } else if (CATEGORY_OF_OBJ(param_obj) == TYPEOBJECT) {
480 curr_node = pop_node(curr_node->attr, param_obj->value.typeValue->match_obj);
481 } else if (CATEGORY_OF_OBJ(param_obj) == FORMPARAMOBJECT) {
482 curr_node = pop_node(curr_node->attr, param_obj);
483 } else {
484 curr_node = pop_node(curr_node->symbol, param_obj);
485 } /* if */
486 } else {
487 curr_node = pop_node(curr_node->symbol, name_elem->obj);
488 } /* if */
489 name_elem = name_elem->next;
490 } /* while */
491 logFunction(printf("pop_name_list -->\n"););
492 } /* pop_name_list */
493
494
495
496 /**
497 * Searches declaration_base for a node matching name_list.
498 * If a node is found it is returned. If no matching node is
499 * found new nodes are generated and entered into declaration_base.
500 * In this case the new node at the bottom is returned.
501 * @return the node found or the new generated node or
502 * NULL, if a memory error occurred.
503 */
get_entity_node(nodeType declaration_base,listType name_list)504 static nodeType get_entity_node (nodeType declaration_base, listType name_list)
505
506 {
507 listType name_elem;
508 objectType param_obj;
509 nodeType curr_node;
510
511 /* get_entity_node */
512 logFunction(printf("get_entity_node(");
513 prot_list(name_list);
514 printf(")\n"););
515 name_elem = name_list;
516 curr_node = declaration_base;
517 while (name_elem != NULL && curr_node != NULL) {
518 if (CATEGORY_OF_OBJ(name_elem->obj) == FORMPARAMOBJECT) {
519 param_obj = name_elem->obj->value.objValue;
520 if (CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT && VAR_OBJECT(param_obj)) {
521 curr_node = get_node(&curr_node->inout_param, param_obj->type_of->match_obj);
522 } else if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
523 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT) {
524 curr_node = get_node(&curr_node->other_param, param_obj->type_of->match_obj);
525 } else if (CATEGORY_OF_OBJ(param_obj) == TYPEOBJECT) {
526 curr_node = get_node(&curr_node->attr, param_obj->value.typeValue->match_obj);
527 } else if (CATEGORY_OF_OBJ(param_obj) == FORMPARAMOBJECT) {
528 curr_node = get_node(&curr_node->attr, param_obj);
529 } else {
530 curr_node = get_node(&curr_node->symbol, param_obj);
531 } /* if */
532 } else {
533 curr_node = get_node(&curr_node->symbol, name_elem->obj);
534 } /* if */
535 name_elem = name_elem->next;
536 } /* while */
537 logFunction(printf("get_entity_node --> ");
538 if (curr_node != NULL) {
539 trace1(curr_node->match_obj);
540 printf("\n");
541 } else {
542 printf("*NULL_NODE*\n");
543 });
544 return curr_node;
545 } /* get_entity_node */
546
547
548
549 /**
550 * Searches declaration_base for an entity matching name_list.
551 * If an entity is found it is returned. If no matching entity is
552 * found a new entity is generated and entered into declaration_base.
553 * In this case the new entity is returned.
554 * @return the entity found or the new generated entity or
555 * NULL, if a memory error occurred.
556 */
get_entity(nodeType declaration_base,listType name_list)557 entityType get_entity (nodeType declaration_base, listType name_list)
558
559 {
560 nodeType node_found;
561 entityType entity_found;
562
563 /* get_entity */
564 logFunction(printf("get_entity(");
565 prot_list(name_list);
566 printf(")\n"););
567 node_found = get_entity_node(declaration_base, name_list);
568 if (node_found == NULL) {
569 /* A memory error occurred. */
570 pop_name_list(declaration_base, name_list);
571 entity_found = NULL;
572 } else if (node_found->entity != NULL) {
573 entity_found = node_found->entity;
574 } else {
575 if ((entity_found = new_entity(NULL)) == NULL) {
576 pop_name_list(declaration_base, name_list);
577 } else {
578 if (copy_params(name_list) != OKAY_NO_ERROR) {
579 pop_name_list(declaration_base, name_list);
580 FREE_RECORD(entity_found, entityRecord, count.entity);
581 entity_found = NULL;
582 } else {
583 entity_found->fparam_list = name_list;
584 node_found->entity = entity_found;
585 } /* if */
586 } /* if */
587 } /* if */
588 logFunction(printf("get_entity -->\n");
589 trace_entity(entity_found););
590 return entity_found;
591 } /* get_entity */
592
593
594
595 /**
596 * Searches declaration_base for an entity matching name_list.
597 * @return the entity found or NULL if no matching entity is found.
598 */
find_entity(nodeType declaration_base,listType name_list)599 entityType find_entity (nodeType declaration_base, listType name_list)
600
601 {
602 listType name_elem;
603 objectType param_obj;
604 nodeType curr_node;
605 entityType entity_found;
606
607 /* find_entity */
608 logFunction(printf("find_entity(");
609 prot_list(name_list);
610 printf(")\n"););
611 name_elem = name_list;
612 curr_node = declaration_base;
613 while (name_elem != NULL && curr_node != NULL) {
614 if (CATEGORY_OF_OBJ(name_elem->obj) == FORMPARAMOBJECT) {
615 param_obj = name_elem->obj->value.objValue;
616 if (CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT && VAR_OBJECT(param_obj)) {
617 curr_node = find_node(curr_node->inout_param, param_obj->type_of->match_obj);
618 } else if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
619 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT) {
620 curr_node = find_node(curr_node->other_param, param_obj->type_of->match_obj);
621 } else if (CATEGORY_OF_OBJ(param_obj) == TYPEOBJECT) {
622 curr_node = find_node(curr_node->attr, param_obj->value.typeValue->match_obj);
623 } else if (CATEGORY_OF_OBJ(param_obj) == FORMPARAMOBJECT) {
624 curr_node = find_node(curr_node->attr, param_obj);
625 } else {
626 curr_node = find_node(curr_node->symbol, param_obj);
627 } /* if */
628 } else {
629 curr_node = find_node(curr_node->symbol, name_elem->obj);
630 } /* if */
631 name_elem = name_elem->next;
632 } /* while */
633 if (curr_node != NULL) {
634 entity_found = curr_node->entity;
635 } else {
636 entity_found = NULL;
637 } /* if */
638 logFunction(printf("find_entity -->\n");
639 trace_entity(entity_found););
640 return entity_found;
641 } /* find_entity */
642
643
644
search_entity(const_nodeType start_node,const_listType name_list)645 entityType search_entity (const_nodeType start_node, const_listType name_list)
646
647 {
648 objectType param_obj;
649 nodeType node_found;
650 typeType object_type;
651 entityType entity_found;
652
653 /* search_entity */
654 logFunction(printf("search_entity(");
655 prot_list(name_list);
656 printf(")\n"););
657 if (name_list == NULL) {
658 if (start_node != NULL) {
659 entity_found = start_node->entity;
660 } else {
661 entity_found = NULL;
662 } /* if */
663 } else {
664 entity_found = NULL;
665 if (start_node != NULL) {
666 if (CATEGORY_OF_OBJ(name_list->obj) == FORMPARAMOBJECT) {
667 /* printf("paramobject x\n"); */
668 param_obj = name_list->obj->value.objValue;
669 if (CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT && VAR_OBJECT(param_obj)) {
670 /* printf("inout param ");
671 trace1(param_obj);
672 printf("\n"); */
673 object_type = param_obj->type_of;
674 do {
675 node_found = find_node(start_node->inout_param, object_type->match_obj);
676 if (node_found != NULL) {
677 entity_found = search_entity(node_found, name_list->next);
678 } /* if */
679 object_type = object_type->meta;
680 } while (object_type != NULL && entity_found == NULL);
681 } else if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
682 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT) {
683 /* printf("value or ref param ");
684 trace1(param_obj);
685 printf("\n"); */
686 object_type = param_obj->type_of;
687 do {
688 node_found = find_node(start_node->other_param, object_type->match_obj);
689 if (node_found != NULL) {
690 entity_found = search_entity(node_found, name_list->next);
691 } /* if */
692 object_type = object_type->meta;
693 } while (object_type != NULL && entity_found == NULL);
694 } else if (CATEGORY_OF_OBJ(param_obj) == TYPEOBJECT) {
695 /* printf("attr param ");
696 trace1(param_obj);
697 printf("\n"); */
698 object_type = param_obj->value.typeValue;
699 do {
700 node_found = find_node(start_node->attr, object_type->match_obj);
701 if (node_found != NULL) {
702 entity_found = search_entity(node_found, name_list->next);
703 } /* if */
704 object_type = object_type->meta;
705 } while (object_type != NULL && entity_found == NULL);
706 } else {
707 /* printf("symbol param ");
708 trace1(param_obj);
709 printf("\n"); */
710 node_found = find_node(start_node->symbol, param_obj);
711 if (node_found != NULL) {
712 entity_found = search_entity(node_found, name_list->next);
713 } /* if */
714 } /* if */
715 } else {
716 /* printf("symbol param ");
717 trace1(name_list->obj);
718 printf("\n"); */
719 node_found = find_node(start_node->symbol, name_list->obj);
720 if (node_found != NULL) {
721 entity_found = search_entity(node_found, name_list->next);
722 } /* if */
723 /* printf("after symbol param\n"); */
724 } /* if */
725 } /* if */
726 } /* if */
727 logFunction(printf("search_entity ->\n"););
728 return entity_found;
729 } /* search_entity */
730
731
732
pop_entity(nodeType declaration_base,const_entityType entity)733 void pop_entity (nodeType declaration_base, const_entityType entity)
734
735 { /* pop_entity */
736 logFunction(printf("pop_entity\n"););
737 /* trace_entity(entity); */
738 pop_name_list(declaration_base, entity->fparam_list);
739 logFunction(printf("pop_entity -->\n"););
740 } /* pop_entity */
741
742
743
close_entity(progType currentProg)744 void close_entity (progType currentProg)
745
746 {
747 entityType entity;
748 entityType old_entity;
749
750 /* close_entity */
751 logFunction(printf("close_entity\n"););
752 entity = currentProg->entity.inactive_list;
753 while (entity != NULL) {
754 old_entity = entity;
755 entity = entity->data.next;
756 free_entity(currentProg, old_entity);
757 } /* while */
758 currentProg->entity.inactive_list = NULL;
759 logFunction(printf("close_entity -->\n"););
760 } /* close_entity */
761
762
763
init_entity(progType aProg,errInfoType * err_info)764 void init_entity (progType aProg, errInfoType *err_info)
765
766 { /* init_entity */
767 logFunction(printf("init_entity\n"););
768 aProg->entity.inactive_list = NULL;
769 if ((aProg->entity.literal = new_entity(aProg->ident.literal)) == NULL) {
770 *err_info = MEMORY_ERROR;
771 } /* if */
772 if (!ALLOC_RECORD(aProg->property.literal, propertyRecord, count.property)) {
773 *err_info = MEMORY_ERROR;
774 } else {
775 aProg->property.literal->entity = aProg->entity.literal;
776 aProg->property.literal->params = NULL;
777 aProg->property.literal->file_number = 0;
778 aProg->property.literal->line = 0;
779 aProg->property.literal->syNumberInLine = 0;
780 } /* if */
781 logFunction(printf("init_entity -->\n"););
782 } /* init_entity */
783