2 ent-int.c -- Ordinary Integers for SXEmacs
3 Copyright (C) 2005, 2006 Sebastian Freundt
5 Author: Sebastian Freundt
7 This file is part of SXEmacs
9 SXEmacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 SXEmacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program. If not, see <http://www.gnu.org/licenses/>. */
27 #include "sysproc.h" /* For qxe_getpid */
31 EMACS_INT Vmost_negative_int, Vmost_positive_int;
32 Lisp_Object Qzero, Qone;
36 ent_int_zerop(Lisp_Object l)
38 return (ent_int(l) == 0);
41 ent_int_onep(Lisp_Object l)
43 return (ent_int(l) == 1);
46 ent_int_unitp(Lisp_Object l)
48 EMACS_INT rl = ent_int(l);
49 return (rl == 1 || rl == -1);
52 static inline Lisp_Object
53 ent_sum_INT_T(Lisp_Object l, Lisp_Object r)
55 return make_integer(ent_int(l) + ent_int(r));
57 static inline Lisp_Object
58 ent_diff_INT_T(Lisp_Object l, Lisp_Object r)
60 return make_integer(ent_int(l) - ent_int(r));
62 static inline Lisp_Object
63 ent_neg_INT_T(Lisp_Object l)
65 return make_integer(-ent_int(l));
67 static inline Lisp_Object
68 ent_prod_INT_T(Lisp_Object l, Lisp_Object r)
70 /* Due to potential overflow, we compute using MP */
71 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
77 bigz_set_long(ent_scratch_bigz, ent_int(l));
78 bigz_set_long(bz, ent_int(r));
79 bigz_mul(ent_scratch_bigz, ent_scratch_bigz, bz);
80 result = ent_mpz_downgrade_maybe(ent_scratch_bigz);
85 return make_integer(ent_int(l) * ent_int(r));
88 static inline Lisp_Object
89 ent_div_INT_T(Lisp_Object l, Lisp_Object r)
91 if (ent_int(r) == 0) {
93 return make_indef(POS_INFINITY);
94 else if (ent_int(l) < 0)
95 return make_indef(NEG_INFINITY);
97 return make_indef(NOT_A_NUMBER);
99 return make_integer(ent_int(l)/ent_int(r));
102 static inline Lisp_Object
103 ent_inv_INT_T(Lisp_Object l)
105 if (ent_int(l) == 0) {
106 return make_indef(POS_INFINITY);
108 return make_integer(1L/ent_int(l));
111 static inline Lisp_Object
112 ent_rem_INT_T(Lisp_Object l, Lisp_Object r)
116 if (ent_int(r) == 0) {
119 rem = ent_int(l) % ent_int(r);
121 return make_int(rem);
123 static inline Lisp_Object
124 ent_mod_INT_T(Lisp_Object l, Lisp_Object r)
128 if (ent_int(r) == 0) {
131 rem = ent_int(l) % ent_int(r);
133 /* If the "remainder" comes out with the wrong sign, fix it. */
134 if (ent_int(r) < 0 ? rem > 0 : rem < 0)
137 return make_int(rem);
140 static inline Lisp_Object
141 ent_pow_INT_T_integer(Lisp_Object l, Lisp_Object r)
144 EMACS_INT x = ent_int(l);
145 EMACS_INT y = ent_int(r);
151 retval = (y & 1) ? -1 : 1;
160 y = (EMACS_UINT) y >> 1;
163 return make_int(retval);
166 /* comparison relations */
168 ent_lt_int(Lisp_Object l, Lisp_Object r)
170 return (ent_int(l) < ent_int(r));
173 ent_gt_int(Lisp_Object l, Lisp_Object r)
175 return (ent_int(l) > ent_int(r));
178 ent_eq_int(Lisp_Object l, Lisp_Object r)
180 return (ent_int(l) == ent_int(r));
183 ent_ne_int(Lisp_Object l, Lisp_Object r)
185 return (ent_int(l) != ent_int(r));
189 static inline Lisp_Object
190 ent_lift_INT_T_INT_T(Lisp_Object number, unsigned long SXE_UNUSED(precision))
192 return make_int(ent_int(number));
195 static inline Lisp_Object
196 ent_lift_INT_T(Lisp_Object number, ent_lift_args_t SXE_UNUSED(unused))
198 return make_int(ent_int(number));
203 ent_int_nullary_optable_init(void)
207 ent_nullop_register(ASE_NULLARY_OP_ZERO, INT_T, Qzero);
208 ent_nullop_register(ASE_NULLARY_OP_ONE, INT_T, Qone);
212 ent_int_unary_optable_init(void)
214 ent_unop_register(ASE_UNARY_OP_NEG, INT_T, ent_neg_INT_T);
215 ent_unop_register(ASE_UNARY_OP_INV, INT_T, ent_inv_INT_T);
219 ent_int_binary_optable_init(void)
221 ent_binop_register(ASE_BINARY_OP_SUM, INT_T, INT_T, ent_sum_INT_T);
222 ent_binop_register(ASE_BINARY_OP_DIFF, INT_T, INT_T, ent_diff_INT_T);
223 ent_binop_register(ASE_BINARY_OP_PROD, INT_T, INT_T, ent_prod_INT_T);
224 ent_binop_register(ASE_BINARY_OP_DIV, INT_T, INT_T, ent_div_INT_T);
225 ent_binop_register(ASE_BINARY_OP_QUO, INT_T, INT_T, ent_div_INT_T);
226 ent_binop_register(ASE_BINARY_OP_REM, INT_T, INT_T, ent_rem_INT_T);
227 ent_binop_register(ASE_BINARY_OP_MOD, INT_T, INT_T, ent_mod_INT_T);
228 ent_binop_register(ASE_BINARY_OP_POW, INT_T, INT_T,
229 ent_pow_INT_T_integer);
233 ent_int_unary_reltable_init(void)
235 ent_unrel_register(ASE_UNARY_REL_ZEROP, INT_T, ent_int_zerop);
236 ent_unrel_register(ASE_UNARY_REL_ONEP, INT_T, ent_int_onep);
237 ent_unrel_register(ASE_UNARY_REL_UNITP, INT_T, ent_int_unitp);
241 ent_int_binary_reltable_init(void)
243 ent_binrel_register(ASE_BINARY_REL_LESSP,
244 INT_T, INT_T, ent_lt_int);
245 ent_binrel_register(ASE_BINARY_REL_GREATERP,
246 INT_T, INT_T, ent_gt_int);
247 ent_binrel_register(ASE_BINARY_REL_EQUALP,
248 INT_T, INT_T, ent_eq_int);
249 ent_binrel_register(ASE_BINARY_REL_NEQP,
250 INT_T, INT_T, ent_ne_int);
254 ent_int_lifttable_init(void)
256 ent_lift_register(INT_T, INT_T, ent_lift_INT_T);
257 ent_lift_register(INDEF_T, INT_T, ent_lift_INDEF_T_COMPARABLE);
260 void init_optables_INT_T(void)
262 ent_int_nullary_optable_init();
263 ent_int_unary_optable_init();
264 ent_int_binary_optable_init();
265 ent_int_unary_reltable_init();
266 ent_int_binary_reltable_init();
267 ent_int_lifttable_init();
270 void init_ent_int(void)
274 void syms_of_ent_int(void)
278 void vars_of_ent_int(void)
280 Vmost_negative_int = EMACS_INT_MIN;
281 DEFVAR_CONST_INT("most-negative-fixnum", &Vmost_negative_int /*
282 The (ordinary) integer closest in value to negative infinity.
285 Vmost_positive_int = EMACS_INT_MAX;
286 DEFVAR_CONST_INT("most-positive-fixnum", &Vmost_positive_int /*
287 The (ordinary) integer closest in value to positive infinity.
291 /* ent-int.c ends here */