summaryrefslogtreecommitdiffstats
path: root/generic/tclTomMathInterface.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTomMathInterface.c')
-rw-r--r--generic/tclTomMathInterface.c241
1 files changed, 204 insertions, 37 deletions
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
index 89537b9..48db8c3 100644
--- a/generic/tclTomMathInterface.c
+++ b/generic/tclTomMathInterface.c
@@ -3,20 +3,93 @@
*
* tclTomMathInterface.c --
*
- * This file contains procedures that are used as a 'glue'
- * layer between Tcl and libtommath.
+ * This file contains procedures that are used as a 'glue' layer between
+ * Tcl and libtommath.
*
* Copyright (c) 2005 by Kevin B. Kenny. All rights reserved.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tclTomMathInterface.c,v 1.2 2005/05/10 18:34:51 kennykb Exp $
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
#include "tommath.h"
-#include <limits.h>
+
+MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclTommath_Init --
+ *
+ * Initializes the TclTomMath 'package', which exists as a
+ * placeholder so that the package data can be used to hold
+ * a stub table pointer.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Installs the stub table for tommath.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclTommath_Init(
+ Tcl_Interp *interp) /* Tcl interpreter */
+{
+ /* TIP #268: Full patchlevel instead of just major.minor */
+
+ if (Tcl_PkgProvideEx(interp, "tcl::tommath", TCL_PATCH_LEVEL,
+ &tclTomMathStubs) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBN_epoch --
+ *
+ * Return the epoch number of the TclTomMath stubs table
+ *
+ * Results:
+ * Returns an arbitrary integer that does not decrease with
+ * release. Stubs tables with different epochs are incompatible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclBN_epoch(void)
+{
+ return TCLTOMMATH_EPOCH;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBN_revision --
+ *
+ * Returns the revision level of the TclTomMath stubs table
+ *
+ * Results:
+ * Returns an arbitrary integer that increases with revisions.
+ * If a client requires a given epoch and revision, any Stubs table
+ * with the same epoch and an equal or higher revision satisfies
+ * the request.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclBN_revision(void)
+{
+ return TCLTOMMATH_REVISION;
+}
+#if 0
/*
*----------------------------------------------------------------------
@@ -28,38 +101,41 @@
* Results:
* Returns a pointer to the allocated block.
*
- * This procedure is a wrapper around Tcl_Alloc, needed because of
- * a mismatched type signature between Tcl_Alloc and malloc.
+ * This procedure is a wrapper around Tcl_Alloc, needed because of a
+ * mismatched type signature between Tcl_Alloc and malloc.
*
*----------------------------------------------------------------------
- */
+ */
extern void *
-TclBNAlloc( size_t x )
+TclBNAlloc(
+ size_t x)
{
- return (void*) Tcl_Alloc( (unsigned int) x );
+ return (void *) ckalloc((unsigned int) x);
}
/*
*----------------------------------------------------------------------
*
- * TclBNAlloc --
+ * TclBNRealloc --
*
* Change the size of an allocated block of memory in libtommath
*
* Results:
* Returns a pointer to the allocated block.
*
- * This procedure is a wrapper around Tcl_Realloc, needed because of
- * a mismatched type signature between Tcl_Realloc and realloc.
+ * This procedure is a wrapper around Tcl_Realloc, needed because of a
+ * mismatched type signature between Tcl_Realloc and realloc.
*
*----------------------------------------------------------------------
- */
+ */
-extern void *
-TclBNRealloc( void* p, size_t s )
+void *
+TclBNRealloc(
+ void *p,
+ size_t s)
{
- return (void*) Tcl_Realloc( (char*) p, (unsigned int) s );
+ return (void *) ckrealloc((char *) p, (unsigned int) s);
}
/*
@@ -75,17 +151,19 @@ TclBNRealloc( void* p, size_t s )
* Side effects:
* Memory is freed.
*
- * This function is simply a wrapper around Tcl_Free, needed in
- * libtommath because of a type mismatch between free and Tcl_Free.
+ * This function is simply a wrapper around Tcl_Free, needed in libtommath
+ * because of a type mismatch between free and Tcl_Free.
*
*----------------------------------------------------------------------
*/
extern void
-TclBNFree( void* p )
+TclBNFree(
+ void *p)
{
- Tcl_Free( (char*) p);
+ ckree((char *) p);
}
+#endif
/*
*----------------------------------------------------------------------
@@ -104,26 +182,29 @@ TclBNFree( void* p )
*/
extern void
-TclBNInitBignumFromLong( mp_int* a, long initVal )
+TclBNInitBignumFromLong(
+ mp_int *a,
+ long initVal)
{
-
int status;
unsigned long v;
- mp_digit* p;
+ mp_digit *p;
/*
* Allocate enough memory to hold the largest possible long
*/
- status = mp_init_size( a, ( ( CHAR_BIT * sizeof( long ) + DIGIT_BIT - 1 )
- / DIGIT_BIT ) );
- if ( status != MP_OKAY ) {
- Tcl_Panic( "initialization failure in TclBNInitBignumFromLong" );
+ status = mp_init_size(a,
+ (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT);
+ if (status != MP_OKAY) {
+ Tcl_Panic("initialization failure in TclBNInitBignumFromLong");
}
-
- /* Convert arg to sign and magnitude */
- if ( initVal < 0 ) {
+ /*
+ * Convert arg to sign and magnitude.
+ */
+
+ if (initVal < 0) {
a->sign = MP_NEG;
v = -initVal;
} else {
@@ -131,13 +212,99 @@ TclBNInitBignumFromLong( mp_int* a, long initVal )
v = initVal;
}
- /* Store the magnitude in the bignum. */
+ /*
+ * Store the magnitude in the bignum.
+ */
p = a->dp;
- while ( v ) {
- *p++ = (mp_digit) ( v & MP_MASK );
+ while (v) {
+ *p++ = (mp_digit) (v & MP_MASK);
v >>= MP_DIGIT_BIT;
}
a->used = p - a->dp;
-
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBNInitBignumFromWideInt --
+ *
+ * Allocate and initialize a 'bignum' from a Tcl_WideInt
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The 'bignum' is constructed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern void
+TclBNInitBignumFromWideInt(
+ mp_int *a, /* Bignum to initialize */
+ Tcl_WideInt v) /* Initial value */
+{
+ if (v < (Tcl_WideInt)0) {
+ TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)(-v));
+ mp_neg(a, a);
+ } else {
+ TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)v);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBNInitBignumFromWideUInt --
+ *
+ * Allocate and initialize a 'bignum' from a Tcl_WideUInt
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The 'bignum' is constructed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern void
+TclBNInitBignumFromWideUInt(
+ mp_int *a, /* Bignum to initialize */
+ Tcl_WideUInt v) /* Initial value */
+{
+ int status;
+ mp_digit *p;
+
+ /*
+ * Allocate enough memory to hold the largest possible Tcl_WideUInt.
+ */
+
+ status = mp_init_size(a,
+ (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT);
+ if (status != MP_OKAY) {
+ Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt");
+ }
+
+ a->sign = MP_ZPOS;
+
+ /*
+ * Store the magnitude in the bignum.
+ */
+
+ p = a->dp;
+ while (v) {
+ *p++ = (mp_digit) (v & MP_MASK);
+ v >>= MP_DIGIT_BIT;
+ }
+ a->used = p - a->dp;
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
generated by cgit v0.12 at 2025-10-21 13:19:04 (GMT)