blob: a81c90b23a89ec126a09f78d2f1fdf375e3f9f23 [file] [log] [blame]
Guido van Rossum85a5fbb1990-10-14 12:07:46 +00001/* Functions used by cgen output */
2
3#include <stdio.h>
4
5#include "PROTO.h"
6#include "object.h"
7#include "intobject.h"
8#include "floatobject.h"
9#include "stringobject.h"
10#include "tupleobject.h"
11#include "listobject.h"
12#include "methodobject.h"
13#include "moduleobject.h"
14#include "modsupport.h"
15#include "import.h"
16#include "cgensupport.h"
17#include "errors.h"
18
19
20/* Functions to construct return values */
21
22object *
23mknewcharobject(c)
24 int c;
25{
26 char ch[1];
27 ch[0] = c;
28 return newsizedstringobject(ch, 1);
29}
30
31/* Functions to extract arguments.
32 These needs to know the total number of arguments supplied,
33 since the argument list is a tuple only of there is more than
34 one argument. */
35
36int
37getiobjectarg(args, nargs, i, p_arg)
38 register object *args;
39 int nargs, i;
40 object **p_arg;
41{
42 if (nargs != 1) {
43 if (args == NULL || !is_tupleobject(args) ||
44 nargs != gettuplesize(args) ||
45 i < 0 || i >= nargs) {
46 return err_badarg();
47 }
48 else {
49 args = gettupleitem(args, i);
50 }
51 }
52 if (args == NULL) {
53 return err_badarg();
54 }
55 *p_arg = args;
56 return 1;
57}
58
59int
60getilongarg(args, nargs, i, p_arg)
61 register object *args;
62 int nargs, i;
63 long *p_arg;
64{
65 if (nargs != 1) {
66 if (args == NULL || !is_tupleobject(args) ||
67 nargs != gettuplesize(args) ||
68 i < 0 || i >= nargs) {
69 return err_badarg();
70 }
71 args = gettupleitem(args, i);
72 }
73 if (args == NULL || !is_intobject(args)) {
74 return err_badarg();
75 }
76 *p_arg = getintvalue(args);
77 return 1;
78}
79
80int
81getishortarg(args, nargs, i, p_arg)
82 register object *args;
83 int nargs, i;
84 short *p_arg;
85{
86 long x;
87 if (!getilongarg(args, nargs, i, &x))
88 return 0;
89 *p_arg = x;
90 return 1;
91}
92
93static int
94extractdouble(v, p_arg)
95 register object *v;
96 double *p_arg;
97{
98 if (v == NULL) {
99 /* Fall through to error return at end of function */
100 }
101 else if (is_floatobject(v)) {
102 *p_arg = GETFLOATVALUE((floatobject *)v);
103 return 1;
104 }
105 else if (is_intobject(v)) {
106 *p_arg = GETINTVALUE((intobject *)v);
107 return 1;
108 }
109 return err_badarg();
110}
111
112static int
113extractfloat(v, p_arg)
114 register object *v;
115 float *p_arg;
116{
117 if (v == NULL) {
118 /* Fall through to error return at end of function */
119 }
120 else if (is_floatobject(v)) {
121 *p_arg = GETFLOATVALUE((floatobject *)v);
122 return 1;
123 }
124 else if (is_intobject(v)) {
125 *p_arg = GETINTVALUE((intobject *)v);
126 return 1;
127 }
128 return err_badarg();
129}
130
131int
132getifloatarg(args, nargs, i, p_arg)
133 register object *args;
134 int nargs, i;
135 float *p_arg;
136{
137 object *v;
138 float x;
139 if (!getiobjectarg(args, nargs, i, &v))
140 return 0;
141 if (!extractfloat(v, &x))
142 return 0;
143 *p_arg = x;
144 return 1;
145}
146
147int
148getistringarg(args, nargs, i, p_arg)
149 object *args;
150 int nargs, i;
151 string *p_arg;
152{
153 object *v;
154 if (!getiobjectarg(args, nargs, i, &v))
155 return NULL;
156 if (!is_stringobject(v)) {
157 return err_badarg();
158 }
159 *p_arg = getstringvalue(v);
160 return 1;
161}
162
163int
164getichararg(args, nargs, i, p_arg)
165 object *args;
166 int nargs, i;
167 char *p_arg;
168{
169 string x;
170 if (!getistringarg(args, nargs, i, &x))
171 return 0;
172 if (x[0] == '\0' || x[1] != '\0') {
173 /* Not exactly one char */
174 return err_badarg();
175 }
176 *p_arg = x[0];
177 return 1;
178}
179
180int
181getilongarraysize(args, nargs, i, p_arg)
182 object *args;
183 int nargs, i;
184 long *p_arg;
185{
186 object *v;
187 if (!getiobjectarg(args, nargs, i, &v))
188 return 0;
189 if (is_tupleobject(v)) {
190 *p_arg = gettuplesize(v);
191 return 1;
192 }
193 if (is_listobject(v)) {
194 *p_arg = getlistsize(v);
195 return 1;
196 }
197 return err_badarg();
198}
199
200int
201getishortarraysize(args, nargs, i, p_arg)
202 object *args;
203 int nargs, i;
204 short *p_arg;
205{
206 long x;
207 if (!getilongarraysize(args, nargs, i, &x))
208 return 0;
209 *p_arg = x;
210 return 1;
211}
212
213/* XXX The following four are too similar. Should share more code. */
214
215int
216getilongarray(args, nargs, i, n, p_arg)
217 object *args;
218 int nargs, i;
219 int n;
220 long *p_arg; /* [n] */
221{
222 object *v, *w;
223 if (!getiobjectarg(args, nargs, i, &v))
224 return 0;
225 if (is_tupleobject(v)) {
226 if (gettuplesize(v) != n) {
227 return err_badarg();
228 }
229 for (i = 0; i < n; i++) {
230 w = gettupleitem(v, i);
231 if (!is_intobject(w)) {
232 return err_badarg();
233 }
234 p_arg[i] = getintvalue(w);
235 }
236 return 1;
237 }
238 else if (is_listobject(v)) {
239 if (getlistsize(v) != n) {
240 return err_badarg();
241 }
242 for (i = 0; i < n; i++) {
243 w = getlistitem(v, i);
244 if (!is_intobject(w)) {
245 return err_badarg();
246 }
247 p_arg[i] = getintvalue(w);
248 }
249 return 1;
250 }
251 else {
252 return err_badarg();
253 }
254}
255
256int
257getishortarray(args, nargs, i, n, p_arg)
258 object *args;
259 int nargs, i;
260 int n;
261 short *p_arg; /* [n] */
262{
263 object *v, *w;
264 if (!getiobjectarg(args, nargs, i, &v))
265 return 0;
266 if (is_tupleobject(v)) {
267 if (gettuplesize(v) != n) {
268 return err_badarg();
269 }
270 for (i = 0; i < n; i++) {
271 w = gettupleitem(v, i);
272 if (!is_intobject(w)) {
273 return err_badarg();
274 }
275 p_arg[i] = getintvalue(w);
276 }
277 return 1;
278 }
279 else if (is_listobject(v)) {
280 if (getlistsize(v) != n) {
281 return err_badarg();
282 }
283 for (i = 0; i < n; i++) {
284 w = getlistitem(v, i);
285 if (!is_intobject(w)) {
286 return err_badarg();
287 }
288 p_arg[i] = getintvalue(w);
289 }
290 return 1;
291 }
292 else {
293 return err_badarg();
294 }
295}
296
297int
298getidoublearray(args, nargs, i, n, p_arg)
299 object *args;
300 int nargs, i;
301 int n;
302 double *p_arg; /* [n] */
303{
304 object *v, *w;
305 if (!getiobjectarg(args, nargs, i, &v))
306 return 0;
307 if (is_tupleobject(v)) {
308 if (gettuplesize(v) != n) {
309 return err_badarg();
310 }
311 for (i = 0; i < n; i++) {
312 w = gettupleitem(v, i);
313 if (!extractdouble(w, &p_arg[i]))
314 return 0;
315 }
316 return 1;
317 }
318 else if (is_listobject(v)) {
319 if (getlistsize(v) != n) {
320 return err_badarg();
321 }
322 for (i = 0; i < n; i++) {
323 w = getlistitem(v, i);
324 if (!extractdouble(w, &p_arg[i]))
325 return 0;
326 }
327 return 1;
328 }
329 else {
330 return err_badarg();
331 }
332}
333
334int
335getifloatarray(args, nargs, i, n, p_arg)
336 object *args;
337 int nargs, i;
338 int n;
339 float *p_arg; /* [n] */
340{
341 object *v, *w;
342 if (!getiobjectarg(args, nargs, i, &v))
343 return 0;
344 if (is_tupleobject(v)) {
345 if (gettuplesize(v) != n) {
346 return err_badarg();
347 }
348 for (i = 0; i < n; i++) {
349 w = gettupleitem(v, i);
350 if (!extractfloat(w, &p_arg[i]))
351 return 0;
352 }
353 return 1;
354 }
355 else if (is_listobject(v)) {
356 if (getlistsize(v) != n) {
357 return err_badarg();
358 }
359 for (i = 0; i < n; i++) {
360 w = getlistitem(v, i);
361 if (!extractfloat(w, &p_arg[i]))
362 return 0;
363 }
364 return 1;
365 }
366 else {
367 return err_badarg();
368 }
369}