1 | /* |
---|
2 | *---------------------------------------------------------------------- |
---|
3 | * |
---|
4 | * tclTomMathInterface.c -- |
---|
5 | * |
---|
6 | * This file contains procedures that are used as a 'glue' layer between |
---|
7 | * Tcl and libtommath. |
---|
8 | * |
---|
9 | * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. |
---|
10 | * |
---|
11 | * See the file "license.terms" for information on usage and redistribution of |
---|
12 | * this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
13 | * |
---|
14 | * RCS: @(#) $Id: tclTomMathInterface.c,v 1.10 2007/12/13 15:23:20 dgp Exp $ |
---|
15 | */ |
---|
16 | |
---|
17 | #include "tclInt.h" |
---|
18 | #include "tommath.h" |
---|
19 | #include <limits.h> |
---|
20 | |
---|
21 | extern TclTomMathStubs tclTomMathStubs; |
---|
22 | |
---|
23 | /* |
---|
24 | *---------------------------------------------------------------------- |
---|
25 | * |
---|
26 | * TclTommath_Init -- |
---|
27 | * |
---|
28 | * Initializes the TclTomMath 'package', which exists as a |
---|
29 | * placeholder so that the package data can be used to hold |
---|
30 | * a stub table pointer. |
---|
31 | * |
---|
32 | * Results: |
---|
33 | * Returns a standard Tcl result. |
---|
34 | * |
---|
35 | * Side effects: |
---|
36 | * Installs the stub table for tommath. |
---|
37 | * |
---|
38 | *---------------------------------------------------------------------- |
---|
39 | */ |
---|
40 | |
---|
41 | int |
---|
42 | TclTommath_Init( |
---|
43 | Tcl_Interp* interp /* Tcl interpreter */ |
---|
44 | ) { |
---|
45 | /* TIP #268: Full patchlevel instead of just major.minor */ |
---|
46 | |
---|
47 | if (Tcl_PkgProvideEx(interp, "tcl::tommath", TCL_PATCH_LEVEL, |
---|
48 | (ClientData)&tclTomMathStubs) != TCL_OK) { |
---|
49 | return TCL_ERROR; |
---|
50 | } |
---|
51 | return TCL_OK; |
---|
52 | } |
---|
53 | |
---|
54 | /* |
---|
55 | *---------------------------------------------------------------------- |
---|
56 | * |
---|
57 | * TclBN_epoch -- |
---|
58 | * |
---|
59 | * Return the epoch number of the TclTomMath stubs table |
---|
60 | * |
---|
61 | * Results: |
---|
62 | * Returns an arbitrary integer that does not decrease with |
---|
63 | * release. Stubs tables with different epochs are incompatible. |
---|
64 | * |
---|
65 | *---------------------------------------------------------------------- |
---|
66 | */ |
---|
67 | |
---|
68 | int |
---|
69 | TclBN_epoch(void) |
---|
70 | { |
---|
71 | return TCLTOMMATH_EPOCH; |
---|
72 | } |
---|
73 | |
---|
74 | /* |
---|
75 | *---------------------------------------------------------------------- |
---|
76 | * |
---|
77 | * TclBN_revision -- |
---|
78 | * |
---|
79 | * Returns the revision level of the TclTomMath stubs table |
---|
80 | * |
---|
81 | * Results: |
---|
82 | * Returns an arbitrary integer that increases with revisions. |
---|
83 | * If a client requires a given epoch and revision, any Stubs table |
---|
84 | * with the same epoch and an equal or higher revision satisfies |
---|
85 | * the request. |
---|
86 | * |
---|
87 | *---------------------------------------------------------------------- |
---|
88 | */ |
---|
89 | |
---|
90 | int |
---|
91 | TclBN_revision(void) |
---|
92 | { |
---|
93 | return TCLTOMMATH_REVISION; |
---|
94 | } |
---|
95 | #if 0 |
---|
96 | |
---|
97 | /* |
---|
98 | *---------------------------------------------------------------------- |
---|
99 | * |
---|
100 | * TclBNAlloc -- |
---|
101 | * |
---|
102 | * Allocate memory for libtommath. |
---|
103 | * |
---|
104 | * Results: |
---|
105 | * Returns a pointer to the allocated block. |
---|
106 | * |
---|
107 | * This procedure is a wrapper around Tcl_Alloc, needed because of a |
---|
108 | * mismatched type signature between Tcl_Alloc and malloc. |
---|
109 | * |
---|
110 | *---------------------------------------------------------------------- |
---|
111 | */ |
---|
112 | |
---|
113 | extern void * |
---|
114 | TclBNAlloc( |
---|
115 | size_t x) |
---|
116 | { |
---|
117 | return (void *) Tcl_Alloc((unsigned int) x); |
---|
118 | } |
---|
119 | |
---|
120 | /* |
---|
121 | *---------------------------------------------------------------------- |
---|
122 | * |
---|
123 | * TclBNRealloc -- |
---|
124 | * |
---|
125 | * Change the size of an allocated block of memory in libtommath |
---|
126 | * |
---|
127 | * Results: |
---|
128 | * Returns a pointer to the allocated block. |
---|
129 | * |
---|
130 | * This procedure is a wrapper around Tcl_Realloc, needed because of a |
---|
131 | * mismatched type signature between Tcl_Realloc and realloc. |
---|
132 | * |
---|
133 | *---------------------------------------------------------------------- |
---|
134 | */ |
---|
135 | |
---|
136 | void * |
---|
137 | TclBNRealloc( |
---|
138 | void *p, |
---|
139 | size_t s) |
---|
140 | { |
---|
141 | return (void *) Tcl_Realloc((char *) p, (unsigned int) s); |
---|
142 | } |
---|
143 | |
---|
144 | /* |
---|
145 | *---------------------------------------------------------------------- |
---|
146 | * |
---|
147 | * TclBNFree -- |
---|
148 | * |
---|
149 | * Free allocated memory in libtommath. |
---|
150 | * |
---|
151 | * Results: |
---|
152 | * None. |
---|
153 | * |
---|
154 | * Side effects: |
---|
155 | * Memory is freed. |
---|
156 | * |
---|
157 | * This function is simply a wrapper around Tcl_Free, needed in libtommath |
---|
158 | * because of a type mismatch between free and Tcl_Free. |
---|
159 | * |
---|
160 | *---------------------------------------------------------------------- |
---|
161 | */ |
---|
162 | |
---|
163 | extern void |
---|
164 | TclBNFree( |
---|
165 | void *p) |
---|
166 | { |
---|
167 | Tcl_Free((char *) p); |
---|
168 | } |
---|
169 | #endif |
---|
170 | |
---|
171 | /* |
---|
172 | *---------------------------------------------------------------------- |
---|
173 | * |
---|
174 | * TclBNInitBignumFromLong -- |
---|
175 | * |
---|
176 | * Allocate and initialize a 'bignum' from a native 'long'. |
---|
177 | * |
---|
178 | * Results: |
---|
179 | * None. |
---|
180 | * |
---|
181 | * Side effects: |
---|
182 | * The 'bignum' is constructed. |
---|
183 | * |
---|
184 | *---------------------------------------------------------------------- |
---|
185 | */ |
---|
186 | |
---|
187 | extern void |
---|
188 | TclBNInitBignumFromLong( |
---|
189 | mp_int *a, |
---|
190 | long initVal) |
---|
191 | { |
---|
192 | int status; |
---|
193 | unsigned long v; |
---|
194 | mp_digit* p; |
---|
195 | |
---|
196 | /* |
---|
197 | * Allocate enough memory to hold the largest possible long |
---|
198 | */ |
---|
199 | |
---|
200 | status = mp_init_size(a, |
---|
201 | (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT); |
---|
202 | if (status != MP_OKAY) { |
---|
203 | Tcl_Panic("initialization failure in TclBNInitBignumFromLong"); |
---|
204 | } |
---|
205 | |
---|
206 | /* |
---|
207 | * Convert arg to sign and magnitude. |
---|
208 | */ |
---|
209 | |
---|
210 | if (initVal < 0) { |
---|
211 | a->sign = MP_NEG; |
---|
212 | v = -initVal; |
---|
213 | } else { |
---|
214 | a->sign = MP_ZPOS; |
---|
215 | v = initVal; |
---|
216 | } |
---|
217 | |
---|
218 | /* |
---|
219 | * Store the magnitude in the bignum. |
---|
220 | */ |
---|
221 | |
---|
222 | p = a->dp; |
---|
223 | while (v) { |
---|
224 | *p++ = (mp_digit) (v & MP_MASK); |
---|
225 | v >>= MP_DIGIT_BIT; |
---|
226 | } |
---|
227 | a->used = p - a->dp; |
---|
228 | } |
---|
229 | |
---|
230 | /* |
---|
231 | *---------------------------------------------------------------------- |
---|
232 | * |
---|
233 | * TclBNInitBignumFromWideInt -- |
---|
234 | * |
---|
235 | * Allocate and initialize a 'bignum' from a Tcl_WideInt |
---|
236 | * |
---|
237 | * Results: |
---|
238 | * None. |
---|
239 | * |
---|
240 | * Side effects: |
---|
241 | * The 'bignum' is constructed. |
---|
242 | * |
---|
243 | *---------------------------------------------------------------------- |
---|
244 | */ |
---|
245 | |
---|
246 | extern void |
---|
247 | TclBNInitBignumFromWideInt( |
---|
248 | mp_int *a, /* Bignum to initialize */ |
---|
249 | Tcl_WideInt v) /* Initial value */ |
---|
250 | { |
---|
251 | if (v < (Tcl_WideInt)0) { |
---|
252 | TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)(-v)); |
---|
253 | mp_neg(a, a); |
---|
254 | } else { |
---|
255 | TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)v); |
---|
256 | } |
---|
257 | } |
---|
258 | |
---|
259 | /* |
---|
260 | *---------------------------------------------------------------------- |
---|
261 | * |
---|
262 | * TclBNInitBignumFromWideUInt -- |
---|
263 | * |
---|
264 | * Allocate and initialize a 'bignum' from a Tcl_WideUInt |
---|
265 | * |
---|
266 | * Results: |
---|
267 | * None. |
---|
268 | * |
---|
269 | * Side effects: |
---|
270 | * The 'bignum' is constructed. |
---|
271 | * |
---|
272 | *---------------------------------------------------------------------- |
---|
273 | */ |
---|
274 | |
---|
275 | extern void |
---|
276 | TclBNInitBignumFromWideUInt( |
---|
277 | mp_int *a, /* Bignum to initialize */ |
---|
278 | Tcl_WideUInt v) /* Initial value */ |
---|
279 | { |
---|
280 | int status; |
---|
281 | mp_digit *p; |
---|
282 | |
---|
283 | /* |
---|
284 | * Allocate enough memory to hold the largest possible Tcl_WideUInt. |
---|
285 | */ |
---|
286 | |
---|
287 | status = mp_init_size(a, |
---|
288 | (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT); |
---|
289 | if (status != MP_OKAY) { |
---|
290 | Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt"); |
---|
291 | } |
---|
292 | |
---|
293 | a->sign = MP_ZPOS; |
---|
294 | |
---|
295 | /* |
---|
296 | * Store the magnitude in the bignum. |
---|
297 | */ |
---|
298 | |
---|
299 | p = a->dp; |
---|
300 | while (v) { |
---|
301 | *p++ = (mp_digit) (v & MP_MASK); |
---|
302 | v >>= MP_DIGIT_BIT; |
---|
303 | } |
---|
304 | a->used = p - a->dp; |
---|
305 | } |
---|
306 | |
---|
307 | /* |
---|
308 | * Local Variables: |
---|
309 | * mode: c |
---|
310 | * c-basic-offset: 4 |
---|
311 | * fill-column: 78 |
---|
312 | * End: |
---|
313 | */ |
---|