1 /* Part of SWI-Prolog
2
3 Author: Jan Wielemaker
4 E-mail: J.Wielemaker@vu.nl
5 WWW: http://www.swi-prolog.org
6 Copyright (c) 2005-2020, University of Amsterdam
7 VU University Amsterdam
8 CWI, Amsterdam
9 All rights reserved.
10
11 Redistribution and use in source and binary forms, with or without
12 modification, are permitted provided that the following conditions
13 are met:
14
15 1. Redistributions of source code must retain the above copyright
16 notice, this list of conditions and the following disclaimer.
17
18 2. Redistributions in binary form must reproduce the above copyright
19 notice, this list of conditions and the following disclaimer in
20 the documentation and/or other materials provided with the
21 distribution.
22
23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34 POSSIBILITY OF SUCH DAMAGE.
35 */
36
37 #ifndef O_PLGMP_INCLUDED
38 #define O_PLGMP_INCLUDED
39
40 #define COMMON(type) SO_LOCAL type
41
42 #ifdef O_GMP
43 #include <gmp.h>
44
45 #define O_MY_GMP_ALLOC 1
46 #define O_GMP_PRECHECK_ALLOCATIONS 1 /* GMP 4.2.3 uses abort() sometimes */
47
48 COMMON(void) initGMP(void);
49 COMMON(void) cleanupGMP(void);
50 COMMON(void) get_integer(word w, number *n);
51 COMMON(void) get_rational(word w, number *n);
52 COMMON(Code) get_mpz_from_code(Code pc, mpz_t mpz);
53 COMMON(Code) get_mpq_from_code(Code pc, mpq_t mpq);
54 COMMON(int) promoteToMPZNumber(number *n);
55 COMMON(int) promoteToMPQNumber(number *n);
56 COMMON(void) ensureWritableNumber(Number n);
57 COMMON(void) clearGMPNumber(Number n);
58 COMMON(void) addMPZToBuffer(Buffer b, mpz_t mpz);
59 COMMON(void) addMPQToBuffer(Buffer b, mpq_t mpq);
60 COMMON(char *) loadMPZFromCharp(const char *data, Word r, Word *store);
61 COMMON(char *) loadMPQFromCharp(const char *data, Word r, Word *store);
62 COMMON(char *) skipMPZOnCharp(const char *data);
63 COMMON(char *) skipMPQOnCharp(const char *data);
64 COMMON(int) mpz_to_int64(mpz_t mpz, int64_t *i);
65 COMMON(int) mpz_to_uint64(mpz_t mpz, uint64_t *i);
66 COMMON(void) mpz_init_set_si64(mpz_t mpz, int64_t i);
67 COMMON(double) mpX_round(double f);
68 COMMON(double) mpq_to_double(mpq_t q);
69 COMMON(void) mpq_set_double(mpq_t q, double f);
70
71 #define clearNumber(n) \
72 do { if ( (n)->type != V_INTEGER ) clearGMPNumber(n); } while(0)
73
74 static inline word
mpz_size_stack(int sz)75 mpz_size_stack(int sz)
76 { return ((word)sz<<1) & ~(word)MP_RAT_MASK;
77 }
78
79 static inline word
mpq_size_stack(int sz)80 mpq_size_stack(int sz)
81 { return ((word)sz<<1) | MP_RAT_MASK;
82 }
83
84 static inline int
mpz_stack_size(word w)85 mpz_stack_size(word w)
86 { return (int)w>>1;
87 }
88
89 static inline int
mpq_stack_size(word w)90 mpq_stack_size(word w)
91 { return (int)w>>1;
92 }
93
94 #else /*O_GMP*/
95
96 #define get_integer(w, n) \
97 do \
98 { (n)->type = V_INTEGER; \
99 (n)->value.i = valInteger(w); \
100 } while(0)
101 #define get_rational(w, n) \
102 get_integer(w, n)
103
104 #define clearGMPNumber(n) (void)0
105 #define clearNumber(n) (void)0
106 #define ensureWritableNumber(n) (void)0
107 #define initGMP() (void)0
108
109 #endif /*O_GMP*/
110
111
112 /*******************************
113 * GMP ALLOCATION *
114 *******************************/
115
116 #define FE_NOTSET (-1)
117
118 #if O_MY_GMP_ALLOC
119 typedef struct mp_mem_header
120 { struct mp_mem_header *prev;
121 struct mp_mem_header *next;
122 struct ar_context *context;
123 } mp_mem_header;
124
125 typedef struct ar_context
126 { struct ar_context *parent;
127 size_t allocated;
128 int femode;
129 } ar_context;
130
131 #define O_GMP_LEAK_CHECK 0
132 #if O_GMP_LEAK_CHECK
133 #define GMP_LEAK_CHECK(g) g
134 #else
135 #define GMP_LEAK_CHECK(g)
136 #endif
137
138 #define AR_CTX ar_context __PL_ar_ctx = {0};
139 #define AR_BEGIN() \
140 do \
141 { __PL_ar_ctx.parent = LD->gmp.context; \
142 __PL_ar_ctx.femode = FE_NOTSET; \
143 LD->gmp.context = &__PL_ar_ctx; \
144 GMP_LEAK_CHECK(__PL_ar_ctx.allocated = LD->gmp.allocated); \
145 } while(0)
146 #define AR_END() \
147 do \
148 { LD->gmp.context = __PL_ar_ctx.parent; \
149 GMP_LEAK_CHECK(if ( __PL_ar_ctx.allocated != LD->gmp.allocated ) \
150 { Sdprintf("GMP: lost %ld bytes\n", \
151 LD->gmp.allocated-__PL_ar_ctx.allocated); \
152 }) \
153 } while(0)
154 #define AR_CLEANUP() \
155 do \
156 { if ( __PL_ar_ctx.femode != FE_NOTSET ) \
157 fesetround(__PL_ar_ctx.femode); \
158 mp_cleanup(&__PL_ar_ctx); \
159 } while(0)
160
161 COMMON(void) mp_cleanup(ar_context *ctx);
162
163 #else /*O_MY_GMP_ALLOC*/
164
165 typedef struct ar_context
166 { int femode;
167 } ar_context;
168
169
170 #define AR_CTX ar_context __PL_ar_ctx = {0};
171 #define AR_BEGIN() \
172 do { __PL_ar_ctx.femode = FE_NOTSET; \
173 } while(0)
174 #define AR_END() (void)0
175 #define AR_CLEANUP() \
176 do \
177 { if ( __PL_ar_ctx.femode != FE_NOTSET ) \
178 fesetround(__PL_ar_ctx.femode); \
179 } while(0)
180
181 #endif /*O_MY_GMP_ALLOC*/
182
183 #endif /*O_PLGMP_INCLUDED*/
184