← Back to branch summary

~ubuntu-branches/ubuntu/vivid/gcl/vivid

« back to all changes in this revision

Viewing changes to o/big.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2002-03-04 14:29:59 UTC
  • Revision ID: james.westby@ubuntu.com-20020304142959-dey14w08kr7lldu3
Tags: upstream-2.5.0.cvs20020219
Import upstream version 2.5.0.cvs20020219

Show diffs side-by-side

added added

removed removed

Lines of Context:
o/big.c
 
1
  /* Copyright William F. Schelter 1991
 
2
   Bignum routines.
 
3
 
 
4
 
 
5
   
 
6
num_arith.c: add_int_big
 
7
num_arith.c: big_minus
 
8
num_arith.c: big_plus
 
9
num_arith.c: big_quotient_remainder
 
10
num_arith.c: big_sign
 
11
num_arith.c: big_times
 
12
num_arith.c: complement_big
 
13
num_arith.c: copy_big
 
14
num_arith.c: div_int_big
 
15
num_arith.c: mul_int_big
 
16
num_arith.c: normalize_big
 
17
num_arith.c: normalize_big_to_object
 
18
num_arith.c: stretch_big
 
19
num_arith.c: sub_int_big
 
20
num_comp.c: big_compare
 
21
num_comp.c: big_sign
 
22
num_log.c: big_sign
 
23
num_log.c: copy_to_big
 
24
num_log.c: normalize_big
 
25
num_log.c: normalize_big_to_object
 
26
num_log.c: stretch_big
 
27
num_pred.c: big_sign
 
28
number.c: big_to_double
 
29
predicate.c: big_compare
 
30
typespec.c: big_sign
 
31
print.d: big_minus
 
32
print.d: big_sign
 
33
print.d: big_zerop
 
34
print.d: copy_big
 
35
print.d: div_int_big
 
36
read.d: add_int_big
 
37
read.d: big_to_double
 
38
read.d: complement_big
 
39
read.d: mul_int_big
 
40
read.d: normalize_big
 
41
read.d: normalize_big_to_object
 
42
 
 
43
 */
 
44
 
 
45
#define remainder gclremainder
 
46
#define NEED_MP_H
 
47
#include "include.h"
 
48
 
 
49
static char* (*gcl_gmp_allocfun)() = alloc_contblock;
 
50
 
 
51
DEFUN("SET-GMP-ALLOCATE-RELOCATABLE",object,fSset_gmp_allocate_relocatable,SI,1,1,NONE,OO,OO,OO,OO,
 
52
      "Set the allocation to be relocatble ")(flag)
 
53
     object flag;
 
54
{
 
55
  if (flag == Ct) {
 
56
    gcl_gmp_allocfun = alloc_relblock;
 
57
  } else {
 
58
    gcl_gmp_allocfun = alloc_contblock;
 
59
  }
 
60
  RETURN1(flag);
 
61
}
 
62
 
 
63
#ifdef GMP
 
64
#include "gmp_big.c"
 
65
#else
 
66
#include "pari_big.c"
 
67
#endif
 
68
 
 
69
 
 
70
 
 
71
int big_sign(x)
 
72
     object x;
 
73
{
 
74
  return BIG_SIGN(x);
 
75
}
 
76
 
 
77
void set_big_sign(x,sign)
 
78
     object x;
 
79
     int sign;
 
80
{
 
81
  SET_BIG_SIGN(x,sign);
 
82
}
 
83
 
 
84
void zero_big(x)
 
85
     object x;
 
86
{
 
87
  ZERO_BIG(x);
 
88
}
 
89
 
 
90
 
 
91
#ifndef HAVE_MP_COERCE_TO_STRING
 
92
 
 
93
double digitsPerBit[37]={ 0,0,
 
94
1.0, /* 2 */
 
95
0.6309297535714574, /* 3 */
 
96
0.5, /* 4 */
 
97
0.4306765580733931, /* 5 */
 
98
0.3868528072345416, /* 6 */
 
99
0.3562071871080222, /* 7 */
 
100
0.3333333333333334, /* 8 */
 
101
0.3154648767857287, /* 9 */
 
102
0.3010299956639811, /* 10 */
 
103
0.2890648263178878, /* 11 */
 
104
0.2789429456511298, /* 12 */
 
105
0.2702381544273197, /* 13 */
 
106
0.2626495350371936, /* 14 */
 
107
0.2559580248098155, /* 15 */
 
108
0.25, /* 16 */
 
109
0.244650542118226, /* 17 */
 
110
0.2398124665681315, /* 18 */
 
111
0.2354089133666382, /* 19 */
 
112
0.2313782131597592, /* 20 */
 
113
0.227670248696953, /* 21 */
 
114
0.2242438242175754, /* 22 */
 
115
0.2210647294575037, /* 23 */
 
116
0.2181042919855316, /* 24 */
 
117
0.2153382790366965, /* 25 */
 
118
0.2127460535533632, /* 26 */
 
119
0.2103099178571525, /* 27 */
 
120
0.2080145976765095, /* 28 */
 
121
0.2058468324604345, /* 29 */
 
122
0.2037950470905062, /* 30 */
 
123
0.2018490865820999, /* 31 */
 
124
0.2, /* 32 */
 
125
0.1982398631705605, /* 33 */
 
126
0.1965616322328226, /* 34 */
 
127
0.1949590218937863, /* 35 */
 
128
0.1934264036172708, /* 36 */
 
129
};
 
130
 
 
131
object
 
132
coerce_big_to_string(x,printbase)
 
133
     int printbase;
 
134
     object x;
 
135
{ int i;
 
136
 int sign=big_sign(x);
 
137
 object b;
 
138
 int size = (int)((ceil(MP_SIZE_IN_BASE2(MP(x))* digitsPerBit[printbase]))+.01);
 
139
 char *q,*p = alloca(size+5);
 
140
 q=p;
 
141
 if(sign<=0) {
 
142
   *q++ = '-';
 
143
   b=big_minus(x);
 
144
 } else {
 
145
   b=copy_big(x);
 
146
 }
 
147
 while (!big_zerop(b))
 
148
   *q++=digit_weight(div_int_big(printbase, b),printbase);
 
149
 *q++=0;
 
150
  object ans = alloc_simple_string(q-p);
 
151
  ans->ust.ust_self=alloc_relblock(ans->ust.ust_dim);
 
152
  bcopy(ans->ust.ust_self,p,ans->ust.ust_dim);
 
153
  ans->ust.ust_fillp=ans->ust.ust_dim-1;
 
154
  return ans;
 
155
}
 
156
 
 
157
#endif