1 /********************************************************************/
2 /* */
3 /* itf_rtl.c Primitive actions for the interface type. */
4 /* Copyright (C) 1989 - 2012 Thomas Mertes */
5 /* */
6 /* This file is part of the Seed7 Runtime Library. */
7 /* */
8 /* The Seed7 Runtime Library is free software; you can */
9 /* redistribute it and/or modify it under the terms of the GNU */
10 /* Lesser General Public License as published by the Free Software */
11 /* Foundation; either version 2.1 of the License, or (at your */
12 /* option) any later version. */
13 /* */
14 /* The Seed7 Runtime Library is distributed in the hope that it */
15 /* will be useful, but WITHOUT ANY WARRANTY; without even the */
16 /* implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR */
17 /* PURPOSE. See the GNU Lesser General Public License for more */
18 /* details. */
19 /* */
20 /* You should have received a copy of the GNU Lesser General */
21 /* Public License along with this program; if not, write to the */
22 /* Free Software Foundation, Inc., 51 Franklin Street, */
23 /* Fifth Floor, Boston, MA 02110-1301, USA. */
24 /* */
25 /* Module: Seed7 Runtime Library */
26 /* File: seed7/src/itf_rtl.c */
27 /* Changes: 2012 Thomas Mertes */
28 /* Content: Primitive actions for the interface type. */
29 /* */
30 /********************************************************************/
31
32 #include "version.h"
33
34 #include "stdlib.h"
35 #include "stdio.h"
36
37 #include "common.h"
38 #include "data_rtl.h"
39 #include "heaputl.h"
40 #include "rtl_err.h"
41
42 #undef EXTERN
43 #define EXTERN
44 #include "itf_rtl.h"
45
46
47
48 /**
49 * Return a copy of source, that can be assigned to a new destination.
50 * It is assumed that the destination of the assignment is undefined.
51 * Create functions can be used to initialize Seed7 constants.
52 * @return a copy of source.
53 */
itfCreate(const rtlInterfaceType source)54 rtlInterfaceType itfCreate (const rtlInterfaceType source)
55
56 { /* itfCreate */
57 if (source->usage_count != 0) {
58 source->usage_count++;
59 } /* if */
60 return source;
61 } /* itfCreate */
62
63
64
65 /**
66 * Generic Create function to be used via function pointers.
67 * Function pointers in C programs generated by the Seed7 compiler
68 * may point to this function. This assures correct behaviour even
69 * if sizeof(genericType) != sizeof(rtlInterfaceType).
70 */
itfCreateGeneric(const genericType from_value)71 genericType itfCreateGeneric (const genericType from_value)
72
73 {
74 rtlObjectType result;
75
76 /* itfCreateGeneric */
77 INIT_GENERIC_PTR(result.value.genericValue);
78 result.value.interfaceValue =
79 itfCreate(((const_rtlObjectType *) &from_value)->value.interfaceValue);
80 return result.value.genericValue;
81 } /* itfCreateGeneric */
82
83
84
85 #ifdef OUT_OF_ORDER
itfToHeap(listType arguments)86 objectType itfToHeap (listType arguments)
87
88 {
89 objectType modu_from;
90 objectType result;
91
92 /* itfToHeap */
93 modu_from = arg_1(arguments);
94 printf("itfToHeap: ");
95 trace1(modu_from);
96 printf("\n");
97 if (CATEGORY_OF_OBJ(modu_from) == INTERFACEOBJECT) {
98 result = take_reference(modu_from);
99 } else if (CATEGORY_OF_OBJ(modu_from) == STRUCTOBJECT) {
100 if (TEMP2_OBJECT(modu_from)) {
101 if (!ALLOC_OBJECT(result)) {
102 return raise_exception(SYS_MEM_EXCEPTION);
103 } else {
104 memcpy(result, modu_from, sizeof(objectRecord));
105 CLEAR_TEMP2_FLAG(result);
106 result->value.structValue = take_struct(modu_from);
107 modu_from->value.structValue = NULL;
108 } /* if */
109 } else {
110 result = modu_from;
111 } /* if */
112 } else {
113 return raise_exception(SYS_RNG_EXCEPTION);
114 } /* if */
115 result = bld_interface_temp(result);
116 printf("itfToHeap --> ");
117 trace1(result);
118 printf("\n");
119 return result;
120 } /* itfToHeap */
121 #endif
122
123
124
itfToInterface(rtlStructType * stru_arg)125 rtlInterfaceType itfToInterface (rtlStructType *stru_arg)
126
127 {
128 rtlInterfaceType result;
129
130 /* itfToInterface */
131 result = *stru_arg;
132 *stru_arg = NULL;
133 return result;
134 } /* itfToInterface */
135