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