Changes On Branch internal-ensemble-cleanup
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch internal-ensemble-cleanup Excluding Merge-Ins

This is equivalent to a diff from b6800b76c8 to ad795c4db6

2025-11-11
20:26
Refactor core ensemble creation/management so that the tables describing what's there and what's saf... check-in: a165eede1d user: dkf tags: trunk, main
09:29
Merge 9.0 check-in: 2f1c224732 user: jan.nijtmans tags: trunk, main
2025-11-10
17:03
merge trunk Closed-Leaf check-in: ad795c4db6 user: dkf tags: internal-ensemble-cleanup
17:00
merge trunk Closed-Leaf check-in: 2491dad7a7 user: dkf tags: c11-tebc-trace-cleanup
15:09
merge trunk check-in: 7ffebdfab0 user: dkf tags: enums-3
14:02
Name three related enums in a consistent way check-in: b6800b76c8 user: dkf tags: trunk, main
2025-11-09
11:16
merge trunk check-in: fcad76bb7d user: dkf tags: internal-ensemble-cleanup
09:57
Merge 9.0. Bug [cb03e57a] - raise error on empty regexp for unresolved variable. check-in: 2ab1a13679 user: apnadkarni tags: trunk, main

Changes to generic/tclBasic.c.
163
164
165
166
167
168
169

170
171
172
173
174
175
176
    iPtr->lineLABCPtr = (context).lineLABCPtr

/*
 * Static functions in this file:
 */

static Tcl_ObjCmdProc	BadEnsembleSubcommand;

static char *		CallCommandTraces(Interp *iPtr, Command *cmdPtr,
			    const char *oldName, const char *newName,
			    int flags);
static int		CancelEvalProc(void *clientData,
			    Tcl_Interp *interp, int code);
static int		CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void		DeleteCoroutine(void *clientData);







>







163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
    iPtr->lineLABCPtr = (context).lineLABCPtr

/*
 * Static functions in this file:
 */

static Tcl_ObjCmdProc	BadEnsembleSubcommand;
static Tcl_CmdDeleteProc BadEnsembleSubcommandCleanup;
static char *		CallCommandTraces(Interp *iPtr, Command *cmdPtr,
			    const char *oldName, const char *newName,
			    int flags);
static int		CancelEvalProc(void *clientData,
			    Tcl_Interp *interp, int code);
static int		CheckDoubleResult(Tcl_Interp *interp, double dResult);
static void		DeleteCoroutine(void *clientData);
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282

283








284



285
286
287
288
289

290
291
292
293
294
295
296
297
298
299
300
};

/*
 * The following structure define the commands in the Tcl core.
 */

typedef struct {
    const char *name;		/* Name of object-based command. */
    Tcl_ObjCmdProc *objProc;	/* Object-based function for command. */
    CompileProc *compileProc;	/* Function called to compile command. */
    Tcl_ObjCmdProc *nreProc;	/* NR-based function for command */
    int flags;			/* Various flag bits, as defined below. */
} CmdInfo;

enum CmdInfoFlags {
    CMD_IS_SAFE = 1		/* Whether this command is part of the set of
				 * commands present by default in a safe
				 * interpreter. */
/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
 * expansion for itself rather than needing the generic layer to take care of
 * it for it. Defined in tclInt.h. */
};

/*
 * The following struct states that the command it talks about (a subcommand
 * of one of Tcl's built-in ensembles) is unsafe and must be hidden when an
 * interpreter is made safe. (TclHideUnsafeCommands accesses an array of these
 * structs.) Alas, we can't sensibly just store the information directly in
 * the commands.

 */












typedef struct {
    const char *ensembleNsName;	/* The ensemble's name within ::tcl. NULL for
				 * the end of the list of commands to hide. */
    const char *commandName;	/* The name of the command within the
				 * ensemble. If this is NULL, we want to also

				 * make the overall command be hidden, an ugly
				 * hack because it is expected by security
				 * policies in the wild. */
} UnsafeEnsembleInfo;

/*
 * The built-in commands, and the functions that implement them:
 */

static int
ProcObjCmd(







|
|
|
|
|












<
<
<
<
|
>

>
>
>
>
>
>
>
>

>
>
>
|
|
<
|
|
>
|
|
|
|







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278




279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295

296
297
298
299
300
301
302
303
304
305
306
307
308
309
};

/*
 * The following structure define the commands in the Tcl core.
 */

typedef struct {
    const char *name;		// Name of object-based command.
    Tcl_ObjCmdProc *objProc;	// Object-based function for command.
    CompileProc *compileProc;	// Function called to compile command.
    Tcl_ObjCmdProc *nreProc;	// NR-based function for command.
    int flags;			// Various flag bits, as defined below.
} CmdInfo;

enum CmdInfoFlags {
    CMD_IS_SAFE = 1		/* Whether this command is part of the set of
				 * commands present by default in a safe
				 * interpreter. */
/* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle
 * expansion for itself rather than needing the generic layer to take care of
 * it for it. Defined in tclInt.h. */
};

/*




 * Description of commands in ::tcl::unsupported.
 *
 */
typedef struct UnsupportedCmdInfo {
    const char *name;		// Name of command in ::tcl::unsupported.
    Tcl_ObjCmdProc *objProc;	// Object-based function for command.
    CompileProc *compileProc;	// Function called to compile command.
    Tcl_ObjCmdProc *nreProc;	// NR-based function for command.
    void *clientData;		// ClientData to use for the command.
    int flags;			// Various flag bits, as defined for CmdInfo.
} UnsupportedCmdInfo;

// A function that can configure an ensemble after it is created.
typedef int (EnsembleConfigurer)(Tcl_Interp *interp, Tcl_Command ensemble);

typedef struct EnsembleSetup {
    const char *name;		// Name of ensemble.

    const EnsembleImplMap *implMap; // Ensemble contents descriptor.
    EnsembleConfigurer *configurerProc; // Optional callback for customisation.
    int flags;			/* Ensemble commands are never technically
				 * unsafe (though their subcommands may well
				 * be so), but some code expects them to be
				 * so. This flag lets us mark those cases. */
} EnsembleSetup;

/*
 * The built-in commands, and the functions that implement them:
 */

static int
ProcObjCmd(
404
405
406
407
408
409
410
411

412
413
414
415
416
417
418

419
420
421
422
423

424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454




455
456
457
458

459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481

482
483
484
485
486
487
488
489
    {"timerate",	Tcl_TimeRateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {NULL,		NULL,			NULL,			NULL,	0}
};

/*

 * Information about which pieces of ensembles to hide when making an
 * interpreter safe:
 */

static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = {
    /* [encoding] has two unsafe commands. Assumed by older security policies
     * to be overall unsafe; it isn't but... */

    {"encoding", NULL},
    {"encoding", "dirs"},
    {"encoding", "system"},
    /* [file] has MANY unsafe commands! Assumed by older security policies to
     * be overall unsafe; it isn't but... */

    {"file", NULL},
    {"file", "atime"},
    {"file", "attributes"},
    {"file", "copy"},
    {"file", "delete"},
    {"file", "dirname"},
    {"file", "executable"},
    {"file", "exists"},
    {"file", "extension"},
    {"file", "home"},
    {"file", "isdirectory"},
    {"file", "isfile"},
    {"file", "link"},
    {"file", "lstat"},
    {"file", "mtime"},
    {"file", "mkdir"},
    {"file", "nativename"},
    {"file", "normalize"},
    {"file", "owned"},
    {"file", "readable"},
    {"file", "readlink"},
    {"file", "rename"},
    {"file", "rootname"},
    {"file", "size"},
    {"file", "stat"},
    {"file", "tail"},
    {"file", "tempdir"},
    {"file", "tempfile"},
    {"file", "tildeexpand"},
    {"file", "type"},
    {"file", "volumes"},




    {"file", "writable"},
    /* [info] has two unsafe commands */
    {"info", "cmdtype"},
    {"info", "nameofexecutable"},

    /* [tcl::process] has ONLY unsafe commands! */
    {"process", "list"},
    {"process", "status"},
    {"process", "purge"},
    {"process", "autopurge"},
    /*
     * [zipfs] perhaps has some safe commands. But like file make it inaccessible
     * until they are analyzed to be safe.
     */
    {"zipfs", NULL},
    {"zipfs", "canonical"},
    {"zipfs", "exists"},
    {"zipfs", "info"},
    {"zipfs", "list"},
    {"zipfs", "lmkimg"},
    {"zipfs", "lmkzip"},
    {"zipfs", "mkimg"},
    {"zipfs", "mkkey"},
    {"zipfs", "mkzip"},
    {"zipfs", "mount"},
    {"zipfs", "mountdata"},
    {"zipfs", "root"},
    {"zipfs", "unmount"},

    {NULL, NULL}
};

/*
 * Math functions. All are safe.
 */

typedef double (BuiltinUnaryFunc)(double x);







<
>
|
|
<
|
<
<
<
>
|
<
<
<
<
>
|
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
|
|
|
|
|
|
>
>
>
>
|
<
|
|
>
|
|
<
<
<
<
|
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
>
|







413
414
415
416
417
418
419

420
421
422

423



424
425




426
427


428



















429
430
431
432
433
434
435
436
437
438
439
440
441

442
443
444
445
446




447


448













449
450
451
452
453
454
455
456
457
    {"timerate",	Tcl_TimeRateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"unload",		Tcl_UnloadObjCmd,	NULL,			NULL,	0},
    {"update",		Tcl_UpdateObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {"vwait",		Tcl_VwaitObjCmd,	NULL,			NULL,	CMD_IS_SAFE},
    {NULL,		NULL,			NULL,			NULL,	0}
};


static const UnsupportedCmdInfo unsupportedCmds[] = {
    {"disassemble",	Tcl_DisassembleObjCmd,	NULL,			NULL,	INT2PTR(0), 0},
    {"getbytecode",	Tcl_DisassembleObjCmd,	NULL,			NULL,	INT2PTR(1), 0},

    {"representation",	Tcl_RepresentationCmd,	NULL,			NULL,	NULL, 0},



    {"assemble",	Tcl_AssembleObjCmd,	TclCompileAssembleCmd,	TclNRAssembleObjCmd, NULL, CMD_IS_SAFE},
    {"corotype",	CoroTypeObjCmd,		NULL,			NULL,	NULL, CMD_IS_SAFE},




    {"loadIcu",		TclLoadIcuObjCmd,	NULL,			NULL,	NULL, 0}, // TODO: Is this supposed to be callable from safe interps?
    {NULL, NULL, NULL, NULL, NULL, 0}


};




















// Table of definitions of ensemble commands.
static const EnsembleSetup ensembleCommands[] = {
    {"array",		tclArrayImplMap,	NULL, CMD_IS_SAFE},
    {"binary",		tclBinaryImplMap,	NULL, CMD_IS_SAFE},
    {"binary encode",	tclBinaryEncodeImplMap, NULL, CMD_IS_SAFE},
    {"binary decode",	tclBinaryDecodeImplMap, NULL, CMD_IS_SAFE},
    {"chan",		tclChanImplMap,		TclSetUpChanCmd, CMD_IS_SAFE},
    // TODO: Sort out why setup of [clock] is so weird
    {"clock",		tclClockImplMap,	NULL, 0},
    {"dict",		tclDictImplMap,		NULL, CMD_IS_SAFE},
    {"encoding",	tclEncodingImplMap,	NULL, 0},
    {"file",		tclFileImplMap,		NULL, 0},

    {"info",		tclInfoImplMap,		NULL, CMD_IS_SAFE},
    {"namespace",	tclNamespaceImplMap,	NULL, CMD_IS_SAFE},
    {"string",		tclStringImplMap,	NULL, CMD_IS_SAFE},
    {"::tcl::prefix",	tclPrefixImplMap,	TclSetUpPrefixCmd, CMD_IS_SAFE},
    {"::tcl::process",	tclProcessImplMap,	TclSetUpProcessCmd, CMD_IS_SAFE},




    {"unicode",		tclUnicodeImplMap,	NULL, CMD_IS_SAFE},


    {"zipfs",		tclZipfsImplMap,	NULL, 0},













    {"zlib",		tclZlibImplMap,		NULL, CMD_IS_SAFE},
    {NULL, NULL, NULL, 0}
};

/*
 * Math functions. All are safe.
 */

typedef double (BuiltinUnaryFunc)(double x);
1103
1104
1105
1106
1107
1108
1109







1110
1111
1112
1113
1114
1115
1116
    iPtr->allocCache = (AllocCache *)TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;








    /*
     * Create the core commands. Do it here, rather than calling Tcl_CreateObjCommand,
     * because it's faster (there's no need to check for a preexisting command
     * by the same name). Set the Tcl_CmdProc to NULL.
     */








>
>
>
>
>
>
>







1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
    iPtr->allocCache = (AllocCache *)TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;

    // Create the namespace for unsupported bits and pieces.
    Tcl_Namespace *unsupportedNs = Tcl_CreateNamespace(interp,
	    "::tcl::unsupported", NULL, NULL);
    if (unsupportedNs == NULL) {
	Tcl_Panic("couldn't find ::tcl::unsupported");
    }

    /*
     * Create the core commands. Do it here, rather than calling Tcl_CreateObjCommand,
     * because it's faster (there's no need to check for a preexisting command
     * by the same name). Set the Tcl_CmdProc to NULL.
     */

1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164

1165
1166
1167
1168



1169
1170
1171
1172
1173
1174
1175
	    cmdPtr->tracePtr = NULL;
	    cmdPtr->nreProc = cmdInfoPtr->nreProc;
	    Tcl_SetHashValue(hPtr, cmdPtr);
	}
    }

    /*
     * Create the "array", "binary", "chan", "clock", "dict", "encoding",
     * "file", "info", "namespace" and "string" ensembles. Note that all these
     * commands (and their subcommands that are not present in the global
     * namespace) are wholly safe *except* for "clock", "encoding" and "file".
     */

    TclInitArrayCmd(interp);
    TclInitBinaryCmd(interp);
    TclInitChanCmd(interp);
    TclInitDictCmd(interp);
    TclInitEncodingCmd(interp);
    TclInitFileCmd(interp);
    TclInitInfoCmd(interp);
    TclInitNamespaceCmd(interp);

    TclInitStringCmd(interp);
    TclInitUnicodeCmd(interp);
    TclInitPrefixCmd(interp);
    TclInitProcessCmd(interp);




    /*
     * Register "clock" subcommands. These *do* go through
     * Tcl_CreateObjCommand, since they aren't in the global namespace and
     * involve ensembles.
     */








|
|
|
|


|
|
|
|
|
<
<
|
>
|
<
<
<
>
>
>







1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136


1137
1138
1139



1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
	    cmdPtr->tracePtr = NULL;
	    cmdPtr->nreProc = cmdInfoPtr->nreProc;
	    Tcl_SetHashValue(hPtr, cmdPtr);
	}
    }

    /*
     * Create the standard ensembles "array", "binary", "chan", "clock",
     * "dict", "encoding", "file", "info", "namespace", "string", etc. Note
     * that most of these commands (and their subcommands that are not present
     * in the global namespace) are wholly safe *except*  as marked.
     */

    const EnsembleSetup *ensSetupPtr;
    for (ensSetupPtr=ensembleCommands; ensSetupPtr->name; ensSetupPtr++) {
	Tcl_Command ensemble = TclMakeEnsemble(interp, ensSetupPtr->name,
		ensSetupPtr->implMap);
	if (ensSetupPtr->configurerProc) {


	    if (ensSetupPtr->configurerProc(interp, ensemble) != TCL_OK) {
		Tcl_Panic("failed to set up %s: %s", ensSetupPtr->name,
			Tcl_GetStringResult(interp));



	    }
	}
    }

    /*
     * Register "clock" subcommands. These *do* go through
     * Tcl_CreateObjCommand, since they aren't in the global namespace and
     * involve ensembles.
     */

1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
    Tcl_CreateObjCommand(interp, "::tcl::Bgerror",
	    TclDefaultBgErrorHandlerObjCmd, NULL, NULL);

    /*
     * Create unsupported commands for debugging bytecode and objects.
     */

    Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
	    Tcl_DisassembleObjCmd, INT2PTR(0), NULL);
    Tcl_CreateObjCommand(interp, "::tcl::unsupported::getbytecode",
	    Tcl_DisassembleObjCmd, INT2PTR(1), NULL);
    Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation",
	    Tcl_RepresentationCmd, NULL, NULL);

    /* Adding the bytecode assembler command */
    cmdPtr = (Command *) Tcl_NRCreateCommand(interp,
	    "::tcl::unsupported::assemble", Tcl_AssembleObjCmd,
	    TclNRAssembleObjCmd, NULL, NULL);
    cmdPtr->compileProc = &TclCompileAssembleCmd;

    /* Coroutine monkeybusiness */
    Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype",
	    CoroTypeObjCmd, NULL, NULL);

    /* Load and intialize ICU */
    Tcl_CreateObjCommand(interp, "::tcl::unsupported::loadIcu",
	    TclLoadIcuObjCmd, NULL, NULL);

    /* Export unsupported commands */
    nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0);
    if (nsPtr) {
	Tcl_Export(interp, nsPtr, "*", 1);
    }

#ifdef USE_DTRACE
    /*
     * Register the tcl::dtrace command.
     */

    Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);
#endif /* USE_DTRACE */

    /*
     * Register the builtin math functions.
     */

    nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL,NULL);
    if (nsPtr == NULL) {
	Tcl_Panic("Can't create math function namespace");
    }
#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
    memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
    for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
	    builtinFuncPtr++) {







|
<
<
<
<
<
|
<
|
|
|
<
|
<
<
<
|
<
<
<
|
<
<
<
|
<













|







1161
1162
1163
1164
1165
1166
1167
1168





1169

1170
1171
1172

1173



1174



1175



1176

1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
    Tcl_CreateObjCommand(interp, "::tcl::Bgerror",
	    TclDefaultBgErrorHandlerObjCmd, NULL, NULL);

    /*
     * Create unsupported commands for debugging bytecode and objects.
     */

    const UnsupportedCmdInfo *unsCmdInfoPtr;





    for (unsCmdInfoPtr=unsupportedCmds; unsCmdInfoPtr->name; unsCmdInfoPtr++) {

	cmdPtr = (Command *) TclCreateObjCommandInNs(interp,
		unsCmdInfoPtr->name, unsupportedNs, unsCmdInfoPtr->objProc,
		unsCmdInfoPtr->clientData, NULL);

	cmdPtr->nreProc = unsCmdInfoPtr->nreProc;



	cmdPtr->compileProc = unsCmdInfoPtr->compileProc;



    }



    Tcl_Export(interp, unsupportedNs, "*", 1);


#ifdef USE_DTRACE
    /*
     * Register the tcl::dtrace command.
     */

    Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);
#endif /* USE_DTRACE */

    /*
     * Register the builtin math functions.
     */

    nsPtr = Tcl_CreateNamespace(interp, "::tcl::mathfunc", NULL, NULL);
    if (nsPtr == NULL) {
	Tcl_Panic("Can't create math function namespace");
    }
#define MATH_FUNC_PREFIX_LEN 17 /* == strlen("::tcl::mathfunc::") */
    memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN);
    for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL;
	    builtinFuncPtr++) {
1433
1434
1435
1436
1437
1438
1439






























1440
1441
1442
1443
1444
1445

1446

1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459


1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483

1484
1485
1486

1487
1488
1489
1490
1491
1492
1493




1494
1495
1496
1497
1498
1499
1500
 *	TCL_OK if it succeeds, TCL_ERROR else.
 *
 * Side effects:
 *	Hides functionality in an interpreter.
 *
 *----------------------------------------------------------------------
 */































int
TclHideUnsafeCommands(
    Tcl_Interp *interp)		/* Hide commands in this interpreter. */
{
    const CmdInfo *cmdInfoPtr;

    const UnsafeEnsembleInfo *unsafePtr;


    if (interp == NULL) {
	return TCL_ERROR;
    }
    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
	if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) {
	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
	}
    }

    for (unsafePtr = unsafeEnsembleCommands;
	    unsafePtr->ensembleNsName; unsafePtr++) {
	if (unsafePtr->commandName) {


	    /*
	     * Hide an ensemble subcommand.
	     */

	    Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s",
		    unsafePtr->ensembleNsName, unsafePtr->commandName);
	    Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s",
		    unsafePtr->ensembleNsName, unsafePtr->commandName);

#define INTERIM_HACK_NAME "___tmp"

	    if (TclRenameCommand(interp, TclGetString(cmdName),
			INTERIM_HACK_NAME) != TCL_OK
		    || Tcl_HideCommand(interp, INTERIM_HACK_NAME,
			    TclGetString(hideName)) != TCL_OK) {
		Tcl_Panic("problem making '%s %s' safe: %s",
			unsafePtr->ensembleNsName, unsafePtr->commandName,
			Tcl_GetStringResult(interp));
	    }
	    Tcl_CreateObjCommand(interp, TclGetString(cmdName),
		    BadEnsembleSubcommand, (void *)unsafePtr, NULL);
	    TclDecrRefCount(cmdName);
	    TclDecrRefCount(hideName);
	} else {

	    /*
	     * Hide an ensemble main command (for compatibility).
	     */


	    if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName,
		    unsafePtr->ensembleNsName) != TCL_OK) {
		Tcl_Panic("problem making '%s' safe: %s",
			unsafePtr->ensembleNsName,
			Tcl_GetStringResult(interp));
	    }




	}
    }

    return TCL_OK;
}

/*







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






>
|
>










|
|
|
>
>




<
|
<
|
|
<
|
|
<
|
|
<
|
|
|
|
<
<
<
<
>

|

>
|
<
<
<
<
<
|
>
>
>
>







1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454

1455

1456
1457

1458
1459

1460
1461

1462
1463
1464
1465




1466
1467
1468
1469
1470
1471





1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
 *	TCL_OK if it succeeds, TCL_ERROR else.
 *
 * Side effects:
 *	Hides functionality in an interpreter.
 *
 *----------------------------------------------------------------------
 */

static void
HideCommandInTclNs(
    Tcl_Interp *interp,
    const char *nsName,
    const char *name,
    Tcl_Obj *publicNameTuple)
{
    Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", nsName, name);
    Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", nsName, name);

#define INTERIM_HACK_NAME "___tmp"
    // TODO: Fix the hiding machinery to handle namespaced commands.

    if (TclRenameCommand(interp, TclGetString(cmdName),
		INTERIM_HACK_NAME) != TCL_OK
	    || Tcl_HideCommand(interp, INTERIM_HACK_NAME,
		    TclGetString(hideName)) != TCL_OK) {
	Tcl_Panic("problem making '%s %s' safe: %s",
		nsName, name, Tcl_GetStringResult(interp));
    }
    if (publicNameTuple) {
	Tcl_IncrRefCount(publicNameTuple);
	Tcl_CreateObjCommand(interp, TclGetString(cmdName),
		BadEnsembleSubcommand, (void *)publicNameTuple,
		BadEnsembleSubcommandCleanup);
    }
    TclDecrRefCount(cmdName);
    TclDecrRefCount(hideName);
}

int
TclHideUnsafeCommands(
    Tcl_Interp *interp)		/* Hide commands in this interpreter. */
{
    const CmdInfo *cmdInfoPtr;
    const EnsembleSetup *ensSetupPtr;
    const EnsembleImplMap *implMapPtr;
    const UnsupportedCmdInfo *unsCmdInfoPtr;

    if (interp == NULL) {
	return TCL_ERROR;
    }
    for (cmdInfoPtr = builtInCmds; cmdInfoPtr->name != NULL; cmdInfoPtr++) {
	if (!(cmdInfoPtr->flags & CMD_IS_SAFE)) {
	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
	}
    }

    for (ensSetupPtr = ensembleCommands; ensSetupPtr->name; ensSetupPtr++) {
	for (implMapPtr=ensSetupPtr->implMap; implMapPtr->name; implMapPtr++) {
	    if (!implMapPtr->unsafe) {
		continue;
	    }
	    /*
	     * Hide an ensemble subcommand.
	     */


	    const char *ensembleNsName = ensSetupPtr->name, *sub;

	    while ((sub = strstr(ensembleNsName, "::")) != NULL) {
		ensembleNsName = sub + 2;

	    }
	    HideCommandInTclNs(interp, ensembleNsName, implMapPtr->name,

		    Tcl_NewListObj(2, ((Tcl_Obj*[]) {
			Tcl_NewStringObj(ensSetupPtr->name, TCL_AUTO_LENGTH),

			Tcl_NewStringObj(implMapPtr->name, TCL_AUTO_LENGTH)
		    })));
	}





	if (!(ensSetupPtr->flags & CMD_IS_SAFE)) {
	    /*
	     * Hide a main command (for compatibility).
	     */
	    Tcl_HideCommand(interp, ensSetupPtr->name, ensSetupPtr->name);
	}





    }

    for (unsCmdInfoPtr=unsupportedCmds; unsCmdInfoPtr->name; unsCmdInfoPtr++) {
	if (!(unsCmdInfoPtr->flags & CMD_IS_SAFE)) {
	    HideCommandInTclNs(interp, "unsupported", unsCmdInfoPtr->name, NULL);
	}
    }

    return TCL_OK;
}

/*
1518
1519
1520
1521
1522
1523
1524
1525


1526
1527
1528
1529
1530
1531
1532

























1533
1534
1535
1536
1537
1538
1539
static int
BadEnsembleSubcommand(
    void *clientData,
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /* objv */)
{
    const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData;



    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "not allowed to invoke subcommand %s of %s",
	    infoPtr->commandName, infoPtr->ensembleNsName));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL);
    return TCL_ERROR;
}


























/*
 *--------------------------------------------------------------
 *
 * Tcl_CallWhenDeleted --
 *
 *	Arrange for a function to be called before a given interpreter is







|
>
>



|



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
static int
BadEnsembleSubcommand(
    void *clientData,
    Tcl_Interp *interp,
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /* objv */)
{
    Tcl_Obj *publicNameTuple = (Tcl_Obj *)clientData;
    Tcl_Obj *ensembleName = TclListObjGetElement(publicNameTuple, 0);
    Tcl_Obj *commandName = TclListObjGetElement(publicNameTuple, 1);

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "not allowed to invoke subcommand %s of %s",
	    TclGetString(commandName), TclGetString(ensembleName)));
    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * BadEnsembleSubcommandCleanup --
 *
 *	Cleans up data used by BadEnsembleSubcommand() when an instance of it
 *	is deleted.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Releases a memory reference.
 *
 *----------------------------------------------------------------------
 */

static void
BadEnsembleSubcommandCleanup(
    void *clientData)
{
    Tcl_Obj *publicNameTuple = (Tcl_Obj *)clientData;
    Tcl_DecrRefCount(publicNameTuple);
}

/*
 *--------------------------------------------------------------
 *
 * Tcl_CallWhenDeleted --
 *
 *	Arrange for a function to be called before a given interpreter is
Changes to generic/tclBinary.c.
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
    '='
};

/*
 * How to construct the ensembles.
 */

static const EnsembleImplMap binaryMap[] = {
    { "format", BinaryFormatCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
    { "scan",   BinaryScanCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0 },
    { "encode", NULL, NULL, NULL, NULL, 0 },
    { "decode", NULL, NULL, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};
static const EnsembleImplMap encodeMap[] = {
    { "hex",      BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryEncodeUu,  NULL, NULL, NULL, 0 },
    { "base64",   BinaryEncode64,  NULL, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};
static const EnsembleImplMap decodeMap[] = {
    { "hex",      BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryDecodeUu,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "base64",   BinaryDecode64,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};

/*







|

|




|





|







116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
    '='
};

/*
 * How to construct the ensembles.
 */

const EnsembleImplMap tclBinaryImplMap[] = {
    { "format", BinaryFormatCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
    { "scan",   BinaryScanCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0 }, // TODO: compile?
    { "encode", NULL, NULL, NULL, NULL, 0 },
    { "decode", NULL, NULL, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};
const EnsembleImplMap tclBinaryEncodeImplMap[] = {
    { "hex",      BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryEncodeUu,  NULL, NULL, NULL, 0 },
    { "base64",   BinaryEncode64,  NULL, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};
const EnsembleImplMap tclBinaryDecodeImplMap[] = {
    { "hex",      BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryDecodeUu,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { "base64",   BinaryDecode64,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};

/*
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822

    if (bytes) {
	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
    }
    byteArrayPtr->used += len;
    TclInvalidateStringRep(objPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitBinaryCmd --
 *
 *	This function is called to create the "binary" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A command token for the new command.
 *
 * Side effects:
 *	Creates a new binary command as a mapped ensemble.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitBinaryCmd(
    Tcl_Interp *interp)
{
    Tcl_Command binaryEnsemble;

    binaryEnsemble = TclMakeEnsemble(interp, "binary", binaryMap);
    TclMakeEnsemble(interp, "binary encode", encodeMap);
    TclMakeEnsemble(interp, "binary decode", decodeMap);
    return binaryEnsemble;
}

/*
 *----------------------------------------------------------------------
 *
 * BinaryFormatCmd --
 *
 *	This procedure implements the "binary format" Tcl command.







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







780
781
782
783
784
785
786





























787
788
789
790
791
792
793

    if (bytes) {
	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
    }
    byteArrayPtr->used += len;
    TclInvalidateStringRep(objPtr);
}






























/*
 *----------------------------------------------------------------------
 *
 * BinaryFormatCmd --
 *
 *	This procedure implements the "binary format" Tcl command.
Changes to generic/tclClock.c.
18
19
20
21
22
23
24



25
26
27
28
29
30
31
#include "tclTomMath.h"
#include "tclStrIdxTree.h"
#include "tclDate.h"
#if defined(_WIN32) && defined (__clang__) && (__clang_major__ > 20)
#pragma clang diagnostic ignored "-Wc++-keyword"
#endif




/*
 * Table of the days in each month, leap and common years
 */

static const int hath[2][12] = {
    {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31},
    {31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}







>
>
>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#include "tclTomMath.h"
#include "tclStrIdxTree.h"
#include "tclDate.h"
#if defined(_WIN32) && defined (__clang__) && (__clang_major__ > 20)
#pragma clang diagnostic ignored "-Wc++-keyword"
#endif

/* The namespace containing the [clock] internals. */
#define TCL_CLOCK_NS	"::tcl::clock"

/*
 * Table of the days in each month, leap and common years
 */

static const int hath[2][12] = {
    {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31},
    {31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31}
110
111
112
113
114
115
116

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132





133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148


















149
150
151
152
153
154
155
156
static Tcl_ObjCmdProc	ClockAddObjCmd;
static int		ClockValidDate(DateInfo *,
			    ClockFmtScnCmdArgs *, int stage);
static struct tm *	ThreadSafeLocalTime(const time_t *);
static size_t		TzsetIfNecessary(void);
static void		ClockDeleteCmdProc(void *);
static void		ClockFinalize(void *);

/*
 * Structure containing description of "native" clock commands to create.
 */

struct ClockCommand {
    const char *name;		/* The tail of the command name. The full name
				 * is "::tcl::clock::<name>". When NULL marks
				 * the end of the table. */
    Tcl_ObjCmdProc *objCmdProc;	/* Function that implements the command. This
				 * will always have the ClockClientData sent
				 * to it, but may well ignore this data. */
    CompileProc *compileProc;	/* The compiler for the command. */
    void *clientData;		/* Any clientData to give the command (if NULL
				 * a reference to ClockClientData will be sent) */
};






static const struct ClockCommand clockCommands[] = {
    {"add",		ClockAddObjCmd,		TclCompileBasicMin1ArgCmd, NULL},
    {"clicks",		ClockClicksObjCmd,	TclCompileClockClicksCmd,  NULL},
    {"format",		ClockFormatObjCmd,	TclCompileBasicMin1ArgCmd, NULL},
    {"getenv",		ClockGetenvObjCmd,	TclCompileBasicMin1ArgCmd, NULL},
    {"microseconds",	ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(CLOCK_READ_MICROS)},
    {"milliseconds",	ClockMillisecondsObjCmd,TclCompileClockReadingCmd, INT2PTR(CLOCK_READ_MILLIS)},
    {"scan",		ClockScanObjCmd,	TclCompileBasicMin1ArgCmd, NULL},
    {"seconds",		ClockSecondsObjCmd,	TclCompileClockReadingCmd, INT2PTR(CLOCK_READ_SECS)},
    {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd,		NULL, NULL},
    {"GetDateFields",	  ClockGetdatefieldsObjCmd,		NULL, NULL},
    {"GetJulianDayFromEraYearMonthDay",
		ClockGetjuliandayfromerayearmonthdayObjCmd,	NULL, NULL},
    {"GetJulianDayFromEraYearWeekDay",
		ClockGetjuliandayfromerayearweekdayObjCmd,	NULL, NULL},
    {"catch",		TclSafeCatchCmd,	TclCompileBasicMin1ArgCmd, NULL},


















    {NULL, NULL, NULL, NULL}
};

/*
 *----------------------------------------------------------------------
 *
 * TclClockInit --
 *







>



<








|
|


>
>
>
>
>

|
<
|
|
<
<
|
<
|
|

|

|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|







113
114
115
116
117
118
119
120
121
122
123

124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

143
144


145

146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
static Tcl_ObjCmdProc	ClockAddObjCmd;
static int		ClockValidDate(DateInfo *,
			    ClockFmtScnCmdArgs *, int stage);
static struct tm *	ThreadSafeLocalTime(const time_t *);
static size_t		TzsetIfNecessary(void);
static void		ClockDeleteCmdProc(void *);
static void		ClockFinalize(void *);

/*
 * Structure containing description of "native" clock commands to create.
 */

struct ClockCommand {
    const char *name;		/* The tail of the command name. The full name
				 * is "::tcl::clock::<name>". When NULL marks
				 * the end of the table. */
    Tcl_ObjCmdProc *objCmdProc;	/* Function that implements the command. This
				 * will always have the ClockClientData sent
				 * to it, but may well ignore this data. */
    CompileProc *compileProc;	/* The compiler for the command. */
    int useClientData;		/* Whether to use the shared ClockClientData
				 * with this command. */
};

/*
 * Table of command created by this file, excluding the compiled parts of the
 * [clock] ensemble, as those are defined below (and never need access to the
 * ClockClientData).
 */
static const struct ClockCommand clockCommands[] = {
    {"add",		ClockAddObjCmd,		TclCompileBasicMin1ArgCmd, 1},

    {"format",		ClockFormatObjCmd,	TclCompileBasicMin1ArgCmd, 1},
    {"getenv",		ClockGetenvObjCmd,	NULL, 1},


    {"scan",		ClockScanObjCmd,	TclCompileBasicMin1ArgCmd, 1},

    {"ConvertLocalToUTC", ClockConvertlocaltoutcObjCmd, NULL, 1},
    {"GetDateFields",	ClockGetdatefieldsObjCmd, NULL, 1},
    {"GetJulianDayFromEraYearMonthDay",
			ClockGetjuliandayfromerayearmonthdayObjCmd, NULL, 1},
    {"GetJulianDayFromEraYearWeekDay",
			ClockGetjuliandayfromerayearweekdayObjCmd, NULL, 1},
    {"catch",		TclSafeCatchCmd,	NULL, 0},
    {NULL, NULL, NULL, 0}
};

/*
 * Definition of the [clock] ensemble.
 *
 * [clock add], [clock format] and [clock scan] have special clientData, so
 * we just tell the ensemble that they'll be there instead of maxing them at
 * this point.
 */
const EnsembleImplMap tclClockImplMap[] = {
    {"add",		NULL,			NULL, NULL, NULL, 1},
    {"clicks",		ClockClicksObjCmd,	TclCompileClockClicksCmd, NULL, NULL, 0},
    {"format",		NULL,			NULL, NULL, NULL, 1},
    {"microseconds",	ClockMicrosecondsObjCmd,TclCompileClockReadingCmd, NULL, INT2PTR(CLOCK_READ_MICROS), 0},
    {"milliseconds",	ClockMillisecondsObjCmd,TclCompileClockReadingCmd, NULL, INT2PTR(CLOCK_READ_MILLIS), 0},
    {"scan",		NULL,			NULL, NULL, NULL, 1},
    {"seconds",		ClockSecondsObjCmd,	TclCompileClockReadingCmd, NULL, INT2PTR(CLOCK_READ_SECS), 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 *----------------------------------------------------------------------
 *
 * TclClockInit --
 *
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
 *----------------------------------------------------------------------
 */

void
TclClockInit(
    Tcl_Interp *interp)		/* Tcl interpreter */
{
    const struct ClockCommand *clockCmdPtr;
    char cmdName[50];		/* Buffer large enough to hold the string
				 *::tcl::clock::GetJulianDayFromEraYearMonthDay
				 * plus a terminating NUL. */
    Command *cmdPtr;
    ClockClientData *data;
    int i;

    static int initialized = 0;	/* global clock engine initialized (in process) */
    /*
     * Register handler to finalize clock on exit.
     */
    if (!initialized) {
	Tcl_CreateExitHandler(ClockFinalize, NULL);
	initialized = 1;
    }







<
<
<
<
<
<
|

<







189
190
191
192
193
194
195






196
197

198
199
200
201
202
203
204
 *----------------------------------------------------------------------
 */

void
TclClockInit(
    Tcl_Interp *interp)		/* Tcl interpreter */
{






    static int initialized = 0;	/* global clock engine initialized (in process) */


    /*
     * Register handler to finalize clock on exit.
     */
    if (!initialized) {
	Tcl_CreateExitHandler(ClockFinalize, NULL);
	initialized = 1;
    }
197
198
199
200
201
202
203
204
205
206

207
208
209
210
211
212
213
	return;
    }

    /*
     * Create the client data, which is a refcounted literal pool.
     */

    data = (ClockClientData *)Tcl_Alloc(sizeof(ClockClientData));
    data->refCount = 0;
    data->literals = (Tcl_Obj **)Tcl_Alloc(LIT__END * sizeof(Tcl_Obj*));

    for (i = 0; i < LIT__END; ++i) {
	TclInitObjRef(data->literals[i], Tcl_NewStringObj(
		Literals[i], TCL_AUTO_LENGTH));
    }
    data->mcLiterals = NULL;
    data->mcLitIdxs = NULL;
    data->mcDicts = NULL;







|


>







212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
	return;
    }

    /*
     * Create the client data, which is a refcounted literal pool.
     */

    ClockClientData *data = (ClockClientData *)Tcl_Alloc(sizeof(ClockClientData));
    data->refCount = 0;
    data->literals = (Tcl_Obj **)Tcl_Alloc(LIT__END * sizeof(Tcl_Obj*));
    int i;
    for (i = 0; i < LIT__END; ++i) {
	TclInitObjRef(data->literals[i], Tcl_NewStringObj(
		Literals[i], TCL_AUTO_LENGTH));
    }
    data->mcLiterals = NULL;
    data->mcLitIdxs = NULL;
    data->mcDicts = NULL;
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283

    data->defFlags = CLF_VALIDATE;

    /*
     * Install the commands.
     */

#define TCL_CLOCK_PREFIX_LEN 14 /* == strlen("::tcl::clock::") */
    memcpy(cmdName, "::tcl::clock::", TCL_CLOCK_PREFIX_LEN);
    for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) {
	void *clientData;

	strcpy(cmdName + TCL_CLOCK_PREFIX_LEN, clockCmdPtr->name);
	if (!(clientData = clockCmdPtr->clientData)) {
	    clientData = data;
	    data->refCount++;
	}
	cmdPtr = (Command *)Tcl_CreateObjCommand(interp, cmdName,
		clockCmdPtr->objCmdProc, clientData,
		clockCmdPtr->clientData ? NULL : ClockDeleteCmdProc);
	cmdPtr->compileProc = clockCmdPtr->compileProc ?
		clockCmdPtr->compileProc : TclCompileBasicMin0ArgCmd;
    }
    cmdPtr = (Command *) Tcl_CreateObjCommand(interp,
	    "::tcl::unsupported::clock::configure",
	    ClockConfigureObjCmd, data, ClockDeleteCmdProc);
    data->refCount++;
    cmdPtr->compileProc = TclCompileBasicMin0ArgCmd;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockConfigureClear --
 *







|
|

|
|
<
<



|
|
|
|
<

<
|


<







265
266
267
268
269
270
271
272
273
274
275
276


277
278
279
280
281
282
283

284

285
286
287

288
289
290
291
292
293
294

    data->defFlags = CLF_VALIDATE;

    /*
     * Install the commands.
     */

    Tcl_Namespace *nsPtr = Tcl_FindNamespace(interp, TCL_CLOCK_NS, NULL, 0);
    const struct ClockCommand *clockCmdPtr;
    for (clockCmdPtr=clockCommands ; clockCmdPtr->name!=NULL ; clockCmdPtr++) {
	void *clientData = NULL;
	if (clockCmdPtr->useClientData) {


	    clientData = data;
	    data->refCount++;
	}
	Command *cmdPtr = (Command *)TclCreateObjCommandInNs(interp,
		clockCmdPtr->name, nsPtr, clockCmdPtr->objCmdProc, clientData,
		clientData ? ClockDeleteCmdProc : NULL);
	cmdPtr->compileProc = clockCmdPtr->compileProc;

    }

    Tcl_CreateObjCommand(interp, "::tcl::unsupported::clock::configure",
	    ClockConfigureObjCmd, data, ClockDeleteCmdProc);
    data->refCount++;

}

/*
 *----------------------------------------------------------------------
 *
 * ClockConfigureClear --
 *
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
    void *clientData,		/* Client data containing literal pool */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter vector */
{
    ClockClientData *dataPtr = (ClockClientData *)clientData;
    static const char *const options[] = {
	"-default-locale",	"-clear",	  "-current-locale",
	"-year-century",  "-century-switch",
	"-min-year", "-max-year", "-max-jdn", "-validate",
	"-init-complete",	  "-setup-tz", "-system-tz", NULL
    };
    enum optionInd {
	CLOCK_DEFAULT_LOCALE, CLOCK_CLEAR_CACHE, CLOCK_CURRENT_LOCALE,
	CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH,
	CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_MAX_JDN, CLOCK_VALIDATE,
	CLOCK_INIT_COMPLETE,  CLOCK_SETUP_TZ, CLOCK_SYSTEM_TZ
    };
    int optionIndex;		/* Index of an option. */
    Tcl_Size i;

    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i++], options,
		"option", 0, &optionIndex) != TCL_OK) {







|
|
|
|





|







966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
    void *clientData,		/* Client data containing literal pool */
    Tcl_Interp *interp,		/* Tcl interpreter */
    int objc,			/* Parameter count */
    Tcl_Obj *const objv[])	/* Parameter vector */
{
    ClockClientData *dataPtr = (ClockClientData *)clientData;
    static const char *const options[] = {
	"-default-locale",	"-clear",	"-current-locale",
	"-year-century",	"-century-switch",
	"-min-year",		"-max-year",	"-max-jdn",
	"-validate",		"-setup-tz",	"-system-tz", NULL
    };
    enum optionInd {
	CLOCK_DEFAULT_LOCALE, CLOCK_CLEAR_CACHE, CLOCK_CURRENT_LOCALE,
	CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH,
	CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_MAX_JDN, CLOCK_VALIDATE,
	CLOCK_SETUP_TZ, CLOCK_SYSTEM_TZ
    };
    int optionIndex;		/* Index of an option. */
    Tcl_Size i;

    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i++], options,
		"option", 0, &optionIndex) != TCL_OK) {
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
		Tcl_SetObjResult(interp,
			Tcl_NewBooleanObj(dataPtr->defFlags & CLF_VALIDATE));
	    }
	    break;
	case CLOCK_CLEAR_CACHE:
	    ClockConfigureClear(dataPtr);
	    break;
	case CLOCK_INIT_COMPLETE: {
	    /*
	     * Init completed.
	     * Compile clock ensemble (performance purposes).
	     */
	    Tcl_Command token = Tcl_FindCommand(interp, "::clock",
		    NULL, TCL_GLOBAL_ONLY);
	    if (!token) {
		return TCL_ERROR;
	    }
	    int ensFlags = 0;
	    if (Tcl_GetEnsembleFlags(interp, token, &ensFlags) != TCL_OK) {
		return TCL_ERROR;
	    }
	    ensFlags |= ENSEMBLE_COMPILE;
	    if (Tcl_SetEnsembleFlags(interp, token, ensFlags) != TCL_OK) {
		return TCL_ERROR;
	    }
	    break;
	}
	default:
	    TCL_UNREACHABLE();
	}
    }

    return TCL_OK;
}







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







1147
1148
1149
1150
1151
1152
1153




















1154
1155
1156
1157
1158
1159
1160
		Tcl_SetObjResult(interp,
			Tcl_NewBooleanObj(dataPtr->defFlags & CLF_VALIDATE));
	    }
	    break;
	case CLOCK_CLEAR_CACHE:
	    ClockConfigureClear(dataPtr);
	    break;




















	default:
	    TCL_UNREACHABLE();
	}
    }

    return TCL_OK;
}
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
{
    ClockClientData *dataPtr = (ClockClientData *)clientData;
    Tcl_Obj *secondsObj;
    Tcl_Obj *dict;
    int changeover;
    TclDateFields fields;
    int created = 0;
    int status;

    fields.tzName = NULL;
    /*
     * Check params and convert time.
     */

    if (objc != 4) {







<







1405
1406
1407
1408
1409
1410
1411

1412
1413
1414
1415
1416
1417
1418
{
    ClockClientData *dataPtr = (ClockClientData *)clientData;
    Tcl_Obj *secondsObj;
    Tcl_Obj *dict;
    int changeover;
    TclDateFields fields;
    int created = 0;


    fields.tzName = NULL;
    /*
     * Check params and convert time.
     */

    if (objc != 4) {
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	created = 1;
	Tcl_IncrRefCount(dict);
    }
    status = Tcl_DictObjPut(interp, dict, dataPtr->literals[LIT_SECONDS],
	    Tcl_NewWideIntObj(fields.seconds));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (created) {
	Tcl_DecrRefCount(dict);
    }
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetdatefieldsObjCmd --
 *







|

|





|







1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	created = 1;
	Tcl_IncrRefCount(dict);
    }
    int result = Tcl_DictObjPut(interp, dict, dataPtr->literals[LIT_SECONDS],
	    Tcl_NewWideIntObj(fields.seconds));
    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (created) {
	Tcl_DecrRefCount(dict);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetdatefieldsObjCmd --
 *
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *lit = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int isBce = 0;

    fields.tzName = NULL;

    /*
     * Check params.
     */







<







1688
1689
1690
1691
1692
1693
1694

1695
1696
1697
1698
1699
1700
1701
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *lit = data->literals;
    int changeover;
    int copied = 0;

    int isBce = 0;

    fields.tzName = NULL;

    /*
     * Check params.
     */
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	Tcl_IncrRefCount(dict);
	copied = 1;
    }
    status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (copied) {
	Tcl_DecrRefCount(dict);
    }
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetjuliandayfromerayearweekdayObjCmd --
 *







|

|





|







1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	Tcl_IncrRefCount(dict);
	copied = 1;
    }
    int result = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (copied) {
	Tcl_DecrRefCount(dict);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ClockGetjuliandayfromerayearweekdayObjCmd --
 *
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *lit = data->literals;
    int changeover;
    int copied = 0;
    int status;
    int isBce = 0;

    fields.tzName = NULL;

    /*
     * Check params.
     */







<







1773
1774
1775
1776
1777
1778
1779

1780
1781
1782
1783
1784
1785
1786
{
    TclDateFields fields;
    Tcl_Obj *dict;
    ClockClientData *data = (ClockClientData *)clientData;
    Tcl_Obj *const *lit = data->literals;
    int changeover;
    int copied = 0;

    int isBce = 0;

    fields.tzName = NULL;

    /*
     * Check params.
     */
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	Tcl_IncrRefCount(dict);
	copied = 1;
    }
    status = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    if (status == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (copied) {
	Tcl_DecrRefCount(dict);
    }
    return status;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertLocalToUTC --
 *







|

|





|







1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
     */

    if (Tcl_IsShared(dict)) {
	dict = Tcl_DuplicateObj(dict);
	Tcl_IncrRefCount(dict);
	copied = 1;
    }
    int result = Tcl_DictObjPut(interp, dict, lit[LIT_JULIANDAY],
	    Tcl_NewWideIntObj(fields.julianDay));
    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, dict);
    }
    if (copied) {
	Tcl_DecrRefCount(dict);
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * ConvertLocalToUTC --
 *
Changes to generic/tclCmdAH.c.
95
96
97
98
99
100
101




















































102
103
104
105
106
107
108
static Tcl_ObjCmdProc PathJoinCmd;
static Tcl_ObjCmdProc PathNativeNameCmd;
static Tcl_ObjCmdProc PathNormalizeCmd;
static Tcl_ObjCmdProc PathRootNameCmd;
static Tcl_ObjCmdProc PathSplitCmd;
static Tcl_ObjCmdProc PathTailCmd;
static Tcl_ObjCmdProc PathTypeCmd;





















































/*
 *----------------------------------------------------------------------
 *
 * Tcl_BreakObjCmd --
 *
 *	This procedure is invoked to process the "break" Tcl command. See the







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
static Tcl_ObjCmdProc PathJoinCmd;
static Tcl_ObjCmdProc PathNativeNameCmd;
static Tcl_ObjCmdProc PathNormalizeCmd;
static Tcl_ObjCmdProc PathRootNameCmd;
static Tcl_ObjCmdProc PathSplitCmd;
static Tcl_ObjCmdProc PathTailCmd;
static Tcl_ObjCmdProc PathTypeCmd;

const EnsembleImplMap tclEncodingImplMap[] = {
    {"convertfrom",	EncodingConvertfromObjCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
    {"convertto",	EncodingConverttoObjCmd,   TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
    {"dirs",		EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
    {"names",		EncodingNamesObjCmd,       TclCompileBasic0ArgCmd,    NULL, NULL, 0},
    {"profiles",	EncodingProfilesObjCmd,    TclCompileBasic0ArgCmd,    NULL, NULL, 0},
    {"system",		EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
    {"user",		EncodingUserObjCmd,        TclCompileBasic0ArgCmd,    NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

const EnsembleImplMap tclFileImplMap[] = {
    {"atime",		FileAttrAccessTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
    {"attributes",	TclFileAttrsCmd,	NULL, NULL, NULL, 1},
    {"channels",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"copy",		TclFileCopyCmd,		NULL, NULL, NULL, 1},
    {"delete",		TclFileDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
    {"dirname",		PathDirNameCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"executable",	FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"exists",		FileAttrIsExistingCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"extension",	PathExtensionCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"home",		TclFileHomeCmd,		TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
    {"isdirectory",	FileAttrIsDirectoryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"isfile",		FileAttrIsFileCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"join",		PathJoinCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"link",		TclFileLinkCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 1},
    {"lstat",		FileAttrLinkStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
    {"mtime",		FileAttrModifyTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
    {"mkdir",		TclFileMakeDirsCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
    {"nativename",	PathNativeNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"normalize",	PathNormalizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"owned",		FileAttrIsOwnedCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"pathtype",	PathTypeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"readable",	FileAttrIsReadableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"readlink",	TclFileReadLinkCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"rename",		TclFileRenameCmd,	NULL, NULL, NULL, 1},
    {"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"separator",	FilesystemSeparatorCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"size",		FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"split",		PathSplitCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"stat",		FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
    {"system",		PathFilesystemCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"tail",		PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"tempdir",		TclFileTempDirCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
    {"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 1},
    {"tildeexpand",	TclFileTildeExpandCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"type",		FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"volumes",		FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 1},
    {"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 *----------------------------------------------------------------------
 *
 * Tcl_BreakObjCmd --
 *
 *	This procedure is invoked to process the "break" Tcl command. See the
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    return TCL_CONTINUE;
}

/*
 *-----------------------------------------------------------------------------
 *
 * TclInitEncodingCmd --
 *
 *	This function creates the 'encoding' ensemble.
 *
 * Results:
 *	Returns the Tcl_Command so created.
 *
 * Side effects:
 *	The ensemble is initialized.
 *
 * This command is hidden in a safe interpreter.
 */

Tcl_Command
TclInitEncodingCmd(
    Tcl_Interp* interp)		/* Tcl interpreter */
{
    static const EnsembleImplMap encodingImplMap[] = {
	{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"convertto",   EncodingConverttoObjCmd,   TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"names",       EncodingNamesObjCmd,       TclCompileBasic0ArgCmd,    NULL, NULL, 0},
	{"profiles",    EncodingProfilesObjCmd,    TclCompileBasic0ArgCmd,    NULL, NULL, 0},
	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"user",        EncodingUserObjCmd,        TclCompileBasic0ArgCmd,    NULL, NULL, 1},
	{NULL,          NULL,                      NULL,                      NULL, NULL, 0}
    };

    return TclMakeEnsemble(interp, "encoding", encodingImplMap);
}

/*
 *------------------------------------------------------------------------
 *
 * EncodingConvertParseOptions --
 *
 *    Common routine for parsing arguments passed to encoding convertfrom







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







415
416
417
418
419
420
421


































422
423
424
425
426
427
428
{
    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }
    return TCL_CONTINUE;
}



































/*
 *------------------------------------------------------------------------
 *
 * EncodingConvertParseOptions --
 *
 *    Common routine for parsing arguments passed to encoding convertfrom
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199

    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, resultPtr);
    }
    Tcl_DecrRefCount(resultPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitFileCmd --
 *
 *	This function builds the "file" Tcl command ensemble. See the user
 *	documentation for details on what that ensemble does.
 *
 *	PLEASE NOTE THAT THIS FAILS WITH FILENAMES AND PATHS WITH EMBEDDED
 *	NULLS. With the object-based Tcl_FS APIs, the above NOTE may no longer
 *	be true. In any case this assertion should be tested.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitFileCmd(
    Tcl_Interp *interp)
{
    /*
     * Note that most subcommands are unsafe because either they manipulate
     * the native filesystem or because they reveal information about the
     * native filesystem.
     */

    static const EnsembleImplMap initMap[] = {
	{"atime",	FileAttrAccessTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
	{"attributes",	TclFileAttrsCmd,	NULL, NULL, NULL, 1},
	{"channels",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"copy",	TclFileCopyCmd,		NULL, NULL, NULL, 1},
	{"delete",	TclFileDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
	{"dirname",	PathDirNameCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"executable",	FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"exists",	FileAttrIsExistingCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"extension",	PathExtensionCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"home",	TclFileHomeCmd,		TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"isdirectory",	FileAttrIsDirectoryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"isfile",	FileAttrIsFileCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"join",	PathJoinCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
	{"link",	TclFileLinkCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 1},
	{"lstat",	FileAttrLinkStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
	{"mtime",	FileAttrModifyTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
	{"mkdir",	TclFileMakeDirsCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
	{"nativename",	PathNativeNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"normalize",	PathNormalizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"owned",	FileAttrIsOwnedCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"pathtype",	PathTypeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"readable",	FileAttrIsReadableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"readlink",	TclFileReadLinkCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"rename",	TclFileRenameCmd,	NULL, NULL, NULL, 1},
	{"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"separator",	FilesystemSeparatorCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"size",	FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"split",	PathSplitCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"stat",	FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
	{"system",	PathFilesystemCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"tail",	PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"tempdir",	TclFileTempDirCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 1},
	{"tildeexpand",	TclFileTildeExpandCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"type",	FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{"volumes",	FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 1},
	{"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    return TclMakeEnsemble(interp, "file", initMap);
}

/*
 *----------------------------------------------------------------------
 *
 * FileAttrAccessTimeCmd --
 *
 *	This function is invoked to process the "file atime" Tcl command. See







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







1130
1131
1132
1133
1134
1135
1136










































































1137
1138
1139
1140
1141
1142
1143

    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, resultPtr);
    }
    Tcl_DecrRefCount(resultPtr);
    return result;
}











































































/*
 *----------------------------------------------------------------------
 *
 * FileAttrAccessTimeCmd --
 *
 *	This function is invoked to process the "file atime" Tcl command. See
Changes to generic/tclCmdIL.c.
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
			    SortInfo *infoPtr);

/*
 * Array of values describing how to implement each standard subcommand of the
 * "info" command.
 */

static const EnsembleImplMap defaultInfoMap[] = {
    {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"cmdtype",		   InfoCmdTypeCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
    {"complete",	   InfoCompleteCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"constant",	   TclInfoConstantCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},







|







145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
			    SortInfo *infoPtr);

/*
 * Array of values describing how to implement each standard subcommand of the
 * "info" command.
 */

const EnsembleImplMap tclInfoImplMap[] = {
    {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
    {"cmdtype",		   InfoCmdTypeCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 1},
    {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
    {"complete",	   InfoCompleteCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"constant",	   TclInfoConstantCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
     * Set the interpreter's object result to refer to the variable's new
     * value object.
     */

    Tcl_SetObjResult(interp, newValuePtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitInfoCmd --
 *
 *	This function is called to create the "info" Tcl command. See the user
 *	documentation for details on what it does.
 *
 * Results:
 *	Handle for the info command, or NULL on failure.
 *
 * Side effects:
 *	none
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitInfoCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    return TclMakeEnsemble(interp, "info", defaultInfoMap);
}

/*
 *----------------------------------------------------------------------
 *
 * InfoArgsCmd --
 *
 *	Called to implement the "info args" command that returns the argument







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







416
417
418
419
420
421
422
























423
424
425
426
427
428
429
     * Set the interpreter's object result to refer to the variable's new
     * value object.
     */

    Tcl_SetObjResult(interp, newValuePtr);
    return TCL_OK;
}

























/*
 *----------------------------------------------------------------------
 *
 * InfoArgsCmd --
 *
 *	Called to implement the "info args" command that returns the argument
Changes to generic/tclCmdMZ.c.
29
30
31
32
33
34
35

































































36
37
38
39
40
41
42
static Tcl_NRPostProc	TryPostFinal;
static Tcl_NRPostProc	TryPostHandler;
static int		UniCharIsAscii(int character);
static int		UniCharIsHexDigit(int character);
static int		StringCmpOpts(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int *nocase,
			    Tcl_Size *reqlength);


































































/*
 * Default set of characters to trim in [string trim] and friends. This is a
 * UTF-8 literal string containing all Unicode space characters [TIP #413]
 */

const char tclDefaultTrimSet[] =







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
static Tcl_NRPostProc	TryPostFinal;
static Tcl_NRPostProc	TryPostHandler;
static int		UniCharIsAscii(int character);
static int		UniCharIsHexDigit(int character);
static int		StringCmpOpts(Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[], int *nocase,
			    Tcl_Size *reqlength);
static Tcl_ObjCmdProc	StringCatCmd;
static Tcl_ObjCmdProc	StringCmpCmd;
static Tcl_ObjCmdProc	StringEqualCmd;
static Tcl_ObjCmdProc	StringFirstCmd;
static Tcl_ObjCmdProc	StringIndexCmd;
static Tcl_ObjCmdProc	StringInsertCmd;
static Tcl_ObjCmdProc	StringIsCmd;
static Tcl_ObjCmdProc	StringLastCmd;
static Tcl_ObjCmdProc	StringLenCmd;
static Tcl_ObjCmdProc	StringMapCmd;
static Tcl_ObjCmdProc	StringMatchCmd;
static Tcl_ObjCmdProc	StringRangeCmd;
static Tcl_ObjCmdProc	StringReptCmd;
static Tcl_ObjCmdProc	StringRplcCmd;
static Tcl_ObjCmdProc	StringRevCmd;
static Tcl_ObjCmdProc	StringLowerCmd;
static Tcl_ObjCmdProc	StringUpperCmd;
static Tcl_ObjCmdProc	StringTitleCmd;
static Tcl_ObjCmdProc	StringTrimCmd;
static Tcl_ObjCmdProc	StringTrimLCmd;
static Tcl_ObjCmdProc	StringTrimRCmd;
static Tcl_ObjCmdProc	StringEndCmd;
static Tcl_ObjCmdProc	StringStartCmd;
static Tcl_ObjCmdProc	TclUnicodeNormalizeCmd;

/*
 * Definition of the contents of the [string] ensemble.
 */
const EnsembleImplMap tclStringImplMap[] = {
    {"cat",		StringCatCmd,	TclCompileStringCatCmd,		NULL, NULL, 0},
    {"compare",		StringCmpCmd,	TclCompileStringCmpCmd,		NULL, NULL, 0},
    {"equal",		StringEqualCmd,	TclCompileStringEqualCmd,	NULL, NULL, 0},
    {"first",		StringFirstCmd,	TclCompileStringFirstCmd,	NULL, NULL, 0},
    {"index",		StringIndexCmd,	TclCompileStringIndexCmd,	NULL, NULL, 0},
    {"insert",		StringInsertCmd, TclCompileStringInsertCmd,	NULL, NULL, 0},
    {"is",		StringIsCmd,	TclCompileStringIsCmd,		NULL, NULL, 0},
    {"last",		StringLastCmd,	TclCompileStringLastCmd,	NULL, NULL, 0},
    {"length",		StringLenCmd,	TclCompileStringLenCmd,		NULL, NULL, 0},
    {"map",		StringMapCmd,	TclCompileStringMapCmd,		NULL, NULL, 0},
    {"match",		StringMatchCmd,	TclCompileStringMatchCmd,	NULL, NULL, 0},
    {"range",		StringRangeCmd,	TclCompileStringRangeCmd,	NULL, NULL, 0},
    {"repeat",		StringReptCmd,	TclCompileBasic2ArgCmd,		NULL, NULL, 0},
    {"replace",		StringRplcCmd,	TclCompileStringReplaceCmd,	NULL, NULL, 0},
    {"reverse",		StringRevCmd,	TclCompileBasic1ArgCmd,		NULL, NULL, 0},
    {"tolower",		StringLowerCmd,	TclCompileStringToLowerCmd,	NULL, NULL, 0},
    {"toupper",		StringUpperCmd,	TclCompileStringToUpperCmd,	NULL, NULL, 0},
    {"totitle",		StringTitleCmd,	TclCompileStringToTitleCmd,	NULL, NULL, 0},
    {"trim",		StringTrimCmd,	TclCompileStringTrimCmd,	NULL, NULL, 0},
    {"trimleft",	StringTrimLCmd,	TclCompileStringTrimLCmd,	NULL, NULL, 0},
    {"trimright",	StringTrimRCmd,	TclCompileStringTrimRCmd,	NULL, NULL, 0},
    {"wordend",		StringEndCmd,	TclCompileBasic2ArgCmd,		NULL, NULL, 0},
    {"wordstart",	StringStartCmd,	TclCompileBasic2ArgCmd,		NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * Definition of the contents of the [unicode] ensemble.
 */
const EnsembleImplMap tclUnicodeImplMap[] = {
    {"tonfc",	TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFC,  0},
    {"tonfd",	TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFD,  0},
    {"tonfkc",	TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFKC, 0},
    {"tonfkd",	TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFKD, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * Default set of characters to trim in [string trim] and friends. This is a
 * UTF-8 literal string containing all Unicode space characters [TIP #413]
 */

const char tclDefaultTrimSet[] =
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitStringCmd --
 *
 *	This procedure creates the "string" Tcl command. See the user
 *	documentation for details on what it does. Note that this command only
 *	functions correctly on properly formed Tcl UTF strings.
 *
 *	Also note that the primary methods here (equal, compare, match, ...)
 *	have bytecode equivalents. You will find the code for those in
 *	tclExecute.c. The code here will only be used in the non-bc case (like
 *	in an 'eval').
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitStringCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap stringImplMap[] = {
	{"cat",		StringCatCmd,	TclCompileStringCatCmd, NULL, NULL, 0},
	{"compare",	StringCmpCmd,	TclCompileStringCmpCmd, NULL, NULL, 0},
	{"equal",	StringEqualCmd,	TclCompileStringEqualCmd, NULL, NULL, 0},
	{"first",	StringFirstCmd,	TclCompileStringFirstCmd, NULL, NULL, 0},
	{"index",	StringIndexCmd,	TclCompileStringIndexCmd, NULL, NULL, 0},
	{"insert",	StringInsertCmd, TclCompileStringInsertCmd, NULL, NULL, 0},
	{"is",		StringIsCmd,	TclCompileStringIsCmd, NULL, NULL, 0},
	{"last",	StringLastCmd,	TclCompileStringLastCmd, NULL, NULL, 0},
	{"length",	StringLenCmd,	TclCompileStringLenCmd, NULL, NULL, 0},
	{"map",		StringMapCmd,	TclCompileStringMapCmd, NULL, NULL, 0},
	{"match",	StringMatchCmd,	TclCompileStringMatchCmd, NULL, NULL, 0},
	{"range",	StringRangeCmd,	TclCompileStringRangeCmd, NULL, NULL, 0},
	{"repeat",	StringReptCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"replace",	StringRplcCmd,	TclCompileStringReplaceCmd, NULL, NULL, 0},
	{"reverse",	StringRevCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"tolower",	StringLowerCmd,	TclCompileStringToLowerCmd, NULL, NULL, 0},
	{"toupper",	StringUpperCmd,	TclCompileStringToUpperCmd, NULL, NULL, 0},
	{"totitle",	StringTitleCmd,	TclCompileStringToTitleCmd, NULL, NULL, 0},
	{"trim",	StringTrimCmd,	TclCompileStringTrimCmd, NULL, NULL, 0},
	{"trimleft",	StringTrimLCmd,	TclCompileStringTrimLCmd, NULL, NULL, 0},
	{"trimright",	StringTrimRCmd,	TclCompileStringTrimRCmd, NULL, NULL, 0},
	{"wordend",	StringEndCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"wordstart",	StringStartCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };

    return TclMakeEnsemble(interp, "string", stringImplMap);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SubstObjCmd --
 *
 *	This procedure is invoked to process the "subst" Tcl command. See the
 *	user documentation for details on what it does. This command relies on
 *	Tcl_SubstObj() for its implementation.
 *
 * Results:







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







3327
3328
3329
3330
3331
3332
3333

























































3334
3335
3336
3337
3338
3339
3340
    Tcl_SetObjResult(interp, Tcl_NewStringObj(string1, length1-trim));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

























































 * Tcl_SubstObjCmd --
 *
 *	This procedure is invoked to process the "subst" Tcl command. See the
 *	user documentation for details on what it does. This command relies on
 *	Tcl_SubstObj() for its implementation.
 *
 * Results:
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
	    &ds) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_DStringResult(interp, &ds);
    return TCL_OK;
}

/*
 * TclInitUnicodeCmd --
 *
 *	This procedure creates the "unicode" Tcl ensemble command. See user
 *	documentation for details on implemented commands.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	Stores the result in the interpreter result.
 */
Tcl_Command
TclInitUnicodeCmd(
    Tcl_Interp *interp)
{
    static const EnsembleImplMap unicodeImplMap[] = {
	{"tonfc", TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFC, 0},
	{"tonfd", TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFD, 0},
	{"tonfkc", TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFKC, 0},
	{"tonfkd", TclUnicodeNormalizeCmd, NULL, NULL, (void *)TCL_NFKD, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    return TclMakeEnsemble(interp, "unicode", unicodeImplMap);
}


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








5483
5484
5485
5486
5487
5488
5489



























5490
5491
5492
5493
5494
5495
5496
5497
	    &ds) != TCL_OK) {
	return TCL_ERROR;
    }

    Tcl_DStringResult(interp, &ds);
    return TCL_OK;
}




























/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclCompCmds.c.
3278
3279
3280
3281
3282
3283
3284

3285
3286
3287
3288
3289
3290
3291
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    Tcl_Obj **objv, *formatObj, *tmpObj;
    const char *bytes, *start;
    Tcl_Size i, j, numWords = parsePtr->numWords;

    /* TODO: Consider support for compiling expanded args. */

    /*
     * Don't handle any guaranteed-error cases.
     */

    if (numWords < 2 || numWords > UINT_MAX) {







>







3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
    CompileEnv *envPtr)		/* Holds resulting instructions. */
{
    DefineLineInformation;	/* TIP #280 */
    Tcl_Token *tokenPtr = parsePtr->tokenPtr;
    Tcl_Obj **objv, *formatObj, *tmpObj;
    const char *bytes, *start;
    Tcl_Size i, j, numWords = parsePtr->numWords;
    /* TODO: Consider support for runtime formats. */
    /* TODO: Consider support for compiling expanded args. */

    /*
     * Don't handle any guaranteed-error cases.
     */

    if (numWords < 2 || numWords > UINT_MAX) {
Changes to generic/tclDictObj.c.
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
static Tcl_NRPostProc		DictForLoopCallback;
static Tcl_NRPostProc		DictMapLoopCallback;

/*
 * Table of dict subcommand names and implementations.
 */

static const EnsembleImplMap implementationMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
    {"create",	DictCreateCmd,	TclCompileDictCreateCmd, NULL, NULL, 0 },
    {"exists",	DictExistsCmd,	TclCompileDictExistsCmd, NULL, NULL, 0 },
    {"filter",	DictFilterCmd,	NULL, NULL, NULL, 0 },
    {"for",	NULL,		TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
    {"get",	DictGetCmd,	TclCompileDictGetCmd, NULL, NULL, 0 },
    {"getdef",	DictGetDefCmd,	TclCompileDictGetWithDefaultCmd, NULL,NULL,0},







|







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
static Tcl_NRPostProc		DictForLoopCallback;
static Tcl_NRPostProc		DictMapLoopCallback;

/*
 * Table of dict subcommand names and implementations.
 */

const EnsembleImplMap tclDictImplMap[] = {
    {"append",	DictAppendCmd,	TclCompileDictAppendCmd, NULL, NULL, 0 },
    {"create",	DictCreateCmd,	TclCompileDictCreateCmd, NULL, NULL, 0 },
    {"exists",	DictExistsCmd,	TclCompileDictExistsCmd, NULL, NULL, 0 },
    {"filter",	DictFilterCmd,	NULL, NULL, NULL, 0 },
    {"for",	NULL,		TclCompileDictForCmd, DictForNRCmd, NULL, 0 },
    {"get",	DictGetCmd,	TclCompileDictGetCmd, NULL, NULL, 0 },
    {"getdef",	DictGetDefCmd,	TclCompileDictGetWithDefaultCmd, NULL,NULL,0},
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
	    TclDecrRefCount(dictPtr);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitDictCmd --
 *
 *	This function is create the "dict" Tcl command. See the user
 *	documentation for details on what it does, and TIP#111 for the formal
 *	specification.
 *
 * Results:
 *	A Tcl command handle.
 *
 * Side effects:
 *	May advance compilation epoch.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitDictCmd(
    Tcl_Interp *interp)
{
    return TclMakeEnsemble(interp, "dict", implementationMap);
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







3962
3963
3964
3965
3966
3967
3968

























3969
3970
3971
3972
3973
3974
3975
	    TclDecrRefCount(dictPtr);
	}
	return TCL_ERROR;
    }
    return TCL_OK;
}


























/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclIOCmd.c.
41
42
43
44
45
46
47
48
49
50

51

52
53
54
55
56
57
58
59




























60
61
62
63
64
65
66
 */
#define ASSOC_KEY "tclTCPAcceptCallbacks"

/*
 * Static functions for this file:
 */

static Tcl_ExitProc		FinalizeIOCmdTSD;
static Tcl_TcpAcceptProc	AcceptCallbackProc;
static Tcl_ObjCmdProc		ChanPendingObjCmd;

static Tcl_ObjCmdProc		ChanTruncateObjCmd;

static void		RegisterTcpServerInterpCleanup(
			    Tcl_Interp *interp,
			    AcceptCallback *acceptCallbackPtr);
static Tcl_InterpDeleteProc	TcpAcceptCallbacksDeleteProc;
static void		TcpServerCloseProc(void *callbackData);
static void		UnregisterTcpServerInterpCleanupProc(
			    Tcl_Interp *interp,
			    AcceptCallback *acceptCallbackPtr);





























/*
 *----------------------------------------------------------------------
 *
 * FinalizeIOCmdTSD --
 *
 *	Release the storage associated with the per-thread cache.







|
|
|
>
|
>








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
 */
#define ASSOC_KEY "tclTCPAcceptCallbacks"

/*
 * Static functions for this file:
 */

static Tcl_ExitProc	FinalizeIOCmdTSD;
static Tcl_TcpAcceptProc AcceptCallbackProc;
static Tcl_ObjCmdProc	ChanIsBinaryCmd;
static Tcl_ObjCmdProc	ChanPendingObjCmd;
static Tcl_ObjCmdProc	ChanPipeObjCmd;
static Tcl_ObjCmdProc	ChanTruncateObjCmd;
static void		RegisterTcpServerInterpCleanup(
			    Tcl_Interp *interp,
			    AcceptCallback *acceptCallbackPtr);
static Tcl_InterpDeleteProc	TcpAcceptCallbacksDeleteProc;
static void		TcpServerCloseProc(void *callbackData);
static void		UnregisterTcpServerInterpCleanupProc(
			    Tcl_Interp *interp,
			    AcceptCallback *acceptCallbackPtr);

/*
 * The basic description of the parts of the [chan] ensemble.
 * Also contains [chan configure], which is [fconfigure].
 */
const EnsembleImplMap tclChanImplMap[] = {
    {"blocked",		Tcl_FblockedObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"close",		Tcl_CloseObjCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"copy",		Tcl_FcopyObjCmd,	NULL,			NULL, NULL, 0},
    {"create",		TclChanCreateObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},	   /* TIP #219 */
    {"eof",		Tcl_EofObjCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"event",		Tcl_FileEventObjCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
    {"flush",		Tcl_FlushObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"gets",		Tcl_GetsObjCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"isbinary",	ChanIsBinaryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"names",		TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"pending",		ChanPendingObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},	   /* TIP #287 */
    {"pipe",		ChanPipeObjCmd,		TclCompileBasic0ArgCmd, NULL, NULL, 0},	   /* TIP #304 */
    {"pop",		TclChanPopObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},    /* TIP #230 */
    {"postevent",	TclChanPostEventObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},	   /* TIP #219 */
    {"push",		TclChanPushObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},	   /* TIP #230 */
    {"puts",		Tcl_PutsObjCmd,		NULL,			NULL, NULL, 0},
    {"read",		Tcl_ReadObjCmd,		NULL,			NULL, NULL, 0},
    {"seek",		Tcl_SeekObjCmd,		TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
    {"tell",		Tcl_TellObjCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"truncate",	ChanTruncateObjCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0}, /* TIP #208 */
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 *----------------------------------------------------------------------
 *
 * FinalizeIOCmdTSD --
 *
 *	Release the storage associated with the per-thread cache.
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101

2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
    return Tcl_GetChannelNamesEx(interp,
	    ((objc == 1) ? NULL : TclGetString(objv[1])));
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitChanCmd --
 *
 *	This function is invoked to create the "chan" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	A Tcl command handle.
 *
 * Side effects:
 *	None (since nothing is byte-compiled).
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitChanCmd(
    Tcl_Interp *interp)

{
    /*
     * Most commands are plugged directly together, but some are done via
     * alias-like rewriting; [chan configure] is this way for security reasons
     * (want overwriting of [fconfigure] to control that nicely), and [chan
     * names] because the functionality isn't available as a separate command
     * function at the moment.
     */
    static const EnsembleImplMap initMap[] = {
	{"blocked",	Tcl_FblockedObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"close",	Tcl_CloseObjCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"copy",	Tcl_FcopyObjCmd,	NULL, NULL, NULL, 0},
	{"create",	TclChanCreateObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #219 */
	{"eof",		Tcl_EofObjCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"event",	Tcl_FileEventObjCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
	{"flush",	Tcl_FlushObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"gets",	Tcl_GetsObjCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"isbinary",	ChanIsBinaryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"names",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
	{"pending",	ChanPendingObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #287 */
	{"pipe",	ChanPipeObjCmd,		TclCompileBasic0ArgCmd, NULL, NULL, 0},		/* TIP #304 */
	{"pop",		TclChanPopObjCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},		/* TIP #230 */
	{"postevent",	TclChanPostEventObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},	/* TIP #219 */
	{"push",	TclChanPushObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},		/* TIP #230 */
	{"puts",	Tcl_PutsObjCmd,		NULL, NULL, NULL, 0},
	{"read",	Tcl_ReadObjCmd,		NULL, NULL, NULL, 0},
	{"seek",	Tcl_SeekObjCmd,		TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
	{"tell",	Tcl_TellObjCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"truncate",	ChanTruncateObjCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},		/* TIP #208 */
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    static const char *const extras[] = {
	"configure",	"::fconfigure",
	NULL
    };
    Tcl_Command ensemble;
    Tcl_Obj *mapObj;
    int i;

    ensemble = TclMakeEnsemble(interp, "chan", initMap);
    Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
    for (i=0 ; extras[i] ; i+=2) {
	/*
	 * Can assume that reference counts are all incremented.
	 */

	TclDictPutString(NULL, mapObj, extras[i], extras[i + 1]);
    }
    Tcl_SetEnsembleMappingDict(interp, ensemble, mapObj);
    return ensemble;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|

|



|


|




|
|
|
>




|
<
<

|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<

<
<
<

<
<
<
<
<
|
<
|
<









2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137


2138
2139



























2140



2141





2142

2143

2144
2145
2146
2147
2148
2149
2150
2151
2152
    return Tcl_GetChannelNamesEx(interp,
	    ((objc == 1) ? NULL : TclGetString(objv[1])));
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetUpChanCmd --
 *
 *	This function is invoked to set up the "chan" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	Tcl result code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclSetUpChanCmd(
    Tcl_Interp *interp,
    Tcl_Command ensemble)
{
    /*
     * Most commands are plugged directly together, but some are done via
     * alias-like rewriting; [chan configure] is this way for security reasons
     * (want overwriting of [fconfigure] to control that nicely).


     */




























    Tcl_Obj *mapObj;



    Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);





    TclDictPutString(NULL, mapObj, "configure", "::fconfigure");

    return Tcl_SetEnsembleMappingDict(interp, ensemble, mapObj);

}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to generic/tclIndexObj.c.
27
28
29
30
31
32
33







34
35
36
37
38
39
40
static void		FreeIndex(Tcl_Obj *objPtr);
static Tcl_ObjCmdProc PrefixAllObjCmd;
static Tcl_ObjCmdProc PrefixLongestObjCmd;
static Tcl_ObjCmdProc PrefixMatchObjCmd;
static void		PrintUsage(Tcl_Interp *interp,
			    const Tcl_ArgvInfo *argTable);








/*
 * The structure below defines the index Tcl object type by means of functions
 * that can be invoked by generic object code.
 */

const Tcl_ObjType tclIndexType = {
    "index",			/* name */







>
>
>
>
>
>
>







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
static void		FreeIndex(Tcl_Obj *objPtr);
static Tcl_ObjCmdProc PrefixAllObjCmd;
static Tcl_ObjCmdProc PrefixLongestObjCmd;
static Tcl_ObjCmdProc PrefixMatchObjCmd;
static void		PrintUsage(Tcl_Interp *interp,
			    const Tcl_ArgvInfo *argTable);

const EnsembleImplMap tclPrefixImplMap[] = {
    {"all",	PrefixAllObjCmd,	TclCompileBasic2ArgCmd,    NULL, NULL, 0},
    {"longest",	PrefixLongestObjCmd,	TclCompileBasic2ArgCmd,    NULL, NULL, 0},
    {"match",	PrefixMatchObjCmd,	TclCompileBasicMin2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * The structure below defines the index Tcl object type by means of functions
 * that can be invoked by generic object code.
 */

const Tcl_ObjType tclIndexType = {
    "index",			/* name */
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
    Tcl_Free(TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1);
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitPrefixCmd --
 *
 *	This procedure creates the "prefix" Tcl command. See the user
 *	documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitPrefixCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap prefixImplMap[] = {
	{"all",	    PrefixAllObjCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"longest", PrefixLongestObjCmd,TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"match",   PrefixMatchObjCmd,	TclCompileBasicMin2ArgCmd, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    Tcl_Command prefixCmd;

    prefixCmd = TclMakeEnsemble(interp, "::tcl::prefix", prefixImplMap);
    Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
	    "prefix", 0);
    return prefixCmd;
}

/*----------------------------------------------------------------------
 *
 * PrefixMatchObjCmd --
 *
 *	This function implements the 'prefix match' Tcl command. Refer to the







|

|



|







|
|
|
<
<
<
<
<
<
<
|
|
<
|

<







461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484







485
486

487
488

489
490
491
492
493
494
495
    Tcl_Free(TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1);
    objPtr->typePtr = NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetUpPrefixCmd --
 *
 *	This procedure sets up the "prefix" Tcl command. See the user
 *	documentation for details on what it does.
 *
 * Results:
 *	Tcl result code.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
TclSetUpPrefixCmd(
    Tcl_Interp *interp,		/* Current interpreter. */







    Tcl_Command ensemble)	/* The prefix ensemble. */ 
{

    return Tcl_Export(interp, (Tcl_Namespace*)((Command *)ensemble)->nsPtr,
	    "prefix", 0);

}

/*----------------------------------------------------------------------
 *
 * PrefixMatchObjCmd --
 *
 *	This function implements the 'prefix match' Tcl command. Refer to the
Changes to generic/tclInt.h.
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778

/*
 * Structure used in implementation of those core ensembles which are
 * partially compiled. Used as an array of these, with a terminating field
 * whose 'name' is NULL.
 */

typedef struct {
    const char *name;		/* The name of the subcommand. */
    Tcl_ObjCmdProc *proc;	/* The implementation of the subcommand. */
    CompileProc *compileProc;	/* The compiler for the subcommand. */
    Tcl_ObjCmdProc *nreProc;	/* NRE implementation of this command. */
    void *clientData;		/* Any clientData to give the command. */
    int unsafe;			/* Whether this command is to be hidden by
				 * default in a safe interpreter. */







|







1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778

/*
 * Structure used in implementation of those core ensembles which are
 * partially compiled. Used as an array of these, with a terminating field
 * whose 'name' is NULL.
 */

typedef struct EnsembleImplMap {
    const char *name;		/* The name of the subcommand. */
    Tcl_ObjCmdProc *proc;	/* The implementation of the subcommand. */
    CompileProc *compileProc;	/* The compiler for the subcommand. */
    Tcl_ObjCmdProc *nreProc;	/* NRE implementation of this command. */
    void *clientData;		/* Any clientData to give the command. */
    int unsafe;			/* Whether this command is to be hidden by
				 * default in a safe interpreter. */
3138
3139
3140
3141
3142
3143
3144






















3145
3146
3147
3148
3149
3150
3151
 */

MODULE_SCOPE const Tcl_HashKeyType tclArrayHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclStringHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType;























/*
 * The head of the list of free Tcl objects, and the total number of Tcl
 * objects ever allocated and freed.
 */

MODULE_SCOPE Tcl_Obj *	tclFreeObjList;








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
 */

MODULE_SCOPE const Tcl_HashKeyType tclArrayHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclOneWordHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclStringHashKeyType;
MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType;

/*
 * Tables ("implementation maps") used to declare ensembles.
 */

MODULE_SCOPE const EnsembleImplMap tclArrayImplMap[];
MODULE_SCOPE const EnsembleImplMap tclBinaryImplMap[];
MODULE_SCOPE const EnsembleImplMap tclBinaryEncodeImplMap[];
MODULE_SCOPE const EnsembleImplMap tclBinaryDecodeImplMap[];
MODULE_SCOPE const EnsembleImplMap tclChanImplMap[];
MODULE_SCOPE const EnsembleImplMap tclClockImplMap[];
MODULE_SCOPE const EnsembleImplMap tclDictImplMap[];
MODULE_SCOPE const EnsembleImplMap tclEncodingImplMap[];
MODULE_SCOPE const EnsembleImplMap tclFileImplMap[];
MODULE_SCOPE const EnsembleImplMap tclInfoImplMap[];
MODULE_SCOPE const EnsembleImplMap tclNamespaceImplMap[];
MODULE_SCOPE const EnsembleImplMap tclPrefixImplMap[];
MODULE_SCOPE const EnsembleImplMap tclProcessImplMap[];
MODULE_SCOPE const EnsembleImplMap tclStringImplMap[];
MODULE_SCOPE const EnsembleImplMap tclUnicodeImplMap[];
MODULE_SCOPE const EnsembleImplMap tclZipfsImplMap[];
MODULE_SCOPE const EnsembleImplMap tclZlibImplMap[];

/*
 * The head of the list of free Tcl objects, and the total number of Tcl
 * objects ever allocated and freed.
 */

MODULE_SCOPE Tcl_Obj *	tclFreeObjList;

3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740

3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
 * Command procedures in the generic core:
 *----------------------------------------------------------------
 */

MODULE_SCOPE Tcl_ObjCmdProc Tcl_AfterObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_AppendObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ApplyObjCmd;
MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_BreakObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_CatchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_CdObjCmd;
MODULE_SCOPE Tcl_Command TclInitChanCmd(Tcl_Interp *interp);

MODULE_SCOPE Tcl_ObjCmdProc TclChanCreateObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPostEventObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPopObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPushObjCmd;
MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc TclClockOldscanObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_CloseObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConcatObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ContinueObjCmd;
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
			    void *clientData);
MODULE_SCOPE Tcl_ObjCmdProc TclDefaultBgErrorHandlerObjCmd;
MODULE_SCOPE Tcl_Command TclInitDictCmd(Tcl_Interp *interp);
MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Size index, Tcl_Size pathc,
			    Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    Tcl_Size pathc, Tcl_Obj *const pathv[]);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_DisassembleObjCmd;







<
<



|
>














<







3750
3751
3752
3753
3754
3755
3756


3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775

3776
3777
3778
3779
3780
3781
3782
 * Command procedures in the generic core:
 *----------------------------------------------------------------
 */

MODULE_SCOPE Tcl_ObjCmdProc Tcl_AfterObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_AppendObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ApplyObjCmd;


MODULE_SCOPE Tcl_ObjCmdProc Tcl_BreakObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_CatchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_CdObjCmd;
MODULE_SCOPE int	TclSetUpChanCmd(Tcl_Interp *interp,
			    Tcl_Command chanEnsemble);
MODULE_SCOPE Tcl_ObjCmdProc TclChanCreateObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPostEventObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPopObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclChanPushObjCmd;
MODULE_SCOPE void	TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc TclClockOldscanObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_CloseObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConcatObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ConstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ContinueObjCmd;
MODULE_SCOPE Tcl_TimerToken TclCreateAbsoluteTimerHandler(
			    Tcl_Time *timePtr, Tcl_TimerProc *proc,
			    void *clientData);
MODULE_SCOPE Tcl_ObjCmdProc TclDefaultBgErrorHandlerObjCmd;

MODULE_SCOPE int	TclDictWithFinish(Tcl_Interp *interp, Var *varPtr,
			    Var *arrayPtr, Tcl_Obj *part1Ptr,
			    Tcl_Obj *part2Ptr, Tcl_Size index, Tcl_Size pathc,
			    Tcl_Obj *const pathv[], Tcl_Obj *keysPtr);
MODULE_SCOPE Tcl_Obj *	TclDictWithInit(Tcl_Interp *interp, Tcl_Obj *dictPtr,
			    Tcl_Size pathc, Tcl_Obj *const pathv[]);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_DisassembleObjCmd;
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
MODULE_SCOPE Tcl_ObjCmdProc Tcl_EvalObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ExecObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ExitObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ExprObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_FblockedObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_FconfigureObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_FcopyObjCmd;
MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_FileEventObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_FlushObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ForObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ForeachObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_FormatObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_GetsObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_GlobalObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_GlobObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_IfObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_IncrObjCmd;
MODULE_SCOPE Tcl_Command TclInitInfoCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_InterpObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_JoinObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LappendObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LassignObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LeditObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LindexObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LinsertObjCmd;







<










<







3791
3792
3793
3794
3795
3796
3797

3798
3799
3800
3801
3802
3803
3804
3805
3806
3807

3808
3809
3810
3811
3812
3813
3814
MODULE_SCOPE Tcl_ObjCmdProc Tcl_EvalObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ExecObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ExitObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ExprObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_FblockedObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_FconfigureObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_FcopyObjCmd;

MODULE_SCOPE Tcl_ObjCmdProc Tcl_FileEventObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_FlushObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ForObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ForeachObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_FormatObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_GetsObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_GlobalObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_GlobObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_IfObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_IncrObjCmd;

MODULE_SCOPE Tcl_ObjCmdProc Tcl_InterpObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_JoinObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LappendObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LassignObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LeditObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LindexObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LinsertObjCmd;
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816

3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LrepeatObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LreplaceObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LreverseObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LsearchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LseqObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LsetObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LsortObjCmd;
MODULE_SCOPE Tcl_Command TclInitNamespaceCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc TclNamespaceEnsembleCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_OpenObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_PackageObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_PidObjCmd;
MODULE_SCOPE Tcl_Command TclInitPrefixCmd(Tcl_Interp *interp);

MODULE_SCOPE Tcl_ObjCmdProc Tcl_PutsObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_PwdObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ReadObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_RegexpObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_RegsubObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_RenameObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_RepresentationCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ReturnObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclSafeCatchCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ScanObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SeekObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SetObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SplitObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SocketObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SourceObjCmd;
MODULE_SCOPE Tcl_Command TclInitStringCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Command TclInitUnicodeCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SubstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SwitchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_TellObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ThrowObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_TimeObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_TimeRateObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_TraceObjCmd;







<




|
>















<
<







3822
3823
3824
3825
3826
3827
3828

3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849


3850
3851
3852
3853
3854
3855
3856
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LrepeatObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LreplaceObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LreverseObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LsearchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LseqObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LsetObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_LsortObjCmd;

MODULE_SCOPE Tcl_ObjCmdProc TclNamespaceEnsembleCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_OpenObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_PackageObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_PidObjCmd;
MODULE_SCOPE int	TclSetUpPrefixCmd(Tcl_Interp *interp,
				Tcl_Command prefixEnsemble);
MODULE_SCOPE Tcl_ObjCmdProc Tcl_PutsObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_PwdObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ReadObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_RegexpObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_RegsubObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_RenameObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_RepresentationCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ReturnObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclSafeCatchCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ScanObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SeekObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SetObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SplitObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SocketObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SourceObjCmd;


MODULE_SCOPE Tcl_ObjCmdProc Tcl_SubstObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_SwitchObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_TellObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_ThrowObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_TimeObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_TimeRateObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc Tcl_TraceObjCmd;
4136
4137
4138
4139
4140
4141
4142
4143

4144
4145
4146
4147
4148
4149
4150
    TCL_PROCESS_EXITED = 1,	/* Process has exited. */
    TCL_PROCESS_SIGNALED = 2,	/* Child killed because of a signal. */
    TCL_PROCESS_STOPPED = 3,	/* Child suspended because of a signal. */
    TCL_PROCESS_UNKNOWN_STATUS = 4
				/* Child wait status didn't make sense. */
} TclProcessWaitStatus;

MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);

MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
			    int *codePtr, Tcl_Obj **msgObjPtr,
			    Tcl_Obj **errorObjPtr);
MODULE_SCOPE int	TclClose(Tcl_Interp *, Tcl_Channel chan);

/*







|
>







4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
    TCL_PROCESS_EXITED = 1,	/* Process has exited. */
    TCL_PROCESS_SIGNALED = 2,	/* Child killed because of a signal. */
    TCL_PROCESS_STOPPED = 3,	/* Child suspended because of a signal. */
    TCL_PROCESS_UNKNOWN_STATUS = 4
				/* Child wait status didn't make sense. */
} TclProcessWaitStatus;

MODULE_SCOPE int	TclSetUpProcessCmd(Tcl_Interp *interp,
			    Tcl_Command processEnsemble);
MODULE_SCOPE void	TclProcessCreated(Tcl_Pid pid);
MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
			    int *codePtr, Tcl_Obj **msgObjPtr,
			    Tcl_Obj **errorObjPtr);
MODULE_SCOPE int	TclClose(Tcl_Interp *, Tcl_Channel chan);

/*
Changes to generic/tclInterp.c.
442
443
444
445
446
447
448

449

450
451
452
453
454
455
456
"    }\n"
"    set dirs {}\n"
"    set errors {}\n"
"    foreach script $scripts {\n"
"	if {[set tcl_library [eval $script]] eq \"\"} continue\n"
"	set tclfile [file join $tcl_library init.tcl]\n"
"	if {[file exists $tclfile]} {\n"

"	    if {[catch {uplevel #0 [list source $tclfile]} msg opts]} {\n"

"		append errors \"$tclfile: $msg\n\"\n"
"		append errors \"[dict get $opts -errorinfo]\n\"\n"
"		continue\n"
"	    }\n"
"	    unset -nocomplain tclDefaultLibrary\n"
"	    return\n"
"	}\n"







>
|
>







442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
"    }\n"
"    set dirs {}\n"
"    set errors {}\n"
"    foreach script $scripts {\n"
"	if {[set tcl_library [eval $script]] eq \"\"} continue\n"
"	set tclfile [file join $tcl_library init.tcl]\n"
"	if {[file exists $tclfile]} {\n"
"	    try {\n"
"		uplevel #0 [list source $tclfile]\n"
"	    } on error {msg opts} {\n"
"		append errors \"$tclfile: $msg\n\"\n"
"		append errors \"[dict get $opts -errorinfo]\n\"\n"
"		continue\n"
"	    }\n"
"	    unset -nocomplain tclDefaultLibrary\n"
"	    return\n"
"	}\n"
Changes to generic/tclNamesp.c.
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
    } while (false)

/*
 * Array of values describing how to implement each standard subcommand of the
 * "namespace" command.
 */

static const EnsembleImplMap defaultNamespaceMap[] = {
    {"children",   NamespaceChildrenCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
    {"code",	   NamespaceCodeCmd,	TclCompileNamespaceCodeCmd, NULL, NULL, 0},
    {"current",	   NamespaceCurrentCmd,	TclCompileNamespaceCurrentCmd, NULL, NULL, 0},
    {"delete",	   NamespaceDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"ensemble",   TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
    {"eval",	   NamespaceEvalCmd,	NULL, NRNamespaceEvalCmd, NULL, 0},
    {"exists",	   NamespaceExistsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"export",	   NamespaceExportCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"forget",	   NamespaceForgetCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"import",	   NamespaceImportCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"inscope",	   NamespaceInscopeCmd,	NULL, NRNamespaceInscopeCmd, NULL, 0},
    {"origin",	   NamespaceOriginCmd,	TclCompileNamespaceOriginCmd, NULL, NULL, 0},
    {"parent",	   NamespaceParentCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"path",	   NamespacePathCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
    {"tail",	   NamespaceTailCmd,	TclCompileNamespaceTailCmd, NULL, NULL, 0},
    {"unknown",	   NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"upvar",	   NamespaceUpvarCmd,	TclCompileNamespaceUpvarCmd, NULL, NULL, 0},
    {"which",	   NamespaceWhichCmd,	TclCompileNamespaceWhichCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}







|






|





|







152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
    } while (false)

/*
 * Array of values describing how to implement each standard subcommand of the
 * "namespace" command.
 */

const EnsembleImplMap tclNamespaceImplMap[] = {
    {"children",   NamespaceChildrenCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
    {"code",	   NamespaceCodeCmd,	TclCompileNamespaceCodeCmd, NULL, NULL, 0},
    {"current",	   NamespaceCurrentCmd,	TclCompileNamespaceCurrentCmd, NULL, NULL, 0},
    {"delete",	   NamespaceDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"ensemble",   TclNamespaceEnsembleCmd, NULL, NULL, NULL, 0},
    {"eval",	   NamespaceEvalCmd,	NULL, NRNamespaceEvalCmd, NULL, 0},
    {"exists",	   NamespaceExistsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0}, // TODO: compile?
    {"export",	   NamespaceExportCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"forget",	   NamespaceForgetCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"import",	   NamespaceImportCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
    {"inscope",	   NamespaceInscopeCmd,	NULL, NRNamespaceInscopeCmd, NULL, 0},
    {"origin",	   NamespaceOriginCmd,	TclCompileNamespaceOriginCmd, NULL, NULL, 0},
    {"parent",	   NamespaceParentCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0}, // TODO: compile?
    {"path",	   NamespacePathCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"qualifiers", NamespaceQualifiersCmd, TclCompileNamespaceQualifiersCmd, NULL, NULL, 0},
    {"tail",	   NamespaceTailCmd,	TclCompileNamespaceTailCmd, NULL, NULL, 0},
    {"unknown",	   NamespaceUnknownCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
    {"upvar",	   NamespaceUpvarCmd,	TclCompileNamespaceUpvarCmd, NULL, NULL, 0},
    {"which",	   NamespaceWhichCmd,	TclCompileNamespaceWhichCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
Tcl_Namespace *
TclEnsureNamespace(
    Tcl_Interp *interp,
    Tcl_Namespace *namespacePtr)
{
    Namespace *nsPtr = (Namespace *) namespacePtr;
    if (!(nsPtr->flags & NS_DYING)) {
	    return namespacePtr;
    }
    return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
}

/*
 *----------------------------------------------------------------------
 *







|







2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
Tcl_Namespace *
TclEnsureNamespace(
    Tcl_Interp *interp,
    Tcl_Namespace *namespacePtr)
{
    Namespace *nsPtr = (Namespace *) namespacePtr;
    if (!(nsPtr->flags & NS_DYING)) {
	return namespacePtr;
    }
    return Tcl_CreateNamespace(interp, nsPtr->fullName, NULL, NULL);
}

/*
 *----------------------------------------------------------------------
 *
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
	resNamePtr->refNsPtr = NULL;
	resNamePtr->refCount = 0;
	nsPtr->refCount++;
	NsNameSetInternalRep(objPtr, resNamePtr);
    }
    return objPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitNamespaceCmd --
 *
 *	This function is called to create the "namespace" Tcl command. See the
 *	user documentation for details on what it does.
 *
 * Results:
 *	Handle for the namespace command, or NULL on failure.
 *
 * Side effects:
 *	none
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitNamespaceCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    return TclMakeEnsemble(interp, "namespace", defaultNamespaceMap);
}

/*
 *----------------------------------------------------------------------
 *
 * NamespaceChildrenCmd --
 *
 *	Invoked to implement the "namespace children" command that returns a







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







3075
3076
3077
3078
3079
3080
3081
























3082
3083
3084
3085
3086
3087
3088
	resNamePtr->refNsPtr = NULL;
	resNamePtr->refCount = 0;
	nsPtr->refCount++;
	NsNameSetInternalRep(objPtr, resNamePtr);
    }
    return objPtr;
}

























/*
 *----------------------------------------------------------------------
 *
 * NamespaceChildrenCmd --
 *
 *	Invoked to implement the "namespace children" command that returns a
Changes to generic/tclOOInfo.c.
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
static Tcl_ObjCmdProc InfoClassSubsCmd;
static Tcl_ObjCmdProc InfoClassSupersCmd;
static Tcl_ObjCmdProc InfoClassVariablesCmd;

/*
 * List of commands that are used to implement the [info object] subcommands.
 */

static const EnsembleImplMap infoObjectCmds[] = {
    {"call",	   InfoObjectCallCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"class",	   InfoObjectClassCmd,	    TclCompileInfoObjectClassCmd, NULL, NULL, 0},
    {"creationid", InfoObjectIdCmd,	    TclCompileInfoObjectCreationIdCmd, NULL, NULL, 0},
    {"definition", InfoObjectDefnCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"filters",	   InfoObjectFiltersCmd,    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	   InfoObjectForwardCmd,    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"isa",	   InfoObjectIsACmd,	    TclCompileInfoObjectIsACmd, NULL, NULL, 0},
    {"methods",	   InfoObjectMethodsCmd,    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	   InfoObjectMixinsCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"namespace",  InfoObjectNsCmd,	    TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
    {"properties", TclOOInfoObjectPropCmd,  TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"vars",	   InfoObjectVarsCmd,	    TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * List of commands that are used to implement the [info class] subcommands.
 */

static const EnsembleImplMap infoClassCmds[] = {
    {"call",	     InfoClassCallCmd,		TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"constructor",  InfoClassConstrCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"definition",   InfoClassDefnCmd,		TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"definitionnamespace", InfoClassDefnNsCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"destructor",   InfoClassDestrCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"filters",	     InfoClassFiltersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	     InfoClassForwardCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},







<
|




















<
|







43
44
45
46
47
48
49

50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70

71
72
73
74
75
76
77
78
static Tcl_ObjCmdProc InfoClassSubsCmd;
static Tcl_ObjCmdProc InfoClassSupersCmd;
static Tcl_ObjCmdProc InfoClassVariablesCmd;

/*
 * List of commands that are used to implement the [info object] subcommands.
 */

static const EnsembleImplMap infoObjectImplMap[] = {
    {"call",	   InfoObjectCallCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"class",	   InfoObjectClassCmd,	    TclCompileInfoObjectClassCmd, NULL, NULL, 0},
    {"creationid", InfoObjectIdCmd,	    TclCompileInfoObjectCreationIdCmd, NULL, NULL, 0},
    {"definition", InfoObjectDefnCmd,	    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"filters",	   InfoObjectFiltersCmd,    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	   InfoObjectForwardCmd,    TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"isa",	   InfoObjectIsACmd,	    TclCompileInfoObjectIsACmd, NULL, NULL, 0},
    {"methods",	   InfoObjectMethodsCmd,    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"mixins",	   InfoObjectMixinsCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"namespace",  InfoObjectNsCmd,	    TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
    {"properties", TclOOInfoObjectPropCmd,  TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"vars",	   InfoObjectVarsCmd,	    TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * List of commands that are used to implement the [info class] subcommands.
 */

static const EnsembleImplMap infoClassImplMap[] = {
    {"call",	     InfoClassCallCmd,		TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"constructor",  InfoClassConstrCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"definition",   InfoClassDefnCmd,		TclCompileBasic2ArgCmd, NULL, NULL, 0},
    {"definitionnamespace", InfoClassDefnNsCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    {"destructor",   InfoClassDestrCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"filters",	     InfoClassFiltersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    {"forward",	     InfoClassForwardCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
141
142
143
144
145
146
147
148
149
150
151
152



153
154
155
156
157
158
159
    Tcl_Command infoCmd;
    Tcl_Obj *mapDict;

    /*
     * Build the ensembles used to implement [info object] and [info class].
     */

    TclMakeEnsemble(interp, "::oo::InfoObject", infoObjectCmds);
    TclMakeEnsemble(interp, "::oo::InfoClass", infoClassCmds);

    /*
     * Install into the [info] ensemble.



     */

    infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
    if (infoCmd) {
	Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
	TclDictPutString(NULL, mapDict, "object", "::oo::InfoObject");
	TclDictPutString(NULL, mapDict, "class", "::oo::InfoClass");







|
|



>
>
>







139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
    Tcl_Command infoCmd;
    Tcl_Obj *mapDict;

    /*
     * Build the ensembles used to implement [info object] and [info class].
     */

    TclMakeEnsemble(interp, "::oo::InfoObject", infoObjectImplMap);
    TclMakeEnsemble(interp, "::oo::InfoClass", infoClassImplMap);

    /*
     * Install into the [info] ensemble.
     * We keep the subcommands with their existing names instead of the
     * auto-generated ones supported by the ensemble guts because we're
     * somewhat documented to work this way.
     */

    infoCmd = Tcl_FindCommand(interp, "info", NULL, TCL_GLOBAL_ONLY);
    if (infoCmd) {
	Tcl_GetEnsembleMappingDict(NULL, infoCmd, &mapDict);
	TclDictPutString(NULL, mapDict, "object", "::oo::InfoObject");
	TclDictPutString(NULL, mapDict, "class", "::oo::InfoClass");
Changes to generic/tclProcess.c.
48
49
50
51
52
53
54
55

56
57





58


59
60
61
62
63
64
65
66
			    Tcl_Size resolvedPid);
static void		FreeProcessInfo(ProcessInfo *info);
static int		RefreshProcessInfo(ProcessInfo *info, int options);
static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, Tcl_Size resolvedPid,
			    int options, int *codePtr, Tcl_Obj **msgPtr,
			    Tcl_Obj **errorObjPtr);
static Tcl_Obj *	BuildProcessStatusObj(ProcessInfo *info);
static Tcl_ObjCmdProc ProcessListObjCmd;

static Tcl_ObjCmdProc ProcessStatusObjCmd;
static Tcl_ObjCmdProc ProcessPurgeObjCmd;





static Tcl_ObjCmdProc ProcessAutopurgeObjCmd;



/*
 *----------------------------------------------------------------------
 *
 * InitProcessInfo --
 *
 *	Initializes the ProcessInfo structure.
 *







|
>
|
|
>
>
>
>
>
|
>
>
|







48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
			    Tcl_Size resolvedPid);
static void		FreeProcessInfo(ProcessInfo *info);
static int		RefreshProcessInfo(ProcessInfo *info, int options);
static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, Tcl_Size resolvedPid,
			    int options, int *codePtr, Tcl_Obj **msgPtr,
			    Tcl_Obj **errorObjPtr);
static Tcl_Obj *	BuildProcessStatusObj(ProcessInfo *info);
static Tcl_ObjCmdProc	ProcessListObjCmd;
static Tcl_ObjCmdProc	ProcessStatusObjCmd;
static Tcl_ObjCmdProc	ProcessPurgeObjCmd;
static Tcl_ObjCmdProc	ProcessAutopurgeObjCmd;

const EnsembleImplMap tclProcessImplMap[] = {
    {"list",		ProcessListObjCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 1},
    {"status",		ProcessStatusObjCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
    {"purge",		ProcessPurgeObjCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
    {"autopurge",	ProcessAutopurgeObjCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 *----------------------------------------------------------------------
 *
 * InitProcessInfo --
 *
 *	Initializes the ProcessInfo structure.
 *
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(autopurge));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitProcessCmd --
 *
 *	This procedure creates the "tcl::process" Tcl command. See the user
 *	documentation for details on what it does.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitProcessCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap processImplMap[] = {
	{"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
	{"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
	{"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    Tcl_Command processCmd;

    if (infoTablesInitialized == 0) {
	Tcl_MutexLock(&infoTablesMutex);
	if (infoTablesInitialized == 0) {
	    Tcl_InitHashTable(&infoTablePerPid, TCL_ONE_WORD_KEYS);
	    Tcl_InitHashTable(&infoTablePerResolvedPid, TCL_ONE_WORD_KEYS);
	    infoTablesInitialized = 1;
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    }

    processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap);
    Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
	    "process", 0);
    return processCmd;
}

/*
 *----------------------------------------------------------------------
 *
 * TclProcessCreated --
 *







|

|



|







|
|
|
<
<
<
<
<
<
<
<
|
|










<
|

<







755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778








779
780
781
782
783
784
785
786
787
788
789
790

791
792

793
794
795
796
797
798
799
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(autopurge));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSetUpProcessCmd --
 *
 *	This procedure sets up the "tcl::process" Tcl command. See the user
 *	documentation for details on what it does.
 *
 * Results:
 *	Tcl result code.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

int
TclSetUpProcessCmd(
    Tcl_Interp *interp,		/* Current interpreter. */








    Tcl_Command ensemble)	/* The ensemble to set up. */
{
    if (infoTablesInitialized == 0) {
	Tcl_MutexLock(&infoTablesMutex);
	if (infoTablesInitialized == 0) {
	    Tcl_InitHashTable(&infoTablePerPid, TCL_ONE_WORD_KEYS);
	    Tcl_InitHashTable(&infoTablePerResolvedPid, TCL_ONE_WORD_KEYS);
	    infoTablesInitialized = 1;
	}
	Tcl_MutexUnlock(&infoTablesMutex);
    }


    return Tcl_Export(interp, (Tcl_Namespace*)((Command *)ensemble)->nsPtr,
	    "process", 0);

}

/*
 *----------------------------------------------------------------------
 *
 * TclProcessCreated --
 *
Changes to generic/tclVar.c.
189
190
191
192
193
194
195




196
197
198
199
200


201
202






203
204
205
206
207
208
209
/*
 * Forward references to functions defined later in this file:
 */

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks,
			    int justConstants);




static void		ArrayPopulateSearch(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Var *varPtr,
			    ArraySearch *searchPtr);
static void		ArrayDoneSearch(Interp *iPtr, Var *varPtr,
			    ArraySearch *searchPtr);


static Tcl_NRPostProc	ArrayForLoopCallback;
static Tcl_ObjCmdProc	ArrayForNRCmd;






static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
			    Var *varPtr, int flags, Tcl_Size index);
static int		LocateArray(Tcl_Interp *interp, Tcl_Obj *name,
			    Var **varPtrPtr, int *isArrayPtr);
static int		NotArrayError(Tcl_Interp *interp, Tcl_Obj *name);
static Tcl_Var		ObjFindNamespaceVar(Tcl_Interp *interp,







>
>
>
>





>
>
|

>
>
>
>
>
>







189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
/*
 * Forward references to functions defined later in this file:
 */

static void		AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Obj *patternPtr, int includeLinks,
			    int justConstants);
static Tcl_ObjCmdProc	ArrayAnyMoreCmd;
static Tcl_ObjCmdProc	ArrayDoneSearchCmd;
static Tcl_ObjCmdProc	ArrayNextElementCmd;
static Tcl_ObjCmdProc	ArrayStartSearchCmd;
static void		ArrayPopulateSearch(Tcl_Interp *interp,
			    Tcl_Obj *arrayNameObj, Var *varPtr,
			    ArraySearch *searchPtr);
static void		ArrayDoneSearch(Interp *iPtr, Var *varPtr,
			    ArraySearch *searchPtr);
static Tcl_ObjCmdProc	ArrayExistsCmd;
static Tcl_ObjCmdProc	ArrayForObjCmd;
static Tcl_NRPostProc   ArrayForLoopCallback;
static Tcl_ObjCmdProc	ArrayForNRCmd;
static Tcl_ObjCmdProc	ArrayGetCmd;
static Tcl_ObjCmdProc	ArrayNamesCmd;
static Tcl_ObjCmdProc	ArraySetCmd;
static Tcl_ObjCmdProc	ArraySizeCmd;
static Tcl_ObjCmdProc	ArrayStatsCmd;
static Tcl_ObjCmdProc	ArrayUnsetCmd;
static void		DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void		DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
			    Var *varPtr, int flags, Tcl_Size index);
static int		LocateArray(Tcl_Interp *interp, Tcl_Obj *name,
			    Var **varPtrPtr, int *isArrayPtr);
static int		NotArrayError(Tcl_Interp *interp, Tcl_Obj *name);
static Tcl_Var		ObjFindNamespaceVar(Tcl_Interp *interp,
237
238
239
240
241
242
243

















244
245
246
247
248
249
250
			    const char **errMsgPtr, Tcl_Size *indexPtr);

static Tcl_DupInternalRepProc	DupLocalVarName;
static Tcl_FreeInternalRepProc	FreeLocalVarName;

static Tcl_FreeInternalRepProc	FreeParsedVarName;
static Tcl_DupInternalRepProc	DupParsedVarName;


















/*
 * Types of Tcl_Objs used to cache variable lookups.
 *
 * localVarName - INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
			    const char **errMsgPtr, Tcl_Size *indexPtr);

static Tcl_DupInternalRepProc	DupLocalVarName;
static Tcl_FreeInternalRepProc	FreeLocalVarName;

static Tcl_FreeInternalRepProc	FreeParsedVarName;
static Tcl_DupInternalRepProc	DupParsedVarName;

const EnsembleImplMap tclArrayImplMap[] = {
    {"anymore",		ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd,		NULL,		NULL, 0},
    {"default",		ArrayDefaultCmd,	TclCompileBasic2Or3ArgCmd,	NULL,		NULL, 0},
    {"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd,		NULL,		NULL, 0},
    {"exists",		ArrayExistsCmd,		TclCompileArrayExistsCmd,	NULL,		NULL, 0},
    {"for",		ArrayForObjCmd,		TclCompileBasic3ArgCmd,		ArrayForNRCmd,	NULL, 0}, // TODO: compile?
    {"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd,	NULL,		NULL, 0},
    {"names",		ArrayNamesCmd,		TclCompileBasic1To3ArgCmd,	NULL,		NULL, 0},
    {"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd,		NULL,		NULL, 0},
    {"set",		ArraySetCmd,		TclCompileArraySetCmd,		NULL,		NULL, 0},
    {"size",		ArraySizeCmd,		TclCompileBasic1ArgCmd,		NULL,		NULL, 0},
    {"startsearch",	ArrayStartSearchCmd,	TclCompileBasic1ArgCmd,		NULL,		NULL, 0},
    {"statistics",	ArrayStatsCmd,		TclCompileBasic1ArgCmd,		NULL,		NULL, 0},
    {"unset",		ArrayUnsetCmd,		TclCompileArrayUnsetCmd,	NULL,		NULL, 0},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 * Types of Tcl_Objs used to cache variable lookups.
 *
 * localVarName - INTERNALREP DEFINITION:
 *   twoPtrValue.ptr1:   pointer to name obj in varFramePtr->localCache
 *			  or NULL if it is this same obj
4438
4439
4440
4441
4442
4443
4444
4445
4446
4447
4448
4449
4450
4451
4452
4453
4454
4455
4456
4457
4458
4459
4460
4461
4462
4463
4464
4465
4466
4467
4468
4469
4470
4471
4472
4473
4474
4475
4476
4477
4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
4490
4491
		CleanupVar(protectedVarPtr, varPtr);
	    }
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclInitArrayCmd --
 *
 *	This creates the ensemble for the "array" command.
 *
 * Results:
 *	The handle for the created ensemble.
 *
 * Side effects:
 *	Creates a command in the global namespace.
 *
 *----------------------------------------------------------------------
 */

Tcl_Command
TclInitArrayCmd(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap arrayImplMap[] = {
	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"default",	ArrayDefaultCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
	{"for",		ArrayForObjCmd,		TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
	{"get",		ArrayGetCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
	{"names",	ArrayNamesCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
	{"nextelement",	ArrayNextElementCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
	{"set",		ArraySetCmd,		TclCompileArraySetCmd, NULL, NULL, 0},
	{"size",	ArraySizeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"startsearch",	ArrayStartSearchCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"statistics",	ArrayStatsCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
	{"unset",	ArrayUnsetCmd,		TclCompileArrayUnsetCmd, NULL, NULL, 0},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };

    return TclMakeEnsemble(interp, "array", arrayImplMap);
}

/*
 *----------------------------------------------------------------------
 *
 * ObjMakeUpvar --
 *
 *	This function does all of the work of the "global" and "upvar"







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







4467
4468
4469
4470
4471
4472
4473








































4474
4475
4476
4477
4478
4479
4480
		CleanupVar(protectedVarPtr, varPtr);
	    }
	    return TCL_ERROR;
	}
    }
    return TCL_OK;
}









































/*
 *----------------------------------------------------------------------
 *
 * ObjMakeUpvar --
 *
 *	This function does all of the work of the "global" and "upvar"
Changes to generic/tclZipfs.c.
474
475
476
477
478
479
480














481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
			    int mask);
static int		ZipChannelWrite(void *instanceData,
			    const char *buf, int toWrite, int *errloc);
static int		TclZipfsInitEncodingDirs(void);
static int		TclZipfsMountExe(void);
static int		TclZipfsMountShlib(void);















/*
 * Define the ZIP filesystem dispatch table.
 */

static const Tcl_Filesystem zipfsFilesystem = {
    "zipfs",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_2,
    ZipFSPathInFilesystemProc,
    NULL, /* dupInternalRepProc */
    NULL, /* freeInternalRepProc */
    NULL, /* internalToNormalizedProc */
    NULL, /* createInternalRepProc */
    NULL, /* normalizePathProc */
    ZipFSFilesystemPathTypeProc,
    ZipFSFilesystemSeparatorProc,
    ZipFSStatProc,
    ZipFSAccessProc,
    ZipFSOpenFileChannelProc,
    ZipFSMatchInDirectoryProc,
    NULL, /* utimeProc */
    NULL, /* linkProc */
    ZipFSListVolumesProc,
    ZipFSFileAttrStringsProc,
    ZipFSFileAttrsGetProc,
    ZipFSFileAttrsSetProc,
    NULL, /* createDirectoryProc */
    NULL, /* removeDirectoryProc */
    NULL, /* deleteFileProc */
    NULL, /* copyFileProc */
    NULL, /* renameFileProc */
    NULL, /* copyDirectoryProc */
    NULL, /* lstatProc */
    (Tcl_FSLoadFileProc *) (void *) ZipFSLoadFile,
    NULL, /* getCwdProc */
    NULL, /* chdirProc */
};

/*
 * The channel type/driver definition used for ZIP archive members.
 */
static const Tcl_ChannelType zipChannelType = {
    "zip",







>
>
>
>
>
>
>
>
>
>
>
>
>
>









|
|
|
|
|






|
|




|
|
|
|
|
|
|

|
|







474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
			    int mask);
static int		ZipChannelWrite(void *instanceData,
			    const char *buf, int toWrite, int *errloc);
static int		TclZipfsInitEncodingDirs(void);
static int		TclZipfsMountExe(void);
static int		TclZipfsMountShlib(void);

static Tcl_ObjCmdProc	ZipFSMkImgObjCmd;
static Tcl_ObjCmdProc	ZipFSMkZipObjCmd;
static Tcl_ObjCmdProc	ZipFSLMkImgObjCmd;
static Tcl_ObjCmdProc	ZipFSLMkZipObjCmd;
static Tcl_ObjCmdProc	ZipFSMountObjCmd;
static Tcl_ObjCmdProc	ZipFSMountBufferObjCmd;
static Tcl_ObjCmdProc	ZipFSUnmountObjCmd;
static Tcl_ObjCmdProc	ZipFSMkKeyObjCmd;
static Tcl_ObjCmdProc	ZipFSExistsObjCmd;
static Tcl_ObjCmdProc	ZipFSInfoObjCmd;
static Tcl_ObjCmdProc	ZipFSListObjCmd;
static Tcl_ObjCmdProc	ZipFSCanonicalObjCmd;
static Tcl_ObjCmdProc	ZipFSRootObjCmd;

/*
 * Define the ZIP filesystem dispatch table.
 */

static const Tcl_Filesystem zipfsFilesystem = {
    "zipfs",
    sizeof(Tcl_Filesystem),
    TCL_FILESYSTEM_VERSION_2,
    ZipFSPathInFilesystemProc,
    NULL,	/* dupInternalRepProc */
    NULL,	/* freeInternalRepProc */
    NULL,	/* internalToNormalizedProc */
    NULL,	/* createInternalRepProc */
    NULL,	/* normalizePathProc */
    ZipFSFilesystemPathTypeProc,
    ZipFSFilesystemSeparatorProc,
    ZipFSStatProc,
    ZipFSAccessProc,
    ZipFSOpenFileChannelProc,
    ZipFSMatchInDirectoryProc,
    NULL,	/* utimeProc */
    NULL,	/* linkProc */
    ZipFSListVolumesProc,
    ZipFSFileAttrStringsProc,
    ZipFSFileAttrsGetProc,
    ZipFSFileAttrsSetProc,
    NULL,	/* createDirectoryProc */
    NULL,	/* removeDirectoryProc */
    NULL,	/* deleteFileProc */
    NULL,	/* copyFileProc */
    NULL,	/* renameFileProc */
    NULL,	/* copyDirectoryProc */
    NULL,	/* lstatProc */
    (Tcl_FSLoadFileProc *) (void *) ZipFSLoadFile,
    NULL,	/* getCwdProc */
    NULL	/* chdirProc */
};

/*
 * The channel type/driver definition used for ZIP archive members.
 */
static const Tcl_ChannelType zipChannelType = {
    "zip",
534
535
536
537
538
539
540





















541
542
543
544
545
546
547
    NULL,			/* Set blocking mode for raw channel. */
    NULL,			/* Function to flush channel. */
    NULL,			/* Function to handle bubbled events. */
    ZipChannelWideSeek,
    NULL,			/* Thread action function. */
    NULL,			/* Truncate function. */
};






















/*
 *------------------------------------------------------------------------
 *
 * TclIsZipfsPath --
 *
 *    Checks if the passed path has a zipfs volume prefix.







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
    NULL,			/* Set blocking mode for raw channel. */
    NULL,			/* Function to flush channel. */
    NULL,			/* Function to handle bubbled events. */
    ZipChannelWideSeek,
    NULL,			/* Thread action function. */
    NULL,			/* Truncate function. */
};

/*
 * The description of the [zipfs] ensemble command.
 */
const EnsembleImplMap tclZipfsImplMap[] = {
    {"mkimg",		ZipFSMkImgObjCmd,	NULL, NULL, NULL, 1},
    {"mkzip",		ZipFSMkZipObjCmd,	NULL, NULL, NULL, 1},
    {"lmkimg",		ZipFSLMkImgObjCmd,	NULL, NULL, NULL, 1},
    {"lmkzip",		ZipFSLMkZipObjCmd,	NULL, NULL, NULL, 1},
    {"mount",		ZipFSMountObjCmd,	NULL, NULL, NULL, 1},
    {"mountdata",	ZipFSMountBufferObjCmd,	NULL, NULL, NULL, 1},
    {"unmount",		ZipFSUnmountObjCmd,	NULL, NULL, NULL, 1},
    {"mkkey",		ZipFSMkKeyObjCmd,	NULL, NULL, NULL, 1},
    {"exists",		ZipFSExistsObjCmd,	NULL, NULL, NULL, 1},
    {"find",		NULL,			NULL, NULL, NULL, 0},
    {"info",		ZipFSInfoObjCmd,	NULL, NULL, NULL, 1},
    {"list",		ZipFSListObjCmd,	NULL, NULL, NULL, 1},
    {"canonical",	ZipFSCanonicalObjCmd,	NULL, NULL, NULL, 1},
    {"root",		ZipFSRootObjCmd,	NULL, NULL, NULL, 1},
    {NULL, NULL, NULL, NULL, NULL, 0}
};

/*
 *------------------------------------------------------------------------
 *
 * TclIsZipfsPath --
 *
 *    Checks if the passed path has a zipfs volume prefix.
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
 *
 * Side effects:
 *	May mount the archive at the ZIPFS_APP_MOUNT mount point.
 *
 *-------------------------------------------------------------------------
 */
static int
TclZipfsMountExe()
{
    WriteLock();
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }
    int mounted = (ZipFSLookupZip(ZIPFS_APP_MOUNT) != NULL);
    Unlock();







|







4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
 *
 * Side effects:
 *	May mount the archive at the ZIPFS_APP_MOUNT mount point.
 *
 *-------------------------------------------------------------------------
 */
static int
TclZipfsMountExe(void)
{
    WriteLock();
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }
    int mounted = (ZipFSLookupZip(ZIPFS_APP_MOUNT) != NULL);
    Unlock();
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
 *
 * Side effects:
 *	May mount the archive at the ZIPFS_ZIP_MOUNT mount point.
 *
 *-------------------------------------------------------------------------
 */
static int
TclZipfsMountShlib()
{
#if defined(STATIC_BUILD)
    /* Static builds have no shared library */
    return 0;
#else
    WriteLock();
    if (!ZipFS.initialized) {







|







4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
 *
 * Side effects:
 *	May mount the archive at the ZIPFS_ZIP_MOUNT mount point.
 *
 *-------------------------------------------------------------------------
 */
static int
TclZipfsMountShlib(void)
{
#if defined(STATIC_BUILD)
    /* Static builds have no shared library */
    return 0;
#else
    WriteLock();
    if (!ZipFS.initialized) {
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426

6427
6428
6429
6430
6431
6432
6433
6434
6435
6436
6437
6438
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Init(
    Tcl_Interp *interp)		/* Current interpreter. */
{
    static const EnsembleImplMap initMap[] = {
	{"mkimg",	ZipFSMkImgObjCmd,	NULL, NULL, NULL, 1},
	{"mkzip",	ZipFSMkZipObjCmd,	NULL, NULL, NULL, 1},
	{"lmkimg",	ZipFSLMkImgObjCmd,	NULL, NULL, NULL, 1},
	{"lmkzip",	ZipFSLMkZipObjCmd,	NULL, NULL, NULL, 1},
	{"mount",	ZipFSMountObjCmd,	NULL, NULL, NULL, 1},
	{"mountdata",	ZipFSMountBufferObjCmd,	NULL, NULL, NULL, 1},
	{"unmount",	ZipFSUnmountObjCmd,	NULL, NULL, NULL, 1},
	{"mkkey",	ZipFSMkKeyObjCmd,	NULL, NULL, NULL, 1},
	{"exists",	ZipFSExistsObjCmd,	NULL, NULL, NULL, 1},
	{"info",	ZipFSInfoObjCmd,	NULL, NULL, NULL, 1},
	{"list",	ZipFSListObjCmd,	NULL, NULL, NULL, 1},
	{"canonical",	ZipFSCanonicalObjCmd,	NULL, NULL, NULL, 1},
	{"root",	ZipFSRootObjCmd,	NULL, NULL, NULL, 1},
	{NULL, NULL, NULL, NULL, NULL, 0}
    };
    static const char findproc[] =
	"namespace eval ::tcl::zipfs {}\n"
	"proc ::tcl::zipfs::Find dir {\n"
	"    set result {}\n"
	"    if {[catch {\n"

	"        concat [glob -directory $dir -nocomplain *] [glob -directory $dir -types hidden -nocomplain *]\n"
	"    } list]} {\n"
	"        return $result\n"
	"    }\n"
	"    foreach file $list {\n"
	"        if {[file tail $file] in {. ..}} {\n"
	"            continue\n"
	"        }\n"
	"        lappend result $file {*}[Find $file]\n"
	"    }\n"
	"    return $result\n"
	"}\n"







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




|
>
|
|


|







6434
6435
6436
6437
6438
6439
6440
















6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
 *-------------------------------------------------------------------------
 */

int
TclZipfs_Init(
    Tcl_Interp *interp)		/* Current interpreter. */
{
















    static const char findproc[] =
	"namespace eval ::tcl::zipfs {}\n"
	"proc ::tcl::zipfs::Find dir {\n"
	"    set result {}\n"
	"    try {\n"
	"        set normal [glob -directory $dir -nocomplain *]\n"
	"        set hidden [glob -directory $dir -types hidden -nocomplain *]\n"
	"    } on error {} {\n"
	"        return $result\n"
	"    }\n"
	"    foreach file [concat $normal $hidden] {\n"
	"        if {[file tail $file] in {. ..}} {\n"
	"            continue\n"
	"        }\n"
	"        lappend result $file {*}[Find $file]\n"
	"    }\n"
	"    return $result\n"
	"}\n"
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
6467
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
    WriteLock();
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }
    Unlock();

    if (interp) {
	Tcl_Command ensemble;
	Tcl_Obj *mapObj;

	Tcl_EvalEx(interp, findproc, TCL_INDEX_NONE, TCL_EVAL_GLOBAL);
	if (!Tcl_IsSafe(interp)) {
	    Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
		    TCL_LINK_INT);
	    Tcl_LinkVar(interp, "::tcl::zipfs::fallbackEntryEncoding",
		    (char *) &ZipFS.fallbackEntryEncoding, TCL_LINK_STRING);
	}
	ensemble = TclMakeEnsemble(interp, "zipfs",
		Tcl_IsSafe(interp) ? (initMap + 4) : initMap);

	/*
	 * Add the [zipfs find] subcommand.
	 */

	Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
	TclDictPutString(NULL, mapObj, "find", "::tcl::zipfs::find");
	Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
		ZipFSTclLibraryObjCmd, NULL, NULL);
    }
    return TCL_OK;
}

/*







<
<
<







<
<
<
<
<
<
<
<
<







6467
6468
6469
6470
6471
6472
6473



6474
6475
6476
6477
6478
6479
6480









6481
6482
6483
6484
6485
6486
6487
    WriteLock();
    if (!ZipFS.initialized) {
	ZipfsSetup();
    }
    Unlock();

    if (interp) {



	Tcl_EvalEx(interp, findproc, TCL_INDEX_NONE, TCL_EVAL_GLOBAL);
	if (!Tcl_IsSafe(interp)) {
	    Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
		    TCL_LINK_INT);
	    Tcl_LinkVar(interp, "::tcl::zipfs::fallbackEntryEncoding",
		    (char *) &ZipFS.fallbackEntryEncoding, TCL_LINK_STRING);
	}









	Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
		ZipFSTclLibraryObjCmd, NULL, NULL);
    }
    return TCL_OK;
}

/*
Changes to generic/tclZlib.c.
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    NULL,			/* Flush proc. */
    ZlibTransformEventHandler,
    NULL,			/* Seek proc. */
    NULL,			/* Thread action proc. */
    NULL			/* Truncate proc. */
};

static const EnsembleImplMap zlibImplMap[] = {
    {"adler32",		ZlibAdler32Cmd,	NULL, NULL, NULL, 0},
    {"compress",	ZlibCompressCmd,	NULL, NULL, NULL, 0},
    {"crc32",		ZlibCRC32Cmd,	NULL, NULL, NULL, 0},
    {"decompress",	ZlibDecompressCmd,	NULL, NULL, NULL, 0},
    {"deflate",		ZlibDeflateCmd,	NULL, NULL, NULL, 0},
    {"gunzip",		ZlibGunzipCmd,	NULL, NULL, NULL, 0},
    {"gzip",		ZlibGzipCmd,	NULL, NULL, NULL, 0},







|







228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    NULL,			/* Flush proc. */
    ZlibTransformEventHandler,
    NULL,			/* Seek proc. */
    NULL,			/* Thread action proc. */
    NULL			/* Truncate proc. */
};

const EnsembleImplMap tclZlibImplMap[] = {
    {"adler32",		ZlibAdler32Cmd,	NULL, NULL, NULL, 0},
    {"compress",	ZlibCompressCmd,	NULL, NULL, NULL, 0},
    {"crc32",		ZlibCRC32Cmd,	NULL, NULL, NULL, 0},
    {"decompress",	ZlibDecompressCmd,	NULL, NULL, NULL, 0},
    {"deflate",		ZlibDeflateCmd,	NULL, NULL, NULL, 0},
    {"gunzip",		ZlibGunzipCmd,	NULL, NULL, NULL, 0},
    {"gzip",		ZlibGzipCmd,	NULL, NULL, NULL, 0},
4107
4108
4109
4110
4111
4112
4113

4114


4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
    Tcl_SetChannelError(chanDataPtr->parent, errObj);
    *errorCodePtr = EINVAL;
    return -1;
}

/*
 *----------------------------------------------------------------------

 *	Finally, the TclZlibInit function. Used to install the zlib API.


 *----------------------------------------------------------------------
 */

int
TclZlibInit(
    Tcl_Interp *interp)
{
    Tcl_Config cfg[2];

    /*
     * This does two things. It creates a counter used in the creation of
     * stream commands, and it creates the namespace that will contain those
     * commands.
     */

    Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}",
	    TCL_AUTO_LENGTH, 0);

    /*
     * Create the public scripted interface to this file's functionality.
     */

    TclMakeEnsemble(interp, "zlib", zlibImplMap);

    /*
     * Store the underlying configuration information.
     *
     * TODO: Describe whether we're using the system version of the library or
     * a compatibility version built into Tcl?
     */








>
|
>
>


















<
<
<
<
<
<







4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135






4136
4137
4138
4139
4140
4141
4142
    Tcl_SetChannelError(chanDataPtr->parent, errObj);
    *errorCodePtr = EINVAL;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 *	Finally, the TclZlibInit function. Used to install the zlib API apart
 *	from the ensemble command.
 *
 *----------------------------------------------------------------------
 */

int
TclZlibInit(
    Tcl_Interp *interp)
{
    Tcl_Config cfg[2];

    /*
     * This does two things. It creates a counter used in the creation of
     * stream commands, and it creates the namespace that will contain those
     * commands.
     */

    Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}",
	    TCL_AUTO_LENGTH, 0);







    /*
     * Store the underlying configuration information.
     *
     * TODO: Describe whether we're using the system version of the library or
     * a compatibility version built into Tcl?
     */

Changes to library/icu.tcl.
16
17
18
19
20
21
22

23
24
25
26
27
28
29
30
31






32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
::tcl::unsupported::loadIcu

namespace eval ::tcl::unsupported::icu {
    # Map Tcl encoding names to ICU and back. Note ICU has multiple aliases
    # for the same encoding.
    variable tclToIcu
    variable icuToTcl


    proc LogError {message} {
	puts stderr $message
    }

    # Constructs the full mappings between Tcl and ICU names for encodings.
    proc Init {} {
	variable tclToIcu
	variable icuToTcl






	# There are some special cases where names do not line up
	# at all. Map Tcl -> ICU
	array set specialCases {
	    ebcdic ebcdic-cp-us
	    macCentEuro maccentraleurope
	    utf16 UTF16_PlatformEndian
	    utf-16be UnicodeBig
	    utf-16le UnicodeLittle
	    utf32 UTF32_PlatformEndian
	}
	# Ignore all errors. Do not want to hold up Tcl
	# if ICU not available
	try {
	    foreach tclName [encoding names] {
		try {
		    set icuNames [aliases $tclName]
		} on error erMsg {
		    LogError "Could not get aliases for $tclName: $erMsg"
		    continue
		}
		if {[llength $icuNames] == 0} {
		    # E.g. macGreek -> x-MacGreek
		    set icuNames [aliases x-$tclName]
		    if {[llength $icuNames] == 0} {
			# Still no joy, check for special cases
			if {[info exists specialCases($tclName)]} {
			    set icuNames [aliases $specialCases($tclName)]
			}
		    }
		}
		# If the Tcl name is also an ICU name use it else use
		# the first name which is the canonical ICU name
		set pos [lsearch -exact -nocase $icuNames $tclName]
		if {$pos >= 0} {
		    lappend tclToIcu($tclName) [lindex $icuNames $pos] {*}[lreplace $icuNames $pos $pos]

		} else {
		    set tclToIcu($tclName) $icuNames
		}
		foreach icuName $icuNames {
		    lappend icuToTcl($icuName) $tclName
		}
	    }
	} on error errMsg {
	    LogError $errMsg
	}
	array default set tclToIcu ""
	array default set icuToTcl ""

	# Redefine ourselves to no-op.
	proc Init {} {}
    }
    # Primarily used during development
    proc MappedIcuNames {{pat *}} {
	Init
	variable icuToTcl
	return [array names icuToTcl $pat]
    }







>









>
>
>
>
>
>
















|
|
















|
>












<
<
<







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86



87
88
89
90
91
92
93
::tcl::unsupported::loadIcu

namespace eval ::tcl::unsupported::icu {
    # Map Tcl encoding names to ICU and back. Note ICU has multiple aliases
    # for the same encoding.
    variable tclToIcu
    variable icuToTcl
    variable Initialised 0

    proc LogError {message} {
	puts stderr $message
    }

    # Constructs the full mappings between Tcl and ICU names for encodings.
    proc Init {} {
	variable tclToIcu
	variable icuToTcl
	variable Initialised
	if {$Initialised} {
	    return
	} else {
	    set initialised 1
	}
	# There are some special cases where names do not line up
	# at all. Map Tcl -> ICU
	array set specialCases {
	    ebcdic ebcdic-cp-us
	    macCentEuro maccentraleurope
	    utf16 UTF16_PlatformEndian
	    utf-16be UnicodeBig
	    utf-16le UnicodeLittle
	    utf32 UTF32_PlatformEndian
	}
	# Ignore all errors. Do not want to hold up Tcl
	# if ICU not available
	try {
	    foreach tclName [encoding names] {
		try {
		    set icuNames [aliases $tclName]
		} on error errMsg {
		    LogError "Could not get aliases for $tclName: $errMsg"
		    continue
		}
		if {[llength $icuNames] == 0} {
		    # E.g. macGreek -> x-MacGreek
		    set icuNames [aliases x-$tclName]
		    if {[llength $icuNames] == 0} {
			# Still no joy, check for special cases
			if {[info exists specialCases($tclName)]} {
			    set icuNames [aliases $specialCases($tclName)]
			}
		    }
		}
		# If the Tcl name is also an ICU name use it else use
		# the first name which is the canonical ICU name
		set pos [lsearch -exact -nocase $icuNames $tclName]
		if {$pos >= 0} {
		    lappend tclToIcu($tclName) [lindex $icuNames $pos] \
			    {*}[lreplace $icuNames $pos $pos]
		} else {
		    set tclToIcu($tclName) $icuNames
		}
		foreach icuName $icuNames {
		    lappend icuToTcl($icuName) $tclName
		}
	    }
	} on error errMsg {
	    LogError $errMsg
	}
	array default set tclToIcu ""
	array default set icuToTcl ""



    }
    # Primarily used during development
    proc MappedIcuNames {{pat *}} {
	Init
	variable icuToTcl
	return [array names icuToTcl $pat]
    }
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
    # the empty string in case not found.
    proc icuToTcl {icuName} {
	Init
	proc icuToTcl {icuName} {
	    variable icuToTcl
	    return [lindex $icuToTcl($icuName) 0]
	}
	icuToTcl $icuName
    }

    # Returns the ICU equivalent of an Tcl encoding name or
    # the empty string in case not found.
    proc tclToIcu {tclName} {
	Init
	proc tclToIcu {tclName} {
	    variable tclToIcu
	    return [lindex $tclToIcu($tclName) 0]
	}
	tclToIcu $tclName
    }

    namespace export {[a-z]*}
    namespace ensemble create
}







|










|





127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
    # the empty string in case not found.
    proc icuToTcl {icuName} {
	Init
	proc icuToTcl {icuName} {
	    variable icuToTcl
	    return [lindex $icuToTcl($icuName) 0]
	}
	tailcall icuToTcl $icuName
    }

    # Returns the ICU equivalent of an Tcl encoding name or
    # the empty string in case not found.
    proc tclToIcu {tclName} {
	Init
	proc tclToIcu {tclName} {
	    variable tclToIcu
	    return [lindex $tclToIcu($tclName) 0]
	}
	tailcall tclToIcu $tclName
    }

    namespace export {[a-z]*}
    namespace ensemble create
}
Changes to library/init.tcl.
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
    }
}

namespace eval tcl::Pkg {}


# Setup the unknown package handler


if {[interp issafe]} {
    package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
} else {
    # Set up search for Tcl Modules (TIP #189).
    # and setup platform specific unknown package handlers
    if {$tcl_platform(os) eq "Darwin"
	    && $tcl_platform(platform) eq "unix"} {
	package unknown {::tcl::tm::UnknownHandler \
		{::tcl::MacOSXPkgUnknown ::tclPkgUnknown}}
    } else {
	package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
    }

    # Set up the 'clock' ensemble

    apply {{} {
	set cmdmap [dict create]
	foreach cmd {add clicks format microseconds milliseconds scan seconds} {
	    dict set cmdmap $cmd ::tcl::clock::$cmd
	}
	namespace inscope ::tcl::clock [list namespace ensemble create -command \
	    ::clock -map $cmdmap]
	::tcl::unsupported::clock::configure -init-complete
    }}
}

# Conditionalize for presence of exec.

if {[namespace which -command exec] eq ""} {

    # Some machines do not have exec. Also, on all







<
<












<
<
<
<
<
<
<
<
<
<
<
<







88
89
90
91
92
93
94


95
96
97
98
99
100
101
102
103
104
105
106












107
108
109
110
111
112
113
    }
}

namespace eval tcl::Pkg {}


# Setup the unknown package handler


if {[interp issafe]} {
    package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
} else {
    # Set up search for Tcl Modules (TIP #189).
    # and setup platform specific unknown package handlers
    if {$tcl_platform(os) eq "Darwin"
	    && $tcl_platform(platform) eq "unix"} {
	package unknown {::tcl::tm::UnknownHandler \
		{::tcl::MacOSXPkgUnknown ::tclPkgUnknown}}
    } else {
	package unknown {::tcl::tm::UnknownHandler ::tclPkgUnknown}
    }












}

# Conditionalize for presence of exec.

if {[namespace which -command exec] eq ""} {

    # Some machines do not have exec. Also, on all
Changes to tests/interp.test.
16
17
18
19
20
21
22

23




























24
25
26
27
28
29
30
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]


set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:home tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempdir tcl:file:tempfile tcl:file:tildeexpand tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:canonical tcl:zipfs:exists tcl:zipfs:info tcl:zipfs:list tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mountdata tcl:zipfs:root tcl:zipfs:unmount unload zipfs}





























proc _ms_limit_args {ms {t0 {}}} {
    if {$t0 eq {}} { set t0 [clock milliseconds] }
    incr t0 $ms
    list -seconds [expr {$t0 / 1000}] -milliseconds [expr {$t0 % 1000}]
}








>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
}

::tcltest::loadTestedCommands
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]

set hidden_cmds [list {*}{
    cd clock encoding exec exit fconfigure file glob load open pwd socket source

    tcl:clock:add tcl:clock:format tcl:clock:scan

    tcl:encoding:dirs tcl:encoding:system

    tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete
    tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension
    tcl:file:home tcl:file:isdirectory tcl:file:isfile tcl:file:link
    tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename
    tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink
    tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail
    tcl:file:tempdir tcl:file:tempfile tcl:file:tildeexpand tcl:file:type
    tcl:file:volumes tcl:file:writable

    tcl:info:cmdtype tcl:info:nameofexecutable

    tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status

    tcl:unsupported:disassemble tcl:unsupported:getbytecode
    tcl:unsupported:loadIcu tcl:unsupported:representation

    tcl:zipfs:canonical tcl:zipfs:exists tcl:zipfs:info tcl:zipfs:list
    tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey
    tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mountdata tcl:zipfs:root
    tcl:zipfs:unmount

    unload zipfs
}]

proc _ms_limit_args {ms {t0 {}}} {
    if {$t0 eq {}} { set t0 [clock milliseconds] }
    incr t0 $ms
    list -seconds [expr {$t0 / 1000}] -milliseconds [expr {$t0 % 1000}]
}

Changes to tests/namespace.test.
3369
3370
3371
3372
3373
3374
3375









3376
3377
3378
3379
3380
3381
3382
3383
3384
3385

3386
3387
3388
3389
3390
3391
3392

test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} {
    info class [format %s constructor] oo::object
} ""

test namespace-55.2 {compiled ensembles inside safe interpreters (for safe sub-commands), bug [1095bf7f756f9aed]} -setup {
    interp create -safe si









    set code {
	proc test_comp_dict d { dict for {k v} $d {expr $v} }
	regexp -inline {Command 1:(?:[^\n]*\n){1,5}} [::tcl::unsupported::disassemble proc test_comp_dict]
    }
} -body {
    set a [   eval $code]
    set b [si eval $code]
    list [expr {$a eq $b}] [regexp { dictFirst } $a] [regexp { dictFirst } $b] $a $b
} -cleanup {
    rename test_comp_dict {}

    unset -nocomplain code a b
    interp delete si
} -match glob -result {1 1 1 *}

test namespace-56.1 {bug f97d4ee020: mutually-entangled deletion} {
    namespace eval ::testing {
	proc abc {} {}







>
>
>
>
>
>
>
>
>


<

<
|
|
|


>







3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386

3387

3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400

test namespace-55.1 {compiled ensembles inside compiled ensembles: Bug 6d2f249a01} {
    info class [format %s constructor] oo::object
} ""

test namespace-55.2 {compiled ensembles inside safe interpreters (for safe sub-commands), bug [1095bf7f756f9aed]} -setup {
    interp create -safe si
    proc findBytecode {setup descriptor} {
	foreach op [dict values [dict get $descriptor instructions]] {
	    if {[lindex $op 0] eq "dictFirst"} {
		return $op
	    }
	}
	return [join [dict get $descriptor instructions] "\n"]
    }
} -body {
    set code {
	proc test_comp_dict d { dict for {k v} $d {expr $v} }

    }

    set a [findBytecode [   eval $code] [::tcl::unsupported::getbytecode proc test_comp_dict]]
    set b [findBytecode [si eval $code] [si invokehidden tcl:unsupported:getbytecode proc test_comp_dict]]
    list [expr {$a eq $b}] [expr {"dictFirst" in $a}] [expr {"dictFirst" in $b}] $a $b
} -cleanup {
    rename test_comp_dict {}
    rename findBytecode {}
    unset -nocomplain code a b
    interp delete si
} -match glob -result {1 1 1 *}

test namespace-56.1 {bug f97d4ee020: mutually-entangled deletion} {
    namespace eval ::testing {
	proc abc {} {}