1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2000, 2011 - 2013 Thomas Mertes */
5 /* 2015 - 2017, 2020, 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: Interpreter */
23 /* File: seed7/src/executl.c */
24 /* Changes: 1993, 1994, 2011 - 2013, 2015 - 2017 Thomas Mertes */
25 /* 2020, 2021 Thomas Mertes */
26 /* Content: Initialization operation procedures used at runtime. */
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 #include "string.h"
38
39 #include "common.h"
40 #include "sigutl.h"
41 #include "data.h"
42 #include "heaputl.h"
43 #include "flistutl.h"
44 #include "syvarutl.h"
45 #include "listutl.h"
46 #include "traceutl.h"
47 #include "objutl.h"
48 #include "error.h"
49 #include "doany.h"
50 #include "exec.h"
51 #include "match.h"
52 #include "runerr.h"
53
54 #undef EXTERN
55 #define EXTERN
56 #include "executl.h"
57
58
59
get_create_call_obj(objectType obj,errInfoType * err_info)60 objectType get_create_call_obj (objectType obj, errInfoType *err_info)
61
62 {
63 objectRecord expr_object;
64 listRecord expr_list[3];
65 objectType match_result;
66 objectType create_call_obj;
67 progType progBackup;
68
69 /* get_create_call_obj */
70 #ifdef WITH_PROTOCOL
71 if (trace.executil) {
72 prot_cstri("match - get_create_call_obj: obj= ");
73 trace1(obj);
74 prot_nl();
75 } /* if */
76 #endif
77 create_call_obj = NULL;
78
79 progBackup = prog;
80 prog = obj->type_of->owningProg;
81 expr_object.type_of = take_type(SYS_EXPR_TYPE);
82 expr_object.descriptor.property = NULL;
83 expr_object.value.listValue = expr_list;
84 INIT_CATEGORY_OF_OBJ(&expr_object, EXPROBJECT);
85
86 expr_list[0].next = &expr_list[1];
87 expr_list[1].next = &expr_list[2];
88 expr_list[2].next = NULL;
89 expr_list[0].obj = obj;
90 expr_list[1].obj = SYS_CREA_OBJECT;
91 expr_list[2].obj = obj;
92
93 match_result = match_expression(&expr_object);
94 if (match_result != NULL) {
95 match_result = match_object(match_result);
96 if (match_result != NULL) {
97 create_call_obj = match_result->value.listValue->obj;
98 FREE_L_ELEM(match_result->value.listValue);
99 /* FREE_OBJECT(match_result) is not necessary, */
100 /* because match_result == &expr_object holds. */
101 } /* if */
102 } /* if */
103 prog = progBackup;
104
105 return create_call_obj;
106 } /* get_create_call_obj */
107
108
109
get_destroy_call_obj(objectType obj,errInfoType * err_info)110 objectType get_destroy_call_obj (objectType obj, errInfoType *err_info)
111
112 {
113 objectRecord expr_object;
114 listRecord expr_list[2];
115 objectType match_result;
116 objectType destroy_call_obj;
117 progType progBackup;
118
119 /* get_destroy_call_obj */
120 #ifdef WITH_PROTOCOL
121 if (trace.executil) {
122 prot_cstri("match - get_destroy_call_obj: obj= ");
123 trace1(obj);
124 prot_nl();
125 } /* if */
126 #endif
127 destroy_call_obj = NULL;
128
129 progBackup = prog;
130 prog = obj->type_of->owningProg;
131 expr_object.type_of = take_type(SYS_EXPR_TYPE);
132 expr_object.descriptor.property = NULL;
133 expr_object.value.listValue = expr_list;
134 INIT_CATEGORY_OF_OBJ(&expr_object, EXPROBJECT);
135
136 expr_list[0].next = &expr_list[1];
137 expr_list[1].next = NULL;
138 expr_list[0].obj = obj;
139 expr_list[1].obj = SYS_DESTR_OBJECT;
140
141 match_result = match_expression(&expr_object);
142 if (match_result != NULL) {
143 match_result = match_object(match_result);
144 if (match_result != NULL) {
145 destroy_call_obj = match_result->value.listValue->obj;
146 FREE_L_ELEM(match_result->value.listValue);
147 /* FREE_OBJECT(match_result) is not necessary, */
148 /* because match_result == &expr_object holds. */
149 } /* if */
150 } /* if */
151 prog = progBackup;
152
153 return destroy_call_obj;
154 } /* get_destroy_call_obj */
155
156
157
type_create_call_obj(objectType destination,objectType source,errInfoType * err_info)158 static void type_create_call_obj (objectType destination,
159 objectType source, errInfoType *err_info)
160
161 {
162 objectRecord expr_object;
163 listRecord expr_list[3];
164 objectType match_result;
165
166 /* type_create_call_obj */
167 #ifdef WITH_PROTOCOL
168 if (trace.executil) {
169 prot_cstri("match - type_create_call_obj: destination= ");
170 trace1(destination);
171 prot_nl();
172 prot_cstri("source= ");
173 trace1(source);
174 prot_nl();
175 } /* if */
176 #endif
177 expr_object.type_of = take_type(SYS_EXPR_TYPE);
178 expr_object.descriptor.property = NULL;
179 expr_object.value.listValue = expr_list;
180 INIT_CATEGORY_OF_OBJ(&expr_object, EXPROBJECT);
181
182 expr_list[0].next = &expr_list[1];
183 expr_list[1].next = &expr_list[2];
184 expr_list[2].next = NULL;
185 expr_list[0].obj = destination;
186 expr_list[1].obj = SYS_CREA_OBJECT;
187 expr_list[2].obj = source;
188
189 match_result = match_expression(&expr_object);
190 if (match_result != NULL) {
191 match_result = match_object(match_result);
192 if (match_result != NULL) {
193 destination->type_of->create_call_obj =
194 match_result->value.listValue->obj;
195 FREE_L_ELEM(match_result->value.listValue);
196 /* FREE_OBJECT(match_result) is not necessary, */
197 /* because match_result == &expr_object holds. */
198 } /* if */
199 } /* if */
200 } /* type_create_call_obj */
201
202
203
type_copy_call_obj(objectType destination,objectType source,errInfoType * err_info)204 static void type_copy_call_obj (objectType destination,
205 objectType source, errInfoType *err_info)
206
207 {
208 objectRecord expr_object;
209 listRecord expr_list[3];
210 objectType match_result;
211
212 /* type_copy_call_obj */
213 #ifdef WITH_PROTOCOL
214 if (trace.executil) {
215 prot_cstri("match - type_copy_call_obj: destination= ");
216 trace1(destination);
217 prot_nl();
218 prot_cstri("source= ");
219 trace1(source);
220 prot_nl();
221 } /* if */
222 #endif
223 expr_object.type_of = take_type(SYS_EXPR_TYPE);
224 expr_object.descriptor.property = NULL;
225 expr_object.value.listValue = expr_list;
226 INIT_CATEGORY_OF_OBJ(&expr_object, EXPROBJECT);
227
228 expr_list[0].next = &expr_list[1];
229 expr_list[1].next = &expr_list[2];
230 expr_list[2].next = NULL;
231 expr_list[0].obj = destination;
232 expr_list[1].obj = SYS_ASSIGN_OBJECT;
233 expr_list[2].obj = source;
234
235 match_result = match_expression(&expr_object);
236 if (match_result != NULL) {
237 match_result = match_object(match_result);
238 if (match_result != NULL) {
239 destination->type_of->copy_call_obj =
240 match_result->value.listValue->obj;
241 FREE_L_ELEM(match_result->value.listValue);
242 /* FREE_OBJECT(match_result) is not necessary, */
243 /* because match_result == &expr_object holds. */
244 } /* if */
245 } /* if */
246 } /* type_copy_call_obj */
247
248
249
type_ord_call_obj(objectType any_obj,errInfoType * err_info)250 static void type_ord_call_obj (objectType any_obj,
251 errInfoType *err_info)
252
253 {
254 objectRecord expr_object;
255 listRecord expr_list[2];
256 objectType match_result;
257
258 /* type_ord_call_obj */
259 #ifdef WITH_PROTOCOL
260 if (trace.executil) {
261 prot_cstri("match - type_ord_call_obj: any_obj= ");
262 trace1(any_obj);
263 prot_nl();
264 } /* if */
265 #endif
266 expr_object.type_of = take_type(SYS_EXPR_TYPE);
267 expr_object.descriptor.property = NULL;
268 expr_object.value.listValue = expr_list;
269 INIT_CATEGORY_OF_OBJ(&expr_object, EXPROBJECT);
270
271 expr_list[0].next = &expr_list[1];
272 expr_list[1].next = NULL;
273 expr_list[0].obj = any_obj;
274 expr_list[1].obj = SYS_ORD_OBJECT;
275
276 match_result = match_expression(&expr_object);
277 if (match_result != NULL) {
278 match_result = match_object(match_result);
279 if (match_result != NULL) {
280 any_obj->type_of->ord_call_obj =
281 match_result->value.listValue->obj;
282 FREE_L_ELEM(match_result->value.listValue);
283 /* FREE_OBJECT(match_result) is not necessary, */
284 /* because match_result == &expr_object holds. */
285 } /* if */
286 } /* if */
287 } /* type_ord_call_obj */
288
289
290
type_in_call_obj(objectType elem_obj,objectType set_obj,errInfoType * err_info)291 static void type_in_call_obj (objectType elem_obj,
292 objectType set_obj, errInfoType *err_info)
293
294 {
295 objectRecord expr_object;
296 listRecord expr_list[3];
297 objectType match_result;
298
299 /* type_in_call_obj */
300 #ifdef WITH_PROTOCOL
301 if (trace.executil) {
302 prot_cstri("match - type_in_call_obj: elem_obj= ");
303 trace1(elem_obj);
304 prot_nl();
305 prot_cstri("set_obj= ");
306 trace1(set_obj);
307 prot_nl();
308 } /* if */
309 #endif
310 expr_object.type_of = take_type(SYS_EXPR_TYPE);
311 expr_object.descriptor.property = NULL;
312 expr_object.value.listValue = expr_list;
313 INIT_CATEGORY_OF_OBJ(&expr_object, EXPROBJECT);
314
315 expr_list[0].next = &expr_list[1];
316 expr_list[1].next = &expr_list[2];
317 expr_list[2].next = NULL;
318 expr_list[0].obj = elem_obj;
319 expr_list[1].obj = SYS_IN_OBJECT;
320 expr_list[2].obj = set_obj;
321
322 match_result = match_expression(&expr_object);
323 if (match_result != NULL) {
324 match_result = match_object(match_result);
325 if (match_result != NULL) {
326 elem_obj->type_of->in_call_obj =
327 match_result->value.listValue->obj;
328 FREE_L_ELEM(match_result->value.listValue);
329 /* FREE_OBJECT(match_result) is not necessary, */
330 /* because match_result == &expr_object holds. */
331 } /* if */
332 } /* if */
333 } /* type_in_call_obj */
334
335
336
type_value_call_obj(objectType type_obj,errInfoType * err_info)337 static objectType type_value_call_obj (objectType type_obj, errInfoType *err_info)
338
339 {
340 objectRecord expr_object;
341 listRecord expr_list[3];
342 objectType match_result;
343 objectType value_call_obj = NULL;
344
345 /* type_value_call_obj */
346 #ifdef WITH_PROTOCOL
347 if (trace.executil) {
348 prot_cstri("match - type_value_call_obj: type_obj= ");
349 trace1(type_obj);
350 prot_nl();
351 } /* if */
352 #endif
353 expr_object.type_of = take_type(SYS_EXPR_TYPE);
354 expr_object.descriptor.property = NULL;
355 expr_object.value.listValue = expr_list;
356 INIT_CATEGORY_OF_OBJ(&expr_object, EXPROBJECT);
357
358 expr_list[0].next = &expr_list[1];
359 expr_list[1].next = &expr_list[2];
360 expr_list[2].next = NULL;
361 expr_list[0].obj = type_obj;
362 expr_list[1].obj = SYS_DOT_OBJECT;
363 expr_list[2].obj = SYS_VALUE_OBJECT;
364
365 match_result = match_expression(&expr_object);
366 if (match_result != NULL) {
367 match_result = match_object(match_result);
368 if (match_result != NULL) {
369 value_call_obj = match_result->value.listValue->obj;
370 FREE_L_ELEM(match_result->value.listValue);
371 /* FREE_OBJECT(match_result) is not necessary, */
372 /* because match_result == &expr_object holds. */
373 } /* if */
374 } /* if */
375 logFunction(printf("type_value_call_obj -> " FMT_U_MEM "\n",
376 (memSizeType) value_call_obj););
377 return value_call_obj;
378 } /* type_value_call_obj */
379
380
381
old_do_create(objectType destination,objectType source,errInfoType * err_info)382 static void old_do_create (objectType destination, objectType source,
383 errInfoType *err_info)
384
385 {
386 listRecord crea_expr[3];
387
388 /* old_do_create */
389 logFunction(printf("old_do_create ");
390 trace1(destination);
391 printf("\nas ");
392 trace1(source);
393 printf("\n"););
394 #ifdef WITH_PROTOCOL
395 if (trace.executil) {
396 prot_cstri("match - old_do_create: destination= ");
397 trace1(destination);
398 prot_nl();
399 prot_cstri("source= ");
400 trace1(source);
401 prot_nl();
402 } /* if */
403 #endif
404 crea_expr[0].next = &crea_expr[1];
405 crea_expr[1].next = &crea_expr[2];
406 crea_expr[2].next = NULL;
407 crea_expr[0].obj = destination;
408 crea_expr[1].obj = SYS_CREA_OBJECT;
409 crea_expr[2].obj = source;
410 if (exec1(crea_expr) != SYS_EMPTY_OBJECT) {
411 if (trace.exceptions) {
412 write_exception_info();
413 } /* if */
414 set_fail_flag(FALSE);
415 *err_info = CREATE_ERROR;
416 } /* if */
417 /* printf("free callobjects ");
418 trace1(crea_expr[0].obj);
419 printf("\n"); */
420 /* The function match_expression, called from exec1, may */
421 /* allocate CALLOBJECT objects which can be freed now. */
422 free_expression(crea_expr[0].obj);
423 logFunction(printf("old_do_create --> err_info=%d\n", *err_info););
424 } /* old_do_create */
425
426
427
do_create(objectType destination,objectType source,errInfoType * err_info)428 void do_create (objectType destination, objectType source,
429 errInfoType *err_info)
430
431 {
432 objectRecord call_object;
433 listRecord call_list[4];
434 objectType call_result;
435
436 /* do_create */
437 logFunction(printf("do_create ");
438 trace1(destination);
439 printf("\nas ");
440 trace1(source);
441 printf("\n"););
442 if (destination->type_of == source->type_of) {
443 if (destination->type_of->destroy_call_obj == NULL) {
444 /* prot_cstri("do_create search for destroy(");
445 trace1(destination);
446 prot_cstri(")");
447 prot_nl(); */
448 destination->type_of->destroy_call_obj =
449 get_destroy_call_obj(destination, err_info);
450 } /* if */
451 if (destination->type_of->create_call_obj == NULL) {
452 /* prot_cstri("do_create ");
453 trace1(destination);
454 prot_nl();
455 prot_cstri("from ");
456 trace1(source);
457 prot_nl(); */
458 type_create_call_obj(destination, source, err_info);
459 /* prot_cstri("is ");
460 trace1(destination->type_of->create_call_obj);
461 prot_nl(); */
462 } /* if */
463 if (destination->type_of->create_call_obj != NULL) {
464 call_object.type_of = NULL;
465 call_object.descriptor.property = NULL;
466 call_object.value.listValue = call_list;
467 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
468
469 call_list[0].next = &call_list[1];
470 call_list[1].next = &call_list[2];
471 call_list[2].next = &call_list[3];
472 call_list[3].next = NULL;
473 call_list[0].obj = destination->type_of->create_call_obj;
474 call_list[1].obj = destination;
475 call_list[2].obj = SYS_CREA_OBJECT;
476 call_list[3].obj = source;
477
478 /* printf("do_create: before exec_call\n");
479 fflush(stdout); */
480 call_result = exec_call(&call_object);
481 /* printf("do_create: after exec_call\n");
482 fflush(stdout); */
483 if (call_result != SYS_EMPTY_OBJECT) {
484 if (trace.exceptions) {
485 write_exception_info();
486 } /* if */
487 set_fail_flag(FALSE);
488 *err_info = CREATE_ERROR;
489 } /* if */
490 } else {
491 *err_info = CREATE_ERROR;
492 } /* if */
493 } else {
494 old_do_create(destination, source, err_info);
495 } /* if */
496 logFunction(printf("do_create --> err_info=%d\n", *err_info););
497 } /* do_create */
498
499
500
do_destroy(objectType old_obj,errInfoType * err_info)501 void do_destroy (objectType old_obj, errInfoType *err_info)
502
503 {
504 objectRecord call_object;
505 listRecord call_list[3];
506 objectType call_result;
507
508 /* do_destroy */
509 if (old_obj->type_of != NULL) {
510 if (old_obj->type_of->destroy_call_obj == NULL) {
511 /* prot_cstri("do_destroy ");
512 trace1(old_obj);
513 prot_nl(); */
514 old_obj->type_of->destroy_call_obj =
515 get_destroy_call_obj(old_obj, err_info);
516 /* prot_cstri("is ");
517 trace1(old_obj->type_of->destroy_call_obj);
518 prot_nl(); */
519 } /* if */
520 if (old_obj->type_of->destroy_call_obj != NULL) {
521 call_object.type_of = NULL;
522 call_object.descriptor.property = NULL;
523 call_object.value.listValue = call_list;
524 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
525
526 /* prot_cstri("old_obj=[");
527 prot_int((intType) old_obj);
528 prot_cstri("] ");
529 prot_flush();
530 trace1(old_obj);
531 prot_nl(); */
532
533 call_list[0].next = &call_list[1];
534 call_list[1].next = &call_list[2];
535 call_list[2].next = NULL;
536 call_list[0].obj = old_obj->type_of->destroy_call_obj;
537 call_list[1].obj = old_obj;
538 call_list[2].obj = SYS_DESTR_OBJECT;
539
540 /* prot_cstri("call_list[0].obj=[");
541 prot_int((intType) call_list[0].obj);
542 prot_cstri("] ");
543 prot_flush();
544 trace1(call_list[0].obj);
545 prot_nl();
546 prot_cstri("call_list[1].obj=[");
547 prot_int((intType) call_list[0].obj);
548 prot_cstri("] ");
549 prot_flush();
550 trace1(call_list[1].obj);
551 prot_nl();
552 prot_cstri("call_list[2].obj=[");
553 prot_int((intType) call_list[0].obj);
554 prot_cstri("] ");
555 prot_flush();
556 trace1(call_list[2].obj);
557 prot_nl(); */
558 /* printf("do_destroy: before exec_call\n");
559 fflush(stdout);
560 if (TEMP_OBJECT(old_obj)) {
561 prot_cstri("is temp ");
562 trace1(old_obj);
563 } */
564 call_result = exec_call(&call_object);
565 /* printf("do_destroy: after exec_call\n");
566 fflush(stdout); */
567 if (call_result != SYS_EMPTY_OBJECT) {
568 if (trace.exceptions) {
569 write_exception_info();
570 } /* if */
571 set_fail_flag(FALSE);
572 *err_info = DESTROY_ERROR;
573 } /* if */
574 } else {
575 *err_info = DESTROY_ERROR;
576 } /* if */
577 } else {
578 *err_info = DESTROY_ERROR;
579 } /* if */
580 } /* do_destroy */
581
582
583
old_do_copy(objectType destination,objectType source,errInfoType * err_info)584 void old_do_copy (objectType destination, objectType source,
585 errInfoType *err_info)
586
587 {
588 listRecord copy_expr[3];
589
590 /* old_do_copy */
591 logFunction(printf("old_do_copy\n"););
592 /*
593 printobject(destination);
594 printf(" := ");
595 printobject(source);
596 printf("\n");
597 */
598 #ifdef WITH_PROTOCOL
599 if (trace.executil) {
600 prot_cstri("match - old_do_copy: destination= ");
601 trace1(destination);
602 prot_nl();
603 prot_cstri("source= ");
604 trace1(source);
605 prot_nl();
606 } /* if */
607 #endif
608 copy_expr[0].next = ©_expr[1];
609 copy_expr[1].next = ©_expr[2];
610 copy_expr[2].next = NULL;
611 copy_expr[0].obj = destination;
612 copy_expr[1].obj = SYS_ASSIGN_OBJECT;
613 copy_expr[2].obj = source;
614 if (exec1(copy_expr) != SYS_EMPTY_OBJECT) {
615 if (trace.exceptions) {
616 write_exception_info();
617 } /* if */
618 set_fail_flag(FALSE);
619 *err_info = COPY_ERROR;
620 } /* if */
621 logFunction(printf("old_do_copy --> err_info=%d\n", *err_info););
622 } /* old_do_copy */
623
624
625
do_copy(objectType destination,objectType source,errInfoType * err_info)626 static void do_copy (objectType destination, objectType source,
627 errInfoType *err_info)
628
629 {
630 objectRecord call_object;
631 listRecord call_list[4];
632 objectType call_result;
633
634 /* do_copy */
635 logFunction(printf("do_copy ");
636 trace1(destination);
637 printf("\nfrom ");
638 trace1(source);
639 printf("\n"););
640 if (destination->type_of == source->type_of) {
641 if (destination->type_of->copy_call_obj == NULL) {
642 /* prot_cstri("do_copy ");
643 trace1(destination);
644 prot_nl();
645 prot_cstri("from ");
646 trace1(source);
647 prot_nl(); */
648 type_copy_call_obj(destination, source, err_info);
649 /* prot_cstri("is ");
650 trace1(destination->type_of->copy_call_obj);
651 prot_nl(); */
652 } /* if */
653 if (destination->type_of->copy_call_obj != NULL) {
654 call_object.type_of = NULL;
655 call_object.descriptor.property = NULL;
656 call_object.value.listValue = call_list;
657 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
658
659 call_list[0].next = &call_list[1];
660 call_list[1].next = &call_list[2];
661 call_list[2].next = &call_list[3];
662 call_list[3].next = NULL;
663 call_list[0].obj = destination->type_of->copy_call_obj;
664 call_list[1].obj = destination;
665 call_list[2].obj = SYS_ASSIGN_OBJECT;
666 call_list[3].obj = source;
667
668 /* printf("copy_local_object: before exec_call\n");
669 fflush(stdout); */
670 call_result = exec_call(&call_object);
671 /* printf("copy_local_object: after exec_call\n");
672 fflush(stdout); */
673 if (call_result != SYS_EMPTY_OBJECT) {
674 if (trace.exceptions) {
675 write_exception_info();
676 } /* if */
677 set_fail_flag(FALSE);
678 *err_info = COPY_ERROR;
679 } /* if */
680 } else {
681 *err_info = COPY_ERROR;
682 } /* if */
683 } else {
684 old_do_copy(destination, source, err_info);
685 } /* if */
686 logFunction(printf("do_copy --> err_info=%d\n", *err_info););
687 } /* do_copy */
688
689
690
do_ord(objectType any_obj,errInfoType * err_info)691 intType do_ord (objectType any_obj, errInfoType *err_info)
692
693 {
694 categoryType temp_any_obj;
695 objectRecord call_object;
696 listRecord call_list[3];
697 objectType call_result;
698 intType result;
699
700 /* do_ord */
701 if (any_obj->type_of->ord_call_obj == NULL) {
702 /* prot_cstri("do_ord ");
703 trace1(any_obj);
704 prot_nl(); */
705 type_ord_call_obj(any_obj, err_info);
706 /* prot_cstri("is ");
707 trace1(any_obj->type_of->ord_call_obj);
708 prot_nl(); */
709 } /* if */
710 if (any_obj->type_of->ord_call_obj != NULL) {
711 call_object.type_of = NULL;
712 call_object.descriptor.property = NULL;
713 call_object.value.listValue = call_list;
714 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
715
716 /* prot_cstri("any_obj=[");
717 prot_int((intType) any_obj);
718 prot_cstri("] ");
719 prot_flush();
720 trace1(any_obj);
721 prot_nl(); */
722
723 call_list[0].next = &call_list[1];
724 call_list[1].next = &call_list[2];
725 call_list[2].next = NULL;
726 call_list[0].obj = any_obj->type_of->ord_call_obj;
727 call_list[1].obj = any_obj;
728 call_list[2].obj = SYS_ORD_OBJECT;
729
730 /* prot_cstri("call_list[0].obj=[");
731 prot_int((intType) call_list[0].obj);
732 prot_cstri("] ");
733 prot_flush();
734 trace1(call_list[0].obj);
735 prot_nl();
736 prot_cstri("call_list[1].obj=[");
737 prot_int((intType) call_list[0].obj);
738 prot_cstri("] ");
739 prot_flush();
740 trace1(call_list[1].obj);
741 prot_nl();
742 prot_cstri("call_list[2].obj=[");
743 prot_int((intType) call_list[0].obj);
744 prot_cstri("] ");
745 prot_flush();
746 trace1(call_list[2].obj);
747 prot_nl(); */
748 /* printf("do_ord: before exec_call\n");
749 fflush(stdout);
750 if (TEMP_OBJECT(any_obj)) {
751 prot_cstri("is temp ");
752 trace1(any_obj);
753 } */
754 temp_any_obj = (categoryType) TEMP_OBJECT(any_obj);
755 CLEAR_TEMP_FLAG(any_obj);
756
757 call_result = exec_call(&call_object);
758
759 SET_ANY_FLAG(any_obj, temp_any_obj);
760 /* printf("do_ord: after exec_call\n");
761 fflush(stdout); */
762 result = take_int(call_result);
763 if (TEMP_OBJECT(call_result)) {
764 dump_any_temp(call_result);
765 } /* if */
766 } else {
767 result = 0;
768 *err_info = IN_ERROR;
769 } /* if */
770 return result;
771 } /* do_ord */
772
773
774
do_in(objectType elem_obj,objectType set_obj,errInfoType * err_info)775 boolType do_in (objectType elem_obj, objectType set_obj,
776 errInfoType *err_info)
777
778 {
779 categoryType temp_elem_obj;
780 categoryType temp_set_obj;
781 objectRecord call_object;
782 listRecord call_list[4];
783 objectType call_result;
784 boolType result;
785
786 /* do_in */
787 if (elem_obj->type_of->in_call_obj == NULL) {
788 /* prot_cstri("do_in ");
789 trace1(elem_obj);
790 prot_nl(); */
791 type_in_call_obj(elem_obj, set_obj, err_info);
792 /* prot_cstri("is ");
793 trace1(elem_obj->type_of->in_call_obj);
794 prot_nl(); */
795 } /* if */
796 if (elem_obj->type_of->in_call_obj != NULL) {
797 call_object.type_of = NULL;
798 call_object.descriptor.property = NULL;
799 call_object.value.listValue = call_list;
800 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
801
802 /* prot_cstri("elem_obj=[");
803 prot_int((intType) elem_obj);
804 prot_cstri("] ");
805 prot_flush();
806 trace1(elem_obj);
807 prot_nl(); */
808
809 call_list[0].next = &call_list[1];
810 call_list[1].next = &call_list[2];
811 call_list[2].next = &call_list[3];
812 call_list[3].next = NULL;
813 call_list[0].obj = elem_obj->type_of->in_call_obj;
814 call_list[1].obj = elem_obj;
815 call_list[2].obj = SYS_IN_OBJECT;
816 call_list[3].obj = set_obj;
817
818 /* prot_cstri("call_list[0].obj=[");
819 prot_int((intType) call_list[0].obj);
820 prot_cstri("] ");
821 prot_flush();
822 trace1(call_list[0].obj);
823 prot_nl();
824 prot_cstri("call_list[1].obj=[");
825 prot_int((intType) call_list[0].obj);
826 prot_cstri("] ");
827 prot_flush();
828 trace1(call_list[1].obj);
829 prot_nl();
830 prot_cstri("call_list[2].obj=[");
831 prot_int((intType) call_list[0].obj);
832 prot_cstri("] ");
833 prot_flush();
834 trace1(call_list[2].obj);
835 prot_nl(); */
836 /* printf("do_in: before exec_call\n");
837 fflush(stdout);
838 if (TEMP_OBJECT(elem_obj)) {
839 prot_cstri("is temp ");
840 trace1(elem_obj);
841 } */
842 temp_elem_obj = (categoryType) TEMP_OBJECT(elem_obj);
843 temp_set_obj = (categoryType) TEMP_OBJECT(set_obj);
844 CLEAR_TEMP_FLAG(elem_obj);
845 CLEAR_TEMP_FLAG(set_obj);
846
847 call_result = exec_call(&call_object);
848
849 SET_ANY_FLAG(elem_obj, temp_elem_obj);
850 SET_ANY_FLAG(set_obj, temp_set_obj);
851 /* printf("do_in: after exec_call\n");
852 fflush(stdout); */
853 result = (boolType) (take_bool(call_result) == SYS_TRUE_OBJECT);
854 if (TEMP_OBJECT(call_result)) {
855 dump_any_temp(call_result);
856 } /* if */
857 } else {
858 result = FALSE;
859 *err_info = IN_ERROR;
860 } /* if */
861 return result;
862 } /* do_in */
863
864
865
getValue(objectType type_obj)866 objectType getValue (objectType type_obj)
867
868 {
869 objectType value_call_obj;
870 objectRecord call_object;
871 listRecord call_list[4];
872 errInfoType err_info = OKAY_NO_ERROR;
873
874 /* getValue */
875 if (take_type(type_obj)->value_obj == NULL) {
876 value_call_obj = type_value_call_obj(type_obj, &err_info);
877 if (value_call_obj != NULL) {
878 call_object.type_of = NULL;
879 call_object.descriptor.property = NULL;
880 call_object.value.listValue = call_list;
881 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
882
883 call_list[0].next = &call_list[1];
884 call_list[1].next = &call_list[2];
885 call_list[2].next = &call_list[3];
886 call_list[3].next = NULL;
887 call_list[0].obj = value_call_obj;
888 call_list[1].obj = type_obj;
889 call_list[2].obj = SYS_DOT_OBJECT;
890 call_list[3].obj = SYS_VALUE_OBJECT;
891
892 take_type(type_obj)->value_obj = exec_call(&call_object);
893 } /* if */
894 } /* if */
895 return take_type(type_obj)->value_obj;
896 } /* getValue */
897
898
899
param1_call(objectType function_obj,objectType param1)900 objectType param1_call (objectType function_obj, objectType param1)
901
902 {
903 objectRecord call_object;
904 listRecord call_list[2];
905 objectType call_result;
906
907 /* param1_call */
908 call_object.type_of = NULL;
909 call_object.descriptor.property = NULL;
910 call_object.value.listValue = call_list;
911 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
912
913 call_list[0].next = &call_list[1];
914 call_list[1].next = NULL;
915 call_list[0].obj = function_obj;
916 call_list[1].obj = param1;
917
918 call_result = exec_call(&call_object);
919 return call_result;
920 } /* param1_call */
921
922
923
param2_call(objectType function_obj,objectType param1,objectType param2)924 objectType param2_call (objectType function_obj, objectType param1,
925 objectType param2)
926
927 {
928 objectRecord call_object;
929 listRecord call_list[3];
930 objectType call_result;
931
932 /* param2_call */
933 call_object.type_of = NULL;
934 call_object.descriptor.property = NULL;
935 call_object.value.listValue = call_list;
936 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
937
938 call_list[0].next = &call_list[1];
939 call_list[1].next = &call_list[2];
940 call_list[2].next = NULL;
941 call_list[0].obj = function_obj;
942 call_list[1].obj = param1;
943 call_list[2].obj = param2;
944
945 call_result = exec_call(&call_object);
946 return call_result;
947 } /* param2_call */
948
949
950
param3_call(objectType function_obj,objectType param1,objectType param2,objectType param3)951 objectType param3_call (objectType function_obj, objectType param1,
952 objectType param2, objectType param3)
953
954 {
955 objectRecord call_object;
956 listRecord call_list[4];
957 objectType call_result;
958
959 /* param3_call */
960 call_object.type_of = NULL;
961 call_object.descriptor.property = NULL;
962 call_object.value.listValue = call_list;
963 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
964
965 call_list[0].next = &call_list[1];
966 call_list[1].next = &call_list[2];
967 call_list[2].next = &call_list[3];
968 call_list[3].next = NULL;
969 call_list[0].obj = function_obj;
970 call_list[1].obj = param1;
971 call_list[2].obj = param2;
972 call_list[3].obj = param3;
973
974 call_result = exec_call(&call_object);
975 return call_result;
976 } /* param3_call */
977
978
979
create_return_object(const_locObjType local,objectType init_value,errInfoType * err_info)980 objectType create_return_object (const_locObjType local, objectType init_value,
981 errInfoType *err_info)
982
983 {
984 objectRecord call_object;
985 listRecord call_list[4];
986 objectType new_object;
987 objectType call_result;
988
989 /* create_return_object */
990 logFunction(printf("create_return_object(");
991 trace1(local->object);
992 printf(", ");
993 trace1(init_value);
994 printf(")\n"););
995 if (local->create_call_obj == NULL) {
996 *err_info = CREATE_ERROR;
997 new_object = NULL;
998 } else if (!ALLOC_OBJECT(new_object)) {
999 *err_info = MEMORY_ERROR;
1000 } else {
1001 new_object->type_of = init_value->type_of;
1002 new_object->descriptor.property = NULL;
1003 if (VAR_OBJECT(init_value)) {
1004 INIT_CATEGORY_OF_VAR(new_object, DECLAREDOBJECT);
1005 } else {
1006 INIT_CATEGORY_OF_OBJ(new_object, DECLAREDOBJECT);
1007 } /* if */
1008
1009 call_object.type_of = NULL;
1010 call_object.descriptor.property = NULL;
1011 call_object.value.listValue = call_list;
1012 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
1013
1014 call_list[0].next = &call_list[1];
1015 call_list[1].next = &call_list[2];
1016 call_list[2].next = &call_list[3];
1017 call_list[3].next = NULL;
1018 call_list[0].obj = local->create_call_obj;
1019 call_list[1].obj = new_object;
1020 call_list[2].obj = SYS_CREA_OBJECT;
1021 call_list[3].obj = init_value;
1022
1023 /* printf("create_return_object: before exec_call\n");
1024 fflush(stdout); */
1025 call_result = exec_call(&call_object);
1026 /* printf("create_return_object: after exec_call\n");
1027 fflush(stdout); */
1028 if (call_result != SYS_EMPTY_OBJECT) {
1029 set_fail_flag(FALSE);
1030 *err_info = CREATE_ERROR;
1031 } /* if */
1032 } /* if */
1033 logFunction(printf("create_return_object -->\n"););
1034 return new_object;
1035 } /* create_return_object */
1036
1037
1038
create_local_object(const_locObjType local,objectType init_value,errInfoType * err_info)1039 void create_local_object (const_locObjType local, objectType init_value,
1040 errInfoType *err_info)
1041
1042 {
1043 objectRecord call_object;
1044 listRecord call_list[4];
1045 objectType new_object;
1046 objectType call_result;
1047
1048 /* create_local_object */
1049 logFunction(printf("create_local_object(");
1050 trace1(local->object);
1051 printf(", ");
1052 trace1(init_value);
1053 printf(")\n"););
1054 if (local->create_call_obj == NULL) {
1055 *err_info = CREATE_ERROR;
1056 } else if (!ALLOC_OBJECT(new_object)) {
1057 *err_info = MEMORY_ERROR;
1058 } else {
1059 new_object->type_of = local->object->type_of;
1060 new_object->descriptor.property = NULL;
1061 if (VAR_OBJECT(local->object)) {
1062 INIT_CATEGORY_OF_VAR(new_object, DECLAREDOBJECT);
1063 } else {
1064 INIT_CATEGORY_OF_OBJ(new_object, DECLAREDOBJECT);
1065 } /* if */
1066
1067 call_object.type_of = NULL;
1068 call_object.descriptor.property = NULL;
1069 call_object.value.listValue = call_list;
1070 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
1071
1072 call_list[0].next = &call_list[1];
1073 call_list[1].next = &call_list[2];
1074 call_list[2].next = &call_list[3];
1075 call_list[3].next = NULL;
1076 call_list[0].obj = local->create_call_obj;
1077 call_list[1].obj = new_object;
1078 call_list[2].obj = SYS_CREA_OBJECT;
1079 call_list[3].obj = init_value;
1080
1081 /* printf("create_local_object: before exec_call\n");
1082 fflush(stdout); */
1083 call_result = exec_call(&call_object);
1084 /* printf("create_local_object: after exec_call\n");
1085 fflush(stdout); */
1086 if (call_result != SYS_EMPTY_OBJECT) {
1087 set_fail_flag(FALSE);
1088 *err_info = CREATE_ERROR;
1089 } /* if */
1090
1091 local->object->value.objValue = new_object;
1092 } /* if */
1093 logFunction(printf("create_local_object -->\n"););
1094 } /* create_local_object */
1095
1096
1097
destroy_local_object(const_locObjType local,boolType ignoreError)1098 void destroy_local_object (const_locObjType local, boolType ignoreError)
1099
1100 {
1101 objectRecord call_object;
1102 listRecord call_list[3];
1103 objectType call_result;
1104 boolType okay = TRUE;
1105
1106 /* destroy_local_object */
1107 logFunction(printf("destroy_local_object(");
1108 /* trace1(local->object); */
1109 printf(", %d)\n", ignoreError););
1110 if (local->object->value.objValue != NULL) {
1111 switch (CATEGORY_OF_OBJ(local->object->value.objValue)) {
1112 case INTOBJECT:
1113 case CHAROBJECT:
1114 case FLOATOBJECT:
1115 case REFOBJECT:
1116 case ACTOBJECT:
1117 case CONSTENUMOBJECT:
1118 case VARENUMOBJECT:
1119 case ENUMLITERALOBJECT:
1120 SET_UNUSED_FLAG(local->object->value.objValue);
1121 break;
1122 default:
1123 if (local->destroy_call_obj != NULL) {
1124 call_object.type_of = NULL;
1125 call_object.descriptor.property = NULL;
1126 call_object.value.listValue = call_list;
1127 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
1128
1129 call_list[0].next = &call_list[1];
1130 call_list[1].next = &call_list[2];
1131 call_list[2].next = NULL;
1132 call_list[0].obj = local->destroy_call_obj;
1133 call_list[1].obj = local->object->value.objValue;
1134 call_list[2].obj = SYS_DESTR_OBJECT;
1135
1136 /* printf("destroy_local_object: local->destroy_call_obj ");
1137 trace1(local->destroy_call_obj);
1138 printf("\n");
1139 printf("destroy_local_object: local->object ");
1140 trace1(local->object);
1141 printf("\n");
1142 printf("destroy_local_object: before exec_call ");
1143 trace1(&call_object);
1144 printf("\n");
1145 fflush(stdout); */
1146 call_result = exec_call(&call_object);
1147 /* printf("destroy_local_object: after exec_call\n");
1148 fflush(stdout); */
1149 if (unlikely(call_result != SYS_EMPTY_OBJECT)) {
1150 okay = FALSE;
1151 if (ignoreError) {
1152 leaveExceptionHandling();
1153 /* } else if (!fail_flag) {
1154 raise_error(DESTROY_ERROR); */
1155 } /* if */
1156 } /* if */
1157 } /* if */
1158 break;
1159 } /* switch */
1160 if (IS_UNUSED(local->object->value.objValue)) {
1161 FREE_OBJECT(local->object->value.objValue);
1162 } else if (unlikely(okay &&
1163 CATEGORY_OF_OBJ(local->object->value.objValue) != STRUCTOBJECT)) {
1164 printf("loc not dumped: ");
1165 trace1(local->object);
1166 printf("\n");
1167 trace1(local->object->value.objValue);
1168 printf("\n");
1169 } /* if */
1170 } /* if */
1171 logFunction(printf("destroy_local_object -->\n"););
1172 } /* destroy_local_object */
1173
1174
1175
destroy_local_init_value(const_locObjType local,errInfoType * err_info)1176 void destroy_local_init_value (const_locObjType local, errInfoType *err_info)
1177
1178 {
1179 objectRecord call_object;
1180 listRecord call_list[3];
1181 objectType call_result;
1182
1183 /* destroy_local_init_value */
1184 logFunction(printf("destroy_local_init_value(");
1185 /* trace1(local->object); */
1186 printf(")\n"););
1187 switch (CATEGORY_OF_OBJ(local->init_value)) {
1188 case INTOBJECT:
1189 case CHAROBJECT:
1190 case FLOATOBJECT:
1191 case REFOBJECT:
1192 case ACTOBJECT:
1193 case CONSTENUMOBJECT:
1194 case VARENUMOBJECT:
1195 case ENUMLITERALOBJECT:
1196 break;
1197 default:
1198 if (local->destroy_call_obj != NULL) {
1199 call_object.type_of = NULL;
1200 call_object.descriptor.property = NULL;
1201 call_object.value.listValue = call_list;
1202 INIT_CATEGORY_OF_OBJ(&call_object, CALLOBJECT);
1203
1204 call_list[0].next = &call_list[1];
1205 call_list[1].next = &call_list[2];
1206 call_list[2].next = NULL;
1207 call_list[0].obj = local->destroy_call_obj;
1208 call_list[1].obj = local->init_value;
1209 call_list[2].obj = SYS_DESTR_OBJECT;
1210
1211 /* printf("destroy_local_init_value: local->destroy_call_obj ");
1212 trace1(local->destroy_call_obj);
1213 printf("\n");
1214 printf("destroy_local_init_value: local->object ");
1215 trace1(local->object);
1216 printf("\n");
1217 printf("destroy_local_init_value: before exec_call ");
1218 trace1(&call_object);
1219 printf("\n");
1220 fflush(stdout); */
1221 call_result = exec_call(&call_object);
1222 /* printf("destroy_local_init_value: after exec_call\n");
1223 fflush(stdout); */
1224 if (call_result != SYS_EMPTY_OBJECT) {
1225 set_fail_flag(FALSE);
1226 *err_info = DESTROY_ERROR;
1227 } /* if */
1228 } else {
1229 *err_info = DESTROY_ERROR;
1230 } /* if */
1231 break;
1232 } /* switch */
1233 logFunction(printf("destroy_local_init_value -->\n"););
1234 } /* destroy_local_init_value */
1235
1236
1237
sct_elem_initialisation(typeType dest_type,objectType obj_to,objectType obj_from)1238 static boolType sct_elem_initialisation (typeType dest_type, objectType obj_to, objectType obj_from)
1239
1240 {
1241 errInfoType err_info = OKAY_NO_ERROR;
1242
1243 /* sct_elem_initialisation */
1244 memcpy(&obj_to->descriptor, &obj_from->descriptor, sizeof(descriptorUnion));
1245 INIT_CATEGORY_OF_VAR(obj_to, DECLAREDOBJECT);
1246 SET_ANY_FLAG(obj_to, HAS_POSINFO(obj_from));
1247 obj_to->type_of = dest_type;
1248 do_create(obj_to, obj_from, &err_info);
1249 return err_info == OKAY_NO_ERROR;
1250 } /* sct_elem_initialisation */
1251
1252
1253
destr_struct(objectType old_elem,memSizeType old_size)1254 void destr_struct (objectType old_elem, memSizeType old_size)
1255
1256 {
1257 memSizeType position;
1258 errInfoType err_info = OKAY_NO_ERROR;
1259
1260 /* destr_struct */
1261 logFunction(printf("destr_struct(" FMT_U_MEM ", " FMT_U_MEM ")\n",
1262 (memSizeType) old_elem, old_size););
1263 for (position = old_size; position > 0; position--) {
1264 switch (CATEGORY_OF_OBJ(old_elem)) {
1265 case INTOBJECT:
1266 case CHAROBJECT:
1267 case FLOATOBJECT:
1268 case REFOBJECT:
1269 case ACTOBJECT:
1270 case CONSTENUMOBJECT:
1271 case VARENUMOBJECT:
1272 case ENUMLITERALOBJECT:
1273 break;
1274 default:
1275 do_destroy(old_elem, &err_info);
1276 break;
1277 } /* switch */
1278 old_elem++;
1279 } /* for */
1280 } /* destr_struct */
1281
1282
1283
crea_struct(objectType elem_to,objectType elem_from,memSizeType new_size)1284 boolType crea_struct (objectType elem_to, objectType elem_from,
1285 memSizeType new_size)
1286
1287 {
1288 memSizeType position;
1289 boolType okay;
1290
1291 /* crea_struct */
1292 okay = TRUE;
1293 position = 0;
1294 while (position < new_size && okay) {
1295 if (!sct_elem_initialisation(elem_from[position].type_of, &elem_to[position], &elem_from[position])) {
1296 /* If a create fails (mostly no memory) all elements */
1297 /* created up to this point must be destroyed to recycle */
1298 /* the memory correct. */
1299 destr_struct(elem_to, position);
1300 okay = FALSE;
1301 } else {
1302 position++;
1303 } /* if */
1304 } /* for */
1305 return okay;
1306 } /* crea_struct */
1307
1308
1309
arr_elem_initialisation(typeType dest_type,objectType obj_to,objectType obj_from)1310 boolType arr_elem_initialisation (typeType dest_type, objectType obj_to, objectType obj_from)
1311
1312 {
1313 errInfoType err_info = OKAY_NO_ERROR;
1314
1315 /* arr_elem_initialisation */
1316 obj_to->descriptor.property = NULL;
1317 INIT_CATEGORY_OF_VAR(obj_to, DECLAREDOBJECT);
1318 SET_ANY_FLAG(obj_to, HAS_POSINFO(obj_from));
1319 obj_to->type_of = dest_type;
1320 do_create(obj_to, obj_from, &err_info);
1321 return err_info == OKAY_NO_ERROR;
1322 } /* arr_elem_initialisation */
1323
1324
1325
destr_array(objectType old_elem,memSizeType old_size)1326 void destr_array (objectType old_elem, memSizeType old_size)
1327
1328 {
1329 memSizeType position;
1330 errInfoType err_info = OKAY_NO_ERROR;
1331
1332 /* destr_array */
1333 for (position = old_size; position > 0; position--) {
1334 do_destroy(old_elem, &err_info);
1335 old_elem++;
1336 } /* for */
1337 } /* destr_array */
1338
1339
1340
crea_array(objectType elem_to,objectType elem_from,memSizeType new_size)1341 boolType crea_array (objectType elem_to, objectType elem_from,
1342 memSizeType new_size)
1343
1344 {
1345 memSizeType position;
1346 boolType okay;
1347
1348 /* crea_array */
1349 okay = TRUE;
1350 position = 0;
1351 while (position < new_size && okay) {
1352 if (!arr_elem_initialisation(elem_from[position].type_of, &elem_to[position], &elem_from[position])) {
1353 /* If a create fails (mostly no memory) all elements */
1354 /* created up to this point must be destroyed to recycle */
1355 /* the memory correct. */
1356 destr_array(elem_to, position);
1357 okay = FALSE;
1358 } else {
1359 position++;
1360 } /* if */
1361 } /* for */
1362 return okay;
1363 } /* crea_array */
1364
1365
1366
cpy_array(objectType elem_to,objectType elem_from,memSizeType new_size)1367 void cpy_array (objectType elem_to, objectType elem_from,
1368 memSizeType new_size)
1369
1370 {
1371 memSizeType position;
1372 errInfoType err_info = OKAY_NO_ERROR;
1373
1374 /* cpy_array */
1375 /* prot_cstri("cpy_array");
1376 prot_nl(); */
1377 for (position = new_size; position > 0; position--) {
1378 do_copy(elem_to, elem_from, &err_info);
1379 elem_to++;
1380 elem_from++;
1381 } /* for */
1382 } /* cpy_array */
1383