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
|
/*
* tclTomMathStubLib.c --
*
* Stub object that will be statically linked into extensions that want
* to access Tcl.
*
* Copyright © 1998-1999 Scriptics Corporation.
* Copyright © 1998 Paul Duffin.
*
* 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 "tclTomMath.h"
MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr;
const TclTomMathStubs *tclTomMathStubsPtr = NULL;
/*
*----------------------------------------------------------------------
*
* TclTomMathInitStubs --
*
* Initializes the Stubs table for Tcl's subset of libtommath
*
* Results:
* Returns a standard Tcl result.
*
* This procedure should not be called directly, but rather through
* the TclTomMath_InitStubs macro, to insure that the Stubs table
* matches the header files used in compilation.
*
*----------------------------------------------------------------------
*/
MODULE_SCOPE const char *
TclTomMathInitializeStubs(
Tcl_Interp *interp, /* Tcl interpreter */
const char *version, /* Tcl version needed */
int epoch, /* Stubs table epoch from the header files */
int revision) /* Stubs table revision number from the
* header files */
{
int exact = 0;
const char *packageName = "tcl::tommath";
const char *errMsg = NULL;
TclTomMathStubs *stubsPtr = NULL;
const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
packageName, version, exact, &stubsPtr);
if (actualVersion == NULL) {
return NULL;
}
if (stubsPtr == NULL) {
errMsg = "missing stub table pointer";
} else if (stubsPtr->tclBN_epoch() != epoch) {
errMsg = "epoch number mismatch";
} else if (stubsPtr->tclBN_revision() != revision) {
errMsg = "requires a later revision";
} else {
tclTomMathStubsPtr = stubsPtr;
return actualVersion;
}
tclStubsPtr->tcl_ResetResult(interp);
tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
" (requested version ", version, ", actual version ",
actualVersion, "): ", errMsg, NULL);
return NULL;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
