← Back to branch summary

~ubuntu-branches/ubuntu/utopic/gcl/utopic

« back to all changes in this revision

Viewing changes to .pc/2.6.10pre-test-6/o/number.c

  • Committer: Package Import Robot
  • Author(s): Camm Maguire
  • Date: 2013-11-13 18:39:19 UTC
  • mfrom: (13.1.102 sid)
  • Revision ID: package-import@ubuntu.com-20131113183919-cs74swffevkpkp1l
Tags: 2.6.10-1
New upstream release

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/2.6.10pre-test-6/o/number.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
 
        number.c
24
 
        IMPLEMENTATION-DEPENDENT
25
 
 
26
 
        This file creates some implementation dependent constants.
27
 
*/
28
 
 
29
 
#define IN_NUM_CO
30
 
 
31
 
#include "include.h"
32
 
#include "num_include.h"
33
 
 
34
 
 
35
 
long
36
 
fixint(object x)
37
 
{
38
 
        if (type_of(x) != t_fixnum)
39
 
                FEwrong_type_argument(sLfixnum, x);
40
 
        return(fix(x));
41
 
}
42
 
 
43
 
int
44
 
fixnnint(object x)
45
 
{
46
 
        if (type_of(x) != t_fixnum || fix(x) < 0)
47
 
                FEerror("~S is not a non-negative fixnum.", 1, x);
48
 
        return(fix(x));
49
 
}
50
 
#if 0
51
 
object small_fixnum ( int i ) {
52
 
#include <assert.h>    
53
 
    assert ( ( -SMALL_FIXNUM_LIMIT <= i ) && ( i < SMALL_FIXNUM_LIMIT ) ); 
54
 
    (object) small_fixnum_table + SMALL_FIXNUM_LIMIT + i;
55
 
}
56
 
#endif
57
 
 
58
 
#if !defined(IM_FIX_BASE)
59
 
 
60
 
#define BIGGER_FIXNUM_RANGE
61
 
 
62
 
#ifdef BIGGER_FIXNUM_RANGE
63
 
struct {int min,max;} bigger_fixnums;
64
 
 
65
 
struct fixnum_struct *bigger_fixnum_table;
66
 
DEFUN_NEW("ALLOCATE-BIGGER-FIXNUM-RANGE",object,fSallocate_bigger_fixnum_range,SI,2,2,NONE,OI,IO,OO,OO,(fixnum min,fixnum max),"")  {
67
 
  int j; 
68
 
  if (min > max) FEerror("Need Min <= Max",0);
69
 
  bigger_fixnum_table=(void *)malloc(sizeof(struct fixnum_struct)*(max - min));
70
 
  
71
 
  for (j=min ; j < max ; j=j+1) {               
72
 
    object x=(object)(bigger_fixnum_table+j-min);
73
 
    x->fw=0;
74
 
    set_type_of(x,t_fixnum);
75
 
    x->FIX.FIXVAL=j;
76
 
  }
77
 
  bigger_fixnums.min=min;
78
 
  bigger_fixnums.max=max;
79
 
  
80
 
  return Ct;
81
 
}
82
 
#endif
83
 
#endif
84
 
 
85
 
 
86
 
object
87
 
make_fixnum1(long i)
88
 
{
89
 
        object x;
90
 
 
91
 
        /* In a macro now */
92
 
/*      if (-SMALL_FIXNUM_LIMIT <= i && i < SMALL_FIXNUM_LIMIT) */
93
 
/*              return(small_fixnum(i)); */
94
 
#ifdef BIGGER_FIXNUM_RANGE
95
 
        if (bigger_fixnum_table)
96
 
          { if (i >= bigger_fixnums.min
97
 
                && i < bigger_fixnums.max)
98
 
              return (object)(bigger_fixnum_table +(i -bigger_fixnums.min));
99
 
          }
100
 
#endif  
101
 
              
102
 
        x = alloc_object(t_fixnum);         
103
 
        set_fix(x,i);
104
 
        return(x);
105
 
}
106
 
 
107
 
object
108
 
make_ratio(object num, object den)
109
 
{
110
 
        object g, r, integer_divide1(object x, object y), get_gcd(object x, object y);
111
 
        vs_mark;
112
 
 
113
 
        if (number_zerop(den))
114
 
                FEerror("Zero denominator.", 0);
115
 
        if (number_zerop(num))
116
 
                return(small_fixnum(0));
117
 
        if (type_of(den) == t_fixnum && fix(den) == 1)
118
 
                return(num);
119
 
        if (number_minusp(den)) {
120
 
                num = number_negate(num);
121
 
                vs_push(num);
122
 
                den = number_negate(den);
123
 
                vs_push(den);
124
 
        }
125
 
        g = get_gcd(num, den);
126
 
        vs_push(g);
127
 
        num = integer_divide1(num, g);
128
 
        vs_push(num);
129
 
        den = integer_divide1(den, g);
130
 
        vs_push(den);
131
 
        if(type_of(den) == t_fixnum && fix(den) == 1) {
132
 
                vs_reset;
133
 
                return(num);
134
 
        }
135
 
        if(type_of(den) == t_fixnum && fix(den) == -1) {
136
 
                num = number_negate(num);
137
 
                vs_reset;
138
 
                return(num);
139
 
        }
140
 
        r = alloc_object(t_ratio);
141
 
        r->rat.rat_num = num;
142
 
        r->rat.rat_den = den;
143
 
        vs_reset;
144
 
        return(r);
145
 
}
146
 
 
147
 
object
148
 
make_shortfloat(double f)
149
 
{
150
 
        object x;
151
 
 
152
 
        if (f == (shortfloat)0.0)
153
 
                return(shortfloat_zero);
154
 
        x = alloc_object(t_shortfloat);
155
 
        sf(x) = (shortfloat)f;
156
 
        return(x);
157
 
}
158
 
 
159
 
object
160
 
make_longfloat(longfloat f)
161
 
{
162
 
        object x;
163
 
 
164
 
        if (f == (longfloat)0.0)
165
 
                return(longfloat_zero);
166
 
        x = alloc_object(t_longfloat);
167
 
        lf(x) = f;
168
 
        return(x);
169
 
}
170
 
 
171
 
object
172
 
make_complex(object r, object i)
173
 
{
174
 
        object c;
175
 
        vs_mark;
176
 
 
177
 
        switch (type_of(r)) {
178
 
        case t_fixnum:
179
 
        case t_bignum:
180
 
        case t_ratio:
181
 
                switch (type_of(i)) {
182
 
                case t_fixnum:
183
 
                        if (fix(i) == 0)
184
 
                                return(r);
185
 
                        break;
186
 
                case t_shortfloat:
187
 
                        r = make_shortfloat((shortfloat)number_to_double(r));
188
 
                        vs_push(r);
189
 
                        break;
190
 
                case t_longfloat:
191
 
                        r = make_longfloat(number_to_double(r));
192
 
                        vs_push(r);
193
 
                        break;
194
 
                default:
195
 
                  break;
196
 
                }
197
 
                break;
198
 
        case t_shortfloat:
199
 
                switch (type_of(i)) {
200
 
                case t_fixnum:
201
 
                case t_bignum:
202
 
                case t_ratio:
203
 
                        i = make_shortfloat((shortfloat)number_to_double(i));
204
 
                        vs_push(i);
205
 
                        break;
206
 
                case t_longfloat:
207
 
                        r = make_longfloat((double)(sf(r)));
208
 
                        vs_push(r);
209
 
                        break;
210
 
                default:
211
 
                  break;
212
 
                }
213
 
                break;
214
 
        case t_longfloat:
215
 
                switch (type_of(i)) {
216
 
                case t_fixnum:
217
 
                case t_bignum:
218
 
                case t_ratio:
219
 
                case t_shortfloat:
220
 
                        i = make_longfloat(number_to_double(i));
221
 
                        vs_push(i);
222
 
                        break;
223
 
                default:
224
 
                  break;
225
 
                }
226
 
                break;
227
 
        default:
228
 
          break;
229
 
        }                       
230
 
        c = alloc_object(t_complex);
231
 
        c->cmp.cmp_real = r;
232
 
        c->cmp.cmp_imag = i;
233
 
        vs_reset;
234
 
        return(c);
235
 
}
236
 
 
237
 
double
238
 
number_to_double(object x)
239
 
{
240
 
        switch(type_of(x)) {
241
 
        case t_fixnum:
242
 
                return((double)(fix(x)));
243
 
 
244
 
        case t_bignum:
245
 
                return(big_to_double(/*  (struct bignum *) */x));
246
 
 
247
 
        case t_ratio:
248
 
          
249
 
          /* vs_base=vs_top; */
250
 
          /* vs_push(x); */
251
 
          /* Lround(); */
252
 
          /* if (vs_base[0]!=small_fixnum(0))  */
253
 
          /*   return number_to_double(vs_base[0])+number_to_double(vs_base[1]); */
254
 
          /* else */
255
 
          {
256
 
            double dx,dy;
257
 
            object xx,yy;
258
 
            
259
 
            for (xx=x->rat.rat_num,yy=x->rat.rat_den,dx=number_to_double(xx),dy=number_to_double(yy);
260
 
                 dx && dy && (!ISNORMAL(dx) || !ISNORMAL(dy));) {
261
 
 
262
 
              if (ISNORMAL(dx))
263
 
                dx*=0.5;
264
 
              else {
265
 
                xx=integer_divide1(xx,small_fixnum(2));
266
 
                dx=number_to_double(xx);
267
 
              }
268
 
 
269
 
              if (ISNORMAL(dy))
270
 
                dy*=0.5;
271
 
              else {
272
 
                yy=integer_divide1(yy,small_fixnum(2));
273
 
                dy=number_to_double(yy);
274
 
              }
275
 
 
276
 
            }
277
 
 
278
 
            return dx/dy;
279
 
          }
280
 
 
281
 
        case t_shortfloat:
282
 
                return((double)(sf(x)));
283
 
 
284
 
        case t_longfloat:
285
 
                return(lf(x));
286
 
 
287
 
        default:
288
 
                wrong_type_argument(TSor_rational_float, x);
289
 
                return(0.0);
290
 
        }
291
 
}
292
 
 
293
 
void
294
 
gcl_init_number(void)
295
 
{
296
 
 
297
 
#if !defined(IM_FIX_BASE)
298
 
  FFN(fSallocate_bigger_fixnum_range)(-1024,1023);
299
 
#endif
300
 
 
301
 
        shortfloat_zero = alloc_object(t_shortfloat);
302
 
        sf(shortfloat_zero) = (shortfloat)0.0;
303
 
        longfloat_zero = alloc_object(t_longfloat);
304
 
        lf(longfloat_zero) = (longfloat)0.0;
305
 
        enter_mark_origin(&shortfloat_zero);
306
 
        enter_mark_origin(&longfloat_zero);
307
 
 
308
 
        make_constant("MOST-POSITIVE-FIXNUM",
309
 
                      make_fixnum(MOST_POSITIVE_FIX));
310
 
        make_constant("MOST-NEGATIVE-FIXNUM",
311
 
                      make_fixnum(MOST_NEGATIVE_FIX));
312
 
 
313
 
        gcl_init_big();
314
 
        gcl_init_num_pred();
315
 
        gcl_init_num_comp();
316
 
        gcl_init_num_arith();
317
 
        gcl_init_num_co();
318
 
        gcl_init_num_log();
319
 
        gcl_init_num_sfun();
320
 
        gcl_init_num_rand();
321
 
}