os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclAppInit.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclAppInit.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,455 @@
1.4 +/*
1.5 + * tclAppInit.c --
1.6 + *
1.7 + * Provides a default version of the main program and Tcl_AppInit
1.8 + * procedure for Tcl applications (without Tk). Note that this
1.9 + * program must be built in Win32 console mode to work properly.
1.10 + *
1.11 + * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
1.12 + * Copyright (c) 1998-1999 by Scriptics Corporation.
1.13 + *
1.14 + * See the file "license.terms" for information on usage and redistribution
1.15 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.16 + *
1.17 + * RCS: @(#) $Id: tclAppInit.c,v 1.11.2.3 2007/03/19 17:06:26 dgp Exp $
1.18 + */
1.19 +
1.20 +#include "tcl.h"
1.21 +#include <windows.h>
1.22 +#include <locale.h>
1.23 +
1.24 +#ifdef TCL_TEST
1.25 +extern int Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
1.26 +extern int Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
1.27 +extern int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
1.28 +extern int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
1.29 +#ifdef TCL_THREADS
1.30 +extern int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
1.31 +#endif
1.32 +#endif /* TCL_TEST */
1.33 +
1.34 +static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
1.35 +static BOOL __stdcall sigHandler (DWORD fdwCtrlType);
1.36 +static Tcl_AsyncProc asyncExit;
1.37 +static void AppInitExitHandler(ClientData clientData);
1.38 +
1.39 +static char ** argvSave = NULL;
1.40 +static Tcl_AsyncHandler exitToken = NULL;
1.41 +static DWORD exitErrorCode = 0;
1.42 +
1.43 +
1.44 +/*
1.45 + *----------------------------------------------------------------------
1.46 + *
1.47 + * main --
1.48 + *
1.49 + * This is the main program for the application.
1.50 + *
1.51 + * Results:
1.52 + * None: Tcl_Main never returns here, so this procedure never
1.53 + * returns either.
1.54 + *
1.55 + * Side effects:
1.56 + * Whatever the application does.
1.57 + *
1.58 + *----------------------------------------------------------------------
1.59 + */
1.60 +
1.61 +int
1.62 +main(argc, argv)
1.63 + int argc; /* Number of command-line arguments. */
1.64 + char **argv; /* Values of command-line arguments. */
1.65 +{
1.66 + /*
1.67 + * The following #if block allows you to change the AppInit
1.68 + * function by using a #define of TCL_LOCAL_APPINIT instead
1.69 + * of rewriting this entire file. The #if checks for that
1.70 + * #define and uses Tcl_AppInit if it doesn't exist.
1.71 + */
1.72 +
1.73 +#ifndef TCL_LOCAL_APPINIT
1.74 +#define TCL_LOCAL_APPINIT Tcl_AppInit
1.75 +#endif
1.76 + extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
1.77 +
1.78 + /*
1.79 + * The following #if block allows you to change how Tcl finds the startup
1.80 + * script, prime the library or encoding paths, fiddle with the argv,
1.81 + * etc., without needing to rewrite Tcl_Main()
1.82 + */
1.83 +
1.84 +#ifdef TCL_LOCAL_MAIN_HOOK
1.85 + extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
1.86 +#endif
1.87 +
1.88 + char buffer[MAX_PATH +1];
1.89 + char *p;
1.90 + /*
1.91 + * Set up the default locale to be standard "C" locale so parsing
1.92 + * is performed correctly.
1.93 + */
1.94 +
1.95 + setlocale(LC_ALL, "C");
1.96 + setargv(&argc, &argv);
1.97 +
1.98 + /*
1.99 + * Save this for later, so we can free it.
1.100 + */
1.101 + argvSave = argv;
1.102 +
1.103 + /*
1.104 + * Replace argv[0] with full pathname of executable, and forward
1.105 + * slashes substituted for backslashes.
1.106 + */
1.107 +
1.108 + GetModuleFileName(NULL, buffer, sizeof(buffer));
1.109 + argv[0] = buffer;
1.110 + for (p = buffer; *p != '\0'; p++) {
1.111 + if (*p == '\\') {
1.112 + *p = '/';
1.113 + }
1.114 + }
1.115 +
1.116 +#ifdef TCL_LOCAL_MAIN_HOOK
1.117 + TCL_LOCAL_MAIN_HOOK(&argc, &argv);
1.118 +#endif
1.119 +
1.120 + Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
1.121 +
1.122 + return 0; /* Needed only to prevent compiler warning. */
1.123 +}
1.124 +
1.125 +
1.126 +/*
1.127 + *----------------------------------------------------------------------
1.128 + *
1.129 + * Tcl_AppInit --
1.130 + *
1.131 + * This procedure performs application-specific initialization.
1.132 + * Most applications, especially those that incorporate additional
1.133 + * packages, will have their own version of this procedure.
1.134 + *
1.135 + * Results:
1.136 + * Returns a standard Tcl completion code, and leaves an error
1.137 + * message in the interp's result if an error occurs.
1.138 + *
1.139 + * Side effects:
1.140 + * Depends on the startup script.
1.141 + *
1.142 + *----------------------------------------------------------------------
1.143 + */
1.144 +
1.145 +int
1.146 +Tcl_AppInit(interp)
1.147 + Tcl_Interp *interp; /* Interpreter for application. */
1.148 +{
1.149 + if (Tcl_Init(interp) == TCL_ERROR) {
1.150 + return TCL_ERROR;
1.151 + }
1.152 +
1.153 + /*
1.154 + * Install a signal handler to the win32 console tclsh is running in.
1.155 + */
1.156 + SetConsoleCtrlHandler(sigHandler, TRUE);
1.157 + exitToken = Tcl_AsyncCreate(asyncExit, NULL);
1.158 +
1.159 + /*
1.160 + * This exit handler will be used to free the
1.161 + * resources allocated in this file.
1.162 + */
1.163 + Tcl_CreateExitHandler(AppInitExitHandler, NULL);
1.164 +
1.165 +#ifdef TCL_TEST
1.166 + if (Tcltest_Init(interp) == TCL_ERROR) {
1.167 + return TCL_ERROR;
1.168 + }
1.169 + Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
1.170 + (Tcl_PackageInitProc *) NULL);
1.171 + if (TclObjTest_Init(interp) == TCL_ERROR) {
1.172 + return TCL_ERROR;
1.173 + }
1.174 +#ifdef TCL_THREADS
1.175 + if (TclThread_Init(interp) == TCL_ERROR) {
1.176 + return TCL_ERROR;
1.177 + }
1.178 +#endif
1.179 + if (Procbodytest_Init(interp) == TCL_ERROR) {
1.180 + return TCL_ERROR;
1.181 + }
1.182 + Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
1.183 + Procbodytest_SafeInit);
1.184 +#endif /* TCL_TEST */
1.185 +
1.186 +#if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES)
1.187 + {
1.188 + extern Tcl_PackageInitProc Registry_Init;
1.189 + extern Tcl_PackageInitProc Dde_Init;
1.190 +
1.191 + if (Registry_Init(interp) == TCL_ERROR) {
1.192 + return TCL_ERROR;
1.193 + }
1.194 + Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
1.195 +
1.196 + if (Dde_Init(interp) == TCL_ERROR) {
1.197 + return TCL_ERROR;
1.198 + }
1.199 + Tcl_StaticPackage(interp, "dde", Dde_Init, NULL);
1.200 + }
1.201 +#endif
1.202 +
1.203 + /*
1.204 + * Call the init procedures for included packages. Each call should
1.205 + * look like this:
1.206 + *
1.207 + * if (Mod_Init(interp) == TCL_ERROR) {
1.208 + * return TCL_ERROR;
1.209 + * }
1.210 + *
1.211 + * where "Mod" is the name of the module.
1.212 + */
1.213 +
1.214 + /*
1.215 + * Call Tcl_CreateCommand for application-specific commands, if
1.216 + * they weren't already created by the init procedures called above.
1.217 + */
1.218 +
1.219 + /*
1.220 + * Specify a user-specific startup file to invoke if the application
1.221 + * is run interactively. Typically the startup file is "~/.apprc"
1.222 + * where "app" is the name of the application. If this line is deleted
1.223 + * then no user-specific startup file will be run under any conditions.
1.224 + */
1.225 +
1.226 + Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
1.227 + return TCL_OK;
1.228 +}
1.229 +
1.230 +/*
1.231 + *----------------------------------------------------------------------
1.232 + *
1.233 + * AppInitExitHandler --
1.234 + *
1.235 + * This function is called to cleanup the app init resources before
1.236 + * Tcl is unloaded.
1.237 + *
1.238 + * Results:
1.239 + * None.
1.240 + *
1.241 + * Side effects:
1.242 + * Frees the saved argv and deletes the async exit handler.
1.243 + *
1.244 + *----------------------------------------------------------------------
1.245 + */
1.246 +
1.247 +static void
1.248 +AppInitExitHandler(
1.249 + ClientData clientData)
1.250 +{
1.251 + if (argvSave != NULL) {
1.252 + ckfree((char *)argvSave);
1.253 + argvSave = NULL;
1.254 + }
1.255 +
1.256 + if (exitToken != NULL) {
1.257 + /*
1.258 + * This should be safe to do even if we
1.259 + * are in an async exit right now.
1.260 + */
1.261 + Tcl_AsyncDelete(exitToken);
1.262 + exitToken = NULL;
1.263 + }
1.264 +}
1.265 +
1.266 +/*
1.267 + *-------------------------------------------------------------------------
1.268 + *
1.269 + * setargv --
1.270 + *
1.271 + * Parse the Windows command line string into argc/argv. Done here
1.272 + * because we don't trust the builtin argument parser in crt0.
1.273 + * Windows applications are responsible for breaking their command
1.274 + * line into arguments.
1.275 + *
1.276 + * 2N backslashes + quote -> N backslashes + begin quoted string
1.277 + * 2N + 1 backslashes + quote -> literal
1.278 + * N backslashes + non-quote -> literal
1.279 + * quote + quote in a quoted string -> single quote
1.280 + * quote + quote not in quoted string -> empty string
1.281 + * quote -> begin quoted string
1.282 + *
1.283 + * Results:
1.284 + * Fills argcPtr with the number of arguments and argvPtr with the
1.285 + * array of arguments.
1.286 + *
1.287 + * Side effects:
1.288 + * Memory allocated.
1.289 + *
1.290 + *--------------------------------------------------------------------------
1.291 + */
1.292 +
1.293 +static void
1.294 +setargv(argcPtr, argvPtr)
1.295 + int *argcPtr; /* Filled with number of argument strings. */
1.296 + char ***argvPtr; /* Filled with argument strings (malloc'd). */
1.297 +{
1.298 + char *cmdLine, *p, *arg, *argSpace;
1.299 + char **argv;
1.300 + int argc, size, inquote, copy, slashes;
1.301 +
1.302 + cmdLine = GetCommandLine(); /* INTL: BUG */
1.303 +
1.304 + /*
1.305 + * Precompute an overly pessimistic guess at the number of arguments
1.306 + * in the command line by counting non-space spans.
1.307 + */
1.308 +
1.309 + size = 2;
1.310 + for (p = cmdLine; *p != '\0'; p++) {
1.311 + if ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
1.312 + size++;
1.313 + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
1.314 + p++;
1.315 + }
1.316 + if (*p == '\0') {
1.317 + break;
1.318 + }
1.319 + }
1.320 + }
1.321 + argSpace = (char *) ckalloc(
1.322 + (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
1.323 + argv = (char **) argSpace;
1.324 + argSpace += size * sizeof(char *);
1.325 + size--;
1.326 +
1.327 + p = cmdLine;
1.328 + for (argc = 0; argc < size; argc++) {
1.329 + argv[argc] = arg = argSpace;
1.330 + while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
1.331 + p++;
1.332 + }
1.333 + if (*p == '\0') {
1.334 + break;
1.335 + }
1.336 +
1.337 + inquote = 0;
1.338 + slashes = 0;
1.339 + while (1) {
1.340 + copy = 1;
1.341 + while (*p == '\\') {
1.342 + slashes++;
1.343 + p++;
1.344 + }
1.345 + if (*p == '"') {
1.346 + if ((slashes & 1) == 0) {
1.347 + copy = 0;
1.348 + if ((inquote) && (p[1] == '"')) {
1.349 + p++;
1.350 + copy = 1;
1.351 + } else {
1.352 + inquote = !inquote;
1.353 + }
1.354 + }
1.355 + slashes >>= 1;
1.356 + }
1.357 +
1.358 + while (slashes) {
1.359 + *arg = '\\';
1.360 + arg++;
1.361 + slashes--;
1.362 + }
1.363 +
1.364 + if ((*p == '\0')
1.365 + || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
1.366 + break;
1.367 + }
1.368 + if (copy != 0) {
1.369 + *arg = *p;
1.370 + arg++;
1.371 + }
1.372 + p++;
1.373 + }
1.374 + *arg = '\0';
1.375 + argSpace = arg + 1;
1.376 + }
1.377 + argv[argc] = NULL;
1.378 +
1.379 + *argcPtr = argc;
1.380 + *argvPtr = argv;
1.381 +}
1.382 +
1.383 +/*
1.384 + *----------------------------------------------------------------------
1.385 + *
1.386 + * asyncExit --
1.387 + *
1.388 + * The AsyncProc for the exitToken.
1.389 + *
1.390 + * Results:
1.391 + * doesn't actually return.
1.392 + *
1.393 + * Side effects:
1.394 + * tclsh cleanly exits.
1.395 + *
1.396 + *----------------------------------------------------------------------
1.397 + */
1.398 +
1.399 +int
1.400 +asyncExit (ClientData clientData, Tcl_Interp *interp, int code)
1.401 +{
1.402 + Tcl_Exit((int)exitErrorCode);
1.403 +
1.404 + /* NOTREACHED */
1.405 + return code;
1.406 +}
1.407 +
1.408 +/*
1.409 + *----------------------------------------------------------------------
1.410 + *
1.411 + * sigHandler --
1.412 + *
1.413 + * Signal handler for the Win32 OS. Catches Ctrl+C, Ctrl+Break and
1.414 + * other exits. This is needed so tclsh can do it's real clean-up
1.415 + * and not an unclean crash terminate.
1.416 + *
1.417 + * Results:
1.418 + * TRUE.
1.419 + *
1.420 + * Side effects:
1.421 + * Effects the way the app exits from a signal. This is an
1.422 + * operating system supplied thread and unsafe to call ANY
1.423 + * Tcl commands except for Tcl_AsyncMark.
1.424 + *
1.425 + *----------------------------------------------------------------------
1.426 + */
1.427 +
1.428 +BOOL __stdcall
1.429 +sigHandler(DWORD fdwCtrlType)
1.430 +{
1.431 + HANDLE hStdIn;
1.432 +
1.433 + if (!exitToken) {
1.434 + /* Async token must have been destroyed, punt gracefully. */
1.435 + return FALSE;
1.436 + }
1.437 +
1.438 + /*
1.439 + * If Tcl is currently executing some bytecode or in the eventloop,
1.440 + * this will cause Tcl to enter asyncExit at the next command
1.441 + * boundry.
1.442 + */
1.443 + exitErrorCode = fdwCtrlType;
1.444 + Tcl_AsyncMark(exitToken);
1.445 +
1.446 + /*
1.447 + * This will cause Tcl_Gets in Tcl_Main() to drop-out with an <EOF>
1.448 + * should it be blocked on input and our Tcl_AsyncMark didn't grab
1.449 + * the attention of the interpreter.
1.450 + */
1.451 + hStdIn = GetStdHandle(STD_INPUT_HANDLE);
1.452 + if (hStdIn) {
1.453 + CloseHandle(hStdIn);
1.454 + }
1.455 +
1.456 + /* indicate to the OS not to call the default terminator */
1.457 + return TRUE;
1.458 +}