1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2013, 2015, 2020, 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: Analyzer */
22 /* File: seed7/src/name.c */
23 /* Changes: 1994, 2011, 2013, 2015, 2020, 2021 Thomas Mertes */
24 /* Content: Enter an object in a specified declaration level. */
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 #include "string.h"
36
37 #include "common.h"
38 #include "data.h"
39 #include "heaputl.h"
40 #include "flistutl.h"
41 #include "identutl.h"
42 #include "objutl.h"
43 #include "entutl.h"
44 #include "typeutl.h"
45 #include "listutl.h"
46 #include "traceutl.h"
47 #include "executl.h"
48 #include "exec.h"
49 #include "dcllib.h"
50 #include "findid.h"
51 #include "match.h"
52 #include "error.h"
53
54 #undef EXTERN
55 #define EXTERN
56 #include "name.h"
57
58
59 static int data_depth = 0;
60 static int depth = 0;
61
62
63
push_owner(ownerType * owner,objectType obj_to_push,stackType decl_level,errInfoType * err_info)64 static void push_owner (ownerType *owner, objectType obj_to_push,
65 stackType decl_level, errInfoType *err_info)
66
67 {
68 ownerType created_owner;
69
70 /* push_owner */
71 logFunction(printf("push_owner " FMT_U_MEM ", ",
72 (memSizeType) obj_to_push);
73 trace1(obj_to_push);
74 printf("\n"););
75 if (ALLOC_RECORD(created_owner, ownerRecord, count.owner)) {
76 created_owner->obj = obj_to_push;
77 created_owner->decl_level = decl_level;
78 created_owner->next = *owner;
79 *owner = created_owner;
80 } else {
81 *err_info = MEMORY_ERROR;
82 } /* if */
83 logFunction(printf("push_owner --> " FMT_U_MEM ", ",
84 (memSizeType) obj_to_push);
85 trace1(obj_to_push);
86 printf("\n"););
87 } /* push_owner */
88
89
90
pop_owner(ownerType * owner)91 static void pop_owner (ownerType *owner)
92
93 {
94 ownerType old_owner;
95
96 /* pop_owner */
97 logFunction(printf("pop_owner\n"););
98 old_owner = *owner;
99 *owner = old_owner->next;
100 FREE_RECORD(old_owner, ownerRecord, count.owner);
101 logFunction(printf("pop_owner -->\n"););
102 } /* pop_owner */
103
104
105
free_params(progType currentProg,listType params)106 static void free_params (progType currentProg, listType params)
107
108 {
109 listType param_elem;
110 objectType param;
111
112 /* free_params */
113 logFunction(printf("free_params\n"););
114 param_elem = params;
115 while (param_elem != NULL) {
116 param = param_elem->obj;
117 if (CATEGORY_OF_OBJ(param) == VALUEPARAMOBJECT ||
118 CATEGORY_OF_OBJ(param) == REFPARAMOBJECT) {
119 /* printf("free_params %lx: ", (unsigned long int) param);
120 trace1(param);
121 printf("\n"); */
122 if (HAS_PROPERTY(param) && param->descriptor.property != currentProg->property.literal) {
123 FREE_RECORD(param->descriptor.property, propertyRecord, count.property);
124 } /* if */
125 FREE_OBJECT(param);
126 } /* if */
127 param_elem = param_elem->next;
128 } /* while */
129 free_list(params);
130 logFunction(printf("free_params -->\n"););
131 } /* free_params */
132
133
134
get_object(progType currentProg,entityType entity,listType params,fileNumType file_number,lineNumType line,errInfoType * err_info)135 static objectType get_object (progType currentProg, entityType entity,
136 listType params, fileNumType file_number, lineNumType line,
137 errInfoType *err_info)
138
139 {
140 objectType defined_object;
141 objectType forward_reference;
142 propertyType defined_property;
143
144 /* get_object */
145 logFunction(printf("get_object\n"););
146 if (entity->data.owner != NULL &&
147 entity->data.owner->decl_level == currentProg->stack_current) {
148 defined_object = entity->data.owner->obj;
149 if (CATEGORY_OF_OBJ(defined_object) != FORWARDOBJECT) {
150 err_object(OBJTWICEDECLARED, entity->data.owner->obj);
151 SET_CATEGORY_OF_OBJ(defined_object, DECLAREDOBJECT);
152 } else {
153 SET_CATEGORY_OF_OBJ(defined_object, DECLAREDOBJECT);
154 /* The old parameter names could be checked against the new ones. */
155 free_params(currentProg, defined_object->descriptor.property->params);
156 defined_object->descriptor.property->params = params;
157 defined_object->descriptor.property->file_number = file_number;
158 defined_object->descriptor.property->line = line;
159 /* defined_object->descriptor.property->syNumberInLine = symbol.syNumberInLine; */
160 if (ALLOC_OBJECT(forward_reference)) {
161 forward_reference->type_of = NULL;
162 forward_reference->descriptor.property = NULL;
163 INIT_CATEGORY_OF_OBJ(forward_reference, FWDREFOBJECT);
164 forward_reference->value.objValue = defined_object;
165 replace_list_elem(currentProg->stack_current->local_object_list,
166 defined_object, forward_reference);
167 currentProg->stack_current->object_list_insert_place = append_element_to_list(
168 currentProg->stack_current->object_list_insert_place, defined_object, err_info);
169 if (*err_info != OKAY_NO_ERROR) {
170 replace_list_elem(currentProg->stack_current->local_object_list,
171 forward_reference, defined_object);
172 FREE_OBJECT(forward_reference);
173 } /* if */
174 } else {
175 *err_info = MEMORY_ERROR;
176 } /* if */
177 } /* if */
178 } else {
179 if (ALLOC_OBJECT(defined_object)) {
180 if (ALLOC_RECORD(defined_property, propertyRecord, count.property)) {
181 defined_property->entity = entity;
182 defined_property->params = params;
183 defined_property->file_number = file_number;
184 defined_property->line = line;
185 /* defined_property->syNumberInLine = symbol.syNumberInLine; */
186 defined_object->type_of = NULL;
187 defined_object->descriptor.property = defined_property;
188 INIT_CATEGORY_OF_OBJ(defined_object, DECLAREDOBJECT);
189 defined_object->value.objValue = NULL;
190 push_owner(&entity->data.owner, defined_object, currentProg->stack_current, err_info);
191 if (*err_info == OKAY_NO_ERROR) {
192 currentProg->stack_current->object_list_insert_place = append_element_to_list(
193 currentProg->stack_current->object_list_insert_place, defined_object, err_info);
194 if (*err_info != OKAY_NO_ERROR) {
195 pop_owner(&entity->data.owner);
196 FREE_RECORD(defined_property, propertyRecord, count.property);
197 FREE_OBJECT(defined_object);
198 defined_object = NULL;
199 } /* if */
200 } else {
201 FREE_RECORD(defined_property, propertyRecord, count.property);
202 FREE_OBJECT(defined_object);
203 defined_object = NULL;
204 } /* if */
205 } else {
206 FREE_OBJECT(defined_object);
207 *err_info = MEMORY_ERROR;
208 defined_object = NULL;
209 } /* if */
210 } else {
211 *err_info = MEMORY_ERROR;
212 } /* if */
213 } /* if */
214 logFunction(printf("get_object --> " FMT_U_MEM ", ",
215 (memSizeType) defined_object);
216 trace1(defined_object);
217 printf("\n"););
218 return defined_object;
219 } /* get_object */
220
221
222
create_parameter_list(listType name_list,errInfoType * err_info)223 static listType create_parameter_list (listType name_list, errInfoType *err_info)
224
225 {
226 listType name_elem;
227 objectType param_obj;
228 listType parameter_list;
229 listType *list_insert_place;
230
231 /* create_parameter_list */
232 logFunction(printf("create_parameter_list(");
233 prot_list(name_list);
234 printf(")\n"););
235 name_elem = name_list;
236 parameter_list = NULL;
237 list_insert_place = ¶meter_list;
238 while (name_elem != NULL) {
239 if (CATEGORY_OF_OBJ(name_elem->obj) == FORMPARAMOBJECT) {
240 /* printf("create paramobject ");
241 trace1(name_elem->obj);
242 printf(" %lu\n", (long unsigned) name_elem->obj); */
243 param_obj = name_elem->obj->value.objValue;
244 if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
245 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT) {
246 /* printf("create in or ref param ");
247 trace1(param_obj);
248 printf(" %lu\n", (long unsigned) param_obj); */
249 list_insert_place = append_element_to_list(list_insert_place,
250 param_obj, err_info);
251 } else if (CATEGORY_OF_OBJ(param_obj) == TYPEOBJECT) {
252 /* printf("create attr param ");
253 trace1(param_obj);
254 printf(" %lu\n", (long unsigned) param_obj); */
255 list_insert_place = append_element_to_list(list_insert_place,
256 param_obj, err_info);
257 } else {
258 /* printf("create symbol param ");
259 trace1(param_obj);
260 printf("\n"); */
261 list_insert_place = append_element_to_list(list_insert_place,
262 param_obj, err_info);
263 } /* if */
264 } else {
265 /* printf("create symbol param ");
266 trace1(name_elem->obj);
267 printf(" %lu\n", (long unsigned) name_elem->obj); */
268 list_insert_place = append_element_to_list(list_insert_place,
269 name_elem->obj, err_info);
270 } /* if */
271 name_elem = name_elem->next;
272 } /* while */
273 logFunction(printf("create_parameter_list\n"););
274 return parameter_list;
275 } /* create_parameter_list */
276
277
278
free_name_list(listType name_list,boolType freeParamObject)279 static void free_name_list (listType name_list, boolType freeParamObject)
280
281 {
282 listType name_elem;
283 objectType param_obj;
284
285 /* free_name_list */
286 logFunction(printf("free_name_list\n"););
287 name_elem = name_list;
288 while (name_elem != NULL) {
289 if (CATEGORY_OF_OBJ(name_elem->obj) == FORMPARAMOBJECT) {
290 /* printf("free_name_list: ");
291 trace1(name_elem->obj);
292 printf("\n"); */
293 param_obj = name_elem->obj->value.objValue;
294 if (freeParamObject) {
295 if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
296 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT) {
297 /* printf("formparam: ");
298 trace1(name_elem->obj);
299 printf("\n"); */
300 /* printf("free param_obj %lx %d: ", (unsigned long int) param_obj, HAS_PROPERTY(param_obj));
301 trace1(param_obj);
302 printf("\n");
303 fflush(stdout); */
304 /* if (HAS_ENTITY(param_obj)) {
305 printf("name: \"%s\"\n", GET_ENTITY(param_obj)->ident == NULL ? "*NULL_IDENT*" : (char *) GET_ENTITY(param_obj)->ident->name);
306 printf("owner: " FMT_U_MEM "\n", (memSizeType) GET_ENTITY(param_obj)->data.owner);
307 } else {
308 printf("no entity: " FMT_U_MEM "\n", (memSizeType) param_obj);
309 } * if */
310 #if 0
311 if (HAS_PROPERTY(param_obj) && param_obj->descriptor.property != prog->property.literal) {
312 /* free_params(prog, param_obj->descriptor.property->params); */
313 FREE_RECORD(param_obj->descriptor.property, propertyRecord, count.property);
314 } /* if */
315 FREE_OBJECT(param_obj);
316 #endif
317 } /* if */
318 } /* if */
319 FREE_OBJECT(name_elem->obj);
320 } /* if */
321 name_elem = name_elem->next;
322 } /* while */
323 free_list(name_list);
324 logFunction(printf("free_name_list -->\n"););
325 } /* free_name_list */
326
327
328
push_name(progType currentProg,nodeType declaration_base,listType name_list,fileNumType file_number,lineNumType line,errInfoType * err_info)329 static objectType push_name (progType currentProg, nodeType declaration_base,
330 listType name_list, fileNumType file_number, lineNumType line,
331 errInfoType *err_info)
332
333 {
334 entityType entity;
335 listType params;
336 objectType defined_object;
337
338 /* push_name */
339 logFunction(printf("push_name(" FMT_U_MEM ", ",
340 (memSizeType) declaration_base);
341 prot_list(name_list);
342 printf(")\n"););
343 params = create_parameter_list(name_list, err_info);
344 if (*err_info != OKAY_NO_ERROR) {
345 free_list(params);
346 defined_object = NULL;
347 } else {
348 entity = get_entity(declaration_base, name_list);
349 if (entity == NULL) {
350 *err_info = MEMORY_ERROR;
351 defined_object = NULL;
352 } else {
353 defined_object = get_object(currentProg, entity, params,
354 file_number, line, err_info);
355 if (*err_info != OKAY_NO_ERROR) {
356 if (entity->fparam_list == name_list) {
357 /* A new entity has been created by get_entity. */
358 pop_entity(declaration_base, entity);
359 FREE_RECORD(entity, entityRecord, count.entity);
360 } /* if */
361 } else if (entity->fparam_list != name_list) {
362 /* An existing entity is used */
363 free_name_list(name_list, FALSE);
364 } /* if */
365 } /* if */
366 } /* if */
367 /* prot_list(GET_ENTITY(defined_object)->params); */
368 logFunction(printf("push_name --> " FMT_U_MEM "\n",
369 (memSizeType) defined_object););
370 return defined_object;
371 } /* push_name */
372
373
374
pop_object(progType currentProg,const_objectType obj_to_pop)375 static void pop_object (progType currentProg, const_objectType obj_to_pop)
376
377 {
378 entityType entity;
379 ownerType owner;
380
381 /* pop_object */
382 logFunction(printf("pop_object(");
383 trace1(obj_to_pop);
384 printf(")\n");
385 fflush(stdout););
386 if (HAS_ENTITY(obj_to_pop)) {
387 entity = GET_ENTITY(obj_to_pop);
388 owner = entity->data.owner;
389 if (owner != NULL) {
390 entity->data.owner = owner->next;
391 FREE_RECORD(owner, ownerRecord, count.owner);
392 if (entity->data.owner == NULL && entity->fparam_list != NULL) {
393 pop_entity(currentProg->declaration_root, entity);
394 entity->data.next = currentProg->entity.inactive_list;
395 currentProg->entity.inactive_list = entity;
396 } /* if */
397 } /* if */
398 } /* if */
399 logFunction(printf("pop_object -->\n"););
400 } /* pop_object */
401
402
403
disconnect_entity(const objectType anObject)404 static void disconnect_entity (const objectType anObject)
405
406 {
407 entityType entity;
408 stackType decl_lev;
409 listType *lstptr;
410 listType lst;
411 listType old_elem;
412
413 /* disconnect_entity */
414 logFunction(printf("disconnect_entity\n"););
415 entity = GET_ENTITY(anObject);
416 if (entity->data.owner != NULL && entity->data.owner->obj == anObject) {
417 /* printf("disconnect_entity ");
418 trace1(anObject);
419 printf("\n"); */
420 decl_lev = entity->data.owner->decl_level;
421 lstptr = &decl_lev->local_object_list;
422 lst = decl_lev->local_object_list;
423 while (lst != NULL) {
424 if (lst->obj == anObject) {
425 if (decl_lev->object_list_insert_place == &lst->next) {
426 decl_lev->object_list_insert_place = lstptr;
427 } /* if */
428 old_elem = lst;
429 *lstptr = lst->next;
430 lst = lst->next;
431 FREE_L_ELEM(old_elem);
432 } else {
433 lstptr = &lst->next;
434 lst = lst->next;
435 } /* if */
436 } /* while */
437 pop_object(prog, anObject);
438 FREE_RECORD(anObject->descriptor.property, propertyRecord, count.property);
439 anObject->descriptor.property = NULL;
440 } /* if */
441 logFunction(printf("disconnect_entity -->\n"););
442 } /* disconnect_entity */
443
444
445
disconnect_param_entities(const const_objectType objWithParams)446 void disconnect_param_entities (const const_objectType objWithParams)
447
448 {
449 listType param_elem;
450 objectType param_obj;
451
452 /* disconnect_param_entities */
453 logFunction(printf("disconnect_param_entities(");
454 trace1(objWithParams);
455 printf(")\n"););
456 if (FALSE && HAS_PROPERTY(objWithParams)) {
457 param_elem = objWithParams->descriptor.property->params;
458 while (param_elem != NULL) {
459 param_obj = param_elem->obj;
460 if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
461 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT) {
462 if (HAS_ENTITY(param_obj)) {
463 disconnect_entity(param_obj);
464 } /* if */
465 } /* if */
466 param_elem = param_elem->next;
467 } /* while */
468 } /* if */
469 logFunction(printf("disconnect_param_entities -->\n"););
470 } /* disconnect_param_entities */
471
472
473
init_stack(progType currentProg,errInfoType * err_info)474 void init_stack (progType currentProg, errInfoType *err_info)
475
476 {
477 stackType created_stack_element;
478
479 /* init_stack */
480 logFunction(printf("init_stack\n"););
481 if (ALLOC_RECORD(created_stack_element, stackRecord, count.stack)) {
482 created_stack_element->upward = NULL;
483 created_stack_element->downward = NULL;
484 created_stack_element->local_object_list = NULL;
485 created_stack_element->object_list_insert_place =
486 &created_stack_element->local_object_list;
487 currentProg->stack_global = created_stack_element;
488 currentProg->stack_data = created_stack_element;
489 currentProg->stack_current = created_stack_element;
490 data_depth = 1;
491 depth = 1;
492 } else {
493 *err_info = MEMORY_ERROR;
494 } /* if */
495 logFunction(printf("init_stack -->\n"););
496 } /* init_stack */
497
498
499
close_current_stack(progType currentProg)500 static void close_current_stack (progType currentProg)
501
502 {
503 listType reversed_list = NULL;
504 listType next_elem;
505 listType list_element;
506
507 /* close_current_stack */
508 logFunction(printf("close_current_stack %d\n", data_depth););
509 /* The list of objects is reversed to free the objects in */
510 /* the opposite way of their definition. */
511 list_element = currentProg->stack_data->local_object_list;
512 if (list_element != NULL) {
513 reversed_list = list_element;
514 list_element = list_element->next;
515 reversed_list->next = NULL;
516 while (list_element != NULL) {
517 next_elem = list_element->next;
518 list_element->next = reversed_list;
519 reversed_list = list_element;
520 list_element = next_elem;
521 } /* while */
522 } /* if */
523 list_element = reversed_list;
524 while (list_element != NULL) {
525 if (CATEGORY_OF_OBJ(list_element->obj) != BLOCKOBJECT) {
526 /* printf("%lx ", (unsigned long int) list_element->obj);
527 trace1(list_element->obj);
528 printf("\n"); */
529 dump_temp_value(list_element->obj);
530 /* memset(&list_element->obj->value, 0, sizeof(valueUnion)); */
531 pop_object(currentProg, list_element->obj);
532 } /* if */
533 list_element = list_element->next;
534 } /* while */
535 list_element = reversed_list;
536 while (list_element != NULL) {
537 if (CATEGORY_OF_OBJ(list_element->obj) == BLOCKOBJECT) {
538 /* printf("%lx ", (unsigned long int) list_element->obj);
539 trace1(list_element->obj);
540 printf("\n"); */
541 dump_temp_value(list_element->obj);
542 /* memset(&list_element->obj->value, 0, sizeof(valueUnion)); */
543 pop_object(currentProg, list_element->obj);
544 } /* if */
545 list_element = list_element->next;
546 } /* while */
547 list_element = reversed_list;
548 /* Freeing objects in an extra loop avoids accessing freed */
549 /* object data. In case of forward declared objects the */
550 /* category of a freed object would be accessed. */
551 while (list_element != NULL) {
552 if (HAS_PROPERTY(list_element->obj) &&
553 list_element->obj->descriptor.property != currentProg->property.literal) {
554 /* Properties are removed here because itf_destr uses */
555 /* !HAS_PROPERTY to determine if an object can be freed. */
556 free_params(currentProg, list_element->obj->descriptor.property->params);
557 FREE_RECORD(list_element->obj->descriptor.property, propertyRecord, count.property);
558 /* list_element->obj->descriptor.property = NULL; */
559 } /* if */
560 FREE_OBJECT(list_element->obj);
561 list_element = list_element->next;
562 } /* while */
563 free_list(reversed_list);
564 currentProg->stack_current->local_object_list = NULL;
565 logFunction(printf("close_current_stack %d -->\n", data_depth););
566 } /* close_current_stack */
567
568
569
close_stack(progType currentProg)570 void close_stack (progType currentProg)
571
572 { /* close_stack */
573 logFunction(printf("close_stack %d\n", data_depth););
574 /*
575 printf("stack_global: " FMT_U_MEM "\n", (memSizeType) currentProg->stack_global);
576 printf("stack_data: " FMT_U_MEM "\n", (memSizeType) currentProg->stack_data);
577 printf("stack_current: " FMT_U_MEM "\n", (memSizeType) currentProg->stack_current);
578 printf("stack_upward: " FMT_U_MEM "\n", (memSizeType) currentProg->stack_current->upward);
579 printf("stack_downward: " FMT_U_MEM "\n", (memSizeType) currentProg->stack_current->downward);
580 */
581 if (currentProg->stack_current != NULL) {
582 close_current_stack(currentProg);
583 } /* if */
584 } /* close_stack */
585
586
587
grow_stack(errInfoType * err_info)588 void grow_stack (errInfoType *err_info)
589
590 {
591 stackType created_stack_element;
592
593 /* grow_stack */
594 logFunction(printf("grow_stack %d\n", data_depth););
595 if (ALLOC_RECORD(created_stack_element, stackRecord, count.stack)) {
596 /* printf("%lx grow_stack %d\n", created_stack_element, data_depth + 1); */
597 created_stack_element->upward = NULL;
598 created_stack_element->downward = prog->stack_data;
599 created_stack_element->local_object_list = NULL;
600 created_stack_element->object_list_insert_place =
601 &created_stack_element->local_object_list;
602 prog->stack_data->upward = created_stack_element;
603 prog->stack_data = created_stack_element;
604 data_depth++;
605 } else {
606 *err_info = MEMORY_ERROR;
607 } /* if */
608 logFunction(printf("grow_stack %d -->\n", data_depth););
609 } /* grow_stack */
610
611
612
shrink_stack(void)613 void shrink_stack (void)
614
615 {
616 listType list_element;
617 stackType old_stack_element;
618
619 /* shrink_stack */
620 logFunction(printf("shrink_stack %d\n", data_depth););
621 /* printf("%lx shrink_stack %d\n", prog->stack_data, data_depth); */
622 list_element = prog->stack_data->local_object_list;
623 while (list_element != NULL) {
624 pop_object(prog, list_element->obj);
625 list_element = list_element->next;
626 } /* while */
627 free_list(prog->stack_data->local_object_list);
628 old_stack_element = prog->stack_data;
629 prog->stack_data = prog->stack_data->downward;
630 prog->stack_data->upward = NULL;
631 FREE_RECORD(old_stack_element, stackRecord, count.stack);
632 data_depth--;
633 logFunction(printf("shrink_stack %d\n", data_depth););
634 } /* shrink_stack */
635
636
637
push_stack(void)638 void push_stack (void)
639
640 { /* push_stack */
641 logFunction(printf("push_stack %d\n", depth););
642 if (prog->stack_current->upward != NULL) {
643 /* printf("%lx push_stack %d\n", prog->stack_current->upward, depth + 1); */
644 prog->stack_current = prog->stack_current->upward;
645 depth++;
646 } else {
647 /* printf("cannot go up\n"); */
648 } /* if */
649 logFunction(printf("push_stack %d -->\n", depth););
650 } /* push_stack */
651
652
653
pop_stack(void)654 void pop_stack (void)
655
656 {
657 listType list_element;
658
659 /* pop_stack */
660 logFunction(printf("pop_stack %d\n", depth););
661 if (prog->stack_current->downward != NULL) {
662 /* printf("%lx pop_stack %d\n", prog->stack_current, depth); */
663 list_element = prog->stack_current->local_object_list;
664 while (list_element != NULL) {
665 pop_object(prog, list_element->obj);
666 list_element = list_element->next;
667 } /* while */
668 free_list(prog->stack_current->local_object_list);
669 prog->stack_current->local_object_list = NULL;
670 prog->stack_current->object_list_insert_place =
671 &prog->stack_current->local_object_list;
672 prog->stack_current = prog->stack_current->downward;
673 depth--;
674 } else {
675 /* printf("cannot go down\n"); */
676 } /* if */
677 logFunction(printf("pop_stack %d -->\n", depth););
678 } /* pop_stack */
679
680
681
down_stack(void)682 static void down_stack (void)
683
684 { /* down_stack */
685 logFunction(printf("down_stack %d\n", depth););
686 if (prog->stack_current->downward != NULL) {
687 /* printf("%lx down_stack %d\n", prog->stack_current, depth); */
688 prog->stack_current = prog->stack_current->downward;
689 depth--;
690 } else {
691 printf("cannot go down");
692 } /* if */
693 logFunction(printf("down_stack %d -->\n", depth););
694 } /* down_stack */
695
696
697
get_local_object_insert_place(void)698 listType *get_local_object_insert_place (void)
699
700 { /* get_local_object_insert_place */
701 return prog->stack_current->object_list_insert_place;
702 } /* get_local_object_insert_place */
703
704
705
match_name_list(listType raw_name_list)706 static void match_name_list (listType raw_name_list)
707
708 {
709 listType name_elem;
710
711 /* match_name_list */
712 logFunction(printf("match_name_list\n"););
713 name_elem = raw_name_list;
714 while (name_elem != NULL) {
715 if (CATEGORY_OF_OBJ(name_elem->obj) == EXPROBJECT) {
716 if (match_expression(name_elem->obj) == NULL) {
717 err_match(NO_MATCH, name_elem->obj);
718 } /* if */
719 } /* if */
720 name_elem = name_elem->next;
721 } /* while */
722 logFunction(printf("match_name_list -->\n"););
723 } /* match_name_list */
724
725
726
eval_name_list(listType raw_name_list,errInfoType * err_info)727 static listType eval_name_list (listType raw_name_list, errInfoType *err_info)
728
729 {
730 listType name_elem;
731 listType name_list;
732 listType *list_insert_place;
733 objectType parameter;
734
735 /* eval_name_list */
736 logFunction(printf("eval_name_list\n"););
737 name_elem = raw_name_list;
738 name_list = NULL;
739 list_insert_place = &name_list;
740 while (name_elem != NULL) {
741 if (CATEGORY_OF_OBJ(name_elem->obj) == MATCHOBJECT) {
742 parameter = do_exec_call(name_elem->obj, err_info);
743 if (*err_info != OKAY_NO_ERROR) {
744 err_object(PARAM_DECL_FAILED, name_elem->obj);
745 } else if (CATEGORY_OF_OBJ(parameter) != FORMPARAMOBJECT) {
746 err_object(PARAM_DECL_FAILED, name_elem->obj);
747 *err_info = CREATE_ERROR;
748 } else {
749 list_insert_place = append_element_to_list(list_insert_place,
750 parameter, err_info);
751 } /* if */
752 } else {
753 if (HAS_ENTITY(name_elem->obj) &&
754 GET_ENTITY(name_elem->obj)->syobject != NULL) {
755 parameter = GET_ENTITY(name_elem->obj)->syobject;
756 } else {
757 parameter = name_elem->obj;
758 } /* if */
759 list_insert_place = append_element_to_list(list_insert_place,
760 parameter, err_info);
761 } /* if */
762 name_elem = name_elem->next;
763 } /* while */
764 if (*err_info != OKAY_NO_ERROR) {
765 free_name_list(name_list, FALSE);
766 name_list = NULL;
767 } /* if */
768 logFunction(printf("eval_name_list -->\n"););
769 return name_list;
770 } /* eval_name_list */
771
772
773
inst_list(nodeType declaration_base,const_objectType object_name,errInfoType * err_info)774 static objectType inst_list (nodeType declaration_base, const_objectType object_name,
775 errInfoType *err_info)
776
777 {
778 listType name_list;
779 objectType defined_object;
780
781 /* inst_list */
782 logFunction(printf("inst_list(" FMT_U_MEM ", ",
783 (memSizeType) declaration_base);
784 trace1(object_name);
785 printf(")\n"););
786 match_name_list(object_name->value.listValue);
787 push_stack();
788 name_list = eval_name_list(object_name->value.listValue, err_info);
789 down_stack();
790 if (*err_info == OKAY_NO_ERROR) {
791 defined_object = push_name(prog, declaration_base, name_list,
792 GET_FILE_NUM(object_name), GET_LINE_NUM(object_name), err_info);
793 } else {
794 defined_object = NULL;
795 } /* if */
796 logFunction(printf("inst_list --> ");
797 trace1(defined_object);
798 printf("\n"););
799 return defined_object;
800 } /* inst_list */
801
802
803
inst_object(const_nodeType declaration_base,objectType name_object,fileNumType file_number,lineNumType line,errInfoType * err_info)804 static objectType inst_object (const_nodeType declaration_base, objectType name_object,
805 fileNumType file_number, lineNumType line, errInfoType *err_info)
806
807 {
808 objectType defined_object;
809
810 /* inst_object */
811 logFunction(printf("inst_object(");
812 trace1(name_object);
813 printf(")\n"););
814 if (name_object->descriptor.property == prog->property.literal) {
815 err_object(IDENT_EXPECTED, name_object);
816 } /* if */
817 defined_object = get_object(prog, GET_ENTITY(name_object), NULL,
818 file_number, line, err_info);
819 logFunction(printf("inst_object --> ");
820 trace1(defined_object);
821 printf("\n"););
822 return defined_object;
823 } /* inst_object */
824
825
826
inst_object_expr(const_nodeType declaration_base,objectType object_name,errInfoType * err_info)827 static objectType inst_object_expr (const_nodeType declaration_base,
828 objectType object_name, errInfoType *err_info)
829
830 {
831 listType name_list;
832 objectType param_obj;
833 objectType defined_object = NULL;
834
835 /* inst_object_expr */
836 logFunction(printf("inst_object_expr(" FMT_U_MEM ", ",
837 (memSizeType) declaration_base);
838 trace1(object_name);
839 printf(")\n"););
840 match_name_list(object_name->value.listValue);
841 push_stack();
842 name_list = eval_name_list(object_name->value.listValue, err_info);
843 down_stack();
844 if (*err_info == OKAY_NO_ERROR) {
845 /* printf("name_list ");
846 prot_list(name_list);
847 printf("\n");
848 fflush(stdout);
849 printf("name_list->obj ");
850 trace1(name_list->obj);
851 printf("\n");
852 fflush(stdout); */
853 if (CATEGORY_OF_OBJ(name_list->obj) == FORMPARAMOBJECT) {
854 param_obj = name_list->obj->value.objValue;
855 if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
856 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT ||
857 CATEGORY_OF_OBJ(param_obj) == TYPEOBJECT) {
858 err_object(IDENT_EXPECTED, object_name);
859 } else {
860 /* printf("param_obj ");
861 trace1(param_obj);
862 printf("\n"); */
863 defined_object = inst_object(declaration_base, param_obj, 0, 0, err_info);
864 } /* if */
865 } else {
866 err_object(IDENT_EXPECTED, object_name);
867 } /* if */
868 free_name_list(name_list, FALSE);
869 } /* if */
870 logFunction(printf("inst_object_expr --> ");
871 trace1(defined_object);
872 printf("\n"););
873 return defined_object;
874 } /* inst_object_expr */
875
876
877
entername(nodeType declaration_base,objectType object_name,errInfoType * err_info)878 objectType entername (nodeType declaration_base, objectType object_name,
879 errInfoType *err_info)
880
881 {
882 objectType defined_object;
883
884 /* entername */
885 logFunction(printf("entername(" FMT_U_MEM ", ",
886 (memSizeType) declaration_base);
887 trace1(object_name);
888 printf(")\n"););
889 if (CATEGORY_OF_OBJ(object_name) == EXPROBJECT) {
890 if (object_name->value.listValue->next != NULL) {
891 defined_object = inst_list(declaration_base, object_name, err_info);
892 } else if (CATEGORY_OF_OBJ(object_name->value.listValue->obj) == EXPROBJECT ||
893 CATEGORY_OF_OBJ(object_name->value.listValue->obj) == MATCHOBJECT) {
894 defined_object = inst_object_expr(declaration_base, object_name, err_info);
895 } else {
896 /* printf("listValue->obj ");
897 trace1(object_name->value.listValue->obj);
898 printf(")\n"); */
899 defined_object = inst_object(declaration_base,
900 object_name->value.listValue->obj,
901 GET_FILE_NUM(object_name), GET_LINE_NUM(object_name), err_info);
902 } /* if */
903 } else {
904 defined_object = inst_object(declaration_base, object_name, 0, 0, err_info);
905 /* printf(" %s\n", defined_object->IDENT->NAME);
906 printf("o%d_%s declared \n", defined_object->NUMBER,
907 defined_object->IDENT->NAME); */
908 } /* if */
909 /* trace_nodes(); */
910 logFunction(printf("entername(");
911 trace1(object_name);
912 printf(") --> ");
913 trace1(defined_object);
914 printf("\n"););
915 return defined_object;
916 } /* entername */
917
918
919
find_name(nodeType declaration_base,const_objectType object_name,errInfoType * err_info)920 objectType find_name (nodeType declaration_base, const_objectType object_name,
921 errInfoType *err_info)
922
923 {
924 listType name_list;
925 objectType param_obj;
926 entityType entity;
927 objectType defined_object;
928
929 /* find_name */
930 logFunction(printf("find_name(" FMT_U_MEM ", ",
931 (memSizeType) declaration_base);
932 trace1(object_name);
933 printf(")\n"););
934 if (CATEGORY_OF_OBJ(object_name) == EXPROBJECT) {
935 grow_stack(err_info);
936 if (*err_info == OKAY_NO_ERROR) {
937 if (object_name->value.listValue->next != NULL) {
938 match_name_list(object_name->value.listValue);
939 push_stack();
940 name_list = eval_name_list(object_name->value.listValue, err_info);
941 down_stack();
942 if (*err_info == OKAY_NO_ERROR) {
943 entity = find_entity(declaration_base, name_list);
944 } else {
945 entity = NULL;
946 } /* if */
947 shrink_stack();
948 free_name_list(name_list, entity == NULL);
949 } else if (CATEGORY_OF_OBJ(object_name->value.listValue->obj) == EXPROBJECT ||
950 CATEGORY_OF_OBJ(object_name->value.listValue->obj) == MATCHOBJECT) {
951 match_name_list(object_name->value.listValue);
952 push_stack();
953 name_list = eval_name_list(object_name->value.listValue, err_info);
954 down_stack();
955 if (*err_info == OKAY_NO_ERROR) {
956 if (CATEGORY_OF_OBJ(name_list->obj) == FORMPARAMOBJECT) {
957 param_obj = name_list->obj->value.objValue;
958 if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
959 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT ||
960 CATEGORY_OF_OBJ(param_obj) == TYPEOBJECT) {
961 entity = NULL;
962 } else {
963 entity = GET_ENTITY(param_obj);
964 } /* if */
965 } else {
966 entity = NULL;
967 } /* if */
968 } else {
969 entity = NULL;
970 } /* if */
971 shrink_stack();
972 free_name_list(name_list, entity == NULL);
973 } else {
974 entity = GET_ENTITY(object_name->value.listValue->obj);
975 shrink_stack();
976 } /* if */
977 } else {
978 entity = NULL;
979 } /* if */
980 } else {
981 entity = GET_ENTITY(object_name);
982 } /* if */
983 if (entity != NULL && entity->data.owner != NULL) {
984 defined_object = entity->data.owner->obj;
985 } else {
986 defined_object = NULL;
987 } /* if */
988 /* printf(" %s\n", defined_object->IDENT->NAME);
989 printf("o%d_%s declared \n", defined_object->NUMBER,
990 defined_object->IDENT->NAME); */
991 /* trace_nodes(); */
992 logFunction(printf("find_name(");
993 trace1(object_name);
994 printf(") --> ");
995 trace1(defined_object);
996 printf("\n"););
997 return defined_object;
998 } /* find_name */
999
1000
1001
search_name(const_nodeType declaration_base,const_objectType object_name,errInfoType * err_info)1002 objectType search_name (const_nodeType declaration_base,
1003 const_objectType object_name, errInfoType *err_info)
1004
1005 {
1006 listType name_list;
1007 objectType param_obj;
1008 entityType entity;
1009 objectType defined_object;
1010
1011 /* search_name */
1012 logFunction(printf("search_name(" FMT_U_MEM ", ",
1013 (memSizeType) declaration_base);
1014 trace1(object_name);
1015 printf(")\n"););
1016 if (CATEGORY_OF_OBJ(object_name) == EXPROBJECT) {
1017 grow_stack(err_info);
1018 if (*err_info == OKAY_NO_ERROR) {
1019 if (object_name->value.listValue->next != NULL) {
1020 match_name_list(object_name->value.listValue);
1021 push_stack();
1022 name_list = eval_name_list(object_name->value.listValue, err_info);
1023 down_stack();
1024 if (*err_info == OKAY_NO_ERROR) {
1025 entity = search_entity(declaration_base, name_list);
1026 } else {
1027 entity = NULL;
1028 } /* if */
1029 shrink_stack();
1030 free_name_list(name_list, entity == NULL);
1031 } else if (CATEGORY_OF_OBJ(object_name->value.listValue->obj) == EXPROBJECT ||
1032 CATEGORY_OF_OBJ(object_name->value.listValue->obj) == MATCHOBJECT) {
1033 match_name_list(object_name->value.listValue);
1034 push_stack();
1035 name_list = eval_name_list(object_name->value.listValue, err_info);
1036 down_stack();
1037 if (*err_info == OKAY_NO_ERROR) {
1038 if (CATEGORY_OF_OBJ(name_list->obj) == FORMPARAMOBJECT) {
1039 param_obj = name_list->obj->value.objValue;
1040 if (CATEGORY_OF_OBJ(param_obj) == VALUEPARAMOBJECT ||
1041 CATEGORY_OF_OBJ(param_obj) == REFPARAMOBJECT ||
1042 CATEGORY_OF_OBJ(param_obj) == TYPEOBJECT) {
1043 entity = NULL;
1044 } else {
1045 entity = GET_ENTITY(param_obj);
1046 } /* if */
1047 } else {
1048 entity = NULL;
1049 } /* if */
1050 } else {
1051 entity = NULL;
1052 } /* if */
1053 shrink_stack();
1054 free_name_list(name_list, entity == NULL);
1055 } else {
1056 entity = GET_ENTITY(object_name->value.listValue->obj);
1057 shrink_stack();
1058 } /* if */
1059 } else {
1060 entity = NULL;
1061 } /* if */
1062 } else {
1063 entity = GET_ENTITY(object_name);
1064 } /* if */
1065 if (entity != NULL && entity->data.owner != NULL) {
1066 defined_object = entity->data.owner->obj;
1067 } else {
1068 defined_object = NULL;
1069 } /* if */
1070 /* printf(" %s\n", defined_object->IDENT->NAME);
1071 printf("o%d_%s declared \n", defined_object->NUMBER,
1072 defined_object->IDENT->NAME); */
1073 /* trace_nodes(); */
1074 logFunction(printf("search_name(");
1075 trace1(object_name);
1076 printf(") --> ");
1077 trace1(defined_object);
1078 printf("\n"););
1079 return defined_object;
1080 } /* search_name */
1081
1082
1083
dollar_parameter(objectType param_object,errInfoType * err_info)1084 static objectType dollar_parameter (objectType param_object,
1085 errInfoType *err_info)
1086
1087 {
1088 listType param_descr;
1089 objectType type_of_parameter;
1090
1091 /* dollar_parameter */
1092 logFunction(printf("dollar_parameter(");
1093 trace1(param_object);
1094 printf(")\n"););
1095 param_descr = param_object->value.listValue;
1096 if (param_descr != NULL) {
1097 if (GET_ENTITY(param_descr->obj)->ident == prog->id_for.ref) {
1098 /* printf("### ref param\n"); */
1099 if (param_descr->next != NULL) {
1100 type_of_parameter = param_descr->next->obj;
1101 if (CATEGORY_OF_OBJ(type_of_parameter) == EXPROBJECT) {
1102 type_of_parameter = eval_expression(type_of_parameter);
1103 if (type_of_parameter != NULL) {
1104 param_descr->next->obj = type_of_parameter;
1105 } /* if */
1106 } /* if */
1107 if (param_descr->next->next != NULL && type_of_parameter != NULL) {
1108 FREE_OBJECT(param_object);
1109 if (GET_ENTITY(param_descr->next->next->obj)->ident == prog->id_for.colon) {
1110 param_object = dcl_ref2(param_descr);
1111 } else {
1112 param_object = dcl_ref1(param_descr);
1113 } /* if */
1114 if (param_object == NULL) {
1115 *err_info = MEMORY_ERROR;
1116 } /* if */
1117 free_list(param_descr);
1118 } /* if */
1119 } /* if */
1120 } else {
1121 err_ident(PARAM_SPECIFIER_EXPECTED, GET_ENTITY(param_descr->obj)->ident);
1122 } /* if */
1123 } /* if */
1124 logFunction(printf("dollar_parameter --> ");
1125 trace1(param_object);
1126 printf("\n"););
1127 return param_object;
1128 } /* dollar_parameter */
1129
1130
1131
dollar_inst_list(nodeType declaration_base,const_objectType object_name,errInfoType * err_info)1132 static objectType dollar_inst_list (nodeType declaration_base,
1133 const_objectType object_name, errInfoType *err_info)
1134
1135 {
1136 listType name_elem;
1137 objectType defined_object;
1138
1139 /* dollar_inst_list */
1140 logFunction(printf("dollar_inst_list(" FMT_U_MEM ", ",
1141 (memSizeType) declaration_base);
1142 trace1(object_name);
1143 printf(")\n"););
1144 name_elem = object_name->value.listValue;
1145 while (name_elem != NULL) {
1146 if (CATEGORY_OF_OBJ(name_elem->obj) == EXPROBJECT) {
1147 name_elem->obj = dollar_parameter(name_elem->obj, err_info);
1148 } /* if */
1149 name_elem = name_elem->next;
1150 } /* while */
1151 if (*err_info == OKAY_NO_ERROR) {
1152 defined_object = push_name(prog, declaration_base,
1153 object_name->value.listValue,
1154 GET_FILE_NUM(object_name), GET_LINE_NUM(object_name), err_info);
1155 } else {
1156 defined_object = NULL;
1157 } /* if */
1158 logFunction(printf("dollar_inst_list -->\n"););
1159 return defined_object;
1160 } /* dollar_inst_list */
1161
1162
1163
dollar_entername(nodeType declaration_base,objectType object_name,errInfoType * err_info)1164 objectType dollar_entername (nodeType declaration_base, objectType object_name,
1165 errInfoType *err_info)
1166
1167 {
1168 objectType defined_object;
1169
1170 /* dollar_entername */
1171 logFunction(printf("dollar_entername(" FMT_U_MEM ", ",
1172 (memSizeType) declaration_base);
1173 trace1(object_name);
1174 printf(")\n"););
1175 if (CATEGORY_OF_OBJ(object_name) == EXPROBJECT) {
1176 defined_object = dollar_inst_list(declaration_base, object_name, err_info);
1177 } else {
1178 defined_object = inst_object(declaration_base, object_name, 0, 0, err_info);
1179 /* printf(" %s\n", defined_object->IDENT->NAME);
1180 printf("o%d_%s declared \n", defined_object->NUMBER,
1181 defined_object->IDENT->NAME); */
1182 } /* if */
1183 /* trace_nodes(); */
1184 logFunction(printf("dollar_entername(");
1185 trace1(object_name);
1186 printf(") --> ");
1187 trace1(defined_object);
1188 printf("\n"););
1189 return defined_object;
1190 } /* dollar_entername */
1191