blob: 87fcfabe6873c675e66f6694eeadd3c19e922ddd [file] [log] [blame]
Guido van Rossumf70e43a1991-02-19 12:39:46 +00001/***********************************************************
Guido van Rossum9bfef441993-03-29 10:43:31 +00002Copyright 1991, 1992, 1993 by Stichting Mathematisch Centrum,
3Amsterdam, The Netherlands.
Guido van Rossumf70e43a1991-02-19 12:39:46 +00004
5 All Rights Reserved
6
7Permission to use, copy, modify, and distribute this software and its
8documentation for any purpose and without fee is hereby granted,
9provided that the above copyright notice appear in all copies and that
10both that copyright notice and this permission notice appear in
11supporting documentation, and that the names of Stichting Mathematisch
12Centrum or CWI not be used in advertising or publicity pertaining to
13distribution of the software without specific, written prior permission.
14
15STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
16THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
17FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
18FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
19WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
20ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
21OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
22
23******************************************************************/
24
Guido van Rossum85a5fbb1990-10-14 12:07:46 +000025/* Functions used by cgen output */
26
Guido van Rossum76a00af1991-07-27 21:34:00 +000027#include "allobjects.h"
Guido van Rossum85a5fbb1990-10-14 12:07:46 +000028#include "cgensupport.h"
Guido van Rossum85a5fbb1990-10-14 12:07:46 +000029
30
Guido van Rossum85a5fbb1990-10-14 12:07:46 +000031/* 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 }
Guido van Rossum76a00af1991-07-27 21:34:00 +0000109 else if (is_longobject(v)) {
110 *p_arg = dgetlongvalue(v);
111 return 1;
112 }
Guido van Rossum85a5fbb1990-10-14 12:07:46 +0000113 return err_badarg();
114}
115
116static int
117extractfloat(v, p_arg)
118 register object *v;
119 float *p_arg;
120{
121 if (v == NULL) {
122 /* Fall through to error return at end of function */
123 }
124 else if (is_floatobject(v)) {
125 *p_arg = GETFLOATVALUE((floatobject *)v);
126 return 1;
127 }
128 else if (is_intobject(v)) {
129 *p_arg = GETINTVALUE((intobject *)v);
130 return 1;
131 }
Guido van Rossum76a00af1991-07-27 21:34:00 +0000132 else if (is_longobject(v)) {
133 *p_arg = dgetlongvalue(v);
134 return 1;
135 }
Guido van Rossum85a5fbb1990-10-14 12:07:46 +0000136 return err_badarg();
137}
138
139int
140getifloatarg(args, nargs, i, p_arg)
141 register object *args;
142 int nargs, i;
143 float *p_arg;
144{
145 object *v;
146 float x;
147 if (!getiobjectarg(args, nargs, i, &v))
148 return 0;
149 if (!extractfloat(v, &x))
150 return 0;
151 *p_arg = x;
152 return 1;
153}
154
155int
156getistringarg(args, nargs, i, p_arg)
157 object *args;
158 int nargs, i;
159 string *p_arg;
160{
161 object *v;
162 if (!getiobjectarg(args, nargs, i, &v))
Guido van Rossum7cdf5eb1992-04-06 12:34:45 +0000163 return 0;
Guido van Rossum85a5fbb1990-10-14 12:07:46 +0000164 if (!is_stringobject(v)) {
165 return err_badarg();
166 }
167 *p_arg = getstringvalue(v);
168 return 1;
169}
170
171int
172getichararg(args, nargs, i, p_arg)
173 object *args;
174 int nargs, i;
175 char *p_arg;
176{
177 string x;
178 if (!getistringarg(args, nargs, i, &x))
179 return 0;
180 if (x[0] == '\0' || x[1] != '\0') {
181 /* Not exactly one char */
182 return err_badarg();
183 }
184 *p_arg = x[0];
185 return 1;
186}
187
188int
189getilongarraysize(args, nargs, i, p_arg)
190 object *args;
191 int nargs, i;
192 long *p_arg;
193{
194 object *v;
195 if (!getiobjectarg(args, nargs, i, &v))
196 return 0;
197 if (is_tupleobject(v)) {
198 *p_arg = gettuplesize(v);
199 return 1;
200 }
201 if (is_listobject(v)) {
202 *p_arg = getlistsize(v);
203 return 1;
204 }
205 return err_badarg();
206}
207
208int
209getishortarraysize(args, nargs, i, p_arg)
210 object *args;
211 int nargs, i;
212 short *p_arg;
213{
214 long x;
215 if (!getilongarraysize(args, nargs, i, &x))
216 return 0;
217 *p_arg = x;
218 return 1;
219}
220
221/* XXX The following four are too similar. Should share more code. */
222
223int
224getilongarray(args, nargs, i, n, p_arg)
225 object *args;
226 int nargs, i;
227 int n;
228 long *p_arg; /* [n] */
229{
230 object *v, *w;
231 if (!getiobjectarg(args, nargs, i, &v))
232 return 0;
233 if (is_tupleobject(v)) {
234 if (gettuplesize(v) != n) {
235 return err_badarg();
236 }
237 for (i = 0; i < n; i++) {
238 w = gettupleitem(v, i);
239 if (!is_intobject(w)) {
240 return err_badarg();
241 }
242 p_arg[i] = getintvalue(w);
243 }
244 return 1;
245 }
246 else if (is_listobject(v)) {
247 if (getlistsize(v) != n) {
248 return err_badarg();
249 }
250 for (i = 0; i < n; i++) {
251 w = getlistitem(v, i);
252 if (!is_intobject(w)) {
253 return err_badarg();
254 }
255 p_arg[i] = getintvalue(w);
256 }
257 return 1;
258 }
259 else {
260 return err_badarg();
261 }
262}
263
264int
265getishortarray(args, nargs, i, n, p_arg)
266 object *args;
267 int nargs, i;
268 int n;
269 short *p_arg; /* [n] */
270{
271 object *v, *w;
272 if (!getiobjectarg(args, nargs, i, &v))
273 return 0;
274 if (is_tupleobject(v)) {
275 if (gettuplesize(v) != n) {
276 return err_badarg();
277 }
278 for (i = 0; i < n; i++) {
279 w = gettupleitem(v, i);
280 if (!is_intobject(w)) {
281 return err_badarg();
282 }
283 p_arg[i] = getintvalue(w);
284 }
285 return 1;
286 }
287 else if (is_listobject(v)) {
288 if (getlistsize(v) != n) {
289 return err_badarg();
290 }
291 for (i = 0; i < n; i++) {
292 w = getlistitem(v, i);
293 if (!is_intobject(w)) {
294 return err_badarg();
295 }
296 p_arg[i] = getintvalue(w);
297 }
298 return 1;
299 }
300 else {
301 return err_badarg();
302 }
303}
304
305int
306getidoublearray(args, nargs, i, n, p_arg)
307 object *args;
308 int nargs, i;
309 int n;
310 double *p_arg; /* [n] */
311{
312 object *v, *w;
313 if (!getiobjectarg(args, nargs, i, &v))
314 return 0;
315 if (is_tupleobject(v)) {
316 if (gettuplesize(v) != n) {
317 return err_badarg();
318 }
319 for (i = 0; i < n; i++) {
320 w = gettupleitem(v, i);
321 if (!extractdouble(w, &p_arg[i]))
322 return 0;
323 }
324 return 1;
325 }
326 else if (is_listobject(v)) {
327 if (getlistsize(v) != n) {
328 return err_badarg();
329 }
330 for (i = 0; i < n; i++) {
331 w = getlistitem(v, i);
332 if (!extractdouble(w, &p_arg[i]))
333 return 0;
334 }
335 return 1;
336 }
337 else {
338 return err_badarg();
339 }
340}
341
342int
343getifloatarray(args, nargs, i, n, p_arg)
344 object *args;
345 int nargs, i;
346 int n;
347 float *p_arg; /* [n] */
348{
349 object *v, *w;
350 if (!getiobjectarg(args, nargs, i, &v))
351 return 0;
352 if (is_tupleobject(v)) {
353 if (gettuplesize(v) != n) {
354 return err_badarg();
355 }
356 for (i = 0; i < n; i++) {
357 w = gettupleitem(v, i);
358 if (!extractfloat(w, &p_arg[i]))
359 return 0;
360 }
361 return 1;
362 }
363 else if (is_listobject(v)) {
364 if (getlistsize(v) != n) {
365 return err_badarg();
366 }
367 for (i = 0; i < n; i++) {
368 w = getlistitem(v, i);
369 if (!extractfloat(w, &p_arg[i]))
370 return 0;
371 }
372 return 1;
373 }
374 else {
375 return err_badarg();
376 }
377}