← Back to branch summary

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

« back to all changes in this revision

Viewing changes to o/conditional.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/conditional.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
        conditional.c
 
25
 
 
26
        conditionals
 
27
*/
 
28
 
 
29
#include "include.h"
 
30
 
 
31
object sLotherwise;
 
32
 
 
33
static void
 
34
FFN(Fif)(object form)
 
35
{
 
36
 
 
37
        object *top = vs_top;
 
38
 
 
39
        if (endp(form) || endp(MMcdr(form)))
 
40
                FEtoo_few_argumentsF(form);
 
41
        if (!endp(MMcddr(form)) && !endp(MMcdddr(form)))
 
42
                FEtoo_many_argumentsF(form);
 
43
        eval(MMcar(form));
 
44
        if (vs_base[0] == Cnil)
 
45
                if (endp(MMcddr(form))) {
 
46
                        vs_top = vs_base = top;
 
47
                        vs_push(Cnil);
 
48
                } else {
 
49
                        vs_top = top;
 
50
                        eval(MMcaddr(form));
 
51
                }
 
52
        else {
 
53
                vs_top = top;
 
54
                eval(MMcadr(form));
 
55
        }
 
56
}
 
57
 
 
58
static void
 
59
FFN(Fcond)(object args)
 
60
{
 
61
 
 
62
        object *top = vs_top;
 
63
        object clause;
 
64
        object conseq;
 
65
 
 
66
        while (!endp(args)) {
 
67
                clause = MMcar(args);
 
68
                if (type_of(clause) != t_cons)
 
69
                        FEerror("~S is an illegal COND clause.",1,clause);
 
70
                eval(MMcar(clause));
 
71
                if (vs_base[0] != Cnil) {
 
72
                        conseq = MMcdr(clause);
 
73
                        if (endp(conseq)) {
 
74
                                vs_top = vs_base+1;
 
75
                                return;
 
76
                        }
 
77
                        while (!endp(conseq)) {
 
78
                                vs_top = top;
 
79
                                eval(MMcar(conseq));
 
80
                                conseq = MMcdr(conseq);
 
81
                        }
 
82
                        return;
 
83
                }
 
84
                vs_top = top;
 
85
                args = MMcdr(args);
 
86
        }
 
87
        vs_base = vs_top = top;
 
88
        vs_push(Cnil);
 
89
}
 
90
 
 
91
static void
 
92
FFN(Fcase)(object arg)
 
93
{
 
94
 
 
95
        object *top = vs_top;
 
96
        object clause;
 
97
        object key;
 
98
        object conseq;
 
99
 
 
100
        if (endp(arg))
 
101
                FEtoo_few_argumentsF(arg);
 
102
        eval(MMcar(arg));
 
103
        vs_top = top;
 
104
        vs_push(vs_base[0]);
 
105
        arg = MMcdr(arg);
 
106
        while (!endp(arg)) {
 
107
                clause = MMcar(arg);
 
108
                if (type_of(clause) != t_cons)
 
109
                        FEerror("~S is an illegal CASE clause.",1,clause);
 
110
                key = MMcar(clause);
 
111
                conseq = MMcdr(clause);
 
112
                if (type_of(key) == t_cons)
 
113
                        do {
 
114
                                if (eql(MMcar(key),top[0]))
 
115
                                        goto FOUND;
 
116
                                key = MMcdr(key);
 
117
                        } while (!endp(key));
 
118
                else if (key == Cnil)
 
119
                        ;
 
120
                else if (key == Ct || key == sLotherwise || eql(key,top[0]))
 
121
                        goto FOUND;
 
122
                arg = MMcdr(arg);
 
123
        }
 
124
        vs_base = vs_top = top;
 
125
        vs_push(Cnil);
 
126
        return;
 
127
 
 
128
FOUND:
 
129
        if (endp(conseq)) {
 
130
                vs_base = vs_top = top;
 
131
                vs_push(Cnil);
 
132
        } else
 
133
                 do {
 
134
                        vs_top = top;
 
135
                        eval(MMcar(conseq));
 
136
                        conseq = MMcdr(conseq);
 
137
                } while (!endp(conseq));
 
138
        return;
 
139
}
 
140
 
 
141
static void
 
142
FFN(Fwhen)(object form)
 
143
{
 
144
 
 
145
        object *top = vs_top;
 
146
 
 
147
        if (endp(form))
 
148
                FEtoo_few_argumentsF(form);
 
149
        eval(MMcar(form));
 
150
        if (vs_base[0] == Cnil) {
 
151
                vs_base = vs_top = top;
 
152
                vs_push(Cnil);
 
153
        } else {
 
154
                form = MMcdr(form);
 
155
                if (endp(form)) {
 
156
                        vs_base = vs_top = top;
 
157
                        vs_push(Cnil);
 
158
                } else
 
159
                        do {
 
160
                                vs_top = top;
 
161
                                eval(MMcar(form));
 
162
                                form = MMcdr(form);
 
163
                        } while (!endp(form));
 
164
        }
 
165
}
 
166
 
 
167
static void
 
168
FFN(Funless)(object form)
 
169
{
 
170
 
 
171
        object *top = vs_top;
 
172
 
 
173
        if (endp(form))
 
174
                FEtoo_few_argumentsF(form);
 
175
        eval(MMcar(form));
 
176
        if (vs_base[0] == Cnil) {
 
177
                vs_top = top;
 
178
                form = MMcdr(form);
 
179
                if (endp(form)) {
 
180
                        vs_base = vs_top = top;
 
181
                        vs_push(Cnil);
 
182
                } else
 
183
                        do {
 
184
                                vs_top = top;
 
185
                                eval(MMcar(form));
 
186
                                form = MMcdr(form);
 
187
                        } while (!endp(form));
 
188
        } else {
 
189
                vs_base = vs_top = top;
 
190
                vs_push(Cnil);
 
191
        }
 
192
}
 
193
 
 
194
void
 
195
gcl_init_conditional(void)
 
196
{
 
197
        make_special_form("IF",Fif);
 
198
        make_special_form("COND",Fcond);
 
199
        make_special_form("CASE",Fcase);
 
200
        make_special_form("WHEN",Fwhen);
 
201
        make_special_form("UNLESS",Funless);
 
202
 
 
203
        sLotherwise = make_ordinary("OTHERWISE");
 
204
        enter_mark_origin(&sLotherwise);
 
205
}