← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to o/mapfun.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
o/mapfun.c
 
1
/*
 
2
 Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
 
3
 
 
4
This file is part of GNU Common Lisp, herein referred to as GCL
 
5
 
 
6
GCL is free software; you can redistribute it and/or modify it under
 
7
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
 
8
the Free Software Foundation; either version 2, or (at your option)
 
9
any later version.
 
10
 
 
11
GCL is distributed in the hope that it will be useful, but WITHOUT
 
12
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 
13
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
 
14
License for more details.
 
15
 
 
16
You should have received a copy of the GNU Library General Public License 
 
17
along with GCL; see the file COPYING.  If not, write to the Free Software
 
18
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
19
 
 
20
*/
 
21
 
 
22
/*
 
23
 
 
24
        mapfun.c
 
25
 
 
26
        Mapping
 
27
*/
 
28
 
 
29
#include "include.h"
 
30
 
 
31
/*
 
32
 
 
33
Use of VS in mapfunctions:
 
34
 
 
35
                |       |
 
36
                |-------|
 
37
        base -> |  fun  |
 
38
                | list1 |
 
39
                |   :   |
 
40
                |   :   |
 
41
                | listn |
 
42
        top ->  | value | ----- the list which should be returned
 
43
                | arg1  | --|
 
44
                |   :   |   |-- arguments to FUN.
 
45
                |   :   |   |   On call to FUN, vs_base = top+1
 
46
                | argn  | --|                   vs_top  = top+n+1
 
47
                |-------|
 
48
                |       |
 
49
                   VS
 
50
*/
 
51
 
 
52
LFD(Lmapcar)(void)
 
53
{
 
54
 
 
55
        object *top = vs_top;
 
56
        object *base = vs_base;
 
57
        object x, handy;
 
58
        int n = vs_top-vs_base-1;
 
59
        int i;
 
60
 
 
61
        if (n <= 0)
 
62
                too_few_arguments();
 
63
        vs_push(Cnil);
 
64
        for (i = 1;  i <= n;  i++) {
 
65
                x = base[i];
 
66
                if (endp(x)) {
 
67
                        base[0] = Cnil;
 
68
                        vs_top = base+1;
 
69
                        vs_base = base;
 
70
                        return;
 
71
                }
 
72
                vs_push(MMcar(x));
 
73
                base[i] = MMcdr(x);
 
74
        }
 
75
        handy = top[0] = MMcons(Cnil,Cnil);
 
76
LOOP:
 
77
        vs_base = top+1;
 
78
        super_funcall(base[0]);
 
79
        MMcar(handy) = vs_base[0];
 
80
        for (i = 1;  i <= n;  i++) {
 
81
                x = base[i];
 
82
                if (endp(x)) {
 
83
                        vs_base = top;
 
84
                        vs_top = top+1;
 
85
                        return;
 
86
                }
 
87
                top[i] = MMcar(x);
 
88
                base[i] = MMcdr(x);
 
89
        }
 
90
        vs_top = top+n+1;
 
91
        handy = MMcdr(handy) = MMcons(Cnil,Cnil);
 
92
        goto LOOP;
 
93
}
 
94
 
 
95
LFD(Lmaplist)(void)
 
96
{
 
97
 
 
98
        object *top = vs_top;
 
99
        object *base = vs_base;
 
100
        object x, handy;
 
101
        int n = vs_top-vs_base-1;
 
102
        int i;
 
103
 
 
104
        if (n <= 0)
 
105
                too_few_arguments();
 
106
        vs_push(Cnil);
 
107
        for (i = 1;  i <= n;  i++) {
 
108
                x = base[i];
 
109
                if (endp(x)) {
 
110
                        base[0] = Cnil;
 
111
                        vs_top = base+1;
 
112
                        vs_base = base;
 
113
                        return;
 
114
                }
 
115
                vs_push(x);
 
116
                base[i] = MMcdr(x);
 
117
        }
 
118
        handy = top[0] = MMcons(Cnil,Cnil);
 
119
LOOP:
 
120
        vs_base = top+1;
 
121
        super_funcall(base[0]);
 
122
        MMcar(handy) = vs_base[0];
 
123
        for (i = 1;  i <= n;  i++) {
 
124
                x = base[i];
 
125
                if (endp(x)) {
 
126
                        vs_base = top;
 
127
                        vs_top = top+1;
 
128
                        return;
 
129
                }
 
130
                top[i] = x;
 
131
                base[i] = MMcdr(x);
 
132
        }
 
133
        vs_top = top+n+1;
 
134
        handy = MMcdr(handy) = MMcons(Cnil,Cnil);
 
135
        goto LOOP;
 
136
}
 
137
 
 
138
LFD(Lmapc)(void)
 
139
{
 
140
 
 
141
        object *top = vs_top;
 
142
        object *base = vs_base;
 
143
        object x;
 
144
        int n = vs_top-vs_base-1;
 
145
        int i;
 
146
 
 
147
        if (n <= 0)
 
148
                too_few_arguments();
 
149
        vs_push(base[1]);
 
150
        for (i = 1;  i <= n;  i++) {
 
151
                x = base[i];
 
152
                if (endp(x)) {
 
153
                        vs_top = top+1;
 
154
                        vs_base = top;
 
155
                        return;
 
156
                }
 
157
                vs_push(MMcar(x));
 
158
                base[i] = MMcdr(x);
 
159
        }
 
160
LOOP:
 
161
        vs_base = top+1;
 
162
        super_funcall(base[0]);
 
163
        for (i = 1;  i <= n;  i++) {
 
164
                x = base[i];
 
165
                if (endp(x)) {
 
166
                        vs_base = top;
 
167
                        vs_top = top+1;
 
168
                        return;
 
169
                }
 
170
                top[i] = MMcar(x);
 
171
                base[i] = MMcdr(x);
 
172
        }
 
173
        vs_top = top+n+1;
 
174
        goto LOOP;
 
175
}
 
176
 
 
177
LFD(Lmapl)(void)
 
178
{
 
179
 
 
180
        object *top = vs_top;
 
181
        object *base = vs_base;
 
182
        object x;
 
183
        int n = vs_top-vs_base-1;
 
184
        int i;
 
185
 
 
186
        if (n <= 0)
 
187
                too_few_arguments();
 
188
        vs_push(base[1]);
 
189
        for (i = 1;  i <= n;  i++) {
 
190
                x = base[i];
 
191
                if (endp(x)) {
 
192
                        vs_top = top+1;
 
193
                        vs_base = top;
 
194
                        return;
 
195
                }
 
196
                vs_push(x);
 
197
                base[i] = MMcdr(x);
 
198
        }
 
199
LOOP:
 
200
        vs_base = top+1;
 
201
        super_funcall(base[0]);
 
202
        for (i = 1;  i <= n;  i++) {
 
203
                x = base[i];
 
204
                if (endp(x)) {
 
205
                        vs_base = top;
 
206
                        vs_top = top+1;
 
207
                        return;
 
208
                }
 
209
                top[i] = x;
 
210
                base[i] = MMcdr(x);
 
211
        }
 
212
        vs_top = top+n+1;
 
213
        goto LOOP;
 
214
}
 
215
 
 
216
LFD(Lmapcan)(void)
 
217
{
 
218
 
 
219
        object *top = vs_top;
 
220
        object *base = vs_base;
 
221
        object x, handy;
 
222
        int n = vs_top-vs_base-1;
 
223
        int i;
 
224
 
 
225
        if (n <= 0)
 
226
                too_few_arguments();
 
227
        vs_push(Cnil);
 
228
        for (i = 1;  i <= n;  i++) {
 
229
                x = base[i];
 
230
                if (endp(x)) {
 
231
                        base[0] = Cnil;
 
232
                        vs_top = base+1;
 
233
                        vs_base = base;
 
234
                        return;
 
235
                }
 
236
                vs_push(MMcar(x));
 
237
                base[i] = MMcdr(x);
 
238
        }
 
239
        handy = Cnil;
 
240
LOOP:
 
241
        vs_base = top+1;
 
242
        super_funcall(base[0]);
 
243
        if (endp(handy)) handy = top[0] = vs_base[0];
 
244
        else {
 
245
                x = MMcdr(handy);
 
246
                while(!endp(x)) {
 
247
                        handy = x;
 
248
                        x = MMcdr(x);
 
249
                }
 
250
                MMcdr(handy) = vs_base[0];
 
251
                }
 
252
        for (i = 1;  i <= n;  i++) {
 
253
                x = base[i];
 
254
                if (endp(x)) {
 
255
                        vs_base = top;
 
256
                        vs_top = top+1;
 
257
                        return;
 
258
                }
 
259
                top[i] = MMcar(x);
 
260
                base[i] = MMcdr(x);
 
261
        }
 
262
        vs_top = top+n+1;
 
263
        goto LOOP;
 
264
}
 
265
 
 
266
LFD(Lmapcon)(void)
 
267
{
 
268
 
 
269
        object *top = vs_top;
 
270
        object *base = vs_base;
 
271
        object x, handy;
 
272
        int n = vs_top-vs_base-1;
 
273
        int i;
 
274
 
 
275
        if (n <= 0)
 
276
                too_few_arguments();
 
277
        vs_push(Cnil);
 
278
        for (i = 1;  i <= n;  i++) {
 
279
                x = base[i];
 
280
                if (endp(x)) {
 
281
                        base[0] = Cnil;
 
282
                        vs_top = base+1;
 
283
                        vs_base = base;
 
284
                        return;
 
285
                }
 
286
                vs_push(x);
 
287
                base[i] = MMcdr(x);
 
288
        }
 
289
        handy = Cnil;
 
290
LOOP:
 
291
        vs_base = top+1;
 
292
        super_funcall(base[0]);
 
293
        if (endp(handy))
 
294
                handy = top[0] = vs_base[0];
 
295
        else {
 
296
                x = MMcdr(handy);
 
297
                while(!endp(x)) {
 
298
                        handy = x;
 
299
                        x = MMcdr(x);
 
300
                }
 
301
                MMcdr(handy) = vs_base[0];
 
302
        }
 
303
        for (i = 1;  i <= n;  i++) {
 
304
                x = base[i];
 
305
                if (endp(x)) {
 
306
                        vs_base = top;
 
307
                        vs_top = top+1;
 
308
                        return;
 
309
                }
 
310
                top[i] = x;
 
311
                base[i] = MMcdr(x);
 
312
        }
 
313
        vs_top = top+n+1;
 
314
        goto LOOP;
 
315
}
 
316
 
 
317
void
 
318
gcl_init_mapfun(void)
 
319
{
 
320
        make_function("MAPCAR", Lmapcar);
 
321
        make_function("MAPLIST", Lmaplist);
 
322
        make_function("MAPC", Lmapc);
 
323
        make_function("MAPL", Lmapl);
 
324
        make_function("MAPCAN", Lmapcan);
 
325
        make_function("MAPCON", Lmapcon);
 
326
}