|
145
|
1 /***********************************************************
|
|
|
2 Copyright 1991 by Stichting Mathematisch Centrum, Amsterdam, The
|
|
|
3 Netherlands.
|
|
|
4
|
|
|
5 All Rights Reserved
|
|
|
6
|
|
|
7 Permission to use, copy, modify, and distribute this software and its
|
|
|
8 documentation for any purpose and without fee is hereby granted,
|
|
|
9 provided that the above copyright notice appear in all copies and that
|
|
|
10 both that copyright notice and this permission notice appear in
|
|
|
11 supporting documentation, and that the names of Stichting Mathematisch
|
|
|
12 Centrum or CWI not be used in advertising or publicity pertaining to
|
|
|
13 distribution of the software without specific, written prior permission.
|
|
|
14
|
|
|
15 STICHTING MATHEMATISCH CENTRUM DISCLAIMS ALL WARRANTIES WITH REGARD TO
|
|
|
16 THIS SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
|
|
17 FITNESS, IN NO EVENT SHALL STICHTING MATHEMATISCH CENTRUM BE LIABLE
|
|
|
18 FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
|
|
19 WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
|
|
20 ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT
|
|
|
21 OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
|
22
|
|
|
23 ******************************************************************/
|
|
|
24
|
|
6
|
25 /* Module support implementation */
|
|
|
26
|
|
86
|
27 #include "allobjects.h"
|
|
6
|
28 #include "modsupport.h"
|
|
|
29 #include "import.h"
|
|
|
30
|
|
|
31
|
|
|
32 object *
|
|
|
33 initmodule(name, methods)
|
|
|
34 char *name;
|
|
|
35 struct methodlist *methods;
|
|
|
36 {
|
|
|
37 object *m, *d, *v;
|
|
|
38 struct methodlist *ml;
|
|
86
|
39 char namebuf[256];
|
|
|
40 if ((m = add_module(name)) == NULL) {
|
|
6
|
41 fprintf(stderr, "initializing module: %s\n", name);
|
|
|
42 fatal("can't create a module");
|
|
|
43 }
|
|
|
44 d = getmoduledict(m);
|
|
|
45 for (ml = methods; ml->ml_name != NULL; ml++) {
|
|
86
|
46 sprintf(namebuf, "%s.%s", name, ml->ml_name);
|
|
|
47 v = newmethodobject(strdup(namebuf), ml->ml_meth,
|
|
|
48 (object *)NULL);
|
|
|
49 /* XXX The strdup'ed memory is never freed */
|
|
6
|
50 if (v == NULL || dictinsert(d, ml->ml_name, v) != 0) {
|
|
|
51 fprintf(stderr, "initializing module: %s\n", name);
|
|
|
52 fatal("can't initialize module");
|
|
|
53 }
|
|
|
54 DECREF(v);
|
|
|
55 }
|
|
86
|
56 return m;
|
|
6
|
57 }
|
|
|
58
|
|
|
59
|
|
|
60 /* Argument list handling tools.
|
|
|
61 All return 1 for success, or call err_set*() and return 0 for failure */
|
|
|
62
|
|
|
63 int
|
|
|
64 getnoarg(v)
|
|
|
65 object *v;
|
|
|
66 {
|
|
|
67 if (v != NULL) {
|
|
|
68 return err_badarg();
|
|
|
69 }
|
|
|
70 return 1;
|
|
|
71 }
|
|
|
72
|
|
|
73 int
|
|
|
74 getintarg(v, a)
|
|
|
75 object *v;
|
|
|
76 int *a;
|
|
|
77 {
|
|
|
78 if (v == NULL || !is_intobject(v)) {
|
|
|
79 return err_badarg();
|
|
|
80 }
|
|
|
81 *a = getintvalue(v);
|
|
|
82 return 1;
|
|
|
83 }
|
|
|
84
|
|
|
85 int
|
|
|
86 getintintarg(v, a, b)
|
|
|
87 object *v;
|
|
|
88 int *a;
|
|
|
89 int *b;
|
|
|
90 {
|
|
|
91 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
|
|
|
92 return err_badarg();
|
|
|
93 }
|
|
|
94 return getintarg(gettupleitem(v, 0), a) &&
|
|
|
95 getintarg(gettupleitem(v, 1), b);
|
|
|
96 }
|
|
|
97
|
|
|
98 int
|
|
|
99 getlongarg(v, a)
|
|
|
100 object *v;
|
|
|
101 long *a;
|
|
|
102 {
|
|
|
103 if (v == NULL || !is_intobject(v)) {
|
|
|
104 return err_badarg();
|
|
|
105 }
|
|
|
106 *a = getintvalue(v);
|
|
|
107 return 1;
|
|
|
108 }
|
|
|
109
|
|
|
110 int
|
|
|
111 getlonglongargs(v, a, b)
|
|
|
112 object *v;
|
|
|
113 long *a, *b;
|
|
|
114 {
|
|
|
115 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
|
|
|
116 return err_badarg();
|
|
|
117 }
|
|
|
118 return getlongarg(gettupleitem(v, 0), a) &&
|
|
|
119 getlongarg(gettupleitem(v, 1), b);
|
|
|
120 }
|
|
|
121
|
|
|
122 int
|
|
|
123 getlonglongobjectargs(v, a, b, c)
|
|
|
124 object *v;
|
|
|
125 long *a, *b;
|
|
|
126 object **c;
|
|
|
127 {
|
|
|
128 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
|
|
|
129 return err_badarg();
|
|
|
130 }
|
|
|
131 if (getlongarg(gettupleitem(v, 0), a) &&
|
|
|
132 getlongarg(gettupleitem(v, 1), b)) {
|
|
|
133 *c = gettupleitem(v, 2);
|
|
|
134 return 1;
|
|
|
135 }
|
|
|
136 else {
|
|
|
137 return err_badarg();
|
|
|
138 }
|
|
|
139 }
|
|
|
140
|
|
|
141 int
|
|
|
142 getstrarg(v, a)
|
|
|
143 object *v;
|
|
|
144 object **a;
|
|
|
145 {
|
|
|
146 if (v == NULL || !is_stringobject(v)) {
|
|
|
147 return err_badarg();
|
|
|
148 }
|
|
|
149 *a = v;
|
|
|
150 return 1;
|
|
|
151 }
|
|
|
152
|
|
|
153 int
|
|
|
154 getstrstrarg(v, a, b)
|
|
|
155 object *v;
|
|
|
156 object **a;
|
|
|
157 object **b;
|
|
|
158 {
|
|
|
159 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
|
|
|
160 return err_badarg();
|
|
|
161 }
|
|
|
162 return getstrarg(gettupleitem(v, 0), a) &&
|
|
|
163 getstrarg(gettupleitem(v, 1), b);
|
|
|
164 }
|
|
|
165
|
|
|
166 int
|
|
|
167 getstrstrintarg(v, a, b, c)
|
|
|
168 object *v;
|
|
|
169 object **a;
|
|
|
170 object **b;
|
|
|
171 int *c;
|
|
|
172 {
|
|
|
173 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
|
|
|
174 return err_badarg();
|
|
|
175 }
|
|
|
176 return getstrarg(gettupleitem(v, 0), a) &&
|
|
|
177 getstrarg(gettupleitem(v, 1), b) &&
|
|
|
178 getintarg(gettupleitem(v, 2), c);
|
|
|
179 }
|
|
|
180
|
|
|
181 int
|
|
|
182 getstrintarg(v, a, b)
|
|
|
183 object *v;
|
|
|
184 object **a;
|
|
|
185 int *b;
|
|
|
186 {
|
|
|
187 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
|
|
|
188 return err_badarg();
|
|
|
189 }
|
|
|
190 return getstrarg(gettupleitem(v, 0), a) &&
|
|
|
191 getintarg(gettupleitem(v, 1), b);
|
|
|
192 }
|
|
|
193
|
|
|
194 int
|
|
|
195 getintstrarg(v, a, b)
|
|
|
196 object *v;
|
|
|
197 int *a;
|
|
|
198 object **b;
|
|
|
199 {
|
|
|
200 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
|
|
|
201 return err_badarg();
|
|
|
202 }
|
|
|
203 return getintarg(gettupleitem(v, 0), a) &&
|
|
|
204 getstrarg(gettupleitem(v, 1), b);
|
|
|
205 }
|
|
|
206
|
|
|
207 int
|
|
|
208 getpointarg(v, a)
|
|
|
209 object *v;
|
|
|
210 int *a; /* [2] */
|
|
|
211 {
|
|
|
212 return getintintarg(v, a, a+1);
|
|
|
213 }
|
|
|
214
|
|
|
215 int
|
|
|
216 get3pointarg(v, a)
|
|
|
217 object *v;
|
|
|
218 int *a; /* [6] */
|
|
|
219 {
|
|
|
220 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
|
|
|
221 return err_badarg();
|
|
|
222 }
|
|
|
223 return getpointarg(gettupleitem(v, 0), a) &&
|
|
|
224 getpointarg(gettupleitem(v, 1), a+2) &&
|
|
|
225 getpointarg(gettupleitem(v, 2), a+4);
|
|
|
226 }
|
|
|
227
|
|
|
228 int
|
|
|
229 getrectarg(v, a)
|
|
|
230 object *v;
|
|
|
231 int *a; /* [2+2] */
|
|
|
232 {
|
|
|
233 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
|
|
|
234 return err_badarg();
|
|
|
235 }
|
|
|
236 return getpointarg(gettupleitem(v, 0), a) &&
|
|
|
237 getpointarg(gettupleitem(v, 1), a+2);
|
|
|
238 }
|
|
|
239
|
|
|
240 int
|
|
|
241 getrectintarg(v, a)
|
|
|
242 object *v;
|
|
|
243 int *a; /* [4+1] */
|
|
|
244 {
|
|
|
245 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
|
|
|
246 return err_badarg();
|
|
|
247 }
|
|
|
248 return getrectarg(gettupleitem(v, 0), a) &&
|
|
|
249 getintarg(gettupleitem(v, 1), a+4);
|
|
|
250 }
|
|
|
251
|
|
|
252 int
|
|
|
253 getpointintarg(v, a)
|
|
|
254 object *v;
|
|
|
255 int *a; /* [2+1] */
|
|
|
256 {
|
|
|
257 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
|
|
|
258 return err_badarg();
|
|
|
259 }
|
|
|
260 return getpointarg(gettupleitem(v, 0), a) &&
|
|
|
261 getintarg(gettupleitem(v, 1), a+2);
|
|
|
262 }
|
|
|
263
|
|
|
264 int
|
|
|
265 getpointstrarg(v, a, b)
|
|
|
266 object *v;
|
|
|
267 int *a; /* [2] */
|
|
|
268 object **b;
|
|
|
269 {
|
|
|
270 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
|
|
|
271 return err_badarg();
|
|
|
272 }
|
|
|
273 return getpointarg(gettupleitem(v, 0), a) &&
|
|
|
274 getstrarg(gettupleitem(v, 1), b);
|
|
|
275 }
|
|
|
276
|
|
|
277 int
|
|
|
278 getstrintintarg(v, a, b, c)
|
|
|
279 object *v;
|
|
|
280 object *a;
|
|
|
281 int *b, *c;
|
|
|
282 {
|
|
|
283 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 3) {
|
|
|
284 return err_badarg();
|
|
|
285 }
|
|
|
286 return getstrarg(gettupleitem(v, 0), a) &&
|
|
|
287 getintarg(gettupleitem(v, 1), b) &&
|
|
|
288 getintarg(gettupleitem(v, 2), c);
|
|
|
289 }
|
|
|
290
|
|
|
291 int
|
|
|
292 getrectpointarg(v, a)
|
|
|
293 object *v;
|
|
|
294 int *a; /* [4+2] */
|
|
|
295 {
|
|
|
296 if (v == NULL || !is_tupleobject(v) || gettuplesize(v) != 2) {
|
|
|
297 return err_badarg();
|
|
|
298 }
|
|
|
299 return getrectarg(gettupleitem(v, 0), a) &&
|
|
|
300 getpointarg(gettupleitem(v, 1), a+4);
|
|
|
301 }
|
|
|
302
|
|
|
303 int
|
|
|
304 getlongtuplearg(args, a, n)
|
|
|
305 object *args;
|
|
|
306 long *a; /* [n] */
|
|
|
307 int n;
|
|
|
308 {
|
|
|
309 int i;
|
|
|
310 if (!is_tupleobject(args) || gettuplesize(args) != n) {
|
|
|
311 return err_badarg();
|
|
|
312 }
|
|
|
313 for (i = 0; i < n; i++) {
|
|
|
314 object *v = gettupleitem(args, i);
|
|
|
315 if (!is_intobject(v)) {
|
|
|
316 return err_badarg();
|
|
|
317 }
|
|
|
318 a[i] = getintvalue(v);
|
|
|
319 }
|
|
|
320 return 1;
|
|
|
321 }
|
|
|
322
|
|
|
323 int
|
|
|
324 getshorttuplearg(args, a, n)
|
|
|
325 object *args;
|
|
|
326 short *a; /* [n] */
|
|
|
327 int n;
|
|
|
328 {
|
|
|
329 int i;
|
|
|
330 if (!is_tupleobject(args) || gettuplesize(args) != n) {
|
|
|
331 return err_badarg();
|
|
|
332 }
|
|
|
333 for (i = 0; i < n; i++) {
|
|
|
334 object *v = gettupleitem(args, i);
|
|
|
335 if (!is_intobject(v)) {
|
|
|
336 return err_badarg();
|
|
|
337 }
|
|
|
338 a[i] = getintvalue(v);
|
|
|
339 }
|
|
|
340 return 1;
|
|
|
341 }
|
|
|
342
|
|
|
343 int
|
|
|
344 getlonglistarg(args, a, n)
|
|
|
345 object *args;
|
|
|
346 long *a; /* [n] */
|
|
|
347 int n;
|
|
|
348 {
|
|
|
349 int i;
|
|
|
350 if (!is_listobject(args) || getlistsize(args) != n) {
|
|
|
351 return err_badarg();
|
|
|
352 }
|
|
|
353 for (i = 0; i < n; i++) {
|
|
|
354 object *v = getlistitem(args, i);
|
|
|
355 if (!is_intobject(v)) {
|
|
|
356 return err_badarg();
|
|
|
357 }
|
|
|
358 a[i] = getintvalue(v);
|
|
|
359 }
|
|
|
360 return 1;
|
|
|
361 }
|
|
|
362
|
|
|
363 int
|
|
|
364 getshortlistarg(args, a, n)
|
|
|
365 object *args;
|
|
|
366 short *a; /* [n] */
|
|
|
367 int n;
|
|
|
368 {
|
|
|
369 int i;
|
|
|
370 if (!is_listobject(args) || getlistsize(args) != n) {
|
|
|
371 return err_badarg();
|
|
|
372 }
|
|
|
373 for (i = 0; i < n; i++) {
|
|
|
374 object *v = getlistitem(args, i);
|
|
|
375 if (!is_intobject(v)) {
|
|
|
376 return err_badarg();
|
|
|
377 }
|
|
|
378 a[i] = getintvalue(v);
|
|
|
379 }
|
|
|
380 return 1;
|
|
|
381 }
|
