diff options
Diffstat (limited to 'unix/dltest/pkgua.c')
| -rw-r--r-- | unix/dltest/pkgua.c | 167 |
1 files changed, 86 insertions, 81 deletions
diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c index 1d7d24a..417bedb 100644 --- a/unix/dltest/pkgua.c +++ b/unix/dltest/pkgua.c @@ -1,37 +1,44 @@ -/* +/* * pkgua.c -- * - * This file contains a simple Tcl package "pkgua" that is intended - * for testing the Tcl dynamic unloading facilities. + * This file contains a simple Tcl package "pkgua" that is intended for + * testing the Tcl dynamic unloading facilities. * * Copyright (c) 1995 Sun Microsystems, Inc. * Copyright (c) 2004 Georgios Petasis * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - * - * RCS: @(#) $Id: pkgua.c,v 1.3 2004/06/08 19:18:39 dgp Exp $ + * 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" /* + * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the + * Pkgua_Init declaration is in the source file itself, which is only + * accessed when we are building a library. + */ +#undef TCL_STORAGE_CLASS +#define TCL_STORAGE_CLASS DLLEXPORT + +/* * Prototypes for procedures defined later in this file: */ -static int PkguaEqObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); -static int PkguaQuoteObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[])); +static int PkguaEqObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static int PkguaQuoteObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* - * In the following hash table we are going to store a struct that - * holds all the command tokens created by Tcl_CreateObjCommand in an - * interpreter, indexed by the interpreter. In this way, we can find - * which command tokens we have registered in a specific interpreter, - * in order to unload them. We need to keep the various command tokens - * we have registered, as they are the only safe way to unregister our - * registered commands, even if they have been renamed. + * In the following hash table we are going to store a struct that holds all + * the command tokens created by Tcl_CreateObjCommand in an interpreter, + * indexed by the interpreter. In this way, we can find which command tokens + * we have registered in a specific interpreter, in order to unload them. We + * need to keep the various command tokens we have registered, as they are the + * only safe way to unregister our registered commands, even if they have been + * renamed. * * Note that this code is utterly single-threaded. */ @@ -50,8 +57,8 @@ PkguaInitTokensHashTable(void) Tcl_InitHashTable(&interpTokenMap, TCL_ONE_WORD_KEYS); interpTokenMapInitialised = 1; } - -void + +static void PkguaFreeTokensHashTable(void) { Tcl_HashSearch search; @@ -63,10 +70,10 @@ PkguaFreeTokensHashTable(void) } interpTokenMapInitialised = 0; } - + static Tcl_Command * -PkguaInterpToTokens(interp) - Tcl_Interp *interp; +PkguaInterpToTokens( + Tcl_Interp *interp) { int newEntry; Tcl_Command *cmdTokens; @@ -79,16 +86,16 @@ PkguaInterpToTokens(interp) for (newEntry=0 ; newEntry<MAX_REGISTERED_COMMANDS+1 ; ++newEntry) { cmdTokens[newEntry] = NULL; } - Tcl_SetHashValue(entryPtr, (ClientData) cmdTokens); + Tcl_SetHashValue(entryPtr, cmdTokens); } else { cmdTokens = (Tcl_Command *) Tcl_GetHashValue(entryPtr); } return cmdTokens; } - + static void -PkguaDeleteTokens(interp) - Tcl_Interp *interp; +PkguaDeleteTokens( + Tcl_Interp *interp) { Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&interpTokenMap, (char *) interp); @@ -104,9 +111,9 @@ PkguaDeleteTokens(interp) * * PkguaEqObjCmd -- * - * This procedure is invoked to process the "pkgua_eq" Tcl command. - * It expects two arguments and returns 1 if they are the same, - * 0 if they are different. + * This procedure is invoked to process the "pkgua_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. @@ -118,14 +125,14 @@ PkguaDeleteTokens(interp) */ static int -PkguaEqObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj * CONST objv[]; /* Argument objects. */ +PkguaEqObjCmd( + ClientData 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; + const char *str1, *str2; int len1, len2; if (objc != 3) { @@ -149,8 +156,8 @@ PkguaEqObjCmd(dummy, interp, objc, objv) * * PkguaQuoteObjCmd -- * - * This procedure is invoked to process the "pkgua_quote" Tcl command. - * It expects one argument, which it returns as result. + * This procedure is invoked to process the "pkgua_quote" Tcl command. It + * expects one argument, which it returns as result. * * Results: * A standard Tcl result. @@ -162,11 +169,11 @@ PkguaEqObjCmd(dummy, interp, objc, objv) */ static int -PkguaQuoteObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj * CONST objv[]; /* Argument strings. */ +PkguaQuoteObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument strings. */ { if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "value"); @@ -181,8 +188,8 @@ PkguaQuoteObjCmd(dummy, interp, objc, objv) * * Pkgua_Init -- * - * This is a package initialization procedure, which is called - * by Tcl when this package is to be added to an interpreter. + * This is a package initialization procedure, which is called by Tcl + * when this package is to be added to an interpreter. * * Results: * None. @@ -193,10 +200,10 @@ PkguaQuoteObjCmd(dummy, interp, objc, objv) *---------------------------------------------------------------------- */ -int -Pkgua_Init(interp) - Tcl_Interp *interp; /* Interpreter in which the package is - * to be made available. */ +EXTERN int +Pkgua_Init( + Tcl_Interp *interp) /* Interpreter in which the package is to be + * made available. */ { int code, cmdIndex = 0; Tcl_Command *cmdTokens; @@ -206,8 +213,8 @@ Pkgua_Init(interp) } /* - * Initialise our Hash table, where we store the registered - * command tokens for each interpreter. + * Initialise our Hash table, where we store the registered command tokens + * for each interpreter. */ PkguaInitTokensHashTable(); @@ -221,11 +228,11 @@ Pkgua_Init(interp) cmdTokens = PkguaInterpToTokens(interp); cmdTokens[cmdIndex++] = - Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd, NULL, + NULL); cmdTokens[cmdIndex++] = - Tcl_CreateObjCommand(interp, "pkgua_quote", PkguaQuoteObjCmd, - (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "pkgua_quote", PkguaQuoteObjCmd, + NULL, NULL); return TCL_OK; } @@ -234,8 +241,8 @@ Pkgua_Init(interp) * * Pkgua_SafeInit -- * - * This is a package initialization procedure, which is called - * by Tcl when this package is to be added to an unsafe interpreter. + * This is a package initialization procedure, which is called by Tcl + * when this package is to be added to a safe interpreter. * * Results: * None. @@ -246,10 +253,10 @@ Pkgua_Init(interp) *---------------------------------------------------------------------- */ -int -Pkgua_SafeInit(interp) - Tcl_Interp *interp; /* Interpreter in which the package is - * to be made available. */ +EXTERN int +Pkgua_SafeInit( + Tcl_Interp *interp) /* Interpreter in which the package is to be + * made available. */ { return Pkgua_Init(interp); } @@ -259,9 +266,8 @@ Pkgua_SafeInit(interp) * * Pkgua_Unload -- * - * This is a package unloading initialization procedure, which is - * called by Tcl when this package is to be unloaded form an - * interpreter. + * This is a package unloading initialization procedure, which is called + * by Tcl when this package is to be unloaded from an interpreter. * * Results: * None. @@ -272,11 +278,11 @@ Pkgua_SafeInit(interp) *---------------------------------------------------------------------- */ -int -Pkgua_Unload(interp, flags) - Tcl_Interp *interp; /* Interpreter from which the package is - * to be unloaded. */ - int flags; /* Flags passed by the unloading mechanism */ +EXTERN int +Pkgua_Unload( + Tcl_Interp *interp, /* Interpreter from which the package is to be + * unloaded. */ + int flags) /* Flags passed by the unloading mechanism */ { int code, cmdIndex; Tcl_Command *cmdTokens = PkguaInterpToTokens(interp); @@ -297,12 +303,12 @@ Pkgua_Unload(interp, flags) if (flags == TCL_UNLOAD_DETACH_FROM_PROCESS) { /* - * Tcl is ready to detach this library from the running - * application. We should free all the memory that is not - * related to any interpreter. + * Tcl is ready to detach this library from the running application. + * We should free all the memory that is not related to any + * interpreter. */ - PkguaFreeTokensHashTable(); + PkguaFreeTokensHashTable(); Tcl_SetVar(interp, "::pkgua_unloaded", ".", TCL_APPEND_VALUE); } return TCL_OK; @@ -313,9 +319,8 @@ Pkgua_Unload(interp, flags) * * Pkgua_SafeUnload -- * - * This is a package unloading initialization procedure, which is - * called by Tcl when this package is to be unloaded form an - * interpreter. + * This is a package unloading initialization procedure, which is called + * by Tcl when this package is to be unloaded from an interpreter. * * Results: * None. @@ -326,11 +331,11 @@ Pkgua_Unload(interp, flags) *---------------------------------------------------------------------- */ -int -Pkgua_SafeUnload(interp, flags) - Tcl_Interp *interp; /* Interpreter from which the package is - * to be unloaded. */ - int flags; /* Flags passed by the unloading mechanism */ +EXTERN int +Pkgua_SafeUnload( + Tcl_Interp *interp, /* Interpreter from which the package is to be + * unloaded. */ + int flags) /* Flags passed by the unloading mechanism */ { return Pkgua_Unload(interp, flags); } |