os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclAppInit.c
author sl
Tue, 10 Jun 2014 14:32:02 +0200
changeset 1 260cb5ec6c19
permissions -rw-r--r--
Update contrib.
sl@0
     1
/*
sl@0
     2
 * tclAppInit.c --
sl@0
     3
 *
sl@0
     4
 *	Provides a default version of the main program and Tcl_AppInit
sl@0
     5
 *	procedure for Tcl applications (without Tk).  Note that this
sl@0
     6
 *	program must be built in Win32 console mode to work properly.
sl@0
     7
 *
sl@0
     8
 * Copyright (c) 1996-1997 by Sun Microsystems, Inc.
sl@0
     9
 * Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0
    10
 *
sl@0
    11
 * See the file "license.terms" for information on usage and redistribution
sl@0
    12
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0
    13
 *
sl@0
    14
 * RCS: @(#) $Id: tclAppInit.c,v 1.11.2.3 2007/03/19 17:06:26 dgp Exp $
sl@0
    15
 */
sl@0
    16
sl@0
    17
#include "tcl.h"
sl@0
    18
#include <windows.h>
sl@0
    19
#include <locale.h>
sl@0
    20
sl@0
    21
#ifdef TCL_TEST
sl@0
    22
extern int		Procbodytest_Init _ANSI_ARGS_((Tcl_Interp *interp));
sl@0
    23
extern int		Procbodytest_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
sl@0
    24
extern int		Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
sl@0
    25
extern int		TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
sl@0
    26
#ifdef TCL_THREADS
sl@0
    27
extern int		TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp));
sl@0
    28
#endif
sl@0
    29
#endif /* TCL_TEST */
sl@0
    30
sl@0
    31
static void		setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
sl@0
    32
static BOOL __stdcall	sigHandler (DWORD fdwCtrlType);
sl@0
    33
static Tcl_AsyncProc	asyncExit;
sl@0
    34
static void		AppInitExitHandler(ClientData clientData);
sl@0
    35
sl@0
    36
static char **          argvSave = NULL;
sl@0
    37
static Tcl_AsyncHandler exitToken = NULL;
sl@0
    38
static DWORD            exitErrorCode = 0;
sl@0
    39
sl@0
    40

sl@0
    41
/*
sl@0
    42
 *----------------------------------------------------------------------
sl@0
    43
 *
sl@0
    44
 * main --
sl@0
    45
 *
sl@0
    46
 *	This is the main program for the application.
sl@0
    47
 *
sl@0
    48
 * Results:
sl@0
    49
 *	None: Tcl_Main never returns here, so this procedure never
sl@0
    50
 *	returns either.
sl@0
    51
 *
sl@0
    52
 * Side effects:
sl@0
    53
 *	Whatever the application does.
sl@0
    54
 *
sl@0
    55
 *----------------------------------------------------------------------
sl@0
    56
 */
sl@0
    57
sl@0
    58
int
sl@0
    59
main(argc, argv)
sl@0
    60
    int argc;			/* Number of command-line arguments. */
sl@0
    61
    char **argv;		/* Values of command-line arguments. */
sl@0
    62
{
sl@0
    63
    /*
sl@0
    64
     * The following #if block allows you to change the AppInit
sl@0
    65
     * function by using a #define of TCL_LOCAL_APPINIT instead
sl@0
    66
     * of rewriting this entire file.  The #if checks for that
sl@0
    67
     * #define and uses Tcl_AppInit if it doesn't exist.
sl@0
    68
     */
sl@0
    69
sl@0
    70
#ifndef TCL_LOCAL_APPINIT
sl@0
    71
#define TCL_LOCAL_APPINIT Tcl_AppInit
sl@0
    72
#endif
sl@0
    73
    extern int TCL_LOCAL_APPINIT _ANSI_ARGS_((Tcl_Interp *interp));
sl@0
    74
sl@0
    75
    /*
sl@0
    76
     * The following #if block allows you to change how Tcl finds the startup
sl@0
    77
     * script, prime the library or encoding paths, fiddle with the argv,
sl@0
    78
     * etc., without needing to rewrite Tcl_Main()
sl@0
    79
     */
sl@0
    80
sl@0
    81
#ifdef TCL_LOCAL_MAIN_HOOK
sl@0
    82
    extern int TCL_LOCAL_MAIN_HOOK _ANSI_ARGS_((int *argc, char ***argv));
sl@0
    83
#endif
sl@0
    84
sl@0
    85
    char buffer[MAX_PATH +1];
sl@0
    86
    char *p;
sl@0
    87
    /*
sl@0
    88
     * Set up the default locale to be standard "C" locale so parsing
sl@0
    89
     * is performed correctly.
sl@0
    90
     */
sl@0
    91
sl@0
    92
    setlocale(LC_ALL, "C");
sl@0
    93
    setargv(&argc, &argv);
sl@0
    94
sl@0
    95
    /*
sl@0
    96
     * Save this for later, so we can free it.
sl@0
    97
     */
sl@0
    98
    argvSave = argv;
sl@0
    99
sl@0
   100
    /*
sl@0
   101
     * Replace argv[0] with full pathname of executable, and forward
sl@0
   102
     * slashes substituted for backslashes.
sl@0
   103
     */
sl@0
   104
sl@0
   105
    GetModuleFileName(NULL, buffer, sizeof(buffer));
sl@0
   106
    argv[0] = buffer;
sl@0
   107
    for (p = buffer; *p != '\0'; p++) {
sl@0
   108
	if (*p == '\\') {
sl@0
   109
	    *p = '/';
sl@0
   110
	}
sl@0
   111
    }
sl@0
   112
sl@0
   113
#ifdef TCL_LOCAL_MAIN_HOOK
sl@0
   114
    TCL_LOCAL_MAIN_HOOK(&argc, &argv);
sl@0
   115
#endif
sl@0
   116
sl@0
   117
    Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
sl@0
   118
sl@0
   119
    return 0;			/* Needed only to prevent compiler warning. */
sl@0
   120
}
sl@0
   121
sl@0
   122

sl@0
   123
/*
sl@0
   124
 *----------------------------------------------------------------------
sl@0
   125
 *
sl@0
   126
 * Tcl_AppInit --
sl@0
   127
 *
sl@0
   128
 *	This procedure performs application-specific initialization.
sl@0
   129
 *	Most applications, especially those that incorporate additional
sl@0
   130
 *	packages, will have their own version of this procedure.
sl@0
   131
 *
sl@0
   132
 * Results:
sl@0
   133
 *	Returns a standard Tcl completion code, and leaves an error
sl@0
   134
 *	message in the interp's result if an error occurs.
sl@0
   135
 *
sl@0
   136
 * Side effects:
sl@0
   137
 *	Depends on the startup script.
sl@0
   138
 *
sl@0
   139
 *----------------------------------------------------------------------
sl@0
   140
 */
sl@0
   141
sl@0
   142
int
sl@0
   143
Tcl_AppInit(interp)
sl@0
   144
    Tcl_Interp *interp;		/* Interpreter for application. */
sl@0
   145
{
sl@0
   146
    if (Tcl_Init(interp) == TCL_ERROR) {
sl@0
   147
	return TCL_ERROR;
sl@0
   148
    }
sl@0
   149
sl@0
   150
    /*
sl@0
   151
     * Install a signal handler to the win32 console tclsh is running in.
sl@0
   152
     */
sl@0
   153
    SetConsoleCtrlHandler(sigHandler, TRUE);
sl@0
   154
    exitToken = Tcl_AsyncCreate(asyncExit, NULL);
sl@0
   155
sl@0
   156
    /*
sl@0
   157
     * This exit handler will be used to free the
sl@0
   158
     * resources allocated in this file.
sl@0
   159
     */
sl@0
   160
    Tcl_CreateExitHandler(AppInitExitHandler, NULL);
sl@0
   161
sl@0
   162
#ifdef TCL_TEST
sl@0
   163
    if (Tcltest_Init(interp) == TCL_ERROR) {
sl@0
   164
	return TCL_ERROR;
sl@0
   165
    }
sl@0
   166
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init,
sl@0
   167
            (Tcl_PackageInitProc *) NULL);
sl@0
   168
    if (TclObjTest_Init(interp) == TCL_ERROR) {
sl@0
   169
	return TCL_ERROR;
sl@0
   170
    }
sl@0
   171
#ifdef TCL_THREADS
sl@0
   172
    if (TclThread_Init(interp) == TCL_ERROR) {
sl@0
   173
	return TCL_ERROR;
sl@0
   174
    }
sl@0
   175
#endif
sl@0
   176
    if (Procbodytest_Init(interp) == TCL_ERROR) {
sl@0
   177
	return TCL_ERROR;
sl@0
   178
    }
sl@0
   179
    Tcl_StaticPackage(interp, "procbodytest", Procbodytest_Init,
sl@0
   180
            Procbodytest_SafeInit);
sl@0
   181
#endif /* TCL_TEST */
sl@0
   182
sl@0
   183
#if defined(STATIC_BUILD) && defined(TCL_USE_STATIC_PACKAGES)
sl@0
   184
    {
sl@0
   185
	extern Tcl_PackageInitProc Registry_Init;
sl@0
   186
	extern Tcl_PackageInitProc Dde_Init;
sl@0
   187
sl@0
   188
	if (Registry_Init(interp) == TCL_ERROR) {
sl@0
   189
	    return TCL_ERROR;
sl@0
   190
	}
sl@0
   191
	Tcl_StaticPackage(interp, "registry", Registry_Init, NULL);
sl@0
   192
sl@0
   193
	if (Dde_Init(interp) == TCL_ERROR) {
sl@0
   194
	    return TCL_ERROR;
sl@0
   195
	}
sl@0
   196
	Tcl_StaticPackage(interp, "dde", Dde_Init, NULL);
sl@0
   197
   }
sl@0
   198
#endif
sl@0
   199
sl@0
   200
    /*
sl@0
   201
     * Call the init procedures for included packages.  Each call should
sl@0
   202
     * look like this:
sl@0
   203
     *
sl@0
   204
     * if (Mod_Init(interp) == TCL_ERROR) {
sl@0
   205
     *     return TCL_ERROR;
sl@0
   206
     * }
sl@0
   207
     *
sl@0
   208
     * where "Mod" is the name of the module.
sl@0
   209
     */
sl@0
   210
sl@0
   211
    /*
sl@0
   212
     * Call Tcl_CreateCommand for application-specific commands, if
sl@0
   213
     * they weren't already created by the init procedures called above.
sl@0
   214
     */
sl@0
   215
sl@0
   216
    /*
sl@0
   217
     * Specify a user-specific startup file to invoke if the application
sl@0
   218
     * is run interactively.  Typically the startup file is "~/.apprc"
sl@0
   219
     * where "app" is the name of the application.  If this line is deleted
sl@0
   220
     * then no user-specific startup file will be run under any conditions.
sl@0
   221
     */
sl@0
   222
sl@0
   223
    Tcl_SetVar(interp, "tcl_rcFileName", "~/tclshrc.tcl", TCL_GLOBAL_ONLY);
sl@0
   224
    return TCL_OK;
sl@0
   225
}
sl@0
   226

sl@0
   227
/*
sl@0
   228
 *----------------------------------------------------------------------
sl@0
   229
 *
sl@0
   230
 * AppInitExitHandler --
sl@0
   231
 *
sl@0
   232
 *	This function is called to cleanup the app init resources before
sl@0
   233
 *	Tcl is unloaded.
sl@0
   234
 *
sl@0
   235
 * Results:
sl@0
   236
 *	None.
sl@0
   237
 *
sl@0
   238
 * Side effects:
sl@0
   239
 *	Frees the saved argv and deletes the async exit handler.
sl@0
   240
 *
sl@0
   241
 *----------------------------------------------------------------------
sl@0
   242
 */
sl@0
   243
sl@0
   244
static void
sl@0
   245
AppInitExitHandler(
sl@0
   246
    ClientData clientData)
sl@0
   247
{
sl@0
   248
    if (argvSave != NULL) {
sl@0
   249
        ckfree((char *)argvSave);
sl@0
   250
        argvSave = NULL;
sl@0
   251
    }
sl@0
   252
sl@0
   253
    if (exitToken != NULL) {
sl@0
   254
        /*
sl@0
   255
         * This should be safe to do even if we
sl@0
   256
         * are in an async exit right now.
sl@0
   257
         */
sl@0
   258
        Tcl_AsyncDelete(exitToken);
sl@0
   259
        exitToken = NULL;
sl@0
   260
    }
sl@0
   261
}
sl@0
   262

sl@0
   263
/*
sl@0
   264
 *-------------------------------------------------------------------------
sl@0
   265
 *
sl@0
   266
 * setargv --
sl@0
   267
 *
sl@0
   268
 *	Parse the Windows command line string into argc/argv.  Done here
sl@0
   269
 *	because we don't trust the builtin argument parser in crt0.
sl@0
   270
 *	Windows applications are responsible for breaking their command
sl@0
   271
 *	line into arguments.
sl@0
   272
 *
sl@0
   273
 *	2N backslashes + quote -> N backslashes + begin quoted string
sl@0
   274
 *	2N + 1 backslashes + quote -> literal
sl@0
   275
 *	N backslashes + non-quote -> literal
sl@0
   276
 *	quote + quote in a quoted string -> single quote
sl@0
   277
 *	quote + quote not in quoted string -> empty string
sl@0
   278
 *	quote -> begin quoted string
sl@0
   279
 *
sl@0
   280
 * Results:
sl@0
   281
 *	Fills argcPtr with the number of arguments and argvPtr with the
sl@0
   282
 *	array of arguments.
sl@0
   283
 *
sl@0
   284
 * Side effects:
sl@0
   285
 *	Memory allocated.
sl@0
   286
 *
sl@0
   287
 *--------------------------------------------------------------------------
sl@0
   288
 */
sl@0
   289
sl@0
   290
static void
sl@0
   291
setargv(argcPtr, argvPtr)
sl@0
   292
    int *argcPtr;		/* Filled with number of argument strings. */
sl@0
   293
    char ***argvPtr;		/* Filled with argument strings (malloc'd). */
sl@0
   294
{
sl@0
   295
    char *cmdLine, *p, *arg, *argSpace;
sl@0
   296
    char **argv;
sl@0
   297
    int argc, size, inquote, copy, slashes;
sl@0
   298
sl@0
   299
    cmdLine = GetCommandLine();	/* INTL: BUG */
sl@0
   300
sl@0
   301
    /*
sl@0
   302
     * Precompute an overly pessimistic guess at the number of arguments
sl@0
   303
     * in the command line by counting non-space spans.
sl@0
   304
     */
sl@0
   305
sl@0
   306
    size = 2;
sl@0
   307
    for (p = cmdLine; *p != '\0'; p++) {
sl@0
   308
	if ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
sl@0
   309
	    size++;
sl@0
   310
	    while ((*p == ' ') || (*p == '\t')) { /* INTL: ISO space. */
sl@0
   311
		p++;
sl@0
   312
	    }
sl@0
   313
	    if (*p == '\0') {
sl@0
   314
		break;
sl@0
   315
	    }
sl@0
   316
	}
sl@0
   317
    }
sl@0
   318
    argSpace = (char *) ckalloc(
sl@0
   319
	    (unsigned) (size * sizeof(char *) + strlen(cmdLine) + 1));
sl@0
   320
    argv = (char **) argSpace;
sl@0
   321
    argSpace += size * sizeof(char *);
sl@0
   322
    size--;
sl@0
   323
sl@0
   324
    p = cmdLine;
sl@0
   325
    for (argc = 0; argc < size; argc++) {
sl@0
   326
	argv[argc] = arg = argSpace;
sl@0
   327
	while ((*p == ' ') || (*p == '\t')) {	/* INTL: ISO space. */
sl@0
   328
	    p++;
sl@0
   329
	}
sl@0
   330
	if (*p == '\0') {
sl@0
   331
	    break;
sl@0
   332
	}
sl@0
   333
sl@0
   334
	inquote = 0;
sl@0
   335
	slashes = 0;
sl@0
   336
	while (1) {
sl@0
   337
	    copy = 1;
sl@0
   338
	    while (*p == '\\') {
sl@0
   339
		slashes++;
sl@0
   340
		p++;
sl@0
   341
	    }
sl@0
   342
	    if (*p == '"') {
sl@0
   343
		if ((slashes & 1) == 0) {
sl@0
   344
		    copy = 0;
sl@0
   345
		    if ((inquote) && (p[1] == '"')) {
sl@0
   346
			p++;
sl@0
   347
			copy = 1;
sl@0
   348
		    } else {
sl@0
   349
			inquote = !inquote;
sl@0
   350
		    }
sl@0
   351
                }
sl@0
   352
                slashes >>= 1;
sl@0
   353
            }
sl@0
   354
sl@0
   355
            while (slashes) {
sl@0
   356
		*arg = '\\';
sl@0
   357
		arg++;
sl@0
   358
		slashes--;
sl@0
   359
	    }
sl@0
   360
sl@0
   361
	    if ((*p == '\0')
sl@0
   362
		    || (!inquote && ((*p == ' ') || (*p == '\t')))) { /* INTL: ISO space. */
sl@0
   363
		break;
sl@0
   364
	    }
sl@0
   365
	    if (copy != 0) {
sl@0
   366
		*arg = *p;
sl@0
   367
		arg++;
sl@0
   368
	    }
sl@0
   369
	    p++;
sl@0
   370
        }
sl@0
   371
	*arg = '\0';
sl@0
   372
	argSpace = arg + 1;
sl@0
   373
    }
sl@0
   374
    argv[argc] = NULL;
sl@0
   375
sl@0
   376
    *argcPtr = argc;
sl@0
   377
    *argvPtr = argv;
sl@0
   378
}
sl@0
   379

sl@0
   380
/*
sl@0
   381
 *----------------------------------------------------------------------
sl@0
   382
 *
sl@0
   383
 * asyncExit --
sl@0
   384
 *
sl@0
   385
 * 	The AsyncProc for the exitToken.
sl@0
   386
 *
sl@0
   387
 * Results:
sl@0
   388
 * 	doesn't actually return.
sl@0
   389
 *
sl@0
   390
 * Side effects:
sl@0
   391
 * 	tclsh cleanly exits.
sl@0
   392
 *
sl@0
   393
 *----------------------------------------------------------------------
sl@0
   394
 */
sl@0
   395
sl@0
   396
int
sl@0
   397
asyncExit (ClientData clientData, Tcl_Interp *interp, int code)
sl@0
   398
{
sl@0
   399
    Tcl_Exit((int)exitErrorCode);
sl@0
   400
sl@0
   401
    /* NOTREACHED */
sl@0
   402
    return code;
sl@0
   403
}
sl@0
   404

sl@0
   405
/*
sl@0
   406
 *----------------------------------------------------------------------
sl@0
   407
 *
sl@0
   408
 * sigHandler --
sl@0
   409
 *
sl@0
   410
 *	Signal handler for the Win32 OS. Catches Ctrl+C, Ctrl+Break and
sl@0
   411
 *	other exits. This is needed so tclsh can do it's real clean-up
sl@0
   412
 *	and not an unclean crash terminate.
sl@0
   413
 *
sl@0
   414
 * Results:
sl@0
   415
 *	TRUE.
sl@0
   416
 *
sl@0
   417
 * Side effects:
sl@0
   418
 *	Effects the way the app exits from a signal. This is an
sl@0
   419
 *	operating system supplied thread and unsafe to call ANY
sl@0
   420
 *	Tcl commands except for Tcl_AsyncMark.
sl@0
   421
 *
sl@0
   422
 *----------------------------------------------------------------------
sl@0
   423
 */
sl@0
   424
sl@0
   425
BOOL __stdcall
sl@0
   426
sigHandler(DWORD fdwCtrlType)
sl@0
   427
{
sl@0
   428
    HANDLE hStdIn;
sl@0
   429
sl@0
   430
    if (!exitToken) {
sl@0
   431
	/* Async token must have been destroyed, punt gracefully. */
sl@0
   432
	return FALSE;
sl@0
   433
    }
sl@0
   434
sl@0
   435
    /*
sl@0
   436
     * If Tcl is currently executing some bytecode or in the eventloop,
sl@0
   437
     * this will cause Tcl to enter asyncExit at the next command
sl@0
   438
     * boundry.
sl@0
   439
     */
sl@0
   440
    exitErrorCode = fdwCtrlType;
sl@0
   441
    Tcl_AsyncMark(exitToken);
sl@0
   442
sl@0
   443
    /*
sl@0
   444
     * This will cause Tcl_Gets in Tcl_Main() to drop-out with an <EOF>
sl@0
   445
     * should it be blocked on input and our Tcl_AsyncMark didn't grab
sl@0
   446
     * the attention of the interpreter.
sl@0
   447
     */
sl@0
   448
    hStdIn = GetStdHandle(STD_INPUT_HANDLE);
sl@0
   449
    if (hStdIn) {
sl@0
   450
	CloseHandle(hStdIn);
sl@0
   451
    }
sl@0
   452
sl@0
   453
    /* indicate to the OS not to call the default terminator */
sl@0
   454
    return TRUE;
sl@0
   455
}