1 /*
2 * tclTomMathStubLib.c --
3 *
4 * Stub object that will be statically linked into extensions that want
5 * to access Tcl.
6 *
7 * Copyright © 1998-1999 Scriptics Corporation.
8 * Copyright © 1998 Paul Duffin.
9 *
10 * See the file "license.terms" for information on usage and redistribution of
11 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 */
13
14 #include "tclInt.h"
15 #include "tclTomMath.h"
16
17 MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr;
18
19 const TclTomMathStubs *tclTomMathStubsPtr = NULL;
20
21
22 /*
23 *----------------------------------------------------------------------
24 *
25 * TclTomMathInitStubs --
26 *
27 * Initializes the Stubs table for Tcl's subset of libtommath
28 *
29 * Results:
30 * Returns a standard Tcl result.
31 *
32 * This procedure should not be called directly, but rather through
33 * the TclTomMath_InitStubs macro, to insure that the Stubs table
34 * matches the header files used in compilation.
35 *
36 *----------------------------------------------------------------------
37 */
38
39 MODULE_SCOPE const char *
TclTomMathInitializeStubs(Tcl_Interp * interp,const char * version,int epoch,int revision)40 TclTomMathInitializeStubs(
41 Tcl_Interp *interp, /* Tcl interpreter */
42 const char *version, /* Tcl version needed */
43 int epoch, /* Stubs table epoch from the header files */
44 int revision) /* Stubs table revision number from the
45 * header files */
46 {
47 int exact = 0;
48 const char *packageName = "tcl::tommath";
49 const char *errMsg = NULL;
50 TclTomMathStubs *stubsPtr = NULL;
51 const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
52 packageName, version, exact, &stubsPtr);
53
54 if (actualVersion == NULL) {
55 return NULL;
56 }
57 if (stubsPtr == NULL) {
58 errMsg = "missing stub table pointer";
59 } else if (stubsPtr->tclBN_epoch() != epoch) {
60 errMsg = "epoch number mismatch";
61 } else if (stubsPtr->tclBN_revision() != revision) {
62 errMsg = "requires a later revision";
63 } else {
64 tclTomMathStubsPtr = stubsPtr;
65 return actualVersion;
66 }
67 tclStubsPtr->tcl_ResetResult(interp);
68 tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
69 " (requested version ", version, ", actual version ",
70 actualVersion, "): ", errMsg, NULL);
71 return NULL;
72 }
73
74 /*
75 * Local Variables:
76 * mode: c
77 * c-basic-offset: 4
78 * fill-column: 78
79 * End:
80 */
81