1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2000 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/blockutl.c */
23 /* Changes: 1992, 1993, 1994 Thomas Mertes */
24 /* Content: Procedures to maintain objects of type blockType. */
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 "entutl.h"
42 #include "syvarutl.h"
43 #include "executl.h"
44 #include "traceutl.h"
45 #include "objutl.h"
46 #include "match.h"
47
48 #undef EXTERN
49 #define EXTERN
50 #include "blockutl.h"
51
52
53
free_locobj(const_locObjType locobj)54 static void free_locobj (const_locObjType locobj)
55
56 {
57 errInfoType err_info = OKAY_NO_ERROR;
58
59 /* free_locobj */
60 /* prot_heapsize();
61 prot_cstri(" free_locobj ");
62 trace1(locobj->object);
63 prot_nl(); */
64 if (locobj->object != NULL) {
65 if (CATEGORY_OF_OBJ(locobj->object) == VALUEPARAMOBJECT ||
66 CATEGORY_OF_OBJ(locobj->object) == REFPARAMOBJECT ||
67 CATEGORY_OF_OBJ(locobj->object) == RESULTOBJECT ||
68 CATEGORY_OF_OBJ(locobj->object) == LOCALVOBJECT) {
69 if (locobj->init_value != NULL) {
70 if (CATEGORY_OF_OBJ(locobj->object) == RESULTOBJECT) {
71 /* printf("free_locobj: RESULTOBJECT init category %u\n",
72 CATEGORY_OF_OBJ(locobj->init_value)); */
73 free_expression(locobj->init_value);
74 } else {
75 /* prot_heapsize();
76 prot_cstri(" free_locobj value ");
77 prot_int((intType) locobj->init_value);
78 prot_cstri(" ");
79 trace1(locobj->init_value);
80 prot_nl(); */
81 destroy_local_init_value(locobj, &err_info);
82 FREE_OBJECT(locobj->init_value);
83 /* dump_any_temp(locobj->init_value); */
84 } /* if */
85 } /* if */
86 /* if (locobj->object->value.objValue != NULL &&
87 CATEGORY_OF_OBJ(locobj->object->value.objValue) != SYMBOLOBJECT) {
88 trace1(locobj->object);
89 prot_nl();
90 } * if */
91 if (CATEGORY_OF_OBJ(locobj->object) != VALUEPARAMOBJECT &&
92 CATEGORY_OF_OBJ(locobj->object) != REFPARAMOBJECT) {
93 /* Parameters are freed by the function free_params (in name.c). */
94 if (HAS_PROPERTY(locobj->object) &&
95 locobj->object->descriptor.property != prog->property.literal) {
96 FREE_RECORD(locobj->object->descriptor.property, propertyRecord, count.property);
97 } /* if */
98 FREE_OBJECT(locobj->object);
99 } /* if */
100 /* } else if (CATEGORY_OF_OBJ(locobj->object) != SYMBOLOBJECT) {
101 printf("####### ");
102 trace1(locobj->object);
103 prot_nl(); */
104 } /* if */
105 } /* if */
106 } /* free_locobj */
107
108
109
free_loclist(locListType loclist)110 static void free_loclist (locListType loclist)
111
112 {
113 locListType old_loclist;
114
115 /* free_loclist */
116 /* prot_heapsize();
117 prot_cstri(" free_loclist");
118 prot_nl(); */
119 while (loclist != NULL) {
120 free_locobj(&loclist->local);
121 old_loclist = loclist;
122 loclist = loclist->next;
123 FREE_RECORD(old_loclist, locListRecord, count.loclist);
124 } /* while */
125 } /* free_loclist */
126
127
128
free_block(blockType block)129 void free_block (blockType block)
130
131 { /* free_block */
132 logFunction(printf("free_block(" FMT_U_MEM ")\n", (memSizeType) block););
133 free_expression(block->body);
134 free_loclist(block->params);
135 free_locobj(&block->result);
136 free_loclist(block->local_vars);
137 dump_list(block->local_consts);
138 FREE_RECORD(block, blockRecord, count.block);
139 } /* free_block */
140
141
142
new_block(locListType block_params,const_locObjType block_result,locListType block_local_vars,listType block_local_consts,objectType block_body)143 blockType new_block (locListType block_params, const_locObjType block_result,
144 locListType block_local_vars, listType block_local_consts,
145 objectType block_body)
146
147 {
148 register blockType created_block;
149
150 /* new_block */
151 logFunction(printf("new_block(" FMT_U_MEM ")\n", (memSizeType) block_params););
152 if (ALLOC_RECORD(created_block, blockRecord, count.block)) {
153 created_block->params = block_params;
154 if (block_result == NULL) {
155 created_block->result.object = NULL;
156 created_block->result.init_value = NULL;
157 created_block->result.create_call_obj = NULL;
158 created_block->result.destroy_call_obj = NULL;
159 } else {
160 created_block->result.object = block_result->object;
161 created_block->result.init_value = block_result->init_value;
162 created_block->result.create_call_obj = block_result->create_call_obj;
163 created_block->result.destroy_call_obj = block_result->destroy_call_obj;
164 } /* if */
165 created_block->local_vars = block_local_vars;
166 created_block->local_consts = block_local_consts;
167 created_block->body = block_body;
168 } /* if */
169 logFunction(printf("new_block --> " FMT_U_MEM "\n", (memSizeType) created_block););
170 return created_block;
171 } /* new_block */
172
173
174
append_to_loclist(locListType ** list_insert_place,objectType object,objectType init_value,objectType create_call_obj,objectType destroy_call_obj,errInfoType * err_info)175 static void append_to_loclist (locListType **list_insert_place, objectType object,
176 objectType init_value, objectType create_call_obj,
177 objectType destroy_call_obj, errInfoType *err_info)
178
179 {
180 register locListType help_element;
181
182 /* append_to_loclist */
183 if (ALLOC_RECORD(help_element, locListRecord, count.loclist)) {
184 help_element->next = NULL;
185 help_element->local.object = object;
186 help_element->local.init_value = init_value;
187 help_element->local.create_call_obj = create_call_obj;
188 help_element->local.destroy_call_obj = destroy_call_obj;
189 **list_insert_place = help_element;
190 *list_insert_place = &help_element->next;
191 } else {
192 *err_info = MEMORY_ERROR;
193 } /* if */
194 } /* append_to_loclist */
195
196
197
get_result_var(locObjType result_var,typeType result_type,objectType result_init,errInfoType * err_info)198 void get_result_var (locObjType result_var, typeType result_type,
199 objectType result_init, errInfoType *err_info)
200
201 { /* get_result_var */
202 logFunction(printf("get_result_var\n"););
203 result_init = copy_expression(result_init, err_info);
204 if (CATEGORY_OF_OBJ(result_init) == MATCHOBJECT) {
205 SET_CATEGORY_OF_OBJ(result_init, CALLOBJECT);
206 } /* if */
207 result_var->object->type_of = result_type;
208 INIT_CATEGORY_OF_VAR(result_var->object, RESULTOBJECT);
209 result_var->object->value.objValue = NULL;
210 result_var->init_value = result_init;
211 result_var->create_call_obj = get_create_call_obj(result_var->object, err_info);
212 result_var->destroy_call_obj = get_destroy_call_obj(result_var->object, err_info);
213 logFunction(printf("get_result_var -->\n"););
214 } /* get_result_var */
215
216
217
get_return_var(locObjType return_var,typeType return_type,errInfoType * err_info)218 void get_return_var (locObjType return_var, typeType return_type,
219 errInfoType *err_info)
220
221 {
222 objectRecord return_object;
223
224 /* get_return_var */
225 logFunction(printf("get_return_var\n"););
226 return_object.type_of = return_type;
227 return_object.descriptor.property = NULL;
228 INIT_CATEGORY_OF_VAR(&return_object, RESULTOBJECT);
229 return_object.value.objValue = NULL;
230 return_var->object = NULL;
231 return_var->init_value = NULL;
232 return_var->create_call_obj = get_create_call_obj(&return_object, err_info);
233 return_var->destroy_call_obj = get_destroy_call_obj(&return_object, err_info);
234 logFunction(printf("get_return_var -->\n"););
235 } /* get_return_var */
236
237
238
get_param_list(const_listType param_object_list,errInfoType * err_info)239 locListType get_param_list (const_listType param_object_list,
240 errInfoType *err_info)
241
242 {
243 locListType *params_insert_place;
244 const_listType param_element;
245 objectType create_call_obj;
246 objectType destroy_call_obj;
247 locListType params;
248
249 /* get_param_list */
250 logFunction(printf("get_param_list\n"););
251 params = NULL;
252 params_insert_place = ¶ms;
253 param_element = param_object_list;
254 while (param_element != NULL) {
255 /* printf("get_param_list: ");
256 trace1(param_element->obj);
257 printf("\n"); */
258 if (CATEGORY_OF_OBJ(param_element->obj) == VALUEPARAMOBJECT) {
259 if (param_element->obj->type_of->create_call_obj != NULL) {
260 create_call_obj = param_element->obj->type_of->create_call_obj;
261 } else {
262 create_call_obj = get_create_call_obj(param_element->obj, err_info);
263 } /* if */
264 if (param_element->obj->type_of->destroy_call_obj != NULL) {
265 destroy_call_obj = param_element->obj->type_of->destroy_call_obj;
266 } else {
267 destroy_call_obj = get_destroy_call_obj(param_element->obj, err_info);
268 } /* if */
269 } else {
270 create_call_obj = NULL;
271 destroy_call_obj = NULL;
272 } /* if */
273 append_to_loclist(¶ms_insert_place,
274 param_element->obj, NULL, create_call_obj, destroy_call_obj, err_info);
275 param_element = param_element->next;
276 } /* while */
277 logFunction(printf("get_param_list -->\n"););
278 return params;
279 } /* get_param_list */
280
281
282
get_local_var_list(const_listType local_object_list,errInfoType * err_info)283 locListType get_local_var_list (const_listType local_object_list,
284 errInfoType *err_info)
285
286 {
287 locListType *local_vars_insert_place;
288 const_listType local_element;
289 objectType local_var;
290 objectType init_value;
291 objectType create_call_obj;
292 objectType destroy_call_obj;
293 locListType local_vars;
294
295 /* get_local_var_list */
296 logFunction(printf("get_local_var_list(" FMT_X_MEM ")\n",
297 (memSizeType) local_object_list););
298 local_vars = NULL;
299 local_vars_insert_place = &local_vars;
300 local_element = local_object_list;
301 while (local_element != NULL) {
302 if (VAR_OBJECT(local_element->obj)) {
303 local_var = local_element->obj;
304 #if OUT_OF_ORDER
305 if (CATEGORY_OF_OBJ(local_var) != LOCALVOBJECT) {
306 if (ALLOC_OBJECT(init_value)) {
307 init_value->type_of = local_var->type_of;
308 init_value->descriptor.property = NULL;
309 init_value->value = local_var->value;
310 init_value->objcategory = local_var->objcategory;
311 SET_CATEGORY_OF_OBJ(local_var, LOCALVOBJECT);
312 local_var->value.objValue = init_value; /* was NULL; changed for s7c.sd7 */
313 } else {
314 *err_info = MEMORY_ERROR;
315 } /* if */
316 } else {
317 /* printf("B "); trace1(local_var); printf("\n"); */
318 } /* if */
319 #endif
320 if (CATEGORY_OF_OBJ(local_var) == LOCALVOBJECT) {
321 /* printf("X "); trace1(local_var); printf("\n"); */
322 init_value = local_var->value.objValue;
323 /* printf("Y "); trace1(init_value); printf("\n"); */
324 create_call_obj = get_create_call_obj(init_value, err_info);
325 destroy_call_obj = get_destroy_call_obj(init_value, err_info);
326 append_to_loclist(&local_vars_insert_place,
327 local_var, init_value, create_call_obj, destroy_call_obj, err_info);
328 } /* if */
329 #if OUT_OF_ORDER
330 } else if (ALLOC_OBJECT(init_value)) {
331 init_value->type_of = local_var->type_of;
332 init_value->descriptor.property = NULL;
333 init_value->value = local_var->value;
334 init_value->objcategory = local_var->objcategory;
335 create_call_obj = get_create_call_obj(local_var, err_info);
336 destroy_call_obj = get_destroy_call_obj(local_var, err_info);
337 SET_CATEGORY_OF_OBJ(local_var, LOCALVOBJECT);
338 local_var->value.objValue = init_value; /* was NULL; changed for s7c.sd7 */
339 append_to_loclist(&local_vars_insert_place,
340 local_var, init_value, create_call_obj, destroy_call_obj, err_info);
341 } else {
342 *err_info = MEMORY_ERROR;
343 } /* if */
344 #endif
345 } /* if */
346 local_element = local_element->next;
347 } /* while */
348 logFunction(printf("get_local_var_list -->\n"););
349 return local_vars;
350 } /* get_local_var_list */
351
352
353
354 listType get_local_const_list (const_listType local_object_list,
355 errInfoType *err_info)
356
357 {
358 listType *list_insert_place;
359 const_listType local_element;
360 listType local_consts;
361
362 /* get_local_const_list */
363 logFunction(printf("get_local_const_list(" FMT_X_MEM ")\n",
364 (memSizeType) local_object_list););
365 local_consts = NULL;
366 list_insert_place = &local_consts;
367 local_element = local_object_list;
368 while (local_element != NULL) {
369 if (!VAR_OBJECT(local_element->obj)) {
370 list_insert_place = append_element_to_list(list_insert_place,
371 local_element->obj, err_info);
372 } /* if */
373 local_element = local_element->next;
374 } /* while */
375 logFunction(printf("get_local_const_list -->\n"););
376 return local_consts;
377 } /* get_local_const_list */
378