1 /********************************************************************/
2 /*                                                                  */
3 /*  s7   Seed7 interpreter                                          */
4 /*  Copyright (C) 1990 - 2005, 2011, 2013 - 2015  Thomas Mertes     */
5 /*                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: Runtime                                                 */
23 /*  File: seed7/src/objutl.c                                        */
24 /*  Changes: 1992 - 1994, 2011, 2013 - 2015, 2021  Thomas Mertes    */
25 /*  Content: isit_.. and bld_.. functions for primitive data types. */
26 /*                                                                  */
27 /********************************************************************/
28 
29 #include "version.h"
30 
31 #include "stdlib.h"
32 #include "stdio.h"
33 #include "string.h"
34 
35 #include "common.h"
36 #include "sigutl.h"
37 #include "data.h"
38 #include "data_rtl.h"
39 #include "heaputl.h"
40 #include "flistutl.h"
41 #include "syvarutl.h"
42 #include "listutl.h"
43 #include "traceutl.h"
44 #include "executl.h"
45 #include "blockutl.h"
46 #include "identutl.h"
47 #include "entutl.h"
48 #include "name.h"
49 #include "runerr.h"
50 #include "exec.h"
51 #include "prg_comp.h"
52 #include "typ_data.h"
53 #include "big_drv.h"
54 #include "drw_drv.h"
55 #include "pcs_drv.h"
56 #include "pol_drv.h"
57 #include "fil_rtl.h"
58 #if WITH_SQL
59 #include "sql_rtl.h"
60 #endif
61 
62 #undef EXTERN
63 #define EXTERN
64 #define DO_INIT
65 #include "objutl.h"
66 
67 
68 
69 #ifdef OUT_OF_ORDER
isit_bool(objectType argument)70 void isit_bool (objectType argument)
71 
72   {
73     objectType arg;
74 
75   /* isit_bool */
76     if (CATEGORY_OF_OBJ(argument) == CONSTENUMOBJECT ||
77         CATEGORY_OF_OBJ(argument) == VARENUMOBJECT) {
78       arg = argument->value.objValue;
79     } else {
80       arg = argument;
81     } /* if */
82     if (arg != SYS_TRUE_OBJECT &&
83         arg != SYS_FALSE_OBJECT) {
84       printf("\n-----------\n");
85       trace1(argument);
86       printf("\n-----------\n");
87       trace1(arg);
88       printf("\n-----------\n");
89       run_error(ENUMLITERALOBJECT, argument);
90     } /* if */
91   } /* isit_bool */
92 #endif
93 
94 
95 
96 #if WITH_TYPE_CHECK
isit_enum(objectType argument)97 void isit_enum (objectType argument)
98 
99   { /* isit_enum */
100     if ((CATEGORY_OF_OBJ(argument) != ENUMLITERALOBJECT &&
101         CATEGORY_OF_OBJ(argument) != CONSTENUMOBJECT &&
102         CATEGORY_OF_OBJ(argument) != VARENUMOBJECT)) {
103       run_error(CONSTENUMOBJECT, argument);
104     } /* if */
105   } /* isit_enum */
106 
107 
108 
isit_list(objectType argument)109 void isit_list (objectType argument)
110 
111   { /* isit_list */
112     if (CATEGORY_OF_OBJ(argument) != LISTOBJECT &&
113         CATEGORY_OF_OBJ(argument) != EXPROBJECT) {
114       run_error(LISTOBJECT, argument);
115     } /* if */
116   } /* isit_list */
117 #endif
118 
119 
120 
bld_action_temp(actType temp_action)121 objectType bld_action_temp (actType temp_action)
122 
123   {
124     register objectType result;
125 
126   /* bld_action_temp */
127     if (ALLOC_OBJECT(result)) {
128       result->type_of = NULL;
129       result->descriptor.property = NULL;
130       INIT_CATEGORY_OF_TEMP(result, ACTOBJECT);
131       result->value.actValue = temp_action;
132       return result;
133     } else {
134       return raise_exception(SYS_MEM_EXCEPTION);
135     } /* if */
136   } /* bld_action_temp */
137 
138 
139 
bld_array_temp(arrayType temp_array)140 objectType bld_array_temp (arrayType temp_array)
141 
142   {
143     register objectType result;
144 
145   /* bld_array_temp */
146     if (ALLOC_OBJECT(result)) {
147       result->type_of = NULL;
148       result->descriptor.property = NULL;
149       INIT_CATEGORY_OF_TEMP(result, ARRAYOBJECT);
150       result->value.arrayValue = temp_array;
151       return result;
152     } else {
153       return raise_exception(SYS_MEM_EXCEPTION);
154     } /* if */
155   } /* bld_array_temp */
156 
157 
158 
bld_bigint_temp(bigIntType temp_bigint)159 objectType bld_bigint_temp (bigIntType temp_bigint)
160 
161   {
162     register objectType result;
163 
164   /* bld_bigint_temp */
165     if (ALLOC_OBJECT(result)) {
166       result->type_of = NULL;
167       result->descriptor.property = NULL;
168       INIT_CATEGORY_OF_TEMP(result, BIGINTOBJECT);
169       result->value.bigIntValue = temp_bigint;
170       return result;
171     } else {
172       return raise_exception(SYS_MEM_EXCEPTION);
173     } /* if */
174   } /* bld_bigint_temp */
175 
176 
177 
bld_binary_temp(uintType temp_binary)178 objectType bld_binary_temp (uintType temp_binary)
179 
180   {
181     register objectType result;
182 
183   /* bld_binary_temp */
184     if (ALLOC_OBJECT(result)) {
185       result->type_of = NULL;
186       result->descriptor.property = NULL;
187       INIT_CATEGORY_OF_TEMP(result, INTOBJECT);
188       result->value.binaryValue = temp_binary;
189       return result;
190     } else {
191       return raise_exception(SYS_MEM_EXCEPTION);
192     } /* if */
193   } /* bld_binary_temp */
194 
195 
196 
bld_block_temp(blockType temp_block)197 objectType bld_block_temp (blockType temp_block)
198 
199   {
200     register objectType result;
201 
202   /* bld_block_temp */
203     if (ALLOC_OBJECT(result)) {
204       result->type_of = NULL;
205       result->descriptor.property = NULL;
206       INIT_CATEGORY_OF_TEMP(result, BLOCKOBJECT);
207       result->value.blockValue = temp_block;
208       return result;
209     } else {
210       return raise_exception(SYS_MEM_EXCEPTION);
211     } /* if */
212   } /* bld_block_temp */
213 
214 
215 
bld_bstri_temp(bstriType temp_bstri)216 objectType bld_bstri_temp (bstriType temp_bstri)
217 
218   {
219     register objectType result;
220 
221   /* bld_bstri_temp */
222     if (ALLOC_OBJECT(result)) {
223       result->type_of = NULL;
224       result->descriptor.property = NULL;
225       INIT_CATEGORY_OF_TEMP(result, BSTRIOBJECT);
226       result->value.bstriValue = temp_bstri;
227       return result;
228     } else {
229       return raise_exception(SYS_MEM_EXCEPTION);
230     } /* if */
231   } /* bld_bstri_temp */
232 
233 
234 
bld_char_temp(charType temp_char)235 objectType bld_char_temp (charType temp_char)
236 
237   {
238     register objectType result;
239 
240   /* bld_char_temp */
241     if (ALLOC_OBJECT(result)) {
242       result->type_of = NULL;
243       result->descriptor.property = NULL;
244       INIT_CATEGORY_OF_TEMP(result, CHAROBJECT);
245       result->value.charValue = temp_char;
246       return result;
247     } else {
248       return raise_exception(SYS_MEM_EXCEPTION);
249     } /* if */
250   } /* bld_char_temp */
251 
252 
253 
bld_database_temp(databaseType temp_database)254 objectType bld_database_temp (databaseType temp_database)
255 
256   {
257     register objectType result;
258 
259   /* bld_database_temp */
260     if (ALLOC_OBJECT(result)) {
261       result->type_of = NULL;
262       result->descriptor.property = NULL;
263       INIT_CATEGORY_OF_TEMP(result, DATABASEOBJECT);
264       result->value.databaseValue = temp_database;
265       return result;
266     } else {
267       return raise_exception(SYS_MEM_EXCEPTION);
268     } /* if */
269   } /* bld_database_temp */
270 
271 
272 
bld_interface_temp(objectType temp_interface)273 objectType bld_interface_temp (objectType temp_interface)
274 
275   {
276     register objectType result;
277 
278   /* bld_interface_temp */
279     if (ALLOC_OBJECT(result)) {
280       result->type_of = NULL;
281       result->descriptor.property = NULL;
282       INIT_CATEGORY_OF_TEMP(result, INTERFACEOBJECT);
283       result->value.objValue = temp_interface;
284       return result;
285     } else {
286       return raise_exception(SYS_MEM_EXCEPTION);
287     } /* if */
288   } /* bld_interface_temp */
289 
290 
291 
bld_file_temp(fileType temp_file)292 objectType bld_file_temp (fileType temp_file)
293 
294   {
295     register objectType result;
296 
297   /* bld_file_temp */
298     if (ALLOC_OBJECT(result)) {
299       result->type_of = NULL;
300       result->descriptor.property = NULL;
301       INIT_CATEGORY_OF_TEMP(result, FILEOBJECT);
302       result->value.fileValue = temp_file;
303       return result;
304     } else {
305       return raise_exception(SYS_MEM_EXCEPTION);
306     } /* if */
307   } /* bld_file_temp */
308 
309 
310 
bld_float_temp(double temp_float)311 objectType bld_float_temp (double temp_float)
312 
313   {
314     register objectType result;
315 
316   /* bld_float_temp */
317     if (ALLOC_OBJECT(result)) {
318       result->type_of = NULL;
319       result->descriptor.property = NULL;
320       INIT_CATEGORY_OF_TEMP(result, FLOATOBJECT);
321       result->value.floatValue = (floatType) temp_float;
322       return result;
323     } else {
324       return raise_exception(SYS_MEM_EXCEPTION);
325     } /* if */
326   } /* bld_float_temp */
327 
328 
329 
bld_hash_temp(hashType temp_hash)330 objectType bld_hash_temp (hashType temp_hash)
331 
332   {
333     register objectType result;
334 
335   /* bld_hash_temp */
336     if (ALLOC_OBJECT(result)) {
337       result->type_of = NULL;
338       result->descriptor.property = NULL;
339       INIT_CATEGORY_OF_TEMP(result, HASHOBJECT);
340       result->value.hashValue = temp_hash;
341       return result;
342     } else {
343       return raise_exception(SYS_MEM_EXCEPTION);
344     } /* if */
345   } /* bld_hash_temp */
346 
347 
348 
bld_int_temp(intType temp_int)349 objectType bld_int_temp (intType temp_int)
350 
351   {
352     register objectType result;
353 
354   /* bld_int_temp */
355     if (ALLOC_OBJECT(result)) {
356       result->type_of = NULL;
357       result->descriptor.property = NULL;
358       INIT_CATEGORY_OF_TEMP(result, INTOBJECT);
359       result->value.intValue = temp_int;
360       return result;
361     } else {
362       return raise_exception(SYS_MEM_EXCEPTION);
363     } /* if */
364   } /* bld_int_temp */
365 
366 
367 
bld_list_temp(listType temp_list)368 objectType bld_list_temp (listType temp_list)
369 
370   {
371     register objectType result;
372 
373   /* bld_list_temp */
374     if (ALLOC_OBJECT(result)) {
375       result->type_of = NULL;
376       result->descriptor.property = NULL;
377       INIT_CATEGORY_OF_TEMP(result, LISTOBJECT);
378       result->value.listValue = temp_list;
379       return result;
380     } else {
381       return raise_exception(SYS_MEM_EXCEPTION);
382     } /* if */
383   } /* bld_list_temp */
384 
385 
386 
bld_param_temp(objectType temp_param)387 objectType bld_param_temp (objectType temp_param)
388 
389   {
390     register objectType result;
391 
392   /* bld_param_temp */
393     if (ALLOC_OBJECT(result)) {
394       result->type_of = NULL;
395       result->descriptor.property = NULL;
396       INIT_CATEGORY_OF_TEMP(result, FORMPARAMOBJECT);
397       result->value.objValue = temp_param;
398       return result;
399     } else {
400       return raise_exception(SYS_MEM_EXCEPTION);
401     } /* if */
402   } /* bld_param_temp */
403 
404 
405 
bld_poll_temp(pollType temp_poll)406 objectType bld_poll_temp (pollType temp_poll)
407 
408   {
409     register objectType result;
410 
411   /* bld_poll_temp */
412     if (ALLOC_OBJECT(result)) {
413       result->type_of = NULL;
414       result->descriptor.property = NULL;
415       INIT_CATEGORY_OF_TEMP(result, POLLOBJECT);
416       result->value.pollValue = temp_poll;
417       return result;
418     } else {
419       return raise_exception(SYS_MEM_EXCEPTION);
420     } /* if */
421   } /* bld_poll_temp */
422 
423 
424 
bld_prog_temp(progType temp_prog)425 objectType bld_prog_temp (progType temp_prog)
426 
427   {
428     register objectType result;
429 
430   /* bld_prog_temp */
431     if (ALLOC_OBJECT(result)) {
432       result->type_of = NULL;
433       result->descriptor.property = NULL;
434       INIT_CATEGORY_OF_TEMP(result, PROGOBJECT);
435       result->value.progValue = temp_prog;
436       return result;
437     } else {
438       return raise_exception(SYS_MEM_EXCEPTION);
439     } /* if */
440   } /* bld_prog_temp */
441 
442 
443 
bld_reference_temp(objectType temp_reference)444 objectType bld_reference_temp (objectType temp_reference)
445 
446   {
447     register objectType result;
448 
449   /* bld_reference_temp */
450     if (ALLOC_OBJECT(result)) {
451       result->type_of = NULL;
452       result->descriptor.property = NULL;
453       INIT_CATEGORY_OF_TEMP(result, REFOBJECT);
454       result->value.objValue = temp_reference;
455       return result;
456     } else {
457       return raise_exception(SYS_MEM_EXCEPTION);
458     } /* if */
459   } /* bld_reference_temp */
460 
461 
462 
bld_reflist_temp(listType temp_reflist)463 objectType bld_reflist_temp (listType temp_reflist)
464 
465   {
466     register objectType result;
467 
468   /* bld_reflist_temp */
469     if (ALLOC_OBJECT(result)) {
470       result->type_of = NULL;
471       result->descriptor.property = NULL;
472       INIT_CATEGORY_OF_TEMP(result, REFLISTOBJECT);
473       result->value.listValue = temp_reflist;
474       return result;
475     } else {
476       return raise_exception(SYS_MEM_EXCEPTION);
477     } /* if */
478   } /* bld_reflist_temp */
479 
480 
481 
bld_set_temp(setType temp_set)482 objectType bld_set_temp (setType temp_set)
483 
484   {
485     register objectType result;
486 
487   /* bld_set_temp */
488     if (ALLOC_OBJECT(result)) {
489       result->type_of = NULL;
490       result->descriptor.property = NULL;
491       INIT_CATEGORY_OF_TEMP(result, SETOBJECT);
492       result->value.setValue = temp_set;
493       return result;
494     } else {
495       return raise_exception(SYS_MEM_EXCEPTION);
496     } /* if */
497   } /* bld_set_temp */
498 
499 
500 
bld_socket_temp(socketType temp_socket)501 objectType bld_socket_temp (socketType temp_socket)
502 
503   {
504     register objectType result;
505 
506   /* bld_socket_temp */
507     if (ALLOC_OBJECT(result)) {
508       result->type_of = NULL;
509       result->descriptor.property = NULL;
510       INIT_CATEGORY_OF_TEMP(result, SOCKETOBJECT);
511       result->value.socketValue = temp_socket;
512       return result;
513     } else {
514       return raise_exception(SYS_MEM_EXCEPTION);
515     } /* if */
516   } /* bld_socket_temp */
517 
518 
519 
bld_sqlstmt_temp(sqlStmtType temp_sqlstmt)520 objectType bld_sqlstmt_temp (sqlStmtType temp_sqlstmt)
521 
522   {
523     register objectType result;
524 
525   /* bld_sqlstmt_temp */
526     if (ALLOC_OBJECT(result)) {
527       result->type_of = NULL;
528       result->descriptor.property = NULL;
529       INIT_CATEGORY_OF_TEMP(result, SQLSTMTOBJECT);
530       result->value.sqlStmtValue = temp_sqlstmt;
531       return result;
532     } else {
533       return raise_exception(SYS_MEM_EXCEPTION);
534     } /* if */
535   } /* bld_sqlstmt_temp */
536 
537 
538 
bld_stri_temp(striType temp_stri)539 objectType bld_stri_temp (striType temp_stri)
540 
541   {
542     register objectType result;
543 
544   /* bld_stri_temp */
545     if (ALLOC_OBJECT(result)) {
546       result->type_of = NULL;
547       result->descriptor.property = NULL;
548       INIT_CATEGORY_OF_TEMP(result, STRIOBJECT);
549       result->value.striValue = temp_stri;
550       return result;
551     } else {
552       return raise_exception(SYS_MEM_EXCEPTION);
553     } /* if */
554   } /* bld_stri_temp */
555 
556 
557 
bld_struct_temp(structType temp_struct)558 objectType bld_struct_temp (structType temp_struct)
559 
560   {
561     register objectType result;
562 
563   /* bld_struct_temp */
564     if (ALLOC_OBJECT(result)) {
565       result->type_of = NULL;
566       result->descriptor.property = NULL;
567       INIT_CATEGORY_OF_TEMP(result, STRUCTOBJECT);
568       result->value.structValue = temp_struct;
569       return result;
570     } else {
571       return raise_exception(SYS_MEM_EXCEPTION);
572     } /* if */
573   } /* bld_struct_temp */
574 
575 
576 
bld_type_temp(typeType temp_type)577 objectType bld_type_temp (typeType temp_type)
578 
579   {
580     register objectType result;
581 
582   /* bld_type_temp */
583     result = temp_type->match_obj;
584     return result;
585   } /* bld_type_temp */
586 
587 
588 
bld_win_temp(winType temp_win)589 objectType bld_win_temp (winType temp_win)
590 
591   {
592     register objectType result;
593 
594   /* bld_win_temp */
595     if (ALLOC_OBJECT(result)) {
596       result->type_of = NULL;
597       result->descriptor.property = NULL;
598       INIT_CATEGORY_OF_TEMP(result, WINOBJECT);
599       result->value.winValue = temp_win;
600       return result;
601     } else {
602       return raise_exception(SYS_MEM_EXCEPTION);
603     } /* if */
604   } /* bld_win_temp */
605 
606 
607 
bld_process_temp(processType temp_process)608 objectType bld_process_temp (processType temp_process)
609 
610   {
611     register objectType result;
612 
613   /* bld_process_temp */
614     if (ALLOC_OBJECT(result)) {
615       result->type_of = NULL;
616       result->descriptor.property = NULL;
617       INIT_CATEGORY_OF_TEMP(result, PROCESSOBJECT);
618       result->value.processValue = temp_process;
619       return result;
620     } else {
621       return raise_exception(SYS_MEM_EXCEPTION);
622     } /* if */
623   } /* bld_process_temp */
624 
625 
626 
dump_temp_value(objectType object)627 void dump_temp_value (objectType object)
628 
629   {
630     boolType save_interrupt_flag;
631     boolType save_fail_flag;
632     errInfoType err_info = OKAY_NO_ERROR;
633 
634   /* dump_temp_value */
635 #ifdef TRACE_DUMP_TEMP_VALUE
636     if (trace.actions) {
637       prot_heapsize();
638       prot_cstri(" ");
639       prot_cstri("dump_temp_value ");
640       printcategory(CATEGORY_OF_OBJ(object));
641       prot_cstri(" ");
642       prot_int((intType) object);
643       prot_cstri(" ");
644       trace1(object);
645       prot_nl();
646     } /* if */
647 #endif
648     save_interrupt_flag = interrupt_flag;
649     save_fail_flag = fail_flag;
650     set_fail_flag(FALSE);
651     switch (CATEGORY_OF_OBJ(object)) {
652       case INTOBJECT:
653       case CHAROBJECT:
654       case SOCKETOBJECT:
655       case FLOATOBJECT:
656       case REFOBJECT:
657       case ACTOBJECT:
658       case CONSTENUMOBJECT:
659       case VARENUMOBJECT:
660       case ENUMLITERALOBJECT:
661       case MATCHOBJECT:
662       case FWDREFOBJECT:
663       case TYPEOBJECT:
664       case DECLAREDOBJECT:
665       case FORWARDOBJECT:
666         SET_UNUSED_FLAG(object);
667         break;
668       case FILEOBJECT:
669         filDestr(object->value.fileValue);
670         SET_UNUSED_FLAG(object);
671         break;
672       case BIGINTOBJECT:
673         bigDestr(object->value.bigIntValue);
674         SET_UNUSED_FLAG(object);
675         break;
676       case STRIOBJECT:
677         if (object->value.striValue != NULL) {
678           FREE_STRI(object->value.striValue, object->value.striValue->size);
679         } /* if */
680         SET_UNUSED_FLAG(object);
681         break;
682       case BSTRIOBJECT:
683         if (object->value.bstriValue != NULL) {
684           FREE_BSTRI(object->value.bstriValue, object->value.bstriValue->size);
685         } /* if */
686         SET_UNUSED_FLAG(object);
687         break;
688       case SETOBJECT:
689         if (object->value.setValue != NULL) {
690           FREE_SET(object->value.setValue,
691               (memSizeType) (object->value.setValue->max_position -
692               object->value.setValue->min_position + 1));
693         } /* if */
694         SET_UNUSED_FLAG(object);
695         break;
696       case ARRAYOBJECT:
697         if (object->value.arrayValue != NULL) {
698 #ifdef TRACE_DUMP_TEMP_VALUE
699           if (trace.actions) {
700             prot_cstri("before do_destroy: ");
701             trace1(object);
702             prot_nl();
703           } /* if */
704 #endif
705           CLEAR_TEMP_FLAG(object);
706           do_destroy(object, &err_info);
707         } else {
708           SET_UNUSED_FLAG(object);
709         } /* if */
710         break;
711       case HASHOBJECT:
712         if (object->value.hashValue != NULL) {
713 #ifdef TRACE_DUMP_TEMP_VALUE
714           if (trace.actions) {
715             prot_cstri("before do_destroy: ");
716             trace1(object);
717             prot_nl();
718           } /* if */
719 #endif
720           CLEAR_TEMP_FLAG(object);
721           do_destroy(object, &err_info);
722         } else {
723           SET_UNUSED_FLAG(object);
724         } /* if */
725         break;
726       case STRUCTOBJECT:
727         if (object->value.structValue != NULL) {
728 #ifdef TRACE_DUMP_TEMP_VALUE
729           if (trace.actions) {
730             prot_cstri("before do_destroy: ");
731             trace1(object);
732             prot_nl();
733           } /* if */
734 #endif
735           CLEAR_TEMP_FLAG(object);
736           do_destroy(object, &err_info);
737         } else {
738           SET_UNUSED_FLAG(object);
739         } /* if */
740         break;
741       case POLLOBJECT:
742         polDestr(object->value.pollValue);
743         SET_UNUSED_FLAG(object);
744         break;
745       case REFLISTOBJECT:
746         free_list(object->value.listValue);
747         SET_UNUSED_FLAG(object);
748         break;
749       case LISTOBJECT:
750         free_list(object->value.listValue);
751         SET_UNUSED_FLAG(object);
752         break;
753       case BLOCKOBJECT:
754         if (object->value.blockValue != NULL) {
755           /* printf("free_block: ");
756           trace1(object);
757           printf("\n"); */
758           free_block(object->value.blockValue);
759         } /* if */
760         SET_UNUSED_FLAG(object);
761         break;
762       case PROGOBJECT:
763         prgDestr(object->value.progValue);
764         SET_UNUSED_FLAG(object);
765         break;
766       case WINOBJECT:
767         if (object->value.winValue != NULL &&
768             object->value.winValue->usage_count != 0) {
769           object->value.winValue->usage_count--;
770           if (object->value.winValue->usage_count == 0) {
771             drwFree(object->value.winValue);
772           } /* if */
773         } /* if */
774         SET_UNUSED_FLAG(object);
775         break;
776       case PROCESSOBJECT:
777         if (object->value.processValue != NULL) {
778           object->value.processValue->usage_count--;
779           if (object->value.processValue->usage_count == 0) {
780             pcsFree(object->value.processValue);
781           } /* if */
782         } /* if */
783         SET_UNUSED_FLAG(object);
784         break;
785       case INTERFACEOBJECT:
786         if (object->value.objValue != NULL) {
787 #ifdef TRACE_DUMP_TEMP_VALUE
788           if (trace.actions) {
789             prot_cstri("before do_destroy: ");
790             trace1(object);
791             prot_nl();
792           } /* if */
793 #endif
794           CLEAR_TEMP_FLAG(object);
795           do_destroy(object, &err_info);
796         } /* if */
797         break;
798 #if WITH_SQL
799       case DATABASEOBJECT:
800         sqlDestrDb(object->value.databaseValue);
801         SET_UNUSED_FLAG(object);
802         break;
803       case SQLSTMTOBJECT:
804         sqlDestrStmt(object->value.sqlStmtValue);
805         SET_UNUSED_FLAG(object);
806         break;
807 #endif
808       default:
809         if (trace.heapsize) {
810           prot_heapsize();
811           prot_cstri(" ");
812         } /* if */
813         prot_cstri("dump_temp_value ");
814         /* prot_int((intType) CATEGORY_OF_OBJ(object)); */
815         /* prot_int((intType) object);
816         printf("%lx", object);
817         prot_cstri(" "); */
818         trace1(object);
819         prot_nl();
820         /* CLEAR_TEMP_FLAG(object);
821         do_destroy(object, &err_info); */
822         break;
823     } /* switch */
824     interrupt_flag |= save_interrupt_flag;
825     fail_flag |= save_fail_flag;
826     /* if (!fail_flag && err_info != OKAY_NO_ERROR) {
827       raise_error(err_info);
828     } * if */
829 #ifdef TRACE_DUMP_TEMP_VALUE
830     if (trace.actions) {
831       prot_heapsize();
832       prot_cstri(" end dump_temp_value ");
833       prot_nl();
834     } /* if */
835 #endif
836   } /* dump_temp_value */
837 
838 
839 
dump_any_temp(objectType object)840 void dump_any_temp (objectType object)
841 
842   { /* dump_any_temp */
843     dump_temp_value(object);
844     if (IS_UNUSED(object)) {
845       FREE_OBJECT(object);
846     } else if (CATEGORY_OF_OBJ(object) != STRUCTOBJECT) {
847       printf("not dumped: ");
848       trace1(object);
849       printf("\n");
850     } /* if */
851   } /* dump_any_temp */
852 
853 
854 
dump_list(listType list)855 void dump_list (listType list)
856 
857   {
858     register listType list_end;
859 
860   /* dump_list */
861     if (list != NULL) {
862       list_end = list;
863       while (list_end->next != NULL) {
864         dump_any_temp(list_end->obj);
865         list_end = list_end->next;
866       } /* while */
867       dump_any_temp(list_end->obj);
868       free_list2(list, list_end);
869     } /* if */
870   } /* dump_list */
871