Tcl Source Code

.AS Tcl_LibraryInitProc *safeInitProc
.AP Tcl_Interp *interp in
If not NULL, points to an interpreter into which the library has
already been incorporated (i.e., the caller has already invoked the
appropriate initialization procedure).  NULL means the library
has not yet been incorporated into any interpreter.
.AP "const char" *prefix in
Prefix for library initialization function. Normally in titlecase (first
letter upper-case, all others lower-case), but this is no longer required.
.AP Tcl_LibraryInitProc *initProc in
Procedure to invoke to incorporate this library into a trusted
interpreter.
.AP Tcl_LibraryInitProc *safeInitProc in
Procedure to call to incorporate this library into a safe interpreter
(one that will execute untrusted scripts).  NULL means the library
cannot be used in safe interpreters.

Once the file has been loaded into the application's address space,
one of two initialization procedures will be invoked in the new code.
Typically the initialization procedure will add new commands to a
Tcl interpreter.
The name of the initialization procedure is determined by
\fIprefix\fR and whether or not the target interpreter
is a safe one.  For normal interpreters the name of the initialization
procedure will have the form \fIprefix\fB_Init\fR.  For example, if



\fIprefix\fR is \fBFoo\fR, the initialization procedure's name will
be \fBFoo_Init\fR.
.PP
If the target interpreter is a safe interpreter, then the name
of the initialization procedure will be \fIprefix\fB_SafeInit\fR
instead of \fIprefix\fB_Init\fR.
The \fIprefix\fB_SafeInit\fR function should be written carefully, so that it
initializes the safe interpreter only with partial functionality provided
by the library that is safe for use by untrusted code. For more information
on Safe\-Tcl, see the \fBsafe\fR manual entry.
.PP
The initialization procedure must match the following prototype:
.PP
.CS

The \fBload\fR command also supports libraries that are statically
linked with the application, if those libraries have been registered
by calling the \fBTcl_StaticLibrary\fR procedure.
If \fIfileName\fR is an empty string, then \fIprefix\fR must
be specified.
.PP
If \fIprefix\fR is omitted or specified as an empty string,
Tcl tries to guess the prefix by taking the last element of


\fIfileName\fR, strip off the first three characters if they
are \fBlib\fR, then strip off the next three characters if
they are \fBtcl9\fR, and use any following wordchars but not digits,
converted to titlecase as the prefix.
For example, the command \fBload libxyz4.2.so\fR uses the prefix
\fBXyz\fR and the command \fBload bin/last.so {}\fR uses the
prefix \fBLast\fR.
.PP
If \fIfileName\fR is an empty string, then \fIprefix\fR must
be specified.
The \fBload\fR command first searches for a statically loaded library

.PP
If \fIprefix\fR is omitted or specified as an empty string,
Tcl tries to guess the prefix. This may be done differently on
different platforms. The default guess, which is used on most
UNIX platforms, is to take the last element of
\fIfileName\fR, strip off the first three characters if they
are \fBlib\fR, then strip off the next three characters if they
are \fBtcl9\fR, and use any following wordchars but not digits,
converted to titlecase as the prefix.
For example, the command \fBunload libxyz4.2.so\fR uses the prefix
\fBXyz\fR and the command \fBunload bin/last.so {}\fR uses the
prefix \fBLast\fR.
.SH "PORTABILITY ISSUES"
.TP
\fBUnix\fR\0\0\0\0\0
.

#include "tclInt.h"

/*
 * The following structure describes a library that has been loaded either
 * dynamically (with the "load" command) or statically (as indicated by a call
 * to Tcl_StaticLibrary). All such libraries are linked together into a
 * single list for the process.


 */

typedef struct LoadedLibrary {
    char *fileName;		/* Name of the file from which the library was
				 * loaded. An empty string means the library
				 * is loaded statically. Malloc-ed. */
    char *prefix;		/* Prefix for the library.


				 * Malloc-ed. */
    Tcl_LoadHandle loadHandle;	/* Token for the loaded file which should be
				 * passed to (*unLoadProcPtr)() when the file
				 * is no longer needed. If fileName is NULL,
				 * then this field is irrelevant. */
    Tcl_LibraryInitProc *initProc;
				/* Initialization function to call to

	if (prefix == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pfx);
	    Tcl_DStringAppend(&pfx, prefix, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1);


	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pfx)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}

	    /*
	     * Threading note - this call used to be protected by a mutex.
	     */

	    /*
	     * The platform-specific code couldn't figure out the prefix.
	     * Make a guess by taking the last element of the file
	     * name, stripping off any leading "lib" and/or "tcl9", and
	     * then using all of the alphabetic and underline characters
	     * that follow that.
	     */

	    splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
	    Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr);
	    pkgGuess = TclGetString(pkgGuessPtr);
	    if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
		    && (pkgGuess[2] == 'b')) {
		pkgGuess += 3;
	    }
#ifdef __CYGWIN__
	    else if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y')
		    && (pkgGuess[2] == 'g')) {
		pkgGuess += 3;
	    }
#endif /* __CYGWIN__ */
	    if (((pkgGuess[0] == 't')
#ifdef MAC_OS_TCL
		    || (pkgGuess[0] == 'T')
#endif
		    ) && (pkgGuess[1] == 'c')
		    && (pkgGuess[2] == 'l') && (pkgGuess[3] == '9')) {
		pkgGuess += 4;
	    }
	    for (p = pkgGuess; *p != 0; p += offset) {
		offset = TclUtfToUniChar(p, &ch);

		if (!Tcl_UniCharIsWordChar(UCHAR(ch))
			|| Tcl_UniCharIsDigit(UCHAR(ch))) {
		    break;
		}
	    }
	    if (p == pkgGuess) {
		Tcl_DecrRefCount(splitPtr);
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"couldn't figure out prefix for %s",
			fullFileName));
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD",
			"WHATLIBRARY", NULL);
		code = TCL_ERROR;
		goto done;
	    }
	    Tcl_DStringAppend(&pfx, pkgGuess, p - pkgGuess);
	    Tcl_DecrRefCount(splitPtr);


	    /*
	     * Fix the capitalization in the prefix so that the first
	     * character is in caps (or title case) but the others are all
	     * lower-case.
	     */

	    Tcl_DStringSetLength(&pfx,
		    Tcl_UtfToTitle(Tcl_DStringValue(&pfx)));

	}

	/*
	 * Compute the names of the two initialization functions, based on the
	 * prefix.
	 */

	TclDStringAppendDString(&initName, &pfx);

	if (prefix == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pfx);
	    Tcl_DStringAppend(&pfx, prefix, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringAppend(&tmp, libraryPtr->prefix, -1);


	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pfx)) == 0) {
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}

void
Tcl_StaticLibrary(
    Tcl_Interp *interp,		/* If not NULL, it means that the library has
				 * already been loaded into the given
				 * interpreter by calling the appropriate init
				 * proc. */
    const char *prefix,	/* Prefix. */


    Tcl_LibraryInitProc *initProc,
				/* Function to call to incorporate this
				 * library into a trusted interpreter. */
    Tcl_LibraryInitProc *safeInitProc)
				/* Function to call to incorporate this
				 * library into a safe interpreter (one that
				 * will execute untrusted scripts). NULL means

if {[info sharedlibextension] != ".dll"} return
if {[package vsatisfies [package provide Tcl] 9.0]} {
    package ifneeded dde 1.4.4 \
	    [list load [file join $dir tcl9dde14.dll] Dde]
} else {
    package ifneeded dde 1.4.4 \
	    [list load [file join $dir tcldde14.dll] Dde]
}

if {[info sharedlibextension] != ".dll"} return
if {[package vsatisfies [package provide Tcl] 9.0]} {
    package ifneeded registry 1.3.6 \
	    [list load [file join $dir tcl9registry13.dll] Registry]
} else {
    package ifneeded registry 1.3.6 \
	    [list load [file join $dir tclregistry13.dll] Registry]
}

LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE	= @LDFLAGS_OPTIMIZE@
LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@

CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
	${SHLIB_CFLAGS} -DUSE_TCL_STUBS ${AC_FLAGS}

all: tcl9pkgπ${SHLIB_SUFFIX} tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} tcl9pkgooa${SHLIB_SUFFIX}
	@if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi
	@touch ../dltest.marker

dltest_suffix: tcl9pkgπ${DLTEST_SUFFIX} tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} tcl9pkgooa${DLTEST_SUFFIX}
	@touch ../dltest.marker

pkgπ.o: $(SRC_DIR)/pkgπ.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgπ.c

pkga.o: $(SRC_DIR)/pkga.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkga.c

pkgb.o: $(SRC_DIR)/pkgb.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgb.c

pkgc.o: $(SRC_DIR)/pkgc.c

pkgua.o: $(SRC_DIR)/pkgua.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgua.c

pkgooa.o: $(SRC_DIR)/pkgooa.c
	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgooa.c

tcl9pkgπ${SHLIB_SUFFIX}: pkgπ.o
	${SHLIB_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS}

tcl9pkga${SHLIB_SUFFIX}: pkga.o
	${SHLIB_LD} -o $@ pkga.o ${SHLIB_LD_LIBS}

tcl9pkgb${SHLIB_SUFFIX}: pkgb.o
	${SHLIB_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS}

tcl9pkgc${SHLIB_SUFFIX}: pkgc.o
	${SHLIB_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS}

tcl9pkgd${SHLIB_SUFFIX}: pkgd.o
	${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}

tcl9pkge${SHLIB_SUFFIX}: pkge.o
	${SHLIB_LD} -o $@ pkge.o ${SHLIB_LD_LIBS}

tcl9pkgua${SHLIB_SUFFIX}: pkgua.o
	${SHLIB_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS}

tcl9pkgooa${SHLIB_SUFFIX}: pkgooa.o
	${SHLIB_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS}

tcl9pkgπ${DLTEST_SUFFIX}: pkgπ.o
	${DLTEST_LD} -o $@ pkgπ.o ${SHLIB_LD_LIBS}

tcl9pkga${DLTEST_SUFFIX}: pkga.o
	${DLTEST_LD} -o $@ pkga.o ${SHLIB_LD_LIBS}

tcl9pkgb${DLTEST_SUFFIX}: pkgb.o
	${DLTEST_LD} -o $@ pkgb.o ${SHLIB_LD_LIBS}

tcl9pkgc${DLTEST_SUFFIX}: pkgc.o
	${DLTEST_LD} -o $@ pkgc.o ${SHLIB_LD_LIBS}

tcl9pkgd${DLTEST_SUFFIX}: pkgd.o
	${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}

tcl9pkge${DLTEST_SUFFIX}: pkge.o
	${DLTEST_LD} -o $@ pkge.o ${SHLIB_LD_LIBS}

tcl9pkgua${DLTEST_SUFFIX}: pkgua.o
	${DLTEST_LD} -o $@ pkgua.o ${SHLIB_LD_LIBS}

tcl9pkgooa${DLTEST_SUFFIX}: pkgooa.o
	${DLTEST_LD} -o $@ pkgooa.o ${SHLIB_LD_LIBS}

clean:
	rm -f *.o lib.exp ../dltest.marker
	@if test "$(SHLIB_SUFFIX)" != ""; then \
	    echo "rm -f *${SHLIB_SUFFIX}" ; \
	    rm -f *${SHLIB_SUFFIX} ; \
	fi

/*
 * pkgπ.c --
 *
 *	This file contains a simple Tcl package "pkgπ" that is intended for
 *	testing the Tcl dynamic loading facilities.
 *
 * Copyright © 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"

/*
 * Prototypes for procedures defined later in this file:
 */

static int    Pkg\u03C0_\u03A0ObjCmd(ClientData clientData,
		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);

/*
 *----------------------------------------------------------------------
 *
 * Pkga_EqObjCmd --
 *
 *	This procedure is invoked to process the "pkga_eq" Tcl command. It
 *	expects two arguments and returns 1 if they are the same, 0 if they
 *	are different.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
Pkg\u03C0_\u03A0ObjCmd(
    void *dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int result;
    const char *str1, *str2;
    int len1, len2;
    (void)dummy;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv,  "");
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(3.14159));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgπ_Init --
 *
 *	This is a package initialization procedure, which is called by Tcl
 *	when this package is to be added to an interpreter.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

DLLEXPORT int
Pkg\u03C0_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "9.0", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "pkgπ", "1.0");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "π", Pkg\u03C0_\u03A0ObjCmd, NULL, NULL);
    return TCL_OK;
}

TCL_VFS_PATH		= libtcl.vfs/tcl_library
TCL_VFS_ROOT		= libtcl.vfs


TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
TCL_DLL_FILE		= @TCL_DLL_FILE@
TCL_LIB_FILE		= @TCL_LIB_FILE@
DDE_DLL_FILE		= tcl9dde$(DDEVER)${DLLSUFFIX}
DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
REG_DLL_FILE		= tcl9registry$(REGVER)${DLLSUFFIX}
REG_LIB_FILE		= @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE		= tcltest${EXESUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
TEST_LOAD_PRMS		= lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
			  package ifneeded dde 1.4.4 [list load [file normalize ${DDE_DLL_FILE}]];\
			  package ifneeded registry 1.3.6 [list load [file normalize ${REG_DLL_FILE}]]

DDEDOTVERSION = 1.4
DDEVERSION = $(DDEDOTVERSION:.=)

REGDOTVERSION = 1.3
REGVERSION = $(REGDOTVERSION:.=)

TCLREGLIBNAME	= $(PROJECT)9registry$(REGVERSION)$(SUFX:t=).$(EXT)
TCLREGLIB	= $(OUT_DIR)\$(TCLREGLIBNAME)

TCLDDELIBNAME	= $(PROJECT)9dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB	= $(OUT_DIR)\$(TCLDDELIBNAME)

TCLTEST		= $(OUT_DIR)\$(PROJECT)test.exe

TCLSHOBJS = \
	$(TMP_DIR)\tclAppInit.obj \
	$(TMP_DIR)\tclsh.res