1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclStubLib.c	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,117 @@
     1.4 +/* 
     1.5 + * tclStubLib.c --
     1.6 + *
     1.7 + *	Stub object that will be statically linked into extensions that wish
     1.8 + *	to access Tcl.
     1.9 + *
    1.10 + * Copyright (c) 1998-1999 by Scriptics Corporation.
    1.11 + * Copyright (c) 1998 Paul Duffin.
    1.12 + *
    1.13 + * See the file "license.terms" for information on usage and redistribution
    1.14 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    1.15 + *
    1.16 + * RCS: @(#) $Id: tclStubLib.c,v 1.6.2.1 2005/11/20 18:23:03 jenglish Exp $
    1.17 + */
    1.18 +
    1.19 +/*
    1.20 + * We need to ensure that we use the stub macros so that this file contains
    1.21 + * no references to any of the stub functions.  This will make it possible
    1.22 + * to build an extension that references Tcl_InitStubs but doesn't end up
    1.23 + * including the rest of the stub functions.
    1.24 + */
    1.25 +
    1.26 +#ifndef USE_TCL_STUBS
    1.27 +#define USE_TCL_STUBS
    1.28 +#endif
    1.29 +#undef USE_TCL_STUB_PROCS
    1.30 +
    1.31 +#include "tclInt.h"
    1.32 +#include "tclPort.h"
    1.33 +
    1.34 +/*
    1.35 + * Ensure that Tcl_InitStubs is built as an exported symbol.  The other stub
    1.36 + * functions should be built as non-exported symbols.
    1.37 + */
    1.38 +
    1.39 +TclStubs *tclStubsPtr = NULL;
    1.40 +TclPlatStubs *tclPlatStubsPtr = NULL;
    1.41 +TclIntStubs *tclIntStubsPtr = NULL;
    1.42 +TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
    1.43 +
    1.44 +static TclStubs *	HasStubSupport _ANSI_ARGS_((Tcl_Interp *interp));
    1.45 +
    1.46 +static TclStubs *
    1.47 +HasStubSupport (interp)
    1.48 +    Tcl_Interp *interp;
    1.49 +{
    1.50 +    Interp *iPtr = (Interp *) interp;
    1.51 +
    1.52 +    if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
    1.53 +	return iPtr->stubTable;
    1.54 +    }
    1.55 +    interp->result = "This interpreter does not support stubs-enabled extensions.";
    1.56 +    interp->freeProc = TCL_STATIC;
    1.57 +
    1.58 +    return NULL;
    1.59 +}
    1.60 +
    1.61 +/*
    1.62 + *----------------------------------------------------------------------
    1.63 + *
    1.64 + * Tcl_InitStubs --
    1.65 + *
    1.66 + *	Tries to initialise the stub table pointers and ensures that
    1.67 + *	the correct version of Tcl is loaded.
    1.68 + *
    1.69 + * Results:
    1.70 + *	The actual version of Tcl that satisfies the request, or
    1.71 + *	NULL to indicate that an error occurred.
    1.72 + *
    1.73 + * Side effects:
    1.74 + *	Sets the stub table pointers.
    1.75 + *
    1.76 + *----------------------------------------------------------------------
    1.77 + */
    1.78 +
    1.79 +#ifdef Tcl_InitStubs
    1.80 +#undef Tcl_InitStubs
    1.81 +#endif
    1.82 +
    1.83 +CONST char *
    1.84 +Tcl_InitStubs (interp, version, exact)
    1.85 +    Tcl_Interp *interp;
    1.86 +    CONST char *version;
    1.87 +    int exact;
    1.88 +{
    1.89 +    CONST char *actualVersion = NULL;
    1.90 +    ClientData pkgData = NULL;
    1.91 +
    1.92 +    /*
    1.93 +     * We can't optimize this check by caching tclStubsPtr because
    1.94 +     * that prevents apps from being able to load/unload Tcl dynamically
    1.95 +     * multiple times. [Bug 615304]
    1.96 +     */
    1.97 +
    1.98 +    tclStubsPtr = HasStubSupport(interp);
    1.99 +    if (!tclStubsPtr) {
   1.100 +	return NULL;
   1.101 +    }
   1.102 +
   1.103 +    actualVersion = Tcl_PkgRequireEx(interp, "Tcl", version, exact, &pkgData);
   1.104 +    if (actualVersion == NULL) {
   1.105 +	return NULL;
   1.106 +    }
   1.107 +    tclStubsPtr = (TclStubs*)pkgData;
   1.108 +
   1.109 +    if (tclStubsPtr->hooks) {
   1.110 +	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
   1.111 +	tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
   1.112 +	tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
   1.113 +    } else {
   1.114 +	tclPlatStubsPtr = NULL;
   1.115 +	tclIntStubsPtr = NULL;
   1.116 +	tclIntPlatStubsPtr = NULL;
   1.117 +    }
   1.118 +    
   1.119 +    return actualVersion;
   1.120 +}