File: float.c

package info (click to toggle)
gap-float 0.9.1%2Bds-6
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye
  • size: 612 kB
  • sloc: ansic: 2,537; cpp: 1,998; xml: 184; makefile: 103; sh: 1
file content (215 lines) | stat: -rw-r--r-- 5,008 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
/****************************************************************************
**
*W  float.c                      GAP source                 Laurent Bartholdi
**
*Y  Copyright (C) 2008-2012 Laurent Bartholdi
**
**  This file contains the main dll of the float package.
**  It defers to mpfr.c, mpfi.c etc. for initialization
*/
#undef TRACE_ALLOC

#include "floatconfig.h"

#undef PACKAGE
#undef PACKAGE_BUGREPORT
#undef PACKAGE_NAME
#undef PACKAGE_STRING
#undef PACKAGE_TARNAME
#undef PACKAGE_URL
#undef PACKAGE_VERSION

#include <string.h>
#include <stdio.h>
#include <gmp.h>

#include "src/compiled.h"
#include "floattypes.h"

Obj FLOAT_INFINITY_STRING, /* pretty strings */
  FLOAT_NINFINITY_STRING,
  FLOAT_EMPTYSET_STRING,
  FLOAT_REAL_STRING,
  FLOAT_I_STRING;

Obj NEW_DATOBJ(size_t size, Obj type)
{
  Obj o = NewBag(T_DATOBJ,sizeof(Obj)+size);
  SET_TYPE_DATOBJ(o, type);
  return o;
}

/****************************************************************
 * convert long GAP integer to gmp signed integers and back:
 * mpz (malloc'ed) or MPZ (on GAP heap)
 * in the current gmp implementation, we put mpz's as follows:
 * +------------+------------+------------+------------+---
 * | _mp_alloc  |  _mp_size  |  _mp_d  ---+--> limb0   |   limb1
 * +------------+------------+------------+------------+---
 ****************************************************************/
Obj MPZ_LONGINT (Obj obj) {
  Obj f;
  mpz_ptr p;
  int s;

  f = NewBag(T_DATOBJ,SIZE_OBJ(obj)+sizeof(__mpz_struct));
  p = mpz_MPZ(f);
  s = SIZE_INT(obj);
  p->_mp_alloc = s;

  memcpy (p->_mp_d, ADDR_INT(obj), s*sizeof(mp_limb_t));

  while (s > 1 && !p->_mp_d[s-1]) s--; /* trim trailing 0's, gmp wants it */

  if (TNUM_OBJ(obj) == T_INTPOS)
    p->_mp_size = s;
  else if (TNUM_OBJ(obj) == T_INTNEG)
    p->_mp_size = -s;
  else
    ErrorQuit("Internal error: MPZ_LONGINT called with non-LONGINT. Repent.",0L,0L);

  return f;
}

mpz_ptr mpz_MPZ (Obj obj) {
  mpz_ptr p = (mpz_ptr) ADDR_OBJ(obj);

  /* adjust pointer, in case the block moved in a garbage-collect */
  p->_mp_d = (mp_limb_t *) (p+1);

  return p;
}

Obj INT_mpz(mpz_ptr z)
{
  if (mpz_sgn(z) == 0) {
    return INTOBJ_INT(0);
  }

  Obj res;
  if (mpz_sgn(z) > 0)
    res = NewBag(T_INTPOS, mpz_size(z)*sizeof(mp_limb_t));
  else
    res = NewBag(T_INTNEG, mpz_size(z)*sizeof(mp_limb_t));
  memcpy (ADDR_INT(res), z[0]._mp_d, mpz_size(z)*sizeof(mp_limb_t));

  res = GMP_NORMALIZE(res);
  res = GMP_REDUCE(res);

  return res;
}

#if 0
/****************************************************************
 * debug allocation / deallocation
 ****************************************************************/
static void *alloc_func (size_t s)
{
  void *res = malloc(s);
#ifdef TRACE_ALLOC
  printf("#W gmp_default_allocate called for bag of size %d, returned %x\n", s, (int) res);
#endif
  return res;
}

static void *realloc_func (void *p, size_t old, size_t new)
{
  void *res = realloc(p, new);
#ifdef TRACE_ALLOC
  printf("#W gmp_default_reallocate called on bag of size %d->%d at %x, returned %x\n", old, new, (int) p, (int) res);
#endif
  return res;
}

static void free_func (void *p, size_t s)
{
  free (p);
#ifdef TRACE_ALLOC
  printf("#W gmp_default_free called on bag of size %d at %x\n", s, (int) p);
#endif
}
#endif

/****************************************************************
 * initialize package
 ****************************************************************/
static Int InitKernel (StructInitInfo *module)
{
  ImportGVarFromLibrary("FLOAT_INFINITY_STRING", &FLOAT_INFINITY_STRING);
  ImportGVarFromLibrary("FLOAT_NINFINITY_STRING", &FLOAT_NINFINITY_STRING);
  ImportGVarFromLibrary("FLOAT_EMPTYSET_STRING", &FLOAT_EMPTYSET_STRING);
  ImportGVarFromLibrary("FLOAT_REAL_STRING", &FLOAT_REAL_STRING);
  ImportGVarFromLibrary("FLOAT_I_STRING", &FLOAT_I_STRING);

#ifdef USE_MPFR
  InitMPFRKernel();
#endif
#ifdef USE_MPFI
  InitMPFIKernel();
#endif
#ifdef USE_MPC
  InitMPCKernel();
#endif
#ifdef USE_FPLLL
  InitFPLLLKernel();
#endif
#ifdef USE_MPD
  InitMPDKernel();
#endif
#ifdef USE_CXSC
  InitCXSCKernel();
#endif
  return 0;
}

static Int InitLibrary (StructInitInfo *module)
{
#ifdef USE_MPFI
  InitMPFILibrary();
#endif
#ifdef USE_MPFR
  InitMPFRLibrary();
#endif
#ifdef USE_MPC
  InitMPCLibrary();
#endif
#ifdef USE_FPLLL
  InitFPLLLLibrary();
#endif
#ifdef USE_MPD
  InitMPDLibrary();
#endif
#ifdef USE_CXSC
  InitCXSCLibrary();
#endif
#if 0
  mp_set_memory_functions (alloc_func, realloc_func, free_func);
#endif

  return 0;
}

static StructInitInfo module = {
#ifdef FLOATSTATIC
    .type = MODULE_STATIC,
#else
    .type = MODULE_DYNAMIC,
#endif
    .name = "float",
    .initKernel = InitKernel,
    .initLibrary = InitLibrary,
};

#ifdef FLOAT_STATIC
StructInitInfo *Init__float (void)
#else
StructInitInfo *Init__Dynamic (void)
#endif
{
  return &module;
}

/****************************************************************************
**
*E  float.c  . . . . . . . . . . . . . . . . . . . . . . . . . . . .ends here
*/