1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2000, 2008, 2013 Thomas Mertes */
5 /* 2015 - 2018, 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: General */
23 /* File: seed7/src/listutl.c */
24 /* Changes: 1990 - 1994, 2002, 2008, 2013 Thomas Mertes */
25 /* 2015 - 2018, 2021 Thomas Mertes */
26 /* Content: Procedures to maintain objects of type listType. */
27 /* */
28 /********************************************************************/
29
30 #define LOG_FUNCTIONS 0
31 #define VERBOSE_EXCEPTIONS 0
32
33 #include "version.h"
34
35 #include "stdlib.h"
36 #include "stdio.h"
37
38 #include "common.h"
39 #include "data.h"
40 #include "heaputl.h"
41 #include "flistutl.h"
42
43 #undef EXTERN
44 #define EXTERN
45 #include "listutl.h"
46
47
48
49 #if WITH_LIST_FREELIST
free_list(listType list)50 void free_list (listType list)
51
52 {
53 register listType list_end;
54
55 /* free_list */
56 if (list != NULL) {
57 list_end = list;
58 while (list_end->next != NULL) {
59 list_end = list_end->next;
60 } /* while */
61 list_end->next = flist.list_elems;
62 flist.list_elems = list;
63 } /* if */
64 } /* free_list */
65
66 #else
67
68
69
free_list(listType list)70 void free_list (listType list)
71
72 {
73 register listType list_elem;
74 register listType old_elem;
75
76 /* free_list */
77 list_elem = list;
78 while (list_elem != NULL) {
79 old_elem = list_elem;
80 list_elem = list_elem->next;
81 FREE_L_ELEM(old_elem);
82 } /* while */
83 } /* free_list */
84 #endif
85
86
87
list_length(const_listType list)88 memSizeType list_length (const_listType list)
89
90 {
91 memSizeType length = 0;
92
93 /* list_length */
94 while (list != NULL) {
95 list = list->next;
96 length++;
97 } /* while */
98 return length;
99 } /* list_length */
100
101
102
append_element_to_list(listType * list_insert_place,objectType object,errInfoType * err_info)103 listType *append_element_to_list (listType *list_insert_place, objectType object,
104 errInfoType *err_info)
105
106 {
107 listType help_element;
108
109 /* append_element_to_list */
110 if (unlikely(!ALLOC_L_ELEM(help_element))) {
111 *err_info = MEMORY_ERROR;
112 return list_insert_place;
113 } else {
114 help_element->next = NULL;
115 help_element->obj = object;
116 *list_insert_place = help_element;
117 return &help_element->next;
118 } /* if */
119 } /* append_element_to_list */
120
121
122
copy_expression2(objectType object_from,errInfoType * err_info)123 static objectType copy_expression2 (objectType object_from, errInfoType *err_info)
124
125 {
126 register listType list_from_elem;
127 register listType list_to_elem;
128 register listType new_elem;
129 objectType object_to;
130
131 /* copy_expression2 */
132 if (unlikely(!ALLOC_OBJECT(object_to))) {
133 *err_info = MEMORY_ERROR;
134 } else {
135 object_to->type_of = object_from->type_of;
136 object_to->descriptor.property = object_from->descriptor.property;
137 object_to->value.listValue = NULL;
138 INIT_CATEGORY_OF_OBJ(object_to, CATEGORY_OF_OBJ(object_from));
139 SET_ANY_FLAG(object_to, HAS_POSINFO(object_from));
140 list_from_elem = object_from->value.listValue;
141 if (list_from_elem != NULL) {
142 if (likely(ALLOC_L_ELEM(list_to_elem))) {
143 object_to->value.listValue = list_to_elem;
144 list_to_elem->obj = copy_expression(list_from_elem->obj, err_info);
145 list_from_elem = list_from_elem->next;
146 while (list_from_elem != NULL) {
147 if (likely(ALLOC_L_ELEM(new_elem))) {
148 list_to_elem->next = new_elem;
149 list_to_elem = new_elem;
150 if (CATEGORY_OF_OBJ(list_from_elem->obj) == EXPROBJECT ||
151 CATEGORY_OF_OBJ(list_from_elem->obj) == CALLOBJECT ||
152 CATEGORY_OF_OBJ(list_from_elem->obj) == MATCHOBJECT ||
153 CATEGORY_OF_OBJ(list_from_elem->obj) == LISTOBJECT) {
154 list_to_elem->obj = copy_expression(list_from_elem->obj, err_info);
155 } else {
156 list_to_elem->obj = list_from_elem->obj;
157 } /* if */
158 list_from_elem = list_from_elem->next;
159 } else {
160 *err_info = MEMORY_ERROR;
161 list_from_elem = NULL;
162 } /* if */
163 } /* while */
164 list_to_elem->next = NULL;
165 } else {
166 *err_info = MEMORY_ERROR;
167 } /* if */
168 } /* if */
169 } /* if */
170 return object_to;
171 } /* copy_expression2 */
172
173
174
copy_expression(objectType object_from,errInfoType * err_info)175 objectType copy_expression (objectType object_from, errInfoType *err_info)
176
177 {
178 objectType object_to;
179
180 /* copy_expression */
181 if (CATEGORY_OF_OBJ(object_from) == EXPROBJECT ||
182 CATEGORY_OF_OBJ(object_from) == CALLOBJECT ||
183 CATEGORY_OF_OBJ(object_from) == MATCHOBJECT ||
184 CATEGORY_OF_OBJ(object_from) == LISTOBJECT) {
185 object_to = copy_expression2(object_from, err_info);
186 } else {
187 object_to = object_from;
188 } /* if */
189 return object_to;
190 } /* copy_expression */
191
192
193
free_expression(objectType object)194 void free_expression (objectType object)
195
196 {
197 listType list_elem;
198
199 /* free_expression */
200 logFunction(printf("free_expression\n"););
201 if (object != NULL) {
202 switch (CATEGORY_OF_OBJ(object)) {
203 case CALLOBJECT:
204 case MATCHOBJECT:
205 case EXPROBJECT:
206 case LISTOBJECT:
207 /* printf("free_expression: \n");
208 trace1(object);
209 printf("\n"); */
210 list_elem = object->value.listValue;
211 if (list_elem != NULL) {
212 while (list_elem->next != NULL) {
213 free_expression(list_elem->obj);
214 list_elem = list_elem->next;
215 } /* while */
216 free_expression(list_elem->obj);
217 free_list2(object->value.listValue, list_elem);
218 } /* if */
219 FREE_OBJECT(object);
220 break;
221 default:
222 break;
223 } /* switch */
224 } /* if */
225 } /* free_expression */
226
227
228
concat_lists(listType * list1,listType list2)229 void concat_lists (listType *list1, listType list2)
230
231 {
232 listType help_element;
233
234 /* concat_lists */
235 logFunction(printf("concat_lists(" FMT_U_MEM ", " FMT_U_MEM ") \n",
236 (memSizeType) *list1, (memSizeType) list2););
237 /* prot_list(list2);
238 printf("\n"); */
239 if (*list1 == NULL) {
240 *list1 = list2;
241 } else {
242 if (list2 != NULL) {
243 help_element = *list1;
244 while (help_element->next != NULL) {
245 help_element = help_element->next;
246 } /* while */
247 help_element->next = list2;
248 } /* if */
249 } /* if */
250 logFunction(printf("concat_lists -->\n"););
251 } /* concat_lists */
252
253
254
incl_list(listType * list,objectType element_object,errInfoType * err_info)255 void incl_list (listType *list, objectType element_object,
256 errInfoType *err_info)
257
258 {
259 listType help_element;
260
261 /* incl_list */
262 logFunction(printf("incl_list(" FMT_U_MEM ", " FMT_U_MEM ")\n",
263 (memSizeType) *list,
264 (memSizeType) element_object););
265 if (unlikely(!ALLOC_L_ELEM(help_element))) {
266 *err_info = MEMORY_ERROR;
267 } else {
268 help_element->next = *list;
269 help_element->obj = element_object;
270 *list = help_element;
271 } /* if */
272 logFunction(printf("incl_list --> " FMT_U_MEM "\n",
273 (memSizeType) *list););
274 } /* incl_list */
275
276
277
excl_list(listType * list,const_objectType elementobject)278 void excl_list (listType *list, const_objectType elementobject)
279
280 {
281 listType listelement, disposeelement;
282 boolType found;
283
284 /* excl_list */
285 logFunction(printf("excl_list\n"););
286 if (*list != NULL) {
287 listelement = *list;
288 if (listelement->obj == elementobject) {
289 *list = listelement->next;
290 FREE_L_ELEM(listelement);
291 } else {
292 found = FALSE;
293 while ((listelement->next != NULL) && !found) {
294 if (listelement->next->obj == elementobject) {
295 found = TRUE;
296 } else {
297 listelement = listelement->next;
298 } /* if */
299 } /* while */
300 if (found) {
301 disposeelement = listelement->next;
302 listelement->next = disposeelement->next;
303 FREE_L_ELEM(disposeelement);
304 } /* if */
305 } /* if */
306 } /* if */
307 logFunction(printf("excl_list -->\n"););
308 } /* excl_list */
309
310
311
pop_list(listType * list)312 void pop_list (listType *list)
313
314 {
315 listType listelement;
316
317 /* pop_list */
318 logFunction(printf("excl_list\n"););
319 if (*list != NULL) {
320 listelement = *list;
321 *list = listelement->next;
322 FREE_L_ELEM(listelement);
323 } /* if */
324 logFunction(printf("excl_list -->\n"););
325 } /* pop_list */
326
327
328
replace_list_elem(listType list,const_objectType elem1,objectType elem2)329 void replace_list_elem (listType list, const_objectType elem1,
330 objectType elem2)
331
332 { /* replace_list_elem */
333 logFunction(printf("replace_list_elem\n"););
334 while (list != NULL) {
335 if (list->obj == elem1) {
336 list->obj = elem2;
337 list = NULL;
338 } else {
339 list = list->next;
340 } /* if */
341 } /* while */
342 logFunction(printf("replace_list_elem -->\n"););
343 } /* replace_list_elem */
344
345
346
347 /**
348 * Copy the given list 'list_from'.
349 * For performance reasons list elements are taken directly
350 * from the free list (flist.list_elems).
351 * @param list_from Possibly empty list to be copied.
352 * @param err_info Unchanged if the function succeeds, and
353 * MEMORY_ERROR if a memory allocation failed.
354 * @return the copied list, or
355 * NULL if an error occurred.
356 */
copy_list(const_listType list_from,errInfoType * err_info)357 listType copy_list (const_listType list_from, errInfoType *err_info)
358
359 {
360 listType help_element;
361 listType list_to;
362
363 /* copy_list */
364 logFunction(printf("copy_list\n"););
365 if (list_from != NULL) {
366 if (flist.list_elems != NULL) {
367 help_element = flist.list_elems;
368 list_to = help_element;
369 help_element->obj = list_from->obj;
370 list_from = list_from->next;
371 while (list_from != NULL && help_element->next != NULL) {
372 help_element = help_element->next;
373 help_element->obj = list_from->obj;
374 list_from = list_from->next;
375 } /* while */
376 flist.list_elems = help_element->next;
377 } else {
378 if (unlikely(!HEAP_L_E(list_to, listRecord))) {
379 logError(printf("copy_list: malloc failed.\n"););
380 *err_info = MEMORY_ERROR;
381 } else {
382 help_element = list_to;
383 help_element->obj = list_from->obj;
384 list_from = list_from->next;
385 } /* if */
386 } /* if */
387 if (list_to != NULL) {
388 while (list_from != NULL) {
389 if (unlikely(!HEAP_L_E(help_element->next, listRecord))) {
390 free_list(list_to);
391 logError(printf("copy_list: malloc failed.\n"););
392 *err_info = MEMORY_ERROR;
393 return NULL;
394 } else {
395 help_element = help_element->next;
396 help_element->obj = list_from->obj;
397 list_from = list_from->next;
398 } /* if */
399 } /* while */
400 help_element->next = NULL;
401 } /* if */
402 } else {
403 list_to = NULL;
404 } /* if */
405 logFunction(printf("copy_list -->\n"););
406 return list_to;
407 } /* copy_list */
408
409
410
411 /**
412 * Generate a list with the elements of the given array 'arr_from'.
413 * For performance reasons list elements are taken directly
414 * from the free list (flist.list_elems).
415 * @param arr_from Possibly empty array.
416 * @param err_info Unchanged if the function succeeds, and
417 * MEMORY_ERROR if a memory allocation failed.
418 * @return the generated list with elements from 'arr_from'.
419 */
array_to_list(arrayType arr_from,errInfoType * err_info)420 listType array_to_list (arrayType arr_from, errInfoType *err_info)
421
422 {
423 listType help_element;
424 memSizeType arr_from_size;
425 memSizeType position;
426 listType list_to;
427
428 /* array_to_list */
429 logFunction(printf("array_to_list\n"););
430 arr_from_size = arraySize(arr_from);
431 if (arr_from_size != 0 && *err_info == OKAY_NO_ERROR) {
432 if (flist.list_elems != NULL) {
433 help_element = flist.list_elems;
434 list_to = help_element;
435 help_element->obj = &arr_from->arr[0];
436 position = 1;
437 while (position < arr_from_size && help_element->next != NULL) {
438 help_element = help_element->next;
439 help_element->obj = &arr_from->arr[position];
440 position++;
441 } /* while */
442 flist.list_elems = help_element->next;
443 } else {
444 if (unlikely(!HEAP_L_E(list_to, listRecord))) {
445 logError(printf("array_to_list: malloc failed.\n"););
446 *err_info = MEMORY_ERROR;
447 } else {
448 help_element = list_to;
449 help_element->obj = &arr_from->arr[0];
450 position = 1;
451 } /* if */
452 } /* if */
453 if (list_to != NULL) {
454 while (position < arr_from_size) {
455 if (unlikely(!HEAP_L_E(help_element->next, listRecord))) {
456 free_list(list_to);
457 logError(printf("array_to_list: malloc failed.\n"););
458 *err_info = MEMORY_ERROR;
459 return NULL;
460 } else {
461 help_element = help_element->next;
462 help_element->obj = &arr_from->arr[position];
463 position++;
464 } /* if */
465 } /* while */
466 help_element->next = NULL;
467 } /* if */
468 } else {
469 list_to = NULL;
470 } /* if */
471 logFunction(printf("array_to_list -->\n"););
472 return list_to;
473 } /* array_to_list */
474
475
476
477 /**
478 * Generate a list with the elements of the given struct 'stru_from'.
479 * For performance reasons list elements are taken directly
480 * from the free list (flist.list_elems).
481 * @param stru_from Possibly empty struct.
482 * @param err_info Unchanged if the function succeeds, and
483 * MEMORY_ERROR if a memory allocation failed.
484 * @return the generated list with elements from 'stru_from'.
485 */
struct_to_list(structType stru_from,errInfoType * err_info)486 listType struct_to_list (structType stru_from, errInfoType *err_info)
487
488 {
489 listType help_element;
490 memSizeType position;
491 listType list_to;
492
493 /* struct_to_list */
494 logFunction(printf("struct_to_list\n"););
495 if (stru_from->size != 0 && *err_info == OKAY_NO_ERROR) {
496 if (flist.list_elems != NULL) {
497 help_element = flist.list_elems;
498 list_to = help_element;
499 help_element->obj = &stru_from->stru[0];
500 position = 1;
501 while (position < stru_from->size && help_element->next != NULL) {
502 help_element = help_element->next;
503 help_element->obj = &stru_from->stru[position];
504 position++;
505 } /* while */
506 flist.list_elems = help_element->next;
507 } else {
508 if (unlikely(!HEAP_L_E(list_to, listRecord))) {
509 logError(printf("struct_to_list: malloc failed.\n"););
510 *err_info = MEMORY_ERROR;
511 } else {
512 help_element = list_to;
513 help_element->obj = &stru_from->stru[0];
514 position = 1;
515 } /* if */
516 } /* if */
517 if (list_to != NULL) {
518 while (position < stru_from->size) {
519 if (unlikely(!HEAP_L_E(help_element->next, listRecord))) {
520 free_list(list_to);
521 logError(printf("struct_to_list: malloc failed.\n"););
522 *err_info = MEMORY_ERROR;
523 return NULL;
524 } else {
525 help_element = help_element->next;
526 help_element->obj = &stru_from->stru[position];
527 position++;
528 } /* if */
529 } /* while */
530 help_element->next = NULL;
531 } /* if */
532 } else {
533 list_to = NULL;
534 } /* if */
535 logFunction(printf("struct_to_list -->\n"););
536 return list_to;
537 } /* struct_to_list */
538
539
540
helem_data_to_list(listType * list_insert_place,hashElemType helem,errInfoType * err_info)541 static void helem_data_to_list (listType *list_insert_place,
542 hashElemType helem, errInfoType *err_info)
543
544 { /* helem_data_to_list */
545 do {
546 incl_list(list_insert_place, &helem->data, err_info);
547 if (helem->next_less != NULL && *err_info == OKAY_NO_ERROR) {
548 helem_data_to_list(list_insert_place, helem->next_less, err_info);
549 } /* if */
550 helem = helem->next_greater;
551 } while (helem != NULL && *err_info == OKAY_NO_ERROR);
552 } /* helem_data_to_list */
553
554
555
hash_data_to_list(hashType hash,errInfoType * err_info)556 listType hash_data_to_list (hashType hash, errInfoType *err_info)
557
558 {
559 unsigned int number;
560 hashElemType *table;
561 listType result;
562
563 /* hash_data_to_list */
564 result = NULL;
565 if (hash->size != 0) {
566 number = hash->table_size;
567 table = hash->table;
568 while (number != 0 && *err_info == OKAY_NO_ERROR) {
569 do {
570 number--;
571 } while (number != 0 && table[number] == NULL);
572 if (number != 0 || table[number] != NULL) {
573 helem_data_to_list(&result, table[number], err_info);
574 } /* if */
575 } /* while */
576 } /* if */
577 return result;
578 } /* hash_data_to_list */
579
580
581
helem_key_to_list(listType * list_insert_place,hashElemType helem,errInfoType * err_info)582 static void helem_key_to_list (listType *list_insert_place,
583 hashElemType helem, errInfoType *err_info)
584
585 { /* helem_key_to_list */
586 do {
587 incl_list(list_insert_place, &helem->key, err_info);
588 if (helem->next_less != NULL && *err_info == OKAY_NO_ERROR) {
589 helem_key_to_list(list_insert_place, helem->next_less, err_info);
590 } /* if */
591 helem = helem->next_greater;
592 } while (helem != NULL && *err_info == OKAY_NO_ERROR);
593 } /* helem_key_to_list */
594
595
596
hash_keys_to_list(hashType hash,errInfoType * err_info)597 listType hash_keys_to_list (hashType hash, errInfoType *err_info)
598
599 {
600 unsigned int number;
601 hashElemType *table;
602 listType result;
603
604 /* hash_keys_to_list */
605 result = NULL;
606 if (hash->size != 0) {
607 number = hash->table_size;
608 table = hash->table;
609 while (number != 0 && *err_info == OKAY_NO_ERROR) {
610 do {
611 number--;
612 } while (number != 0 && table[number] == NULL);
613 if (number != 0 || table[number] != NULL) {
614 helem_key_to_list(&result, table[number], err_info);
615 } /* if */
616 } /* while */
617 } /* if */
618 return result;
619 } /* hash_keys_to_list */
620