← Back to branch summary

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

« back to all changes in this revision

Viewing changes to o/num_pred.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/num_pred.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
        Predicates on numbers
 
24
*/
 
25
#define NEED_MP_H
 
26
#include "include.h"
 
27
#include "num_include.h"
 
28
 
 
29
 
 
30
int
 
31
number_zerop(object x)
 
32
{
 
33
        switch (type_of(x)) {
 
34
 
 
35
        case t_fixnum:
 
36
                if (fix(x) == 0)
 
37
                        return(1);
 
38
                else
 
39
                        return(0);
 
40
 
 
41
        case t_bignum:
 
42
        case t_ratio:
 
43
                return(0);
 
44
 
 
45
        case t_shortfloat:
 
46
                if (sf(x) == 0.0)
 
47
                        return(1);
 
48
                else
 
49
                        return(0);
 
50
 
 
51
        case t_longfloat:
 
52
                if (lf(x) == 0.0)
 
53
                        return(1);
 
54
                else
 
55
                        return(0);
 
56
 
 
57
        case t_complex:
 
58
                return(number_zerop(x->cmp.cmp_real) &&
 
59
                       number_zerop(x->cmp.cmp_imag));
 
60
 
 
61
        default:
 
62
                FEwrong_type_argument(sLnumber, x);
 
63
                return(0);
 
64
        }
 
65
}
 
66
 
 
67
int
 
68
number_plusp(object x)
 
69
{
 
70
        switch (type_of(x)) {
 
71
 
 
72
        case t_fixnum:
 
73
                if (fix(x) > 0)
 
74
                        return(1);
 
75
                else
 
76
                        return(0);
 
77
 
 
78
        case t_bignum:
 
79
                if (big_sign(x) > 0)
 
80
                        return(1);
 
81
                else
 
82
                        return(0);
 
83
 
 
84
        case t_ratio:
 
85
                if (number_plusp(x->rat.rat_num))
 
86
                        return(1);
 
87
                else
 
88
                        return(0);
 
89
 
 
90
        case t_shortfloat:
 
91
                if (sf(x) > 0.0)
 
92
                        return(1);
 
93
                else
 
94
                        return(0);
 
95
 
 
96
        case t_longfloat:
 
97
                if (lf(x) > 0.0)
 
98
                        return(1);
 
99
                else
 
100
                        return(0);
 
101
 
 
102
        default:
 
103
                FEwrong_type_argument(TSor_rational_float,x);
 
104
                return(0);
 
105
        }
 
106
}
 
107
 
 
108
int
 
109
number_minusp(object x)
 
110
{
 
111
        switch (type_of(x)) {
 
112
 
 
113
        case t_fixnum:
 
114
                if (fix(x) < 0)
 
115
                        return(1);
 
116
                else
 
117
                        return(0);
 
118
 
 
119
        case t_bignum:
 
120
                if (big_sign(x) < 0)
 
121
                        return(1);
 
122
                else
 
123
                        return(0);
 
124
 
 
125
        case t_ratio:
 
126
                if (number_minusp(x->rat.rat_num))
 
127
                        return(1);
 
128
                else
 
129
                        return(0);
 
130
 
 
131
        case t_shortfloat:
 
132
                if (sf(x) < 0.0)
 
133
                        return(1);
 
134
                else
 
135
                        return(0);
 
136
 
 
137
        case t_longfloat:
 
138
                if (lf(x) < 0.0)
 
139
                        return(1);
 
140
                else
 
141
                        return(0);
 
142
 
 
143
        default:
 
144
                FEwrong_type_argument(TSor_rational_float,x);
 
145
                return(0);
 
146
        }
 
147
}
 
148
 
 
149
int
 
150
number_oddp(object x)
 
151
{
 
152
        int i=0;
 
153
 
 
154
        if (type_of(x) == t_fixnum)
 
155
                i = fix(x);
 
156
        else if (type_of(x) == t_bignum)
 
157
           i = MP_LOW(MP(x),lgef(MP(x)));
 
158
        else
 
159
                FEwrong_type_argument(sLinteger, x);
 
160
        return(i & 1);
 
161
}
 
162
 
 
163
int
 
164
number_evenp(object x)
 
165
{
 
166
        int i=0;
 
167
 
 
168
        if (type_of(x) == t_fixnum)
 
169
                i = fix(x);
 
170
        else if (type_of(x) == t_bignum)
 
171
          i = MP_LOW(MP(x),lgef(MP(x)));
 
172
        else
 
173
                FEwrong_type_argument(sLinteger, x);
 
174
        return(~i & 1);
 
175
}
 
176
 
 
177
LFD(Lzerop)(void)
 
178
{
 
179
        check_arg(1);
 
180
        check_type_number(&vs_base[0]);
 
181
        if (number_zerop(vs_base[0]))
 
182
                vs_base[0] = Ct;
 
183
        else
 
184
                vs_base[0] = Cnil;
 
185
}
 
186
 
 
187
LFD(Lplusp)(void)
 
188
{
 
189
        check_arg(1);
 
190
        check_type_or_rational_float(&vs_base[0]);
 
191
        if (number_plusp(vs_base[0]))
 
192
                vs_base[0] = Ct;
 
193
        else
 
194
                vs_base[0] = Cnil;
 
195
}
 
196
 
 
197
LFD(Lminusp)(void)
 
198
{
 
199
        check_arg(1);
 
200
        check_type_or_rational_float(&vs_base[0]);
 
201
        if (number_minusp(vs_base[0]))
 
202
                vs_base[0] = Ct;
 
203
        else
 
204
                vs_base[0] = Cnil;
 
205
}
 
206
 
 
207
LFD(Loddp)(void)
 
208
{
 
209
        check_arg(1);
 
210
        check_type_integer(&vs_base[0]);
 
211
        if (number_oddp(vs_base[0]))
 
212
                vs_base[0] = Ct;
 
213
        else
 
214
                vs_base[0] = Cnil;
 
215
}
 
216
 
 
217
LFD(Levenp)(void)
 
218
{
 
219
        check_arg(1);
 
220
        check_type_integer(&vs_base[0]);
 
221
        if (number_evenp(vs_base[0]))
 
222
                vs_base[0] = Ct;
 
223
        else
 
224
                vs_base[0] = Cnil;
 
225
}
 
226
 
 
227
/* this is just to force things into memory in num_co.c */
 
228
/* static void  _assure_in_memory (void *p) */
 
229
/* { */
 
230
/* ; */
 
231
/* } */
 
232
 
 
233
/* static int */
 
234
/* lf_eqlp(double *p, double *q) */
 
235
/* { */
 
236
/*   return *p == *q; */
 
237
/* } */
 
238
 
 
239
 
 
240
void
 
241
gcl_init_num_pred(void)
 
242
{
 
243
#ifndef GMP
 
244
        big_register_1 = new_bignum();
 
245
        ZERO_BIG(big_register_1);
 
246
        enter_mark_origin(&big_register_1);
 
247
#endif
 
248
        make_function("ZEROP", Lzerop);
 
249
        make_function("PLUSP", Lplusp);
 
250
        make_function("MINUSP", Lminusp);
 
251
        make_function("ODDP", Loddp);
 
252
        make_function("EVENP", Levenp);
 
253
}