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: Interpreter */
22 /* File: seed7/src/doany.c */
23 /* Changes: 1993, 1994, 2015 Thomas Mertes */
24 /* Content: Procedures to call several Seed7 functions from C. */
25 /* */
26 /* This File contains a set of do_.. functions that allow to */
27 /* call several Seed7-expressions from C. The expressions are */
28 /* interpreted with the same mechanism that is used to execute */
29 /* the MAIN program at runtime. The procedures are used during */
30 /* the analysation phase and during the execution phase. */
31 /* */
32 /********************************************************************/
33
34 #define LOG_FUNCTIONS 0
35 #define VERBOSE_EXCEPTIONS 0
36
37 #include "version.h"
38
39 #include "stdio.h"
40 #include "stdlib.h"
41 #include "string.h"
42
43 #include "common.h"
44 #include "sigutl.h"
45 #include "data.h"
46 #include "heaputl.h"
47 #include "striutl.h"
48 #include "flistutl.h"
49 #include "syvarutl.h"
50 #include "traceutl.h"
51 #include "objutl.h"
52 #include "runerr.h"
53 #include "exec.h"
54 #include "match.h"
55
56 #undef EXTERN
57 #define EXTERN
58 #include "doany.h"
59
60
61 static listRecord flush_expr[2];
62 static listRecord wrnl_expr[2];
63 static listRecord wrstri_expr[3];
64
65
66
exec1(listType list)67 objectType exec1 (listType list)
68
69 {
70 objectRecord expr_object;
71 objectType object;
72 objectType result;
73
74 /* exec1 */
75 logFunction(printf("exec1\n"););
76 #ifdef DEBUG_EXEC
77 printf("before matching\n");
78 trace1(list->obj);
79 printf("\n");
80 trace1(list->next->obj);
81 printf("\n");
82 trace1(list->next->next->obj);
83 printf("\n");
84 #endif
85 /* printf(".");
86 fflush(stdout); */
87 expr_object.type_of = take_type(SYS_EXPR_TYPE);
88 expr_object.descriptor.property = NULL;
89 expr_object.value.listValue = list;
90 INIT_CATEGORY_OF_OBJ(&expr_object, EXPROBJECT);
91 if ((object = match_expression(&expr_object)) != NULL) {
92 #ifdef DEBUG_EXEC
93 printf("before executing\n");
94 trace1(object);
95 printf("\n");
96 trace1(list->obj);
97 printf("\n");
98 trace1(list->next->obj);
99 printf("\n");
100 trace1(list->next->next->obj);
101 printf("\n");
102 if (CATEGORY_OF_OBJ(list->obj) == CALLOBJECT) {
103 trace1(list->obj);
104 printf("\n");
105 } /* if */
106 #endif
107 result = exec_call(object);
108 FREE_L_ELEM(object->value.listValue);
109 /* FREE_OBJECT(object) is not necessary, */
110 /* because object == &expr_object holds. */
111 } else {
112 result = NULL;
113 } /* if */
114 #ifdef DEBUG_EXEC
115 printf("after executing\n");
116 trace1(object);
117 printf("\n");
118 trace1(list->obj);
119 printf("\n");
120 trace1(list->next->obj);
121 printf("\n");
122 trace1(list->next->next->obj);
123 printf("\n");
124 #endif
125 logFunction(printf("exec1 -->\n"););
126 return result;
127 } /* exec1 */
128
129
130
do_flush(objectType outfile)131 boolType do_flush (objectType outfile)
132
133 {
134 progType outfileProg;
135 progType progBackup;
136 boolType result;
137
138 /* do_flush */
139 logFunction(printf("do_flush\n"););
140 outfileProg = outfile->type_of->owningProg;
141 progBackup = prog;
142 prog = outfileProg;
143 flush_expr[0].obj = outfile;
144 flush_expr[1].obj = SYS_FLUSH_OBJECT;
145 result = (boolType) (exec1(flush_expr) == SYS_EMPTY_OBJECT);
146 set_fail_flag(FALSE);
147 prog = progBackup;
148 logFunction(printf("do_flush -->\n"););
149 return result;
150 } /* do_flush */
151
152
153
do_wrnl(objectType outfile)154 boolType do_wrnl (objectType outfile)
155
156 {
157 progType outfileProg;
158 progType progBackup;
159 boolType result;
160
161 /* do_wrnl */
162 logFunction(printf("do_wrnl\n"););
163 outfileProg = outfile->type_of->owningProg;
164 progBackup = prog;
165 prog = outfileProg;
166 wrnl_expr[0].obj = outfile;
167 wrnl_expr[1].obj = SYS_WRLN_OBJECT;
168 result = (boolType) (exec1(wrnl_expr) == SYS_EMPTY_OBJECT);
169 set_fail_flag(FALSE);
170 prog = progBackup;
171 logFunction(printf("do_wrnl -->\n"););
172 return result;
173 } /* do_wrnl */
174
175
176
do_wrstri(objectType outfile,striType stri)177 boolType do_wrstri (objectType outfile, striType stri)
178
179 {
180 progType outfileProg;
181 progType progBackup;
182 objectType out_stri;
183 boolType result;
184
185 /* do_wrstri */
186 logFunction(printf("do_wrstri\n"););
187 outfileProg = outfile->type_of->owningProg;
188 progBackup = prog;
189 prog = outfileProg;
190 result = FALSE;
191 if ((out_stri = bld_stri_temp(stri)) != SYS_MEM_EXCEPTION) {
192 wrstri_expr[0].obj = outfile;
193 wrstri_expr[1].obj = out_stri;
194 wrstri_expr[2].obj = SYS_WRITE_OBJECT;
195 result = (boolType) (exec1(wrstri_expr) == SYS_EMPTY_OBJECT);
196 set_fail_flag(FALSE);
197 FREE_OBJECT(out_stri);
198 } /* if */
199 set_fail_flag(FALSE);
200 prog = progBackup;
201 logFunction(printf("do_wrstri -->\n"););
202 return result;
203 } /* do_wrstri */
204
205
206
do_wrcstri(objectType outfile,const_cstriType stri)207 boolType do_wrcstri (objectType outfile, const_cstriType stri)
208
209 {
210 striType out_stri;
211 boolType result;
212
213 /* do_wrcstri */
214 logFunction(printf("do_wrcstri\n"););
215 result = FALSE;
216 out_stri = cstri_to_stri(stri);
217 if (out_stri != NULL) {
218 result = do_wrstri(outfile, out_stri);
219 FREE_STRI(out_stri, out_stri->size);
220 } /* if */
221 logFunction(printf("do_wrcstri -->\n"););
222 return result;
223 } /* do_wrcstri */
224
225
226
init_do_any(void)227 void init_do_any (void)
228
229 { /* init_do_any */
230 logFunction(printf("init_do_any\n"););
231 flush_expr[0].next = &flush_expr[1];
232 flush_expr[1].next = NULL;
233 wrnl_expr[0].next = &wrnl_expr[1];
234 wrnl_expr[1].next = NULL;
235 wrstri_expr[0].next = &wrstri_expr[1];
236 wrstri_expr[1].next = &wrstri_expr[2];
237 wrstri_expr[2].next = NULL;
238 logFunction(printf("init_do_any -->\n"););
239 } /* init_do_any */
240